html and order events tests

.github/workflows/clojure.yml

@@ -32,6 +32,10 @@ jobs:
         with:
           node-version: 15.x
 
+      - uses: DeLaGuardo/setup-clojure@3.1
+        with:
+          tools-deps: '1.10.1.763'
+
       - run: npm install karma karma-cljs-test --save-dev karma-chrome-launcher --save-dev
         working-directory: ./frontend
 

frontend/deps.edn

@@ -4,7 +4,8 @@
         day8.re-frame/http-fx {:mvn/version "0.2.3"}}
 
  :aliases
- {:dev {:extra-deps  { thheller/shadow-cljs {:mvn/version "2.11.21"}}
+ {:dev {:extra-deps  { thheller/shadow-cljs {:mvn/version "2.11.21"}
+                      day8.re-frame/test {:mvn/version "0.1.5"}}
         :extra-paths ["test"]}
 
   :garden

frontend/src/chicken_master/events.cljs

@@ -8,13 +8,14 @@
    [ajax.edn :as edn]
    [goog.crypt.base64 :as b64]))
 
+(defn get-token [] (str "Basic " (some-> js/window (.-localStorage) (.getItem :bearer-token))))
 (defn http-request [method endpoint & {:keys [params body on-success on-failure]
                                        :or {on-success ::process-fetched-days
                                             on-failure ::failed-request}}]
   {:method method
    :uri (str (settings :backend-url) endpoint)
    :headers {"Content-Type" "application/edn"
-             "authorization" (str "Basic " (some-> js/window (.-localStorage) (.getItem :bearer-token)))}
+             "authorization" (get-token)}
    :format (edn/edn-request-format)
    :body (some-> body pr-str)
    :params params
@@ -58,14 +59,19 @@
    (when (js/confirm msg)
      {:fx [[:dispatch (into [on-confirm-event] params)]]})))
 
-(re-frame/reg-event-db
+(re-frame/reg-event-fx
+ ::log-error
+ (fn [_ [_ error]]
+   (.error js/console error)
+   (js/alert "Wystąpił błąd")))
+
+(re-frame/reg-event-fx
  ::failed-request
- (fn [db [_ response]]
+ (fn [{db :db} [_ response]]
-   (.error js/console (str response))
+   {:db (-> db
-   (js/alert "Wystąpił błąd")
-   (-> db
             (assoc :loading? false)
-       (update :current-user #(when-not (= (:status response) 401) %)))))
+            (update :current-user #(when-not (= (:status response) 401) %)))
+    :dispatch [::log-error (str response)]}))
 
 (re-frame/reg-event-fx
  ::remove-order
@@ -74,12 +80,12 @@
 
 (re-frame/reg-event-fx
  ::move-order
- (fn [{{orders :orders start-date :start-date} :db} [_ id day]]
+ (fn [{{orders :orders} :db} [_ id day]]
    {:http-xhrio
     (http-request :put (str "orders/" id)
-                  :body (-> id orders (assoc :day day :start-from start-date)))}))
+                  :body (-> id orders (assoc :day day)))}))
 
- (re-frame/reg-event-db
+(re-frame/reg-event-db
  ::edit-order
  (fn [{orders :orders :as db} [_ day id]]
    (assoc db :order-edit
@@ -103,11 +109,12 @@
  ::save-order
  (fn [{{order :order-edit} :db} [_ form]]
    {:dispatch [::hide-modal :order-edit]
-    :http-xhrio (http-post (str "orders")
+    :http-xhrio (http-post "orders"
                            (merge
                             (select-keys order [:id :day :hour :state])
                             (select-keys form [:id :day :hour :state :who :notes :products])))}))
 
+;; FIXME: add test
 (re-frame/reg-event-db
  ::process-fetched-days
  (fn [db [_ days]]
@@ -118,6 +125,7 @@
                                  [day (if (contains? days day) (days day) orders)])))
        (update :orders #(reduce (fn [m order] (assoc m (:id order) order)) % (mapcat second days))))))
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::scroll-weeks
  (fn [{db :db} [_ offset]]
@@ -128,6 +136,7 @@
                                           (time/date-offset (* 7 offset))
                                           time/iso-date)]]]}))
 
+;; FIXME: add test
 (re-frame/reg-event-db
  ::show-from-date
  (fn [{:keys [start-date orders] :as db} [_ day]]
@@ -139,6 +148,7 @@
             :start-date day
             :current-days (map #(vector % (get filtered-orders %)) (sort days))))))
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::fetch-orders
  (fn [_ [_ from to]]
@@ -146,18 +156,21 @@
     :http-xhrio (http-request :get "orders")}))
 
 ;; Customers events
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::show-customers
  (fn [{db :db} _]
    {:db (assoc-in db [:clients :show] true)
     :dispatch [::fetch-stock]}))
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::add-customer
  (fn [_ [_ customer-name]]
    {:http-xhrio (http-request :post "customers"
                                             :body {:name customer-name}
                                             :on-success ::process-stock)}))
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::remove-customer
  (fn [_ [_ id]]
@@ -167,18 +180,21 @@
 
 ;;; Storage events
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::show-stock
  (fn [{db :db} _]
    {:db (assoc-in db [:stock :show] true)
     :dispatch [::fetch-stock]}))
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::fetch-stock
  (fn [_ _]
    {:dispatch [::start-loading]
     :http-xhrio (http-get "stock" {} ::process-stock)}))
 
