Test fix :wrench:

Test fix :wrench:

--- test/metabase/models/card_test.clj
+++ test/metabase/models/card_test.clj
@@ -119,5 +119,5 @@
 ;; invalid/legacy card should return perms for something that doesn't exist so no one gets to see it
 (expect
   #{"/db/0/"}
-  (query-perms-set (mbql {:filter [:WOW 100 200]}
-                         :read)))
+  (query-perms-set (mbql {:filter [:WOW 100 200]})
+                   :read))


test suite

test suite

--- src/flatgui/test.clj
+++ src/flatgui/test.clj
@@ -150,4 +150,7 @@
 ;; Utilities for working with components
 ;;

-
+(defn wait-table-model-coords-shown [container table-path coords]
+  (wait-for-property-pred container table-path :in-use-model
+                              (fn [v] (let [sc->id (:screen-coord->cell-id v)]
+                                        (= (set coords) (set (map (fn [[k _cid]] k) sc->id)))))))


Add navbar and intro text

Add navbar and intro text

--- src/gather/views.clj
+++ src/gather/views.clj
@@ -2,26 +2,72 @@
   (:use hiccup.core)
   (:require [hiccup.page :as page]
             [hiccup.element :as element]
-            [clojure.string :as string]))
+            [clojure.string :refer [capitalize]]))

-(defn app [title & body]
+(defn common [title & body]
   (html
     [:head
-      [:meta {:charset "utf-8"}]
-      [:meta {:http-equiv "X-UA-Compatible" :content "IE-Edge"}]
-      [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
-      [:title title]
-      (page/include-css "css/bootstrap.min.css")
-      (page/include-js "js/bootstrap.min.js")]
-    [:body body]))
+     [:meta {:charset "utf-8"}]
+     [:meta {:http-equiv "X-UA-Compatible" :content "IE-Edge"}]
+     [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
+     [:meta {:name "description" :content "make a page for your event"}]
+     [:meta {:name "author" :content "Bryan Garza"}]
+     [:title title]
+     (page/include-css "css/bootstrap.min.css"
+                       "font-awesome/css/font-awesome.min.css"
+                       "fonts/lora.css"
+                       "fonts/montserrat.css"
+                       "css/grayscale.css")]
+    [:div.container
+     [:body#page-top {:data-spy "scroll" :data-target ".navbar-custom"} body]]
+    (page/include-js "js/jquery.min.js"
+                     "js/bootstrap.min.js"
+                     "js/jquery.easing.min.js"
+                     "js/grayscale.js")))

 (defn index []
-  (app
+  (common
     "Home"
-    [:h1 "Gather"]
-    [:h2 "Create an information page for your event, no signup required."]
-    (map (fn [w]
-           [:div.input-group.input-group-lg
-           [:input.form-control {:type w :placeholder (string/capitalize w)}]])
-         ["title" "location" "date" "time"])
-    [:button.btn.btn-default {:type "submit"} "Submit"]))
+    [:nav.navbar.navbar-custom.navbar-fixed-top {:role "navigation"}
+     [:div.container
+
+      [:div.navbar-header.page-scroll
+       [:button.navbar-toggle {:type "button"
+                               :data-toggle "collapse"
+                               :data-target ".navbar-main-collapse"}
+        [:i.fa.fa-bars]]
+       [:a.navbar-brand {:href "#page-top"}
+        [:i.fa.fa-paper-plane] [:span.light "Start"] "Bootstrap"]]
+
+      ; Collect the nav links, forms, and other content for toggling
+      [:div.collapse.navbar-collapse.navbar-right.navbar-main-collapse
+       [:ul.nav.navbar-nav
+        ; Hidden li included to remove active class from about link when
+        ; scrolled up past section
+        [:li.hidden (element/link-to "#page-top")]
+        [:li.page-scroll (element/link-to "#create" "Create")]
+        [:li.page-scroll (element/link-to "#events" "Events")]
+        [:li.page-scroll (element/link-to "#contact" "Contact")]]]]]
+
+    [:section.intro
+     [:div.intro-body
+      [:div.container
+       [:div.row
+        [:div.col-md-8.col-md-offset-2
+         [:h1.brand-heading "Gather"]
+         [:p.intro-text "Make a page for your event. No signups, no mess.
+                         We'll take care of the details."]
+         [:div.page-scroll
+          [:a.btn.btn-circle {:href "#create"}
+           [:i.fa.fa-angle-double-down.animated]]]]]]]]
+
+    ; [:div.col-md-2]
+    ; [:div.col-md-8
+    ;  (map (fn [w]
+    ;         [:div.input-group.input-group-lg
+    ;          [:input.form-control {:type w :placeholder (capitalize w)}]])
+    ;       ["title" "location" "date" "time"])
+    ;  [:textarea.form-control.input-lg {:rows "5":placeholder "Description"}]
+    ;  [:button.btn.btn-primary {:type "submit"} "Submit"]]
+    ; [:div.col-md-2]
+    ))


fix(var doc): plain text doesn't show "<pre>" anymore

--- ccw.core/src/clj/ccw/core/doc_utils.clj
+++ ccw.core/src/clj/ccw/core/doc_utils.clj
@@ -65,14 +65,14 @@

 (defn doc-doc [renderer {:keys [doc]}]
   (when-not (str/blank? doc)
-    (render-section renderer
-                    "Documentation"
-                    (str
-                      "
"
-                      "  " ; We add 2 spaces because docstring are generally
-                           ; indented 2 spaces except the first line
-                      doc
-                      "
"))))
+    (let [body (condp = renderer
+                 :html (str "
" doc "
")
+                 :text doc)
+          body (str
+                 "  " ; We add 2 spaces because docstring are generally
+                      ; indented 2 spaces except the first line
+                 body)]
+      (render-section renderer "Documentation" body))))

 (defn var-doc-info [renderer m]
   (let [sections [(header-doc renderer m)


DXML-61: avoid calling -pr-writer directly in cljs element printer

--- src/main/clojure/clojure/data/xml/node.cljc
+++ src/main/clojure/clojure/data/xml/node.cljc
@@ -151,13 +151,13 @@
    [IPrintWithWriter
     (-pr-writer [this writer opts]
                 (-write writer "#xml/element{:tag ")
-                (-pr-writer tag writer opts)
+                (pr-writer tag writer opts)
                 (when-not (empty? attrs)
                   (-write writer ", :attrs ")
-                  (-pr-writer attrs writer opts))
+                  (pr-writer attrs writer opts))
                 (when-not (empty? content)
                   (-write writer ", :content ")
-                  (pr-sequential-writer writer -pr-writer "[" " " "]" opts content))
+                  (pr-sequential-writer writer pr-writer "[" " " "]" opts content))
                 (-write writer "}"))]))

 ;; clj printing is a multimethod


Make search implementable

Make search implementable

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -35,6 +35,7 @@
 (defmulti -read-meta dispatch)
 (defmulti -read-note dispatch)
 (defmulti -read-example dispatch)
+(defmulti -search dispatch)

 ;; Datastore API impl' multimethods - listing & reading
 ;;--------------------------------------------------------------------
@@ -400,6 +401,10 @@
   Will match all instances of Ns in any platform of any version of any artifact
   in a Maven group matching the regex #\"org.*\""
   [config pattern]
+  (-search config pattern))
+
+;; Default naive implementation of searching as above
+(defmethod -search :default [config pattern]
   (match [pattern]
     ;; Case of a def
     ;;----------------------------------------


Fix to use the local util

Fix to use the local util

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -4,7 +4,7 @@
   regard to the implementation of the datastore. Ports of Grimoire to
   different datastores should only need to tweak this namespace."

-  (:require [grimoire.web.util :as util]
+  (:require [grimoire.util :as util]
             [clojure.java.io :as io]
             [clojure.string :as string]
             [clj-semver.core :as semver]))


SQUASHME WITH LAST Drop :as cfg

SQUASHME WITH LAST Drop :as cfg

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -55,7 +55,7 @@

 (defn ns->thing
   "Function from a"
-  [{:keys [groupid artifactid version platform :as cfg]} ns-symbol]
+  [{:keys [groupid artifactid version platform]} ns-symbol]
   {:pre [(symbol? ns-symbol)
          (string? groupid)
          (string? artifactid)


Switched to using group-by

Switched to using group-by

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -16,29 +16,21 @@
   [word-seq target-len]
   (filter #(= target-len (count %)) word-seq) )

+(def all-words
+  (->> (slurp"resources/words.txt")
+       (str/split-lines )
+       (map str/trim ) ))
+
 (defn main []
-  (println "Hello, World!")
+  (println "main: enter")
+  (show-info all-words "all-words")
   (let [
-     words   (->> (slurp"resources/words.txt")
-                  (str/split-lines )
-                  (map str/trim ) )
-     _       (show-info words "words")
-     max-len (apply max (map #(count %) words) )
-     _  (println "max-len:" max-len)
-     _  (do
-          (println "for loop:")
-          (doall (for [ curr-len (range 1 (inc max-len)) ]
-            (let [ curr-words (words-of-len words curr-len) ]
-              (show-info curr-words (str "len=" curr-len) )
-            )) )
-          (println "leaving doall #1")
-          )
-     map-by-size  (group-by count words)
-     _   (println "map-by-size:")
-     _   (doall (for [ curr-len (range 1 (inc max-len)) ]
-             (let [ curr-words   (get map-by-size curr-len [] ) ]
-              (show-info curr-words (str "len=" curr-len) ) )
-           ))
-     ]
-  )
-)
+    max-len (apply max (map #(count %) all-words) )
+    map-by-size  (group-by count all-words)
+    ]
+    (println "map-by-size:")
+    (doseq [ curr-len (range 1 (inc max-len)) ]
+      (let [ curr-words   (get map-by-size curr-len [] ) ]
+        (show-info curr-words (str "len=" curr-len) ) )
+    )
+  ))


Blake-out restart/loop buttons when disabled

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -281,24 +281,30 @@
 (defn restart-button [data owner]
   (reify om/IRender
     (render [this]
-      (dom/img #js {:style #js {:transform "scale(-1, 1)"}
-                    :className "player-button-img"
-                    :src "/images/player/restart.svg"
-                    :title "Restart Track"
-                    :onClick core/restart-track}))))
+      (if (nil? (:current-track-id data))
+        (dom/img #js {:className "player-button-img"
+                      :src grey-out-image})
+        (dom/img #js {:style #js {:transform "scale(-1, 1)"}
+                      :className "player-button-img"
+                      :src "/images/player/restart.svg"
+                      :title "Restart Track"
+                      :onClick core/restart-track})))))

 (defn loop-button [data owner]
   (reify om/IRender
     (render [this]
-      (if (:looping? data)
-        (dom/img #js {:className "player-button-img"
-                      :src "/images/player/looping.svg"
-                      :title "Unloop Track"
-                      :onClick core/toggle-loop})
-        (dom/img #js {:className "player-button-img"
-                      :src "/images/player/looping.svg"
-                      :title "Loop Track"
-                      :onClick core/toggle-loop})))))
+      (if (nil? (:current-track-id data))
+        (dom/img #js {:className "player-button-img"
+                      :src grey-out-image})
+        (if (:looping? data)
+          (dom/img #js {:className "player-button-img"
+                        :src "/images/player/looping.svg"
+                        :title "Unloop Track"
+                        :onClick core/toggle-loop})
+          (dom/img #js {:className "player-button-img"
+                        :src "/images/player/looping.svg"
+                        :title "Loop Track"
+                        :onClick core/toggle-loop}))))))

 (om/root play-pause-button player/app-state {:target (. js/document (getElementById "play-pause-button"))})
 (om/root previous-track-button core/app-state {:target (. js/document (getElementById "previous-track-button"))})


Add support for variable references

Add support for variable references

