🎉 Allow calculations in numeric fields

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

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")
+  (let [value-str   (obj/get props "value")
-        on-change (obj/get props "onChange")
+        min-val-str (obj/get props "min")
-        min-val   (obj/get props "min")
+        max-val-str (obj/get props "max")
-        max-val   (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)
-        local-ref (mf/use-ref nil)
         ref (or ref local-ref)
 
-        min-val (cond-> min-val
+        value (d/parse-integer value-str)
-                  (string? min-val) (d/parse-integer nil))
 
-        max-val (cond-> max-val
+        min-val (when (string? min-val-str)
-                  (string? max-val) (d/parse-integer nil))
+                  (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)
+        parse-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
         (mf/use-callback
-         (mf/deps on-change)
+          (mf/deps ref min-val max-val value)
-         (fn [event]
+          (fn []
-           (let [value (parse-value event)]
+            (let [input-node (mf/ref-val ref)
-             (when (and on-change (num? value))
+                  new-value (-> (dom/get-value input-node)
-               (on-change value)))))
+                                (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)
+           (let [current-value (parse-value)]
-                 increment (if up? 9 -9)]
+             (when current-value
-             (when (and (or up? down?) (num? value))
+               (let [increment (if (kbd/shift? event)
-               (cond
+                                 (if up? 10 -10)
-                 (kbd/shift? event)
+                                 (if up? 1 -1))
-                 (let [new-value (+ value increment)
+
+                     new-value (+ current-value increment)
                      new-value (cond
-                                   (and wrap-value? (num? max-val) (num? min-val) (> new-value max-val) up?)
+                                 (and wrap-value? (num? max-val) (num? min-val)
-                                   (+ min-val (- max-val new-value))
+                                      (> new-value max-val) up?)
+                                 (-> new-value (- max-val) (+ min-val) (- 1))
 
-                                   (and wrap-value? (num? min-val) (num? max-val) (< new-value min-val) down?)
+                                 (and wrap-value? (num? min-val) (num? max-val)
-                                   (- max-val (- new-value min-val))
+                                      (< new-value min-val) down?)
+                                 (-> new-value (- min-val) (+ max-val) (+ 1))
+
+                                 (and (num? min-val) (< new-value min-val))
+                                 min-val
+
+                                 (and (num? max-val) (> new-value max-val))
+                                 max-val
 
-                                   (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? max-val) (num? min-val) (= value max-val) up?)
+                 (apply-value new-value))))))
-                 (dom/set-value! (dom/get-target event) (dec 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)))))))
 
         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
+        (mf/use-callback
+          (mf/deps parse-value apply-value update-input)
           (fn [event]
-          (when-let [input-node (and ref (mf/ref-val ref))]
+            (let [new-value (parse-value)]
-            (dom/set-value! input-node @stored-val)))
+              (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))]
+       (when-let [input-node (mf/ref-val ref)]
-         (if-not (dom/active? input-node)
+         (when-not (dom/active? input-node)
-           (dom/set-value! input-node value)
+           (dom/set-value! input-node value-str)))))
-           (reset! stored-val value)))))
+
     [:> :input props]))
 

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 (<spaces> ('+'|'-') <spaces> expr)* |
+            ('+'|'-'|'*'|'/') <spaces> factor
+     term = factor (<spaces> ('*'|'/') <spaces> term)*
+     factor = number | ('(' <spaces> expr <spaces> ')')
+     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))))
+

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))))
+
+  )
+