CIRCLE-4311 Fix setup test summary link for 2.0 (#1934)

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -363,14 +363,16 @@
                                    (sort-by first))))
               (spinner)))])))))

-(defn tests-ad [owner language build-succeeded?]
-  (let [junit-link (case language
-                         "Clojure" "/docs/test-metadata/#test2junit-for-clojure-tests"
-                         "Ruby" "/docs/test-metadata/#rspec"
-                         "JavaScript" "/docs/test-metadata/#js"
-                         "Python" "/docs/test-metadata#python"
-                         "Java" "/docs/test-metadata#java-junit-results-with-maven-surefire-plugin"
-                         "/docs/test-metadata/#metadata-collection-in-custom-test-steps")
+(defn tests-ad [owner language platform build-succeeded?]
+  (let [junit-link (if (= platform "2.0")
+                     "/docs/2.0/configuration-reference/#storetestresults"
+                     (case language
+                       "Clojure" "/docs/test-metadata/#test2junit-for-clojure-tests"
+                       "Ruby" "/docs/test-metadata/#rspec"
+                       "JavaScript" "/docs/test-metadata/#js"
+                       "Python" "/docs/test-metadata#python"
+                       "Java" "/docs/test-metadata#java-junit-results-with-maven-surefire-plugin"
+                       "/docs/test-metadata/#metadata-collection-in-custom-test-steps"))
         track-junit #((om/get-shared owner :track-event) {:event-type :set-up-junit-clicked
                                                           :properties {:language language}})]
     (case (feature/ab-test-treatment :junit-ab-test)
@@ -495,7 +497,8 @@

 (defn build-tests-list [{project :project
                          {{:keys [tests exceptions]} :tests-data
-                          {build-status :status} :build
+                          {build-status :status
+                           platform :platform} :build
                           :as data} :build-data}
                         owner]
   (reify
@@ -550,7 +553,7 @@
                                  (:classname slowest)
                                  (:name slowest)
                                  (:run_time slowest))]])]
-               :else (tests-ad owner (:language project) build-succeeded?))))])))))
+               :else (tests-ad owner (:language project) platform build-succeeded?))))])))))

 (defn circle-yml-ad []
   [:div


Minor cleanup

Minor cleanup

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -9,52 +9,19 @@
 ;; A version of eval subproblems where we explicitly represent the relationships
 ;; between subproblems, and allow "listeners" that wait for a subproblem to be
 ;; evaluated.
-;; Subproblems where the expand operation evaluates the output set, and generates
-;; the children.  Putting the focus on evaluation gives us finer granularity,
-;; allowing full utilizatino of subsumption, plus is more natural in a decomposed
-;; setting where we also have to "evaluate" existing actions in new contexts.
-
-;; TODO: assuming consistency and evaluation s.t. no bounding is necessary. Otherwise, downwards would be better anyway?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Subproblem Protocol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; A subproblem should also implement Summarizable and Refinable implementations.
-;; The non-viable (pre-refinement) subproblem is always represented as nil.
-
-;; Here, get-child and refine-input always return subproblems,
-;; but output-set can return "nil"
-;; get-child and refine-input are allow to return nil
-
-
-(defprotocol OutputWatched
-  (add-watcher!   [s w] "Add a watcher to be notified of all outputs to this.
-                         A watcher is just a fn of [watched-sp/stub new-subproblem]."))
-
-(defprotocol Evaluable
-  (evaluate!      [s]))
-
-(defn can-evaluate? [s]  (satisfies? Evaluable s))
-
-(defprotocol Subproblem
-  (subproblem-name   [s])
-  (input-set         [s])
-  (output-set        [s])
-  (tree-summarizer   [s] "Summarizer that includes children."))
-
-(defn sp-str [sp] (format  "#<Subproblem$%h %s>" (System/identityHashCode sp) (subproblem-name sp)) )
-(defmethod print-method angelic.search.implicit.fah_astar_eval2.Subproblem [ss o] (print-method (sp-str ss) o))
-
-
-(comment ; TODO: refine-input must go somewhere
-  (refine-input      [s maybe-refined-input-set])
-  (refine-input-   [s refined-input-set] "must be a strict subset of input-set."))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Summarizers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Assuming consistency and evaluation s.t. no bounding is necessary.
+;; Otherwise, downwards would be better anyway?
+
+;; Breaks down into "subproblems" with well-defined action seqs, inputs, outputs,
+;; and "stubs" where output is not known yet.
+;; Summary of either represents child subproblems not yet produced.
+;; These are produced into "tree summary", which has semantic view.
+
+;; One issue with this formulation is that pair-subproblems can
+;; decrease and increase reward arbitrarily (with shortcutting)
+;; as they get cut off by left sp, then recreated by children.
+

 #_ (def  ^{:private true} cache-trait summaries/uncached-summarizer-node)
  (def ^{:private true} cache-trait summaries/eager-cached-summarizer-node)
@@ -62,6 +29,13 @@
 #_ (def ^{:private true} cache-trait summaries/lazy-cached-summarizer-node)
 #_ (def ^{:private true} cache-trait summaries/pseudo-cached-summarizer-node)

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Watchers      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defprotocol OutputWatched
+  (add-watcher!   [s w] "Add a watcher to be notified of all outputs to this.
+                         A watcher is just a fn of [watched-sp/stub new-subproblem]."))

 (defprotocol SimpleWatched
   (add-output! [sw o])
@@ -84,7 +58,28 @@
     (swap! forwards conj child-sw)
     (doseq [w @watchers] (add-watcher! child-sw w))))

-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Subproblems     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Protocols     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defprotocol Evaluable
+  (evaluate!      [s]))
+
+(defn can-evaluate? [s]  (satisfies? Evaluable s))
+
+(defprotocol Subproblem
+  (subproblem-name   [s])
+  (input-set         [s])
+  (output-set        [s])
+  (tree-summarizer   [s] "Summarizer that includes children."))
+
+(defn sp-str [sp] (format  "#<Subproblem$%h %s>" (System/identityHashCode sp) (subproblem-name sp)) )
+(defmethod print-method angelic.search.implicit.fah_astar_eval2.Subproblem [ss o] (print-method (sp-str ss) o))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Tree Summarizer  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; Expects to be a parent of inside, but not have inside as a child.
 ;; All children are tree summarizers.
@@ -101,17 +96,11 @@
    TreeSummarizer
    (get-inner-sp [ts] inner-sp)
    (connect-child-sp! [ts child-sp]
-;                      (when (= (summary/max-reward (summaries/summary ts)) Double/NEGATIVE_INFINITY) (println "connecting " ts child-sp))
      (summaries/connect! ts (tree-summarizer child-sp) false)
      (add-output! ts child-sp)
-;     (add-forward! ts (tree-summarizer child-sp)) Not correct -- user should be responsible.
-     ;; Update only when changed to solved.
      (let [my-sum (summaries/summary ts) child-sum (summaries/summary (tree-summarizer child-sp))]
-;       (def *bad* [ts child-sp])
-;       (util/assert-is (>= (summary/max-reward my-sum) (summary/max-reward child-sum)))
-       (when-not (summary/>= my-sum child-sum) (summaries/summary-changed! ts)))
-#_     (util/assert-is (summary/>= (summaries/summary ts) (summaries/summary (tree-summarizer child-sp))))
-     #_(summaries/summary-changed! ts))
+;       (util/assert-is (>= (summary/max-reward my-sum) (summary/max-reward child-sum)))  Cannot assert this -- see above.
+       (when-not (summary/>= my-sum child-sum) (summaries/summary-changed! ts))))

    summaries/Summarizable
    (summarize [s]
@@ -128,9 +117,11 @@

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Subproblem Traits ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(comment ; TODO: refine-input must go somewhere
+  (refine-input      [s maybe-refined-input-set])
+  (refine-input-   [s refined-input-set] "must be a strict subset of input-set."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblem Impl  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn make-simple-subproblem [name inp-set out-set summary-fn inner-children copy-children child-transform]
   (let [ts-atom (atom nil)
@@ -166,7 +157,12 @@
           refined))))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Atomic Subproblem ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;     Subproblem Types and Stubs     ;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Atomic       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare make-fs-seq-stub)
@@ -180,8 +176,6 @@
      (map #(refine-input- % inp-set) sub-children))))

-
-;; TODO: do something with stub, refine-input.
 (defn- make-atomic-subproblem [stub inp-set function-set out-set reward status]
   (let [children (when (= status :live)
                    (or #_ (refined-children subsuming-as inp-set) ;; TODO!!
@@ -227,18 +221,10 @@

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Seq Subproblem ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Tree summarizer represents semantic (stateless) bound on best solution of SP.
-;; Inner of SP represents best possible bound on any descendent subproblem not outputted yet.,
-;;   i.e., tree of any child subproblem
-;; Stub represents best possible tree of any output (not outputted yet!).
-
-;; TODO TODO: think about who connects to who'se tree.
-;; TODO: increase is OK as long as tree doesn't ?
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   Sequences    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; This subproblem is allowed to die, (incl. tree?!), replaced by refinements at sp1.
-(defn- make-right-subproblem [stub sp1 sp2]
+(defn- make-pair-subproblem [stub sp1 sp2]
   (make-simple-subproblem
    [::Pair (subproblem-name sp1) (subproblem-name sp2)]
    (input-set sp1) (output-set sp2)
@@ -247,7 +233,7 @@
      (assert (= 2 (count (summaries/node-ordinary-children s))))
      (summary/+ (summaries/summary sp1) (summaries/summary sp2) s))
    [sp1 sp2] [(tree-summarizer sp2)]
-   (fn [s] (make-right-subproblem stub sp1 s))))
+   (fn [s] (make-pair-subproblem stub sp1 s))))

 ;; TODO: sharing below ends up doubling up on published outputs unnecessarily?
 ;; Short circuit means that right SP can go dead then back live.
@@ -259,13 +245,13 @@
                  (cons (summary/+ (summaries/summary left-sp) (summaries/summary right-stub) s)
                        (map summaries/summary (summaries/node-ordinary-children s)))
                   s Double/POSITIVE_INFINITY)))]
-    (add-watcher! right-stub (fn [_ o] (add-output! ret (make-right-subproblem ret left-sp o))))
+    (add-watcher! right-stub (fn [_ o] (add-output! ret (make-pair-subproblem ret left-sp o))))
     (summaries/add-parent! left-sp ret false)
     (summaries/add-parent! right-stub ret false)

+    ;; Note: this right-sharing is crucial for efficiency!
     (add-watcher! (tree-summarizer left-sp)
       (fn [_ left-child]
-        ;; Note: this right-sharing is crucial for efficiency!
         (let [right-right (if (= (output-set left-child) (output-set left-sp)) right-stub (right-stub-fn (output-set left-child)))
               new-right-stub (make-right-stub left-child right-right right-stub-fn)]
           (summaries/connect! ret new-right-stub false)
@@ -315,7 +301,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Planning ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn choose-leaf [verified-summary]
+(defn- choose-leaf [verified-summary]
 ;  (println "VS"  verified-summary) #_ (def *sum* verified-summary) (Thread/sleep 10)
   (->> (summary/extract-leaf-seq verified-summary (comp empty? summary/children))
 ;       util/prln
@@ -326,15 +312,14 @@
        (filter can-evaluate?)
        last #_ rand-nth))

-
-(defn solve [root-subproblem]
+(defn- solve [root-subproblem]
   (def *root* root-subproblem)
   (summary/solve
    #(summaries/verified-summary (tree-summarizer root-subproblem) summary/+worst-simple-summary+)
    (comp evaluate! choose-leaf)
    #(let [n (second (subproblem-name %))] (when-not (= (first n) :noop) n))))

-(defn get-root-subproblem [inp-set fs]
+(defn- get-root-subproblem [inp-set fs]
   (let [root-stub (make-atomic-stub nil inp-set fs)
         ret       (atom nil)]
     (add-watcher! root-stub (fn [_ root] (reset! ret root)))


Generate a db.yml when we we know what adapter they have

--- src/circle/backend/build/inference/rails.clj
+++ src/circle/backend/build/inference/rails.clj
@@ -211,7 +211,7 @@
           (blacklist))
         (when use-bundler?
           (bundle-install))
-        (when (need-database-yml? repo)
+        (when (and (need-database-yml? repo) (db-yml-adapter repo))
           (generate-database-yml repo))
         (when (need-mysql-socket? repo)
           (mysql/ensure-socket (mysql-socket-path repo)))


Tree sort questions so they show in the same order as the UI

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -750,6 +750,23 @@
     (.format (SimpleDateFormat. "YYYY-MM-dd HH:mm")
              pg-time)))

+(defn- append-children [survey-questions questions]
+  (reduce (fn [acc cur]
+            (let [cur-id   (tc/val->int (get cur 0))
+                  children (filter (fn [[_id question]] (= cur-id (:parentQuestionId question)))
+                                   survey-questions)]
+              (cond-> (conj acc cur)
+                (seq children) (concat (append-children survey-questions children))
+                :always        (vec))))
+          []
+          questions))
+
+(defn- sort-questions [survey-questions]
+  (append-children survey-questions
+                   (filter (fn [[_id question]]
+                             (= -1 (:parentQuestionId question)))
+                           survey-questions)))
+
 ;;;
 ;;; Dump aggregate
 ;;;
@@ -812,7 +829,7 @@
         text-headers     (concat (pu/remove-vector-items plot-base-headers
                                                          (when-not confidence? :confidence))
                                  (get-ext-headers plots :extra_plot_info "pl_"))
-        number-headers   (get-value-distribution-headers survey-questions)
+        number-headers   (-> survey-questions (sort-questions) (get-value-distribution-headers))
         headers-out      (->> (concat text-headers number-headers)
                               (map #(-> % name csv-quotes))
                               (str/join ",")
@@ -885,9 +902,9 @@
             text-headers     (concat sample-base-headers
                                      (get-ext-headers samples :extra_plot_info "pl_")
                                      (get-ext-headers samples :extra_sample_info "smpl_")
-                                     (map (fn [[_ val]]
-                                            (:question val "not-found"))
-                                          survey-questions))
+                                     (->> survey-questions
+                                          (sort-questions)
+                                          (map (fn [[_ {:keys [question]}]] (or question "not-found")))))
             headers-out      (->> text-headers
                                   (map #(-> % name csv-quotes))
                                   (str/join ",")


you *can* :on-click on some text

you *can* :on-click on some text

--- src/cljs/early_vote_site/election/views.cljs
+++ src/cljs/early_vote_site/election/views.cljs
@@ -55,10 +55,9 @@
   [election]
   [:tr {:key (:id election)}
    [:td {:name "election-state"} (-> election :state-fips format-fips)]
-   [:td {:name "election-date"} (-> election :election-date format-date)]
+   [:td {:name "election-date" :on-click #(re-frame/dispatch [:election-form/election-selected])} (-> election :election-date format-date)]
    [:td
-    [:button.button "edit"]]
-   [:td [:button.button {:on-click #(re-frame/dispatch [:election-form/election-selected])} "test"]]])
+    [:button.button "edit"]]])

 (defn election-table []
   (let [election-list-items @(re-frame/subscribe [:elections/list])]


date-input can take label and placeholder and behave as material input

--- src/cljs/re_form/inputs/date_input_impl.cljs
+++ src/cljs/re_form/inputs/date_input_impl.cljs
@@ -126,11 +126,13 @@
   (let [fmt (or (:format opts) "iso")
         fmt-obj (get formats fmt)
         state (r/atom {:lastValue (:value opts) :value (date-unparse fmt (:value opts))})
+        input-state (r/atom "blur")
         doc-click-listener (fn [e]
                              (when (and (not (cmn/has-ancestor (.-target e) (:node @state)))
                                         (:dropdown-visible @state))
                                (swap! state assoc :dropdown-visible false)))
         my-on-blur (fn [event on-blur]
+                     (reset! input-state "blur")
                      (when (:errors @state)
                        (swap! state assoc :value (date-unparse fmt (:lastValue @state)))
                        (swap! state dissoc :errors))
@@ -164,25 +166,44 @@
           (will-recv-props v)))

       :reagent-render
-      (fn [{:keys [with-chevrons with-dropdown value on-change errors on-blur err-classes] :as props}]
+      (fn [{:keys [with-chevrons with-dropdown value on-change errors on-blur err-classes label placeholder] :as props}]
         [:div.dropdown-input
          (when with-chevrons
            [:div.date-chevrons
             {:on-click #(on-change (dec-iso value))}
             [:i.material-icons "chevron_left"]])
          [:div.date-input {:on-blur #(my-on-blur % (or on-blur identity))
-                           :class (when-not (empty? errors) :error)}
+                           :class (if label
+                                    (str "input-field")
+                                    (when-not (empty? errors) :error))}
           [:i.material-icons
            {:on-click
             #(let [parent-node (.. % -target -parentNode)
                    input (cmn/f-child parent-node "re-input")]
                (.focus input))} "today"]
           [:input.re-input (merge (dissoc props :errors :with-dropdown :format :with-chevrons)
+                                  (when label
+                                    {:class (str "validate " (when-not (empty? errors) "invalid"))})
                                   {:type "text"
-                                   :placeholder (:placeholder fmt-obj)
-                                   :on-focus #(swap! state assoc :dropdown-visible true)
+                                   :placeholder (if placeholder
+                                                  (when (or (not (empty? errors))
+                                                            (not (str/blank? value))
+                                                            (= "focus" @input-state))
+                                                    placeholder)
+                                                  (:placeholder fmt-obj))
+                                   :on-focus #(do
+                                                (reset! input-state "focus")
+                                                (swap! state assoc :dropdown-visible true))
                                    :on-change #(my-onchange % on-change)
-                                   :value (:value @state)})]]
+                                   :value (:value @state)})]
+          (when label
+            [:label {:data-error (cond
+                                   (seq errors)     (str/join " " errors)
+                                   (:errors @state) (:errors @state))
+                     :class (str (when (or (not (empty? errors))
+                                           (not (str/blank? value))
+                                           (= "focus" @input-state)) "active") " "
+                                 (when (= "focus" @input-state) "focus"))} label])]
          (when with-chevrons
            [:div.date-chevrons
             {:on-click #(on-change (inc-iso value))}
@@ -195,9 +216,10 @@
              {:value (date-parse fmt (:value @state))
               :on-change (comp #(swap! state assoc :dropdown-visible false)
                                on-change will-recv-props)}]])
-         [:div {:class (apply str (interpose "." err-classes))}
-          (when-let [local-errors (:errors @state)]
-            (str/join "\n" (conj errors local-errors)))]])})))
+         (when-not label
+           [:div {:class (apply str (interpose "." err-classes))}
+            (when-let [local-errors (:errors @state)]
+              (str/join "\n" (conj errors local-errors)))])])})))

 (defn iso-dt [date time] (gstring/format "%sT%s:00%s" date time ""))


fix date input with us tz

fix date input with us tz

--- src/cljs/re_form/inputs/date_input_impl.cljs
+++ src/cljs/re_form/inputs/date_input_impl.cljs
@@ -10,6 +10,7 @@
   [:*
    [:.date-chevrons
     {:display :inline-block
+     :user-select :none
      :font-size (u/px h2)
      :cursor :pointer
      :line-height (u/px* h2 1.5)}]
@@ -96,11 +97,11 @@

 (defn f-iso [f x]
   (let [date-obj (js/Date. x)]
-    (.setDate date-obj (f (.getDate date-obj)))
+    (.setUTCDate date-obj (f (.getUTCDate date-obj)))
     (gstring/format "%04d-%02d-%02d"
-                    (.getFullYear date-obj)
-                    (inc (.getMonth date-obj))
-                    (.getDate date-obj))))
+                    (.getUTCFullYear date-obj)
+                    (inc (.getUTCMonth date-obj))
+                    (.getUTCDate date-obj))))

 (def inc-iso (partial f-iso inc))
 (def dec-iso (partial f-iso dec))


semi-working select-xhr

semi-working select-xhr

--- src/cljs/re_form/inputs/select_xhr_impl.cljs
+++ src/cljs/re_form/inputs/select_xhr_impl.cljs
@@ -45,39 +45,47 @@
      [:&:hover {:background-color "#f1f1f1"}]]]])

 (defn- suggest-set-callback [state suggs]
-  (println suggs)
   (swap! state assoc :suggestions suggs))