--- src/icfp2014/ghc.clj
+++ src/icfp2014/ghc.clj
@@ -12,6 +12,12 @@
   "Return the name of a hashtag, if any. Otherwise return nil."
   [line]
   (last (first (re-seq #"#(\S+)" line))))
+
+(defn vars
+  "Return a vector of all vars on the line. If none, return an empty vector"
+  [line]
+  {:post [(vector? %)]}
+  (mapv second (re-seq #"\$([\w-!?><\[\]]+)" line)))

 (defn attag
   "Return the name of an @tag, if any. Otherwise return nil."
@@ -45,14 +51,46 @@
                      (into {}))]
     (map (partial replace-attag tag-map) source)))

+(defn replace-vars
+  "Given a string (line) and a map of tags to line numbers, replace any instance
+  of @tag with the corresponding number. Otherwise return the line."
+  [var-lst line]
+  (reduce (fn [l var]
+            (let [idx (.indexOf var-lst var)]
+              (-> (s/replace l
+                             (str "$" var)
+                             (str "[" idx "]"))
+                  (str (format " ; $%s = %d" var idx)))))
+          line
+          (vars line)))
+
+(defn var-lines
+  [seq-of-lines]
+  (let [source  (->> seq-of-lines
+                     (filter (complement comment?)))
+        var-lst (vec (mapcat vars source))]
+    (if (> (count var-lst) 255)
+      (throw (IllegalArgumentException. "Too many variables!")))
+    (mapv (partial replace-vars var-lst) source)))
+
 (defn check-length
   "The maximum length for a GHC program is 256 instructions.
-  Throw an exception if the program is too long, otherwise
+  Throw an exception if the program is too long, otherwise
   just return it."
   [lines]
   (if (> (count lines) 256)
     (throw (IllegalArgumentException. (format "This program is too damn long! %d lines!" (count lines))))
     lines))
+
+(defn tag-file*
+  [fin-path]
+  (->> fin-path
+       io/reader
+       line-seq
+       tag-lines
+       var-lines
+       check-length
+       (s/join "\n")))

 (defn tag-file
   [fin-path fout-path]
@@ -60,6 +98,7 @@
        io/reader
        line-seq
        tag-lines
+       var-lines
        check-length
        (s/join "\n")
        (spit fout-path)))


Correcting spelling mistake.

Correcting spelling mistake.

--- umm-spec-lib/src/cmr/umm_spec/umm_json.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_json.clj
@@ -69,7 +69,7 @@

 (defmethod parse-json :default
   [_ _ schema-type _]
-  (throw (Exception. (str "Unable to determing parse json for " (pr-str schema-type)))))
+  (throw (Exception. (str "Unable to parse json for " (pr-str schema-type)))))

 ;; An object is parsed by finding the equivalent clojure record and it's map->record-name constructor
 ;; function.


Refactor store tests to centralize operation declarations.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -17,6 +17,8 @@
     blocks.data.PersistentBytes))

