Always add at least one on gendata.

Always add at least one on gendata.

--- src/org/scode/httpgctest.clj
+++ src/org/scode/httpgctest.clj
@@ -29,12 +29,12 @@
   (let [amount (let [amstr (:amount (:query-params request))]
                  (if amstr
                    (Integer/parseInt amstr)
-                   (count @data)))]
+                   (max 1 (count @data))))]
     (dosync
      (alter data #(concat %1 (repeat amount "data"))))
-  {:status 200
-   :headers {}
-   :body (str "size is now " (count @data))}))
+    {:status 200
+     :headers {}
+     :body (str "size is now " (count @data) " after adding " amount)}))

 (defn serve-dropdata [request]
   (let [old-size (count @data)]


Teach insts how about node-status and node-block-until-ready. For insts, this is really composite behaviour - depending on the sub synths within the inst. Also use with-server-sync when creating inst groups to ensure sequential creation (some groups depend on the existence of previous groups for location).

--- src/overtone/studio/inst.clj
+++ src/overtone/studio/inst.clj
@@ -1,6 +1,7 @@
 (ns overtone.studio.inst
-  (:use [overtone.sc defaults bindings server synth ugens envelope node bus]
+  (:use [overtone.sc defaults bindings server synth ugens envelope node bus dyn-vars]
         [overtone.sc.machinery synthdef]
+        [overtone.sc.machinery.server.comms :only [with-server-sync]]
         [overtone.sc.util :only (id-mapper)]
         [overtone.studio core mixer fx]
         [overtone.helpers lib]
@@ -45,12 +46,14 @@
 (defn inst-volume!
   "Control the volume of a single instrument."
   [inst vol]
+  (ensure-node-active! inst)
   (ctl (:mixer inst) :volume vol)
   (reset! (:volume inst) vol))

 (defn inst-pan!
   "Control the pan setting of a single instrument."
   [inst pan]
+  (ensure-node-active! inst)
   (ctl (:mixer inst) :pan pan)
   (reset! (:pan inst) pan))

@@ -61,6 +64,7 @@

 (defmethod inst-fx! :mono
   [inst fx]
+  (ensure-node-active! inst)
   (let [fx-group (:fx-group inst)
         bus      (:bus inst)
         fx-id    (fx :tgt fx-group :pos :tail :bus bus)]
@@ -68,6 +72,7 @@

 (defmethod inst-fx! :stereo
   [inst fx]
+  (ensure-node-active! inst)
   (let [fx-group (:fx-group inst)
         bus-l    (to-sc-id (:bus inst))
         bus-r    (inc bus-l)
@@ -77,6 +82,7 @@

 (defn clear-fx
   [inst]
+  (ensure-node-active! inst)
   (group-clear (:fx-group inst))
   :clear)

@@ -112,9 +118,7 @@
                      group instance-group fx-group
                      mixer bus fx-chain
                      volume pan
-                     n-chans
-                     status
-                     loaded?]
+                     n-chans]
   (fn [this & args]
     (apply synth-player sdef params this :tgt instance-group args))

@@ -134,14 +138,23 @@
   `(let [[sname# params# ugens# constants# n-chans# inst-bus#] (pre-inst ~sname ~@args)
          new-inst# (get (:instruments @studio*) sname#)
          container-group# (or (:group new-inst#)
-                              (group (str "Inst " sname# " Container")
-                                     :tail (:instrument-group @studio*)))
+                              (with-server-sync
+                                #(group (str "Inst " sname# " Container")
+                                        :tail (:instrument-group @studio*))
+                                "whilst creating an inst container group"))
+
          instance-group#  (or (:instance-group new-inst#)
-                              (group (str "Inst " sname#)
-                                     :head container-group#))
+                              (with-server-sync
+                                #(group (str "Inst " sname#)
+                                        :head container-group#)
+                                "whilst creating an inst instance group"))
+
          fx-group#        (or (:fx-group new-inst#)
-                              (group (str "Inst " sname# " FX")
-                                     :tail container-group#))
+                              (with-server-sync
+                                #(group (str "Inst " sname# " FX")
+                                        :tail container-group#)
+                                "whilst creating an inst fx group"))
+
          imixer#    (or (:mixer new-inst#)
                         (inst-mixer n-chans#
                                     :tgt container-group#
@@ -159,8 +172,7 @@
                              imixer# inst-bus# fx-chain#
                              volume# pan#
                              n-chans#
-                             (:status container-group#)
-                             (:loaded? container-group#))
+                             )
                       {:overtone.helpers.lib/to-string #(str (name (:type %)) ":" (:name %))})]
      (load-synthdef sdef#)
      (add-instrument inst#)
@@ -261,6 +273,29 @@
                              (vals (ns-publics 'overtone.instrument))))]
     (load-synthdef synth)))

+(defn- inst-block-until-ready*
+  [inst]
+  (when *block-node-until-ready?*
+    (doseq [sub-node [(:fx-group inst)
+                      (:group inst)
+                      (:instance-group inst)
+                      (:mixer inst)]]
+      (node-block-until-ready sub-node))))
+
+(defn- inst-status*
+  [inst]
+  (let [sub-nodes [(:fx-group inst)
+                   (:group inst)
+                   (:instance-group inst)
+                   (:mixer inst)]]
+    (cond
+     (some #(= :loading @(:status %)) sub-nodes) :loading
+     (some #(= :destroyed @(:status %)) sub-nodes) :destroyed
+     (some #(= :paused @(:status %)) sub-nodes) :paused
+     (every? #(= :live @(:status %)) sub-nodes) :live
+     :else (throw (Exception. "Unknown instrument sub-node state: "
+                              (with-out-str (doseq [n sub-nodes] (pr n))))))))
+
 (extend Inst
   ISynthNode
   {:node-free  node-free*
@@ -278,5 +313,5 @@
   {:kill* (fn [this] (group-deep-clear (:instance-group this)))}

   ISynthNodeStatus
-  {:node-status            node-status*
-   :node-block-until-ready node-block-until-ready*})
+  {:node-status            inst-status*
+   :node-block-until-ready inst-block-until-ready*})


fix up docstring

fix up docstring

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -137,7 +137,8 @@
 (defn midi-capture-next-control-input
   "Returns a simple map representing next modified controller. Useful
   for detecting controller information. If the argument with-key? is set
-  to true, the full event key will associated with the resulting map."
+  to true, the full event key will be associated with the resulting
+  map."
   ([] (midi-capture-next-control-input false))
   ([with-key?]
      (let [p (promise)]


Fixing the cmr-indexer-app.

Fixing the cmr-indexer-app.

--- test/cmr/indexer/services/index_service_test.clj
+++ test/cmr/indexer/services/index_service_test.clj
@@ -25,7 +25,9 @@
                                :version-id version-id}
                      :temporal {:range-date-times [{:beginning-date-time (t/date-time 1996 2 24 22 20 41)
                                                     :ending-date-time (t/date-time 1997 3 25 23 23 43 123)}]}
-                     :projects projects}
+                     :projects projects
+                     :two-d-coordinate-systems [{:name "FOO"}
+                                                {:name "Bar"}]}
         expected {:concept-id concept-id
                   :entry-title dataset-id
                   :entry-title.lowercase "a minimal valid collection v 1"
@@ -38,7 +40,9 @@
                   :start-date "1996-02-24T22:20:41.000Z"
                   :end-date "1997-03-25T23:23:43.123Z"
                   :project-sn ["ESI" "EVI" "EPI"]
-                  :project-sn.lowercase ["esi" "evi" "epi"]}
+                  :project-sn.lowercase ["esi" "evi" "epi"]
+                  :two-d-coord-name ["FOO" "Bar"]
+                  :two-d-coord-name.lowercase  ["foo" "bar"]}
         actual (svc/concept->elastic-doc nil concept umm-concept)]
     (is (= expected actual))))


Add some notes about animating the erased-walk part of Wilson's algorithm.

--- src/snergly/algorithms.cljc
+++ src/snergly/algorithms.cljc
@@ -146,6 +146,15 @@
         path
         (let [next-coord (rand-nth (g/cell-neighbors (g/grid-cell grid current-coord)))
               position (#?(:clj .indexOf :cljs cljs-index-of) path next-coord)]
+          ;; in order to animate doing the walk in addition to actually carving
+          ;; the path, we would need to pass in result-chan and
+          ;; report-partial-steps? here, include the grid in the recur *and*
+          ;; the return value, and at this point update the color of
+          ;; current-coord and, if report-partial-steps?, put the updated grid
+          ;; onto result-chan.  (Oh, and also we'd have to have conditional code
+          ;; for setting the color in both the cljs and clj ways, and we'd
+          ;; have to update wilsons-carve-passage to erase the cell color from
+          ;; each cell as it carves the path.  Hardly seems worth it.
           (recur next-coord
                  (if (neg? position)
                    (conj path next-coord)


todomvc: bump clojars deps

todomvc: bump clojars deps

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -26,12 +26,12 @@
                                            [cljsjs/jquery-ui "1.11.4-0"]
                                            [cljsjs/filesaverjs "1.1.20151003-0"]]}

-             :clojars-deps {:dependencies [[carry "0.3.0"]
-                                           [carry-debugger "0.4.0"]
+             :clojars-deps {:dependencies [[carry "0.4.0"]
+                                           [carry-debugger "0.5.0"]
                                            [carry-history "0.3.0"]
                                            [carry-logging "0.1.0"]
                                            [carry-persistence "0.3.0"]
-                                           [carry-reagent "0.4.0"]
+                                           [carry-reagent "0.5.0"]
                                            [carry-schema "0.4.0"]]}}

   :cljsbuild {:builds [{:id           "clojars-deps"


Update to include pre-filled links

Update to include pre-filled links

--- scrape-n-mail/src/scrape_n_mail/core.cljs
+++ scrape-n-mail/src/scrape_n_mail/core.cljs
@@ -1,7 +1,7 @@
 (ns scrape-n-mail.core
     (:require [rum.core :as rum]
               [cljs-http.client :as http]
-              [clojure.string :refer [join split starts-with? trim]]
+              [clojure.string :refer [join split starts-with? trim lower-case]]
               [cljs-time.format :as fmt]
               ; dt is for datetime
               [cljs-time.core :as dt]
@@ -48,19 +48,29 @@
                  ::submitter-email ::submitter-name]
            :opt [::procunciation-hints]))

+; this is a bit brittle - based on the structure of the form at some point in time
 (defn row-to-held-person [[timestamp name-for-altar _ pronunciation your-name your-email is-group? name-public]]
   (merge
-    ; Our required fields
-    {::when-submitted (fmt/parse goog-datetime timestamp)
-     ::held-name-altar (trim name-for-altar)
-     ::held-name-public (if (empty? name-public) (first (split name-for-altar #"\s+")) name-public)
-     ; We could make this more robust - but should be fine for now
-     ::is-group-or-class (and (not (nil? is-group?)) (starts-with? is-group? "YES"))
-     ; ::is-group-or-class is-group?
-     ::submitter-email your-email
-     ::submitter-name your-name}
-    ; And the optional field
-    (when-not (empty? pronunciation) {::procunciation-hints pronunciation}) ))
+    (let [processed-group (and (not (nil? is-group?)) (starts-with? is-group? "YES"))]
+      ; Our required fields
+      {::when-submitted (fmt/parse goog-datetime timestamp)
+       ::held-name-altar (trim name-for-altar)
+       ; We could make this more robust - but should be fine for now
+       ::is-group-or-class processed-group
+       ; The logic is a little complex
+       ; If we lack a public name, we propose one - if it's a group, we just
+       ; use the full text, otherwise we use the first word of the altar name.
+       ; We likely need a dictionary for stop-words like "Ms."
+       ::held-name-public (if (empty? name-public)
+                            (if processed-group
+                              name-for-altar
+                              (first (split name-for-altar #"\s+")) )
+                            name-public)
+       ; ::is-group-or-class is-group?
+       ::submitter-email (trim (lower-case your-email))
+       ::submitter-name (trim your-name)} )
+      ; And the optional field
+      (when-not (empty? pronunciation) {::procunciation-hints pronunciation}) ))

 (defn get-wellbeing-data []
   (->
@@ -127,8 +137,30 @@
           (.load js/gapi "client:auth2" #(init-client config-keys)) )
         #_(println keys-resp) )))

-
-(rum/defc hello-world < rum/reactive []
+(defn prefilled-link [{name-altar ::held-name-altar
+                       name-public ::held-name-public
+                       pronunciation ::procunciation-hints
+                       group ::is-group-or-class
+                       submitter-name ::submitter-name
+                       submitter-email ::submitter-email}]
+  ; Format into links like this:
+  ; https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform?usp=pp_url&entry.1145228181=name-for-altar&entry.2041965689=name-for-public&entry.1791240241=pronunciation-hints&entry.628312063=YES,+this+is+a+group&entry.552838120=your-name&entry.681476151=your-email
+  ; https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform?usp=pp_url&entry.1145228181&entry.2041965689&entry.1791240241&entry.552838120&entry.681476151
+  (let [url-root
+        "https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform?usp=pp_url"
+        custom-url
+        (join \& [ url-root
+                  (str "entry.1145228181=" name-altar)
+                  (str "entry.2041965689=" name-public)
+                  (str "entry.1791240241=" pronunciation)
+                  (if group "entry.628312063=YES,+this+is+a+group")
+                  (str "entry.552838120=" submitter-name)
+                  (str "entry.681476151=" submitter-email)])]
+
+    [:a {:href custom-url} name-altar]
+  ))
+
+(rum/defc scrape-it < rum/reactive []
   (let [curr-data (rum/react app-data)]
     [:div
       [:h2 "Wellness Scraper"]
@@ -148,29 +180,30 @@
                [:p "Dear " (::submitter-name (first name-records)) ","]

                [:p "Currently, the community is holding the following names on the altar "
-                   "in support of their wellbeing at your request:"
+                   "in support of their wellbeing at your request. This month, you can click "
+                   "directly on each name you would like to remain and get a pre-filled form. "
+                   "Please check each submission before clicking the submit button, and let Dav know if there is anything incorrect."
                 (into [:ul {:id "content"}]
                   ; We currently assume all visible data is "current"
                   ; (filter #(s/includes? (aget % 0) "2017"))
                   ; Each line is a list, this joins them in to one string
-                  (map #(vector :li (::held-name-altar %)) name-records))
-
-                "Please let us know if these names should remain, along with any other names "
-                "you'd like added by (re-)submitting names at "
+                  ; (map #(vector :li (::held-name-altar %)) name-records))
+                  (map #(vector :li (prefilled-link %)) name-records))
+
+                "New names may be submitted at "
                 [:a {:href "https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform"}
-                "this link"] ". If that link doesn't work, you can copy-paste it into your browser:"]
+                "this link"] ". If the above links don't work, you can copy-paste the form link into your browser:"]

                [:p "https://docs.google.com/forms/d/e/1FAIpQLSc_FFrH7a_ClDmpAq36vA7gdUd1njmoEK0wfhRNaYcjfLox0w/viewform"]

-               [:p "If we do not hear from you, we will assume they are doing better and "
-                "remove them from the altar."]
+               [:p "If we do not hear from you, we will remove these names from the altar. Jai mitra!"]

                ; Note that the \ is an escape character!
                [:p "/|\\"]
                 ]))
      ]))

-(rum/mount (hello-world)
+(rum/mount (scrape-it)
            (. js/document (getElementById "app")))

 (defn on-js-reload []


add icon lightbox

add icon lightbox

--- frontend/uxbox/ui/elements.cljs
+++ frontend/uxbox/ui/elements.cljs
@@ -154,6 +154,7 @@
         ]
         [:div.dashboard-grid-content
           [:div.grid-item.small-item.add-project
+            {on-click #(lightbox/set! :new-icon)}
             [:span "+ New icon"]]
           [:div.grid-item.small-item.project-th
             [:span.grid-item-image i/logo-icon]
@@ -411,9 +412,12 @@
     :name "colors"
     :mixins [rum/static]}))

-;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Lightbox
-;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; ADD ELEMENT LIGHTBOX
+
 (defn- new-element-lightbox-render
   [own]

@@ -443,3 +447,35 @@
 (defmethod lightbox/render-lightbox :new-element
   [_]
   (new-element-lightbox))
+
+;; ADD ICON LIGHTBOX
+
+(defn- new-icon-lightbox-render
+  [own]
+
+   (html
+    [:div.lightbox-body
+      [:h3 "New icon"]
+        [:div.row-flex
+          [:div.lightbox-big-btn
+            [:span.big-svg i/shapes]
+            [:span.text "Go to workspace"]
+          ]
+          [:div.lightbox-big-btn
+            [:span.big-svg.upload i/exit]
+            [:span.text "Upload file"]
+          ]
+        ]
+      [:a.close {:href "#"
+                :on-click #(do (dom/prevent-default %)
+                               (lightbox/close!))}
+                               i/close]]))
+
+(def new-icon-lightbox
+  (util/component
+   {:render new-icon-lightbox-render
+    :name "new-icon-lightbox"}))
+
+(defmethod lightbox/render-lightbox :new-icon
+  [_]
+  (new-icon-lightbox))


Update chart logger; ensure frame doesn't exit VM

--- clojure/src/evolution_programs/logging/chart.clj
+++ clojure/src/evolution_programs/logging/chart.clj
@@ -5,8 +5,7 @@
            [org.jfree.data.category CategoryDataset DefaultCategoryDataset]
            [org.jfree.data.function Function2D]
            [org.jfree.data.general DatasetUtilities]
-           [org.jfree.data.xy XYDataset XYSeries XYSeriesCollection]
-           [org.jfree.ui ApplicationFrame]))
+           [org.jfree.data.xy XYDataset XYSeries XYSeriesCollection]))

 (ChartFactory/setChartTheme (StandardChartTheme. "JFree/Shadow" true))

@@ -40,9 +39,10 @@
       (.add content-pane (panel (chart dataset))))))

 (defn- frame [title & datasets]
-  (doto (ApplicationFrame. title)
+  (doto (JFrame. title)
     (add-charts datasets)
     (.setExtendedState JFrame/MAXIMIZED_BOTH)
+    (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
     (.setVisible true)))

 (defn- ->Function2D [f]


Wrap stacktrace properly to capture applicaton context.  Fix #77.

--- src/rdf-repository/grafter/rdf/repository.clj
+++ src/rdf-repository/grafter/rdf/repository.clj
@@ -387,7 +387,7 @@
                                                 (converter-f (.next results))
                                                 (catch Exception e
                                                   (.close results)
-                                                  (throw e)))]
+                                                  (throw (ex-info "Error reading results" {:prepared-query prepared-query} e))))]
                            (lazy-cat
                             [current-result]
                             (pull-query)))


Add support for continual status updates; more robust support for error processing; cancelations of flows on node aborts

--- src/aerobio/htseq/common.clj
+++ src/aerobio/htseq/common.clj
@@ -577,6 +577,8 @@
   (let [fqzmap (get-all-replicate-fqzs eid)
         rnm-bits (str/split #"-" repname)
         fqzs (fqzmap (cljstr/join "-" (coll/takev 2 rnm-bits)))]
+    (assert (seq fqzs)
+            (format "%s : There are no fastq files for %s" eid repname))
     (if (< (count rnm-bits) 3)
       fqzs
       (->> fqzs
@@ -599,16 +601,40 @@
       prn (->> cfg clojure.pprint/pprint)
       :else cfg)))

+(defmacro safe-deref
+  "Deref future fut ensuring against throwing an 'errant' exception due
+  to being canceled"
+  [fut]
+  `(try
+     (deref ~fut)
+     (catch Error e#
+       {:error (type e#), :msg ((Throwable->map e#) :cause)})
+     (catch Exception e#
+       {:error (type e#), :msg ((Throwable->map e#) :cause)})))
+
+(defn job-flow-node-results
+  ""
+  [futs-vec status-atom]
+  (reduce (fn[abort? fut]
+              (when abort? (future-cancel fut))
+              (let [res (safe-deref fut)]
+                (swap! status-atom #(assoc % :done (conj (% :done) res)))
+                (if (and (map? res) (res :error))
+                  true
+                  false)))
+            false futs-vec))
+

 (defn run-phase-0
-  [eid recipient get-toolinfo template]
+  [eid recipient get-toolinfo template status-atom]
   (let [ph0 template
         cfg (-> (assoc-in ph0 [:nodes :ph0 :args] [eid recipient])
                 (pg/config-pgm-graph-nodes get-toolinfo nil nil)
                 pg/config-pgm-graph)
         ;;_ (clojure.pprint/pprint cfg)
         futs-vec (->> cfg pg/make-flow-graph pg/run-flow-program)]
-    (mapv (fn[fut] (deref fut)) futs-vec)))
+    (job-flow-node-results futs-vec status-atom)
+    (@status-atom :done)))

 ;;;(ns-unmap 'aerobio.htseq.common 'get-phase-1-args)
@@ -620,7 +646,7 @@
   (fn[exptype & args] exptype))

 (defn run-phase-1
-  [eid recipient get-toolinfo template & {:keys [repk]}]
+  [eid recipient get-toolinfo template status-atom & {:keys [repk]}]
   (let [exp (get-exp-info eid :exp)
         phase1-job-template template
         bt (if (-> template (get-in [:nodes :ph1 :name])
@@ -633,27 +659,49 @@
                        (mapcat #((get-exp-info eid :replicate-names) %)
                                (get-exp-info eid :sample-names))
                        sample-names)]
-    (doseq [tuple (partition-all 2 sample-names)]
-      (let [futs-vecs
-            (mapv
-             (fn[snm]
-               (let [job (assoc-in phase1-job-template [:nodes :ph1 :args]
-                                   (get-phase-1-args
-                                    exp eid snm :repk repk
-                                    :bowtie bt :star star))
-                     cfg (-> job
-                             (pg/config-pgm-graph-nodes get-toolinfo nil nil)
-                             pg/config-pgm-graph)]
-                 #_(clojure.pprint/pprint cfg)
-                 (->> cfg pg/make-flow-graph pg/run-flow-program)))
-             tuple)]
-        (mapv (fn[futs] (mapv (fn[fut] (deref fut)) futs))
-              futs-vecs)))
+    (swap! status-atom assoc :DONE [])
+    (loop [tuples (partition-all 2 sample-names)
+           abort? false]
+      (if (or (empty? tuples) abort?)
+        abort?
+        (let [tuple (first tuples)
+              futs-vecs
+              (mapv
+               (fn[snm]
+                 (let [job (assoc-in phase1-job-template [:nodes :ph1 :args]
+                                     (get-phase-1-args
+                                      exp eid snm :repk repk
+                                      :bowtie bt :star star))
+                       cfg (-> job
+                               (pg/config-pgm-graph-nodes get-toolinfo nil nil)
+                               pg/config-pgm-graph)]
+                   #_(clojure.pprint/pprint cfg)
+                   (->> cfg pg/make-flow-graph pg/run-flow-program)))
+               tuple)]
+          (recur (rest tuples)
+                 (coll/reducem
+                  (fn[replicate futs]
+                    (let [abort? (job-flow-node-results futs status-atom)
+                          flow-results (@status-atom :done)]
+                      (swap! status-atom
+                             #(assoc % :DONE
+                                     (conj (% :DONE) [replicate flow-results])))
+                      abort?))
+                  (fn ([] false) ([x y] #_(println x y) (or x y)))
+                  :|| tuple futs-vecs)))))
     (pg/send-msg
      [recipient]
      (str "Aerobio job status: " exp " phase-1  " eid)
      (str "Finished " (if repk "replicates" "merged") " for " eid ))))

+#_(let [a (atom [])]
+  [(coll/reducem
+    (fn [x y]
+      (swap! a conj [x y])
+      (if (= 0 x) true false))
+    (fn ([] false) ([x y] (println x y) (or x y)))
+    :|| (range 5) [:one :two :three :four :five])
+   @a])

 ;;;(ns-unmap 'aerobio.htseq.common 'get-comparison-files)
 (defmulti
@@ -699,7 +747,7 @@

 (defn launch-action
-  [eid recipient get-toolinfo template & {:keys [action rep compfile]}]
+  [eid recipient get-toolinfo template & {:keys [action rep compfile status]}]
   (prn "LAUNCH: "
        [eid recipient template action rep compfile])
   (let [exp (get-exp-info eid :exp)]
@@ -713,11 +761,11 @@
         (cond
           (#{"phase-0" "phase-0b" "phase-0c" "phase-0d"} phase)
           (pg/future+
-            (run-phase-0 eid recipient get-toolinfo template))
+            (run-phase-0 eid recipient get-toolinfo template status))

           (#{"phase-1" "bt2-phase-1" "bt1-phase-1" "star-phase-1"} phase)
           (pg/future+
-            (run-phase-1 eid recipient get-toolinfo template :repk rep))
+            (run-phase-1 eid recipient get-toolinfo template status :repk rep))

           (#{"phase-2" "phase-2b"} phase)
           (run-phase-2 exp eid recipient get-toolinfo template)


CMR-790: Added tests for additional attributes validation for parameter and aql searches.

--- test/cmr/system_int_test/search/collection_psa_search_test.clj
+++ test/cmr/system_int_test/search/collection_psa_search_test.clj
@@ -634,3 +634,57 @@
            [coll1 coll2] [{:type :dateRange :name "bravo" :value [20 nil]}]
            [coll1 coll2] [{:type :dateRange :name "bravo" :value [nil 24]}]
            [coll2] [{:type :dateRange :name "charlie" :value [44 45]}]))))
+
+(deftest range-validation-test
+  (testing "empty parameter range"
+    (are [attrib-value]
+         (= {:errors [(am/one-of-min-max-msg)]
+             :status 400}
+            (search/get-search-failure-xml-data
+              (search/find-refs :collection {"attribute[]" attrib-value})))
+
+         "string,alpha,,"
+         "int,alpha,,"
+         "float,alpha,,"
+         "date,alpha,,"
+         "time,alpha,,"
+         "datetime,alpha,,"))
+
+  (testing "invalid parameter range values"
+    (are [v min-n max-n]
+         (= {:errors [(am/max-must-be-greater-than-min-msg min-n max-n)]
+             :status 400}
+            (search/get-search-failure-xml-data
+              (search/find-refs :collection
+                                {"attribute[]" (format "%s,%s,%s" v (str min-n) (str max-n))})))
+
+         "string,alpha" "y" "m"
+         "int,alpha" 10 6
+         "float,alpha" 10.0 6.0))
+
+  (testing "empty aql range"
+    (are [attrib-value]
+         (= {:errors [(am/one-of-min-max-msg)]
+             :status 400}
+            (search/get-search-failure-xml-data
+              (search/find-refs-with-aql
+                :collection [{:additionalAttributes [attrib-value]}])))
+
+         {:type :range :name "alpha" :value [nil nil]}
+         {:type :intRange :name "alpha" :value [nil nil]}
+         {:type :floatRange :name "alpha" :value [nil nil]}
+         {:type :dateRange :name "alpha" :value [nil nil]}
+         {:type :timeRange :name "alpha" :value [nil nil]}))
+
+  (testing "invalid aql range values"
+    (are [attrib-value]
+         (= {:errors [(apply am/max-must-be-greater-than-min-msg (:value attrib-value))]
+             :status 400}
+            (search/get-search-failure-xml-data
+              (search/find-refs-with-aql
+                :collection [{:additionalAttributes [attrib-value]}])))
+
+         {:type :range :name "alpha" :value ["y" "m"]}
+         {:type :intRange :name "alpha" :value [10 6]}
+         {:type :floatRange :name "alpha" :value [10.0 6.0]})))
+


Added a test.

Added a test.

--- test/cmr/system_int_test/search/granule_search_format_test.clj
+++ test/cmr/system_int_test/search/granule_search_format_test.clj
@@ -56,12 +56,14 @@
            {:producer-granule-id ["p1" "p3"]} [g1-echo g1-smap]))

     (testing "Retrieving results in echo10"
-      (d/assert-metadata-results-match
-        :echo10 all-granules
-        (search/find-metadata :granule :echo10 {}))
-      (d/assert-metadata-results-match
-        :echo10 [g1-echo]
-        (search/find-metadata :granule :echo10 {:granule-ur "g1"}))
+      (are [search expected]
+           (d/assert-metadata-results-match
+             :echo10 expected
+             (search/find-metadata :granule :echo10 search))
+           {} all-granules
+           {:granule-ur "g1"} [g1-echo]
+           {:granule-ur "g3"} [g1-smap])
+
       (testing "as extension"
         (d/assert-metadata-results-match
           :echo10 [g1-echo]


CMR-2312 Fixes test error

CMR-2312 Fixes test error

--- umm-spec-lib/test/cmr/umm_spec/test/umm_json.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/umm_json.clj
@@ -137,4 +137,4 @@
                                                                  :SwathWidth "123"}}})
         orbit-params (-> umm-c :SpatialExtent :OrbitParameters)]
     (is (= 123.0 (:SwathWidth orbit-params)))
-    (is (= {:NumberOfOrbits "Could not parse value: foo"} (:_errors orbit-params)))))
+    (is (= {:NumberOfOrbits "Could not parse number value: foo"} (:_errors orbit-params)))))


Added comments in the classifier

Added comments in the classifier

--- src/atom_finder/classifier/reversed-subscript.clj
+++ src/atom_finder/classifier/reversed-subscript.clj
@@ -1,8 +1,11 @@
 (in-ns 'atom-finder.classifier)
-(import '(org.eclipse.cdt.core.dom.ast IASTArraySubscriptExpression))
+(import '(org.eclipse.cdt.core.dom.ast IASTArraySubscriptExpression IBasicType))

 (defn reversed-subscript-atom?
   "Is this node a reversed-subscript-atom?"
   [node]
   (and (instance? IASTArraySubscriptExpression node)
-       (instance? org.eclipse.cdt.core.dom.ast.IBasicType(.getExpressionType (first (children node))))))
+       ;;the first child will be the element to the left of the squared bracket
+       ;;.getExpressionType returns the type that the expression evaluates to
+       ;;IBasicType covers types that can be used as indices
+       (instance? IBasicType (.getExpressionType (first (children node))))))


remove trace output

remove trace output

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -548,9 +548,7 @@
                         (assoc-in [:items 1 :amount] (bigdec 99.99)))
             _ (try
                 (transactions/update storage-spec updated)
-                (catch RuntimeException e
-                  (println "exception caught")
-                  nil))]
+                (catch RuntimeException e nil))]
         (testing "transaction items are not updated"
           (is (= #{(bigdec 101)} (->> t2
                             (transactions/reload storage-spec)


CMR-1980: Filter to only pass in matching keywords

--- search-app/src/cmr/search/api/keyword.clj
+++ search-app/src/cmr/search/api/keyword.clj
@@ -81,7 +81,7 @@
     {:category all-topics})

-  {:category (parse-hierarchical-keywords keyword-hierarchy keywords nil nil)}
+  {:category (parse-hierarchical-keywords keyword-hierarchy keywords)}

   (def keywords
    (vals (kms/get-keywords-for-keyword-scheme
@@ -89,19 +89,18 @@
   )

 (defn- parse-hierarchical-keywords
-  "Returns keywords in a hierarchical fashion for the given keyword scheme and keywords."
-  [keyword-hierarchy keywords prev-field prev-value]
+  "Returns keywords in a hierarchical fashion based on the provided keyword hierarchy and keywords."
+  [keyword-hierarchy keywords]
   (when-let [field (first keyword-hierarchy)]
     (let [next-field (second keyword-hierarchy)]
       (let [values-for-field (keep (fn [k-word] (when (and (nil? (next-field k-word))
-                                                           (field k-word)
-                                                           (or (nil? prev-field)
-                                                               (= prev-value (prev-field k-word))))
+                                                           (field k-word))
                                                   {:value (field k-word)
                                                    :uuid  (:uuid k-word)})) keywords)]
         (for [value values-for-field
               :let [subfields (parse-hierarchical-keywords
-                                (rest keyword-hierarchy) keywords field (:value value))]]
+                                (rest keyword-hierarchy)
+                                (filter #(= (:value value) (field %)) keywords))]]
           (if (seq subfields)
             (assoc value
                    :subfields [(name next-field)]


Commented out the winner modal logic.

Commented out the winner modal logic.

--- src/cljs/wombats_web_client/panels/game-play.cljs
+++ src/cljs/wombats_web_client/panels/game-play.cljs
@@ -82,18 +82,13 @@
     (re-frame/dispatch [:set-modal {:fn #(winner-modal wombat-color wombat-name username)
                                     :show-overlay? false}])))

-(defn right-game-play-panel []
-  (let [messages (re-frame/subscribe [:game/messages])
-        arena (re-frame/subscribe [:game/arena])
-        stats (re-frame/subscribe [:game/stats])
-        info (re-frame/subscribe [:game/info])
-        winner (:game-winner @info)]
+(defn right-game-play-panel
+  [info messages stats]
+  (let [winner (:game-winner @info)]
+    ;; Dispatch winner modal if there's a winner
+    #_(when winner
+      (show-winner-modal winner))

-    ;; Dispatch winner modal if there's a winner
-    (when winner
-      (show-winner-modal winner))
-
-    (update-arena arena)
     [:div.right-game-play-panel

      [:div.top-panel
@@ -107,19 +102,25 @@
       [chat-box @game-id messages stats]]]))

 (defn game-play []
-  (let [dimensions (get-arena-dimensions)]
+  (let [dimensions (get-arena-dimensions)
+        arena (re-frame/subscribe [:game/arena])
+        info (re-frame/subscribe [:game/info])
+        messages (re-frame/subscribe [:game/messages])
+        stats (re-frame/subscribe [:game/stats])]
+
     ;; TODO This should come from the router
     (reset! game-id (get-game-id))
+
     (reagent/create-class
      {:component-will-unmount #(clear-game-panel-state)
       :display-name "game-play-panel"
       :reagent-render
       (fn []
+        (update-arena arena)
         [:div {:class-name "game-play-panel"}
-         [:div {:style {:color "white"}
-                :id "wombat-arena"
+         [:div {:id "wombat-arena"
                 :class-name "left-game-play-panel"}
           [:canvas {:id canvas-id
                     :width dimensions
                     :height dimensions}]]
-         [right-game-play-panel]])})))
+         [right-game-play-panel info messages stats]])})))


Remove unnecessary code.

Remove unnecessary code.

--- src/videotest/blob/core.clj
+++ src/videotest/blob/core.clj
@@ -4,7 +4,7 @@
    [quil.middleware :as m]
    [videotest.basic-mover.cv :as cv])
   (:import
-   [org.opencv.core CvType Mat MatOfByte MatOfFloat MatOfPoint MatOfPoint2f]))
+   [org.opencv.core CvType Mat]))

 (def CAM-SIZE (cv/camera-frame-size))
@@ -31,9 +31,7 @@
 (defn update [state]
   (-> state
       (cv/update-frame)
-      (cv/update-p-image)
-      #_(cv/init-gray-mat)
-      #_(cv/update-optical-flow)))
+      (cv/update-p-image)))

 (defn draw [state]
   (let [{:keys [p-image]} state]
@@ -42,7 +40,6 @@
     (q/translate WIDTH 0)
     (q/scale -1 1)
     (q/image p-image 0 0)
-    #_(draw-flow state)
     (q/pop-matrix)))

 (defn on-close


Add comment to future self about s3 timeouts

--- src/vignette/storage/s3.clj
+++ src/vignette/storage/s3.clj
@@ -8,6 +8,39 @@
             [vignette.util.filesystem :refer :all])
   (:use [environ.core])
   (:import [com.amazonaws.services.s3.model AmazonS3Exception]))
+
+
+;;;; Note about timeouts: The timeouts you can specify to the s3 client don't
+;;;; behave as expected. Setting the timeouts will cause the request to timeout
+;;;; but it doesn't match up with the values specified. I suspect it has
+;;;; something to do with the abstraction used in S3Client.
+;;;;
+;;;; In the example below we have timeouts set to 20ms yet it takes almost 2
+;;;; seconds for the exception to bubble up. --drsnyder
+
+(comment
+  (def storage-creds {:max-reties 0
+                      :socket-timeout 20 ; one of these should timeout most of the time
+                      :conn-timeout 20
+                      :access-key "..."
+                      :secret-key "..."
+                      :endpoint "http://endpoint"
+                      :proxy {:host nil}})
+
+  (time (try (s3/get-object storage-creds "muppet" "images/d/d4/Mo-Yet.jpg")
+             (catch Exception e (println (.getMessage e)) (clojure.stacktrace/e)))))
+;Unable to execute HTTP request: Read timed out
+;java.net.SocketTimeoutException: Read timed out
+ ;at java.net.SocketInputStream.socketRead0 (SocketInputStream.java:-2)
+    ;java.net.SocketInputStream.read (SocketInputStream.java:129)
+    ;org.apache.http.impl.io.AbstractSessionInputBuffer.fillBuffer (AbstractSessionInputBuffer.java:166)
+    ;org.apache.http.impl.io.SocketInputBuffer.fillBuffer (SocketInputBuffer.java:90)
+    ;org.apache.http.impl.io.AbstractSessionInputBuffer.readLine (AbstractSessionInputBuffer.java:281)
+    ;org.apache.http.impl.conn.LoggingSessionInputBuffer.readLine (LoggingSessionInputBuffer.java:115)
+    ;org.apache.http.impl.conn.DefaultHttpResponseParser.parseHead (DefaultHttpResponseParser.java:92)
+    ;org.apache.http.impl.conn.DefaultHttpResponseParser.parseHead (DefaultHttpResponseParser.java:62)
+;"Elapsed time: 1912.641 msecs"
+

 (def default-storage-connection-timeout 100)
 (def default-storage-get-socket-timeout 500)


Add tests for conforming and parasing joins with sub-joins

--- src/test/workflo/macros/specs/query_test.cljc
+++ src/test/workflo/macros/specs/query_test.cljc
@@ -395,3 +395,67 @@
        :alias d
        :parameters {e f g h}}]
     '[({a [b c]} :as d {e f g h})]))
+
+(deftest conforming-joins-with-sub-joins
+  (are [out in] (= out (q/conform in))
+    '[[:property
+       [:join
+        [:properties
+         {[:simple users]
+          [[:prefixed-properties {:base db
+                                  :children [[:property [:simple id]]]}]
+           [:prefixed-properties {:base user
+                                  :children [[:property [:simple name]]]}]
+           [:property
+            [:join [:properties
+                    {[:simple friends]
+                     [[:prefixed-properties
+                       {:base db
+                        :children [[:property [:simple id]]]}]
+                      [:prefixed-properties
+                       {:base user
+                        :children [[:property [:simple name]]]}]]}]]]]}]]]]
+    '[{users [db [id]
+              user [name]
+              {friends [db [id]
+                        user [name]]}]}]
+
+    '[[:property
+       [:join
+        [:properties
+         {[:simple users]
+          [[:property
+            [:join
+             [:properties
+              {[:simple friends]
+               [[:property [:join
+                            [:properties
+                             {[:simple friends]
+                              [[:prefixed-properties
+                                {:base db
+                                 :children [[:property [:simple id]]]}]]}]]]]}]]]]}]]]]
+    '[{users [{friends [{friends [db [id]]}]}]}]))
+
+(deftest parsing-joins-with-sub-joins
+  (are [out in] (= out (q/conform-and-parse in))
+    '[{:name users :type :join
+       :join-source {:name users :type :property}
+       :join-target [{:name db/id :type :property}
+                     {:name user/name :type :property}
+                     {:name friends :type :join
+                      :join-source {:name friends :type :property}
+                      :join-target [{:name db/id :type :property}
+                                    {:name user/name :type :property}]}]}]
+    '[{users [db [id]
+              user [name]
+              {friends [db [id]
+                        user [name]]}]}]
+
+    '[{:name users :type :join
+       :join-source {:name users :type :property}
+       :join-target [{:name friends :type :join
+                      :join-source {:name friends :type :property}
+                      :join-target [{:name friends :type :join
+                                     :join-source {:name friends :type :property}
+                                     :join-target [{:name db/id :type :property}]}]}]}]
+    '[{users [{friends [{friends [db [id]]}]}]}]))


