diff --git a/frontend/deps.edn b/frontend/deps.edn index 313e8db1a..5783b856b 100644 --- a/frontend/deps.edn +++ b/frontend/deps.edn @@ -21,6 +21,8 @@ lambdaisland/uri {:mvn/version "1.4.54" :exclusions [org.clojure/data.json]} + instaparse/instaparse {:mvn/version "1.4.10"} + } :aliases {:dev diff --git a/frontend/src/app/main/ui/components/numeric_input.cljs b/frontend/src/app/main/ui/components/numeric_input.cljs index f8b4027b1..6088b9b8d 100644 --- a/frontend/src/app/main/ui/components/numeric_input.cljs +++ b/frontend/src/app/main/ui/components/numeric_input.cljs @@ -8,83 +8,122 @@ (:require [app.common.data :as d] [app.common.math :as math] + [app.common.spec :as us] [app.util.dom :as dom] [app.util.keyboard :as kbd] [app.util.object :as obj] + [app.util.simple-math :as sm] [rumext.alpha :as mf])) (mf/defc numeric-input {::mf/wrap-props false ::mf/forward-ref true} [props ref] - (let [value (obj/get props "value") - on-change (obj/get props "onChange") - min-val (obj/get props "min") - max-val (obj/get props "max") + (let [value-str (obj/get props "value") + min-val-str (obj/get props "min") + max-val-str (obj/get props "max") wrap-value? (obj/get props "data-wrap") + on-change (obj/get props "onChange") - stored-val (mf/use-var value) - local-ref (mf/use-ref nil) + local-ref (mf/use-ref) ref (or ref local-ref) - min-val (cond-> min-val - (string? min-val) (d/parse-integer nil)) + value (d/parse-integer value-str) - max-val (cond-> max-val - (string? max-val) (d/parse-integer nil)) + min-val (when (string? min-val-str) + (d/parse-integer min-val-str)) + max-val (when (string? max-val-str) + (d/parse-integer max-val-str)) + num? (fn [val] (and (number? val) + (not (math/nan? val)) + (math/finite? val))) - num? (fn [value] (and (number? value) - (not (math/nan? value)) - (math/finite? value))) - - parse-value (fn [event] - (let [value (-> (dom/get-target-val event) (d/parse-integer nil))] - (when (num? value) - (cond-> value - (num? min-val) (cljs.core/max min-val) - (num? max-val) (cljs.core/min max-val))))) - handle-change + parse-value (mf/use-callback - (mf/deps on-change) - (fn [event] - (let [value (parse-value event)] - (when (and on-change (num? value)) - (on-change value))))) + (mf/deps ref min-val max-val value) + (fn [] + (let [input-node (mf/ref-val ref) + new-value (-> (dom/get-value input-node) + (sm/expr-eval value))] + (when (num? new-value) + (cond-> new-value + true + (math/round) + + true + (cljs.core/max us/min-safe-int) + + true + (cljs.core/min us/max-safe-int) + + (num? min-val) + (cljs.core/max min-val) + + (num? max-val) + (cljs.core/min max-val)))))) + + update-input + (mf/use-callback + (mf/deps ref) + (fn [new-value] + (let [input-node (mf/ref-val ref)] + (dom/set-value! input-node (str new-value))))) + + apply-value + (mf/use-callback + (mf/deps on-change update-input) + (fn [new-value] + (when new-value + (when on-change + (on-change new-value)) + (update-input new-value)))) set-delta (mf/use-callback - (mf/deps on-change wrap-value? min-val max-val) + (mf/deps wrap-value? min-val max-val parse-value apply-value) (fn [event up? down?] - (let [value (parse-value event) - increment (if up? 9 -9)] - (when (and (or up? down?) (num? value)) - (cond - (kbd/shift? event) - (let [new-value (+ value increment) - new-value (cond - (and wrap-value? (num? max-val) (num? min-val) (> new-value max-val) up?) - (+ min-val (- max-val new-value)) + (let [current-value (parse-value)] + (when current-value + (let [increment (if (kbd/shift? event) + (if up? 10 -10) + (if up? 1 -1)) - (and wrap-value? (num? min-val) (num? max-val) (< new-value min-val) down?) - (- max-val (- new-value min-val)) + new-value (+ current-value increment) + new-value (cond + (and wrap-value? (num? max-val) (num? min-val) + (> new-value max-val) up?) + (-> new-value (- max-val) (+ min-val) (- 1)) - (and (num? min-val) (< new-value min-val)) min-val - (and (num? max-val) (> new-value max-val)) max-val - :else new-value)] - (dom/set-value! (dom/get-target event) new-value)) + (and wrap-value? (num? min-val) (num? max-val) + (< new-value min-val) down?) + (-> new-value (- min-val) (+ max-val) (+ 1)) - (and wrap-value? (num? max-val) (num? min-val) (= value max-val) up?) - (dom/set-value! (dom/get-target event) (dec min-val)) + (and (num? min-val) (< new-value min-val)) + min-val - (and wrap-value? (num? min-val) (num? max-val) (= value min-val) down?) - (dom/set-value! (dom/get-target event) (inc max-val))))))) + (and (num? max-val) (> new-value max-val)) + max-val + + :else new-value)] + + (apply-value new-value)))))) handle-key-down (mf/use-callback - (mf/deps set-delta) + (mf/deps set-delta apply-value update-input) (fn [event] - (set-delta event (kbd/up-arrow? event) (kbd/down-arrow? event)))) + (let [up? (kbd/up-arrow? event) + down? (kbd/down-arrow? event) + enter? (kbd/enter? event) + esc? (kbd/esc? event)] + (when (or up? down?) + (set-delta event up? down?)) + (when enter? + (let [new-value (parse-value)] + (apply-value new-value))) + (when esc? + (update-input value-str))))) handle-mouse-wheel (mf/use-callback @@ -93,27 +132,30 @@ (set-delta event (< (.-deltaY event) 0) (> (.-deltaY event) 0)))) handle-blur - (fn [event] - (when-let [input-node (and ref (mf/ref-val ref))] - (dom/set-value! input-node @stored-val))) + (mf/use-callback + (mf/deps parse-value apply-value update-input) + (fn [event] + (let [new-value (parse-value)] + (if new-value + (apply-value new-value) + (update-input value-str))))) props (-> props (obj/without ["value" "onChange"]) (obj/set! "className" "input-text") - (obj/set! "type" "number") + (obj/set! "type" "text") (obj/set! "ref" ref) - (obj/set! "defaultValue" value) + (obj/set! "defaultValue" value-str) (obj/set! "onWheel" handle-mouse-wheel) (obj/set! "onKeyDown" handle-key-down) - (obj/set! "onChange" handle-change) (obj/set! "onBlur" handle-blur))] (mf/use-effect - (mf/deps value) + (mf/deps value-str) (fn [] - (when-let [input-node (and ref (mf/ref-val ref))] - (if-not (dom/active? input-node) - (dom/set-value! input-node value) - (reset! stored-val value))))) + (when-let [input-node (mf/ref-val ref)] + (when-not (dom/active? input-node) + (dom/set-value! input-node value-str))))) + [:> :input props])) diff --git a/frontend/src/app/util/simple_math.cljs b/frontend/src/app/util/simple_math.cljs new file mode 100644 index 000000000..45cb01719 --- /dev/null +++ b/frontend/src/app/util/simple_math.cljs @@ -0,0 +1,104 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.simple-math + (:require + [cljs.spec.alpha :as s] + [clojure.string :refer [index-of]] + [cuerdas.core :as str] + [instaparse.core :as insta] + [app.common.data :as d] + [app.common.exceptions :as ex])) + +(def parser + (insta/parser + "opt-expr = '' | expr + expr = term ( ('+'|'-') expr)* | + ('+'|'-'|'*'|'/') factor + term = factor ( ('*'|'/') term)* + factor = number | ('(' expr ')') + number = #'[0-9]*[.,]?[0-9]+%?' + spaces = ' '*")) + +(defn interpret + [tree init-value] + (let [token (first tree) + args (rest tree)] + (case token + + :opt-expr + (if (empty? args) 0 (interpret (first args) init-value)) + + :expr + (if (index-of "+-*/" (first args)) + (let [operator (first args) + second-value (interpret (second args) init-value)] + (case operator + "+" (+ init-value second-value) + "-" (- init-value second-value) + "*" (* init-value second-value) + "/" (/ init-value second-value))) + (let [value (interpret (first args) init-value)] + (loop [value value + rest-expr (rest args)] + (if (empty? rest-expr) + value + (let [operator (first rest-expr) + second-value (interpret (second rest-expr) init-value) + rest-expr (-> rest-expr rest rest)] + (case operator + "+" (recur (+ value second-value) rest-expr) + "-" (recur (- value second-value) rest-expr))))))) + + :term + (let [value (interpret (first args) init-value)] + (loop [value value + rest-expr (rest args)] + (if (empty? rest-expr) + value + (let [operator (first rest-expr) + second-value (interpret (second rest-expr) init-value) + rest-expr (-> rest-expr rest rest)] + (case operator + "*" (recur (* value second-value) rest-expr) + "/" (recur (/ value second-value) rest-expr)))))) + + :factor + (if (= (first args) "(") + (interpret (second args) init-value) + (interpret (first args) init-value)) + + :number + (let [value-str (str/replace (first args) "," ".")] + (if-not (str/ends-with? value-str "%") + (d/parse-double value-str) + (-> value-str + (str/replace "%" "") + (d/parse-double) + (/ 100) + (* init-value)))) + + (ex/raise :type :validation + :hint (str "Unknown token" token args))))) + +(defn expr-eval + [expr init-value] + (s/assert string? expr) + (s/assert number? init-value) + (let [result (parser expr)] + (if-not (insta/failure? result) + (interpret result init-value) + (let [text (:text result) + index (:index result) + expecting (->> result + :reason + (map :expecting) + (filter some?))] + (js/console.debug + (str "Invalid value '" text "' at index " index + ". Expected one of " expecting ".")) + nil)))) + diff --git a/frontend/tests/app/test_util_simple_math.cljs b/frontend/tests/app/test_util_simple_math.cljs new file mode 100644 index 000000000..98f73eb1f --- /dev/null +++ b/frontend/tests/app/test_util_simple_math.cljs @@ -0,0 +1,78 @@ +(ns app.test-util-simple-math + (:require [cljs.test :as t :include-macros true] + [cljs.pprint :refer [pprint]] + [app.common.math :as cm] + [app.util.simple-math :as sm])) + +(t/deftest test-parser-inst + (t/testing "Evaluate an empty string" + (let [result (sm/expr-eval "" 999)] + (t/is (= result 0)))) + + (t/testing "Evaluate a single number" + (let [result (sm/expr-eval "10" 999)] + (t/is (= result 10)))) + + (t/testing "Evaluate an addition" + (let [result (sm/expr-eval "10+3" 999)] + (t/is (= result 13)))) + + (t/testing "Evaluate an addition with spaces" + (let [result (sm/expr-eval "100 + 35" 999)] + (t/is (= result 135)))) + + (t/testing "Evaluate some operations" + (let [result (sm/expr-eval "100 + 35 - 10 * 2" 999)] + (t/is (= result 115)))) + + (t/testing "Evaluate some operations with parentheses" + (let [result (sm/expr-eval "(100 + 35 - 10) * 2" 999)] + (t/is (= result 250)))) + + (t/testing "Evaluate some operations with nested parentheses" + (let [result (sm/expr-eval "(100 + 35 - (20/2))*2" 999)] + (t/is (= result 250)))) + + (t/testing "Evaluate a relative addition" + (let [result (sm/expr-eval "+10" 20)] + (t/is (= result 30)))) + + (t/testing "Evaluate a relative multiplication" + (let [result (sm/expr-eval "*10" 20)] + (t/is (= result 200)))) + + (t/testing "Evaluate a relative complex operation" + (let [result (sm/expr-eval "+(10*2 - 5)" 20)] + (t/is (= result 35)))) + + (t/testing "Evaluate a percentual operation" + (let [result (sm/expr-eval "+50%" 20)] + (t/is (= result 30)))) + + (t/testing "Evaluate a complex operation with percents" + (let [result (sm/expr-eval "5 + (25% * 2)" 100)] + (t/is (= result 55)))) + + (t/testing "Evaluate a complex operation with percents and relative" + (let [result (sm/expr-eval "+ (25% * 2)" 100)] + (t/is (= result 150)))) + + (t/testing "Evaluate an addition with decimals" + (let [result1 (sm/expr-eval "10 + 2.5" 999) + result2 (sm/expr-eval "10 + 2,5" 999)] + (t/is (= result1 result2 12.5)))) + + (t/testing "Evaluate a relative operation with decimals" + (let [result (sm/expr-eval "*.5" 20)] + (t/is (= result 10)))) + + (t/testing "Evaluate a percentual operation with decimals" + (let [result (sm/expr-eval "+10.5%" 20)] + (t/is (= result 22.1)))) + + (t/testing "Evaluate a complex operation with decimals" + (let [result (sm/expr-eval "(20.333 + 10%) * (1 / 3)" 20)] + (t/is (cm/close? result 7.44433333)))) + + ) +