+;; ## Block Utilities
+
 (defn random-block
   "Creates a new block with random content at most `max-size` bytes long."
   [max-size]
@@ -44,17 +46,44 @@

-;; ## Generators
-
-(def gen-block
-  "Generator which constructs blocks with random content and one of the
-  available hashing functions."
-  (gen/fmap
-    (partial apply block/read!)
-    (gen/tuple
-      (gen/not-empty (gen/scale (partial * 10) gen/bytes))
-      (gen/elements (keys digest/functions)))))
-
+;; ## Result Checkers
+
+(defn- check-stat
+  "Checker for the response for block stats."
+  [model id result]
+  (if-let [block (get model id)]
+    (testing "for stored block"
+      (is (map? result))
+      (is (= (:id block) (:id result)))
+      (is (= (:size block) (:size result)))
+      (is (some? (:stored-at result))))
+    (testing "for missing block"
+      (is (nil? result)))))
+
+
+(defn- check-list
+  "Checker for the response for a list call."
+  [model {:keys [algorithm after limit]} result]
+  (let [expected-ids
+          (cond->> (keys model)
+            after
+              (filter #(pos? (compare (multihash/hex %) after)))
+            algorithm
+              (filter #(= algorithm (:algorithm %)))
+            true
+              (sort)
+            limit
+              (take limit))]
+    (is (sequential? result))
+    (is (= (count result) (count expected-ids))
+        "result should match the number of blocks expected")
+    (is (every? (partial apply check-stat model)
+                (map vector expected-ids result))
+        "all stat results are rturned")))
+
+
+
+;; ## Operation Generators

 (defn- gen-list-opts
   "Generator for options maps to pass into a block/list call."
@@ -71,6 +100,8 @@

 (defn- gen-block-range
+  "Generator for a tuple containing a block id and a start and end offset, where
+  the offsets are guaranteed to follow `0 <= start <= end <= size`."
   [blocks]
   (gen/bind
     (gen/elements (vals blocks))
@@ -81,139 +112,150 @@
         (gen/vector (gen/large-integer* {:min 0, :max (:size block)}) 2)))))

+(def ^:private store-operations
+  "Map of information about the various operations which the tests can perform
+  on the block store."
+  (let [choose-id (comp gen/elements keys)
+        choose-block (comp gen/elements vals)]
+    {:stat
+     {:args choose-id
+      :check check-stat}
+
+     :list
+     {:args gen-list-opts
+      :check check-list}
+
+     :get
+     {:args choose-id
+      :check (fn check-get
+               [model id result]
+               (if-let [block (get model id)]
+                 (is (= block result)
+                     "returned block should be equivalent to model")
+                 (is (nil? result)
+                     "missing block should return nil")))}
+
+     :put!
+     {:args choose-block
+      :update (fn update-put
+                [model block]
+                (assoc model (:id block) block))
+      :check (fn check-put
+               [model block result]
+               (is (= (:id block) (:id result)))
+               (is (= (:size block) (:size result)))
+               (is (= block result)))}
+
+     :delete!
+     {:args choose-id
+      :update (fn update-delete
+                [model id]
+                (dissoc model id))
+      :check (fn check-delete
+               [model id result]
+               (if (contains? model id)
+                 (is (true? result)
+                     "deleting a stored block should return true")
+                 (is (false? result)
+                     "deleting a missing block should return false")))}
+
+     :get-batch
+     {:args (comp gen/not-empty gen/set choose-id)
+      :check (fn check-get-batch
+               [model ids result]
+               (let [expected-blocks (keep model (set ids))]
+                 (is (coll? result))
+                 (is (= (set expected-blocks) (set result)))))}
+
+     :put-batch!
+     {:args (comp gen/not-empty gen/set choose-block)
+      :update (fn update-put-batch
+                [model blocks]
+                (into model (map (juxt :id identity) blocks)))
+      :check (fn check-put-batch
+               [model blocks result]
+               (is (= (set blocks) (set result))))}
+
+     :delete-batch!
+     {:args (comp gen/not-empty gen/set choose-id)
+      :update (fn update-delete-batch
+                [model ids]
+                (apply dissoc model ids))
+      :check (fn check-delete-batch
+               [model ids result]
+               (let [contained-ids (keep (set ids) (keys model))]
+                 (is (set? result))
+                 (is (= (set contained-ids) result))))}
+
+     :open-block
+     {:args choose-id
+      :apply block/get
+      :check (fn check-open-block
+               [model id result]
+               (if-let [block (get model id)]
+                 (is (bytes= (.open (.content block)) (block/open result)))
+                 (is (nil? result))))}
+
+     :open-block-range
+     {:args gen-block-range
+      :apply (fn [store args] (block/get store (first args)))
+      :check (fn check-open-block-range
+               [model [id start end] result]
+               (if-let [block (get model id)]
+                 (is (bytes= (@#'blocks.core/bounded-input-stream
+                               (.open (.content block)) start end)
+                             (block/open result start end)))
+                 (is (nil? result))))}}))
+
+
 (defn- gen-store-op
   "Test generator which creates a single operation against the store."
   [blocks]
-  (let [gen-op (fn [op-key gen-args] (gen/tuple (gen/return op-key) gen-args))
-        gen-block-key (gen/elements (keys blocks))
-        gen-block-val (gen/elements (vals blocks))]
-    (gen/one-of
-      [(gen-op :stat             gen-block-key)
-       (gen-op :list             (gen-list-opts blocks))
-       (gen-op :get              gen-block-key)
-       (gen-op :put!             gen-block-val)
-       (gen-op :delete!          gen-block-key)
-       (gen-op :get-batch        (gen/not-empty (gen/set gen-block-key)))
-       (gen-op :put-batch!       (gen/not-empty (gen/set gen-block-val)))
-       (gen-op :delete-batch!    (gen/not-empty (gen/set gen-block-key)))
-       (gen-op :open-block       gen-block-key)
-       (gen-op :open-block-range (gen-block-range blocks))])))
-
-
-
-;; ## Testing
+  (gen/bind
+    (gen/elements (keys store-operations))
+    (fn [op-key]
+      (gen/tuple
+        (gen/return op-key)
+        ((get-in store-operations [op-key :args]) blocks)))))
+
+
+
+;; ## Operation Testing

 (defn- apply-op!
   "Applies an operation to the store by using the op keyword to resolve a method
   in the `blocks.core` namespace. Returns the result of calling the method."
   [store [op-key args]]
   ;(println ">>" op-key (pr-str args))
-  (case op-key
-    :open-block
-      (block/get store args)
-
-    :open-block-range
-      (block/get store (first args))
-
-    (let [var-name (symbol (name op-key))
-          method (ns-resolve 'blocks.core var-name)]
-      (method store args))))
-
-
-(defn- check-stat-result
-  [block result]
-  (if block
-    (testing "stored block"
-      (is (map? result))
-      (is (= (:id block) (:id result)))
-      (is (= (:size block) (:size result)))
-      (is (some? (:stored-at result))))
-    (testing "missing block"
-      (is (nil? result)))))
+  (if-let [method (or (get-in store-operations [op-key :apply])
+                      (ns-resolve 'blocks.core (symbol (name op-key))))]
+    (method store args)
+    (throw (ex-info "No apply function available for operation!"
+                    {:op-key op-key}))))

 (defn- check-op
   "Checks that the result of an operation matches the model of the store's
   contents. Returns true if the operation and model match."
   [model [op-key args] result]
-  (case op-key
-    :stat
-      (check-stat-result (get model args) result)
-
-    :list
-      (let [{:keys [algorithm after limit]} args
-            expected-ids
-              (cond->> (keys model)
-                after
-                  (filter #(pos? (compare (multihash/hex %) after)))
-                algorithm
-                  (filter #(= algorithm (:algorithm %)))
-                true
-                  (sort)
-                limit
-                  (take limit))]
-        (is (sequential? result))
-        (is (= (count result) (count expected-ids)))
-        (is (every?
-               (fn [[id act]] (check-stat-result (get model id) act))
-               (map vector expected-ids result))
-            "all stat results are rturned"))
-
-    :get
-      (if-let [block (get model args)]
-        (is (= block result))
-        (is (nil? result)))
-
-    :put!
-      (do (is (= (:id result) (:id args)))
-          (is (= (:size result) (:size args))))
-
-    :delete!
-      (if (contains? model args)
-        (testing "stored block"
-          (is (true? result)))
-        (testing "missing block"
-          (is (false? result))))
-
-    :get-batch
-      (let [expected-blocks (keep model args)]
-        (is (coll? result))
-        (is (= (set expected-blocks) (set result))))
-
-    :put-batch!
-      (is (= (set args) (set result)))
-
-    :delete-batch!
-      (let [contained-ids (keep (set args) (keys model))]
-        (is (= (set contained-ids) result)))
-
-    :open-block
-      (if-let [block (get model args)]
-        (is (bytes= (.open (.content block)) (block/open result)))
-        (is (nil? result)))
-
-    :open-block-range
-      (let [[id start end] args]
-        (if-let [block (get model id)]
-          (is (bytes= (@#'blocks.core/bounded-input-stream
-                        (.open (.content block)) start end)
-                      (block/open result start end)))
-          (is (nil? result))))))
+  (if-let [checker (get-in store-operations [op-key :check])]
+    (checker model args result)
+    (throw (ex-info "No check function available for operation!"
+                    {:op-key op-key}))))

 (defn- update-model
+  "Updates the model after an operation has been applied to the store under
+  test. Returns an updated version of the model."
   [model [op-key args]]
-  (case op-key
-    :put! (assoc model (:id args) args)
-    :delete! (dissoc model args)
-    :put-batch! (into model (map (juxt :id identity) args))
-    :delete-batch! (apply dissoc model args)
+  (if-let [updater (get-in store-operations [op-key :update])]
+    (updater model args)
     model))

 (defn- valid-op-seq?
   "Determines whether the given sequence of operations produces valid results
-  when applied to the store."
+  when applied to the store. Returns true if the store behavior is valid."
   [store ops]
   (loop [model {}
          ops ops]
@@ -232,6 +274,17 @@
 ;; ## Store Tests

 (defn check-store
+  "Uses generative tests to validate the behavior of a block store
+  implementation. The first argument must be a no-arg constructor function which
+  will produce a new block store for testing. The remaining options control the
+  behavior of the tests:
+
+  - `blocks`      generate this many random blocks to test the store with
+  - `max-size`    maximum block size to generate, in bytes
+  - `iterations`  number of generative tests to perform
+  - `eraser`      optional custom function to completely remove the store
+
+  Returns the results of the generative tests."
   [constructor & {:keys [blocks max-size iterations eraser]
                   :or {blocks 20, max-size 1024, iterations 100}}]
   {:pre [(some? constructor)]}
@@ -259,7 +312,8 @@

 (defn check-store!
-  "Interprets test results from `check-store!` for a `clojure.test` result."
+  "Runs tests as for `check-store` but interprets the results for
+  `clojure.test`. Throws an exception if the tests do not succeed."
   [& args]
   (let [info (apply check-store args)]
     (cond


add more parameter properties

add more parameter properties

--- src/crucible/parameters.clj
+++ src/crucible/parameters.clj
@@ -28,6 +28,30 @@
   [[k no-echo?]]
   [(encode-key k) (str no-echo?)])

+(defmethod encode-kv :constraint-description
+  [[k constraint-description]]
+  [(encode-key k) (str constraint-description)])
+
+(defmethod encode-kv :allowed-pattern
+  [[k pattern]]
+  [(encode-key k) (str pattern)])
+
+(defmethod encode-kv :min-value
+  [[k n]]
+  [(encode-key k) (str n)])
+
+(defmethod encode-kv :max-value
+  [[k n]]
+  [(encode-key k) (str n)])
+
+(defmethod encode-kv :min-length
+  [[k n]]
+  [(encode-key k) (str n)])
+
+(defmethod encode-kv :max-length
+  [[k n]]
+  [(encode-key k) (str n)])
+
 (defn encode-parameter
   [spec]
   (into {} (map encode-kv (seq spec))))


Uses futures

Uses futures

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -145,8 +145,16 @@
   (println "-----------------------------------------------------------------------------")
   (println "Beginning data transfer...")
   (newline)
-  (doseq [table-name (keys tables/table-name->creation-sql) ]
-    (proc-table table-name)))
+  (let [table-futures-map   (into (sorted-map)
+                              (for [table-name (keys tables/table-name->creation-sql) ]
+                                { table-name (future (proc-table table-name)) } ))
+  ]
+    (doseq [it table-futures-map]
+      (print "  waiting for:" (key it))
+      (deref (val it))  ; block until complete
+      (println "  done."))
+    (shutdown-agents)
+  ))

 (defn -main []
   (oracle-init)


Remove debug code

Remove debug code

--- src/cyanite_cache/cache.clj
+++ src/cyanite_cache/cache.clj
@@ -36,24 +36,17 @@
   (* sec 1000))

 (defn create-flusher
- [mkeys mkey pkeys tenant period rollup time ttl fn-get fn-agg fn-store]
- (fn []
-   (println "FLUSHER!!!!!!!")
-   (doseq [path @pkeys]
-     (fn-store tenant period rollup time path
-               (fn-agg (fn-get (construct-key mkey path))) ttl))
-   ;;(swap! mkeys (fn [mkeys] (dissoc mkeys mkey)))
-   (println "FLUSHER ENDS!!!")
-   (newline)
-   ))
+  [mkeys mkey pkeys tenant period rollup time ttl fn-get fn-agg fn-store]
+  (fn []
+    (doseq [path @pkeys]
+      (fn-store tenant period rollup time path
+                (fn-agg (fn-get (construct-key mkey path))) ttl))
+    (swap! mkeys (fn [mkeys] (dissoc mkeys mkey)))))

 (defn run-delayer!
   [rollup flusher]
-  (let [
-        ;;delayer (future
-        ;;          (Thread/sleep (to-ms (calc-delay rollup (rand-int 59)))))
-        delayer (future (Thread/sleep 3000))
-        ]
+  (let [delayer (future
+                  (Thread/sleep (to-ms (calc-delay rollup (rand-int 59)))))]
     (future
       (deref delayer)
       (flusher))
@@ -63,9 +56,9 @@
   [mkeys tenant period rollup time ttl fn-get fn-agg fn-store]
   (let [mkey (construct-mkey tenant period rollup time)]
     (swap! mkeys
-           (fn [mkeys]
-             (if (contains? mkeys mkey)
-               mkeys
+           (fn [at-mkeys]
+             (if (contains? at-mkeys mkey)
+               at-mkeys
                (let [pkeys (atom [])
                      flusher (create-flusher mkeys mkey pkeys tenant period
                                              rollup time ttl fn-get fn-agg
@@ -74,7 +67,7 @@
                  (swap! pkeys
                         (fn [pkeys]
                           (with-meta pkeys {:flusher flusher :delayer delayer})))
-                 (assoc mkeys mkey pkeys)))))
+                 (assoc at-mkeys mkey pkeys)))))
     (get @mkeys mkey)))

 (defn set-keys!


AWS updates to core.clj

AWS updates to core.clj

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -7,12 +7,14 @@
 ;           [cooljure.misc          :as cool-misc]
   )
   (:use cooljure.core cooljure.misc)
+  (:import java.util.TimeZone)
   (:gen-class))

 (def db-spec
   { :classname "org.postgresql.Driver"
     :subprotocol "postgresql"
-    :subname "//localhost:5432/alan"
+    :subname "//localhost:5432/ubuntu"
+  ; :subname "//localhost:5432/alan"
   ; :user "alan"
   ; :pass "secret"
   })
@@ -95,10 +97,10 @@

  (newline))

-(defn ora []
-  (newline)
-  (println "-----------------------------------------------------------------------------")
-  (println "ora")
+(defn ora1 []
+  (newline)
+  (println "-----------------------------------------------------------------------------")
+  (println "ora1")
   (let [
     db-spec { :classname    "oracle.jdbc.OracleDriver"  ; must be in classpath
               :subprotocol  "oracle"
@@ -107,17 +109,20 @@
               :password     "rxlogix" }
 ;   db-str  "jdbc:oracle:thin:@//argus-mart-db01.eng.rxlogix.com:1521:pvram"
   ]
+    ; Stupid Oracle DB will often crash without this set
+    (let [timeZone  (TimeZone/getTimeZone "America/Los_Angeles") ]
+      (TimeZone/setDefault timeZone))
     (newline)
     (spy :msg "pkg_rls.set_context"
       (jdbc/execute! db-spec [
         "begin
            pkg_rls.set_context ('admin', '1','ARGUS_MART', '#$!AgSeRvIcE@SaFeTy');
          end; " ] ))
-
-    (newline)
-    (println "Trying count(*)...")
     (spyx (jdbc/query db-spec [ "select sysdate as current_day from dual" ] ))
     (spyx (jdbc/query db-spec [ "select BANNER from SYS.V_$VERSION" ] ))
+
+    (newline)
+    (println "Trying count(*)...")
     (spyx (jdbc/query db-spec [ "select * from rm_case_master" ] ))

     (newline)
@@ -154,16 +159,87 @@
           "begin
              pkg_rls.set_context ('admin', '1','ARGUS_MART', '#$!AgSeRvIcE@SaFeTy');
            end; " ] ))
+      (time
+        (spy :msg "  2st stmt"
+          (jdbc/query db-conn
+                          [ "select * from rm_case_master" ]
+                          :result-set-fn count )))
+    )
+
+   (newline)))
+
+(defn ora2 []
+  (newline)
+  (println "-----------------------------------------------------------------------------")
+  (println "ora2")
+  (let [
+    db-spec { :classname    "oracle.jdbc.OracleDriver"  ; must be in classpath
+              :subprotocol  "oracle"
+              :subname      "thin:@//10.100.6.231:1521/pvram"
+              :user         "mart_user_bkp"
+              :password     "rxlogix" }
+  ]
+    ; Stupid Oracle DB will often crash without this set
+    (let [timeZone  (TimeZone/getTimeZone "America/Los_Angeles") ]
+      (TimeZone/setDefault timeZone))
+    (newline)
+    #_(spy :msg "pkg_rls.set_context"
+      (jdbc/execute! db-spec [
+        "begin
+           pkg_rls.set_context ('admin', '1','ARGUS_MART', '#$!AgSeRvIcE@SaFeTy');
+         end; " ] ))
+    (spyx (jdbc/query db-spec [ "select sysdate as current_day from dual" ] ))
+    (spyx (jdbc/query db-spec [ "select BANNER from SYS.V_$VERSION" ] ))
+
+    (newline)
+    (println "using conn")
+    (jdbc/with-db-connection [db-conn db-spec]
+      (spy :msg "  1st stmt"
+        #_(jdbc/execute! db-conn [
+          "begin
+             pkg_rls.set_context ('admin', '1','ARGUS_MART', '#$!AgSeRvIcE@SaFeTy');
+           end; " ] ))
       (spy :msg "  2st stmt"
-        (jdbc/query db-conn
+        (let [result  (jdbc/query db-conn
                         [ "select * from rm_case_master" ]
-                        :result-set-fn count ))
+              ;         :result-set-fn first
+                        :result-set-fn #(doall (take 5 %))
+                      )
+              ]
+          (doseq [it result]
+            (newline)
+            (prn (into (sorted-map) it)))
+          (newline)))
+
+      (spy :msg "  count(*)"
+        (jdbc/query db-conn [ "select count(*) as result from rm_case_master" ] ))
+      (spy :msg "  count(1)"
+        (jdbc/query db-conn [ "select count(1) as result from rm_case_master" ] ))
+    )
+
+    (newline)
+    (println "using conn #2")
+    (jdbc/with-db-connection [db-conn db-spec]
+      (spy :msg "  1st stmt"
+        #_(jdbc/execute! db-conn [
+          "begin
+             pkg_rls.set_context ('admin', '1','ARGUS_MART', '#$!AgSeRvIcE@SaFeTy');
+           end; " ] ))
+      ; perf: about 11K rows/sec tx between servers on AWS
+      (time
+        (spy :msg "  2st stmt"
+          (jdbc/query db-conn
+                          [ "select * from rm_case_master where rownum < 100000" ]
+                          :result-set-fn count )))
     )

    (newline)))

+
 (defn -main []
+; (v0)
 ; (v1)
-  (ora)
+; (ora1)
+  (ora2)
 )


Escape elasticsearch query string

Escape elasticsearch query string

Working around this:

https://github.com/elasticsearch/elasticsearch/issues/1387

--- src/kixi/hecuba/data/entities/search.clj
+++ src/kixi/hecuba/data/entities/search.clj
@@ -6,6 +6,7 @@
             [clojurewerkz.elastisch.native :as es]
             [clojurewerkz.elastisch.native.document :as doc]
             [clojurewerkz.elastisch.query :as q]
+            [clojurewerkz.elastisch.escape :as esc]
             [kixi.hecuba.storage.search :as search]
             [kixi.hecuba.data.entities :as entities]
             [kixi.hecuba.data.profiles :as profiles]
@@ -116,11 +117,20 @@
 ;; See http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/query-dsl-query-string-query.html
 (defn search-entities
   ([query-string filter-map from size search-session]
-     (let [query  {:query {:filtered {:query {:query_string {:query query-string}}
-                                      :filter filter-map}}}]
+     (let [query {:query {:filtered
+                          {:query
+                           {:query_string
+                            {:query (esc/escape-query-string-characters query-string)}}
+                           :filter filter-map}}}]
        (search/search search-session "entities" "entity" (assoc query :size size :from from))))
   ([query-string from size search-session]
-     (search/search search-session "entities" "entity" :query {:query_string {:query query-string}} :size size :from from))
+     (search/search search-session
+                    "entities"
+                    "entity"
+                    :query {:query_string
+                            {:query (esc/escape-query-string-characters query-string)}}
+                    :size size
+                    :from from))
   ([query-string filter-map search-session]
      (search-entities query-string filter-map 0 20 search-session))
   ([query-string search-session]


make team optional

make team optional

--- src/modus/api/projects.clj
+++ src/modus/api/projects.clj
@@ -11,7 +11,7 @@
   (routes
     (GET "/" []
       :middleware [#(auth/wrap-authorize %)]
-      :query-params [team-id :- s/Uuid]
+      :query-params [team-id :- s/Uuid nil]
       :auth-account auth-account
       (let [account-id (:account-id auth-account)]
         (-> (if team-id


Fix wrong calls on novelty function.

Fix wrong calls on novelty function.

--- src/postal/core.cljs
+++ src/postal/core.cljs
@@ -156,9 +156,9 @@
 (defn novelty
   "Sends a :novelty frame to the server."
   ([client dest]
-   (query client dest nil nil))
+   (novelty client dest nil nil))
   ([client dest data]
-   (query client dest data nil))
+   (novelty client dest data nil))
   ([client dest data opts]
    (let [socket (:socket client)
          frame {:cmd :novelty


WM: Change row height, cleanup slickgrid row options

--- src/hatti/views/table.cljs
+++ src/hatti/views/table.cljs
@@ -94,10 +94,11 @@

 (def sg-options
   "Options to feed the slickgrid constructor."
-  #js {:enableColumnReorder false
-       :autoHeight true
-       :rowHeight 24
-       :enableTextSelectionOnCells true})
+  #js {:autoHeight true
+       :enableColumnReorder false
+       :enableTextSelectionOnCells true
+       :rowHeight 40
+       :syncColumnCellResize true})

 (defn bind-external-slick-grid-event-handlers
   [grid event-handlers]


add step function

add step function

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/emulator_chip8/cpu.cljc
+++ src/emulator_chip8/cpu.cljc
@@ -84,4 +84,10 @@
   "Reset the full cpu state."
   []
   (-> (make-cpu)
-      load-fontset))+      load-fontset))
+
+(defn step
+  "Step through the cpu."
+  [state]
+  ;; TODO:
+  )


Get around reagent 0.6.0 checkbox bug as reported here: https://github.com/reagent-project/reagent/issues/264

--- src/re_com/misc.cljs
+++ src/re_com/misc.cljs
@@ -230,7 +230,7 @@
                                       {:cursor cursor}
                                       style)
                     :disabled  disabled?
-                    :checked   model
+                    :checked   (boolean model)
                     :on-change (handler-fn (callback-fn))}
                    attr)]
                 (when label


Complete infix support.

Complete infix support.

--- src/refac/syntax.clj
+++ src/refac/syntax.clj
@@ -128,8 +128,11 @@
     [(infix
        [[fst & rest] left-value]
        (case fst
-         ("+" "-" "/" "*") [rest {:method (list fst)
-                                  :params (list left-value)}]
+         ("+" "-" "/" "*")
+         (if-let [[remaining right-value] (get-value rest)]
+           [remaining {:method (list fst)
+                       :params (list left-value right-value)
+                       }])
          nil))
      (chain-operator
        [[fst & rest]]


StringBufferInputStraem -> ByteArrayInputStream

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -29,11 +29,12 @@
 ;; A newest-first sequence of revision numbers in which the item changed

 (defn revlist [item]
-  (for [e (try
-            (xml-seq (parse (java.io.StringBufferInputStream. (log item))))
-            (catch Exception e (errmsg)))
-        :when (seq (:attrs e))]
-    (:revision (:attrs e))))
+  (let [logstream (java.io.ByteArrayInputStream. (.getBytes (log item)))]
+    (for [e (try
+              (xml-seq (parse logstream))
+              (catch Exception e (errmsg)))
+          :when (seq (:attrs e))]
+    (:revision (:attrs e)))))

 ;; A sequence of revision pairs for potential comparison -- e.g. for the revlist
 ;; (9 8 6 4 1), return (8 9 6 8 4 6 1 4).


Use a LinkedBlockingQueue in riemann.pool.

LinkedBlockingQueues generally exhibit better throughput and diminished lock
contention when compared to ArrayBlockingQueues.

--- src/riemann/pool.clj
+++ src/riemann/pool.clj
@@ -1,7 +1,7 @@
 (ns riemann.pool
   "A generic thread-safe resource pool."
   (:use clojure.tools.logging)
-  (:import [java.util.concurrent ArrayBlockingQueue TimeUnit]))
+  (:import [java.util.concurrent LinkedBlockingQueue TimeUnit]))

 ; THIS IS A MUTABLE STATE OF AFFAIRS. WHICH IS TO SAY, IT IS FUCKING TERRIBLE.

@@ -73,7 +73,7 @@
          regenerate-interval  (or (:regenerate-interval opts) 5)
          block-start          (or (:block-start opts) true)
          pool (FixedQueuePool.
-                (ArrayBlockingQueue. size true)
+                (LinkedBlockingQueue. size)
                 open
                 close
                 regenerate-interval)


Added a no-args overload and a completeness check.

--- src/fm/simrunner/config.clj
+++ src/fm/simrunner/config.clj
@@ -71,13 +71,19 @@
 (defn- trimmed [lines]
   (map #(-> % str .trim) lines))

-(defn config [map]
-  (reduce (fn [config param-id]
-            (if-let [value (value param-id (param-id map))]
-              (assoc config param-id value)
-              config))
-          {}
-          param-ids))
+(defn config
+  ([]
+    (config {}))
+  ([map]
+    (reduce (fn [config param-id]
+              (if-let [value (value param-id (param-id map))]
+                (assoc config param-id value)
+                config))
+            {}
+            param-ids)))
+
+(defn complete? [config]
+  (and config (every? config param-ids)))

 (defn read-config-lines [lines]
   (let [values (-> lines


bug fix of dotimes

bug fix of dotimes

--- src/kondolisp/compiler.clj
+++ src/kondolisp/compiler.clj
@@ -332,7 +332,7 @@
       (:VM_PUSH)
       (:VM_VINC ~(make-sym var))
       (:VM_PUSH)
-      (:VM_IVAL ~(make-num num))
+      ~@(compile-pass1 num)
       (:VM_LE)
       (:VM_BIF ~end-label)
       (:VM_JMP ~retry-label)


point and click with clicking.

point and click with clicking.

--- src/mermaid_ldjam/core.cljs
+++ src/mermaid_ldjam/core.cljs
@@ -13,6 +13,7 @@
      :flap {:x 60 :y (- (q/height) 20) :width 50 :height 20 :label "Flap"}}
    :current-status "Hello little mermaid."
    :last-clicked []
+   :mouse-clicked false
    })

 (defn unhide [state hidden-entity]
@@ -54,7 +55,7 @@
       state)))

 (defn update-last-clicked [state]
-  (if true
+  (if (:mouse-clicked state)
     (clicked-on-entity? (q/mouse-x) (q/mouse-y) state)
     state))

@@ -105,6 +106,12 @@
   (draw-entities state)
   (draw-status-bar state))

+(defn handle-click [state]
+  (assoc state :mouse-clicked true))
+
+(defn handle-release [state]
+  (assoc state :mouse-clicked false))
+
 (q/defsketch mermaid-ldjam
   :host "mermaid-ldjam"
   :size [600 400]
@@ -113,6 +120,9 @@
   ; update-state is called on each iteration before draw-state.
   :update update-state
   :draw draw-state
+  :mouse-pressed handle-click
+  :mouse-released handle-release
+
   ; This sketch uses functional-mode middleware.
   ; Check quil wiki for more info about middlewares and particularly
   ; fun-mode.


Notes on requeue process.

Notes on requeue process.

--- src/onyx/peer/operation.clj
+++ src/onyx/peer/operation.clj
@@ -38,6 +38,7 @@
     :as event} f]
   (if (= (last decompressed) :done)
     (if (= (:onyx/type (:onyx.core/task-map event)) :input)
+      ;; Input task, delegate out to its implementation for what "done" means
       (let [n-messages (f event)]
         {:onyx.core/tail-batch? (= n-messages (count decompressed))
          :onyx.core/requeue? true
@@ -48,7 +49,9 @@
             n-messages (f event)
             state @pipeline-state]
         (if uuid
+          ;; UUID has been preassigned to sentinel value
           (if-not (get-in state [:learned-sentinel input])
+            ;; Don't have a cached value for the sentinel leader
             (do (vote-for-sentinel-leader log task-id input uuid)
                 (let [node (sentinel-node-name task-id input)
                       learned (:leader (extensions/read-chunk log :sentinel node))
@@ -61,27 +64,34 @@
                                              (and (= n-messages (count decompressed))
                                                   (= learned uuid))))))]
                   (if (= learned uuid)
+                    ;; My sentinel is the leader
                     {:onyx.core/tail-batch? (and (learned-all-sentinels? event successor)
                                                  (drained-all-inputs? event successor))
                      :onyx.core/requeue? true
                      :onyx.core/decompressed filtered-segments}
+                    ;; My sentinel isn't the leader, throw it out
                     {:onyx.core/tail-batch? false
                      :onyx.core/requeue? false
                      :onyx.core/decompressed filtered-segments})))
+            ;; We've got the cached leader already
             (let [successor (swap! pipeline-state assoc-in [:drained-inputs input]
                                    (and (= n-messages (count decompressed))
                                         (= (get-in state [:learned-sentinel input]) uuid)))]
-                (if (= (get-in state [:learned-sentinel input]) uuid)
-                  {:onyx.core/tail-batch? (and (learned-all-sentinels? event successor)
-                                               (drained-all-inputs? event successor))
-                   :onyx.core/requeue? true
-                   :onyx.core/decompressed filtered-segments}
-                  {:onyx.core/tail-batch? false
-                   :onyx.core/requeue? false
-                   :onyx.core/decompressed filtered-segments})))
+              (if (= (get-in state [:learned-sentinel input]) uuid)
+                ;; Our sentinel is the leader
+                {:onyx.core/tail-batch? (and (learned-all-sentinels? event successor)
+                                             (drained-all-inputs? event successor))
+                 :onyx.core/requeue? true
+                 :onyx.core/decompressed filtered-segments}
+                ;; Our sentinel isn't the leader, chuck it
+                {:onyx.core/tail-batch? false
+                 :onyx.core/requeue? false
+                 :onyx.core/decompressed filtered-segments})))
+          ;; This sentinel doesn't have a UUID associated with it, funnel it through again
           {:onyx.core/tail-batch? false
            :onyx.core/requeue? true
            :onyx.core/decompressed filtered-segments})))
+    ;; Not a sentinel, nothing to requeue
     {:onyx.core/tail-batch? false
      :onyx.core/requeue? false}))


Feedback exceptions from producer thread to read-batch

--- src/onyx/plugin/datomic.clj
+++ src/onyx/plugin/datomic.clj
@@ -92,7 +92,8 @@
                                            (seq (drop datoms-per-segment datoms)))))))
                             (>!! ch (t/input (random-uuid) :done))
                             (catch Exception e
-                              (fatal e))))]
+                              ;; feedback exception to read-batch
+                              (>!! ch e))))]

         {:datomic/read-ch ch
          :datomic/commit-ch (:commit-ch pipeline)
@@ -114,6 +115,22 @@
   (empty? (remove #(= :done (:message %))
                   messages)))