-(defn- on-change-update [state suggest-fn query]
-  (go (suggest-set-callback state (<! (suggest-fn query)))))
+(defn- on-change-update [state suggest-fn node]
+  (let [query (.-textContent node)]
+    (when-not (empty? query)
+      (go (suggest-set-callback state (<! (suggest-fn query)))))))

 ;; TODO:
 ;; text input to query
 ;; on component-did-mount do r/dom-node and .addEventListener 'input' to track
 ;; contenteditable changes
 ;; debounce
-(defn select-xhr-input [_]
+(defn select-xhr-input [{:keys [suggest-fn]}]
   (let [state (r/atom {:active false :suggestions []})]
-    (fn [{:keys [value on-change value-fn label-fn match-fn suggest-fn placeholder]}]
-      (let [label-fn (or label-fn pr-str)
-            value-fn (or value-fn identity)
-            match-fn (or match-fn
-                         (fn [v] (->> (:suggestions @state)
-                                      (filter #(= (value-fn %) v))
-                                      first label-fn)))]
-        [:div.re-select-xhr
-         {:on-click #(swap! state update :active not)}
-         (if value
-           [:span.value
-            [:span.value (match-fn value) ]]
-           [:span.choose-value
-            {:contentEditable true
-             :on-input #(on-change-update state suggest-fn (.. % -target -value))}])
-         (when (:active @state)
-           [:div.options
-            (for [i (:suggestions @state)] ^{:key (label-fn i)}
-              [:div.option
-               {:on-click (fn [_] (on-change (value-fn i)))
-                :class (when (= value (value-fn i)) "active")}
-               (label-fn i)])])])))
+    (r/create-class
+     {:component-did-mount
+      (fn [this]
+        (let [root-node (r/dom-node this)
+              node (first (array-seq (.getElementsByClassName root-node "choose-value")))]
+          (.addEventListener node "input" #(on-change-update state suggest-fn node))))
+
+      :reagent-render
+      (fn [{:keys [value on-change value-fn label-fn match-fn suggest-fn placeholder]}]
+        (let [label-fn (or label-fn pr-str)
+              value-fn (or value-fn identity)
+              match-fn (or match-fn
+                           (fn [v] (->> (:suggestions @state)
+                                        (filter #(= (value-fn %) v))
+                                        first label-fn)))]
+          [:div.re-select-xhr
+           {:on-click #(swap! state update :active not)}
+           (if value
+             [:span.value
+              [:span.value (match-fn value) ]]
+             [:span.choose-value
+              {:contentEditable true}])
+           (when (:active @state)
+             [:div.options
+              (for [i (:suggestions @state)] ^{:key (label-fn i)}
+                [:div.option
+                 {:on-click (fn [_] (on-change (value-fn i)))
+                  :class (when (= value (value-fn i)) "active")}
+                 (label-fn i)])])]))}))
   )


Add bind marker

Add bind marker

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -3,10 +3,15 @@
    that `cql` namespace is too limiting for you."
   (:import [com.datastax.driver.core.querybuilder QueryBuilder
             Select$Selection Select Select$Where
-
+            BindMarker
             Clause]
            [com.datastax.driver.core.querybuilder ]))

+(defn ?
+  ([]
+     (QueryBuilder/bindMarker))
+  ([name]
+     (QueryBuilder/bindMarker name)))

 (def select-command-order
   [QueryBuilder Select$Selection Select Select$Where])


The attempt is implicit

The attempt is implicit

--- src/desdemona/launcher/launch_prod_peers.clj
+++ src/desdemona/launcher/launch_prod_peers.clj
@@ -41,7 +41,7 @@
         peer-group (onyx.api/start-peer-group peer-config)
         env (onyx.api/start-env env-config)
         peers (onyx.api/start-peers n-peers peer-group)]
-    (println "Attempting to connect to Zookeeper: " (:zookeeper/address peer-config))
+    (println "Connecting to Zookeeper: " (:zookeeper/address peer-config))
     (add-shutdown-hook! (fn []
                           (doseq [v-peer peers]
                             (onyx.api/shutdown-peer v-peer))


set logger async? true

set logger async? true

--- clj-timbre-auditlog/src/clj_timbre_auditlog/audit_log.clj
+++ clj-timbre-auditlog/src/clj_timbre_auditlog/audit_log.clj
@@ -13,15 +13,18 @@

 (defn create-audit-logger [service-name base-path ^ApplicationType application-type]
   (let [audit-log-config (assoc timbre/example-config
-                                :appenders {:standard-out     {:enabled? false}
-                                            :println          nil
-                                            :file-appender   (assoc (rolling-appender
+                                :appenders {:standard-out     {:enabled? false
+                                                               :async?   true}
+                                            :println          {:enabled? false
+                                                               :async?   true}
+                                            :file-appender   (-> (rolling-appender
                                                                      {:path    (str base-path
                                                                                "/audit_" service-name
                                                                                ;; Hostname will differentiate files in actual environments
                                                                                (when (:hostname env) (str "_" (:hostname env))))
                                                                       :pattern :daily})
-                                                                    :output-fn (fn [data] (force (:msg_ data))))}
+                                                                 (assoc :output-fn (fn [data] (force (:msg_ data))))
+                                                                 (assoc :async? true))}
                                 :timestamp-opts {:pattern  "yyyy-MM-dd'T'HH:mm:ss.SSSXXX"
                                                  :timezone (TimeZone/getTimeZone "Europe/Helsinki")})
         logger           (proxy [Logger] [] (log [s]


remove obsolete class imports

remove obsolete class imports

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -29,10 +29,8 @@
                                                     make-property-sequences]])
   (:require [clojure.set]
             [org.micromanager.mm :as mm])
-  (:import [org.micromanager AcqControlDlg]
-           [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
-           [org.micromanager.acquisition AcquisitionWrapperEngine
-                                         MMAcquisition
+  (:import [org.micromanager.api AcquisitionEngine]
+           [org.micromanager.acquisition MMAcquisition
                                          SequenceSettings
                                          TaggedImageQueue]
            [org.micromanager.navigation PositionList]
@@ -964,15 +962,6 @@

 ;; testing

-(defn create-acq-eng []
-  (doto
-    (proxy [AcquisitionWrapperEngine] []
-      (runPipeline [^SequenceSettings settings]
-        (-run settings this)
-    (.setCore mmc (.getAutofocusManager gui))
-    (.setParentGUI gui)
-    (.setPositionList (.getPositionList gui))))))
-
 (defn stop []
   (when-let [acq-thread (:acq-thread (.state last-acq))]
     (.stop acq-thread)))


Remove rlwrap from alpine tools-deps images

Addresses #55

--- src/docker_clojure/dockerfile/tools_deps.clj
+++ src/docker_clojure/dockerfile/tools_deps.clj
@@ -3,8 +3,7 @@
 (defn install-deps [{:keys [distro]}]
   (case distro
     "alpine"
-    ["RUN echo '@testing http://dl-cdn.alpinelinux.org/alpine/edge/testing' >> /etc/apk/repositories && \\"
-     "  apk add --update --no-cache bash curl rlwrap@testing"]
+    ["RUN apk add --update --no-cache bash curl"]

     "debian"
     ["RUN apt-get update && apt-get install -y rlwrap"]


Update bar.clj

Update bar.clj

--- backend/src/akvo/lumen/lib/aggregation/bar.clj
+++ backend/src/akvo/lumen/lib/aggregation/bar.clj
@@ -28,7 +28,7 @@
         column-y-name (get column-y "columnName")
         column-y-title (get column-y "title")

-        aggregation-method (if (and (not column-y) column-subbucket) "count" (get query "metricAggregation"))
+        aggregation-method (if (and (not column-y) column-x) "count" (get query "metricAggregation"))
         truncate-size (or (get query "truncateSize") "ALL")
         sql-sort-subquery (case (get query "sort")
                             nil "ORDER BY x ASC"
@@ -78,9 +78,9 @@
             sort_table.include_value IS NOT NULL
           " sql-sort-subbucket-subquery)

-        valid-spec (boolean (and column-x (or column-y (and (not column-y) column-subbucket))))
+        valid-spec (boolean column-x)
         sql-text (if valid-spec (if column-subbucket sql-text-with-subbucket sql-text-without-subbucket) "SELECT NULL")
-        sql-response (run-query tenant-conn table-name sql-text column-x-name column-y-name filter-sql aggregation-method truncate-size column-subbucket-name)
+        sql-response (run-query tenant-conn table-name sql-text column-x-name (or column-y-name column-x-name) filter-sql aggregation-method truncate-size column-subbucket-name)
         bucket-values (distinct
                        (mapv
                         (fn [[x-value y-value s-value]] x-value)


finish

finish

--- Add-Two-Numbers/ATN.clj
+++ Add-Two-Numbers/ATN.clj
@@ -13,3 +13,21 @@
           (recur (into [] (rest a))
                  (into [] (rest b))
                  (conj re (+ (first a) (first b)))))))
+
+(defn check-ten [l]
+  (let [f (atom 0)
+        ll (doall (for [a l]
+                    (let [inner-a (+ a @f)]
+                      (if (>= inner-a 10)
+                        (do (reset! f (int (Math/floor (/ inner-a 10))))
+                            (mod inner-a 10))
+                        inner-a
+                        ))))]
+    (if (not= 0 @f)
+      (conj (into [] ll) @f)
+      (into [] ll))))
+
+(add-two-number [2 6 8] [8 9 3 1])
+(check-ten [10 15 11 1])
+
+(check-ten (add-two-number [9 9 9 9] [9 9 9 9]))


Fix lein profiles

Fix lein profiles

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -3,16 +3,17 @@
                    :eastwood-exclude-linters [:kibit]}}
   :plugin-repositories [["private-plugins"
                          {:url "private repo url"}]]
-        :singing {:gpg-key "matthew.russell@wormbase.org"}
-        :dependencies [[clojure-ini "0.0.2"]
-                       [me.raynes/fs "1.4.6"]]
-        :plugins [[cider/cider-nrepl "0.15.0-SNAPSHOT"]
-                  [refactor-nrepl "0.2.2"]
-                  [jonase/eastwood "0.2.3"]
-                  [lein-ancient "0.6.8"]
-                  [lein-bikeshed "0.3.0"]
-                  [lein-ns-dep-graph "0.1.0-SNAPSHOT"]]}
+  :singing {:gpg-key "matthew.russell@wormbase.org"}
+  :dependencies [[clojure-ini "0.0.2"]
+                 [me.raynes/fs "1.4.6"]]
+  :plugins [
+            [jonase/eastwood "0.2.3"]
+            [lein-ancient "0.6.8"]
+            [lein-bikeshed "0.3.0"]
+            [lein-ns-dep-graph "0.1.0-SNAPSHOT"]]
+            [refactor-nrepl "0.2.2"]}
  :repl {:dependencies [[acyclic/squiggly-clojure "0.1.6"]
+                       [cider/cider-nrepl "0.15.0-SNAPSHOT"]
                        [datomic-schema-grapher "0.0.1"]
                        [org.clojure/tools.nrepl "0.2.12"]]
         :plugins [[cider/cider-nrepl "0.15.0-SNAPSHOT"]]}


bencode.metainfo.reader/torrent-name: get 'name.utf-8' field first

--- src/main/clojure/bencode/metainfo/reader.clj
+++ src/main/clojure/bencode/metainfo/reader.clj
@@ -50,7 +50,8 @@
 (defn torrent-name
   "Returns the torrent name."
   [metainfo]
-  (get-in metainfo ["info" "name"]))
+  (or (get-in metainfo ["info" "name.utf-8"])
+      (get-in metainfo ["info" "name"])))

 (defn torrent-announce
   "Returns the torrent tracker URL."


fix incorrect tabindex

fix incorrect tabindex

--- src/main/shadow/cljs/ui/components/inspect.cljs
+++ src/main/shadow/cljs/ui/components/inspect.cljs
@@ -92,7 +92,7 @@
   (<< [:div.flex-1
        [:textarea.w-full.h-full.font-mono.border-t.p-4
         {:readOnly true
-         :tabindex -1}
+         :tab-index -1}
         "nil"]]))

 (def seq-vlist
@@ -115,7 +115,7 @@
   [object active?]
   (seq-vlist {:ident (:db/ident object)
               :select-event {:e ::kb-select!}
-              :tabindex (if active? 0 -1)}))
+              :tab-index (if active? 0 -1)}))

 (defmethod render-view :vec [data active?]
   (render-seq data active?))
@@ -153,7 +153,7 @@
   [object active?]
   (map-vlist {:ident (:db/ident object)
               :select-event {:e ::kb-select!}
-              :tabindex (if active? 0 -1)}))
+              :tab-index (if active? 0 -1)}))

 (def lazy-seq-vlist
   (vlist/configure :lazy-seq-vlist
@@ -171,7 +171,7 @@
 (defmethod render-view :lazy-seq
   [object active?]
   (lazy-seq-vlist {:ident (:db/ident object)
-                   :tabindex (if active? 0 -1)}))
+                   :tab-index (if active? 0 -1)}))

 (def css-button-selected "mx-2 border bg-blue-400 px-4 rounded")
 (def css-button "mx-2 border bg-blue-200 hover:bg-blue-400 px-4 rounded")
@@ -182,7 +182,7 @@
                  css-button-selected
                  css-button)
         :on-click {:e ::inspect-switch-display! :display-type val}
-        :tabindex (if active? 0 -1)}
+        :tab-index (if active? 0 -1)}
        label]))

 (defc ui-object-panel
@@ -321,13 +321,13 @@
   (render
     (<< [:div.p-2.font-bold.border-b.border-bg-gray-200 "Tap History"]
         [:div.flex-1.overflow-hidden
-         (tap-vlist {:tabindex (if active? 0 -1)
+         (tap-vlist {:tab-index (if active? 0 -1)
                      :select-event {:e ::kb-select!}})]

         [:div.flex.bg-white.py-2.px-4.font-mono.border-t-2
          [:button
           {:class css-button
-           :tabindex (if active? 0 -1)
+           :tab-index (if active? 0 -1)
            :on-click ::m/tap-clear!}
           "Clear"]])))


Filter out all tasks which are currently min-required-peers

--- src/onyx/scheduling/balanced_task_scheduler.clj
+++ src/onyx/scheduling/balanced_task_scheduler.clj
@@ -9,7 +9,10 @@
    (reduce
     (fn [[peers-to-drop allocations] _]
       (let [max-peers (->> allocations
-                           (sort-by (comp count val))
+                           (remove (fn [[task peers]]
+                                     (= (count peers) (get-in replica [:min-required-peers job task] 1))))
+                           (sort-by (fn [[task peers]]
+                                      (count peers)))
                            reverse
                            first
                            second


remove unnecessary core.async :require

remove unnecessary core.async :require

--- src/onyx_starter/launcher/submit_sample_job.clj
+++ src/onyx_starter/launcher/submit_sample_job.clj
@@ -1,6 +1,5 @@
 (ns onyx-starter.launcher.submit-sample-job
-  (:require [clojure.core.async :refer [>!!]]
-            [com.stuartsierra.component :as component]
+  (:require [com.stuartsierra.component :as component]
             [clojure.java.io :refer [resource]]
             [onyx-starter.launcher.dev-system :refer [onyx-dev-env]]
             [onyx-starter.workflows.sample-workflow :refer [workflow]]


CMR-4247 - Added metedata-db int test for variable cascade deletes.

--- metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/delete_test.clj
+++ metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/delete_test.clj
@@ -32,23 +32,40 @@
 (deftest delete-group-general
   (cd-spec/general-delete-test :access-group ["REG_PROV" "SMAL_PROV" "CMR"]))

-;; test tag delete cascades to tag associations
-(deftest tag-delete-cascades-to-tag-associations
-  (let [tag-collection (util/create-and-save-collection "REG_PROV" 1)
-        tag (util/create-and-save-tag 1)
-        tag-association (util/create-and-save-tag-association tag-collection tag 1 1)
-        tag-association-id (:concept-id tag-association)
-        {status :status tag-association-concept :concept} (util/get-concept-by-id tag-association-id)
-        _ (util/delete-concept (:concept-id tag))
-        {tombstone-status :status tombstone :concept} (util/get-concept-by-id tag-association-id)]
+(deftest tag-delete-cascades-associations
+  (testing "delete cascades to tag associations"
+    (let [tag-collection (util/create-and-save-collection "REG_PROV" 1)
+          tag (util/create-and-save-tag 1)
+          tag-association (util/create-and-save-tag-association tag-collection tag 1 1)
+          tag-association-id (:concept-id tag-association)
+          {status :status tag-association-concept :concept} (util/get-concept-by-id tag-association-id)
+          _ (util/delete-concept (:concept-id tag))
+          {tombstone-status :status tombstone :concept} (util/get-concept-by-id tag-association-id)]
+      (testing "tag association was saved and is not a tombstone"
+        (is (= 200 status))
+        (is (not (:deleted tag-association-concept))))
+      (testing "tag association is tombstoned after tag is deleted"
+        (is (= 200 tombstone-status))
+        (is (:deleted tombstone))))))

-    (testing "tag association was saved and is not a tombstone"
-      (is (= 200 status))
-      (is (not (:deleted tag-association-concept))))
-
-    (testing "tag association is tombstoned after tag is deleted"
-      (is (= 200 tombstone-status))
-      (is (:deleted tombstone)))))
+(deftest variable-delete-cascades-associations
+  (testing "delete cascades to variable associations"
+    (let [variable-collection (util/create-and-save-collection "REG_PROV" 1)
+          variable (util/create-and-save-variable "REG_PROV" 1)
+          variable-association (util/create-and-save-variable-association
+                                variable-collection variable 1 1)
+          variable-association-id (:concept-id variable-association)
+          {status :status variable-association-concept :concept} (util/get-concept-by-id
+                                                                  variable-association-id)
+          _ (util/delete-concept (:concept-id variable))
+          {tombstone-status :status tombstone :concept} (util/get-concept-by-id
+                                                         variable-association-id)]
+      (testing "variable association was saved and is not a tombstone"
+        (is (= 200 status))
+        (is (not (:deleted variable-association-concept))))
+      (testing "variable association is tombstoned after variable is deleted"
+        (is (= 200 tombstone-status))
+        (is (:deleted tombstone))))))

 ;; collections must be tested separately to make sure granules are deleted as well
 (deftest delete-collection-using-delete-end-point-test


refactorings on server parser

refactorings on server parser

--- src/server/daveconservatoire/server/parser.cljs
+++ src/server/daveconservatoire/server/parser.cljs
@@ -77,7 +77,7 @@
   (zipmap (keys schema)
           (map #(let [m (:fields %)]
                  (assoc %
-                   :fields-getters
+                   ::reader-map
                    (zipmap (keys m)
                            (map
                              (fn [field]
@@ -93,7 +93,7 @@

 (defn row-getter [schema k f]
   (let [table (keyword (namespace k))]
-    (assoc-in schema [table :fields-getters k] f)))
+    (assoc-in schema [table ::reader-map k] f)))

 (def db-specs
   (-> (prepare-schema
@@ -143,14 +143,20 @@
                    :lesson/title       "title"
                    :lesson/description "description"
                    :lesson/keywords    "keywords"}}})
+
+      ; Course
       (row-getter :course/topics
         #(has-many % :topic :topic/course-id {:sort ["sortorder"]}))
       (row-getter :course/lessons
         #(has-many % :lesson :lesson/course-id {:sort ["lessonno"]}))
+
+      ; Topic
       (row-getter :topic/course
         #(has-one % :course :topic/course-id))
       (row-getter :topic/lessons
         #(has-many % :lesson :lesson/topic-id {:sort ["lessonno"]}))
+
+      ; Lesson
       (row-getter :lesson/course
         #(has-one % :course :lesson/course-id))
       (row-getter :lesson/topic
@@ -168,16 +174,18 @@

 (defn row-get [{:keys [table] :as env} row attr]
   (read-from (assoc env :row row :ast {:key attr :dispatch-key attr})
-    (:fields-getters table)))
+    (::reader-map table)))

 (defn parse-row [{:keys [table ast ::union-selector] :as env} row]
   (let [row' {:db/table (:key table) :db/id (row-get env row :db/id)}
-        readers [(:fields-getters table) placeholder-node]
+        readers [(::reader-map table) placeholder-node]
         ast (if (union-children? ast)
               (some-> ast :query (get (row-get env row union-selector)) (om/query->ast))
               ast)]
     (-> (reduce (fn [row' {:keys [key] :as ast}]
-                  (assoc row' key (read-from (assoc env :ast ast :row row) readers)))
+                  (if (contains? #{:db/id :db/table} key)
+                    row'
+                    (assoc row' key (read-from (assoc env :ast ast :row row) readers))))
                 row'
                 (:children ast))
         (read-chan-values))))


[FIX #2423] ui: fix typo in render-public-chats-item

--- src/status_im/ui/screens/discover/views.cljs
+++ src/status_im/ui/screens/discover/views.cljs
@@ -127,22 +127,21 @@
   (re-frame/dispatch [:create-new-public-chat topic]))

 (defn render-public-chats-item [{:keys [name color topic] :as item}]
-  [react/touchable-highlight {:on-press #(navigate-to-public-chat topic)}]
-
-  [react/view styles/public-chats-item-container
-   [react/view styles/public-chats-icon-container
-    [react/view (styles/public-chats-icon color)
-     [react/text {:style styles/public-chats-icon-text}
-      (-> name first str)]]]
-   [react/view styles/public-chats-item-inner
-    [react/view styles/public-chats-item-name-container
-     [vector-icons/icon :icons/public-chat]
-     [react/text {:font  :medium
-                  :style styles/public-chats-item-name-text}
-      name]]
-    [react/view {}
-     [react/text {:style {:color :lightgray}}
-      (str "#" topic)]]]])
+  [react/touchable-highlight {:on-press #(navigate-to-public-chat topic)}
+   [react/view styles/public-chats-item-container
+    [react/view styles/public-chats-icon-container
+     [react/view (styles/public-chats-icon color)
+      [react/text {:style styles/public-chats-icon-text}
+       (-> name first str)]]]
+    [react/view styles/public-chats-item-inner
+     [react/view styles/public-chats-item-name-container
+      [vector-icons/icon :icons/public-chat]
+      [react/text {:font  :medium
+                   :style styles/public-chats-item-name-text}
+       name]]
+     [react/view {}
+      [react/text {:style {:color :lightgray}}
+       (str "#" topic)]]]]])

 (defn public-chats-teaser []
   [react/view styles/public-chats-container


Refactor

Refactor

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -30,23 +30,14 @@
 (defn request-headers
   "Create a set of request headers to use for interaction with the Keycloak
    REST API. This allows us to reuse the same token for multiple requests."
-  ([{:keys [openid-config credentials connection-manager]}]
-   (let [params (merge {:grant_type "client_credentials"}
-                       credentials)
-         resp (client/post (get openid-config "token_endpoint")
-                           {:form-params params})]
-     (when-let [access-token (-> resp :body json/decode (get "access_token"))]
-       {"Authorization" (str "bearer " access-token)
-        "Content-Type" "application/json"})))
+  ([{:keys [openid-config credentials connection-manager] :as k}]
+   (request-headers k {}))
   ([{:keys [openid-config credentials connection-manager]}
     {:keys [timeout] :as req-opts}]
-   (let [params (merge {:grant_type "client_credentials"}
-                       credentials)
-         url (get openid-config "token_endpoint")
-         req-opts (-> req-opts
-                      (select-keys [:timeout])
-                      (assoc :form-params params))]
-     (when-let [access-token (-> (client/post url (assoc req-opts :connection-manager connection-manager))
+   (let [params (merge {:grant_type "client_credentials"} credentials)
+         req-opts (-> (select-keys req-opts [:timeout])
+                      (assoc :form-params params :connection-manager connection-manager))]
+     (when-let [access-token (-> (client/post (get openid-config "token_endpoint") req-opts)
                                  :body
                                  json/decode
                                  (get "access_token"))]


Send mail using Postal’s classloader context

--- systems/mail/src/containium/systems/mail.clj
+++ systems/mail/src/containium/systems/mail.clj
@@ -8,6 +8,7 @@
             [containium.systems.config :as config :refer (Config)]
             [containium.systems.logging :refer (SystemLogger refer-logging)]
             [postal.core :as postal]
+            [classlojure.core :refer (with-classloader)]
             [clojure.xml :as xml]
             [clojure.zip :as zip]
             [clojure.java.io :as io :refer (resource as-file)])
@@ -114,7 +115,7 @@
     clojure.java.io/file."
   [mail-system from to subject html & {:keys [cc bcc text attachments src-root src-map]}]
   (let [html-contents (make-inline html src-root src-map)
-        attachment-contents (map (fn [a] (assoc a :type :attachment)) attachments)
+        attachment-contents (doall (map (fn [a] (assoc a :type :attachment)) attachments))
         body-contents (if text
                         [:alternative
                          {:type "text/plain" :content text}
@@ -123,6 +124,7 @@
         contents (if (seq attachment-contents)
                    [:mixed body-contents attachment-contents]
                    body-contents)]
-    (send-message mail-system from to subject contents
-                  (merge (when cc {:cc cc})
-                         (when bcc {:bcc bcc})))))
+    (with-classloader (.getClassLoader Postal)
+      (send-message mail-system from to subject contents
+                    (merge (when cc {:cc cc})
+                           (when bcc {:bcc bcc}))))))


add some tree trimming to the topo-sort algorithm

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -114,6 +114,10 @@
 (defn ns->dependents [ns]
   (get-in @dependency-data [:dependents ns]))

+(defn in-upper-level? [topo-state current-depth dep]
+  (some (fn [[_ v]] (and v (v dep)))
+        (filter (fn [[k v]] (> k current-depth)) topo-state)))
+
 (defn build-topo-sort [get-deps]
   (let [get-deps (memoize get-deps)]
     (letfn [(topo-sort-helper* [x depth state]
@@ -125,7 +129,8 @@
               ([deps depth state]
                (swap! state update-in [depth] (fnil into #{}) deps)
                (doseq [dep deps]
-                 (topo-sort-helper* dep (inc depth) state))
+                 (when (and dep (not (in-upper-level? @state depth dep)))
+                   (topo-sort-helper* dep (inc depth) state)))
                (when (= depth 0)
                  (elim-dups* (reverse (vals @state))))))
             (elim-dups* [[x & xs]]


(MAINT) clean up shutdown tests

(MAINT) clean up shutdown tests

--- test/puppetlabs/trapperkeeper/shutdown_test.clj
+++ test/puppetlabs/trapperkeeper/shutdown_test.clj
@@ -28,8 +28,9 @@
           app               (bootstrap-services-with-empty-config [test-service])]
       (is (false? @shutdown-called?))
       (internal/shutdown! (app-context app))
-      (is (true? @shutdown-called?))))
-
+      (is (true? @shutdown-called?)))))
+
+(deftest shutdown-dep-order-test
   (testing "services are shut down in dependency order"
     (let [order       (atom [])
           service1    (service ShutdownTestService
@@ -44,8 +45,9 @@
           app         (bootstrap-services-with-empty-config [service1 service2])]
       (is (empty? @order))
       (internal/shutdown! (app-context app))
-      (is (= @order [2 1]))))
-
+      (is (= @order [2 1])))))
+
+(deftest shutdown-continue-after-ex-test
   (testing "services continue to shut down when one throws an exception"
     (let [shutdown-called?  (atom false)
           test-service      (service []
@@ -58,10 +60,11 @@
           app               (bootstrap-services-with-empty-config [test-service broken-service])]
       (is (false? @shutdown-called?))
       (logging/with-test-logging
-        (internal/shutdown! (app-context app))
-        (is (logged? #"Encountered error during shutdown sequence" :error)))
-      (is (true? @shutdown-called?))))
-
+       (internal/shutdown! (app-context app))
+       (is (logged? #"Encountered error during shutdown sequence" :error)))
+      (is (true? @shutdown-called?)))))
+
+(deftest shutdown-run-app-test
   (testing "`tk/run-app` runs the framework (blocking until shutdown signal received), and `request-shutdown` shuts down services"
     (let [shutdown-called?  (atom false)
           test-service      (service []
@@ -73,8 +76,9 @@
       (is (false? @shutdown-called?))
       (internal/request-shutdown shutdown-svc)
       (tk/run-app app)
-      (is (true? @shutdown-called?))))
-
+      (is (true? @shutdown-called?)))))
+
+(deftest shutdown-on-error-custom-fn-error-test
   (testing (str "`shutdown-on-error` in custom function causes services to be "
                 "shut down and the error is rethrown from main")
     (let [shutdown-called?  (atom false)
@@ -85,159 +89,166 @@
                                            context)
                                      (test-fn [this]
                                               (future (shutdown-on-error
-                                                        (service-id this)
-                                                        #(throw
-                                                          (Throwable.
-                                                            "oops"))))))
+                                                       (service-id this)
+                                                       #(throw
+                                                         (Throwable.
+                                                          "oops"))))))
           app               (tk/boot-services-with-config [test-service] {})
           test-svc          (get-service app :ShutdownTestServiceWithFn)]
       (is (false? @shutdown-called?))
       (test-fn test-svc)
       (is (thrown-with-msg?
-            Throwable
-            #"oops"
-            (tk/run-app app)))
-      (is (true? @shutdown-called?))))
-
-  (defn bootstrap-and-validate-shutdown
-    [services shutdown-called? expected-exception-message]
-    (let [app         (tk/boot-services-with-config services {})]
-        (is (thrown-with-msg?
-              Throwable
-              expected-exception-message
-              (tk/run-app app))
-            "tk run-app did not die with expected exception.")
-        (is (true? @shutdown-called?)
-            "Service shutdown was not called.")))
-
+           Throwable
+           #"oops"
+           (tk/run-app app)))
+      (is (true? @shutdown-called?)))))
+
+(defn bootstrap-and-validate-shutdown
+  [services shutdown-called? expected-exception-message]
+  (let [app         (tk/boot-services-with-config services {})]
+    (is (thrown-with-msg?
+         Throwable
+         expected-exception-message
+         (tk/run-app app))
+        "tk run-app did not die with expected exception.")
+    (is (true? @shutdown-called?)
+        "Service shutdown was not called.")))
+
+(deftest shutdown-ex-during-init-test
   (testing (str "shutdown will be called if a service throws an exception "
                 "during init on main thread, with appropriate errors logged")
     (logging/with-test-logging
-      (let [shutdown-called? (atom false)
-            test-service     (service ShutdownTestService
+     (let [shutdown-called? (atom false)
+           test-service     (service ShutdownTestService
+                                     []
+                                     (init [this context]
+                                           (throw (Throwable. "oops"))
+                                           context)
+                                     (stop [this context]
+                                           (reset! shutdown-called? true)
+                                           context))]
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"Error during service init!!!" :error)
+           "Error message for service init not logged.")))))
+
+(deftest shutdown-ex-during-start-test
+  (testing (str "shutdown will be called if a service throws an exception "
+                "during start on main thread, with appropriate errors logged")
+    (logging/with-test-logging
+     (let [shutdown-called?  (atom false)
+           test-service      (service ShutdownTestService
                                       []
+                                      (start [this context]
+                                             (throw (Throwable. "oops"))
+                                             context)
+                                      (stop  [this context]
+                                             (reset! shutdown-called? true)
+                                             context))]
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"Error during service start!!!" :error)
+           "Error message for service start not logged.")))))
+
+(deftest shutdown-log-errors-during-init-test
+  (testing (str "`shutdown-on-error` will catch and log errors raised during "
+                "init on main thread")
+    (logging/with-test-logging
+     (let [shutdown-called?  (atom false)
+           test-service      (service ShutdownTestService
+                                      [[:ShutdownService shutdown-on-error]]
                                       (init [this context]
-                                            (throw (Throwable. "oops"))
+                                            (shutdown-on-error
+                                             :ShutdownTestService
+                                             #(throw (Throwable. "oops")))
                                             context)
                                       (stop [this context]
                                             (reset! shutdown-called? true)
                                             context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"Error during service init!!!" :error)
-            "Error message for service init not logged."))))
-
-  (testing (str "shutdown will be called if a service throws an exception "
-                "during start on main thread, with appropriate errors logged")
-    (logging/with-test-logging
-      (let [shutdown-called?  (atom false)
-            test-service      (service ShutdownTestService
-                                       []
-                                       (start [this context]
-                                              (throw (Throwable. "oops"))
-                                              context)
-                                       (stop  [this context]
-                                              (reset! shutdown-called? true)
-                                              context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"Error during service start!!!" :error)
-            "Error message for service start not logged."))))
-
-  (testing (str "`shutdown-on-error` will catch and log errors raised during "
-                "init on main thread")
-    (logging/with-test-logging
-      (let [shutdown-called?  (atom false)
-            test-service      (service ShutdownTestService
-                                       [[:ShutdownService shutdown-on-error]]
-                                       (init [this context]
-                                             (shutdown-on-error
-                                               :ShutdownTestService
-                                               #(throw (Throwable. "oops")))
-                                             context)
-                                       (stop [this context]
-                                             (reset! shutdown-called? true)
-                                             context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"shutdown-on-error triggered because of exception!"
-                     :error)
-            "Error message for shutdown-on-error not logged."))))
-
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"shutdown-on-error triggered because of exception!"
+                    :error)
+           "Error message for shutdown-on-error not logged.")))))
+
+(deftest shutdown-log-errors-during-init-future-test
   (testing (str "`shutdown-on-error` will catch and log errors raised during "
                 "init on future")
     (logging/with-test-logging
-      (let [shutdown-called?  (atom false)
-            test-service      (service ShutdownTestService
-                                       [[:ShutdownService shutdown-on-error]]
-                                       (init [this context]
+     (let [shutdown-called?  (atom false)
+           test-service      (service ShutdownTestService
+                                      [[:ShutdownService shutdown-on-error]]
+                                      (init [this context]
+                                            @(future
+                                              (shutdown-on-error
+                                               :ShutdownTestService
+                                               #(throw (Throwable. "oops"))))
+                                            context)
+                                      (stop [this context]
+                                            (reset! shutdown-called? true)
+                                            context))]
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"shutdown-on-error triggered because of exception!"
+                    :error)
+           "Error message for shutdown-on-error not logged.")))))
+
+(deftest shutdown-log-errors-during-start-test
+  (testing (str "`shutdown-on-error` will catch and log errors raised during"
+                "start on main thread")
+    (logging/with-test-logging
+     (let [shutdown-called?  (atom false)
+           test-service      (service ShutdownTestService
+                                      [[:ShutdownService shutdown-on-error]]
+                                      (start [this context]
+                                             (shutdown-on-error
+                                              :ShutdownTestService
+                                              #(throw (Throwable. "oops")))
+                                             context)
+                                      (stop [this context]
+                                            (reset! shutdown-called? true)
+                                            context))]
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"shutdown-on-error triggered because of exception!"
+                    :error)
+           "Error message for shutdown-on-error not logged.")))))
+
+(deftest shutdown-log-errors-during-start-future-test
+  (testing (str "`shutdown-on-error` will catch and log errors raised during "
+                "start on future")
+    (logging/with-test-logging
+     (let [shutdown-called?  (atom false)
+           test-service      (service ShutdownTestService
+                                      [[:ShutdownService shutdown-on-error]]
+                                      (start [this context]
                                              @(future
                                                (shutdown-on-error
-                                                 :ShutdownTestService
-                                                 #(throw (Throwable. "oops"))))
+                                                :ShutdownTestService
+                                                #(throw (Throwable. "oops"))))
                                              context)
-                                       (stop [this context]
-                                             (reset! shutdown-called? true)
-                                             context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"shutdown-on-error triggered because of exception!"
-                     :error)
-            "Error message for shutdown-on-error not logged."))))
-
-  (testing (str "`shutdown-on-error` will catch and log errors raised during"
-                "start on main thread")
-    (logging/with-test-logging
-      (let [shutdown-called?  (atom false)
-            test-service      (service ShutdownTestService
-                                       [[:ShutdownService shutdown-on-error]]
-                                       (start [this context]
-                                             (shutdown-on-error
-                                               :ShutdownTestService
-                                               #(throw (Throwable. "oops")))
-                                             context)
-                                       (stop [this context]
-                                             (reset! shutdown-called? true)
-                                             context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"shutdown-on-error triggered because of exception!"
-                     :error)
-            "Error message for shutdown-on-error not logged."))))
-
-  (testing (str "`shutdown-on-error` will catch and log errors raised during "
-                "start on future")
-    (logging/with-test-logging
-      (let [shutdown-called?  (atom false)
-            test-service      (service ShutdownTestService
-                                       [[:ShutdownService shutdown-on-error]]
-                                       (start [this context]
-                                              @(future
-                                                 (shutdown-on-error
-                                                   :ShutdownTestService
-                                                   #(throw (Throwable. "oops"))))
-                                             context)
-                                       (stop [this context]
-                                             (reset! shutdown-called? true)
-                                             context))]
-        (bootstrap-and-validate-shutdown
-          [test-service]
-          shutdown-called?
-          #"oops")
-        (is (logged? #"shutdown-on-error triggered because of exception!"
-                     :error)
-            "Error message for shutdown-on-error not logged."))))
-
+                                      (stop [this context]
+                                            (reset! shutdown-called? true)
+                                            context))]
+       (bootstrap-and-validate-shutdown
+        [test-service]
+        shutdown-called?
+        #"oops")
+       (is (logged? #"shutdown-on-error triggered because of exception!"
+                    :error)
+           "Error message for shutdown-on-error not logged.")))))
+
+(deftest shutdown-on-error-callback-test
   (testing "`shutdown-on-error` takes an optional function that is called on error"
     (let [shutdown-called?    (atom false)
           on-error-fn-called? (atom false)
@@ -256,12 +267,13 @@
       (is (false? @on-error-fn-called?))
       (test-fn test-svc)
       (is (thrown-with-msg?
-            RuntimeException
-            #"uh oh"
-            (tk/run-app app)))
+           RuntimeException
+           #"uh oh"
+           (tk/run-app app)))
       (is (true? @shutdown-called?))
-      (is (true? @on-error-fn-called?))))
-
+      (is (true? @on-error-fn-called?)))))
+
+(deftest shutdown-on-error-callback-error-test
   (testing "errors thrown by the `shutdown-on-error` optional on-error function are caught and logged"
     (let [broken-service  (service ShutdownTestServiceWithFn
                                    [[:ShutdownService shutdown-on-error]]
@@ -272,29 +284,29 @@
           app             (bootstrap-services-with-empty-config [broken-service])
           test-svc        (get-service app :ShutdownTestServiceWithFn)]
       (logging/with-test-logging
-        (test-fn test-svc)
-        (is (thrown-with-msg?
-              Throwable
-              #"foo"
-              (tk/run-app app)))
-        (is (logged? #"Error occurred during shutdown" :error))))))
+       (test-fn test-svc)
+       (is (thrown-with-msg?
+            Throwable
+            #"foo"
+            (tk/run-app app)))
+       (is (logged? #"Error occurred during shutdown" :error))))))

 (deftest shutdown-on-error-error-handling
   (testing "Shutdown-on-error should never throw an exception."
     (testing "providing `nil` for all arguments"
       (let [test-service (tk/service
-                           [[:ShutdownService shutdown-on-error]]
-                           (init [this context]
-                                 (shutdown-on-error nil nil nil)
-                                 context))]
+                          [[:ShutdownService shutdown-on-error]]
+                          (init [this context]
+                                (shutdown-on-error nil nil nil)
+                                context))]
         (is (not (nil? (tk/boot-services-with-config [test-service] {}))))))

     (testing "passing `nil` instead of a function"
       (let [test-service (tk/service
-                           [[:ShutdownService shutdown-on-error]]
-                           (init [this context]
-                                 (shutdown-on-error context nil)
-                                 context))]
+                          [[:ShutdownService shutdown-on-error]]
+                          (init [this context]
+                                (shutdown-on-error context nil)
+                                context))]
         (is (not (nil? (tk/boot-services-with-config [test-service] {}))))))))

 (deftest app-check-for-errors!-tests
@@ -303,14 +315,14 @@
                                     [[:ShutdownService shutdown-on-error]]
                                     (init [this context]
                                           (shutdown-on-error
-                                            :ShutdownTestService
-                                            #(throw (Throwable. "oops")))
+                                           :ShutdownTestService
+                                           #(throw (Throwable. "oops")))
                                           context))
           app              (tk/boot-services-with-config [test-service] {})]
       (is (thrown-with-msg?
-            Throwable
-            #"oops"
-            (check-for-errors! app))
+           Throwable
+           #"oops"
+           (check-for-errors! app))
           "Expected error not thrown for check-for-errors!")))
   (testing "check-for-errors! throws exception for error in init"
     (let [test-service     (service ShutdownTestService
@@ -320,35 +332,35 @@
                                           context))
           app              (tk/boot-services-with-config [test-service] {})]
       (is (thrown-with-msg?
-            Throwable
-            #"oops"
-            (check-for-errors! app))
+           Throwable
+           #"oops"
+           (check-for-errors! app))
           "Expected error not thrown for check-for-errors!")))
   (testing "check-for-errors! throws exception for shutdown-on-error in start"
     (let [test-service     (service ShutdownTestService
                                     [[:ShutdownService shutdown-on-error]]
                                     (start [this context]
-                                          (shutdown-on-error
+                                           (shutdown-on-error
                                             :ShutdownTestService
                                             #(throw (Throwable. "oops")))
-                                          context))
-          app              (tk/boot-services-with-config [test-service] {})]
-      (is (thrown-with-msg?
-            Throwable
-            #"oops"
-            (check-for-errors! app))
+                                           context))
+          app              (tk/boot-services-with-config [test-service] {})]
+      (is (thrown-with-msg?
+           Throwable
+           #"oops"
+           (check-for-errors! app))
           "Expected error not thrown for check-for-errors!")))
   (testing "check-for-errors! throws exception for error in start"
     (let [test-service     (service ShutdownTestService
                                     []
                                     (start [this context]
-                                          (throw (Throwable. "oops"))
-                                          context))
-          app              (tk/boot-services-with-config [test-service] {})]
-      (is (thrown-with-msg?
-            Throwable
-            #"oops"
-            (check-for-errors! app))
+                                           (throw (Throwable. "oops"))
+                                           context))
+          app              (tk/boot-services-with-config [test-service] {})]
+      (is (thrown-with-msg?
+           Throwable
+           #"oops"
+           (check-for-errors! app))
           "Expected error not thrown for check-for-errors!")))
   (testing "check-for-errors! returns app when no shutdown-on-error occurs"
     (let [test-service     (service ShutdownTestService


Fix doc string

Fix doc string

--- library/src/doo/core.clj
+++ library/src/doo/core.clj
@@ -243,7 +243,7 @@
     :debug - bool (default false) to log to standard-out internal events
              to aid debugging
     :paths - a map from runners (keywords) to string commands for bash.
-    :exec-dir - a directory path (string) from where runner should be
+    :exec-dir - a directory path (file) from where runner should be
                 exectuted. Defaults to nil which resolves to the current dir"
   ([js-env compiler-opts]
    (run-script js-env compiler-opts {}))


add comments

add comments

--- Longest-Word-in-Dictionary-through-Deleting/LWiDtD.clj
+++ Longest-Word-in-Dictionary-through-Deleting/LWiDtD.clj
@@ -1,6 +1,5 @@
 (defn find-Longest-Word [s d]
   (let [newD (sort-by count > d) ; newD is a list
-        tempList (atom [])
         scan-Word (fn [sIn s]
                     (if (> (count s) (count sIn))
                       nil
@@ -12,6 +11,8 @@
                                 true
                                 (recur (rest a) (rest b)))
                               :else (recur (rest a) b)))))]
+    ;; main part is different from python version
+    ;; because newD is sorted by alphabet in clojure, but reversed-alphabet in python version
     (loop [sIn s
            words newD]
       (cond (empty? words) ""


Added Searcher search file unit tests to clojure

--- clojure/cljsearch/test/cljsearch/searcher_test.clj
+++ clojure/cljsearch/test/cljsearch/searcher_test.clj
@@ -1,9 +1,15 @@
 (ns cljsearch.searcher-test
-  (:use [clojure.java.io :only (file)])
+  (:use [clojure.java.io :only (file reader)])
   (:require [clojure.test :refer :all])
   (:require [clojure.string :as str :only (join)])
+  (:use [cljsearch.fileutil :only (expand-path)])
   (:use [cljsearch.searcher])
   (:use [cljsearch.searchsettings]))
+
+(def TESTFILE "~/src/git/xsearch/shared/testFiles/testFile2.txt")
+
+(defn get-settings []
+  (add-pattern DEFAULT-SETTINGS "Searcher" :searchpatterns))

 ;; *****************************************************************************
 ;; is-search-dir? tests
@@ -155,3 +161,35 @@
       (is (filter-file? (file ".gitignore") settings))
       (is (not (filter-file? (file "archive.zip") settings))))))

+;; *****************************************************************************
+;; search-lines tests
+;; *****************************************************************************
+(deftest test-search-lines
+  (testing "test-search-lines"
+    (with-open [rdr (reader (expand-path TESTFILE))]
+      (let [settings (get-settings)
+            results (search-lines (line-seq rdr) settings)]
+        (is (= (count results) 2))
+        (is (= (:linenum (first results)) 23))
+        (is (= (:startmatchindex (first results)) 3))
+        (is (= (:endmatchindex (first results)) 11))
+        (is (= (:linenum (second results)) 29))
+        (is (= (:startmatchindex (second results)) 24))
+        (is (= (:endmatchindex (second results)) 32))))))
+
+;; *****************************************************************************
+;; search-multiline-string tests
+;; *****************************************************************************
+(deftest test-search-multiline-string
+  (testing "test-search-multiline-string"
+    (let [settings (get-settings)
+          contents (slurp (expand-path TESTFILE))
+          results (search-multiline-string contents settings)]
+      (is (= (count results) 2))
+      (is (= (:linenum (first results)) 23))
+      (is (= (:startmatchindex (first results)) 3))
+      (is (= (:endmatchindex (first results)) 11))
+      (is (= (:linenum (second results)) 29))
+      (is (= (:startmatchindex (second results)) 24))
+      (is (= (:endmatchindex (second results)) 32)))))
+


No more normal vs dev dependencies in build.boot (dev have :scope "test")

--- resources/leiningen/new/lambone/common/build.boot
+++ resources/leiningen/new/lambone/common/build.boot
@@ -6,10 +6,7 @@
                      [adzerk/env "0.3.0" :scope "test"]
                      [pandeiro/boot-http "0.7.3" :scope "test"]])

-(def common-deps '[[org.clojure/clojure "1.8.0" :scope "test"]])
-
-(def backend-dev-deps '[[adzerk/boot-test "1.1.1"]
-                        [adzerk/env "0.3.0" :scope "test"]])
+(def common-deps '[[org.clojure/clojure "1.8.0" :scope "provided"]])

 (def backend-deps (into common-deps
                         '[[org.clojure/tools.namespace "0.2.10"]
@@ -24,25 +21,28 @@
                           [org.apache.logging.log4j/log4j-slf4j-impl "2.5" :scope "runtime"]
                           [mount "0.1.10"]
                           [robert/hooke "1.3.0"]
-                          [cprop "0.1.7"]]))
+                          [cprop "0.1.7"]
+                          ;; dev only
+                          [adzerk/boot-test "1.1.1" :scope "test"]
+                          [adzerk/env "0.3.0" :scope "test"]]))
 <% if any frontend %>
-(def frontend-dev-deps '[[adzerk/boot-cljs "1.7.228-1" :scope "test"]
-                         [adzerk/boot-cljs-repl "0.3.0" :scope "test"]
-                         [adzerk/boot-reload "0.4.4" :scope "test"]
-                         [deraen/boot-sass "0.2.1" :scope "test"]
-                         [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]
-                         [adzerk/boot-cljs-repl "0.3.0" :scope "test"]
-                         [com.cemerick/piggieback "0.2.1" :scope "test"]
-                         [weasel "0.7.0" :scope "test"]
-                         [org.clojure/tools.nrepl "0.2.12" :scope "test"]
-                         [org.slf4j/slf4j-nop "1.7.21"]])
-
 ;; All the deps are "test" because they are only need for compiling to
 ;; JavaScript, not "real" project dependencies.
 (def frontend-deps (into common-deps
                          '[[org.clojure/clojurescript "1.8.51" :scope "test"]
                            [org.clojure/core.async "0.2.374" :scope "test"]
-                           [adzerk/cljs-console "0.1.1" :scope "test"]]))
+                           [adzerk/cljs-console "0.1.1" :scope "test"]
+                           ;; dev only
+                           [adzerk/boot-cljs "1.7.228-1" :scope "test"]
+                           [adzerk/boot-cljs-repl "0.3.0" :scope "test"]
+                           [adzerk/boot-reload "0.4.4" :scope "test"]
+                           [deraen/boot-sass "0.2.1" :scope "test"]
+                           [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]
+                           [adzerk/boot-cljs-repl "0.3.0" :scope "test"]
+                           [com.cemerick/piggieback "0.2.1" :scope "test"]
+                           [weasel "0.7.0" :scope "test"]
+                           [org.clojure/tools.nrepl "0.2.12" :scope "test"]
+                           [org.slf4j/slf4j-nop "1.7.21" :scope "test"]]))
 <% endif %>
 (set-env! :source-paths #{"dev"}
           :dependencies cmd-line-deps)
@@ -85,13 +85,10 @@
          :file "<<project-ns>>-standalone.jar"}
    :aot {:all true}})

-(def backend-dev-dependencies
-  (vec (distinct (concat backend-dev-deps backend-deps))))
-
 (defmethod boot/options [:backend :dev]
   [selection]
   (merge backend-options
-         {:env {:dependencies backend-dev-dependencies
+         {:env {:dependencies backend-deps
                 :source-paths #{"src/backend" "env/dev/src"}
                 :resource-paths #{"env/dev/resources"}}}))

@@ -106,7 +103,7 @@
   [selection]
   (merge backend-options
          {:test {:namespaces #{'<<project-ns>>.system-test}}
-          :env {:dependencies backend-dev-dependencies
+          :env {:dependencies backend-deps
                 :middleware @@(resolve 'boot.repl/*default-middleware*)
                 :source-paths #{"src/backend" "test/backend" "env/dev/src"}
                 :resource-paths #{"env/dev/resources"}}}))
@@ -144,7 +141,7 @@
 (def frontend-options
   {:env {:source-paths #{"src/frontend"}
          :asset-paths #{"assets"}
-         :dependencies (vec (distinct (concat frontend-dev-deps frontend-deps)))}
+         :dependencies frontend-deps}
    :reload {:on-jsload '<<project-ns>>.app/init}
    :cljs-repl {:nrepl-opts {:port 5088}}
    :test-cljs {:suite-ns '<<project-ns>>.suite}})
@@ -168,8 +165,7 @@
         (assoc :props {"CLJS_LOG_LEVEL" "INFO"})
         (update-in [:env :source-paths] conj "env/prod/src")
         (assoc :cljs (merge optimizations
-                            {:source-map false
-                             :compiler-options prod-compiler-options}))
+                            {:compiler-options prod-compiler-options}))
         (assoc :test-cljs (merge optimizations
                                  {:cljs-opts prod-compiler-options})))))

@@ -209,7 +205,6 @@
   (let [type (or type :prod)
         flavor (or flavor (keyword (get (env/env) "BOOT_BUILD_FLAVOR")))
         options (boot/options [flavor type])]
-    (util/dbug "Options:\n%s\n" (with-out-str (pprint options)))
     (util/info "Will build the [%1s %2s] profile...\n" flavor type)
     (case flavor
       <% if any backend %>:backend (boot/build-backend options)<% endif %><% if any frontend %>


Add two additional test series for ranges, these for y ranges that do not include 0.

--- metlog-agent/config.clj
+++ metlog-agent/config.clj
@@ -5,18 +5,25 @@
     (fn [ ]
       (swap! current #(+ % (/ (+ (Math/random) (Math/random)) 2) -0.5)))))

-(def rs-0 (random-sampler))
-(def rs-1 (random-sampler))
-(def rs-2 (random-sampler))
+(defsensor* random-unconstrained {:poll-interval (seconds 10)}
+  (let [rs (random-sampler)]
+    (fn [] (rs))))

-(defsensor random-unconstrained {:poll-interval (seconds 10)}
-  (rs-0))
+(defsensor* random-positive {:poll-interval (seconds 10)}
+  (let [rs (random-sampler)]
+    (fn [] (+ 0.1 (Math/abs (rs))))))

-(defsensor random-positive {:poll-interval (seconds 10)}
-  (+ 0.1 (Math/abs (rs-1))))
+(defsensor* random-negative {:poll-interval (seconds 10)}
+  (let [rs (random-sampler)]
+    (fn [] (- -0.1 (Math/abs (rs))))))

-(defsensor random-negative {:poll-interval (seconds 10)}
-  (- -0.1 (Math/abs (rs-2))))
+(defsensor* random-very-positive {:poll-interval (seconds 10)}
+  (let [rs (random-sampler)]
+    (fn [] (+ 10 (Math/abs (rs))))))
+
+(defsensor* random-very-negative {:poll-interval (seconds 10)}
+  (let [rs (random-sampler)]
+    (fn [] (- -10 (Math/abs (rs))))))

 (defsensor math {:poll-interval (seconds 10)}
   {:sine (+ 0.3 (Math/sin (/ (- (System/currentTimeMillis) start-t) (minutes 1))))


Web UI for uploading measurement CSVs

Web UI for uploading measurement CSVs

--- src-cljs/kixi/hecuba/tabs/property_details.cljs
+++ src-cljs/kixi/hecuba/tabs/property_details.cljs
@@ -1,4 +1,5 @@
 (ns kixi.hecuba.tabs.property-details
+  (:import goog.net.XhrIo)
   (:require [cljs.core.async :refer [<! >! chan put! sliding-buffer close! pipe map< filter< mult tap map>]]
             [cljs.reader :as reader]
             [om.core :as om :include-macros true]
@@ -209,25 +210,37 @@
                  ;; CSV Management
                  [:div {:class (if (not= active-tab :upload) "hidden" "col-md-12")}
                   [:div {:style {:padding-top "15px"}}
-                   [:div {:class "panel panel-default"}
+                   ;; Download measurements template
+                   [:div.panel.panel-default
                     [:div.panel-body
                      [:div
                       [:h4 "Download CSV measurements template"]
                       [:a {:class "btn btn-primary"
                            :type "button"
-                           :href (str "/4/templates/for-entity/" selected-property-id)} "Download"]]]]
-                   [:div {:class "panel panel-default"}
-                    [:div.panel-body
-                     [:div
-                      [:h4 "Upload CSV profile data"]
-                      (let [div-id "file-form"]
-                        (om/build (file/file-upload (str "/4/entities/" selected-property-id "/profiles/")
-                                                    div-id)
-                                  nil {:opts {:method "POST"}}))]]]
-                   [:div {:class "panel panel-default"}
-                    [:div.panel-body
-                     [:div
-                      [:h4 "Upload CSV property details"]
-                      (let [div-id "property-details-form"]
-                        (om/build (file/file-upload (str "/4/entities/" selected-property-id) div-id)
-                                  nil {:opts {:method "PUT"}}))]]]]]])])))))
+                           :href (str "/4/templates/for-entity/" selected-property-id)} "Download"]]]]]
+                  ;; Upload measurements
+                  [:div.panel.panel-default
+                   [:div.panel-body
+                    [:div
+                     [:h4 "Upload measurements CSV"]
+                     (let [div-id "measurements-upload"]
+                       (om/build (file/file-upload "/4/measurements/"
+                                                   div-id)
+                                 nil {:opts {:method "POST"}}))]]]
+                  ;; Upload profile data
+                  [:div.panel.panel-default
+                   [:div.panel-body
+                    [:div
+                     [:h4 "Upload CSV profile data"]
+                     (let [div-id "file-form"]
+                       (om/build (file/file-upload (str "/4/entities/" selected-property-id "/profiles/")
+                                                   div-id)
+                                 nil {:opts {:method "POST"}}))]]]
+                  ;; Upload property details
+                  [:div.panel.panel-default
+                   [:div.panel-body
+                    [:div
+                     [:h4 "Upload CSV property details"]
+                     (let [div-id "property-details-form"]
+                       (om/build (file/file-upload (str "/4/entities/" selected-property-id) div-id)
+                                 nil {:opts {:method "PUT"}}))]]]]])])))))


Step 6: Bulk processing

Step 6: Bulk processing

--- desktop/src-common/brain_gain_or_drain/screens/game.clj
+++ desktop/src-common/brain_gain_or_drain/screens/game.clj
@@ -40,7 +40,9 @@
               :player (texture "brain.png")
               :logo (texture! (texture "clojure-logos.png") :split 64 64)
              })
-    [])
+    [(take 20 (sprite-generator {:type :logo :z 2} (width screen) (height screen)))
+     (take 15 (sprite-generator {:type :logo :z 1} (width screen) (height screen)))
+     (take 10 (sprite-generator {:type :logo :z 0} (width screen) (height screen)))])

   :on-render
   (fn [screen entities]


Follow symlinks for nnml dirs too

Follow symlinks for nnml dirs too

--- src/net/dishevelled/mailindex/backends/nnml.clj
+++ src/net/dishevelled/mailindex/backends/nnml.clj
@@ -49,7 +49,7 @@
   "Find any messages that have been updated"
   [connection & [index-mtime]]
   (let [base (-> @connection :config :base)
-        cmd ["find" base "-type" "f"]
+        cmd ["find" "-L" base "(" "-type" "f" "-o" "-type" "l" ")"]
         cmd (if index-mtime
               (concat cmd ["-mtime" (str "-" (inc
                                               (mtime-to-days index-mtime)))])


Add defaults map for SNES controller.

Add defaults map for SNES controller.

--- src/org/playasophy/wonderdome/input/gamepad.clj
+++ src/org/playasophy/wonderdome/input/gamepad.clj
@@ -80,7 +80,7 @@
 (def ^:const snes-product-id 0xd015)

-(def ^:private snes-buttons
+(def ^:private snes-bits
   {:X      [3 0]
    :A      [3 1]
    :B      [3 2]
@@ -89,6 +89,19 @@
    :R      [3 5]
    :select [4 0]
    :start  [4 1]})
+
+
+(def ^:private snes-defaults
+  {:x-axis 0.0
+   :y-axis 0.0
+   :X      false
+   :A      false
+   :B      false
+   :Y      false
+   :L      false
+   :R      false
+   :select false
+   :start  false})

 (defn- snes-read-state
@@ -105,7 +118,7 @@
       (str "Incomplete data read from SNES controller: "
            (apply str (map (partial format "%02X") (take len buffer)))))
     (assoc
-      (read-buttons snes-buttons buffer)
+      (read-buttons snes-bits buffer)
       :x-axis (byte-axis (aget buffer 0))
       :y-axis (- (byte-axis (aget buffer 1))))))


Get the ConnectionManager more or less the way I want

Except that it belongs in the Client

--- src/clj/com/frereth/web/connection_manager.clj
+++ src/clj/com/frereth/web/connection_manager.clj
@@ -36,31 +36,103 @@
    [this]
    this))

+(def auth-dialog-description {:expires DateTime
+                              :client-script s/Str})
+(def optional-auth-dialog-description (s/Maybe auth-dialog-description))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal

+(s/defn request-auth-descr
+  "Signal the server that we want to get in touch"
+  [auth-sock :- mq/Socket]
+  (com-comm/dealer-send! auth-sock :where-should-my-people-call-your-people))
+
+(s/defn unexpired-auth-description :- optional-auth-dialog-description
+  [this :- ConnectionManager
+   potential-description :- optional-auth-dialog-description]
+  "If we're missing the description, or it's expired, try to read a more recent"
+  (let [now (DateTime.)]
+    (if (or (not potential-description)
+            (< now (:expires potential-description)))
+      (let [auth-sock (-> :frereth-server :auth-sock)]
+        (if-let [description-frames (com-comm/dealer-recv! auth-sock)]
+          ;; Note that this newly received description could also be expired already
+          (translate-description-frames description-frames)  ; Previous request triggered this
+          (request-auth-descr auth-sock)))  ; trigger another request
+      potential-description)))  ; Last received version still good
+
+(s/defn ^:always-validate send-auth-descr-response!
+  [{:keys [respond]}
+   current-description :- auth-dialog-description]
+  (async/>!! respond current-description))
+
+(s/defn ^:always-validate send-wait!
+  [{:keys [respond]}]
+  (async/>!! respond :hold-please))
+
+(s/defn dispatch-auth-request :- s/Any
+  [this :- ConnectionManager
+   v
+   c :- fr-skm/async-channel
+   current-description :- optional-auth-dialog-description]
+  (when-not (= c (:auth-request this))
+    (raise {:problem "Auth request on unexpected channel"
+            :details {:value v
+                      :channel c}
+            :possibilities this}))
+  (if-let [current-description (unexpired-auth-description this current-description)]
+    (send-auth-descr-response! v current-description)
+    (send-wait! v)))
+
 (s/defn auth-loop-creator :- fr-skm/async-channel
-  [this :- ConnectionManager]
-  (let [auth-sock (-> this :frereth-server :auth-sock)
+  [{:keys [auth-request frereth-server]
+    :as this} :- ConnectionManager]
+  (let [auth-sock (:auth-sock frereth-server)
         auth-request (:auth-request this)
         minutes-5 (partial async/timeout (* 5 (util/minute)))]
     ;; It seems almost wasteful to start this before there's any
     ;; interest to express. But the 90% (at least) use case is for
     ;; the local server where there won't ever be any reason
     ;; for it to timeout.
-    (com-comm/dealer-send! auth-sock :where-should-my-people-call-your-people)
-    (async/go-loop [t-o (minutes-5)]
+    (request-auth-descr auth-sock)
+    (async/go-loop [t-o (minutes-5)
+                    dialog-description nil]
       (let [[v c] (async/alts! [auth-request to])]
         (if v
-          (raise :not-implemented "Start Here")
+          (let [dialog-description (dispatch-auth-request this v c dialog-description)]
+            (recur (minutes-5) dialog-description))
           (when (= t-o c)
             (log/info "Auth Loop Creator: heartbeat")
-            (recur (minutes-5)))))
+            (recur (minutes-5) dialog-description))))
       (log/warn "ConnectionManager's auth-loop exited"))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public

+(s/defn ^:always-validate initiate-handshake :- optional-auth-dialog-description
+  [this :- ConnectionManager
+   attempts :- s/Int
+   timeout-ms :- s/Int]
+  (let [receiver (async/chan)
+        responder {:respond receiver}
+        transmitter (:auth-request this)]
+    (loop [remaining-attempts attempts]
+      (when (< 0 remaining-attempts)
+        (let [[v c] (async/alts!! [[transmitter responder] (async/timeout timeout-ms)])]
+          (if v
+            (if (= v :hold-please)
+              (do
+                (log/info "Request for AUTH dialog ACK'd. Waiting...")
+                (recur (dec remaining-attempts)))
+              v)
+            (if (= c transmitter)
+              (log/error "Auth channel closed")
+              (do
+                (log/warn "Timed out trying to transmit request for AUTH dialog.\n"
+                          (dec remaining-attempts) " attempts remaining")
+                (recur (dec remaining-attempts))))))))))
+
 (s/defn ctor :- ConnectionManager
   [{:keys [url]}]
   (map->ConnectionManager {:url url}))


Fix require statements

Fix require statements

--- src/clj/freestuffly/gumtree/groups_scraper.clj
+++ src/clj/freestuffly/gumtree/groups_scraper.clj
@@ -1,8 +1,8 @@
 (ns freestuffly.gumtree.groups-scraper
   (:require [clj-yaml.core :as yaml])
-  (:require [clj-http.client :as client])
-  (:require [clojure.string :as string])
-  (:require [freestuffly.gumtree.result-parser :as result-parser]))
+            [clj-http.client :as client]
+            [clojure.string :as string]
+            [freestuffly.gumtree.result-parser :as result-parser])

 (def ^:private config (yaml/parse-string (slurp "config/gumtree.yml")))


Refactored api.entities.game functions.

Refactored api.entities.game functions.

Refactored common get-game* boilerplate into a private get-game-info function that takes the game-id, a db/fetch function, and a response formatting function.

--- src/api/entities/game.clj
+++ src/api/entities/game.clj
@@ -3,6 +3,15 @@
   (:require [api.db :as db]
             [api.util.date :as date]
             [api.util.param :as param]))
+
+(defn- get-game-info
+  [id fetch-info-fn format-fn]
+  (let [game-id (param/string-to-int id nil)
+        game (when game-id (fetch-info-fn game-id))]
+    (if game
+        (format-fn game)
+        (throw+ {:status 404
+                 :body (str "Game ID not found: " id)}))))

 (defn- format-game
   [game]
@@ -41,37 +50,17 @@

 (defn get-game-remixes
   [id]
-  (let [game-id (param/string-to-int id nil)
-        game (when game-id (db/fetch-id-name :games game-id))]
-    (if game
-        (format-game-remixes game)
-        (throw+ {:status 404
-                 :body (str "Game ID not found: " id)}))))
+  (get-game-info id (partial db/fetch-id-name :games) format-game-remixes))

 (defn get-game-albums
   [id]
-  (let [game-id (param/string-to-int id nil)
-        game (when game-id (db/fetch-id-name :games game-id))]
-    (if game
-        (format-game-albums game)
-        (throw+ {:status 404
-                 :body (str "Game ID not found: " id)}))))
+  (get-game-info id (partial db/fetch-id-name :games) format-game-albums))

 (defn get-game-songs
   [id]
-  (let [game-id (param/string-to-int id nil)
-        game (when game-id (db/fetch-id-name :games game-id))]
-    (if game
-        (format-game-songs game)
-        (throw+ {:status 404
-                 :body (str "Game ID not found: " id)}))))
+  (get-game-info id (partial db/fetch-id-name :games) format-game-songs))

 (defn get-game
   [id]
-  (let [game-id (param/string-to-int id nil)
-        game (when game-id (db/fetch-game game-id))]
-    (if game
-        (format-game game)
-        (throw+ {:status 404
-                 :body (str "Game ID not found: " id)}))))
+  (get-game-info id db/fetch-game format-game))


remove leading and trailing spaces for day number

--- src/cljs_workcalendar/datasource/consultantru.clj
+++ src/cljs_workcalendar/datasource/consultantru.clj
@@ -14,7 +14,7 @@
   (= (:class (:attrs html-element)) "weekend"))

 (defn- day [html-element]
-  (Integer/parseInt (first (:content html-element))))
+  (Integer/parseInt (.trim (first (:content html-element)))))

 (defn- extract-non-working-days [calendar-element year month]
   (filter #(not (nil? %))