Fix the tests with an ugly hack

Fix the tests with an ugly hack

--- test/mdr2/test/archive.clj
+++ test/mdr2/test/archive.clj
@@ -2,7 +2,10 @@
   (:use clojure.test
         mdr2.archive))

-(defn mock-jdbc-insert [db table job] job)
+(def mock-db (atom ()))
+
+(defn mock-jdbc-insert [db table job]
+  (reset! mock-db job))

 (deftest test-archiving
   (testing "container id"
@@ -18,7 +21,9 @@

   (testing "add master to db"
     (with-redefs [clojure.java.jdbc/insert! mock-jdbc-insert]
-      (is (= (add-to-db {:id 123})
+      (is (= (do
+               (add-to-db {:id 123})
+               @mock-db)
              {:verzeichnis "dam123",
               :sektion "master",
               :aktion "save",
@@ -29,9 +34,11 @@

   (testing "add iso to db"
     (with-redefs [clojure.java.jdbc/insert! mock-jdbc-insert]
-      (is (= (add-to-db {:id 123 :iso-path "foo"})
+      (is (= (do
+               (add-to-db {:id 123 :iso-path "foo"})
+               @mock-db)
              {:verzeichnis "ds123",
-              :sektion "master",
+              :sektion "cdimage",
               :aktion "save",
               :transaktions_status "pending",
               :abholer "NN",


CMR-669: Updated page_num and page_size tests to use new error handling.:

--- test/cmr/system_int_test/search/paging_search_test.clj
+++ test/cmr/system_int_test/search/paging_search_test.clj
@@ -30,13 +30,13 @@
     (let [limit (cfg/config-value :paging-depth-limit 1000000)
           page-size 10
           page-num (int (+ (/ limit page-size) 1))]
-      (let [res (search/find-refs :collection
-                                  {:page_size page-size
-                                   :page-num page-num})
-            status (:status res)
-            errors (:errors res)]
+      (let [resp (search/find-refs :collection
+                                   {:page_size page-size
+                                    :page-num page-num})
+            {:keys [status errors]} resp]
         (is (= 400 status))
-        (is (re-matches #"The paging depth \(page_num \* page_size\) of \[\d*?\] exceeds the limit of \d*?.*?" (first errors)))))))
+        (is (re-matches #"The paging depth \(page_num \* page_size\) of \[\d*?\] exceeds the limit of \d*?.*?"
+                        (first errors)))))))

 (deftest search-with-page-size
   (create-collections)
@@ -46,39 +46,21 @@
   (testing "Search with large page_size."
     (let [{:keys [refs]} (search/find-refs :collection {:page_size 100})]
       (is (= collection-count (count refs)))))
-  (testing "page_size less than one."
-    (try
-      (search/find-refs :collection {:page_size 0})
-      (catch clojure.lang.ExceptionInfo e
-        (let [status (get-in (ex-data e) [:object :status])
-              body (get-in (ex-data e) [:object :body])]
-          (is (= 400 status))
-          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
-  (testing "Negative page_size."
-    (try
-      (search/find-refs :collection {:page_size -1})
-      (catch clojure.lang.ExceptionInfo e
-        (println "OK>..........")
-        (let [status (get-in (ex-data e) [:object :status])
-              body (get-in (ex-data e) [:object :body])]
-          (is (= 400 status))
-          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
+  (testing "page_size less than zero."
+    (let [resp (search/find-refs :collection {:page_size -1})
+          {:keys [status errors]} resp]
+      (is (= 400 status))
+      (is (re-matches #".*page_size must be a number between 0 and 2000.*" (first errors)))))
   (testing "page_size too large."
-    (try
-      (search/find-refs :collection {:page_size 2001})
-      (catch clojure.lang.ExceptionInfo e
-        (let [status (get-in (ex-data e) [:object :status])
-              body (get-in (ex-data e) [:object :body])]
-          (is (= 400 status))
-          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
+    (let [resp (search/find-refs :collection {:page_size 2001})
+          {:keys [status errors]} resp]
+      (is (= 400 status))
+      (is (re-matches #".*page_size must be a number between 0 and 2000.*" (first errors)))))
   (testing "Non-numeric page_size"
-    (try
-      (search/find-refs :collection {:page_size "ABC"})
-      (catch clojure.lang.ExceptionInfo e
-        (let [status (get-in (ex-data e) [:object :status])
-              body (get-in (ex-data e) [:object :body])]
-          (is (= 400 status))
-          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body)))))))
+    (let [resp (search/find-refs :collection {:page_size "ABC"})
+          {:keys [status errors]} resp]
+      (is (= 400 status))
+      (is (re-matches #".*page_size must be a number between 0 and 2000.*" (first errors))))))

 (deftest search-for-hits
   (create-collections)
@@ -102,22 +84,18 @@
         (is (= (map :short-name [col5 col4 col3 col2 col1])
                (map :short-name refs)))))
     (testing "page_num less than one."
-      (try
-        (search/find-refs :collection {:provider "PROV1"
-                                       :page_size 5
-                                       :page_num 0})
-        (catch clojure.lang.ExceptionInfo e
-          (let [status (get-in (ex-data e) [:object :status])
-                body (get-in (ex-data e) [:object :body])]
-            (is (= 400 status))
-            (is (re-matches #".*page_num must be a number greater than or equal to 1.*" body))))))
+      (let [resp (search/find-refs :collection {:provider "PROV1"
+                                                :page_size 5
+                                                :page_num 0})
+            {:keys [status errors]} resp]
+        (is (= 400 status))
+        (is (re-matches #".*page_num must be a number greater than or equal to 1.*"
+                        (first errors)))))
     (testing "Non-numeric page_num."
-      (try
-        (search/find-refs :collection {:provider "PROV1"
-                                       :page_size 5
-                                       :page_num "ABC"})
-        (catch clojure.lang.ExceptionInfo e
-          (let [status (get-in (ex-data e) [:object :status])
-                body (get-in (ex-data e) [:object :body])]
-            (is (= 400 status))
-            (is (re-matches #".*page_num must be a number greater than or equal to 1.*" body))))))))
+      (let [resp (search/find-refs :collection {:provider "PROV1"
+                                                :page_size 5
+                                                :page_num "ABC"})
+            {:keys [status errors]} resp]
+        (is (= 400 status))
+        (is (re-matches #".*page_num must be a number greater than or equal to 1.*"
+                        (first errors)))))))


Test for function send-response

Test for function send-response

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -924,3 +924,17 @@
                      :headers {"Content-Type" "application/json"}
                      :body "{\"status\":\"error\",\"command\":\"running_jobs\",\"message\":\"Can not read Jenkins queue and\\/or selected view\"}"}))))))

+(deftest test-send-response
+    "Check the function emender-jenkins.rest-api/send-response."
+    (testing "the function emender-jenkins.rest-api/send-response."
+        (let [request       {:configuration {:jenkins {:currently-building-view "Building"
+                                                      :jenkins-url "http://10.20.30.40:8080/"}}}]
+             (is (= (send-response {:response :ok} request)
+                    {:status  200
+                     :headers {"Content-Type" "application/json"}
+                     :body    "{\"response\":\"ok\"}"}))
+             (is (= (send-response {:response {:deep {:structure :ok}}} request)
+                    {:status  200
+                     :headers {"Content-Type" "application/json"}
+                     :body    "{\"response\":{\"deep\":{\"structure\":\"ok\"}}}"})))))
+


Clean up ship info queries.

Clean up ship info queries.


Updated test so sort ordering is very explicit.

--- storm-core/test/clj/backtype/storm/cluster_test.clj
+++ storm-core/test/clj/backtype/storm/cluster_test.clj
@@ -208,8 +208,9 @@
       (let [state (mk-storm-state zk-port)]
         (.report-error state "a" "1"(local-hostname) 6700  (RuntimeException.))
         (validate-errors! state "a" "1" ["RuntimeException"])
+        (advance-time-secs! 1)
         (.report-error state "a" "1" (local-hostname) 6700 (IllegalArgumentException.))
-        (validate-errors! state "a" "1" ["RuntimeException" "IllegalArgumentException"])
+        (validate-errors! state "a" "1" ["IllegalArgumentException" "RuntimeException"])
         (doseq [i (range 10)]
           (.report-error state "a" "2" (local-hostname) 6700 (RuntimeException.))
           (advance-time-secs! 2))


Verify with deftest.

Verify with deftest.

--- test/onyx/coordinator/cluster_test.clj
+++ test/onyx/coordinator/cluster_test.clj
@@ -43,7 +43,7 @@

 (def workflow {:in {:inc :out}})

-(def n-jobs 10)
+(def n-jobs 5)

 (def n-peers 10)

@@ -91,14 +91,27 @@
     (let [db (:db-after (.take tx-queue))
           query '[:find (count ?task) :where [?task :task/complete? true]]
           result (ffirst (d/q query db))]
+      (prn result)
       (when-not (= result (* n-jobs tasks-per-job))
         (recur)))))

-(let [db (d/db (:conn log))]
+(def result-db (d/db (:conn log)))
+
+(deftest task-completeness
   (testing "No tasks are left incomplete"
     (let [query '[:find (count ?task) :where [?task :task/complete? false]]
-          result (ffirst (d/q query db))]
+          result (ffirst (d/q query result-db))]
       (is (nil? result)))))
+
+(deftest task-safety
+  (testing "No sequential task ever had more than 1 peer"
+    (let [query '[:find ?task (count ?peer) :where
+                  [?task :task/consumption :sequential]
+                  [?peer :peer/task ?task]]
+          result (map second (d/q query (d/history result-db)))]
+      (is (every? (partial = 1) result)))))

 (alter-var-root #'system component/stop)

+(run-tests 'onyx.coordinator.cluster-test)
+


Import missing var.

Import missing var.

--- test/onyx/plugin/input_resume_test.clj
+++ test/onyx/plugin/input_resume_test.clj
@@ -6,7 +6,7 @@
              [job :refer [add-task]]
              [test-helper :refer [with-test-env]]]
             [onyx.plugin kafka
-             [core-async :refer [take-segments!]]
+             [core-async :refer [take-segments! get-core-async-channels]]
              [test-utils :as test-utils]]
             [onyx.tasks.core-async :as core-async]
             [onyx.tasks.kafka :refer [kafka-input]]))


[#533] Added docs to user-management/delete-invite

--- backend/src/akvo/lumen/component/user_manager.clj
+++ backend/src/akvo/lumen/component/user_manager.clj
@@ -21,7 +21,12 @@
     "List active invites.")
   (delete-invite
     [this tenant-conn id]
-    "Deletes invite")
+    "Deletes non consumed invites, returns 210 if invite was consumed and
+     204 in any other case (both delete of actual invite or non existing).
+
+     We don't want to delete invites that was used. This since we store who
+     created the invite in the \"author\" db field, and this provides
+     traceability. Hence we don't allow deletion of consumed invite.")
   (tenant-invite-email
     [this server-name invite-id author-claims]
     "Constructs the tenant invite email body")
@@ -34,6 +39,7 @@
   (verify-invite
     [this tenant-conn tenant id]
     "Add user to tenant."))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Helper fns


Fix fixtures

Fix fixtures

--- test/servisne_info/features/common.clj
+++ test/servisne_info/features/common.clj
@@ -8,6 +8,5 @@
   (t))

 (defn fixtures-each [t]
-  (fn [t]
-    (mc/remove "users")
-    (t)))
+  (mc/remove "users")
+  (t))


Update content.cljs

Update content.cljs

changed in response to martin's comments. Also i changed dark blue to light blue since we switched hte colours around...

--- src/prais2/content.cljs
+++ src/prais2/content.cljs
@@ -29,11 +29,11 @@
          (Header. "Observed Survival Rate %"    false      true     86   50
                   "The percentage of operations where the child survived at least 30 days after their operation. Some hospitals specialise in certain conditions, meaning that some hospitals tend to operate on children with a lower chance of survival. It would be unfair to then expect all hospitals to have the same survival rates each year")
          (Header. "Outer Low"                   false      false   130   50
-                  "A dot within the right hand dark blue band means that there is some evidence that chances of survival in the hospital were higher than predicted")
+                  "A dot within the left hand light blue band means that there is some evidence that chances of survival in the hospital were lower than predicted")
          (Header. "Inner Low"                   false      false   130   50
                   "A dot in this area means that there is no evidence that the hospital’s survival rate is different from what is predicted")
          (Header. "Inner High"                  false      false   130   50
-                  "A dot within the right hand dark blue band means that there is some evidence that chances of survival in the hospital were higher than predicted")
+                  "A dot within the right hand light blue band means that there is some evidence that chances of survival in the hospital were higher than predicted")
          (Header. "Outer High"                  false      false   130   50
                   nil)
          (Header. "Observed survival with predicted range"  false      false   0   100
@@ -231,11 +231,11 @@
 ;;;

 (def bar-comments
-  {:inner "A dot in this area means that there is no evidence that the hospital’s survival rate is different from what is predicted"
-   :outer-high "A dot in this area means that there is some evidence that chances of survival in the hospital were higher than predicted"; " [add link]"
-   :outer-low "A dot in this area means that there is some evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
-   :low "A dot to the left of the bands means that there is strong evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
-   :high "A dot to the right of the bands means that there is strong evidence that chances of survival in the hospital were higher than predicted."; " [add link]"
+  {:inner "If the black dot is in this area then there is no evidence that the hospital’s survival rate is different from what is predicted"
+   :outer-high "If the black dot is in this area then there is some evidence that chances of survival in the hospital were higher than predicted"; " [add link]"
+   :outer-low "If the black dot is in this area then there is some evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
+   :low "If the black dot is in this area then there is strong evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
+   :high "If the black dot is in this area then there is strong evidence that chances of survival in the hospital were higher than predicted."; " [add link]"
    })

 ;;;
@@ -244,8 +244,8 @@
 ;;;

 (def dot-comments
-  {:inner "There is no evidence that the hospital’s survival rate is different from what is predicted"
-   :outer-high "There is some evidence that chances of survival in the hospital were higher than predicted"; " [add link]"
+  {:inner "There is no evidence that chances of survival in the hospital are different from predicted."
+   :outer-high "There is some evidence that chances of survival in the hospital were higher than predicted."; " [add link]"
    :outer-low "There is some evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
    :low "There is strong evidence that chances of survival in the hospital were lower than predicted."; " [add link]"
    :high "There is strong evidence that chances of survival in the hospital were higher than predicted."; " [add link]"


Don't rely on autoboxing.

Don't rely on autoboxing.

--- test/clojure_the_language/clojure_numerics_test.clj
+++ test/clojure_the_language/clojure_numerics_test.clj
@@ -126,7 +126,11 @@

 (fact "All types of integer are usefully comparable using `=`"
   ;; From /Clojure Programming/ with adjustments
-  (= 2 2N (Integer. 2) (short 2) (Short. (short 2)) (byte 2) (Byte. (byte 2)))
+  (= (Byte. (byte 2))
+     (Short. (short 2))
+     (Integer. 2)
+     2
+     2N)
   => true)

 (fact "Ratios are usefully comparable using `=`"
@@ -235,8 +239,8 @@
 ;;;; ---------------------------------------------------------------------------

 (fact "Collections use `=` to determine equality"
-  (into #{} [(byte 2)
-             (short 2)
+  (into #{} [(Byte. (byte 2))
+             (Short. (short 2))
              (Integer. 2)
              2
              2N
@@ -261,8 +265,8 @@
 ;;;   address the need for type-insensitive equivalence tests.

 (fact "Numbers with an equivalent value are equal using `==`"
-  (== (byte 2)
-      (short 2)
+  (== (Byte. (byte 2))
+      (Short. (short 2))
       (Integer. 2)
       2
       2N


Delete users.clj

Delete users.clj


CMR-3797: Corrected an issue in the the freeze time fixture.

--- system-int-test/src/cmr/system_int_test/utils/search_util.clj
+++ system-int-test/src/cmr/system_int_test/utils/search_util.clj
@@ -14,6 +14,7 @@
     [cmr.common-app.test.side-api :as side]
     [cmr.common.concepts :as cs]
     [cmr.common.mime-types :as mime-types]
+    [cmr.common.test.time-util :as tu]
     [cmr.common.time-keeper :as tk]
     [cmr.common.util :as util]
     [cmr.common.xml :as cx]
@@ -636,14 +637,20 @@
      (:body response)
      response)))

+(def now-n
+  "The N value for the current time. Uses N values for date times as describd in
+  cmr.common.test.time-util. Need to use this common now-n to lock both the current time
+  in test and on CMR side."
+  10)
+
 (defn freeze-resume-time-fixture
   []
   (fn [f]
     (try
       ;; Freeze time in test
-      (tk/set-time-override! (tk/now))
+      (tk/set-time-override! (tu/n->date-time now-n))
       ;; Freeze time on CMR side
-      (side/eval-form `(tk/set-time-override! (tk/now)))
+      (side/eval-form `(tk/set-time-override! (tu/n->date-time now-n)))
       (f)
       (finally
         ;; Resume time in test


Fix some more whitespacing

Fix some more whitespacing

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -230,10 +230,10 @@
                      (when show-modal?
                        (om/build beta-terms-modal {:close-fn #(om/set-state! owner :show-modal? false)}))
                      [:p "We invite you to join Inner Circle, our new
-                           beta program. As a member of CircleCI’s
-                           Inner Circle you get exclusive access to
-                           new features and settings before they are
-                           released publicly!"]
+                          beta program. As a member of CircleCI’s
+                          Inner Circle you get exclusive access to new
+                          features and settings before they are
+                          released publicly!"]
                      (button/button
                       {:on-click #(do
                                     (om/set-state! owner :show-modal? true)


Remove icons from sidebar

Remove icons from sidebar

--- src-cljs/tamarack/components/sidebar.cljs
+++ src-cljs/tamarack/components/sidebar.cljs
@@ -6,9 +6,9 @@
   (html
    [:ol
     [:li.active
-     [:a {:href "#"} [:i.fa.fa-cubes] "Applications"]]
+     [:a {:href "#"} "Applications"]]
     [:li
-     [:a {:href "#"} [:i.fa.fa-group] "Teams"]]]))
+     [:a {:href "#"} "Teams"]]]))

 (defn component [app owner]
   (reify


fixed a bug in get-card resulting in not getting :runner :scored cards correctly

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -232,7 +232,10 @@
       (if host
         (get-card-hosted state card)
         (some #(when (= cid (:cid %)) %)
-              (get-in @state (cons (to-keyword side) (map to-keyword zone)))))
+              (let [zones (map to-keyword zone)]
+                (if (= (first zones) :scored)
+                  (into (get-in @state [:corp :scored]) (get-in @state [:runner :scored]))
+                  (get-in @state (cons (to-keyword side) zones))))))
       card)))

 (defn update! [state side {:keys [type zone cid host] :as card}]


multi access fix

multi access fix

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -304,7 +304,7 @@
   (update! state side (apply assoc (cons card args))))

 (defn resolve-prompt [state side {:keys [choice card] :as args}]
-  (let [prompt (get-in @state [side :prompt 0])
+  (let [prompt (first (get-in @state [side :prompt]))
         choice (if (= (:choices prompt) :credit)
                  (min choice (get-in @state [side :credit]))
                  choice)]
@@ -321,7 +321,7 @@
       (swap! state dissoc :access))))

 (defn trash-no-cost [state side]
-  (when-let [card (:card (get-in @state [side :prompt 0]))]
+  (when-let [card (:card (first (get-in @state [side :prompt])))]
     (trash state side card)
     (swap! state update-in [side :prompt] rest)
     (when-let [run (:run @state)]
@@ -485,7 +485,7 @@
         (swap! state update-in [:corp :register :scored-agenda] #(+ (or % 0) (:agendapoints c)))
         (gain-agenda-point state :corp (:agendapoints c))
         (set-prop state :corp c :advance-counter 0)
-        (when-let [current (get-in @state [:runner :current 0])]
+        (when-let [current (first (get-in @state [:runner :current]))]
           (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
           (trash state side current))
         (trigger-event state :corp :agenda-scored (assoc c :advance-counter 0))))))
@@ -498,7 +498,7 @@
     (swap! state update-in [:runner :register :stole-agenda] #(+ (or % 0) (:agendapoints c)))
     (gain-agenda-point state :runner (:agendapoints c))
     (set-prop state :runner c :advance-counter 0)
-    (when-let [current (get-in @state [:corp :current 0])]
+    (when-let [current (first (get-in @state [:corp :current]))]
       (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
       (trash state side current))
     (trigger-event state :runner :agenda-stolen c)))
@@ -623,7 +623,7 @@
         (do-access state side server)))))

 (defn end-run [state side]
-  (let [server (get-in @state [:run :server 0])]
+  (let [server (first (get-in @state [:run :server]))]
     (swap! state update-in [:runner :register :unsuccessful-run] #(conj % server))
     (swap! state assoc-in [:run :unsuccessful] true)
     (trigger-event state side :unsuccessful-run)
@@ -703,12 +703,12 @@
            (resolve-ability state side cdef card nil)
            (if (has? c :subtype "Current")
              (do (doseq [s [:corp :runner]]
-                   (when-let [current (get-in @state [s :current 0])]
+                   (when-let [current (first (get-in @state [s :current]))]
                      (say state side {:user "__system__" :text (str (:title current) " is trashed.")})
                      (trash state side current)))
-                 (let [moved-card (move state side (get-in @state [side :play-area 0]) :current)]
+                 (let [moved-card (move state side (first (get-in @state [side :play-area])) :current)]
                    (card-init state side moved-card)))
-             (move state side (get-in @state [side :play-area 0]) :discard)))))))
+             (move state side (first (get-in @state [side :play-area])) :discard)))))))

 (defn in-play? [state card]
   (let [dest (when (= (:side card) "Runner")


Parametrize popover-border-color

Parametrize popover-border-color

--- src/re_com/popover.cljs
+++ src/re_com/popover.cljs
@@ -101,7 +101,7 @@

 (defn- popover-arrow
   "Render the triangle which connects the popover to the anchor (using SVG)"
-  [orientation pop-offset arrow-length arrow-width grey-arrow? no-border? popover-color]
+  [orientation pop-offset arrow-length arrow-width grey-arrow? no-border? popover-color popover-border-color]
   (let [half-arrow-width (/ arrow-width 2)
         arrow-shape {:left  (str (point 0 0)            (point arrow-length half-arrow-width) (point 0 arrow-width))
                      :right (str (point arrow-length 0) (point 0 half-arrow-width)            (point arrow-length arrow-width))
@@ -134,7 +134,7 @@
                  :style {:fill (if popover-color
                                  popover-color
                                  (if grey-arrow? "#f7f7f7" "white"))
-                         :stroke (when-not no-border? "rgba(0, 0, 0, .2)")
+                         :stroke (or popover-border-color (when-not no-border? "rgba(0, 0, 0, .2)"))
                          :stroke-width "1"}}]]))

@@ -236,7 +236,8 @@
    {:name :margin-left     :required false                       :type "string"           :validate-fn string?           :description "a CSS style describing the horiztonal offset from anchor after position"}
    {:name :margin-top      :required false                       :type "string"           :validate-fn string?           :description "a CSS style describing the vertical offset from anchor after position"}
    {:name :tooltip-style?  :required false :default false        :type "boolean"                                         :description "setup popover styles for a tooltip"}
-   {:name :title           :required false                       :type "string | markup"                                 :description "describes a title"}])
+   {:name :title           :required false                       :type "string | markup"                                 :description "describes a title"}
+   {:name :popover-border-color :required false                  :type "string"           :validate-fn string?           :description "color of the popover arrow stroke"}])

 (defn popover-border
   "Renders an element or control along with a Bootstrap popover"
@@ -277,7 +278,7 @@

        :reagent-render
        (fn
-         [& {:keys [children position position-offset width height popover-color arrow-length arrow-width arrow-gap padding margin-left margin-top tooltip-style? title]
+         [& {:keys [children position position-offset width height popover-color popover-border-color arrow-length arrow-width arrow-gap padding margin-left margin-top tooltip-style? title]
              :or {arrow-length 11 arrow-width 22 arrow-gap -1}
              :as args}]
          {:pre [(validate-args-macro popover-border-args-desc args "popover-border")]}
@@ -313,7 +314,7 @@
                             :opacity   (if @ready-to-show? "1" "0")
                             :max-width "none"
                             :padding   "0px"})}
-            [popover-arrow orientation @pop-offset arrow-length arrow-width grey-arrow? tooltip-style? popover-color]
+            [popover-arrow orientation @pop-offset arrow-length arrow-width grey-arrow? tooltip-style? popover-color popover-border-color]
             (when title title)
             (into [:div.popover-content {:style {:padding padding}}] children)]))})))

@@ -336,6 +337,7 @@
    {:name :body              :required false                        :type "string | hiccup"  :validate-fn string-or-hiccup? :description "describes the popover body. Must be a single component"}
    {:name :tooltip-style?    :required false  :default false        :type "boolean"                                         :description "setup popover styles for a tooltip"}
    {:name :popover-color     :required false  :default "white"      :type "string"           :validate-fn string?           :description "fill color of the popover"}
+   {:name :popover-border-color :required false                     :type "string"           :validate-fn string?           :description "color of the popover arrow stroke"}
    {:name :arrow-length      :required false  :default 11           :type "integer | string" :validate-fn number-or-string? :description "the length in pixels of the arrow (from pointy part to middle of arrow base)"}
    {:name :arrow-width       :required false  :default 22           :type "integer | string" :validate-fn number-or-string? :description "the width in pixels of arrow base"}
    {:name :arrow-gap         :required false  :default -1           :type "integer"          :validate-fn number?           :description "px gap between the anchor and the arrow tip. Positive numbers push the popover away from the anchor"}
@@ -372,7 +374,7 @@
        :reagent-render
        (fn
          [& {:keys [showing-injected? position-injected position-offset no-clip? width height backdrop-opacity on-cancel title
-                    close-button? body tooltip-style? popover-color arrow-length arrow-width arrow-gap padding class style attr]
+                    close-button? body tooltip-style? popover-color popover-border-color arrow-length arrow-width arrow-gap padding class style attr]
              :or {arrow-length 11 arrow-width 22 arrow-gap -1}
              :as args}]
          {:pre [(validate-args-macro popover-content-wrapper-args-desc args "popover-content-wrapper")]}
@@ -397,6 +399,7 @@
            :height          height
            :tooltip-style?  tooltip-style?
            :popover-color   popover-color
+           :popover-border-color popover-border-color
            :arrow-length    arrow-length
            :arrow-width     arrow-width
            :arrow-gap       arrow-gap


CMR-2920 respond to comments

CMR-2920 respond to comments

--- mock-echo-app/src/cmr/mock_echo/api/urs.clj
+++ mock-echo-app/src/cmr/mock_echo/api/urs.clj
@@ -100,7 +100,6 @@
 (defn login-xml
   "Processes a login request"
   [context body]
-  (println "XML BODY = " body)
   (let [{:keys [username password]} (parse-login-request body)]
     (if (and (urs-db/user-exists? context username)
              (urs-db/password-matches? context username password))
@@ -142,9 +141,7 @@
       ;; echo kernel adds a / for some reason to the request it sends...
       (POST "/login/" {:keys [request-context body content-type] :as request}
         (assert-urs-basic-auth-info request)
-        (case content-type
-          "application/x-www-form-urlencoded" (login-form request-context (slurp body))
-          (login-xml request-context (slurp body))))
+        (login-xml request-context (slurp body)))

       (context "/groups/:group" [group]
         (context "/:username" [username]
@@ -157,21 +154,18 @@
         ;; This is used for adding test data. Body should be a list of
         ;; maps with username, password, and other URS user fields
         (POST "/" {context :request-context body :body content-type :content-type}
-          (case content-type
-            ;; Not sure why, but I cant use mt/xml here in place of the string
-            "application/xml" (create-users-xml context (slurp body))
+          (if (= mt/xml content-type)
+            (create-users-xml context (slurp body))
             (create-users-json context (slurp body))))

         (PUT "/:username" {context :request-context body :body content-type :content-type}
-          (case content-type
-            ;; Not sure why, but I cant use mt/xml here in place of the string
-            "application/xml" (create-users-xml context (slurp body))
+          (if (= mt/xml content-type)
+            (create-users-xml context (slurp body))
             (create-users-json context (slurp body))))

         (context "/:username" [username]
           (GET "/" {:keys [request-context] :as request}
             (assert-urs-basic-auth-info request)
-            (println "returning user " (get-user request-context username))
             (get-user request-context username))))

       (context "/oauth" []


Remove unused import

Remove unused import

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -1,7 +1,6 @@
 (ns ^:figwheel-always discuss.core
   "Entrypoint to this application. Loads all requirements, and bootstraps the application."
   (:require [om.core :as om :include-macros true]
-            [discuss.auth :as auth]
             [discuss.communication :as com]
             [discuss.debug :as debug]
             [discuss.references.integration]


Force om to use latest reactjs

Force om to use latest reactjs

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -2,6 +2,8 @@
   "Entrypoint to this application. Loads all requirements, and bootstraps the application."
   (:require [om.next :as om]
             [goog.dom :as gdom]
+            [react :as react]
+            [create-react-class :as create-react-class]
             [discuss.communication.lib :as comlib]
             [discuss.config :as config]
             [discuss.parser :as parser]
@@ -11,6 +13,8 @@
             [discuss.views :as views]
             [discuss.communication.connectivity :as comcon]))

+;; this is to support om with the latest version of React
+(set! (.-createClass react) create-react-class)

 ;; Initialization
 (defn ^:export main []


(TK-337) Fix race in timeout test

(TK-337) Fix race in timeout test

Previously, our status callback timeout test had a race condition
that caused it to almost always fail in Travis. This was due to
the test relying on an InterruptedException being thrown when
the status callback timed out and had its future cancelled.
However, due to the way Java was scheduling threads, that
was not always being thrown, so the assertion would frequently
fail.

This commit removes the frequently-failing test assertion, and
replaces it with a new assertion that tests the error message
that will be logged by the `with-timeout` macro, rather than
the one that should be logged if the timeout thread gets
interrupted.

--- test/puppetlabs/trapperkeeper/services/status/status_core_test.clj
+++ test/puppetlabs/trapperkeeper/services/status/status_core_test.clj
@@ -73,13 +73,15 @@
             (is (= :unknown (:state result))))))

       (testing "and it is from a timeout"
-        (update-status-context status-fns "quux" "1.1.0" 1 (fn [_] (Thread/sleep 2000) {:state :running
-                                                                                :status "aw yis"}))
+        ; Add a status function that will block indefinitely to ensure we will always
+        ; timeout
+        (update-status-context status-fns "quux" "1.1.0" 1 (fn [_] (deref (promise)) {:state :running
+                                                                                :status "aw yis"}))
         (with-redefs [puppetlabs.trapperkeeper.services.status.status-core/check-timeout (constantly 1)]
           (with-test-logging
             (let [result (call-status-fn-for-service "quux" (get @status-fns "quux") :debug)]
               (is (logged? #"Status callback timed out" :error))
-              (is (logged? #"Status callback interrupted" :error))
+              (is (logged? #"CancellationException"))
               (testing "state is set properly"
                 (is (= :unknown (:state result))))
               (testing "status is set to explain timeout"


test positions should have names

test positions should have names

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@5825 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
+++ sandbox/AcquisitionEngine/src/main/java/main/sequence_generator.clj
@@ -95,15 +95,14 @@

 (def test-settings
   (struct-map acq-settings
-    :frames (range 100) :positions [{:x 1 :y 2} {:x 4 :y 5}]
+    :frames (range 100) :positions [{:name "a" :x 1 :y 2} {:name "b" :x 4 :y 5}]
     :channels my-channels :slices (range 5)
     :interval 5 :slices-first false
     :keep-shutter-open-slices false :keep-shutter-open-channels true
     :use-autofocus true :autofocus-skip 3 :relative-slices true :exposure 100
     :interval-ms 1000))

-(def test-output (->  (make-cs-loop test-acq)
-                      (make-fp-loop test-acq)
+(def test-output (->  (make-main-loops test-acq)
                       (process-skip-z-stack test-acq)
                       (manage-shutter test-acq)
                       (process-use-autofocus test-acq)))


Add missing license header on stream ns.

--- src/futura/stream.clj
+++ src/futura/stream.clj
@@ -1,3 +1,27 @@
+;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
 (ns futura.stream
   (:require [clojure.core.async :as async]
             [clojure.core.async.impl.protocols :as asyncp]


document the parse function

document the parse function

--- src/tick/alpha/api.cljc
+++ src/tick/alpha/api.cljc
@@ -175,7 +175,17 @@

 ;; Parsing

-(def parse core/parse)
+(def ^{:doc "Do not use this function if you know the expected format of the string
+that you want to parse. This is partly because for example t/instant, t/date etc  will
+be much faster, but also because if the string you pass it is not in the format you
+expect, this function may still convert it into some entity that you weren't expecting.
+
+If you have a string in a non-standard format, use a formatter and the parse fn of they entity you want.
+
+For example:
+
+(cljc.java-time.local-date/parse \"20200202\" (t/formatter \"yyyyMMdd\"))
+"} parse core/parse)

 ;; Arithmetic


Move src/resource/assets where they belong

--- build.boot
+++ build.boot
@@ -2,7 +2,8 @@

 (set-env!
  :target-path "target/dev"
- :source-paths #{"sass" "src" "resources"}
+ :source-paths #{"sass" "src"}
+ :resource-paths #{"resources"}
  :asset-paths #{"assets"}
  :dependencies
  '[[io.dominic/boot-cljs "1.7.228-3" :scope "test"]
@@ -58,7 +59,9 @@
   "Develop the server backend"
   []
   (let [p (pod/make-pod
-           {:dependencies (concat server-deps
+           {:source-paths #{"src"}
+            :resource-paths #{"resources"}
+            :dependencies (concat server-deps
                                   @@(resolve 'boot.repl/*default-dependencies*))
             :directories #{"src" "resources" "dev"}
             :middleware @@(resolve 'boot.repl/*default-middleware*)})]


Update deps

Update deps

--- build.boot
+++ build.boot
@@ -13,8 +13,10 @@
                   [weasel                 "0.7.0"      :scope "test"]
                   [org.clojure/tools.nrepl "0.2.12"    :scope "test"]
                   [adzerk/boot-reload     "0.4.2"      :scope "test"]
-                  [adzerk/boot-test       "1.0.6"      :scope "test"]
-                  [deraen/boot-less       "0.4.2"      :scope "test"]
+                  [adzerk/boot-test       "1.0.7"      :scope "test"]
+                  [deraen/boot-less       "0.4.4"      :scope "test"]
+                  ;; For boot-less
+                  [org.slf4j/slf4j-nop    "1.7.13"     :scope "test"]
                   [deraen/boot-sass       "0.1.1"      :scope "test"]
                   [deraen/boot-ctn        "0.1.0"      :scope "test"]


force compilation of ExceptionInfo to happen before every other namespace


Check if elasticsearch is enabled with fn, not var

Need to delay the check until runtime, since the config state isn't
loaded when the file is initially required

--- src/braid/server/search/elasticsearch.clj
+++ src/braid/server/search/elasticsearch.clj
@@ -5,9 +5,8 @@
     [clojure.data.json :as json]
     [org.httpkit.client :as http]))

-(def elasticsearch-enabled? (some? (config :elasticsearch-url)))
-
-(defn tee [x] (println x) x)
+(defn elasticsearch-enabled? []
+  (some? (config :elasticsearch-url)))

 (defn search-for
   [{:keys [text group-id user-id]}]


reduce references into rebel-readline and use new top level fns

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -197,39 +197,20 @@
   (let [prompt (:prompt (:repl-opts figwheel-env))
         prompt-fn' (fn [] (with-out-str (prompt)))]
     (cond (and
-           (require? 'rebel-readline.core)
-           (require? 'rebel-readline-cljs.service)
-           (require? 'rebel-readline-cljs.core)
-           (resolve 'rebel-readline.core/line-reader)
-           (resolve 'rebel-readline-cljs.service/create)
-           (resolve 'rebel-readline-cljs.core/cljs-repl-read))
-          (let [line-reader    (resolve 'rebel-readline.core/line-reader)
-                help-message    (resolve 'rebel-readline.core/help-message)
-                line-reader-command (resolve 'rebel-readline.commands/command)
-                line-reader-command-doc (resolve 'rebel-readline.commands/command-doc)
-                docs (resolve 'figwheel-sidecar.system/repl-function-docs)
-                cljs-service   (resolve 'rebel-readline-cljs.service/create)
-                cljs-repl-read (resolve 'rebel-readline-cljs.core/cljs-repl-read)
-                cljs-repl-print (resolve 'rebel-readline-cljs.core/cljs-repl-print)]
-            (when (and line-reader-command line-reader-command-doc docs
-                       @line-reader-command @line-reader-command-doc @docs)
-              (defmethod @line-reader-command :repl/help-figwheel [_]
-                (println @docs))
-              (defmethod @line-reader-command-doc :repl/help-figwheel [_]
-                "Displays the help docs for the Figwheel REPL"))
-            (when help-message (println (help-message)))
+           (require? 'rebel-readline-cljs.repl)
+           (require? 'rebel-readline.commands)
+           (resolve 'rebel-readline-cljs.repl/cljs-repl*)
+           (resolve 'rebel-readline.commands/add-command))
+          (let [rebel-cljs-repl* (resolve 'rebel-readline-cljs.repl/cljs-repl*)
+                add-command      (resolve 'rebel-readline.commands/add-command)
+                docs             (resolve 'figwheel-sidecar.system/repl-function-docs)]
+            (when (and add-command docs @add-command @docs)
+              (add-command
+               :repl/help-figwheel
+               #(println @docs)
+               "Displays the help docs for the Figwheel REPL"))
             (try
-              (let [line-reader'
-                    (line-reader
-                     (cljs-service {:repl-env figwheel-env
-                                    :prompt prompt-fn'}))]
-                (cljs.repl/repl*
-                 figwheel-env
-                 (assoc
-                  (:repl-opts figwheel-env)
-                  :read (cljs-repl-read line-reader')
-                  :prompt (fn [])
-                  :print (cljs-repl-print line-reader'))))
+              (rebel-cljs-repl* figwheel-env (:repl-opts figwheel-env))
               (catch clojure.lang.ExceptionInfo e
                 (if (-> e ex-data :type (= :rebel-readline.line-reader/bad-terminal))
                   (do (println (.getMessage e))


s/fo/morph/

s/fo/morph/

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -3,7 +3,7 @@
   (:require [babel.directory :refer [models]]
             [babel.english :refer [analyze fo-ps generate generate-all medium morph parse sentences]]
             [babel.english.grammar :as grammar]
-            [babel.english.morphology :refer [fo get-string]]
+            [babel.english.morphology :refer [get-string]]

             [babel.generate :refer [get-lexemes lightning-bolts not-fail?]]

@@ -55,7 +55,7 @@
                             :english "Antonio",
                             :cat :noun,
                             :pronoun false}}}]
-    (is (= (fo form)
+    (is (= (morph form)
            "is Antonio"))))

 (deftest generate-irregular-present-2
@@ -78,7 +78,7 @@
                                   :2plur "are",
                                   :3sing "is",
                                   :2sing "are"}}}]
-    (is (= (fo form)
+    (is (= (morph form)
            "is"))))

 (deftest generate-irregular-present-3
@@ -106,7 +106,7 @@
                                   :number :sing},
                             :cat :noun,
                             :english "Juan"}}}]
-    (is (= (fo form)
+    (is (= (morph form)
            "is Juan"))))

 (deftest generate-irregular-imperfect
@@ -123,7 +123,7 @@
                    :agr {:person :2nd, :gender
                          :fem, :number
                          :plur}}}}]
-    (let [surface-form (fo form)]
+    (let [surface-form (morph form)]
       (is (or (= surface-form
                  "you all were going downstairs")
               (= surface-form
@@ -189,9 +189,9 @@
                    (repeatedly #(let [expression (generate {:modified false
                                                             :synsem {:cat :verb
                                                                      :sem {:pred :be-called}}})]
-                                  (is (not (= "" (fo expression))))
+                                  (is (not (= "" (morph expression))))
                                   (log/info (display-expression expression))
-                                  (fo expression)))))))))
+                                  (morph expression)))))))))

 (deftest mod-is-empty-list
   (let [result (generate {:modified false
@@ -205,7 +205,7 @@

 (deftest her-name-is-luisa
   (is (= "her name is Luisa"
-         (fo (generate {:modified false
+         (morph (generate {:modified false
                         :synsem {:cat :verb
                                  :sem {:mod '()
                                        :iobj {:pred :luisa}
@@ -233,7 +233,7 @@
                                          :of {:pred :Juana}}
                                   :pred :dog}}})]
     (is (not (nil? result)))
-    (is (= "Juana's dog" (fo result)))))
+    (is (= "Juana's dog" (morph result)))))

 (deftest generate-with-possessive-2
   (let [result
@@ -245,7 +245,7 @@
                                   :pred :dog}
                             :subcat '()}})]
     (is (not (nil? result)))
-    (is (= "Juana's red dog" (fo result)))))
+    (is (= "Juana's red dog" (morph result)))))

 (deftest no-failed-bolts
   (let [result
@@ -257,7 +257,7 @@
                               :synsem {:sem {:pred :wash
                                              :mod nil
                                              :reflexive true}}})]
-                        {:f (fo generated :from-language "it")
+                        {:f (morph generated :from-language "it")
                          :sem (get-in generated [:synsem :sem :mod])}))
          (take 5))]
     (= (count result) 5)))
@@ -271,7 +271,7 @@
                                              :number :sing
                                              :spec {:def :def
                                                     :pred :definite}}}}})]
-    (is (= (fo expr)
+    (is (= (morph expr)
            "in front of the table"))))

 (deftest furniture-sentence
@@ -293,7 +293,7 @@
     (log/info (str "furniture-sentence: "
                    (display-expression expr)))

-    (is (= (fo expr)
+    (is (= (morph expr)
            "the chair is in front of the table"))))

 (deftest reflexive-furniture-sentence
@@ -309,7 +309,7 @@
                                                      :pred :definite}}}
                                  :subcat '()}})]
     (log/info (str "reflexive furniture expression:" (display-expression expr)))
-    (is (= (fo expr)
+    (is (= (morph expr)
            "the chair is in front of itself"))))

 (deftest infinitive-vp
@@ -325,7 +325,7 @@
     (is true)))

 (deftest past-and-gender-agreement
-  (= (fo (generate {:synsem {:sem {:pred :go
+  (= (morph (generate {:synsem {:sem {:pred :go
                                    :aspect :perfect
                                    :tense :present
                                    :subj {:gender :fem
@@ -333,7 +333,7 @@
      "they (♀) went"))

 (deftest noun-number-agreement
-  (= (fo (generate {:synsem {:agr {:number :plur}
+  (= (morph (generate {:synsem {:agr {:number :plur}
                              :cat :noun
                              :sem {:pred :cat :spec {:def :def}
                                    :mod '()}}}))
@@ -555,8 +555,8 @@

 (deftest benchmark-test []
   (let [med (medium)
-        to-run #(time (println (fo (generate
-                                    {:synsem {:cat :verb, :sem {:pred :read
-                                                                :subj {:pred :woman}}
-                                              :subcat '()}}))))]
+        to-run #(time (println (morph (generate
+                                       {:synsem {:cat :verb, :sem {:pred :read
+                                                                   :subj {:pred :woman}}
+                                                 :subcat '()}}))))]
     (is (= 1 (count (take 1 (repeatedly to-run)))))))


Tidy docs

Tidy docs

--- test/compound/docs.cljc
+++ test/compound/docs.cljc
@@ -517,7 +517,7 @@
      :quantity 4}})

-[[:chapter {:title "Miscellaneous addenda"}]]
+[[:chapter {:title "Miscellaneous"}]]

 [[:section {:title "Diffing"}]]

@@ -535,15 +535,17 @@
                    (c/add-items [{:id 1 :name "bananas" :category "Long fruit"}
                                  {:id 2 :name "grapes" :category "Small round fruit"}
                                  {:id 3 :name "tomatoes" :category "Pretend fruit"}]))]
-    (c/diff source target) => {:add
-                               #{{:id 5, :name "blueberries", :category "Blue fruit"}
-                                 {:id 4, :name "strawberries", :category "Red fruit"}},
-                               :modify
-                               #{{:source {:id 2, :name "grapes", :category "New fruit"},
-                                  :target {:id 2, :name "grapes", :category "Small round fruit"}}
-                                 {:source {:id 1, :name "bananas", :category "Old fruit"},
-                                  :target {:id 1, :name "bananas", :category "Long fruit"}}},
-                               :remove #{{:id 3, :name "tomatoes", :category "Pretend fruit"}}}
+    (c/diff source target) =>
+
+    {:add
+     #{{:id 5, :name "blueberries", :category "Blue fruit"}
+       {:id 4, :name "strawberries", :category "Red fruit"}},
+     :modify
+     #{{:source {:id 2, :name "grapes", :category "New fruit"},
+        :target {:id 2, :name "grapes", :category "Small round fruit"}}
+       {:source {:id 1, :name "bananas", :category "Old fruit"},
+        :target {:id 1, :name "bananas", :category "Long fruit"}}},
+     :remove #{{:id 3, :name "tomatoes", :category "Pretend fruit"}}}

     (c/apply-diff target {:add
                           #{{:id 5, :name "blueberries", :category "Blue fruit"}
@@ -553,7 +555,8 @@
                              :target {:id 2, :name "grapes", :category "Small round fruit"}}
                             {:source {:id 1, :name "bananas", :category "Old fruit"},
                              :target {:id 1, :name "bananas", :category "Long fruit"}}},
-                          :remove #{{:id 3, :name "tomatoes", :category "Pretend fruit"}}}) => source))
+                          :remove #{{:id 3, :name "tomatoes", :category "Pretend fruit"}}}) =>
+    source))

 (comment


use immutable data with ids for lesson4

use immutable data with ids for lesson4

Removes redundant calls and prevents us from
pushing up the data on every tick


remove clj-ext.clj - no need

remove clj-ext.clj - no need

--- src/clojure/com/mobileink/xsl/clj-ext.clj
+++ src/clojure/com/mobileink/xsl/clj-ext.clj
@@ -1,6 +0,0 @@
-(ns org.mobileink.xsl.clj-ext)
-
-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))


Fix storage tests.

Fix storage tests.

--- test/storages/tests.clj
+++ test/storages/tests.clj
@@ -1,8 +1,8 @@
 (ns storages.tests
   (:require [clojure.test :as t]
             [storages.core :as st]
-            [storages.fs :as fs]
-            [storages.misc :as misc])
+            [storages.fs.local :as fs]
+            [storages.fs.misc :as misc])
   (:import java.io.File
            org.apache.commons.io.FileUtils))


Fix for ctor reading

Fix for ctor reading

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -588,6 +588,7 @@
                              \{ [\} :extended]
                              nil)]
       (let [entries (to-array (read-delimited end-ch rdr true))
+            numargs (count entries)
             all-ctors (.getConstructors class)
             ctors-num (count all-ctors)]
         (case form
@@ -595,9 +596,9 @@
           (loop [i 0]
             (if (> i ctors-num)
               (reader-error rdr "Unexpected number of constructor arguments to " (str class)
-                            ": got" (count entries))
+                            ": got" numargs)
               (if (== (count (.getParameterTypes ^Constructor (aget all-ctors i)))
-                      ctors-num)
+                      numargs)
                 (Reflector/invokeConstructor class entries)
                 (recur (inc i)))))
           :extended


Fix typo in syntax-quote, caused classes of static calls to remain unqualified

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -528,7 +528,7 @@
           (if (namespace form)
             (let [maybe-class ((ns-map *ns*)
                                (symbol (namespace form)))]
-              (if (class? class)
+              (if (class? maybe-class)
                 (symbol (.getName ^Class maybe-class) (name form))
                 (resolve-symbol form)))
             (let [sym (name form)]


a bit of a tidy up

a bit of a tidy up

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -13,7 +13,9 @@
 	   ])
  )

+;;----------------------------------------------------------------------------------------------------------------------
 ;; TODO - this will have to wait until we have an extended ClassFactory
+
 ;; (do
 ;;   (def Cetacea (make-class factory "org.dada.whales.Cetacea" Object [(Float/TYPE) "length"] [(Float/TYPE) "weight"]))
 ;;   (def Mysticeti (make-class factory "org.dada.whales.Mysticeti" Cetacea))
@@ -37,7 +39,7 @@
 ;;  physeteroidea			; Sperm Whales
 ;;  zyphiidae                           : Beaked Whales
 ;;  delphinidae                         ; Orca, Dolphins
-
+;;----------------------------------------------------------------------------------------------------------------------

 (def types [
 	    "blue whale"
@@ -67,17 +69,6 @@

 (defn rnd [seq] (nth seq (rand-int (count seq))))

-;; IDEAS
-
-;; spotting - whale-id, time, coordinates, weight, length
-;; birth - whale-id time, weight, length, location
-;; death - id, time, weight, length
-
-
-;;(def factory (new ClassFactory))
-
-;; TODO - factory comes from core
-
 (if false
   (def *metamodel*
        (new org.dada.core.MetaModelImpl
@@ -88,7 +79,6 @@
     (def *metamodel* (start-server "Cetacea"))
     (start-client "Cetacea")))

-;; TODO need class available to type accessors....
 (def attributes
      (list
       :time (Long/TYPE)
@@ -205,207 +195,9 @@
        )
    ))

-;;----------------------------------------
-;; select - being refactored into filter, transform, aggregate, group, ...
-;;----------------------------------------
-
-;; ;; syntactic sugar
-;; (defn fetch [& args]
-;;   (let [output (apply select args)]
-;;     (insert *metamodel* output)
-;;     output))
-
-;; ;; here
-;; ;; select whales into a new model...
-;; (def narwhals (fetch whales :time :version '([:time] [:version] [:type][:weight]) :model "Narwhals" :filter (fn [value] (= "narwhal" (. value getType)))))
-
-;; (def belugas (fetch whales :time :version '([:time] [:version] [:type][:length]) :model "Belugas" :filter (fn [value] (= "beluga whale" (. value getType)))))
-
-;; (import org.dada.core.Reducer)
-;; (import org.dada.core.Reducer$Strategy)
-
-;; ;; make a class to hold key, version and aggregate value...
-
-;; (def aggregator-initial-values
-;;      {
-;;      (Integer/TYPE) 0
-;;      Integer 0
-;;      (Float/TYPE) (new Float "0")
-;;      Float (new Float "0")
-;;      (Double/TYPE) (new Double "0")
-;;      Double (new Double "0")
-;;      BigDecimal (new BigDecimal "0")
-;;      Number 0
-;;      Average (new Average (BigDecimal/ZERO) 0)
-;;      })
-
-;; (def aggregator-metadata {
-;;      'count [(Integer/TYPE) 0]
-;;      'sum [Number 0]
-;;      'average [Average (new Average (BigDecimal/ZERO) 0)]
-;;      })
-
-;; (defn make-average-aggregator [metadata model-name pkval field-key]
-;;   (let [getter (.getAttributeGetter metadata field-key)
-;; 	accessor #(.get getter %)]
-;;     (AggregatedModelView.
-;;      model-name
-;;      metadata
-;;      pkval
-;;      (proxy
-;;       [AggregatedModelView$Aggregator]
-;;       []
-;;       (initialValue []
-;; 		    (aggregator-initial-values Average))
-;;       (initialType []
-;; 		   Average)
-;;       (currentValue [key version value]
-;; 		    (.create metadata [key version value]))
-;;       (aggregate [insertions updates deletions]
-;; 		 (new
-;; 		  org.dada.core.Average
-;; 		  (new BigDecimal
-;; 		       (.toString ;; TODO - aaaaarrrrrrrggggggggghhhhhh !!
-;; 			(-	  ; total
-;; 			 (+
-;; 			  (apply + (map #(accessor (.getNewValue %)) insertions))
-;; 			  (apply + (map #(accessor (.getNewValue %)) updates))
-;; 			  )
-;; 			 (+
-;; 			  (apply + (map #(accessor (.getOldValue %)) updates))
-;; 			  (apply + (map #(accessor (.getOldValue %)) deletions))
-;; 			  ))))
-;; 		  (- (count insertions) (count deletions)) ; denominator
-;; 		  ))
-;;       (apply [currentValue deltaValue]
-;; 	     (let [currentTotal (.getSum currentValue)
-;; 		   currentDenominator (.getDenominator currentValue)
-;; 		   deltaTotal (.getSum deltaValue)
-;; 		   deltaDenominator (.getDenominator deltaValue)]
-;; 	       (new org.dada.core.Average
-;; 		    (.add currentTotal deltaTotal) (+ currentDenominator deltaDenominator))))
-;;       )
-;;      )))
-
-;; classname - "org.dada.demo.whales.Length"
-;; modelname - "Beluga.Length"
-;; pktype - String
-;; pkname - "type"
-;; pkval - "beluga whale"
-;; fieldtype - (Float/TYPE)
-;; fieldname - "length"
-;; initial-value - (new Float "0")
-;; accessor - .getLength
-
-;; make-aggregator [metadata modelname pkval initial-value fieldname]
-;; (def
-;;  sum-aggregator
-;;  (let [expr "SUM(length)"
-;;        field-key :length
-;;        field-type Number
-;;        package-name "org.dada.demo.whales"
-;;        class-name (str package-name "." expr)
-;;        class (make-class class-name Object :type String :version (Integer/TYPE) field-key field-type)
-;;        metadata (metadata class :type :version field-key field-type)]
-;;    (make-sum-aggregator metadata (str "Beluga." expr) "beluga whale" field-key)
-;;    ))
-
-;; (def
-;;  count-aggregator
-;;  (let [expr "COUNT(*)"
-;;        field-type (Integer/TYPE) ;; TODO - should get this from aggregator
-;;        field-key :count
-;;        package-name "org.dada.demo.whales"
-;;        class-name (str package-name "." expr)
-;;        class (make-class class-name Object :type String :version (Integer/TYPE) field-key field-type)
-;;        metadata (metadata class :type :version field-key field-type)]
-;;    (make-count-aggregator metadata (str "Beluga." expr) "beluga whale" field-key)
-;;    ))
-
-;; (def
-;;  average-aggregator
-;;  (let [expr "AVERAGE(length)"
-;;        field-key :length
-;;        field-type Average			;TODO - we should have asked aggregator
-;;        package-name "org.dada.demo.whales"
-;;        class-name (str package-name "." expr)
-;;        class (make-class class-name Object :type String :version (Integer/TYPE) field-key field-type)
-;;        metadata (metadata class :type :version field-key field-type)]
-;;    (make-average-aggregator metadata (str "Beluga." expr) "beluga whale" field-key)
-;;    ))
-
-;; (insert *metamodel* sum-aggregator)
-;; (insert *metamodel* count-aggregator)
-;; (insert *metamodel* average-aggregator)
-
-;; (connect belugas sum-aggregator)
-;; (connect belugas count-aggregator)
-;; (connect belugas average-aggregator)
-
-
-;; extract output class from aggregate and create an aggregator per type of whale
-;; collect all aggregators together for length and weight
-;; pivot them into a single Model
-
-;;----------------------------------------
-;; aggregation
-;;----------------------------------------
-
-;; (defn make-aggregator [model key-name key-val #^Symbol aggregator attribute]
-;;   (let [attribute-type (first (aggregator-metadata aggregator))
-;; 	key key-name
-;; 	key-type (type key-val)
-;; 	model-name (str (.getName model) "." (.toString aggregator) "(" attribute ")")
-;; 	class-name (.toString (gensym (str "org.dada.demo.tmp.Aggregator." aggregator)))
-;; 	class (make-class class-name Object key-name key-type :version (Integer/TYPE) attribute attribute-type)
-;; 	metadata (metadata class key :version attribute attribute-type)
-;; 	aggregator-fn (eval (symbol (str "make-" aggregator "-aggregator")))]
-;;     (aggregator-fn metadata model-name key-val attribute)))
-
-;; (defn do-aggregate
-;;   "apply an aggregator view to a model"
-;;   [model key-name key-val aggregator attribute]
-;;   (connect model (make-aggregator model key-name key-val aggregator attribute)))
-
-
-;; (def blue-whales-sum-length (do-aggregate blue-whales :type "blue whale" 'sum :length))
-;; (def blue-whales-count-length (do-aggregate blue-whales :type "blue whale" 'count :length))
-;; (def blue-whales-average-length (do-aggregate blue-whales :type "blue whale" 'average :length))
-
-;; (insert *metamodel* blue-whales-sum-length)
-;; (insert *metamodel* blue-whales-count-length)
-;; (insert *metamodel* blue-whales-average-length)
-
-;;----------------------------------------
-;; combined filtration and aggregation
-;; "combined weight of all killer whales"
-;;----------------------------------------
-
-
-
-;; (let [model whales
-;;       filter-attr-key :type
-;;       filter-attr-value "killer whale"
-;;       filtration (do-filter "type='killer whale'" model [filter-attr-key] #(= % filter-attr-value))
-
-;;       aggregator-attr-key :weight
-;;       aggregator-symbol 'count ;; 'sum, 'average, 'count
-
-;;       aggregation (do-aggregate
-;;       		   filtration
-;; 		   filter-attr-key filter-attr-value aggregator-symbol aggregator-attr-key)
-;;   ]
-;;   (insert *metamodel* filtration)
-;;   (insert *metamodel* aggregation)
-;;   )
-
-;; TODO - aggregated column's name and type depends on aggregator, not original column type
-
-;;----------------------------------------
-
-
-
-
+;; TODO: Reducers need to support variable length set of attribute keys
+
+;;----------------------------------------
 ;; THOUGHTS

 ;; primitives: a select is a combination of : filter, transform,
@@ -415,3 +207,15 @@

 ;; not sure yet about how a heterogenous/assymetric join works

+
+;; IDEAS
+
+;; spotting - whale-id, time, coordinates, weight, length
+;; birth - whale-id time, weight, length, location
+;; death - id, time, weight, length
+
+
+;;(def factory (new ClassFactory))
+
+;; TODO - factory comes from core
+


RDC - Refactor rotate-cell to look nicer.

--- src/icfp2015/cell.clj
+++ src/icfp2015/cell.clj
@@ -26,10 +26,9 @@
   [pivot direction]
   (fn [cell]
     (mapv + cell
-      (let [pivot (offset->cube pivot)
-          cell  (offset->cube cell)
-          hex-vector (mapv - cell pivot)
-          [x y z] hex-vector]
+      (let [cell (offset->cube cell)
+            pivot (offset->cube pivot)
+            [x y z] (mapv - cell pivot)]
       (cube->offset
         (case direction
           :counterclockwise (mapv - [z x y])


aggregation query

aggregation query

--- src/ophion/server.clj
+++ src/ophion/server.clj
@@ -53,10 +53,11 @@
   [mongo protograph request]
   (let [query (mapv identity (read-json (:body request)))
         label (get-in request [:params :label])
-        result (aggregate/evaluate mongo label query)]
+        result (aggregate/evaluate mongo label query)
+        out (map output result)]
     {:status 200
      :headers {"content-type" "application/json"}
-     :body (stream/->source result)}))
+     :body (stream/->source out)}))

 (defn fetch-schema
   [schema]


repeat server-timestamps to the client

repeat server-timestamps to the client

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -31,7 +31,9 @@
   ;; TODO: store client-uuid as a proper uuid everywhere
   (doseq [[uid _] (dissoc (get @document-subs (:document/id data)) (str (:session/uuid data)))]
     (log/infof "notifying %s about new transactions for %s" uid (:document/id data))
-    ((:send-fn @sente-state) uid [:datomic/transaction data])))
+    ((:send-fn @sente-state) uid [:datomic/transaction data]))
+  (when-let [server-timestamps (seq (filter #(= :server/timestamp (:a %)) (:tx-data data)))]
+    ((:send-fn @sente-state) (str (:session/uuid data)) [:datomic/transaction (assoc data :tx-data server-timestamps)])))

 (defn ws-handler-dispatch-fn [req]
   (-> req :event first))


Propertly catch all exceptions on promise factory

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -84,7 +84,7 @@
      (try
        (f #(pt/-resolve! d %)
           #(pt/-reject! d %))
-       (catch #?(:clj Exception :cljs :default) e
+       (catch #?(:clj Throwable :cljs :default) e
          (pt/-reject! d e)))
      d))
   ([f executor]


Log the URL of DB scripts as they are run.

--- src/sql_file/core.clj
+++ src/sql_file/core.clj
@@ -32,17 +32,14 @@
 (defn- schema-path [ conn ]
   (conj (get conn :schema-path []) ""))

-(defn- locate-schema-script [ conn basename ]
-  (or (some identity
-            (map #(clojure.java.io/resource (format "%s%s" % basename))
-                 (schema-path conn)))
-      (fail "Cannot find resource script: " basename " in search path " (schema-path conn))))
-
-(defn- schema-install-script [ conn schema ]
+(defn- locate-schema-script [ conn schema-name schema-version ]
   "Locate the schema script to install the given schema name and
 version. If there is no such script, throws an exception."
-  (let [[ schema-name schema-version ] schema]
-    (locate-schema-script conn (format "schema-%s-%s.sql" schema-name schema-version))))
+  (let [basename (format "schema-%s-%s.sql" schema-name schema-version)]
+    (or (some identity
+              (map #(clojure.java.io/resource (format "%s%s" % basename))
+                   (schema-path conn)))
+        (fail "Cannot find schema script: " basename " in search path " (schema-path conn)))))

 (defn do-statements [ conn stmts ]
   "Execute a sequence of statements against the given DB connection."
@@ -57,9 +54,10 @@
 (defn- run-script [ conn script-url ]
   "Run the database script at the given URL against a specific
 database connection."
-  (log/debug "Run script:" script-url)
+  (log/info "Run DB script:" (str script-url))
   (let [ script-text (slurp script-url) ]
-    (do-statements conn (map #(assoc % :url script-url) (script/sql-statements script-text)))))
+    (do-statements conn (map #(assoc % :url script-url)
+                             (script/sql-statements script-text)))))

 (defn get-schema-version [ conn schema-name ]
   "Retrieves the current version of a schema within a database managed
@@ -94,7 +92,7 @@
   (log/info "Installing schema:" schema)
   (let [ [schema-name schema-version ] schema ]
     (try
-      (run-script conn (schema-install-script conn schema))
+      (run-script conn (locate-schema-script conn schema-name schema-version))
       (catch Exception ex
         (throw (Exception. (str "Error installing schema: " schema) ex))))
     (set-schema-version! conn schema-name schema-version)))


passing cidr block to elasticsearch-cluster fn

--- src/terraboot/vpc.clj
+++ src/terraboot/vpc.clj
@@ -112,7 +112,8 @@
      (elasticsearch-cluster "elasticsearch" {:vpc-name vpc-name
                                              :account-number account-number
                                              :azs azs
-                                             :default-ami default-ami})
+                                             :default-ami default-ami
+                                             :vpc-cidr-block vpc-cidr-block})

      (in-vpc (id-of "aws_vpc" vpc-name)
              (aws-instance (vpc-unique "vpn") {
@@ -249,7 +250,7 @@
                                                        :vpc_id (id-of "aws_vpc" vpc-name)})

-            (resource "aws_db_subnet_group" vpc-name
+             (resource "aws_db_subnet_group" vpc-name
                        {:name vpc-name
                         :subnet_ids (map #(id-of "aws_subnet" (stringify vpc-name "-private-" %)) azs)
                         :description "subnet for dbs"})
@@ -257,9 +258,9 @@

              ;; all the subnets
              (apply merge-in (mapv #(private-public-subnets {:naming-fn vpc-unique
-                                                            :az %
-                                                            :cidr-blocks (% subnet-cidr-blocks)
-                                                            :public-route-table (vpc-id-of "aws_route_table" "public")}) azs))
+                                                             :az %
+                                                             :cidr-blocks (% subnet-cidr-blocks)
+                                                             :public-route-table (vpc-id-of "aws_route_table" "public")}) azs))
              (apply merge-in (for [az azs
                                    name [:public :private]]
                                (output (stringify "subnet-" name "-" az "-id") "aws_subnet" (vpc-unique (stringify name "-" az)) "id")))


Use assoc-in instead of update-in

Use assoc-in instead of update-in

--- boot/core/src/boot/cli.clj
+++ boot/core/src/boot/cli.clj
@@ -169,7 +169,7 @@
       (not (keyword? arg)) (recur (update-in split [:cli] (fnil conj []) arg) more)
       (empty? more) (update-in split [:errors] (fnil conj [])
                                (str "no value supplied for option " arg))
-      :else (recur (update-in split [:kw] assoc arg (first more)) (rest more)))))
+      :else (recur (assoc-in split [:kw arg] (first more)) (rest more)))))

 (defmacro ^:private assert
   [test fmt & args]


Improving the collection acl search test to test include undefined access value filter.

--- test/cmr/system_int_test/search/acls/collection_acl_search_test.clj
+++ test/cmr/system_int_test/search/acls/collection_acl_search_test.clj
@@ -12,12 +12,14 @@
             [cmr.system-int-test.utils.echo-util :as e]))

-(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"} false))
+(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2" "provguid3" "PROV3"}
+                                          false))

 (comment
   (ingest/reset)
   (ingest/create-provider "provguid1" "PROV1")
   (ingest/create-provider "provguid2" "PROV2")
+  (ingest/create-provider "provguid3" "PROV3")
 )

 (deftest invalid-security-token-test
@@ -27,9 +29,13 @@
 (deftest collection-search-with-acls-test
   ;; Grant permissions before creating data
   ;; Grant guests permission to coll1
-  (e/grant-guest (e/coll-catalog-item-id "provguid1" (e/coll-id ["coll1"])))
+  (e/grant-guest (e/coll-catalog-item-id "provguid1" (e/coll-id ["coll1" "notexist"])))
   ;; restriction flag acl grants matches coll4
   (e/grant-guest (e/coll-catalog-item-id "provguid1" (e/coll-id ["coll4"] {:min-value 4 :max-value 6})))
+
+  ;; Grant undefined access values in prov3
+  (e/grant-guest (e/coll-catalog-item-id "provguid3" (e/coll-id nil {:include-undefined true})))
+
   ;; all collections in prov2 granted to guests
   (e/grant-guest (e/coll-catalog-item-id "provguid2"))
   ;; grant registered users permission to coll2 and coll4
@@ -59,8 +65,13 @@
         ;; added for atom results
         coll8 (assoc coll8 :original-format "DIF")

-        all-colls [coll1 coll2 coll3 coll4 coll5 coll6 coll7 coll8]
-        guest-permitted-collections [coll1 coll4 coll6 coll7 coll8]
+        ;; PROV3
+        coll9 (d/ingest "PROV3" (dc/collection {:entry-title "coll9"}))
+        coll10 (d/ingest "PROV3" (dc/collection {:entry-title "coll10"
+                                                :access-value 12}))
+
+        all-colls [coll1 coll2 coll3 coll4 coll5 coll6 coll7 coll8 coll9 coll10]
+        guest-permitted-collections [coll1 coll4 coll6 coll7 coll8 coll9]
         guest-token (e/login-guest)
         user1-token (e/login "user1")
         user2-token (e/login "user2" ["group-guid1"])


cleanup

cleanup

--- src/ysmiraak/lang.clj
+++ src/ysmiraak/lang.clj
@@ -1,5 +1,4 @@
-(ns ysmiraak.lang
-  (:require [clojure.core.match :refer [match]]))
+(ns ysmiraak.lang)

 ;; goals
 ;; 1. unify terms and types (basic constructors shared by types and data)
@@ -13,16 +12,20 @@
 ;; form = expr | term
 ;; term = expr & vars
 ;; vars = set var
+;; args = vec var

 (defrecord Term   [expr vars])
 (defrecord Forall [expr args])
+
+(defn term?   [x] (instance? Term   x))
+(defn forall? [x] (instance? Forall x))

 (defn forms->term
   "merges multiple forms into a single term"
   [forms]
   (loop [forms (seq forms)  expr []  vars #{}]
     (if-let [[form & forms] forms]
-      (if (instance? Term form) ; build expr & collect vars
+      (if (term? form)
         (recur forms (conj expr (:expr form)) (into vars (:vars form)))
         (recur forms (conj expr        form)        vars))
       (Term. (seq expr) vars))))
@@ -30,41 +33,38 @@
 (defn subst
   "substitutes all keys in expr to vals in env"
   [env expr]
-  (cond ; todo use a better data structure (lens?) for this
-    (seq? expr)             (map (partial subst env) expr)
-    (instance? Forall expr) (assoc expr :expr (subst (reduce dissoc env (:args expr)) (:expr expr)))
-    :else                   (env expr expr)))
+  (cond ; consider using a better data structure (lens?) for this
+    (seq?    expr) (map (partial subst env) expr)
+    (forall? expr) (assoc expr :expr (subst (reduce dissoc env (:args expr)) (:expr expr)))
+    :else          (env expr expr)))

 (defn beta
   "beta-reduces a term whose expr has a Forall as head"
   [{[{:keys [expr args]} & vals] :expr vars :vars}]
-  (loop [rgs (seq args)  als (seq vals)  env {}]
-    (match [rgs als]
-           [nil nil] (Term. (subst env expr) (reduce disj vars (keys env)))
-           [_   nil] (Term. (Forall. (subst env expr) rgs) (reduce disj vars (keys env)))
-           [nil   _] (throw (ex-info "arity error" {:args args :vals vals}))
-           :else (let [[a & rgs] rgs
-                       [v & als] als]
-                   (recur rgs als (assoc env a v))))))
+  (let [nval (count vals)  env (zipmap args vals)]
+    (case (compare (count args) nval)
+      1 (Term. (Forall. (subst env expr) (subvec args nval)) (reduce disj vars (keys env)))
+      0 (Term.          (subst env expr)                     (reduce disj vars (keys env)))
+      (throw (ex-info "arity error" {:args args :vals vals})))))

 (defn ?
   "funcall, the counit of product-exponential adjunction"
   ([& forms]
    (as-> (forms->term forms) {:keys [expr vars] :as term}
-     (cond-> term (instance? Forall (first expr)) beta)
+     (cond-> term (forall? (first expr)) beta)
      (if (seq vars) term (eval expr))))
   ([]))

 (defn %
   "forall"
   [form & args] ; currently args can only be var terms
-  (let [term (if (instance? Term form) form (Term. form #{}))
+  (let [term (if (term? form) form (Term. form #{}))
         expr (:expr term)
-        args (map :expr args)]
+        args (mapv :expr args)]
     (Term.
-     (if (instance? Forall expr)
-       (Forall. (:expr expr) (concat args (:args expr)))
-       (Forall.        expr          args))
+     (if (forall? expr)
+       (Forall. (:expr expr) (into args (:args expr)))
+       (Forall.        expr        args))
      (reduce disj (:vars term) args))))

 (defn !
@@ -141,8 +141,7 @@

   )

-;; todo goal 1
-(comment
+(comment ; todo goal 1

   ;; let
   ;; - A B C be types


Fix test-service-account-injection for default-namespace (#1438)

broken in PR #1420

--- waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
+++ waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
@@ -313,9 +313,9 @@
           (is (thrown? Exception #"Cannot use run-as-requester with a specific namespace"
                        (check-pod-namespace waiter-url (assoc star-user-header :x-waiter-namespace not-current-user) current-user))))))))

-(defn- get-pod-service-account
+(defn- get-pod-service-account-info
   [waiter-url namespace-arg]
-  (let [{:keys [body error service-id status]}
+  (let [{:keys [body cookies error service-id status] :as response}
         (make-request-with-debug-info
           (cond->
             {:x-waiter-name (rand-name)
@@ -324,24 +324,29 @@
             namespace-arg
             (assoc :x-waiter-namespace namespace-arg))
           #(make-kitchen-request waiter-url % :path "/environment"))]
-    (when-not (= http-200-ok status)
-      (throw (ex-info "Failed to create service"
-                      {:response-body body
-                       :response-status status}
-                      error)))
     (with-service-cleanup
       service-id
-      (-> body str try-parse-json (get "SERVICE_ACCOUNT")))))
+      (assert-response-status response http-200-ok)
+      (assert-service-on-all-routers waiter-url service-id cookies)
+      (let [instance (first (active-instances waiter-url service-id :cookies cookies))
+            instance-env (-> body str try-parse-json)]
+        {:pod-namespace (:k8s/namespace instance)
+         :service-account (get instance-env "SERVICE_ACCOUNT")}))))

 (deftest ^:parallel ^:integration-fast test-service-account-injection
   (testing-using-waiter-url
     (when (using-k8s? waiter-url)
       (let [current-user (retrieve-username)]
-        (testing "Has service account with matching default namespace"
-          (let [service-account (get-pod-service-account waiter-url nil)]
-            (is (= current-user service-account))))
+        (testing "No service account for default namespace, or matches user"
+          (let [{:keys [service-account pod-namespace]} (get-pod-service-account-info waiter-url nil)]
+            ;; matches run-as-user when default-namespace resolves to run-as-user
+            ;; blank when default-namespace resolves to some other user (don't leak credentials)
+            (if (= current-user pod-namespace)
+              (is (= current-user service-account))
+              (is (str/blank? service-account)))))
         (testing "Has service account with custom namespace"
-          (let [service-account (get-pod-service-account waiter-url current-user)]
+          (let [{:keys [service-account pod-namespace]} (get-pod-service-account-info waiter-url current-user)]
+            (is (= current-user pod-namespace))
             (is (= current-user service-account))))))))

 (deftest ^:parallel ^:integration-slow ^:resource-heavy test-kubernetes-pod-expiry-failing-instance


CMR-2468: Log granules as vector

CMR-2468: Log granules as vector

--- common-lib/src/cmr/common/services/messages.clj
+++ common-lib/src/cmr/common/services/messages.clj
@@ -53,6 +53,6 @@
     (if (not-empty granule-references)
       (format "%s %s"
               appended-string
-              (pr-str (map #(get % :concept-id) granule-references)))
+              (pr-str (vec (map #(get % :concept-id) granule-references))))
       appended-string)))


using cond instead of if for 003.clj

using cond instead of if for 003.clj

--- 003.clj
+++ 003.clj
@@ -1,11 +1,9 @@
 (defn square [x] (* x x))
 (defn defactor [n]
   (defn hlp [n divisor factor]
-    (if (> (square divisor) n)
-      (cons n factor)
-      (if (= 0 (rem n divisor))
-        (hlp (/ n divisor) divisor (cons divisor factor))
-        (hlp n (+ divisor 1) factor))))
+    (cond (> (square divisor) n) (cons n factor)
+          (= 0 (rem n divisor)) (hlp (/ n divisor) divisor (cons divisor factor))
+          :else (hlp n (+ divisor 1) factor)))
   (hlp n 2 '()))

 (println (defactor 13195))


removing default config...

removing default config...

--- resources/default-config.clj
+++ resources/default-config.clj
@@ -1,111 +0,0 @@
-{
-  :fr$core {:corpus ["fr.time"
-                    "fr.numbers"
-                    "fr.temperature"
-                    "fr.measure"
-                    "fr.finance"
-                    "en.communication"
-                    ]
-            :rules ["fr.time"
-                    "fr.numbers"
-                    "fr.cycles"
-                    "fr.duration"
-                    "fr.temperature"
-                    "fr.measure"
-                    "en.finance"                             ; sic
-                    "en.communication"
-                    ]}
- :en$core {:corpus ["en.time"
-                    "en.numbers"
-                    "en.temperature"
-                    "en.measure"
-                    "en.finance"
-                    "en.communication"]
-           :rules  ["en.time"
-                    "en.numbers"
-                    "en.cycles"
-                    "en.duration"
-                    "en.temperature"
-                    "en.measure"
-                    "en.finance"
-                    "en.communication"]}
-:es$core {:corpus ["es.time"
-                   "es.numbers"
-                   "es.temperature"
-                   "es.measure"
-                   "es.finance"
-                   "en.communication"
-                  ]
-            :rules ["es.time"
-                    "es.numbers"
-                    "es.cycles"
-                    "es.duration"
-                    "es.temperature"
-                    "es.measure"
-                    "en.finance"
-                    "en.communication"
-                    ]}
-:et$core {:corpus [
-                    "et.numbers"
-                    ]
-           :rules  [
-                    "et.numbers"
-                    ]}
-:it$core {:corpus [
-                    "it.time"
-                    "it.numbers"
-                   ]
-            :rules [
-                     "it.time"
-                     "it.numbers"
-                     "it.cycles"
-                     "it.duration"
-                    ]}
-:cn$core {:corpus [
-                    "cn.time"
-                    "cn.numbers"
-                    "cn.temperature"
-                   ]
-            :rules [
-                     "cn.time"
-                     "cn.numbers"
-                     "cn.cycles"
-                     "cn.duration"
-                     "cn.temperature"
-                    ]}
-:ru$core {:corpus [
-                    "ru.numbers"
-                   ]
-            :rules [
-                     "ru.numbers"
-                    ]}
-
-:ar$core {:corpus [
-                    "ar.numbers"
-                   ]
-            :rules [
-                     "ar.numbers"
-                    ]}
-
-:ja$core {:corpus [
-                    "ja.numbers"
-                    "ja.temperature"
-                   ]
-            :rules [
-                     "ja.numbers"
-                     "ja.temperature"
-                     "ja.duration"
-                     "ja.cycles"
-                    ]}
-:de$core {:corpus [
-                    "de.numbers"
-                    "de.time"
-                   ]
-            :rules [
-                     "de.numbers"
-                     "de.duration"
-                     "de.cycles"
-                     "de.time"
-                    ]}
- }
-


CMR-7795: Added a test case.

CMR-7795: Added a test case.

--- search-app/test/cmr/search/test/results_handlers/stac_results_handler.clj
+++ search-app/test/cmr/search/test/results_handlers/stac_results_handler.clj
@@ -17,6 +17,10 @@
                                                :type "application/xml"}})]
         (is (= expected-assets
                (#'stac-results-handler/atom-links->assets metadata-link links))))
+
+      "no extra links"
+      nil
+      nil

       "single data link"
       [{:href "ftp://f5eil01v.edn.ecs.nasa.gov/example-data"


[#946] Render caddisfly responses as json strings

--- backend/src/akvo/lumen/import/flow.clj
+++ backend/src/akvo/lumen/import/flow.clj
@@ -1,6 +1,7 @@
 (ns akvo.lumen.import.flow
   (:require [akvo.commons.psql-util :as pg]
             [akvo.lumen.import.common :as import]
+            [cheshire.core :as json]
             [clj-http.client :as http]
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as str])
@@ -144,6 +145,10 @@
 (defmethod render-response "VIDEO"
   [_ response]
   (get response "filename"))
+
+(defmethod render-response "CADDISFLY"
+  [_ response]
+  (json/generate-string response))

 (defmethod render-response :default
   [type response]


Logs info instead of warn for node-watch timeouts (#1913)

* Logs info instead of warn for node-watch timeouts

* Fixes cause check

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -381,7 +381,12 @@
           (handle-watch-updates current-nodes-atom watch node->node-name
                                 callbacks) ; Update the set of all nodes.
           (catch Exception e
-            (log/warn e "Error during node watch for compute cluster" compute-cluster-name))
+            (let [cause (-> e Throwable->map :cause)]
+              (if (= cause "Socket closed")
+                ; We expect timeouts to happen on the node watch when there is
+                ; no node-related activity, so we log with INFO instead of WARN
+                (log/info e "Timeout during node watch for compute cluster" compute-cluster-name)
+                (log/warn e "Error during node watch for compute cluster" compute-cluster-name {:cause cause}))))
           (finally
             (.close watch)
             (initialize-node-watch compute-cluster)))))))


Give scratch space read/write access to cook-sidecar (#1899)

Co-authored-by: Caleb Harris <f19fc8a1d658da7a12d02007b679d7521088e20f@twosigma.com>

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -1078,7 +1078,7 @@

   (defn add-cook-sidecar-to-pod
     "Create Cook Sidecar container and add it to the pod"
-    [{:keys [main-env-vars pod-spec sidecar sandbox-dir sandbox-volume-mount-fn sidecar-workdir sidecar-workdir-volume-mount-fn]}]
+    [{:keys [main-env-vars pod-spec sidecar sandbox-dir sandbox-volume-mount-fn scratch-space-volume-mount-fn sidecar-workdir sidecar-workdir-volume-mount-fn]}]
     (when-let [{:keys [command health-check-endpoint image port resource-requirements]} sidecar]
       (let [{:keys [cpu-request cpu-limit memory-request memory-limit]} resource-requirements
             container (V1Container.)
@@ -1108,7 +1108,7 @@
         (set-mem-cpu-resources resources memory-request memory-limit cpu-request cpu-limit)
         (.setResources container resources)

-        (.setVolumeMounts container [(sandbox-volume-mount-fn true) (sidecar-workdir-volume-mount-fn false)])
+        (.setVolumeMounts container [(sandbox-volume-mount-fn true) (sidecar-workdir-volume-mount-fn false) (scratch-space-volume-mount-fn false)])
         (.addContainersItem pod-spec container))))

   (defn ^V1Pod task-metadata->pod


parse number in text for custom fields

parse number in text for custom fields

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/entry/capture.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/entry/capture.cljs
@@ -1,4 +1,5 @@
-(ns iwaswhere-web.ui.entry.capture)
+(ns iwaswhere-web.ui.entry.capture
+  (:require [clojure.string :as s]))

 (defn select-elem
   "Render select element for the given options. On change, dispatch message
@@ -33,15 +34,24 @@
           [:legend tag]
           (for [[k field] (:fields conf)]
             (let [input-cfg (:cfg field)
-                  value (get-in entry [:custom-fields tag k])
+                  input-type (:type input-cfg)
+                  path [:custom-fields tag k]
+                  value (get-in entry path)
                   on-change-fn
                   (fn [ev]
                     (let [v (.. ev -target -value)
-                          parsed (if (= :number (:type input-cfg))
+                          parsed (if (= :number input-type)
                                    (when (seq v) (js/parseFloat v))
                                    v)
-                          updated (assoc-in entry [:custom-fields tag k] parsed)]
+                          updated (assoc-in entry path parsed)]
                       (put-fn [:entry/update-local updated])))]
+              (when-not value
+                (when (and (= input-type :number) edit-mode?)
+                  (let [p1 (-> (:md entry) (s/split tag) first)
+                        last-n (last (re-seq #"\d+" p1))]
+                    (when last-n
+                      (let [updated (assoc-in entry path (js/parseFloat last-n))]
+                        (put-fn [:entry/update-local updated]))))))
               ^{:key (str "cf" ts tag k)}
               [:span
                [:label (:label field)]


[#10634] Image of 'Get started' view changes height/width if navigate back from "Enter seed phrase"

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/intro/views.cljs
+++ src/status_im/ui/screens/intro/views.cljs
@@ -29,7 +29,7 @@
       ^{:key i}
       [react/view {:style (styles/dot color (selected i))}]))])

-(defn intro-viewer [slides window-height]
+(defn intro-viewer [slides window-height _]
   (let [scroll-x (r/atom 0)
         scroll-view-ref (atom nil)
         width (r/atom 0)
@@ -38,58 +38,63 @@
         text-temp-height (atom 0)
         text-temp-timer (atom nil)
         bottom-margin (if (> window-height 600) 32 16)]
-    (fn []
-      [react/view {:style {:align-items :center
-                           :flex 1
-                           :margin-bottom bottom-margin
-                           :justify-content :flex-end}
-                   :on-layout (fn [^js e]
-                                (reset! width (-> e .-nativeEvent .-layout .-width)))}
-       [react/scroll-view {:horizontal true
-                           :paging-enabled true
-                           :ref #(reset! scroll-view-ref %)
-                           :shows-vertical-scroll-indicator false
-                           :shows-horizontal-scroll-indicator false
-                           :pinch-gesture-enabled false
-                           :on-scroll #(let [^js x (.-nativeEvent.contentOffset.x ^js %)]
-                                         (reset! scroll-x x))
-                           :style {:margin-bottom bottom-margin}}
-        (doall
-         (for [s slides]
-           ^{:key (:title s)}
-           [react/view {:style {:flex 1
-                                :width @width
-                                :justify-content :flex-end
-                                :align-items :center
-                                :padding-horizontal 32}}
-            (let [size (min @width @height)]
-              [react/view {:style {:flex 1}
-                           :on-layout (fn [^js e]
-                                        (let [new-height (-> e .-nativeEvent .-layout .-height)]
-                                          (swap! height #(if (pos? %) (min % new-height) new-height))))}
-               [react/image {:source (:image s)
-                             :resize-mode :contain
-                             :style {:width size
-                                     :height size}}]])
-            [react/i18n-text {:style styles/wizard-title :key (:title s)}]
-            [react/text {:style (styles/wizard-text-with-height @text-height)
-                         :on-layout
-                         (fn [^js e]
-                           (let [new-height (-> e .-nativeEvent .-layout .-height)]
-                             (when (and (not= new-height @text-temp-height)
-                                        (not (zero? new-height))
-                                        (< new-height 200))
-                               (swap! text-temp-height #(if (pos? %) (max % new-height) new-height))
-                               (when @text-temp-timer (js/clearTimeout @text-temp-timer))
-                               (reset! text-temp-timer
-                                       (js/setTimeout #(reset! text-height @text-temp-height) 500)))))}
-             (i18n/label (:text s))]]))]
-       (let [selected (hash-set (quot (int @scroll-x) (int @width)))]
-         [dots-selector {:selected selected :n (count slides)
-                         :color colors/blue}])])))
+    (fn [_ _ view-id]
+      (let [current-screen? (or (nil? view-id) (= view-id :intro))]
+        [react/view {:style {:align-items :center
+                             :flex 1
+                             :margin-bottom bottom-margin
+                             :justify-content :flex-end}
+                     :on-layout (fn [^js e]
+                                  (when current-screen?
+                                    (reset! width (-> e .-nativeEvent .-layout .-width))))}
+         [react/scroll-view {:horizontal true
+                             :paging-enabled true
+                             :ref #(reset! scroll-view-ref %)
+                             :shows-vertical-scroll-indicator false
+                             :shows-horizontal-scroll-indicator false
+                             :pinch-gesture-enabled false
+                             :on-scroll #(let [^js x (.-nativeEvent.contentOffset.x ^js %)]
+                                           (reset! scroll-x x))
+                             :style {:margin-bottom bottom-margin}}
+          (doall
+           (for [s slides]
+             ^{:key (:title s)}
+             [react/view {:style {:flex 1
+                                  :width @width
+                                  :justify-content :flex-end
+                                  :align-items :center
+                                  :padding-horizontal 32}}
+              (let [size (min @width @height)]
+                [react/view {:style {:flex 1}
+                             :on-layout (fn [^js e]
+                                          (let [new-height (-> e .-nativeEvent .-layout .-height)]
+                                            (when current-screen?
+                                              (swap! height #(if (pos? %) (min % new-height) new-height)))))}
+                 [react/image {:source (:image s)
+                               :resize-mode :contain
+                               :style {:width size
+                                       :height size}}]])
+              [react/i18n-text {:style styles/wizard-title :key (:title s)}]
+              [react/text {:style (styles/wizard-text-with-height @text-height)
+                           :on-layout
+                           (fn [^js e]
+                             (let [new-height (-> e .-nativeEvent .-layout .-height)]
+                               (when (and current-screen?
+                                          (not= new-height @text-temp-height)
+                                          (not (zero? new-height))
+                                          (< new-height 200))
+                                 (swap! text-temp-height #(if (pos? %) (max % new-height) new-height))
+                                 (when @text-temp-timer (js/clearTimeout @text-temp-timer))
+                                 (reset! text-temp-timer
+                                         (js/setTimeout #(reset! text-height @text-temp-height) 500)))))}
+               (i18n/label (:text s))]]))]
+         (let [selected (hash-set (quot (int @scroll-x) (int @width)))]
+           [dots-selector {:selected selected :n (count slides)
+                           :color colors/blue}])]))))

 (defview intro []
-  (letsubs  [{window-height :height} [:dimensions/window]]
+  (letsubs  [{window-height :height} [:dimensions/window]
+             view-id [:view-id]]
     [react/view {:style styles/intro-view}
      [intro-viewer [{:image (resources/get-theme-image :chat)
                      :title :intro-title1
@@ -99,7 +104,7 @@
                      :text :intro-text2}
                     {:image (resources/get-theme-image :browser)
                      :title :intro-title3
-                     :text :intro-text3}] window-height]
+                     :text :intro-text3}] window-height view-id]
      [react/view styles/buttons-container
       [components.common/button {:button-style (assoc styles/bottom-button :margin-bottom 16)
                                  :on-press     #(re-frame/dispatch [:multiaccounts.create.ui/intro-wizard])


Some new test utils

Some new test utils

--- src/structural_typing/assist/testutil.clj
+++ src/structural_typing/assist/testutil.clj
@@ -5,7 +5,9 @@
             [structural-typing.assist.oopsie :as oopsie]
             [structural-typing.assist.lifting :as lifting]
             [structural-typing.type :as type]
-            [such.readable :as readable]))
+            [such.readable :as readable]
+            such.immigration
+            structural-typing.guts.explanations))

 (defn exval
   "Generate an \"extended value\". Omitted values are replaced
@@ -85,9 +87,13 @@

 (import-vars [structural-typing.guts.explanations
-               err:only err:notpath
-              ])
+                err:only err:notpath
+                err:nil-all
+                err:bad-range-target])

+;; I don't immigrate the following out of a deep-seated fear that I'll
+;; mess up the output by having the test generator and code generator
+;; produce the same incorrect strings.
 (defn err:required
   "Produces the same error messsage produced when [[required-path]] fails."
   [path]