+(defn completed? [batch pending-messages read-ch]
+  (and (all-done? (vals @pending-messages))
+       (all-done? batch)
+       (zero? (count (.buf read-ch)))
+       (or (not (empty? @pending-messages))
+           (not (empty? batch)))))
+
+(defn feedback-producer-exception! [e]
+  (when (instance? java.lang.Throwable e)
+    (throw e)))
+
+(defn update-chunk-indices! [m top-chunk-index pending-chunk-indices]
+  (when-let [chunk-index (:chunk-index m)]
+    (swap! top-chunk-index max chunk-index)
+    (swap! pending-chunk-indices conj chunk-index)))
+
 (defrecord DatomicInput [log task-id max-pending batch-size batch-timeout
                          pending-messages drained?
                          top-chunk-index top-acked-chunk-index pending-chunk-indices
@@ -131,14 +148,10 @@
           batch (->> (range max-segments)
                      (keep (fn [_] (first (alts!! [read-ch timeout-ch] :priority true)))))]
       (doseq [m batch]
-        (when-let [chunk-index (:chunk-index m)]
-          (swap! top-chunk-index max chunk-index)
-          (swap! pending-chunk-indices conj chunk-index))
+        (feedback-producer-exception! m)
+        (update-chunk-indices! m top-chunk-index pending-chunk-indices)
         (swap! pending-messages assoc (:id m) m))
-    (when (and (all-done? (vals @pending-messages))
-               (all-done? batch)
-               (or (not (empty? @pending-messages))
-                   (not (empty? batch))))
+    (when (completed? batch pending-messages read-ch)
       (>!! commit-ch {:status :complete})
       (reset! drained? true))
     {:onyx.core/batch batch}))