Share middleware code

Share middleware code

--- src/app/player/handlers.cljs
+++ src/app/player/handlers.cljs
@@ -1,23 +1,14 @@
 (ns app.player.handlers
   (:require [re-frame.core :refer [trim-v after register-handler path
-                                   dispatch-sync]]
-            [app.db :as db]
+                                   dispatch-sync]]
+            [app.middleware :refer [check-schema-mw]]
             [app.player.player :as player]
             [app.player.drizzle :as drizzle]
             [app.player.pairs :as pairs]
             [app.player.players :as players]
-            [app.player.screen :as screen]
-            [schema.core :as s :include-macros true]))
+            [app.player.screen :as screen]))

-(defn check-and-throw
-  "throw an exception if db doesn't match the schema."
-  [a-schema db]
-  (if-let [problems  (s/check a-schema db)]
-    (throw (js/Error. (str "schema check failed: " problems)))))
-
-
-(def check-schema-mw (after (partial check-and-throw db/schema))) ;; todo share with main handler

 (def player-mw [check-schema-mw
                 (path :player)


improve logging

improve logging

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -264,10 +264,7 @@
               (let [message
                     (str " add-complement to " (get-in bolt [:rule]) " at path: " path " took " run-time " msec, but found no lexical complements for "
                          "'" (morph from-bolt) "'"
-;                         ". Desired complement cat was: " (strip-refs (get-in bolt (concat path [:synsem :cat])))
-                         ". Desired complement synsem/sem/pred was: " (strip-refs (get-in bolt (concat path [:synsem :sem :pred])))
-;                         ". Head is:" (strip-refs (get-in bolt (concat (butlast path) [:head])))
-                         ". Head notes:" (strip-refs (get-in bolt (concat (butlast path) [:head :notes])))
+                         ". Desired complement [:synsem :sem :pred] was: " (strip-refs (get-in bolt (concat path [:synsem :sem :pred])))
                          ". Complements tried were:"
                          (str " " (string/join "," (map morph (take 5 complement-candidate-lexemes)))
                               (if (< 0 (- (count complement-candidate-lexemes) 5))


added missing require

added missing require

--- src/tutorial/untangled_tutorial/tutorial.cljs
+++ src/tutorial/untangled_tutorial/tutorial.cljs
@@ -11,6 +11,7 @@
     untangled-tutorial.F-Untangled-Client
     untangled-tutorial.G-Mutation
     untangled-tutorial.G-Mutation-Exercises
+    untangled-tutorial.H-Server-Interactions
     untangled-tutorial.Z-Glossary
     [devtools.core :as devtools]))


Need to convert to string for s3 b64 encode

--- src/braid/core/server/s3.clj
+++ src/braid/core/server/s3.clj
@@ -24,7 +24,8 @@
         secret-key (SecretKeySpec. (.getBytes key "UTF-8") (.getAlgorithm mac))]
     (-> (doto mac (.init secret-key))
         (.doFinal (.getBytes to-sign "UTF-8"))
-        Base64/encodeBase64)))
+        Base64/encodeBase64
+        String.)))

 (defn generate-policy
   []


resolve properly

resolve properly

--- src/bzzz/queries/dis_max.clj
+++ src/bzzz/queries/dis_max.clj
@@ -1,6 +1,6 @@
 (ns bzzz.queries.dis-max
   (use bzzz.util)
-  (:import (org.apache.lucene.search DisjunctionMaxQuery)))
+  (:import (org.apache.lucene.search DisjunctionMaxQuery Query)))

 (defn parse
   [generic input analyzer]
@@ -8,6 +8,6 @@
          :or {tie-breaker 0.5 boost 1}} input
          top ^DisjunctionMaxQuery (DisjunctionMaxQuery. (float-or-parse tie-breaker))]
     (doseq [q queries]
-      (.add top (generic q analyzer)))
+      (.add top ^Query (generic q analyzer)))
     (.setBoost top boost)
     top))


