bugfixes

Author: garbados

karma.conf.js

@@ -24,6 +24,8 @@ module.exports = function (config) {
     client: {
       args: ['shadow.test.karma.init'],
       singleRun: true
-    }
+    },
+    pingTimeout: 60000,
+    browserNoActivityTimeout: 1000 * 60 * 5 // minutes
   })
 }

src/witch_clock/calendar.cljs

@@ -86,6 +86,9 @@
 (def MINUTES-IN-HOUR 60)
 (def SECONDS-IN-MINUTE 60)
 
+(defn print-date [dt]
+  (.toLocaleString dt))
+
 (defn- get-seasons [year & {:keys [southern?]}]
   (let [js-seasons (astro/Seasons year)
         js-last-seasons (astro/Seasons (dec year))
@@ -125,6 +128,7 @@
 (defn- compare-dates [op dt1 dt2 & dts]
   (apply op (map #(.getTime %) (concat [dt1 dt2] dts))))
 (def is-before (partial compare-dates <))
+(def is-or-before (partial compare-dates <=))
 (def is-after (partial compare-dates >))
 (defn days-between [days dt1 dt2]
   (count
@@ -253,9 +257,9 @@
         "The Demise")
       conclusion]])))
 
-(defn get-day
+(defn get-date
   ([witchy-year]
-   (get-day witchy-year (new js/Date)))
+   (get-date witchy-year (new js/Date)))
   ([{:keys [months seasons days cycle-end nth-cycle]} dt]
    (cond
      (is-before dt (:dawn (first days)))
@@ -279,7 +283,7 @@
            (->> dawn-to-dawn
                 (filter
                  (fn [[_cycle-i [dawn _next-dawn]]]
-                   (is-before dawn dt)))
+                   (is-or-before dawn dt)))
                 (map
                  (fn [[cycle-i [_dawn _next-dawn]]]
                    [(inc cycle-i) [_dawn _next-dawn]]))
@@ -315,8 +319,8 @@
            (->> sorted-moon-phase-dt
                 (filter
                  (fn [[_month _phase phase-dt]]
-                   (is-before dawn phase-dt)))
-                last)
+                   (is-before phase-dt next-dawn)))
+                first)
            [_month _phase month-dt]
            (->> sorted-moon-phase-dt
                 (filter
@@ -330,7 +334,7 @@
                  (fn [[_month _phase other-phase-dt]]
                    (is-before phase-dt other-phase-dt)))
                 last)
-           phase-i (days-between dawns phase-dt dawn)
+           phase-i (days-between dawns phase-dt next-dawn)
            phase-n (days-between dawns phase-dt next-phase-dt)
            [next-month _next-phase next-month-dt]
            (if (not= month next-month*)
@@ -342,7 +346,7 @@
                       (is-before month-dt next-month-dt)
                       (not= month next-month))))
                   last))
-           month-i (days-between dawns month-dt dawn)
+           month-i (days-between dawns month-dt next-dawn)
            month-n (days-between dawns month-dt next-month-dt)]
        {:cycle [nth-cycle (inc cycle-i) cycle-n]
         :season [season season-dt (inc season-i) season-n]

src/witch_clock/web.cljs

@@ -57,7 +57,7 @@
   (refresh-seasons! year)
   (refresh-months! year)
   (when year
-    (reset! -date (calendar/get-day year))))
+    (reset! -date (calendar/get-date year))))
 
 (defn track-time! [-geo -year -date -time -time-timer]
   (when @-time-timer
@@ -73,7 +73,7 @@
                        witchy-year (calendar/from-gregorian-year year latitude longitude)]
                    (reset! -year witchy-year))
                  (calendar/is-before (-> @-date :day (nth 2)) now)
-                 (reset! -date (calendar/get-day @-year now))
+                 (reset! -date (calendar/get-date @-year now))
                  :else
                  (reset! -time (calendar/get-current-time @-date)))))
            (* 3 1000))))

test/witch_clock/core_test.cljs