@@ -289,7 +302,8 @@
                           (if-not (= exit :shutdown)
                             (>!! read-ch (t/input (random-uuid) :done))))
                         (catch Exception e
-                          (fatal e))))]
+                          ;; feedback exception to read-batch
+                          (>!! read-ch e))))]

     {:datomic/read-ch read-ch
      :datomic/shutdown-ch shutdown-ch
@@ -304,6 +318,13 @@
             (= max-tx max-pending))
       max-pending
       (recur (inc max-pending)))))
+
+(defn update-top-txes! [m top-tx pending-txes]
+  (let [message (:message m)]
+    (when-not (= message :done)
+      (swap! top-tx max (:t message))
+      (swap! pending-txes conj (:t message)))))
+

 (defrecord DatomicLogInput
   [log task-id max-pending batch-size batch-timeout pending-messages drained?
@@ -324,16 +345,10 @@
                   (->> (range max-segments)
                        (keep (fn [_] (first (alts!! [read-ch timeout-ch] :priority true))))))]
       (doseq [m batch]
-        (let [message (:message m)]
-          (when-not (= message :done)
-            (swap! top-tx max (:t message))
-            (swap! pending-txes conj (:t message))))
+        (feedback-producer-exception! m)
+        (update-top-txes! m top-tx pending-txes)
         (swap! pending-messages assoc (:id m) m))
-      (when (and (all-done? (vals @pending-messages))
-                 (all-done? batch)
-                 (zero? (count (.buf read-ch)))
-                 (or (not (empty? @pending-messages))
-                     (not (empty? batch))))
+      (when (completed? batch pending-messages read-ch)
         (when-not (:checkpoint/key (:onyx.core/task-map event))
           (>!! commit-ch {:status :complete}))
         (reset! drained? true))


Adding inst metadata to start testing synth-controller gui.

--- src/overtone/inst/synth.clj
+++ src/overtone/inst/synth.clj
@@ -7,7 +7,9 @@
   (* (env-gen (perc 0.001 0.01) :action FREE)
      (sin-osc freq)))

-(definst ping [note 60 a 0.2 b 0.2]
+(definst ping [note {:default 60 :min 0 :max 120 :step 1}
+               a    {:default 0.2 :min 0.001 :max 1 :step 0.001}
+               b    {:default 0.2 :min 0.001 :max 1 :step 0.001}]
   (let [snd (sin-osc (midicps note))
         env (env-gen (perc a b) :action FREE)]
     (* env snd)))
@@ -72,8 +74,9 @@
         signal     (rlpf src (+ (* 0.3 freq) (* f-env 2 freq)) 0.5)
         k          (/ (* 4 amt) (- 1 amt))
         dist       (clip2 (/ (* (+ 1 k) signal) (+ 1 (* k (abs signal))))
-                          0.03)]
-    (* amp dist (line:kr 1 0 t))))
+                          0.03)
+        snd        (* amp dist (line:kr 1 0 t))]
+    src))

 (definst buzz [pitch 40 cutoff 300 dur 200]
   (let [lpf-lev (* (+ 1 (lf-noise1:kr 10)) 400)


cleanup admin inner routes

cleanup admin inner routes

--- src/pc/http/admin/inner.clj
+++ src/pc/http/admin/inner.clj
@@ -19,31 +19,23 @@
 (defpage base "/admin" [req]
   (hiccup/html (content/layout {}
                                [:div {:style "padding: 40px"}
-                                [:p "Congratulations on logging in!"]
+                                [:div [:a {:href "/early-access"} "Early Access"]]
+                                [:div [:a {:href "/graphs"} "User Graphs"]]
+                                [:div [:a {:href "/clients"} "Clients"]]
+                                [:div [:a {:href "/occupied"} "Occupied"]]
+                                [:div [:a {:href "/interesting"} "Interesting"]]])))
+
+(defpage early-access "/early-access" [req]
+  (hiccup/html (content/layout {}
+                               [:div {:style "padding: 40px"}
                                 [:h2 "Early access"]
-                                (admin-content/early-access-users)
-                                [:h2 "User Growth"]
-                                (admin-content/users-graph)])))
+                                (admin-content/early-access-users)])))

-(defpage base "/graphs" [req]
+(defpage graphs "/graphs" [req]
   (hiccup/html (content/layout {}
                                [:div {:style "padding: 40px"}
                                 [:h2 "User Growth"]
                                 (admin-content/users-graph)])))
-
-(defpage grant-early-access [:post "/grant-early-access"] [req]
-  (let [uuid (some-> req :params (get "cust-uuid") (UUID/fromString))]
-    (when (empty? (str uuid))
-      (throw+ {:status 400 :public-message "No customer specified"}))
-    (let [cust (cust-model/find-by-uuid (pcd/default-db) uuid)]
-      (when (empty? cust)
-        (throw+ {:status 400 :public-message "No customer found"}))
-      (flag-model/add-flag cust :flags/private-docs)
-      {:status 200 :body (hiccup/html [:div
-                                       [:p "All right, granted access to " (:cust/email cust) "."]
-                                       [:a {:href "/admin"}
-                                        "Go back to the admin page"]
-                                       "."])})))

 (defpage clients "/clients" [req]
   {:status 200 :body (hiccup/html (content/layout {} (admin-content/clients @sente/client-stats @sente/document-subs)))})
@@ -87,6 +79,19 @@
   (Thread/sleep 500)
   {:status 302 :headers {"Location" "/clients"} :body ""})

+(defpage grant-early-access [:post "/grant-early-access"] [req]
+  (let [uuid (some-> req :params (get "cust-uuid") (UUID/fromString))]
+    (when (empty? (str uuid))
+      (throw+ {:status 400 :public-message "No customer specified"}))
+    (let [cust (cust-model/find-by-uuid (pcd/default-db) uuid)]
+      (when (empty? cust)
+        (throw+ {:status 400 :public-message "No customer found"}))
+      (flag-model/add-flag cust :flags/private-docs)
+      {:status 200 :body (hiccup/html [:div
+                                       [:p "All right, granted access to " (:cust/email cust) "."]
+                                       [:a {:href "/admin"}
+                                        "Go back to the admin page"]
+                                       "."])})))

 (defn wrap-require-login [handler]
   (fn [req]


Make web logging messages more useful.

Make web logging messages more useful.

--- modules/web/src/main/clojure/immutant/web.clj
+++ modules/web/src/main/clojure/immutant/web.clj
@@ -30,7 +30,8 @@
 (defn start-servlet
   "Can be used to mount a servlet in lieu of a typical Ring handler"
   [sub-context-path servlet]
-  (log/info (str "Starting servlet at URL: " (util/app-uri) sub-context-path))
+  (log/info (format "Starting servlet for %s at: %s%s" (util/app-name)
+              (util/app-uri) sub-context-path))
   (start* sub-context-path
           (servlet/proxy-servlet servlet)
           {}))
@@ -38,7 +39,8 @@
 (defn start-handler
   "Typically not called directly; use start instead"
   [sub-context-path handler & {:keys [init destroy] :as opts}]
-  (log/info (str "Starting handler at URL: " (util/app-uri) sub-context-path))
+  (log/info (format "Starting handler for %s at: %s%s" (util/app-name)
+              (util/app-uri) sub-context-path))
   (start* sub-context-path
           (servlet/create-servlet (add-middleware handler opts))
           opts))


create canvas

create canvas

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -1,5 +1,5 @@
 (ns ^:figwheel-always splash.core
-    (:require))
+    (:require [infinitelives.pixi.canvas :as canv]))

 (enable-console-print!)

@@ -9,10 +9,17 @@

 (defonce app-state (atom {:text "Hello world!"}))

+(defonce canvas
+  (canv/init
+   {:expand true
+    :engine :auto
+    :layers [:stars]
+    :background 0x505050}))
+
+

 (defn on-js-reload []
   ;; optionally touch your app-state to force rerendering depending on
   ;; your application
   ;; (swap! app-state update-in [:__figwheel_counter] inc)
 )
-


[test-cljs]: require mount to avoid clj <=> cljs require order problems

--- build.boot
+++ build.boot
@@ -76,6 +76,8 @@
   (set-env! :source-paths #(conj % "test/core" "test/cljs"))
   (set-env! :resource-paths #{"test/resources"})

+  (require '[mount.core])
+
   (comp
     (strip-deps-attr :attr :classifier :value "aot")
     (tcs/test-cljs ;; :optimizations :advanced


compile with :static-fns and :optimize-constants true, :dump-core false

this cuts startup time by more than half while also shaving bundle size
a little bit.

Now starts up a little faster than Planck!

```shell
Lumo:

time (echo :foo | ./main -q)
cljs.user=> :foo
:foo
( echo :foo | ./main -q; )  0.85s user 0.08s system 105% cpu 0.873 total

Planck:

time (echo :foo | planck -q)
:foo
( echo :foo | planck -q; )  1.02s user 0.11s system 175% cpu 0.645 total
```

--- build.boot
+++ build.boot
@@ -81,6 +81,9 @@
                              :main 'lumo.core
                              :cache-analysis true
                              :source-map nil
+                             :dump-core false
+                             :static-fns true
+                             :optimize-constants true
                              :verbose true
                              :compiler-stats true
                              :parallel-build true})
@@ -114,6 +117,9 @@
                              :main 'lumo.core
                              :cache-analysis true
                              :source-map nil
+                             :dump-core false
+                             :static-fns true
+                             :optimize-constants true
                              :verbose true
                              :compiler-stats true
                              :parallel-build true})


Removing unused function, was relevant only for Neo4j

--- src/tropology/db.clj
+++ src/tropology/db.clj
@@ -98,24 +98,6 @@
   (let [now (.getMillis (j/date-time))]
     (merge {:time-stamp now :next-update now} data)))

-
-;
-; Query helpers
-;
-
-(defn code-to-match
-  "Returns match pattern string for an id, including the node label, with
-  the prefix name for the pattern.
-
-  I'm not a fan of not being able to pass the label as a parameter, but them's
-  the breaks. neo4j's parsing seems strong enough that code injection is
-  unlikely."
-  ([prefix]
-   (code-to-match prefix "id" b/base-label))
-  ([prefix id-param]
-   (code-to-match prefix id-param b/base-label))
-  ([prefix id-param label]
-   (str "(" prefix ":" label " {code:{" id-param "}})")))

 ;


show bots after add

show bots after add

--- src/cljs/wombats_web_client/panels/account.cljs
+++ src/cljs/wombats_web_client/panels/account.cljs
@@ -10,10 +10,15 @@
   (fn []
     (re-frame/dispatch [:set-modal add-wombat-modal])))