finished but untested

finished but untested

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -13,31 +13,64 @@
     :refer [defroutes GET]]
    [cheshire.core :refer [parse-string generate-string]]))

+(def ncols 7)
+(def nrows 6)
+(def n-to-win 4)
+
 (defonce matcher (atom nil))
 ;;; All the ids waiting for a match
 (defonce awaiting (atom nil))

 (defonce match-count (atom {}))

+(defn get-winner [state-val i]
+  (let [cand (state-val i)
+        dirs [1 nrows (inc nrows)]]
+    (when (first
+           (for [dir dirs]
+             (<= (inc n-to-win)
+                 (+
+                  (count
+                   (for [j (reductions + (repeat (- dir)))
+                         :while (= cand (state-val j))]
+                     true))
+                  (count
+                   (for [j (reductions + (repeat (+ dir)))
+                         :while (= cand (state-val j))]
+                     true))))))
+      cand)))
+
 (defn process-move [state winner turn move]
-  true)
+  ;; This function implements the rules of connect-4. If a move is not
+  ;; valid, returns false. If a move is valid, it makes the move and
+  ;; then determines if there has been a winner. If there has been a
+  ;; winner, it marks the winner. Flips turn and returns true at this point
+  (when-let [i (and
+                (< 0 move ncols)
+                (->> (range (* move nrows) (* (inc move) nrows))
+                     (filter (fn [i] (= (@state i) 0)))
+                     first))]
+    (swap! state assoc i (inc @turn))
+    (swap! turn #(- 1 %))
+    (reset! winner (get-winner @state i))
+    true))

 (defn game-loop [players]
   (let [ch-ins (vec (map (comp first :chs) players))
         ch-outs (vec (map (comp second :chs) players))
-        state (atom (repeat (* 7 6) 0))
+        state (atom (vec (repeat (* ncols nrows) 0)))
         turn (atom 0)
         winner (atom nil)
         notify (fn [ch]
                  (go (>! ch
                          (cond->
                              {:type :state
-                              :turn (inc @turn)
-                              :you (inc @turn)
+                              :turn (inc (or @turn -1))
+                              :you (inc (.indexOf ch-outs ch))
                               :state @state}
                            @winner
                            (assoc
-                            :winner @winner
+                            :winner (inc @winner)
                             :turn 0)))))]
     (go
       ;; During the game


Adds get-auth and optional argument to get-user.

The get-auth function may be used to easily access the current
authentication map of friend.  This authentication map holds everything
related to the user from the mongo store besides the password hash.

The second, optional argument added to get-user (fields) allows for
selecting a subset of keys avaialble from a full query.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -22,8 +22,9 @@
     (mg/set-db! (mg/get-db db-name))
     (ensure-indexes)))

-(defn get-user [username]
-  (mc/find-one-as-map "users" {:username username}))
+(defn get-user
+  ([username fields] (mc/find-one-as-map "users" {:username username} fields))
+  ([username] (get-user username nil)))

 (defn add-user [user]
   (mc/insert "users"
@@ -38,6 +39,7 @@
   true)

 (def identity #(get friend/*identity* :current))
+(def get-auth #((:authentications friend/*identity*) (:current friend/*identity*)))

 (defn get-phrase []
   (if (options/dev-mode?)


Rename the sort comparator function

Rename the sort comparator function

to a more sensible name

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -419,7 +419,7 @@
    (re-seq #"\d+|\D+")
    (map #(or (parse-int %) %))))

-(defn- by-vector [v1 v2]
+(defn- locale-comparator [v1 v2]
   (let [c1 (count v1)
         c2 (count v2)]
     (cond
@@ -429,7 +429,7 @@
              (fn [_ [s1 s2]]
                (let [comparison (if (every? seq? [s1 s2])
                                   ;; a chunked string
-                                  (by-vector s1 s2)
+                                  (locale-comparator s1 s2)
                                   ;; locale aware comparison
                                   (locale-compare s1 s2))]
                  (if (not= 0 comparison)
@@ -540,7 +540,7 @@
    (->>
     items
     collate-all-duplicate-items
-    (sort-by sort-key by-vector)
+    (sort-by sort-key locale-comparator)
     (reduce
      (fn [m item]
        (let [update-keys (get-update-keys-fn item)]


Enable locale aware comparison of numbers and strings

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -400,16 +400,22 @@
      (mapcat collate-duplicate-items [braille-items musiknoten-items taktile-items spiele-items])
      others)))

-(defn locale-compare
+(defn- locale-compare
   "Comparator similar to `clojure.core/compare`. Uses a locale aware
   collator for string comparison. Unlike `clojure.core/compare` treats
-  `nil` as 'greater than', so that it comes last in the sort order."
+  `nil` as 'greater than', so that it comes last in the sort order.
+  Numbers are smaller than strings to that they come first in sort
+  order."
   [x y]
   (cond
     (every? string? [x y]) (. collator compare x y)
     (and (nil? x) (nil? y)) 0
     (nil? x) -1
     (nil? y) 1
+    ;; when trying to compare strings and numbers make sure that
+    ;; numbers are ordered before strings
+    (and (string? x) (number? y)) 1
+    (and (number? x) (string? y)) -1
     :else (compare x y)))

 (defn- chunkify


Helper func numbered-lines.

Helper func numbered-lines.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -39,13 +39,36 @@
 (defn process-top-level-form [smodel form]
   (let [[op name & rest] form]
     (case (str op)
-      "ns" ["package" name (line-range form)]
-      "defn" ["func" name (line-range form)]
+      "ns" [["package" name] (line-range form)]
+      "defn" [["func" name] (line-range form)]
       "UNKNOWN-TOP-LEVEL-FORM")))

 (defn process-top-level-forms [smodel]
   (map #(process-top-level-form smodel %)
        (:forms smodel)))
+
+(defn numbered-lines [lines beg end] ; beg and end are 1-based.
+  (map vector
+       (range beg (inc end))
+       (subvec lines (dec beg) end)))
+
+(defn do-lines [lines beg end f] ; beg and end are 1-based.
+  (doseq [[i curr-line] (numbered-lines lines beg end)]
+    (f i curr-line)))
+
+(defn emit [slines pmodel-in]
+  (loop [last-line 0
+         pmodel pmodel-in]
+    (when (seq pmodel)
+      (let [[out [sline-beg sline-end]] (first pmodel)]
+        (when (> sline-beg (inc last-line))
+          (do-lines slines (inc last-line) (dec sline-beg)
+                    #(println "//" %1 %2)))
+        (do-lines slines sline-beg sline-end
+                  #(println "//" %1 %2))
+        (println "out>>>" out)
+        (recur sline-end
+               (rest pmodel))))))

 (defn -main
   "some docstring"
@@ -54,5 +77,6 @@
   (let [smodel (read-model-file "src/cbfg/fence.cljs")
         pmodel (process-top-level-forms smodel)]
     (pprintm smodel)
-    (pprintm pmodel)))
+    (pprintm pmodel)
+    (emit (:lines smodel) pmodel)))


add tmrw for tomorrow in EN

add tmrw for tomorrow in EN

--- resources/duckling/rules/en.time.clj
+++ resources/duckling/rules/en.time.clj
@@ -189,7 +189,7 @@
   (cycle-nth :day 0)

   "tomorrow"
-  #"(?i)tomm?or?row"
+  #"(?i)(tmrw|tomm?or?row)"
   (cycle-nth :day 1)

   "yesterday"


Fixing args

Fixing args

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -10,6 +10,7 @@
    limitations under the License.)

 (ns celestial.api
+  (:refer-clojure :exclude [hash])
   (:use [celestial.hosts-api :only (hosts types)]
         [celestial.users-api :only (users quotas)]
         [compojure.core :only (defroutes routes)]
@@ -45,9 +46,9 @@

 (defmodel action :operates-on :string :src :string :actions {:type "Actions"})

-(defmodel arg :key :string :value :string)
+(defmodel hash)

-(defmodel arguments :args {:type "List" :items {"$ref" "Arg"}})
+(defmodel arguments :args {:type "Hash" :description "key value pairs {'foo':1 , 'bar':2 , ...}" })

 (defn schedule-job
   ([id action msg]
@@ -84,16 +85,14 @@
            (schedule-job id "provision" "submitted provisioning"
               [type (assoc system :system-id (Integer. id))])))

-  (POST- "/job/:action/:id" [^:string action ^:int id & ^:arguments args]
+  (POST- "/job/:action/:id" [^:string action ^:int id & ^:hash args]
      {:nickname "runAction" :summary "Run remote action"
       :notes "Runs adhoc remote opertions on system (like deployment, service restart etc)
               using matching remoting capable tool like Capisrano/Supernal/Fabric"}
-       (let [{:keys [machine] :as system} (p/get-system id)
-            args-m (apply merge (map #(into {} %) args))]
+       (let [{:keys [machine] :as system} (p/get-system id)]
          (if-let [actions (p/find-action-for (keyword action) (:type system))]
            (schedule-job id "run-action" "submitted action"
-             [actions (merge args-m
-                        {:action (keyword action) :target (machine :ip) :system-id (Integer. id)})])
+             [actions (merge args {:action (keyword action) :target (machine :ip) :system-id (Integer. id)})])
            (bad-req {:msg (<< "No action ~{action} found for id ~{id}")})
            )))


Correct old use of `:done`. Replace with `:halt`

--- src/re_frame_async_flow_fx/core.cljs
+++ src/re_frame_async_flow_fx/core.cljs
@@ -39,8 +39,8 @@
                  :disptach  (cond
                               (vector? dispatch)  (list dispatch)
                               (list? dispatch)    (map (fn [d] (if (= d :halt) halt-event d) dispatch))
-                              (= :halt dispatch)  (list [id :halt])
-                              :else  (js/console.error "aync-flow: dispatch not valid: " dispatch))})))))
+                              (= :halt dispatch)  (list halt-event)
+                              :else  (js/console.error "aync-flow: dispatch value not valid: " dispatch))})))))

 (defn make-flow-event-handler
@@ -89,7 +89,7 @@
               ;;  1. remove this event handler
               ;;  2. remove state
               ;;  3. stop the events forwarder
-              :done {:db (dissoc db db-path)
+              :halt {:db (dissoc db db-path)
                      :event-forwarder {:unregister id}
                      :deregister-event-handler id})          ;; XXX write this effects handler


Don't stop piped queries when empty results are returned

--- src/sparql_to_csv/sparql.clj
+++ src/sparql_to_csv/sparql.clj
@@ -80,6 +80,7 @@
     :as params}
    template
    param-seq
+   stopping-condition
    & [lines & _]]
   (let [append? (pos? start-from)
         [base-header base-lines] (if extend?
@@ -99,7 +100,7 @@
     (with-open [writer (io/writer output :append (and append? (util/file-exists? output)))]
       (dorun (csv/write-csv writer
                             (->> (map-fn query-fn param-seq base-lines (iterate inc 0))
-                                 (take-while seq)
+                                 (take-while stopping-condition)
                                  util/lazy-cat')
                             :separator delimiter)))))

@@ -111,7 +112,8 @@
   (csv-seq params
            template
            (map (partial assoc {:limit page-size} :offset)
-                (iterate (partial + page-size) start-from))))
+                (iterate (partial + page-size) start-from))
+           seq))

 (defn piped-query
   "Run the query from `template` with each line of input provided as template parameters."
@@ -130,4 +132,5 @@
       (csv-seq params
                template
                (map (partial zipmap header) (next lines))
+               (constantly true)
                lines))))


[#3073] Fix ns definition + test

[#3073] Fix ns definition + test

--- backend/test/akvo/lumen/lib/data_group_test.clj
+++ backend/test/akvo/lumen/lib/data_group_test.clj
@@ -1,19 +1,19 @@
-(ns akvo.lumen.lib.aggregation.commons-test
+(ns akvo.lumen.lib.data-group-test
   (:require [akvo.lumen.lib.data-group :as data-group]
-            [clojure.test :refer :all]))
+            [clojure.test :refer [deftest is]]))

 (def test-data-groups [{:columns [{:columnName "instance_id"}
                                   {:columnName "rnum"}
                                   {:columnName "identifier"}
                                   {:columnName "A"}]
-                        :groupId "metadata"
+                        :group-id "metadata"
                         :table-name "ds_meta"}
                        {:columns [{:columnName "instance_id"}
                                   {:columnName "rnum"}
                                   {:columnName "B"}]
-                        :groupId "repeated"
+                        :group-id "repeated"
                         :table-name "ds_repeated"}
-                       {:groupId "not-repeated"
+                       {:group-id "not-repeated"
                         :columns [{:columnName "instance_id"}
                                   {:columnName "rnum"}
                                   {:columnName "C"}]


remove comment

remove comment

--- src/clj/salava/badge/pdf.clj
+++ src/clj/salava/badge/pdf.clj
@@ -153,7 +153,6 @@
                                content (if (= lang "all") (map template $content) (map template (filter #(= (:default_language_code %) (:language_code %)) $content)))]

                            (reduce into [[:chapter ]] content)))]
-    ;;TODO Test alignments
     (fn [output-stream]
       (pdf/pdf (into [pdf-settings] (badge-template badges)) output-stream)))
   )


core.util markdown conversion

core.util markdown conversion

--- src/clj/salava/core/util.clj
+++ src/clj/salava/core/util.clj
@@ -10,6 +10,7 @@
             [clojure.java.shell :refer [sh]]
             [clj.qrgen :as q]
             [clj-time.coerce :as tc]
+            [autoclave.core :refer [markdown-processor markdown-to-html]]
             [salava.core.helper :refer [plugin-str]]
             [pantomime.mime :refer [extension-for-name mime-type-of]]))

@@ -219,3 +220,10 @@
              (map #(str/replace (plugin-str %) #"/" "."))
              (map fun)
              (filter #(not (nil? %))))))))
+
+(def default-md-processor (markdown-processor :quotes :suppress-all-html))
+
+(defn md->html
+  "convert markdown to html and sanitize output"
+  ([md] (markdown-to-html md default-md-processor))
+  ([md processor] (markdown-to-html processor md)))


Delay display until all remote data is syncing

Refs #2

--- src/cljs/geoforms/forms.cljs
+++ src/cljs/geoforms/forms.cljs
@@ -257,14 +257,18 @@
 (defn page []
   (fn []
     [:div
-     [bind-fields
-      form-template
-      user-doc
-      (fn [k v _]
-        (let [after (assoc-in @user-doc k v)
-              errors (validate-user after)]
-          (assoc after :errors errors)))]
-
-     [:button.btn.btn-default
-      {:on-click #(when (validate-user! user-doc) (submit! @user-doc))}
-      "Submit"]]))
+     (when (and (seq @db/districts)
+                (seq @db/categories)
+                (seq @db/ideas))
+       [:div
+        [bind-fields
+         form-template
+         user-doc
+         (fn [k v _]
+           (let [after (assoc-in @user-doc k v)
+                 errors (validate-user after)]
+             (assoc after :errors errors)))]
+
+        [:button.btn.btn-default
+         {:on-click #(when (validate-user! user-doc) (submit! @user-doc))}
+         "Submit"]])]))


Add multiple columns for Persons, fixing #5

--- src/cljs/herder/persons.cljs
+++ src/cljs/herder/persons.cljs
@@ -20,13 +20,20 @@
       [:div {:class "container-fluid"}
        [convention-header :persons]
        [:h2 "People"]
-       [:ul
+       [:div.row
         (for [{:keys [id name]} (get-data [:persons (:id @state)])]
-          ^{:key id} [:li [:a {:href (str "#/person/" id)} name " "]
-                      [:button {:type "button"
-                                :class "btn btn-danger"
-                                :on-click #(DELETE (person-url (:id @state) id))}
-                       (str "Delete " name)]])]
+          ^{:key id}
+          [:div
+           [:div.col-md-2
+            [:a {:class "pull-xs-right"
+                 :style {:line-height "38px"}
+                 :href (str "#/person/" id)}
+             name " "]]
+           [:div.col-md-2
+            [:button {:type "button"
+                      :class "btn btn-danger"
+                      :on-click #(DELETE (person-url (:id @state) id))}
+             (str "Delete " name)]]])]
        [:hr]
        [:form {:class "form-inline"
                :on-submit #(do


make devtools ws connect async and catch errors during setup

--- src/main/shadow/cljs/devtools/client/browser.cljs
+++ src/main/shadow/cljs/devtools/client/browser.cljs
@@ -311,53 +311,55 @@

 (defn ws-connect []
-  (let [print-fn
-        cljs.core/*print-fn*
-
-        ws-url
-        (env/ws-url :browser)
-
-        socket
-        (js/WebSocket. ws-url)]
-
-    (vreset! socket-ref socket)
-
-    (set! (.-onmessage socket)
-      (fn [e]
-        (env/process-ws-msg (. e -data) handle-message)
-        ))
-
-    (set! (.-onopen socket)
-      (fn [e]
-        (hud/connection-error-clear!)
-        (vreset! close-reason-ref nil)
-        ;; :module-format :js already patches provide
-        (when (= "goog" env/module-format)
-          ;; patch away the already declared exception
-          (set! (.-provide js/goog) js/goog.constructNamespace_))
-
-        (env/set-print-fns! ws-msg)
-
-        (devtools-msg "WebSocket connected!")
-        ))
-
-    (set! (.-onclose socket)
-      (fn [e]
-        ;; not a big fan of reconnecting automatically since a disconnect
-        ;; may signal a change of config, safer to just reload the page
-        (devtools-msg "WebSocket disconnected!")
-        (hud/connection-error (or @close-reason-ref "Connection closed!"))
-        (vreset! socket-ref nil)
-        (env/reset-print-fns!)
-        ))
-
-    (set! (.-onerror socket)
-      (fn [e]
-        (hud/connection-error "Connection failed!")
-        (devtools-msg "websocket error" e)))
-
-    (js/setTimeout heartbeat! 30000)
-    ))
+  (try
+    (let [print-fn
+          cljs.core/*print-fn*
+
+          ws-url
+          (env/ws-url :browser)
+
+          socket
+          (js/WebSocket. ws-url)]
+
+      (vreset! socket-ref socket)
+
+      (set! (.-onmessage socket)
+        (fn [e]
+          (env/process-ws-msg (. e -data) handle-message)
+          ))
+
+      (set! (.-onopen socket)
+        (fn [e]
+          (hud/connection-error-clear!)
+          (vreset! close-reason-ref nil)
+          ;; :module-format :js already patches provide
+          (when (= "goog" env/module-format)
+            ;; patch away the already declared exception
+            (set! (.-provide js/goog) js/goog.constructNamespace_))
+
+          (env/set-print-fns! ws-msg)
+
+          (devtools-msg "WebSocket connected!")
+          ))
+
+      (set! (.-onclose socket)
+        (fn [e]
+          ;; not a big fan of reconnecting automatically since a disconnect
+          ;; may signal a change of config, safer to just reload the page
+          (devtools-msg "WebSocket disconnected!")
+          (hud/connection-error (or @close-reason-ref "Connection closed!"))
+          (vreset! socket-ref nil)
+          (env/reset-print-fns!)
+          ))
+
+      (set! (.-onerror socket)
+        (fn [e]
+          (hud/connection-error "Connection failed!")
+          (devtools-msg "websocket error" e)))
+
+      (js/setTimeout heartbeat! 30000))
+    (catch :default e
+      (devtools-msg "WebSocket setup failed" e))))

 (when ^boolean env/enabled
   ;; disconnect an already connected socket, happens if this file is reloaded
@@ -376,4 +378,4 @@
       (when-let [s @socket-ref]
         (.close s))))

-  (ws-connect))
+  (js/setTimeout ws-connect 10))


Add selection logic for buttons.

Add selection logic for buttons.

--- ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreateProjectPage.clj
+++ ccw.support.examples/src/ccw/support/labrepl/wizards/LabreplCreateProjectPage.clj
@@ -12,7 +12,8 @@
   (:import
     [org.eclipse.swt SWT]
     [org.eclipse.swt.widgets Button Composite]
-    [org.eclipse.swt.layout GridLayout GridData])
+    [org.eclipse.swt.layout GridLayout GridData]
+    [org.eclipse.swt.events SelectionAdapter] )
   (:gen-class
    :extends org.eclipse.ui.dialogs.WizardNewProjectCreationPage
    :exposes-methods {createControl super-createControl}
@@ -33,15 +34,27 @@
   (let
     [composite (Composite. (.getControl this) SWT/NONE)
      layout (GridLayout.)]
+
     (doto composite
       (.setLayout layout)
       (.setLayoutData (GridData. (bit-or GridData/VERTICAL_ALIGN_FILL GridData/FILL_HORIZONTAL))))
-    (let [run-lein-deps-button (Button. composite SWT/CHECK)]
+
+    ; Create the check buttons for running "lein deps" and for starting up
+    ; the REPL and for displaying the Labrepl start page.
+    ; The latter button only is enabled if the "lein deps" button is checked.
+    (let [run-lein-deps-button (Button. composite SWT/CHECK)
+          run-repl-button (Button. composite SWT/CHECK)]
       (doto run-lein-deps-button
         (.setText "Run \"lein deps\" to download dependencies")
-        (.setSelection  true)))
-    (let [run-repl-button (Button. composite SWT/CHECK)]
+        (.setSelection  true)
+        (.addSelectionListener
+          (proxy [SelectionAdapter] []
+            (widgetSelected [_]
+              (.setEnabled run-repl-button (.getSelection run-lein-deps-button))))))
+
       (doto run-repl-button
         (.setText "Run REPL and open web page")
-        (.setSelection  true)))
-    (.validatePage this)))
+        (.setSelection  true))
+      (dosync (alter (.state this) assoc :run-repl-button run-repl-button :run-lein-deps-button run-lein-deps-button))))
+
+  (.validatePage this))


Another fix.

Another fix.

--- src/onyx/scheduling/percentage_task_scheduler.clj
+++ src/onyx/scheduling/percentage_task_scheduler.clj
@@ -85,8 +85,7 @@
          {}
          (map
           (fn [[k v]]
-            (let [n-to-drop (- (count (get-in replica [:allocations job k])) (:allocation v))]
-              {k (take-last n-to-drop (get-in replica [:allocations job k]))}))  tasks))]
+            {k (take-last n (get-in replica [:allocations job k]))}) tasks))]
     (loop [k 0
            pool candidates
            peers []]


improved error handling and logging

improved error handling and logging

--- src/clj/game/main.clj
+++ src/clj/game/main.clj
@@ -51,7 +51,8 @@
            "do" ((commands command) state (keyword side) args)
            "quit" (system-msg state (keyword side) "left the game")
            "notification" (swap! state update-in [:log] #(conj % {:user "__system__" :text text})))
-         (catch Exception e (println "Error: " e))))
+         (catch Exception e
+           (println "Game error:" action command (get-in args [:card :title]) e))))
   (assoc @(@game-states gameid) :action action))

 (defn -main []
@@ -59,9 +60,10 @@
     (.bind socket "tcp://127.0.0.1:1043")
     (println "Listening on port 1043 for incoming commands...")
     (while true
-      (let [data (convert (.recv socket))]
-        ;; (println (:action data) data)
-        (if (= (:action data) "remove")
-          (do (swap! game-states dissoc (:gameid data))
-              (.send socket (generate-string "ok")))
-          (.send socket (generate-string (dissoc (exec data) :events))))))))
+      (try (let [data (convert (.recv socket))]
+             (if (= (:action data) "remove")
+               (do (swap! game-states dissoc (:gameid data))
+                   (.send socket (generate-string "ok")))
+               (.send socket (generate-string (dissoc (exec data) :events)))))
+           (catch Exception e
+             (println "Main error:" e))))))


Need a java class for comparison.

Need a java class for comparison.

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -211,7 +211,7 @@
       (when debug
         (println "Request:")
         (clojure.pprint/pprint
-         (assoc req :body (if (isa? (:body req) String)
+         (assoc req :body (if (isa? (type (:body req)) String)
                             (format "... %s bytes ..."
                                     (count (:body req)))
                             (bean (:body req)))))


clojure: fixed classify-recursively for 0 or 1 elements

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -63,15 +63,23 @@
     [k (map second c)]))

 (defn classify-recursively [items2seqs]
-  (loop [classes (sorted-set [(- (count items2seqs)) [] items2seqs])]
-    (let [[n k c] (first classes)]
-      (if (or (nil? n) (>= n -1))
-        (zipmap (map second classes) (map #(map first (last %)) classes))
-        (recur (into (disj classes (first classes))
-                     (for [[key cl] (classify-once c)]
-                       (if (nil? key)
-                         [0 k cl]
-                         [(- (count cl)) (conj k key) cl]))))))))
+  (cond
+    (empty? items2seqs)
+    {}
+
+    (= 1 (count items2seqs))
+    { (vec (take 1 (second (first items2seqs)))) (take 1 (first items2seqs)) }
+
+    :else
+    (loop [classes (sorted-set [(- (count items2seqs)) [] items2seqs])]
+      (let [[n k c] (first classes)]
+        (if (or (nil? n) (>= n -1))
+          (zipmap (map second classes) (map #(map first (last %)) classes))
+          (recur (into (disj classes (first classes))
+                       (for [[key cl] (classify-once c)]
+                         (if (nil? key)
+                           [0 k cl]
+                           [(- (count cl)) (conj k key) cl])))))))))

 (defn node-classification [net]
   (let [pos (barycentric-positions net)


changed c/complex-number to c/complex

changed c/complex-number to c/complex

--- src/test/clj/clojure/core/matrix/test_complex.clj
+++ src/test/clj/clojure/core/matrix/test_complex.clj
@@ -10,7 +10,7 @@
 (set! *unchecked-math* true)

 (deftest test-complex
-  (let [c (c/complex-number 1 2)]
+  (let [c (c/complex 1 2)]
     (is (== 1 (cm/real c)))
     (is (== 2 (cm/imag c)))))

@@ -19,26 +19,26 @@
     (is (= [2] (m/shape ca)))
     (is (m/equals [1 2] (cm/real ca)))
     (is (m/equals [3 4] (cm/imag ca)))
-    (is (= (c/complex-number 1 3) (m/mget ca 0)))
-    (is (= (c/complex-number 2 4) (m/mget ca 1)))))
+    (is (= (c/complex 1 3) (m/mget ca 0)))
+    (is (= (c/complex 2 4) (m/mget ca 1)))))

 (deftest test-complex-predicates
-  (is (cm/complex? (c/complex-number 1 2)))
+  (is (cm/complex? (c/complex 1 2)))
   (is (cm/complex? (cm/complex-array 1 2)))
   (is (not (cm/complex? 3.5)))
   (is (not (cm/complex? [1 2 3])))
   (is (cm/complex? (cm/complex-array [1 2 3]))))

 (deftest test-complex-equality
-  (is (m/e= (c/complex-number 1 2) (cm/complex-array 1 2))))
+  (is (m/e= (c/complex 1 2) (cm/complex-array 1 2))))

 (deftest test-scaling
-  (is (= (c/complex-number 3 6) (m/scale (c/complex-number 1 2) 3)))
-  (is (= (c/complex-number 3 6) (m/scale 3 (c/complex-number 1 2))))
-  (is (= (c/complex-number 3 6) (m/mul (c/complex-number 1 2) 3)))
-  (is (= (c/complex-number 3 6) (m/mul 3 (c/complex-number 1 2))))
-  (is (= (c/complex-number 3 6) (m/mul 3 (c/complex-number 1 2))))
-  (is (= (c/complex-number -310 70) (m/scale (c/complex-number 1 3) (c/complex-number -10 100))))
+  (is (= (c/complex 3 6) (m/scale (c/complex 1 2) 3)))
+  (is (= (c/complex 3 6) (m/scale 3 (c/complex 1 2))))
+  (is (= (c/complex 3 6) (m/mul (c/complex 1 2) 3)))
+  (is (= (c/complex 3 6) (m/mul 3 (c/complex 1 2))))
+  (is (= (c/complex 3 6) (m/mul 3 (c/complex 1 2))))
+  (is (= (c/complex -310 70) (m/scale (c/complex 1 3) (c/complex -10 100))))
   (is (= (m/scale
            (cm/complex-array (m/identity-matrix 2))
            (cm/complex 3 6))))
@@ -55,29 +55,29 @@

 (deftest herm-transpose
   (is (m/e= (m/add (cm/hermitian-transpose
-                     (cm/complex-array (m/identity-matrix 2))) (c/complex-number 0 0))
+                     (cm/complex-array (m/identity-matrix 2))) (c/complex 0 0))
             (cm/complex-array (m/identity-matrix 2))))
   (is (m/e= (m/add (cm/hermitian-transpose
-                     (cm/complex-array [[1 2] [3 4]])) (c/complex-number 0 0))
+                     (cm/complex-array [[1 2] [3 4]])) (c/complex 0 0))
             (cm/complex-array [[1 3] [2 4]] [[0 0] [0 0]])))
   (is (m/e= (cm/hermitian-transpose (cm/complex-array [[1 2] [3 4]] [[10 2] [1 5]]))
             (cm/complex-array [[1 3] [2 4]] [[-10 -1] [-2 -5]]))))

 (deftest trace
   (is (= (m/trace (cm/complex-array (m/identity-matrix 10)))
-         (c/complex-number 10)))
+         (c/complex 10)))
   (is (= (m/trace (cm/complex-array [[1 2] [3 4]]))
-         (c/complex-number 5)))
+         (c/complex 5)))
   (is (= (m/trace (cm/complex-array [[1 2] [3 4]] [[10 2] [1 5]]))
-         (c/complex-number 5 15))))
+         (c/complex 5 15))))

 (deftest det
   (is (= (m/det (cm/complex-array
                   [[1 2 1] [3 4 2] [5 2 3]]
                   [[0 1 0] [0 0 0] [0 0 0]]))
-         (c/complex-number -4 1)))
+         (c/complex -4 1)))
   (is (= (m/det (cm/complex-array (m/identity-matrix 8)))   ;; Very slow to return if dim>8
-         (c/complex-number 1.0))))
+         (c/complex 1.0))))

 (deftest inverse
   (is (m/equals (m/inverse (cm/complex-array (m/identity-matrix 10)))


Fix the test for window-crop-fixed.

Fix the test for window-crop-fixed.

--- test/vignette/http/routes_test.clj
+++ test/vignette/http/routes_test.clj
@@ -129,7 +129,7 @@

 (facts :window-crop-fixed-route
        (route-matches window-crop-fixed-route
-                      (request :get "/thelastofus/5/58/Door_4.jpg/revision/latest/window-crop/width/400/height/400/x-offset/400/y-offset/200/window-width/200/window-height/400")) =>
+                      (request :get "/thelastofus/5/58/Door_4.jpg/revision/latest/window-crop-fixed/width/400/height/400/x-offset/400/y-offset/200/window-width/200/window-height/400")) =>
        {:wikia "thelastofus"
         :top-dir "5"
         :middle-dir "58"


Test structure improvements

Test structure improvements

--- test/yada/representations_test.clj
+++ test/yada/representations_test.clj
@@ -129,66 +129,76 @@
         (when (:rejected rep) :rejected))))

 (deftest content-type-test
-  ;; Basic match
-  (is (= (get-content-type-quality
-          {:headers {"accept" "text/html"}}
-          {:content-type (mime/string->media-type "text/html")})
-         [(float 1.0) 3 0 (float 1.0)]))
-
-  ;; Basic match, with multiple options
-  (is (= (get-content-type-quality
-          {:headers {"accept" "image/png,text/html"}}
-          {:content-type (mime/string->media-type "text/html")})
-         [(float 1.0) 3 0 (float 1.0)]))
-
-  ;; Basic match, with multiple options and q values
-  (is (= (get-content-type-quality
-          {:headers {"accept" "image/png,text/html;q=0.9"}}
-          {:content-type (mime/string->media-type "text/html;q=0.8")})
-         [(float 0.9) 3 0 (float 0.8)]))
-
-  ;; Basic reject
-  (is (= (get-content-type-quality
-          {:headers {"accept" "text/html"}}
-          {:content-type (mime/string->media-type "text/plain")})
-         :rejected))
-
-  ;; Basic reject with multiple options
-  (is (= (get-content-type-quality
-          {:headers {"accept" "image/png,text/html"}}
-          {:content-type (mime/string->media-type "text/plain")})
-         :rejected))
-
-  ;; Wildcard match
-  (is (= ((get-content-type-quality
-           {:headers {"accept" "image/png,text/*"}}
-           {:content-type (mime/string->media-type "text/html")}) 1)
-         ;; We get a match with a specificty score of 2
-         2))
-
-  ;; Specific match beats wildcard
-  (is (= ((get-content-type-quality
-           {:headers {"accept" "image/png,text/*,text/html"}}
-           {:content-type (mime/string->media-type "text/html")}) 1)
-         ;; We get a specificty score of 3, indicating we matched on the
-         ;; text/html rather than the preceeding text/*
-         3))
-
-  ;; Specific match beats wildcard, different order
-  (is (= ((get-content-type-quality
-           {:headers {"accept" "text/html,text/*,image/png"}}
-           {:content-type (mime/string->media-type "text/html")}) 1)
-         3))
-
-  ;; Greater number of parameters matches
-  (is (= ((get-content-type-quality
-           {:headers {"accept" "text/html,text/html;level=1"}}
-           {:content-type (mime/string->media-type "text/html;level=1")}) 2)
-         ;; We get a specificty score of 3, indicating we matched on the
-         ;; text/html rather than the preceeding text/*
-         1))
-
-  ;; TODO: Test content type parameters
+
+  (testing "Basic match"
+    (is (= (get-content-type-quality
+            {:headers {"accept" "text/html"}}
+            {:content-type (mime/string->media-type "text/html")})
+           [(float 1.0) 3 0 (float 1.0)])))
+
+
+  (testing "Basic match, with multiple options"
+    (is (= (get-content-type-quality
+            {:headers {"accept" "image/png,text/html"}}
+            {:content-type (mime/string->media-type "text/html")})
+           [(float 1.0) 3 0 (float 1.0)]))
+
+    (testing "Basic match, with multiple options and q values"
+      (is (= (get-content-type-quality
+              {:headers {"accept" "image/png,text/html;q=0.9"}}
+              {:content-type (mime/string->media-type "text/html;q=0.8")})
+             [(float 0.9) 3 0 (float 0.8)]))))
+
+
+  (testing "Basic reject"
+    (is (= (get-content-type-quality
+            {:headers {"accept" "text/html"}}
+            {:content-type (mime/string->media-type "text/plain")})
+           :rejected)))
+
+
+  (testing "Basic reject with multiple options"
+    (is (= (get-content-type-quality
+            {:headers {"accept" "image/png,text/html"}}
+            {:content-type (mime/string->media-type "text/plain")})
+           :rejected)))
+
+  (testing "Wildcard match"
+    (is (= ((get-content-type-quality
+             {:headers {"accept" "image/png,text/*"}}
+             {:content-type (mime/string->media-type "text/html")}) 1)
+           ;; We get a match with a specificty score of 2
+           2)))
+
+  (testing "Specific match beats wildcard"
+    (is (= ((get-content-type-quality
+             {:headers {"accept" "image/png,text/*,text/html"}}
+             {:content-type (mime/string->media-type "text/html")}) 1)
+           ;; We get a specificty score of 3, indicating we matched on the
+           ;; text/html rather than the preceeding text/*
+           3)))
+
+  (testing "Specific match beats wildcard, different order"
+    (is (= ((get-content-type-quality
+             {:headers {"accept" "text/html,text/*,image/png"}}
+             {:content-type (mime/string->media-type "text/html")}) 1)
+           3)))
+
+  (testing "Parameter alignment"
+    (is (= (get-content-type-quality
+            {:headers {"accept" "text/html;level=2"}}
+            {:content-type (mime/string->media-type "text/html;level=1")})
+           ;; We get a specificty score of 3, indicating we matched on the
+           ;; text/html rather than the preceeding text/*
+           :rejected)))
+
+  (testing "Greater number of parameters matches"
+    (is (= ((get-content-type-quality
+             {:headers {"accept" "text/html,text/html;level=1"}}
+             {:content-type (mime/string->media-type "text/html;level=1")}) 2)
+           ;; We get a specificty score of 3, indicating we matched on the
+           ;; text/html rather than the preceeding text/*
+           1)))

   ;; TODO: Test charsets


GUI change for admin console

GUI change for admin console

so that can see the tables

--- src/webapp/framework/client/components/admin.cljs
+++ src/webapp/framework/client/components/admin.cljs
@@ -7,10 +7,13 @@
 		[webapp.framework.client.system-globals  :only  [
 																										 client-data-windows
 																										 client-query-cache
-																										 ]])
-   )
-
+																										 ]]))
 (c/ns-coils 'webapp.framework.client.components.admin)
+
+
+
+
+

@@ -98,7 +101,7 @@
 						(= use-source  data-source))

 				  (c/div {:style {:color  "black"}}
-						 (c/inline "100px" (c/div nil table-name))
+						 (c/inline "300px" (c/div nil table-name))
 						 (c/inline "100px" (c/div {:style {:fontSize "12px" :padding "7px"}
 												   :onClick
 												   (fn [e] (do


Fix function descriptions

Fix function descriptions

--- src/whisper2cyanite/core.clj
+++ src/whisper2cyanite/core.clj
@@ -16,11 +16,12 @@
 (def ^:const pbar-width 35)

 (defn- calc-ttl
-  "Calc TTL."
+  "Calc a TTL value."
   [time retention]
   (- time (- (utils/now) retention)))

 (defn- log-point
+  "Log a point."
   [msg rollup period path time value ttl]
   (log/trace
    (format (str "%s: rollup: %s, period: %s, path: %s, time: %s, "
@@ -164,7 +165,7 @@
         root-dir-c))))

 (defn- create-mstore
-  "Create metric store."
+  "Create a metric store."
   [cass-host options]
   (if-not (:disable-metric-store options false)
     (try
@@ -174,7 +175,7 @@
     nil))

 (defn- create-pstore
-  "Create path store."
+  "Create a path store."
   [es-url options]
   (if-not (:disable-path-store options false)
     (try
@@ -184,7 +185,7 @@
     nil))

 (defn- get-from-to
-  "Get and check FROM and TO time."
+  "Get and check FROM and TO time values."
   [options]
   (let [from (:from options)
         to (:to options)]
@@ -236,13 +237,13 @@
   (wlog/exit 0))

 (defn migrate
-  "Do migration."
+  "Do the migration."
   [source tenant cass-host es-url options]
   (process source tenant cass-host es-url options migrate-path migrate-points
            "Starting migration" "Migrating"))

 (defn validate
-  "Do validation."
+  "Do the validation."
   [source tenant cass-host es-url options]
   (process source tenant cass-host es-url options validate-path validate-points
            "Starting validation" "Validating"))
@@ -271,7 +272,7 @@
       (println "    Size:             " (str (:size archive))))))

 (defn- get-archive-by-rollup
-  "Get archive by rollup."
+  "Get an archive by a rollup."
   [archives rollup]
   (let [archive (filter #(= rollup (:seconds-per-point %)) archives)]
     (if (count archive)


Check for non-matching `eid` specifier in pull

Fixes a bug where pulling wildcard selector on a non-matching
[attribute value] ref would return unrelated attributes.

--- src/datascript/pull_api.cljc
+++ src/datascript/pull_api.cljc
@@ -267,7 +267,8 @@

 (defn pull-spec
   [db pattern eid multi?]
-  (pull-pattern db (list (initial-frame pattern [(db/entid db eid)] multi?))))
+  (when-let [id (db/entid db eid)]
+    (pull-pattern db (list (initial-frame pattern [id] multi?)))))

 (defn pull [db selector eid]
   {:pre [(db/db? db)]}


unnecessary delete, db-name cannot exist yet

--- src/datomic/samples/repl.clj
+++ src/datomic/samples/repl.clj
@@ -24,7 +24,6 @@
   (let [cfg (read-string (slurp cfg-file))
         client (d/client cfg)
         db-name (str scratch-db-prefix (UUID/randomUUID))]
-    (d/delete-database client {:db-name db-name})
     (d/create-database client {:db-name db-name})
     (d/connect client {:db-name db-name})))

@@ -204,4 +203,4 @@
             "v" (trunc v 24)
             "tx" (format "0x%x" t)
             "added" added}))
-       (pp/print-table ["e" "a" "v" "tx" "added"])))+       (pp/print-table ["e" "a" "v" "tx" "added"])))


CMR-2312 Adds better error reporting for UMM array properties.

--- umm-spec-lib/src/cmr/umm_spec/json_schema.clj
+++ umm-spec-lib/src/cmr/umm_spec/json_schema.clj
@@ -189,6 +189,14 @@
     (recur (apply lookup-ref pair))
     pair))

+(defn- parse-error-msg
+  [type-def val]
+  (str "Could not parse "
+       (or (:format type-def)
+           (:type type-def))
+       " value: "
+       val))
+
 (defn coerce
   "Returns x coerced according to a JSON schema type type definition."
   ([schema x]
@@ -218,26 +226,39 @@
                    (= "true" x)
                    (boolean x))

-       "array"   (util/seqv
-                  (keep #(coerce schema (:items type-definition) %) x))
-
        ;; The most important job of this function:
        "object"  (let [ctor (record-ctor schema type-name)
                        ;; Reduce an empty map with each pair of (non-nil) key/vals in x, trying to
                        ;; parse each value or else add error messages in the map under :_errors.
                        m (reduce
                           (fn [m [k v]]
-                            (try
-                              (let [prop-type-definition (get-in type-definition [:properties k])
-                                    parsed (coerce schema prop-type-definition v)]
-                                (if (some? parsed)
-                                  (assoc m k parsed)
-                                  m))
-                              (catch Exception e
-                                (log/warn e "Could not parse value:" v)
-                                (assoc-in m [:_errors k] (str "Could not parse value: " v)))))
+                            (let [prop-type-definition (get-in type-definition [:properties k])
+                                  item-type-def (:items prop-type-definition)]
+                              (if (= "array" (:type prop-type-definition))
+                                (let [results (for [x v]
+                                                (try
+                                                  {:value (coerce schema item-type-def x)}
+                                                  (catch Exception e
+                                                    (let [msg (parse-error-msg item-type-def x)]
+                                                      (log/warn e msg)
+                                                      {:error msg}))))
+                                      results (filter #(or (:value %)
+                                                           (:error % ))
+                                                      results)]
+                                  (cond-> m
+                                    (some :value results) (assoc k (util/seqv (map :value results)))
+                                    (some :error results) (assoc-in [:_errors k] (map :error results))))
+                                ;; non-array types
+                                (try
+                                  (let [parsed (coerce schema prop-type-definition v)]
+                                    (if (some? parsed)
+                                      (assoc m k parsed)
+                                      m))
+                                  (catch Exception e
+                                    (let [msg (parse-error-msg prop-type-definition v)]
+                                      (log/warn e msg)
+                                      (assoc-in m [:_errors k] msg)))))))
                           nil
-                          ;; Leave nil values as-is.
                           (filter val x))]
                    ;; Return nil instead of empty maps/records here.
                    (when m
@@ -254,7 +275,7 @@
   (coerce umm-c-schema
           {:EntryTitle "This is a test"
            :TemporalExtents [{:EndsAtPresentFlag "true"
-                              :SingleDateTimes ["2000-01-01T00:00:00.000Z"]}]
-           :MetadataDates [{}]
-           :Distributions [{:Fees "123.4"}]})
+                              :SingleDateTimes ["2000-01-01T00:00:00.000Z" nil "banana"]}]
+           :Distributions [{:Fees "123.4"
+                            :DistributionSize "123 junk"}]})
   )


Rename variable in test

Rename variable in test

--- clstreams/test/clstreams/webapi/component_test.clj
+++ clstreams/test/clstreams/webapi/component_test.clj
@@ -17,17 +17,17 @@
       (with-spy-redefs
         [[aleph/start-server start-server-spy] (spy server-dummy)]

-        (let [im (new-aleph app-factory {:host "0.1.2.3" :port 1234})]
-          (is (= (:server im) nil))
+        (let [aleph (new-aleph app-factory {:host "0.1.2.3" :port 1234})]
+          (is (= (:server aleph) nil))
           (is (= (-> start-server-spy calls count) 0))
           (is (= (-> stop-server-spy calls count) 0))

-          (let [started-aleph (component/start im)]
+          (let [started-aleph (component/start aleph)]
             (is (= (:server started-aleph) server-dummy))
             (is (= (-> start-server-spy calls count) 1))
             (is (= (-> stop-server-spy calls count) 0))
             (is (= (-> app-factory-spy calls count) 1))
-            (is (= (-> app-factory-spy calls first) [im]))
+            (is (= (-> app-factory-spy calls first) [aleph]))

             (let [stopped-aleph (component/stop started-aleph)]
               (is (= (:stop-server stopped-aleph) nil)))))


Ensure webjars are put on valid path

Ensure webjars are put on valid path

--- ext/webjars/src/yada/resources/webjar_resource.clj
+++ ext/webjars/src/yada/resources/webjar_resource.clj
@@ -74,5 +74,7 @@
    (let [webjars (->> (WebJarAssetLocator.)
                       .getWebJars
                       keys
-                      (map (juxt identity #(new-webjar-resource % options))))]
+                      (map (juxt (fn [identifier]
+                                   (str "/" identifier "/"))
+                                 #(new-webjar-resource % options))))]
      ["" webjars])))


New Problem Added

New Problem Added

--- src/foreclojure/data-set.clj
+++ src/foreclojure/data-set.clj
@@ -2,6 +2,7 @@
   (:use [somnium.congomongo]))

 (do
+
   (insert! :problems
            {:_id 1
             :title "Nothing but the Truth"


Ring web server working with "lein run"! Returns map html+svg to client!!

--- src/glory_of_empires/map.clj
+++ src/glory_of_empires/map.clj
@@ -3,6 +3,7 @@
   (:use clojure-common.utils)
   (:use clojure-common.xml)
   (:use clojure.test)
+  (:use ring.adapter.jetty)
   (:gen-class))

 (def resources-url "http://www.brotherus.net/ti3/")
@@ -160,9 +161,19 @@
           (concat [ :g { :transform (str "scale(0.5) translate(" counter-translate ")") } ]
                   (map piece-to-svg pieces2)) ] ] ] ))

-;-----------------------------------------------------------------------
+;----------------- web server ----------------------
+
+(def big-map (xml-to-text (map-to-svg (make-random-map 4))))
+
+(defn handler [request]
+  (println (pretty-pr request))
+  {:status 200
+   :headers {"Content-Type" "text/html"}
+   :body big-map } )
+

 (defn -main [& args]
   (println (xml-to-text (map-to-svg (make-random-map 2))))
   (spit "map.html" (xml-to-text (map-to-svg (make-random-map 4))))
+  (run-jetty handler {:port 3000})
 )


added pre constraints to book handlers

added pre constraints to book handlers

--- src/granger/models/books.clj
+++ src/granger/models/books.clj
@@ -7,14 +7,31 @@
                          :host "127.0.0.1"
                          :port 27017))

+(def book-keys #{:created_at
+                 :isbn
+                 :title
+                 :authors
+                 :text})
+
+(defn keys-exist [whitelist vals]
+  (every? (partial contains? whitelist) vals))
+
+(defn valid-book?
+  "Check that map is a valid representation of a book"
+  [m]
+  (and (keys-exist book-keys (keys m))
+       (keys-exist m book-keys)))
+
 (defn add-book!
   "Create new book review"
-  [data]
-  (mongo/with-mongo conn (mongo/insert! :test data)))
+  [book]
+  {:pre [(valid-book? book)]}
+  (mongo/with-mongo conn (mongo/insert! :test book)))

 (defn update-book!
   "Update existing book review"
   [old updates]
+  {:pre [(valid-book? (merge old updates))]}
   (mongo/with-mongo conn
     (mongo/update! :test old (merge old updates))))

@@ -30,8 +47,4 @@
   "Returns a collection of book reviews"
   []
   (mongo/with-mongo conn
-    (response (mongo/fetch :test :as :json))))
-
-(defn is-valid?
-  "Whether data is a valid book review representation"
-  [data])+    (response (mongo/fetch :test :as :json))))