@@ -1,36 +1,60 @@
 (ns witch-clock.core-test
   (:require
    [clojure.string :as string]
-   [clojure.test :refer [deftest is testing]]
+   [clojure.test :refer [is testing deftest]]
    [witch-clock.calendar :as calendar]))
 
 (deftest witch-clock-sanity-test
-  (testing "Works for one hundred years."
-    (doseq [[latitude longitude]
-            [[45.5761 -122.6881] ; north america
-             [25.2744 133.7751]  ; australia
-             ]]
-      (doseq [i (range 100)
-              :let [greg-year (+ calendar/FIRST-CYCLE-YEAR i -50)
-                    {:keys [nth-cycle months seasons conclusion cycle-end days]}
-                    (calendar/from-gregorian-year greg-year latitude longitude)]]
-        (is (number? nth-cycle))
-        (doseq [month calendar/MONTHS
-                :when (get months month)
-                :let [i (inc (.indexOf calendar/MONTHS month))
-                      next-month (nth calendar/MONTHS i nil)
-                      [new-moon waxing-moon full-moon waning-moon] (map :date (get months month))]]
-          (is (calendar/is-before new-moon waxing-moon full-moon waning-moon))
-          (if (get months next-month)
-            (let [next-new-moon (-> months next-month first :date)]
-              (is (calendar/is-before waning-moon next-new-moon)))
-            (is (calendar/is-before waning-moon cycle-end))))
-        (doseq [season calendar/SEASONS
-                :let [next-season (get calendar/NEXT-SEASON season)]]
-          (is (calendar/is-before (get seasons season) (get seasons next-season))))
-        (is (calendar/is-before conclusion cycle-end))
-        (doseq [[day next-day] (zipmap (drop-last 1 days) (drop 1 days))]
-          (is (calendar/is-before (:dawn day) (:dusk day) (:dawn next-day) (:dusk next-day))
-              (->> [(:dawn day) (:dusk day) (:dawn next-day) (:dusk next-day)]
-                   (map #(.toLocaleString %))
-                   (string/join ", "))))))))
+  (doseq [greg-year (map #(+ calendar/FIRST-CYCLE-YEAR % -5) (range 10))
+          [latitude longitude]
+          [[45.5761 -122.6881] ; north america
+           [25.2744 133.7751]  ; australia
+           ]]
+    (let [{:keys [nth-cycle months seasons conclusion cycle-end days]
+           :as witchy-year}
+          (calendar/from-gregorian-year greg-year latitude longitude)]
+      (println (str "Testing: " (string/join " ; " [greg-year latitude longitude])))
+      (is (number? nth-cycle))
+      (doseq [month calendar/MONTHS
+              :when (get months month)
+              :let [i (inc (.indexOf calendar/MONTHS month))
+                    next-month (nth calendar/MONTHS i nil)
+                    [new-moon waxing-moon full-moon waning-moon] (map :date (get months month))]]
+        (is (calendar/is-before new-moon waxing-moon full-moon waning-moon))
+        (if (get months next-month)
+          (let [next-new-moon (-> months next-month first :date)]
+            (is (calendar/is-before waning-moon next-new-moon)))
+          (is (calendar/is-before waning-moon cycle-end))))
+      (doseq [season calendar/SEASONS
+              :let [next-season (get calendar/NEXT-SEASON season)]]
+        (is (calendar/is-before (get seasons season) (get seasons next-season))))
+      (is (calendar/is-before conclusion cycle-end))
+      (doseq [[day next-day] (zipmap (drop-last 1 days) (drop 1 days))
+              :let [date (calendar/get-date witchy-year (:dawn day))
+                    next-date (calendar/get-date witchy-year (:dawn next-day))]]
+        (is (calendar/is-before (:dawn day) (:dusk day) (:dawn next-day) (:dusk next-day))
+            (->> [(:dawn day) (:dusk day) (:dawn next-day) (:dusk next-day)]
+                 (map #(.toLocaleString %))
+                 (string/join ", ")))
+        (is (apply calendar/is-or-before (concat (:day date) (:day next-date))))
+        (let [[month _month-dt month-i :as today-month] (:month date)
+              [tmrw-month _tmrw-month-dt tmrw-month-i :as tmrw-month*] (:month next-date)]
+          (if (= month tmrw-month)
+            (is (= (inc month-i) tmrw-month-i)
+                (str [today-month tmrw-month*]))
+            (is (= 1 tmrw-month-i)
+                (str tmrw-month*))))
+        (let [[phase _phase-dt phase-i :as today-phase] (:phase date)
+              [tmrw-phase _tmrw-phase-dt tmrw-phase-i :as tmrw-phase*] (:phase next-date)]
+          (if (= phase tmrw-phase)
+            (is (= (inc phase-i) tmrw-phase-i)
+                (str [today-phase tmrw-phase*]))
+            (is (= 1 tmrw-phase-i)
+                (str tmrw-phase*))))
+        (let [[season _season-dt season-i :as today-season] (:season date)
+              [tmrw-season _tmrw-season-dt tmrw-season-i :as tmrw-season*] (:season next-date)]
+          (if (= season tmrw-season)
+            (is (= (inc season-i) tmrw-season-i)
+                (str [today-season tmrw-season*]))
+            (is (= 1 tmrw-season-i)
+                (str tmrw-season*))))))))