+(defn temp-prettify-wombat [wombat]
+  [:div {:key (:name wombat)} (str wombat)])
+
 (defn welcome []
-  [:div (str "This is the Account Management Page.")
-   [:div [:a {:href github-signout-url} "Log out"]]
-   [add-wombat-button/root (open-add-wombat-modal)]])
+  (let [my-wombats (re-frame/subscribe [:my-wombats])]
+    [:div (str "This is the Account Management Page.")
+     [:div [:a {:href github-signout-url} "Log out"]]
+     [:div (map temp-prettify-wombat @my-wombats)]
+     [add-wombat-button/root (open-add-wombat-modal)]]))

 (defn login-prompt []
   [:div (str "You must login to see your account.")])


a websocket

a websocket

--- src/lein_ui/core.clj
+++ src/lein_ui/core.clj
@@ -251,6 +251,9 @@
 ;;; Server

 (defroutes all-routes
+  (GET "/websocket" {:as request}
+       (server/with-channel request channel
+         (server/send! channel "yoo")))
   (GET "/api/projects" []
        {:body (pprint-str (get-projects))
         :status 200})


Project cleanup implemented.

Project cleanup implemented.

--- src/wat/database.clj
+++ src/wat/database.clj
@@ -54,17 +54,15 @@
       (println "Database" db-name "already exist, its fine."))
     (println "Connection established!")))

-(defn create-line [& {:keys [pname id text male-text female-text translator], :or {male-text "" female-text "" translator ""}
-                      }]
-  (println (str "wtf" pname id text male-text female-text translator))
+(defn create-line [& {:keys [pname id text male-text female-text translator],
+                      :or {male-text "" female-text "" translator ""}}]
   {:db/id (d/tempid :db.part/user)
    :line/pname pname
    :line/num (java.lang.Long. id)
    :line/original text
    :line/male male-text
    :line/female female-text
-   :line/translator translator
-   })
+   :line/translator translator})

 (defn get-n-words [n coll]
   (let [sum (atom 0)
@@ -84,6 +82,7 @@
                        :in $ ?pname
                        :where [?line :line/pname ?pname]]
                      db project-name)]
+    (println (str "dumped " content))
     (with-open [out-file (io/writer (str "/tmp/" project-name ".csv"))]
       (csv/write-csv out-file
                      (sort #(compare (first %1) (first %2))
@@ -99,8 +98,25 @@
   (let [data (with-open [in-file (io/reader source)]
                (doall
                 (csv/read-csv in-file)))]
+    (println "loaded")
     (doseq [[n o m f t] data]
-        @(d/transact conn [(create-line :pname pname :id n :text o)]))))
+      @(d/transact conn [(create-line :pname pname :id n :text o)]))))
+
+(defn cleanup-project [pname]
+  (let [data (d/q '[:find [?line ...]
+                    :in $ ?pname
+                    :where [?line :line/pname ?pname]]
+                  (d/db conn) pname)]
+    (println "cleaned " data)
+    (doseq [e data]
+      @(d/transact
+        conn
+        [{:db/id #db/id[db.part/user], :db/excise e}]))))
+
+(defn get-project-chunk [pname size]
+  (println (str (d/q '[:find (wat.database/get-n-words 8 ?e) .;; find all untranslated entries and collect till have n words
+                       :where [?e :line/pname "tududu"]]
+                     (d/db conn)))))

 (defn get-dummy-info []
   (println "====================")
@@ -111,10 +127,10 @@
   (println ">")
   ;(dump-project "default")
   ;(load-project "tududu" "/tmp/default")
-  (dump-project "tududu")
-  (println (str (d/q '[:find (wat.database/get-n-words 8 ?e) .;; find all untranslated entries and collect till have n words
-                       :where [?e :line/pname "tududu"]]
-                     (d/db conn))))
+  (future
+    (cleanup-project "tududu")
+    (Thread/sleep 3000)
+    (dump-project "tududu"))
   (println "<")
   (str "Hello there, big brother greets you!"))


CMR-5389: Update site templates to Clojure 1.10.

--- site-templates/project.clj
+++ site-templates/project.clj
@@ -5,7 +5,7 @@
     :name "Apache License, Version 2.0"
     :url "http://www.apache.org/licenses/LICENSE-2.0"}
   :dependencies [
-    [org.clojure/clojure "1.8.0"]]
+    [org.clojure/clojure "1.10.0"]]
   :profiles {
     :test {
       :plugins [


Updated reports.exporter to use /var/tmp/akvo/flow/reports filesystem path to store generated reports.

--- reports/src/reports/exporter.clj
+++ reports/src/reports/exporter.clj
@@ -2,9 +2,6 @@
   (:require [clojure.java.io :as io])
   (:import java.util.UUID
            org.waterforpeople.mapping.dataexport.SurveyDataImportExportFactory))
-
-(defonce base-path
-  (.getAbsolutePath (io/file (System/getProperty "java.io.tmpdir"))))

 (defn- get-ext [t]
   (if (= t "SURVEY_FORM")
@@ -12,9 +9,9 @@
     "xlsx"))

 (defn- getfile [et id]
-  (let [path (format "%s/akvo-flow-reports/%s" base-path (UUID/randomUUID))]
+  (let [path (str "/var/tmp/akvo/flow/reports/" (UUID/randomUUID))]
     (do
-      (.mkdir (io/file path))
+      (.mkdirs (io/file path))
       (io/file (format "%s/%s-%s.%s" path et id (get-ext et))))))


(PDB-3723) fact-contents-query: handle same path, differing types

[rlb@puppet.com: adjust message]

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -508,7 +508,11 @@
                                            "        name,"
                                            "        environment_id"
                                            "   from factsets"
-                                           "     cross join fact_paths"
+                                           "     cross join (select distinct on (path)"
+                                           "                        path,"
+                                           "                        path_array,"
+                                           "                        name"
+                                           "                   from fact_paths) distinct_paths"
                                            "   where jsonb_extract_path(stable||volatile,"
                                            "                            variadic path_array)"
                                            "           is not null)"))


Fix #11: preserve filesystem filenames in URLs

--- src/markiki/core.clj
+++ src/markiki/core.clj
@@ -58,8 +58,10 @@
   "Takes a string, returns a trimmed down string only w/ alphabet and hyphens"
   [title]
   (-> title
-      (string/replace #"[ ]{1,}" "-")
+      (string/replace #"[ -]{1,}" "-")
       (string/replace #"[^a-zA-Z-]" "")
+      (string/split #"-")
+      ((fn [s] (string/join "-" s))) ; because join takes the coll as last arg
       string/lower-case))

@@ -69,7 +71,7 @@
   (let [json (atom [])]
     (doseq [f (fs/list-dir path)]
       ;; This is ugly. Here to avoid mapping the static folder
-      (when-not (some #{(fs/name f)} ["static"])
+      (when-not (some #{(fs/base-name f)} ["static"])
         (swap! json
                conj
                (if (fs/directory? f)
@@ -77,11 +79,14 @@
                        [new-cat new-path] (map #(str %1 "/" cat-name)
                                                [category path])]
                    (parse-tree new-path new-cat))
-                 (let [[title content] (split-title (slurp f))]
-                   {:title title
-                    :last-modified (fs/mod-time f)
-                    :path (str category "/" (pathize title))
-                    :text content})))))
+                 (let [[title content] (split-title (slurp f))
+                       name (fs/name f)
+                       ext (fs/extension f)]
+                   (when (= ext ".md")
+                     {:title title
+                      :last-modified (fs/mod-time f)
+                      :path (str category "/" (pathize name))
+                      :text content }))))))
     @json))


add test for subsequent transaction item balances

--- test/clj_money/models/transactions_test.clj
+++ test/clj_money/models/transactions_test.clj
@@ -148,7 +148,27 @@
                          (filter #(= (:id (:checking accounts)) (:account-id %)))
                          first)]
     (is (= (bigdec 1000) (:balance salary-item)) "The salary transaction item has the correct balance")
-    (is (= (bigdec 1000) (:balance checking-item)) "The checking transaction item has the correct balance")))
+    (is (= (bigdec 1000) (:balance checking-item)) "The checking transaction item has the correct balance")
+    (let [t2 (transactions/create
+               storage-spec
+               {:transaction-date (t/local-date 2016 3 3)
+                :entity-id (:id entity)
+                :items [{:action :debit
+                         :account-id (:id (:groceries accounts))
+                         :amount (bigdec 100)}
+                        {:action :credit
+                         :account-id (:id (:checking accounts))
+                         :amount (bigdec 100)}]})
+          groceries-item (->> t2
+                              :items
+                              (filter #(= (:id (:groceries accounts)) (:account-id %)))
+                              first)
+          checking-item (->> t2
+                              :items
+                              (filter #(= (:id (:checking accounts)) (:account-id %)))
+                              first)]
+      (is (= (bigdec 100) (:balance groceries-item)) "The groceries transaciton has the correct balance")
+      (is (= (bigdec 900) (:balance checking-item)) "The second checking transaction item has the correct balance"))))

 ; TODO Need to create the accounts for each test instead of once
 (deftest item-indexes-are-set-when-saved


Update cider-nrepl

Update cider-nrepl

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -10,7 +10,7 @@
                        [org.clojure/tools.nrepl "0.2.7"]
                        [slamhound "1.5.3"]]

-        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
+        :plugins [[cider/cider-nrepl "0.9.0"]
                   [codox "0.6.6"]
                   [jonase/eastwood "0.2.1"]
                   [lein-clojars "0.9.1"]


what the shortest path should be

what the shortest path should be


Adapt align worker to use new faster generation of kd trees.

--- src/uxbox/worker/align.cljs
+++ src/uxbox/worker/align.cljs
@@ -11,23 +11,19 @@
             [uxbox.worker.core :as wrk]
             [uxbox.util.geom.point :as gpt]))

-(defonce state (volatile! nil))
+(defonce tree (kd/create))

 (defmethod wrk/handler :grid/init
   [{:keys [sender width height x-axis y-axis] :as opts}]
   (time
-   (let [points (into-array
-                 (for [x (range 0 width (or x-axis 10))
-                       y (range 0 height (or y-axis 10))]
-                   #js [x y]))
-         tree (kd/create2d points)]
-     (vreset! state tree)
-     (wrk/reply! sender nil))))
+   (let [value (kd/generate width height (or x-axis 10) (or y-axis 10))]
+     (set! tree value)))
+  (wrk/reply! sender nil))

 (defmethod wrk/handler :grid/align
   [{:keys [sender point] :as message}]
   (let [point #js [(:x point) (:y point)]
-        results (js->clj (.nearest @state point 1))
+        results (js->clj (kd/nearest tree point 1))
         [[x y] d] (first results)
         result (gpt/point x y)]
     (wrk/reply! sender {:point (gpt/point x y)})))


working on serialization

working on serialization

--- src/ophion/query.clj
+++ src/ophion/query.clj
@@ -318,6 +318,10 @@
   [^GraphTraversal g {:keys [head tail]}]
   (.cap g head (into-array tail)))

+;; (defn serialize
+;;   [val]
+;;   (if))
+
 (defn set-property!
   [element key val]
   (.property element (name key) val))


return simpler browser info

return simpler browser info

--- src/webapp/client/main.cljs
+++ src/webapp/client/main.cljs
@@ -47,17 +47,9 @@

 (defn detect-browser []
-  (add-broswer-details :app-code-name (.-appCodeName js/navigator))
-  (add-broswer-details :app-name (.-appName js/navigator))
-  (add-broswer-details :app-version (.-appVersion js/navigator))
   (add-broswer-details :cookie-enabled (.-cookieEnabled js/navigator))
   (add-broswer-details :language (.-language js/navigator))
-  (add-broswer-details :online (.-onLine js/navigator))
   (add-broswer-details :platform (.-platform js/navigator))
-  (add-broswer-details :app-version (.-appVersion js/navigator))
-  (add-broswer-details :user-agent (.-userAgent js/navigator))
-  (add-broswer-details :app-version (.-appVersion js/navigator))
-  (add-broswer-details :system-language (.-systemLanguage js/navigator))
   (add-broswer-details :who-am-i (.-sayswho js/navigator))
   )


CMR-298: Added tests for granule search in iso-smap format.