+;; FIXME: add test
 (defn assoc-if [coll key val] (if val (assoc coll key val) coll))
 (re-frame/reg-event-fx
  ::process-stock
@@ -189,6 +205,7 @@
     :dispatch [::stop-loading]
     }))
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::save-stock
  (fn [_ [_ products]]
@@ -198,12 +215,14 @@
 
 ;; Settings
 
+;; FIXME: add test
 (re-frame/reg-event-db
  ::show-settings
  (fn [db _]
    (assoc-in db [:settings :show] true)))
 
 
+;; FIXME: add test
 (re-frame/reg-event-fx
  ::set-user
  (fn [{db :db} [_ user]]

frontend/src/chicken_master/html.cljs

@@ -4,8 +4,8 @@
 
 (defn extract-input [elem]
   (condp = (.-tagName elem)
-    "CHECKBOX" [elem (.-checked elem)]
+    "CHECKBOX" [(.-name elem) (.-checked elem)]
-    "INPUT" [(.-name elem) (if (-> (.-type elem) clojure.string/lower-case #{"checkbox"})
+    "INPUT" [(.-name elem) (if (some-> (.-type elem) clojure.string/lower-case #{"checkbox"})
                              (.-checked elem)
                              (.-value elem))]
     "SELECT" [(.-name elem) (some->> elem

frontend/test/chicken_master/events_test.cljs

@@ -0,0 +1,185 @@
+(ns chicken-master.events-test
+  (:require
+   [chicken-master.events :as sut]
+   [chicken-master.subs :as subs]
+   [cljs.test :refer-macros [deftest is testing]]
+   [day8.re-frame.test :as rf-test]
+   [re-frame.core :as rf]))
+
+
+(defn set-db [updates]
+  (rf/reg-event-db
+   ::merge-db
+   (fn [db [_ incoming]] (merge db incoming)))
+  (rf/dispatch [::merge-db updates]))
+
+(defn param-validator [event validator]
+  (rf/reg-event-fx event (fn [_ [_ & params]] (validator params) nil)))
+
+
+(deftest hide-modal
+  (testing "models can be hidden"
+    (rf-test/run-test-sync
+     (set-db {:order-edit {:show true}
+              :stock {:show true}
+              :clients {:show true}
+              :settings {:show true}})
+     (is @(rf/subscribe [::subs/show-edit-modal]))
+     (is @(rf/subscribe [::subs/show-stock-modal]))
+     (is @(rf/subscribe [::subs/show-customers-modal]))
+     (is @(rf/subscribe [::subs/show-settings-modal]))
+
+     (rf/dispatch [::sut/hide-modal :order-edit])
+     (is (nil? @(rf/subscribe [::subs/show-edit-modal])))
+
+     (rf/dispatch [::sut/hide-modal :stock])
+     (is (nil? @(rf/subscribe [::subs/show-stock-modal])))
+
+     (rf/dispatch [::sut/hide-modal :clients])
+     (is (nil? @(rf/subscribe [::subs/show-customers-modal])))
+
+     (rf/dispatch [::sut/hide-modal :settings])
+     (is (nil? @(rf/subscribe [::subs/show-settings-modal]))))))
+
+(deftest loader-test
+  (testing "loader gets set"
+    (rf-test/run-test-sync
+     (set-db {:loading? nil})
+     (is (nil? @(rf/subscribe [::subs/loading?])))
+     (rf/dispatch [::sut/start-loading])
+     (is @(rf/subscribe [::subs/loading?]))))
+
+  (testing "loader gets cleared"
+    (rf-test/run-test-sync
+     (set-db {:loading? true})
+     (is @(rf/subscribe [::subs/loading?]))
+     (rf/dispatch [::sut/stop-loading])
+     (is (nil? @(rf/subscribe [::subs/loading?]))))))
+
+(deftest confirm-action-test
+  (testing "when confirmed, the provided event is called"
+    (rf-test/run-test-sync
+     (param-validator ::confirm #(is (= % [1 2])))
+
+     (with-redefs [js/confirm (constantly true)]
+       (rf/dispatch [::sut/confirm-action "bla bla" ::confirm 1 2]))))
+
+  (testing "when not confirmed, nothing happens"
+    (rf-test/run-test-sync
+     (let [calls (atom [])]
+       (param-validator ::confirm #(swap! calls conj %))
+       ;; make sure that the action handler works by sending a test event
+       (rf/dispatch [::confirm :check-call])
+
+       (with-redefs [js/confirm (constantly false)]
+         (rf/dispatch [::sut/confirm-action "bla bla" ::confirm 1 2]))
+       (is (= @calls [[:check-call]]))))))
+
+(deftest test-failed-request
+  (testing "failed requests log errors"
+    (rf-test/run-test-sync
+     (set-db {:loading? true :current-user "mr blobby"})
+     (param-validator ::sut/log-error #(is (= % ["{:status 500}"])))
+
+     (is @(rf/subscribe [::subs/loading?]))
+     (rf/dispatch [::sut/failed-request {:status 500}])
+
+     (is (not @(rf/subscribe [::subs/loading?])))
+     (is (= @(rf/subscribe [::subs/current-user]) "mr blobby"))))
+
+  (testing "401s log the user out"
+    (rf-test/run-test-sync
+     (set-db {:loading? true :current-user "mr blobby"})
+     (param-validator ::sut/log-error #(is (= % ["{:status 401}"])))
+
+     (is @(rf/subscribe [::subs/loading?]))
+     (rf/dispatch [::sut/failed-request {:status 401}])
+
+     (is (not @(rf/subscribe [::subs/loading?])))
+     (is (nil? @(rf/subscribe [::subs/current-user]))))))
+
+(deftest test-orders-updates
+  ;; FIXME: the request handler is not being overloaded
+  (testing "orders get updated"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2012-12-12"}}})
+     (param-validator :http-xhrio (fn [[{:keys [method uri body]}]]
+                                    (is (= method :put))
+                                    (is (= uri "orders/1"))
+                                    (is (= body {:id 1 :day "2020-01-01"}))))
+
+     (rf/dispatch [::sut/move-order 1 "2020-01-01"])))
+
+  (testing "orders editor is shown"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2012-12-12"}} :order-edit nil})
+
+     (rf/dispatch [::sut/edit-order "2020-01-01" 1])
+
+     (is (= @(rf/subscribe [::subs/editted-order])
+            {:show true :day "2020-01-01" :id 1}))))
+
+  (testing "new orders can be edited"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2012-12-12"}} :order-edit nil})
+
+     (rf/dispatch [::sut/edit-order "2020-01-01" :new-order])
+
+     (is (= @(rf/subscribe [::subs/editted-order])
+            {:show true :day "2020-01-01" :state :waiting}))))
+
+  ;; FIXME: the request handler is not being overloaded
+  (testing "orders are fulfilled"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2012-12-12"}} :order-edit nil})
+     (param-validator :http-xhrio (fn [[{:keys [method uri body]}]]
+                                    (is (= method :post))
+                                    (is (= uri "orders/1/fulfilled"))
+                                    (is (= body nil))))
+
+     (rf/dispatch [::sut/fulfill-order 1])
+     (is (= (-> [::subs/orders] rf/subscribe deref (get 1) :state) :pending))))
+
+  ;; FIXME: the request handler is not being overloaded
+  (testing "orders are reset"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2012-12-12"}} :order-edit nil})
+     (param-validator :http-xhrio (fn [[{:keys [method uri body]}]]
+                                    (is (= method :post))
+                                    (is (= uri "orders/1/waiting"))
+                                    (is (= body nil))))
+
+     (rf/dispatch [::sut/reset-order 1])
+     (is (= (-> [::subs/orders] rf/subscribe deref (get 1) :state) :waiting))))
+
+  ;; FIXME: the request handler is not being overloaded
+  (testing "orders use the values in :order-edit if not provided"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2020-10-10" :hour "12" :state :waiting}}
+              :order-edit {:show true}})
+     (param-validator :http-xhrio (fn [[{:keys [method uri body]}]]
+                                    (is (= method :post))
+                                    (is (= uri "orders"))
+                                    (is (= body {:id 1 :day "2020-10-10" :hour "12" :state :waiting :products {:eggs 2 :milk 3}}))))
+
+     (rf/dispatch [::sut/save-order {:products {:eggs 2 :milk 3}}])
+
+     (is (nil? @(rf/subscribe [::subs/show-edit-modal])))))
+
+  ;; FIXME: the request handler is not being overloaded
+  (testing "order edit forms overwrite previous values"
+    (rf-test/run-test-sync
+     (set-db {:orders {1 {:id 1 :day "2020-10-10" :hour "12" :state :waiting}}
+              :order-edit {:show true}})
+     (param-validator :http-xhrio (fn [[{:keys [method uri body]}]]
+                                    (is (= method :post))
+                                    (is (= uri "orders"))
+                                    (is (= body {:id 1 :day "2022-10-10" :hour "24"
+                                                 :state :pending :note "asd" :who {:id 12 :name "mr blobby"}
+                                                 :products {:eggs 2 :milk 3}}))))
+
+     (rf/dispatch [::sut/save-order {:id 1 :day "2022-10-10" :hour "24"
+                                     :state :pending :note "asd" :who {:id 12 :name "mr blobby"}
+                                     :product {:eggs 2 :milk 3}}])
+
+     (is (nil? @(rf/subscribe [::subs/show-edit-modal]))))))

frontend/test/chicken_master/html_test.cljs

@@ -0,0 +1,55 @@
+(ns chicken-master.html-test
+  (:require
+   [chicken-master.html :as sut]
+   [cljs.test :refer-macros [deftest is testing]]))
+
+(defn make-select [name selected items]
+  (let [select (new js/Set (map #(js-obj "selected" (= % selected) "value" %) items))]
+    (set! (.-tagName select) "SELECT")
+    (set! (.-name select) name)
+    select))
+
+(deftest test-extract-input
+  (testing "unknown types return nil"
+    (is (nil? (sut/extract-input (clj->js {:tagName "BLA bla" :name "bla" :checked true})))))
+
+  (testing "no input type is handled"
+    (is (= (sut/extract-input (clj->js {:tagName "INPUT" :name "bla" :value "asd"}))
+           ["bla" "asd"])))
+
+  (testing "checkboxes work"
+    (is (= (sut/extract-input (clj->js {:tagName "CHECKBOX" :name "bla" :checked true})) ["bla" true]))
+    (is (= (sut/extract-input (clj->js {:tagName "CHECKBOX" :name "bla" :checked false :value "bla"}))
+           ["bla" false]))
+    (is (= (sut/extract-input (clj->js {:tagName "CHECKBOX" :name "bla" :value "asd"})) ["bla" nil])))
+
+  (testing "input checkboxes work"
+    (is (= (sut/extract-input (clj->js {:tagName "INPUT" :name "bla" :type "checkbox" :checked true}))
+           ["bla" true]))
+    (is (= (sut/extract-input (clj->js {:tagName "INPUT" :name "bla" :type "cHEckBOx" :checked true}))
+           ["bla" true])))
+
+  (testing "basic inputs work"
+    (is (= (sut/extract-input (clj->js {:tagName "INPUT" :name "bla" :type "text" :value true}))
+           ["bla" true]))
+    (is (= (sut/extract-input (clj->js {:tagName "INPUT" :name "bla" :type "text" :value "ble ble"}))
+           ["bla" "ble ble"])))
+
+  (testing "selects work"
+    (is (= (sut/extract-input (make-select "bla" nil [:a :b :c :d])) ["bla" nil]))
+    (is (= (sut/extract-input (make-select "bla" :missing-item [:a :b :c :d])) ["bla" nil]))))
+
+(deftest test-form-values
+  (testing "extraction works"
+    (is (= (sut/form-values
+            (clj->js {:elements
+                      [(clj->js {:tagName "CHECKBOX" :name "bla" :checked true})
+                       (clj->js {:tagName "CHECKBOX" :name "ble" :checked nil})
+                       (clj->js {:tagName "INPUT" :type "text" :name "name" :value "mr blobby"})
+                       (clj->js {:tagName "INPUT" :type "text" :name "flies" :value 12})
+                       (clj->js {:tagName "INPUT" :type "text" :name "flies" :value 12})
+                       (clj->js {:tagName "BAD INPUT" :name "asda" :value 12})
+                       (clj->js {:tagName "UNPUT" :name "afe" :value 12})
+                       (make-select "selected" :a [:a :b :c :d])
+                       (make-select "not-selected" nil [:a :b :c :d])]}))
+           {"bla" true, "ble" nil, "name" "mr blobby", "flies" 12, "selected" :a, "not-selected" nil}))))