--- test/cmr/system_int_test/search/granule_search_format_test.clj
+++ test/cmr/system_int_test/search/granule_search_format_test.clj
@@ -20,7 +20,7 @@
             [cmr.umm.core :as umm]
             [cmr.umm.spatial :as umm-s]))

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

 (comment

@@ -30,24 +30,56 @@
   )

 (deftest search-granules-in-xml-metadata
-  ;; We can add additional formats here later such as iso
-  (let [coll1 (d/ingest "PROV1" (dc/collection))
-        coll2 (d/ingest "PROV1" (dc/collection))
-        gran1 (d/ingest "PROV1" (dg/granule coll1 {:granule-ur "g1"}))
-        gran2 (d/ingest "PROV1" (dg/granule coll2 {:granule-ur "g2"}))
-        all-granules [gran1 gran2]]
+  (let [c1-echo (d/ingest "PROV1" (dc/collection) :echo10)
+        c2-smap (d/ingest "PROV2" (dc/collection) :iso-smap)
+        g1-echo (d/ingest "PROV1" (dg/granule c1-echo {:granule-ur "g1"
+                                                       :producer-gran-id "p1"}) :echo10)
+        g2-echo (d/ingest "PROV1" (dg/granule c1-echo {:granule-ur "g2"
+                                                       :producer-gran-id "p2"}) :echo10)
+        g1-smap (d/ingest "PROV2" (dg/granule c2-smap {:granule-ur "g3"
+                                                       :producer-gran-id "p3"}) :iso-smap)
+        g2-smap (d/ingest "PROV2" (dg/granule c2-smap {:granule-ur "g4"
+                                                       :producer-gran-id "p2"}) :iso-smap)
+        all-granules [g1-echo g2-echo g1-smap g2-smap]]
     (index/refresh-elastic-index)
-    (testing "echo10"
+
+    (testing "Finding refs ingested in different formats"
+      (are [search expected]
+           (d/refs-match? expected (search/find-refs :granule search))
+           {} all-granules
+           {:granule-ur "g1"} [g1-echo]
+           {:granule-ur "g3"} [g1-smap]
+           {:producer-granule-id "p1"} [g1-echo]
+           {:producer-granule-id "p3"} [g1-smap]
+           {:producer-granule-id "p2"} [g2-echo g2-smap]
+           {:granule-ur ["g1" "g4"]} [g1-echo g2-smap]
+           {: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 [gran1]
+        :echo10 [g1-echo]
         (search/find-metadata :granule :echo10 {:granule-ur "g1"}))
       (testing "as extension"
         (d/assert-metadata-results-match
-          :echo10 [gran1]
+          :echo10 [g1-echo]
           (search/find-metadata :granule :echo10
+                                {:granule-ur "g1"}
+                                {:format-as-ext? true}))))
+
+    (testing "Retrieving results in SMAP ISO"
+      (d/assert-metadata-results-match
+        :iso-smap all-granules
+        (search/find-metadata :granule :iso-smap {}))
+      (d/assert-metadata-results-match
+        :iso-smap [g1-echo]
+        (search/find-metadata :granule :iso-smap {:granule-ur "g1"}))
+      (testing "as extension"
+        (d/assert-metadata-results-match
+          :iso-smap [g1-echo]
+          (search/find-metadata :granule :iso-smap
                                 {:granule-ur "g1"}
                                 {:format-as-ext? true}))))

@@ -68,18 +100,18 @@
     (testing "reference XML"
       (let [refs (search/find-refs :granule {:granule-ur "g1"})
             location (:location (first (:refs refs)))]
-        (is (d/refs-match? [gran1] refs))
+        (is (d/refs-match? [g1-echo] refs))

         (testing "Location allows granule native format retrieval"
           (let [response (client/get location
                                      {:accept :application/echo10+xml
                                       :connection-manager (url/conn-mgr)})]
-            (is (= (umm/umm->xml gran1 :echo10) (:body response))))))
-
-      (testing "as extension"
-        (is (d/refs-match? [gran1] (search/find-refs :granule
-                                                     {:granule-ur "g1"}
-                                                     {:format-as-ext? true})))))))
+            (is (= (umm/umm->xml g1-echo :echo10) (:body response))))))
+
+      (testing "as extension"
+        (is (d/refs-match? [g1-echo] (search/find-refs :granule
+                                                       {:granule-ur "g1"}
+                                                       {:format-as-ext? true})))))))

 (deftest search-granule-csv
@@ -89,28 +121,28 @@
         coll1 (d/ingest "PROV1" (dc/collection {}))
         coll2 (d/ingest "PROV1" (dc/collection {}))
         gran1 (d/ingest "PROV1" (dg/granule coll1 {:granule-ur "Granule1"
-                                                       :beginning-date-time "2010-01-01T12:00:00Z"
-                                                       :ending-date-time "2010-01-11T12:00:00Z"
-                                                       :producer-gran-id "Granule #1"
-                                                       :day-night "DAY"
-                                                       :size 100
-                                                       :cloud-cover 50
-                                                       :related-urls [ru1 ru2 ru3]}))
+                                                   :beginning-date-time "2010-01-01T12:00:00Z"
+                                                   :ending-date-time "2010-01-11T12:00:00Z"
+                                                   :producer-gran-id "Granule #1"
+                                                   :day-night "DAY"
+                                                   :size 100
+                                                   :cloud-cover 50
+                                                   :related-urls [ru1 ru2 ru3]}))
         gran2 (d/ingest "PROV1" (dg/granule coll2 {:granule-ur "Granule2"
-                                                       :beginning-date-time "2011-01-01T12:00:00Z"
-                                                       :ending-date-time "2011-01-11T12:00:00Z"
-                                                       :producer-gran-id "Granule #2"
-                                                       :day-night "NIGHT"
-                                                       :size 80
-                                                       :cloud-cover 30
-                                                       :related-urls [ru1]}))
+                                                   :beginning-date-time "2011-01-01T12:00:00Z"
+                                                   :ending-date-time "2011-01-11T12:00:00Z"
+                                                   :producer-gran-id "Granule #2"
+                                                   :day-night "NIGHT"
+                                                   :size 80
+                                                   :cloud-cover 30
+                                                   :related-urls [ru1]}))
         gran3 (d/ingest "PROV1" (dg/granule coll2 {:granule-ur "Granule3"
-                                                       :beginning-date-time "2012-01-01T12:00:00Z"
-                                                       :ending-date-time "2012-01-11T12:00:00Z"
-                                                       :producer-gran-id "Granule #3"
-                                                       :day-night "NIGHT"
-                                                       :size 80
-                                                       :cloud-cover 30}))]
+                                                   :beginning-date-time "2012-01-01T12:00:00Z"
+                                                   :ending-date-time "2012-01-11T12:00:00Z"
+                                                   :producer-gran-id "Granule #3"
+                                                   :day-night "NIGHT"
+                                                   :size 80
+                                                   :cloud-cover 30}))]

     (index/refresh-elastic-index)


Simplify error/not-found pages

Simplify error/not-found pages

--- src/poehub/pages.clj
+++ src/poehub/pages.clj
@@ -6,6 +6,38 @@
             [poehub.data :as data]
             [poehub.dat :as dat]
             [poehub.search :as search]))
+
+(defn simple-layout-page [request title page]
+  (html5
+   [:head
+    [:meta {:charset "utf-8"}]
+    [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
+    [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
+    [:title (if (not-empty title)
+              (str "poehub - " title)
+              "poehub")]
+    [:link {:rel "stylesheet" :href "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap.min.css"
+            :integrity "sha512-dTfge/zgoMYpP7QbHy4gWMEGsbsdZeCXz7irItjcC3sPUFtf0kuFbDz/ixG7ArTxmDjLXDmezHubeNikyKGVyQ=="
+            :crossorigin="anonymous"}]
+    [:link {:rel "stylesheet" :href (link/file-path request "/css/poehub.css")}]]
+   [:body
+    [:div.container
+     [:div.main
+      page]]
+    [:script {:src "https://ajax.googleapis.com/ajax/libs/jquery/1.11.3/jquery.min.js"} ""]
+    [:script {:src "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/js/bootstrap.min.js"
+              :integrity "sha512-K1qjQ+NcF2TYO/eI3M6v8EiNYZfA95pQumfvcVrTHtwQVDG+aHRqLi/ETn2uB+1JqwYqVG3LIvdm9lj6imS/pQ=="
+              :crossorigin="anonymous"} ""]
+    [:script {:src "//twitter.github.io/typeahead.js/releases/latest/typeahead.bundle.js"}]
+    [:script {:src (link/file-path request "/js/poehub.js")} ""]
+    [:script "
+  (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+
+  ga('create', 'UA-70467764-1', 'auto');
+  ga('send', 'pageview');"]]))

 (defn layout-page [request title page]
   (if (not-empty title)
@@ -388,18 +420,24 @@
            (item-affix-tags)))))

 (defn server-error [ctx]
-  (layout-page
+  (simple-layout-page
    ctx
    nil
    [:div
-    [:h1 "Server Error!"]]))
+    [:h1 "Server Error!"]
+    [:br]
+    [:h4 "Go to "
+     [:a {:href "/"} "Start page"] "."]]))

 (defn not-found [ctx]
-  (layout-page
+  (simple-layout-page
    ctx
    nil
    [:div
-    [:h1 "Page not found!"]]))
+    [:h1 "Page not found!"]
+    [:br]
+    [:h4 "Go to "
+     [:a {:href "/"} "Start page"] "."]]))

 (defn get-pages []
   (merge {"/index.html" index


add header and footer

add header and footer

--- src_cljs/rrms/corecljs.cljs
+++ src_cljs/rrms/corecljs.cljs
@@ -30,8 +30,8 @@
 (defn http-post [url callback data]
   (xhr/send url callback "POST" data  (structs/Map. (clj->js {:Content-Type "application/json"}))))

-(defn http-delete [url callback data]
-  (xhr/send url callback "DELETE" data  (structs/Map. (clj->js {:Content-Type "application/json"}))))
+(defn http-delete [url callback]
+  (xhr/send url callback "DELETE" (structs/Map. (clj->js {:Content-Type "application/json"}))))

 (declare render-documents)

@@ -39,7 +39,7 @@
   (let [stext (.-value (.getElementById js/document "sText"))
         onres (fn [json]
                 (r/render [render-documents (getdata json)]
-                          (.-body js/document)))]
+                          (.getElementById js/document "app1")))]
     (http-get (str "http://localhost:8193/documents/title/" stext) onres)))
 (defn row [label input]
   [:div.row
@@ -118,67 +118,72 @@
    [:input {:type "button" :value "Save"
             :class "btn btn-primary" :on-click docupdate}]])

-
 (defn delete[id]
   (let [onres (fn [json]
                 ((reset! documents (getdata json))
                  (r/render [render-documents @documents]
-                           (.-body js/document))))]
-    (http-delete (str "http://localhost:8193/documents/delete/" id) nil onres)))
-
+                           (.getElementById js/document "app1"))))]
+    (http-delete (str "http://localhost:8193/documents/delete/" id)  onres)))

 (defn render-documents [documents]
-  [:div.container
-   [:div.padding]
-   [:div.page-header [:h1 "Record Room Management System"]]
-   [:div#add]
+  [:div {:id "app"}
+   ;; [:div.padding]
+   ;; [:div.page-header [:h1 "Record Room Management System"]]
+   ;; [:div#add]
    [:div#update]
-   [:div#app
-    [:br]
-    [:h1.text-center "List of Documents"]
-    [:div
+   [:div {:class "box"}
+    [:div {:class "box-header"}
+     [:h8 ""]]
+    ;; [:br]
+    ;; [:h1.text-center "List of Documents"]
+    [:div {:class "col-xs-12"}
      [:div.form-group
       [:div.col-sm-2 [:input.form-control {:id "sText" :type "text"
                                            :placeholder "search by title"}]]
       [:input {:type "button" :value "Search"
                :class "btn btn-primary" :on-click search}]
       (url-format "#/documents/add" "Add")]]
-    [:table {:class "table table-striped table-bordered"}
-     [:thead
-      [:tr
-       [:th "DocumentName"]
-       [:th "Title"]
-       [:th "Employeename"]
-       [:th "Date"]
-       [:th "Location"]
-       [:th " "]
-       [:th " "]
-       ]]
-     [:tbody
-      (for [dn documents]
-        ^{:key (.-id dn)} [:tr
-                           [:td (.-documentname dn)]
-                           [:td (.-title dn)]
-                           [:td (.-employeename dn)]
-                           [:td  (f/unparse (f/formatter "dd-MMM-yyyy")(f/parse (.-date dn)))]
-                           ;; [:td (.-date dn)]
-                           [:td (.-location dn)]
-                           [:td [:input {:type "button" :on-click #(click-update(.-id dn))
-                                         :value "Update"}]]
-                           [:td [:input {:type "button" :on-click #(delete(.-id dn))
-                                         :value "Delete"}]]
-                           ])]]]
-   [:div.padding]
-   [:div.page-footer [:h4 "Copyright All Rights Reserved © 2016 TechnoIdentity Solutions Pvt.Ltd"]]
+    [:div {:class "box-body"}
+
+     [:table {:id "example1" :class "table table-bordered table-striped dataTable" :role "grid" :aria-describedby "example1_info"}
+
+      [:thead
+       [:tr {:role "row"}
+        [:th "DocumentName"]
+        [:th "Title"]
+        [:th "Employeename"]
+        [:th "Date"]
+        [:th "Location"]
+        [:th " "]
+        [:th " "]
+        ]]
+      [:tbody
+       (for [dn documents]
+         ^{:key (.-id dn)} [:tr
+                            [:td (.-documentname dn)]
+                            [:td (.-title dn)]
+                            [:td (.-employeename dn)]
+                            [:td  (f/unparse (f/formatter "dd-MMM-yyyy")(f/parse (.-date dn)))]
+                            ;; [:td (.-date dn)]
+                            [:td (.-location dn)]
+                            [:td [:input {:type "button" :on-click #(click-update(.-id dn))
+                                          :class "glyphicon glyphicon-edit" :value "Update"}
+                                  ]]
+                            [:td [:input {:type "button" :on-click #(delete(.-id dn))
+                                          :class "glyphicon glyphicon-remove"  :value "Delete"}]]
+                            ])]]
+     ]
+
+    ]
+   ;; [:div.padding]
+   ;;  [:div.page-footer [:h4 "Copyright All Rights Reserved © 2016 TechnoIdentity Solutions Pvt.Ltd"]]
    ])
-
-

 (defroute home-path "/" []
   (let [onres (fn [json]
                 ((reset! documents (getdata json))
                  (r/render [render-documents @documents]
-                           (.-body js/document))))]
+                           (.getElementById js/document "app1"))))]
     (http-get "http://localhost:8193/documents/all" onres)))

 (defroute documents-path "/documents/add" []
@@ -192,7 +197,6 @@

 (defroute "*" []
   (js/alert "
Not Found Page
"))
-

 (defn main
   []


Open Test Summary links in new tabs (#1664)

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -415,6 +415,7 @@
     (case (feature/ab-test-treatment :junit-ab-test)
       :junit-button (button/link {:href junit-link
                                   :kind :primary
+                                  :target "_blank"
                                   :on-click track-junit}
                                  "Set Up Test Summary")
       :junit-banner [:div.alert.iconified {:class "alert-info"}
@@ -424,13 +425,15 @@
                       "Help us provide better insight around your tests and failures. "
                       [:a {:href junit-link
                            :class "junit-link"
+                           :target "_blank"
                            :on-mouse-up track-junit}
                        "Set up your test runner to output in JUnit-style XML"]
                       ", so we can:"
                       [:ul
                        [:li "Show a summary of all test failures across all containers"]
                        [:li "Identify your slowest tests"]
-                       [:li [:a {:href "https://circleci.com/docs/parallel-manual-setup/"}
+                       [:li [:a {:href "https://circleci.com/docs/parallel-manual-setup/"
+                                 :target "_blank"}
                              "Balance tests between containers when using properly configured parallelization"]]]]])))

 (defrender parse-errors [exceptions owner]


Adds collapsable toggles for the artifacts tab. Converts frontend.components.build-head/artifacts-node into a Om component in the process.

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -230,19 +230,44 @@
                {})
        :children))

-(defn artifacts-node [artifacts {:keys [show-node-indices? admin?] :as opts}]
-  (when (seq artifacts)
-    [:ul.build-artifacts-list
-     (for [[part {:keys [artifact children]}] (sort-by first artifacts)
-           :let [text (cond
-                        (not artifact) (str part "/") ; directory
-                        show-node-indices? (str part " (" (:node_index artifact) ")")
-                        :else part)
-                 url (:url artifact)
-                 tag (if (and url (not admin?)) ; Be extra careful about XSS of admins
-                       [:a {:href (:url artifact) :target "_blank"} text]
-                       [:span text])]]
-       [:li tag (artifacts-node children opts)])]))
+(defn artifacts-node [artifacts owner {:keys [show-node-indices? admin?] :as opts}]
+  (reify
+    om/IRender
+    (render [_]
+      (html
+       (when (seq artifacts)
+         [:ul.build-artifacts-list
+          (map-indexed
+           (fn node-entry [idx [part {:keys [artifact children]}]]
+             (let [directory? (not artifact)
+                   text       (cond
+                               directory?         (str part "/") ; directory
+                               show-node-indices? (str part " (" (:node_index artifact) ")")
+                               :else              part)
+                   url        (:url artifact)
+                   tag        (if (and url (not admin?)) ; Be extra careful about XSS of admins
+                                [:a {:href (:url artifact) :target "_blank"} text]
+                                [:span text])
+                   key        (keyword (str "index-" idx))
+                   closed?    (or
+                               (:ancestors-closed? opts)
+                               (om/get-state owner [key :closed?]))
+                   toggler    (fn [event]
+                                (let [key (keyword (str "index-" idx))]
+                                  (.preventDefault event)
+                                  (.stopPropagation event)
+                                  (om/update-state! owner [key :closed?] not)))]
+               [:li (when directory?
+                      [:div {:style    {:cursor  "pointer"
+                                        :display "inline"}
+                             :on-click toggler} (if closed? "▼  " "▲  ")])
+                tag
+                [:div (when closed? {:style {:display "none"}})
+                 (om/build artifacts-node
+                           children
+                           {:opts (assoc opts
+                                    :ancestors-closed? (or (:ancestors-closed? opts) closed?))})]]))
+           (sort-by first artifacts))])))))

 (defn build-artifacts-list [data owner {:keys [show-node-indices?] :as opts}]
   (reify
@@ -259,7 +284,7 @@
             (artifacts-ad)
             (if-not artifacts
               [:div.loading-spinner common/spinner]
-              (artifacts-node (artifacts-tree artifacts) node-opts)))])))))
+              (om/build artifacts-node (artifacts-tree artifacts) {:opts node-opts})))])))))

 (defn tests-ad [owner]
   [:div


Remove svg

Remove svg

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -1013,5 +1013,4 @@
            [:a.build-action
             {:href (routes/v1-project-settings (:navigation-data data))}
             [:i.material-icons "settings"]
-            [:img.dashboard-icon {:src (common/icon-path "QuickLink-Settings")}]
             "Project Settings"]])))))


Removing TODO

Removing TODO

--- dev-system/dev/refresh_persistent_settings.clj
+++ dev-system/dev/refresh_persistent_settings.clj
@@ -6,8 +6,6 @@
 (r/disable-reload!)
 (r/disable-unload!)

-;; TODO test this with refresh and super refresh
-
 (def logging-level
   "The logging level to use locally"
   (atom :error))


Increment template version

Increment template version

--- template/project.clj
+++ template/project.clj
@@ -1,4 +1,4 @@
-(defproject play-clj/lein-template "0.4.7.1-SNAPSHOT"
+(defproject play-clj/lein-template "0.4.7.1"
   :description "A template for making play-clj projects"
   :url "https://github.com/oakes/play-clj"
   :license {:name "Public Domain"


Clean up imports

Clean up imports

Remove unused and duplicates; sort

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -15,42 +15,34 @@
 ;               INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES.

 (ns org.micromanager.acq-engine
-  (:use [org.micromanager.mm :only
-          [when-lets map-config get-config get-positions load-mm store-mmcore
-           get-default-devices core log log-cmd mmc gui with-core-setting
-           do-when if-args get-system-config-cached select-values-match?
-           get-property get-camera-roi parse-core-metadata
-           json-to-data get-pixel-type get-msp-z-position set-msp-z-position
-           get-msp MultiStagePosition-to-map ChannelSpec-to-map
-           get-pixel-type get-current-time-str rekey
-           data-object-to-map str-vector double-vector
-           get-property-value edt attempt-all]]
-        [org.micromanager.sequence-generator :only [generate-acq-sequence
-                                                    make-property-sequences]])
-  (:require [clojure.set]
-            [org.micromanager.mm :as mm])
-  (:import [org.micromanager.acquisition TaggedImageQueue]
-  		   [org.micromanager.acquisition MMAcquisition]
-           [org.micromanager.api SequenceSettings]
-           [org.micromanager.api PositionList]
-           [org.micromanager.utils ReportingUtils MMListenerAdapter]
-           [mmcorej TaggedImage Configuration Metadata]
-           (java.util.concurrent Executors TimeUnit)
-           [java.util.prefs Preferences]
-           [java.net InetAddress]
-           [java.util.concurrent LinkedBlockingQueue TimeUnit CountDownLatch]
-           [org.micromanager.utils MDUtils
-                                   ReportingUtils]
-           [org.json JSONObject JSONArray]
-           [java.util Date UUID]
-           [javax.swing SwingUtilities]
-           [ij ImagePlus])
-   (:gen-class
-     :name org.micromanager.AcquisitionEngine2010
-     :implements [org.micromanager.api.IAcquisitionEngine2010]
-     :init init
-     :constructors {[org.micromanager.api.ScriptInterface] [] [mmcorej.CMMCore] []}
-     :state state))
+  (:use
+    [org.micromanager.mm :only
+     [ChannelSpec-to-map MultiStagePosition-to-map attempt-all core
+      data-object-to-map do-when double-vector get-camera-roi
+      get-current-time-str get-msp get-msp-z-position get-pixel-type
+      get-property get-property-value get-system-config-cached gui json-to-data
+      load-mm log map-config mmc rekey set-msp-z-position store-mmcore
+      str-vector when-lets with-core-setting]]
+    [org.micromanager.sequence-generator :only [generate-acq-sequence]])
+  (:require
+    [clojure.set]
+    [org.micromanager.mm :as mm])
+  (:import
+    [ij ImagePlus]
+    [java.net InetAddress]
+    [java.util Date UUID]
+    [java.util.concurrent CountDownLatch LinkedBlockingQueue TimeUnit]
+    [mmcorej Configuration Metadata TaggedImage]
+    [org.json JSONArray JSONObject]
+    [org.micromanager.acquisition MMAcquisition TaggedImageQueue]
+    [org.micromanager.api PositionList SequenceSettings]
+    [org.micromanager.utils MDUtils MMListenerAdapter ReportingUtils])
+  (:gen-class
+    :name org.micromanager.AcquisitionEngine2010
+    :implements [org.micromanager.api.IAcquisitionEngine2010]
+    :init init
+    :constructors {[org.micromanager.api.ScriptInterface] [] [mmcorej.CMMCore] []}
+    :state state))

 ;; test utils


Images now display distance annotations.

They're ugly and don't adapt to different grid sizes, but it's a start.

--- src/snergly/grid.clj
+++ src/snergly/grid.clj
@@ -141,5 +141,10 @@

         (when-not (linked? cell (:east cell)) (.drawLine g x2 y1 x2 y2))
         (when-not (linked? cell (:south cell)) (.drawLine g x1 y2 x2 y2))
+
+        (when (:label cell)
+          (.drawString g
+                       (Integer/toString (:label cell) 36)
+                       (+ x1 7) (- y2 5)))
         ))
     img))