[test] dynamically sized heatmap

[test] dynamically sized heatmap

--- test/clj_dstream/generative_test.clj
+++ test/clj_dstream/generative_test.clj
@@ -15,10 +15,14 @@
             [taoensso.tufte :as tufte :refer (defnp p profiled profile)]))

-(defn get-random-sample [method properties & {:keys [centroids]}]
+(defn get-random-sample [method properties & {:keys [centroids pos]}]
   ;;TODO make this sample some actua; distributions....
   (if centroids
-    (let [the-centroid (get centroids (rand-int (count centroids)))]
+    (let [the-centroid (get centroids (rand-int (count centroids)))
+          {:keys [row col]} pos
+
+          ]
+      (n/noise2 (* row 0.1) (* col 0.25))
       (vec
         (map-indexed (fn [idx {:keys [::core/domain-start ::core/domain-end]}]
                        (max domain-start (min domain-end (+ domain-start
@@ -55,19 +59,21 @@

     (let [vecs
           (for [c (range cols) r (range rows)]
-                 (let [num (or (::core/density-at-last-update (get grid-cells [r c]))
-                               0.0)]
-                   num
-                   ))]
-      (->>
-        vecs
-        (viz/matrix-2d rows cols)
-        ))
-
+            (let [num (or (::core/density-at-last-update (get grid-cells [r c]))
+                          0.0)]
+              num
+              ))]
+      {:matrix (->>
+                 vecs
+                 (viz/matrix-2d rows cols)
+                 )
+       :rows   rows
+       :cols   cols})
     ))

 (defn heatmap-spec
   [id the-matrix]
+  (println "id, matrix: " id the-matrix)
   {:matrix        the-matrix
    :value-domain  (viz/value-domain-bounds the-matrix)
    :palette       (->> id (grad/cosine-schemes) (apply grad/cosine-gradient 100))
@@ -75,18 +81,18 @@
    :layout        viz/svg-heatmap})

 (defn cartesian-viz
-  [prefix id the-matrix & [opts]]
+  [prefix id the-matrix rows cols & [opts]]
   (clojure.pprint/pprint the-matrix)
   (->> {:x-axis (viz/linear-axis
-                  {:domain [0 50]
+                  {:domain [0 cols]
                    :range  [50 550]
                    :major  10
                    :minor  5
                    :pos    280})
         :y-axis (viz/linear-axis
-                  {:domain      [0 10]
+                  {:domain      [0 rows]
                    :range       [280 20]
-                   :major       1
+                   :major       10
                    :pos         50
                    :label-dist  15
                    :label-style {:text-anchor "end"}})
@@ -112,9 +118,11 @@
               _            (println "tsne: " algo-name)
               output-map   {algo-name (tsne/tsne input-matrix 2 :tsne-algorithm algo-name :perplexity 0.01)}]
           output-map)))
+  (let [hm1 (grids-2d->heatmap-vec grid-cells props)
+        hm2 (grids-2d->heatmap-vec grid-cells props)]

-  (cartesian-viz "hm" :rainbow2 (grids-2d->heatmap-vec grid-cells props))
-  (cartesian-viz "hm" :orange-blue (grids-2d->heatmap-vec grid-cells props))
+    (cartesian-viz "hm" :rainbow2 (:matrix hm1) (:cols hm1) (:rows hm1))
+    (cartesian-viz "hm" :orange-blue (:matrix hm2) (:cols hm2) (:rows hm2)))
   )

@@ -132,18 +140,30 @@
                                           {::core/domain-start    -2.5
                                            ::core/domain-end      2.5
                                            ::core/domain-interval 0.1}
-                                          {::core/domain-start    -0.5
-                                           ::core/domain-end      0.5
+                                          {::core/domain-start    -2.5
+                                           ::core/domain-end      2.5
                                            ::core/domain-interval 0.1}]
-                      ::core/gap-time    50}
-        centroids    (vec (repeatedly 3 (fn [] (get-random-sample :unifrom test-props))))
-        _            (println "centroids: " centroids)
-        samples      (repeatedly 10000 #(hash-map
+                      ::core/gap-time    250}
+        ;centroids    (vec (repeatedly 4 (fn [] (get-random-sample :unifrom test-props))))
+        ;_            (println "centroids: " centroids)
+        samples      (repeatedly 50000 #(hash-map
                                          ::core/raw-datum
                                          {::core/position-value
-                                                       (get-random-sample :normal test-props
-                                                                          :centroids
-                                                                          centroids)
+                                                       (vec
+                                                         (take
+                                                           (::core/dimensions test-props)
+                                                           (repeatedly
+                                                             (fn []
+
+                                                               (if (> 0.5 (rand))
+                                                                 (+ 0.1
+                                                                    (* 0.15
+                                                                       (first
+                                                                         (random/sample-normal 1))))
+                                                                 (+ 0.9
+                                                                    (* 0.25
+                                                                       (first
+                                                                         (random/sample-normal 1)))))))))
                                           ::core/value 1.0}))

         test-state   {::core/state {::core/grid-cells           {}


New tests: parse-float-existence, parse-int-existence and parse-boolean existence

--- test/emender_service/config_test.clj
+++ test/emender_service/config_test.clj
@@ -11,3 +11,27 @@
     [function-name]
     (clojure.test/function? function-name))

+;
+; Tests for various functions
+;
+
+(deftest test-parse-int-existence
+    "Check that the emender-service.config/parse-int definition exists."
+    (testing "if the emender-service.config/parse-int definition exists."
+        (is (callable? 'emender-service.config/parse-int))))
+
+(deftest test-parse-float-existence
+    "Check that the emender-service.config/parse-float definition exists."
+    (testing "if the emender-service.config/parse-float definition exists."
+        (is (callable? 'emender-service.config/parse-float))))
+
+(deftest test-parse-boolean-existence
+    "Check that the emender-service.config/parse-boolean definition exists."
+    (testing "if the emender-service.config/parse-boolean definition exists."
+        (is (callable? 'emender-service.config/parse-boolean))))
+
+(deftest test-update-configuration-existence
+    "Check that the emender-service.config/update-configuration definition exists."
+    (testing "if the emender-service.config/update-configuration definition exists."
+        (is (callable? 'emender-service.config/update-configuration))))
+


Join random image tests

Join random image tests

--- test/silly_image_store/store_test.clj
+++ test/silly_image_store/store_test.clj
@@ -15,14 +15,12 @@
     (is (nil? (load-image "somewhere" "doesnt-exist.png"))))

   (testing "random image"
-    (let [file-path (.getPath (random-image test-basedir))]
-      (is (some #{file-path} ["test/fixtures/tubes.jpg"
-                              "test/fixtures/rocket.jpg"]))))
-
-  (testing "random image form bucket"
-    (let [file-path (.getPath (random-image test-basedir "some-bucket"))]
-      (is (some #{file-path} ["test/fixtures/some-bucket/boxes.jpg"
-                              "test/fixtures/some-bucket/shed.jpg"]))))
+    (is (some #{(.getPath (random-image test-basedir))}
+              ["test/fixtures/tubes.jpg"
+               "test/fixtures/rocket.jpg"]))
+    (is (some #{(.getPath (random-image test-basedir "some-bucket"))}
+              ["test/fixtures/some-bucket/boxes.jpg"
+               "test/fixtures/some-bucket/shed.jpg"])) )

   (testing "listing images"
     (is (= (list-images test-basedir) ["rocket.jpg" "tubes.jpg"]))


add navigator app, comment out broken dossier init (sorry!), fix helmsman-definition so it doesn't break for apps without routes

--- src/galleon/applications.clj
+++ src/galleon/applications.clj
@@ -3,15 +3,20 @@
             [dossier.core :as dossier]
             [dossier.system]
             [gangway.util :as gw-util]
-            [gangway.web]))
+            [gangway.web]
+            [navigator]))

 (def system-applications
   [{:app-name "Dossier"
-    :init-fn! dossier.system/db-init
+    :init-fn! nil #_dossier.system/db-init ;; this is broken
     :start-fn! nil
     :stop-fn! nil
     :helmsman-context "dossier"
     :helmsman-definition dossier/helmsman-definition}
+   {:app-name "Navigator"
+    :init-fn! navigator/init!
+    :start-fn! nil
+    :stop-fn! nil}
    {:app-name "Gangway"
     :init-fn! nil
     :start-fn! nil #_gw-util/start-queues!


Add configuration options for defcommand macro

--- src/main/workflo/macros/command.clj
+++ src/main/workflo/macros/command.clj
@@ -3,6 +3,34 @@
             [workflo.macros.command.util :as util]
             [workflo.macros.specs.command]
             [workflo.macros.query :as q]))
+
+;;;; Configuration
+
+(defonce ^:private +configuration+
+  (atom {:query nil
+         :process-result nil}))
+
+(defn configure!
+  "Configures how commands are created with defcommand
+   and how they are executed. Supports the following options:
+
+   :query   - a function that takes a parsed query; this function
+              is used to query a cache for data that the command
+              being executed needs to run.
+   :process-result - a function that is called after a command has been
+              executed; it takes the data returned from the command
+              implementation and handles it in whatever way is
+              desirable."
+  [{:keys [query process-result] :as options}]
+  (swap! +configuration+ assoc
+         :query query
+         :process-result process-result))
+
+(defn get-config
+  "Returns the configuration for a given configuration key, e.g.
+   :query or :process-result."
+  [key]
+  (@+configuration+ key))

 ;;;; Command registry


reverting back to using str not pr-str, because pr-str was printing with quotes around the output

--- src/midje/internal_ideas/report.clj
+++ src/midje/internal_ideas/report.clj
@@ -113,7 +113,7 @@
                            [nil 0]                  "[expected at least once, actually never called]"
                            [nil act] (cl-format nil "[expected at least once, actually called ~R time~:P]" act)
                            [exp act] (cl-format nil "[expected :times ~A, actually called ~R time~:P]" exp act))]
-                (str "    " (pr-str (:expected fail)) " " msg)))]
+                (str "    " (:expected fail) " " msg)))]

     (concat
           (list (fail-at (first (:failures m)))


Add key size parameter to cn-from-x509-certificate test

--- test/puppetlabs/certificate_authority/core_test.clj
+++ test/puppetlabs/certificate_authority/core_test.clj
@@ -172,10 +172,10 @@
 (deftest cn-from-x509-certificate-test
   (testing "cn extracted from an X509Certificate"
     (let [subject         (cn "foo")
-          key-pair        (generate-key-pair)
+          key-pair        (generate-key-pair 512)
           subj-pub        (get-public-key key-pair)
           issuer          (cn "my ca")
-          issuer-key-pair (generate-key-pair)
+          issuer-key-pair (generate-key-pair 512)
           issuer-priv     (get-private-key issuer-key-pair)
           not-before      (generate-not-before-date)
           not-after       (generate-not-after-date)


Dang; no defmacro- yet.

Dang; no defmacro- yet.

--- src/leiningen/util/maven.clj
+++ src/leiningen/util/maven.clj
@@ -183,7 +183,7 @@
   [project path-key]
   (.replace (path-key project) (str (:root project) "/") ""))

-(defmacro- add-a-resource [build method resource-path]
+(defmacro ^:private add-a-resource [build method resource-path]
   `(let [resource# (Resource.)]
      (.setDirectory resource# ~resource-path)
      (~(symbol (name method)) ~build [resource#])))


Symbol -invoke should defer to `get` same as Keyword

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -898,9 +898,9 @@

   IFn
   (-invoke [sym coll]
-    (-lookup coll sym nil))
+    (get coll sym))
   (-invoke [sym coll not-found]
-    (-lookup coll sym not-found))
+    (get coll sym not-found))

   IMeta
   (-meta [_] _meta)


ensure su note isnt nil if not provided

ensure su note isnt nil if not provided

--- src/open_company/lib/bot.clj
+++ src/open_company/lib/bot.clj
@@ -38,7 +38,9 @@
        (apply merge)))

 (defn add-su-note [ctx]
-  (assoc-in ctx [:stakeholder-update :note] (-> ctx :data :note)))
+  (if-let [note (-> ctx :data :note)]
+    (assoc-in ctx [:stakeholder-update :note] note)
+    ctx))

 (defn ctx->trigger [script-id ctx]
   {:pre [(map? (:company ctx)) (map? (:user ctx))]}


Fix Slack reconnect

Fix Slack reconnect

--- src/yetibot/core/adapters/slack.clj
+++ src/yetibot/core/adapters/slack.clj
@@ -239,7 +239,7 @@
         (timbre/info "attempt no." rb/*try* " to rereconnect to slack")
         (when rb/*error* (timbre/info "previous attempt errored:" rb/*error*))
         (when rb/*last-try* (timbre/warn "this is the last attempt"))
-        (restart conn config)))))
+        (restart conn config connected?)))))

 (defn on-error [exception]
   (timbre/error "error in slack" exception))


replace proxy with reify

replace proxy with reify

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -182,10 +182,7 @@

 (defn custom-creator [^Class class]
   "make a Creator for the given Class"
-  (proxy [Creator] []
-	 (^{:tag class} create [^{:tag (type (into-array Object []))} args]
-		  ;;(println "CREATOR" class (map identity args))
-		  (apply make-instance class args))))
+  (reify Creator (create [_ args] (apply make-instance class args))))

 (defn ^Metadata custom-metadata3 [^Class class primary-keys version-keys version-comparator attribute-specs]
   "make Metadata for a given class"
@@ -254,9 +251,7 @@

 (defn ^Creator record-creator [^Class class]
   "make a Creator for the given Class"
-  (proxy [Creator] []
-	 (^{:tag class} create [^{:tag (type (into-array Object []))} args] ;TODO: why does creator insist on an array ?
-		  (apply make-instance class args))))
+  (reify Creator (create [_ args] (apply make-instance class args))))

 (defn ^Getter record-getter [^Class input-type ^Class output-type name]
   "make a Getter for the named attribute of the given Class"
@@ -316,8 +311,8 @@

 ;; TODO - creator should take a collection OR an array ?
 (defmacro make-record-creator [class-name field-names]
-  `(proxy [Creator] []
-     (^{:tag ~class-name} create [^{:tag (type (into-array Object []))} args#]
+  `(reify Creator
+     (create [_ args#]
       (let [~(apply vector field-names) args#] (~(symbol (str (name class-name) "." )) ~@field-names)))
      ))


Fixing system int test dependencies.

Fixing system int test dependencies.

--- system-int-test/project.clj
+++ system-int-test/project.clj
@@ -17,6 +17,9 @@
                  ;; included to allow access to catalog rest and db connection code
                  [nasa-cmr/cmr-bootstrap-app "0.1.0-SNAPSHOT"]

+                 ;; Needed for client libraries
+                 [nasa-cmr/cmr-mock-app "0.1.0-SNAPSHOT"]
+
                  ; include ring-core to support encoding of params
                  [ring/ring-core "1.3.2" :exclusions [clj-time]]]
   :plugins [[lein-test-out "0.3.1"]]


New test: get-first-day-of-week-2

New test: get-first-day-of-week-2

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -402,3 +402,49 @@
             (.set calendar 2000 00 10 00 00 00)
             (is (= "2000-01-09" (get-first-day-of-week-formatted calendar))))))

+(deftest test-get-first-day-of-week-2
+    "Check the function clj-calendar.calendar/get-first-day-of-week"
+    (testing "the function clj-calendar.calendar/get-first-day-of-week"
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 1 00 00 00)
+            (is (= "2000-01-30" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 2 00 00 00)
+            (is (= "2000-01-30" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 3 00 00 00)
+            (is (= "2000-01-30" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 4 00 00 00)
+            (is (= "2000-01-30" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 5 00 00 00)
+            (is (= "2000-01-30" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 6 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 7 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 8 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 9 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 10 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 11 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 12 00 00 00)
+            (is (= "2000-02-06" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 13 00 00 00)
+            (is (= "2000-02-13" (get-first-day-of-week-formatted calendar))))
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 14 00 00 00)
+            (is (= "2000-02-13" (get-first-day-of-week-formatted calendar))))))
+


All tests pass in clj, all but one in cljs.

--- test/cljx/quile/component_test.cljx
+++ test/cljx/quile/component_test.cljx
@@ -15,9 +15,14 @@
 #+cljs
 (defn var [arg] arg)

+#+clj
 (defn- log [& args]
   (when (thread-bound? #'*log*)
     (set! *log* (conj *log* args))))
+
+#+cljs
+(defn- log [& args]
+  (set! *log* (conj *log* args)))

 (defn- ordering
   "Given an ordered collection of messages, returns a map from the
@@ -130,13 +135,17 @@
                        :my-c :c})
                  :e (component-e)}))

+;;; Macros disappear in .cljs - they are written in clojure
 (defmacro with-log [& body]
   `(binding [*log* []]
      ~@body
      *log*))

 (deftest components-start-in-order
-  (let [log (with-log (component/start (system-1)))]
+  (let [log #+clj (with-log (component/start (system-1)))
+            #+cljs (binding [*log* []]
+                     (component/start (system-1))
+                     *log*)]
     (are [k1 k2] (before? log k1 k2)
          'ComponentA.start 'ComponentB.start
          'ComponentA.start 'ComponentC.start
@@ -191,10 +200,10 @@
     (is (started? (-> ex ex-data :component :a)))
     (is (started? (-> ex ex-data :component :b)))))

+#+clj
 (deftest error-thrown-with-cause
   (let [error (ex-info "Boom!" {})
         ex (setup-error error)]
-    (println error ex)
     (is (identical? error (.getCause ex)))))

 (defrecord System2b [one]


added some tests for short-term function

--- test/forma/trends/analysis_test.clj
+++ test/forma/trends/analysis_test.clj
@@ -181,10 +181,29 @@
           (transpose
            (telescoping-long-trend 23 start end ndvi-ts reli-ts rain-ts))))))

+(defn short-trend-results
+  "returns three vectors, the first with the hansen statistic for time
+  series ranging from 0 through 135 (end of training period) and 136;
+  the second with the long-term drop value; and the third with the
+  long-term t-statisic.  Input a map, generated by total-tap.  The
+  start and end index don't matter for this application, but are left
+  in there anyway to ensure forward compatibility"
+  [m]
+  (let [start 135
+        [ndvi-ts reli-ts] ((juxt :ndvi :reli) m)]
+    (schema/timeseries-value start (count ndvi-ts)
+     (telescoping-short-trend 30 10 23 start ndvi-ts reli-ts))))
+
 (def long-trend-query
   (<- [?han-stat ?long-drop ?long-tstat]
       (ts-tap ?ts-map)
       (long-trend-results ?ts-map :> ?han-stat ?long-drop ?long-tstat)
+      (:distinct false)))
+
+(def short-trend-query
+  (?<- (stdout) [?min-drop]
+      (ts-tap ?ts-map)
+      (short-trend-results ?ts-map :> ?min-drop)
       (:distinct false)))

 (fact


Change how the mock data state is held for cucumber tests.

--- test/fcms/lib/http_mock.clj
+++ test/fcms/lib/http_mock.clj
@@ -1,17 +1,15 @@
 (ns fcms.lib.http-mock)

-(def req) ; mock HTTP request
-(def bod) ; body of the mock HTTP request or response
-(def resp) ; mock HTTP response
+(def mock-data (atom {:request {} :body "" :response {}}))

 (defn request
-  ([] req)
-  ([new-req] (def req new-req)))
+  ([] (:request @mock-data))
+  ([new-request] (swap! mock-data assoc :request new-request)))

 (defn body
-  ([] bod)
-  ([new-body] (def bod new-body)))
+  ([] (:body @mock-data))
+  ([new-body] (swap! mock-data assoc :body new-body)))

 (defn response
-  ([] resp)
-  ([new-resp] (def resp new-resp)))
+  ([] (:response @mock-data))
+  ([new-response] (swap! mock-data assoc :response new-response)))


Change some existing tests to use new collection checker style.

--- test/midje/t_semi_sweet.clj
+++ test/midje/t_semi_sweet.clj
@@ -25,7 +25,7 @@
                  '[:key 'value] ])

   (let [actual (fakes-and-overrides '())]
-    actual => (just [empty? empty?])))
+    actual => (just empty? empty?)))

 (fact "calling a faked function raises an error"
   (faked-function) => (throws Error))
@@ -117,13 +117,13 @@
   (after-silently
    (expect (no-caller) => "irrelevant"
            (fake (mocked-function) => 33))
-   @reported => (just [wrong-call-count bad-result]))
+   @reported => (just wrong-call-count bad-result))

   "mock call was not supposed to be made, but was (non-zero call count)"
   (after-silently
    (expect (function-under-test 33) => "irrelevant"
            (not-called mocked-function))
-   @reported => (just [wrong-call-count bad-result]))
+   @reported => (just wrong-call-count bad-result))

   "call not from inside function"
   (after-silently
@@ -136,8 +136,8 @@
   (after-silently
    (expect (+ (mocked-function 12) (mocked-function 33)) => "result irrelevant because of earlier failure"
            (fake (mocked-function 12) => "hi"))
-   @reported => (just [(contains {:type :mock-argument-match-failure :actual '(33)})
-                      bad-result]))
+   @reported => (just (contains {:type :mock-argument-match-failure :actual '(33)})
+                      bad-result))

   "failure because one variant of multiply-mocked function is not called"
   (after-silently
@@ -145,9 +145,9 @@
            (fake (mocked-function 12) => 1)
            (fake (mocked-function 22) => 2)
            (fake (mocked-function 33) => 3))
-   @reported => (just [(contains {:type :mock-incorrect-call-count
+   @reported => (just (contains {:type :mock-incorrect-call-count
                                  :expected-call "(mocked-function 33)" })
-                       pass])) ; Right result, but wrong reason.
+                      pass)) ; Right result, but wrong reason.

   "multiple calls to a mocked function are perfectly fine"
   (expect (+ (mocked-function 12) (mocked-function 12)) => 2


Use new API in full test.

Use new API in full test.

--- test/onyx/log/full_test.clj
+++ test/onyx/log/full_test.clj
@@ -29,9 +29,7 @@
    :onyx/id onyx-id
    :onyx.coordinator/revoke-delay 5000})

-(def dev (onyx-development-env env-config))
-
-(def env (component/start dev))
+(def env (onyx.api/start-env env-config))

 (def peer-config
   {:hornetq/mode :udp
@@ -68,9 +66,7 @@
 (fact (count (:peers replica)) => n-peers)

 (doseq [v-peer v-peers]
-  (try
-    ((:shutdown-fn v-peer))
-    (catch Exception e (prn e))))
+  (onyx.api/shutdown-peer v-peer))

-(component/stop env)
+(onyx.api/shutdown-env env)


Oops.  Expand PhraseQuery queries too

Oops.  Expand PhraseQuery queries too

--- src/net/dishevelled/mailindex.clj
+++ src/net/dishevelled/mailindex.clj
@@ -394,6 +394,21 @@
               (.setQuery clause (expand-query (.getQuery clause))))
             query)

+        (and (instance? PhraseQuery query))
+        (if-let [linked-fields (:linked-fields
+                                (parse-rules (.field
+                                              (first (.getTerms query)))))]
+          (let [new-query (BooleanQuery.)]
+            (.add new-query query BooleanClause$Occur/SHOULD)
+            (doseq [field linked-fields]
+              (let [phrase (PhraseQuery.)]
+                (doseq [term (.getTerms query)]
+                  (.add phrase (Term. field (.text term))))
+                (.add new-query phrase BooleanClause$Occur/SHOULD)))
+            new-query)
+          query)
+
+
         (instance? TermQuery query)
         (let [term (.getTerm query)]
           (if-let [linked-fields (:linked-fields (parse-rules (.field term)))]


Parse complex optargs with sequential types

This patch enables to parse options using complex optargs like SYM:VER=PATH
with types that are not nested but straight up sequential, like [sym str str].

--- boot/core/src/boot/cli.clj
+++ boot/core/src/boot/cli.clj
@@ -43,7 +43,17 @@
     code  (constantly true)
     file  #(instance? java.io.File %)))

-(defn- parse-fn [optarg]
+(defn- parse-fn
+  "Return a function accepting arguments that are split according to optarg.
+
+  The function works also for optargs splitting:
+
+    ((parse-fn SYM:VER=PATH) SYM:VER=PATH) => [SYM VER PATH]
+
+  But the typical usage is:
+
+    ((parse-fn SYM:VER=PATH) \"prj:1.3=parent\") => [prj 1.3 parent]"
+  [optarg]
   (fn [arg]
     (let [chars (->> optarg str (remove A-Z?))]
       (if-not (seq chars)
@@ -73,10 +83,12 @@
           int-flag?  (and flag? (= 'int type))
           bool-flag? (and flag? (= 'bool type))]
       (cond
-        bool-flag?     (assoc m k v)
-        int-flag?      (update-in m [k] (fnil inc 0))
-        (symbol? type) (assoc m k (parse-type type v))
-        (coll? type)   (update-in m [k] (fnil conj (empty type)) (parse-type (first type) v))))))
+        bool-flag?              (assoc m k v)
+        int-flag?               (update-in m [k] (fnil inc 0))
+        (or (symbol? type)
+            (sequential? type)) (assoc m k (parse-type type v))
+        (or (set? type)
+            (map? type))        (update-in m [k] (fnil conj (empty type)) (parse-type (first type) v))))))

 (defn- deprecated [short]
   (:deprecated (meta short)))
@@ -89,12 +101,13 @@
         flag? (not optarg)
         incr? (and flag? (= 'int type))
         docstring (cond
-                    incr? (format "Increase %s" (decap doc))
-                    flag? doc
-                    atom? (format "%s sets %s." optarg (depunc (decap doc)))
-                    :else (let [f "Conj %s onto %s"
-                                v ((parse-fn optarg) (str optarg))]
-                            (format f (if (string? v) v (pr-str (mapv symbol v))) (decap doc))))]
+                    incr?       (format "Increase %s" (decap doc))
+                    flag?       doc
+                    atom?       (format "%s sets %s." optarg (depunc (decap doc)))
+                    sequential? (format "%s sets %s" (str optarg) (decap doc))
+                    :else       (let [f "Conj %s onto %s"
+                                      v ((parse-fn optarg) (str optarg))]
+                                  (format f (if (string? v) v (pr-str (mapv symbol v))) (decap doc))))]
     (cond-> docstring
       (deprecated short) deprecated-doc)))


Describe implementation of status delay

Describe implementation of status delay

--- src-cljs/frontend/components/build.cljs
+++ src-cljs/frontend/components/build.cljs
@@ -302,11 +302,33 @@
          (datetime/as-duration (container-utilization-duration actions))
          ")"]))))

-(defn maybe-override-status [status {:keys [until] :as override-status}]
+(defn compute-override-status
+  "This is called when properties are updated in will-receive-props.
+
+  This exists because the jump between :running and :waiting status is
+  jarring and it can happen very quickly in a sequence of short build
+  steps. To mitigate this, we are introducing a two second delay when
+  transitioning from the :running state to the :waiting state.
+
+  compute-override-status checks if we are transitioning to
+  the :waiting status.  If we are, it generates 'override' data to put
+  into component local state.  This data is used during rendering to
+  decide which status to display."
+  [current-status next-status]
+  (if (and (= next-status :waiting)
+           (not= current-status next-status))
+    {:status current-status
+     :until (+ (datetime/now)
+               2000)}))
+
+(defn maybe-override-status
+  "If there is an override status and its time has not experied, use
+  that status.  If the time has expried, use the real status."
+  [real-status {:keys [until] :as override-status}]
   (if (and override-status
            (>= until (datetime/now)))
     (:status override-status)
-    status))
+    real-status))

 (defn container-pill-v2 [{:keys [container status current-container-id build-running?]} owner]
   (reify
@@ -321,12 +343,7 @@
     om/IWillReceiveProps
     (will-receive-props [this next-props]
       (let [next-status (:status next-props)]
-        (if (and (= next-status :waiting)
-                 (not= status next-status))
-          (om/set-state! owner :override-status {:status status
-                                                 :until (+ (datetime/now)
-                                                           2000)})
-          (om/set-state! owner :override-status nil))))
+        (om/set-state! owner :override-status (compute-override-status status next-status))))
     om/IRenderState
     (render-state [_ {:keys [override-status]}]
       (html


having datomic in lein deps is no bueno

having datomic in lein deps is no bueno


extend our `realize-json` function to handle the case where the column is of type org.postgresql.util.PGobject which happens if the postgres column type is 'json'.

--- src/metabase/models/hydrate.clj
+++ src/metabase/models/hydrate.clj
@@ -25,8 +25,10 @@
 (defn- read-json-str-or-clob
   "If JSON-STRING is a JDBC Clob, convert to a String. Then call `json/read-str`."
   [json-str]
-  (some-> (if-not (= (type json-str) org.h2.jdbc.JdbcClob) json-str
-                  (u/jdbc-clob->str json-str))
+  (some-> (cond
+            (= (type json-str) org.h2.jdbc.JdbcClob) (u/jdbc-clob->str json-str)
+            (= (type json-str) org.postgresql.util.PGobject) (.getValue json-str)
+            :else json-str)
           cheshire/parse-string))

 (defn realize-json


♻ Convert poller to a record

♻ Convert poller to a record

--- src/territory_bro/poller.clj
+++ src/territory_bro/poller.clj
@@ -3,11 +3,17 @@
 ;; The license text is at http://www.apache.org/licenses/LICENSE-2.0

 (ns territory-bro.poller
+  (:refer-clojure :exclude [await])
   (:require [clojure.tools.logging :as log])
   (:import (com.google.common.util.concurrent ThreadFactoryBuilder)
            (java.lang Thread$UncaughtExceptionHandler)
            (java.util Queue)
            (java.util.concurrent ExecutorService Executors TimeUnit ArrayBlockingQueue)))
+
+(defprotocol Poller
+  (trigger! [this])
+  (await [this])
+  (shutdown! [this]))

 (def ^:private uncaught-exception-handler
   (reify Thread$UncaughtExceptionHandler
@@ -21,12 +27,6 @@
       (.setUncaughtExceptionHandler uncaught-exception-handler)
       (.build)))

-(defn create [task]
-  (assert (fn? task) {:task task})
-  {::available-tasks (doto (ArrayBlockingQueue. 1)
-                       (.add task))
-   ::executor (Executors/newFixedThreadPool 1 thread-factory)})
-
 (defn- run-safely! [task]
   (try
     (task)
@@ -37,22 +37,27 @@
         (when-let [handler (.getUncaughtExceptionHandler t)]
           (.uncaughtException handler t e))))))

-(defn trigger! [this]
-  (let [executor ^ExecutorService (::executor this)
-        available-tasks ^Queue (::available-tasks this)
-        task (.poll available-tasks)]
-    (when task
+(defrecord AsyncPoller [^Queue available-tasks
+                        ^ExecutorService executor]
+  Poller
+  (trigger! [_]
+    (when-let [task (.poll available-tasks)]
       (.execute executor (fn []
                            (.add available-tasks task)
-                           (run-safely! task))))))
+                           (run-safely! task)))))

-(defn shutdown! [this]
-  (doto ^ExecutorService (::executor this)
-    (.shutdown)
-    (.awaitTermination 1 TimeUnit/MINUTES)
-    (.shutdownNow)))
+  (await [_]
+    (let [future (.submit executor ^Runnable (fn []))]
+      (.get future)))

-(defn await [this]
-  (let [executor ^ExecutorService (::executor this)
-        future (.submit executor ^Runnable (fn []))]
-    (.get future)))
+  (shutdown! [_]
+    (doto executor
+      (.shutdown)
+      (.awaitTermination 1 TimeUnit/MINUTES)
+      (.shutdownNow))))
+
+(defn create [task]
+  (assert (fn? task) {:task task})
+  (AsyncPoller. (doto (ArrayBlockingQueue. 1)
+                  (.add task))
+                (Executors/newFixedThreadPool 1 thread-factory)))


Quick fix for cond-> use in data fetch merging #33

--- src/untangled/client/impl/data_fetch.cljs
+++ src/untangled/client/impl/data_fetch.cljs
@@ -333,7 +333,7 @@
                           (swap! app-state (fn [s]
                                              (cond-> s
                                                (data-marker? item) (update-in (data-path item) set-failed! error)
-                                               (update :untangled/loads-in-progress disj (data-uuid item)))))))
+                                               :always (update :untangled/loads-in-progress disj (data-uuid item)))))))
           run-fallbacks (fn [] (doseq [item loading-items]
                                  (when-let [fallback-symbol (::fallback item)]
                                    (reset! ran-fallbacks true)


Make a table to hold details on app database schemas

This will be so that schemas can be a first class thing in the system

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -891,6 +891,7 @@
           (
           id                                               serial NOT NULL,
           fk_appshare_application_id                       integer,
+          fk_appshare_schema_id                            integer,
           application_environment                          character varying,
           database_schema_name                             character varying,
           CONSTRAINT appshare_applications_schemas_pkey    PRIMARY KEY (id)
@@ -903,6 +904,7 @@
           (
           id                                             NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
           fk_appshare_application_id                     NUMBER,
+          fk_appshare_schema_id                          NUMBER,
           application_environment                        VARCHAR2(200 BYTE),
           database_schema_name                           VARCHAR2(200 BYTE),
           CONSTRAINT  APPSHARE_APPLICATION_SCHEMAS_PK    PRIMARY KEY (ID)
@@ -913,6 +915,47 @@
       (korma.core/exec-raw   [sql-to-create-app-schemas-table []]   [])
       nil)))

+
+
+
+
+
+
+
+
+
+
+
+(defn make-schemas-table []
+  (let [sql-to-create-schemas-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE public.appshare_schemas
+          (
+          id                                               serial NOT NULL,
+          fk_appshare_publisher_id                         integer,
+          application_environment                          character varying,
+          database_schema_name                             character varying,
+          CONSTRAINT appshare_schemas_pkey    PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_schemas
+          (
+          id                                             NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          fk_appshare_publisher_id                       NUMBER,
+          application_environment                        VARCHAR2(200 BYTE),
+          database_schema_name                           VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_SCHEMAS_PK    PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_schemas"))
+      (korma.core/exec-raw   [sql-to-create-schemas-table []]   [])
+      nil)))

@@ -1116,6 +1159,7 @@
 (make-logins-table)
 (make-applications-table)
 (make-app-schemas-table)
+(make-schemas-table)
 (make-triggers-table)
 (make-log-table)


Fix the faces of the dodecahedron

Fix the faces of the dodecahedron

--- src/wireframes/shapes/platonic_solids.clj
+++ src/wireframes/shapes/platonic_solids.clj
@@ -57,30 +57,28 @@

 (def dodecahedron
   "A 12-sided polyhedron with regular pentagonal faces"
-  (let [points (vec
-                 (apply concat
-                   (for [x [-1 1]
-                         y [-1 1]
-                         z [-1 1]]
-                     (t/point x y z))
+  {:points (vec
+             (apply concat
+               (for [x [-1 1]
+                     y [-1 1]
+                     z [-1 1]]
+                 (t/point x y z))

-                   (for [a [(/ -1 rho) (/ 1 rho)]
-                         b [(- rho) rho]]
-                     (map #(apply t/point %) (take 3 (partition 3 1 (cycle [0 a b])))))))
-        polygons (vec
-                   (for [a (range (count points))
-                         b (range a)
-                         c (range b)
-                         d (range (count points))
-                         e (range d)
-                         :when (and
-                                 (=approx (t/distance (points a) (points b)) (dec sqrt-5))
-                                 (=approx (t/distance (points b) (points c)) (dec sqrt-5))
-                                 (=approx (t/distance (points c) (points d)) (dec sqrt-5))
-                                 (=approx (t/distance (points d) (points e)) (dec sqrt-5))
-                                 (=approx (t/distance (points e) (points a)) (dec sqrt-5)))]
-                     {:vertices [a b c d e]}))]
-  {:points points :polygons polygons}))
+               (for [a [(/ -1 rho) (/ 1 rho)]
+                     b [(- rho) rho]]
+                 (map #(apply t/point %) (take 3 (partition 3 1 (cycle [0 a b])))))))
+   :polygons [{:vertices [14 8 0 10 2]}
+              {:vertices [14 8 4 13 6]}
+              {:vertices [15 9 0 8 4]}
+              {:vertices [15 9 1 11 5]}
+              {:vertices [16 10 0 9 1]}
+              {:vertices [16 10 2 12 3]}
+              {:vertices [17 11 1 16 3]}
+              {:vertices [17 11 5 19 7]}
+              {:vertices [18 12 2 14 6]}
+              {:vertices [18 12 3 17 7]}
+              {:vertices [19 13 4 15 5]}
+              {:vertices [19 13 6 18 7]}]})

 (def icosahedron
   "A 20-sided polyhedron with triangular faces"


allow typing in a new email address

allow typing in a new email address

--- src/chat/client/views/group_invite.cljs
+++ src/chat/client/views/group_invite.cljs
@@ -33,7 +33,8 @@
                             (fn [s ch]
                               ; TODO: don't show users already in group
                               (let [emails (->> (store/get-user-emails)
-                                                (filter #(not= -1 (.indexOf % s))))]
+                                                (filter #(not= -1 (.indexOf % s)))
+                                                (cons s))]
                                 (put! ch emails)))
                             :choice-render-fn str
                             :class "autocomplete"}})


I think I've fixed the parentless GO term bug

--- src/cljs/gointermod/ontology/views.cljs
+++ src/cljs/gointermod/ontology/views.cljs
@@ -67,12 +67,28 @@
        ", "  end-x " " end-y)
 ))

+(defn setpath [parentnode childnode]
+  (.setAttribute (clonepath) "d" (build-path parentnode childnode)))
+
 (defn drawline
   "given a parent HTML element and a child HTML element, draw a line between the bottom of the parent and the top of the child. This is done by calculating the locations of each of the boxes, and offsetting by 1) the amount scrolled on the window if any and 2) the other elements in the page."
   [parent child]
-     (let [childnode (if (elem child) (elem child) (elem (organism-id child)))
-           parentnode (if (elem parent) (elem parent) (elem (organism-id parent)))]
-     (.setAttribute (clonepath) "d" (build-path parentnode childnode))))
+     (let [child-node (elem child)
+           org-child (elem (organism-id child))
+           parent-node (elem parent)
+           org-parent (elem (organism-id parent))]
+       ;;this is chaotic looking but seems to avoid all nullpointer errors
+       ;;as well as avoiding all the seemingly 'parentless' go terms without lines
+       (cond (and child-node parent-node)
+         (setpath parent-node child-node))
+       (cond (and child-node org-parent)
+         (setpath org-parent child-node))
+       (cond (and org-child parent-node)
+         (setpath parent-node org-child))
+       (cond (and org-child org-parent)
+         (setpath org-parent org-child))
+
+     ))

 (defn organism-node
   "outputs the go term, organism, and orthologue for nodes with these types of results"


Refactor polling-loop's cookie-sent to top (WIP)

i.e. Move it from an inline functional clojure to a top-level function.

This is a first step in an attempt to make the pieces small enough to
help figure out where the Initiate response is disappearing (yet again).

Fixed a bug in an exception handler where I was trying to call
flush-logs! without a logger.

Fixed another in a different one where I was just building the new log
message and discarding it.

--- src/clojure/frereth_cp/client/hello.clj
+++ src/clojure/frereth_cp/client/hello.clj
@@ -254,6 +254,54 @@
                (pick-next-timeout (count remaining-ips))
                remaining-ips)
       (throw (ex-info "Giving up" this)))))
+
+(s/fdef cookie-sent
+        :args (s/cat :this ::state/state
+                     :raw-packet ::specs/network-packet
+                     :log-state-atom ::log/state-atom
+                     :cookie-response dfrd/deferrable?
+                     :cookie-sent-callback (s/fspec :args (s/cat :this ::state/state
+                                                                 :result dfrd/deferrable?
+                                                                 :timeout nat-int?
+                                                                 :sent ::specs/network-packet)
+                                                    :ret any?)
+                     :send-packet-success boolean?)
+        ;; Actually, it should return a deferrable
+        ;; that resolves to a ::cookie-response
+        :ret (s/or :response dfrd/deferrable?
+                   :recursed ::cookie-response))
+(defn cookie-sent
+  ;; TODO: Come up with a better name. do-polling-loop
+  ;; needs both this and a callback from the cookie
+  ;; ns that it's named cookie-sent-callback.
+  ;; Need to make them different enough that I won't
+  ;; get them snarled up.
+  [{:keys [::state/timeout
+           :state/server-ips]
+    :as this}
+   raw-packet
+   log-state-atom
+   cookie-response
+   ;; Yeah. This is where the names go haywire
+   cookie-sent-callback
+   raw-packet
+   send-packet-success]
+  (if send-packet-success
+    ;; Note that this timeout actually can grow to be quite long.
+    ;; In the original, they probably add up to a ballpark of a minute.
+    ;; It's probably acceptable for a single polling thread to block for that
+    ;; long.
+    ;; Or, at least, it probably was back in 2011 when the spec was written,
+    ;; or in 2013 when my copy of the reference implementation was published.
+    ;; Q: Is that still reasonable today?
+    ;; Better Q: Is there a better alternative?
+    (dfrd/timeout! cookie-response timeout ::awaiting-cookie-timed-out)
+    ;; I'd really like to trampoline this. Realistically, we can't, because
+    ;; we're inside a deferred chain.
+    ;; TODO: Prove that, one way or another
+    (trampoline possibly-recurse
+                (assoc this ::log/state @log-state-atom)
+                server-ips cookie-sent-callback raw-packet)))

 (s/fdef do-polling-loop
         :args (s/cat :this ::state/state
@@ -318,24 +366,18 @@
     (-> dfrd-send-success
         (dfrd/timeout!  1000)
         (dfrd/chain
-         (fn [send-packet-success]
-           (if send-packet-success
-             ;; Note that this timeout actually can grow to be quite long.
-             ;; In the original, they probably add up to a ballpark of a minute.
-             ;; It's probably acceptable for a single polling thread to block for that
-             ;; long.
-             ;; Or, at least, it probably was back in 2011 when the spec was written,
-             ;; or in 2013 when my copy of the reference implementation was published.
-             ;; Q: Is that still reasonable today?
-             ;; Better Q: Is there a better alternative?
-             (dfrd/timeout! cookie-response timeout ::awaiting-cookie-timed-out)
-             (trampoline possibly-recurse
-                         (assoc this ::log/state @log-state-atom)
-                         ips cookie-sent-callback raw-packet)))
+         (partial cookie-sent this raw-packet log-state-atom cookie-response cookie-sent-callback)
          (fn [actual-success]
            (let [now (System/nanoTime)]
              (swap! log-state-atom (fn [local]
                                      (log/merge-state local (::log/state actual-success))))
+             ;; This really should be a log message. Time after time, it's shown up in STDOUT
+             ;; as a marker when my logs disappear.
+             ;; That isn't an endorsement of using the print.
+             ;; It's probably more of a sign that maybe logs simply are not meant to be
+             ;; accrued this way.
+             ;; Then again, logs are really for diagnosing production issues, not debugging
+             ;; problems at dev time
              (println "hello/do-polling-loop Sent HELLO actual-success:\n"
                       (dissoc actual-success ::log/state)
                       "\nTop-level keys:\n"
@@ -350,9 +392,8 @@
                                                                              ::do-polling-loop
                                                                              "Got back a network-packet but missing something else"
                                                                              {::cookie-response actual-success}))))
-                   (assert (and server-security shared-secrets)
-                           (str "Network-packet missing either security or shared-secrets:\n"
-                                (util/pretty actual-success))))
+                   (throw (ex-info "Network-packet missing either security or shared-secrets"
+                                   actual-success)))
                  (swap! log-state-atom #(log/debug %
                                                    ::do-polling-loop
                                                    "Got back a usable cookie"
@@ -371,6 +412,8 @@
                                          "Discarding garbage cooke")]
                  (if (< 0 remaining)
                    ;; Q: Use trampoline instead?
+                   ;; A: That would get into all sorts of weirdness, because this
+                   ;; is nested inside a deferred
                    (do-polling-loop
                     (assoc this ::log/state (log/flush-logs! logger (log/info @log-state-atom
                                                                               ::do-polling-loop
@@ -388,8 +431,6 @@
                                      raw-packet
                                      cookie-sent-callback
                                      now
-                                     ;; TODO: I'm missing that module against a random 32-byte number
-                                     ;; mentioned above.
                                      (pick-next-timeout timeout)
                                      ips)))))))
         (dfrd/catch ExceptionInfo
@@ -411,7 +452,8 @@
             (fn [ex]
               (assoc this
                      ::log/state (swap! log-state-atom
-                                        #(log/flush-logs! (log/exception %
+                                        #(log/flush-logs! logger
+                                                          (log/exception %
                                                                          ex
                                                                          ::do-polling-loop))))))
         (deref timeout ::polling-timed-out))))
@@ -445,7 +487,7 @@
                              ::poll-servers!
                              "Putting hello(s) onto ->server channel"
                              {::raw-packet raw-packet})]
-    (println "Client: Entering the hello polling loop")
+    (println "Hello: Entering the server polling loop")
     (let [this
           (try
             (do-polling-loop (assoc this ::log/state log-state)
@@ -462,10 +504,9 @@
                              ;; Stick with the reference implementation version for now.
                              (take max-server-attempts (cycle server-ips)))
             (catch Exception ex
-              (log/exception log-state
-                             ex
-                             ::poll-servers!)
-              (assoc this ::log/state (log/flush-logs! logger log-state))))]
+              (assoc this ::log/state (log/exception log-state
+                                                     ex
+                                                     ::poll-servers!))))]
       (assert (::log-state this) "do-polling-loop returned badly")
       (update this ::log/state
               #(log/flush-logs! logger %)))))
@@ -547,21 +588,25 @@
    wait-for-cookie!
    build-inner-vouch
    servers-polled]
-  (let [{log-state ::log/state
-         :as this}
-        ;; Note that this is going to block the calling
-        ;; thread. Which is annoying, but probably not
-        ;; a serious issue outside of unit tests that
-        ;; are mimicking both client and server pieces,
-        ;; which need to run this function in a separate
-        ;; thread.
-        (poll-servers! this timeout wait-for-cookie!)
-        log-state-atom (atom log-state)]
-    (println "client: triggered hello! polling")
-    (dfrd/chain #(into this (build-inner-vouch this))
-                ;; Got a Cookie back. Set things up to send a vouch
+  (println "hello: polling triggered")
+  ;; Note that this is going to block the calling
+  ;; thread. Which is annoying, but probably not
+  ;; a serious issue outside of unit tests that
+  ;; are mimicking both client and server pieces,
+  ;; which need to run this function in a separate
+  ;; thread.
+  (let [this (poll-servers! this timeout wait-for-cookie!)
+        ;; The flow-control below gets twisty
+        log-state-atom (atom nil)
+        inner-vouch-pieces (build-inner-vouch this)
+        this (into this inner-vouch-pieces)]
+    (dfrd/chain this  ; Q: What about the log-state-atom?
+                ;; Got a Cookie back. Set things up to send a vouch.
+                ;; This should trigger state/fork!
+                ;; But we're no longer getting back an Initiate
+                ;; packet.
                 servers-polled
-                ;; Cope with that send returning more than just the
+                ;; Cope with the fact that that send returns more than just the
                 ;; next deferred in the chain
                 (fn [{:keys [::specs/deferrable
                              ::log/state]
@@ -577,6 +622,8 @@
                                                                     {::sent sent})))
                   (if (not (or (= sent ::state/sending-vouch-timed-out)
                                (= sent ::state/drained)))
+                    ;; This feels more and more like it should move back into
+                    ;; the top-level client
                     (state/->message-exchange-mode (assoc this
                                                           ::log/state @log-state-atom)
                                                    sent)


Implement full-featured table component #45

--- src/flatgui/samples/forms/tablewin2.clj
+++ src/flatgui/samples/forms/tablewin2.clj
@@ -74,7 +74,13 @@
                  :text "?"
                  :children {:exp cell-expand-checkbox}
                  :evolvers {:text cell-text-evolver
-                            :atomic-state atomic-state-evolver}}))
+                            :atomic-state atomic-state-evolver
+                            ;; Strip some unneeded features
+                            :look nil
+                            :coord-map nil
+                            :accepts-focus? nil
+                            :has-mouse nil
+                            :enabled nil}}))

 (fg/defevolverfn scroll-cs-evolver :clip-size
   (let [ win-size (get-property [] :clip-size)]
@@ -85,7 +91,6 @@
                       :sizes header-model-size}
    :cell-prototype democell
    :position-matrix m/identity-matrix
-   ;:clip-size (m/defpoint 1 1)
    :background (awt/color 32 16 8)
    :evolvers {:header-model-loc table/shift-header-model-loc-evolver
               :clip-size scrollpanel/scrollpanelcontent-clip-size-evolver}} ;TODO bug: this evolver is not taken from scrollpanelcontent


Fixed unique constraint on prices

Fixed unique constraint on prices

--- src/hackerati_interval_web_app/jdbc.clj
+++ src/hackerati_interval_web_app/jdbc.clj
@@ -32,6 +32,7 @@
   (db-do-commands db (create-table-ddl :prices
                                             [:priceid :integer "PRIMARY KEY" "AUTO_INCREMENT"]
                                             [:productid :integer "references products (productid)"]
-                                            [:date "date" "UNIQUE"]
-                                            [:price "decimal(7,2)"])))
+                                            [:date "date"]
+                                            [:price "decimal(7,2)"]
+                                            :table-spec "constraint uc_price unqiue (productid, date)")))


small changes

small changes

--- examples/simple_todo/src/core.cljs
+++ examples/simple_todo/src/core.cljs
@@ -8,11 +8,11 @@
   {:id (str (gensym)), :text text})

 (defn tap-input [wire component]
-  (w/taps wire
-    {:event :keyboard-up :keypress :enter}
-      (fn [e]
-        (w/act wire :new-todo {:text (:value e)})
-        (set! (.-value (:target e)) ""))))
+  (-> wire
+      (w/tap {:event :keyboard-up :keypress :enter}
+             (fn [e]
+               (w/act wire :new-todo {:text (:value e)})
+               (set! (.-value (:target e)) "")))))

 (show/defclass TodoInput [component]
   (render [{:keys [wire]} state]
@@ -23,7 +23,7 @@
 (defn tap-item [wire component]
   (w/taps wire
     :mouse-double-click #(w/act wire :remove-todo)
-    :mouse-click #(show/update! component :selected not)))
+    :mouse-click        #(show/update! component :selected not)))

 (show/defclass Todo [component]
   (initial-state []
@@ -31,8 +31,8 @@
   (render [{:keys [text wire]}
            {:keys [selected]}]
     (wired/li (tap-item wire component)
-      {:className (show/class-map {"list-item" true, "selected" selected})}
-      text)))
+              {:className (show/class-map {"list-item" true, "selected" selected})}
+              text)))

 (show/defclass TodoList [component]
   (render [{:keys [todos wire]} state]


(PE-3680) Fixup failing tests due to missed rebase on merge of PE-3673

A pull request pertaining to work on PE-3673 was merged without first
rebasing based on conflicting changes from a pull request merged for
PE-3266.  This commit fixes up the failing tests to address the
conflict.

--- test/puppetlabs/kitchensink/core_test.clj
+++ test/puppetlabs/kitchensink/core_test.clj
@@ -64,12 +64,12 @@

 (deftest mkdirs-test
   (testing "creates all specified directories that don't exist"
-    (let [tmpdir (testutils/temp-dir)]
+    (let [tmpdir (temp-dir)]
       (fs/mkdirs (fs/file tmpdir "foo"))
       (mkdirs! (fs/file tmpdir "foo" "bar" "baz"))
       (is (fs/directory? (fs/file tmpdir "foo" "bar" "baz")))))
   (testing "throws exception if one of the elements of the path exists and is a file"
-    (let [tmpdir (testutils/temp-dir)]
+    (let [tmpdir (temp-dir)]
       (fs/mkdirs (fs/file tmpdir "foo"))
       (fs/touch (fs/file tmpdir "foo" "bar"))
       (try+
@@ -82,7 +82,7 @@
           (is (contains? m :message))
           (is (re-find #"foo/bar' is a file" (:message m)))))))
   (testing "Permission denied on some directory in the hierarchy"
-    (let [tmpdir (testutils/temp-dir)]
+    (let [tmpdir (temp-dir)]
       (fs/mkdirs (fs/file tmpdir "foo"))
       (fs/chmod "-w" (fs/file tmpdir "foo"))
       (try+


small typo fix

small typo fix

--- test/workshop/jobs/challenge_2_0_test.clj
+++ test/workshop/jobs/challenge_2_0_test.clj
@@ -13,7 +13,7 @@
 ;; http://www.onyxplatform.org/docs/user-guide/latest/information-model.html
 ;;
 ;;
-;; This challenge is an already-working example to get your started.
+;; This challenge is an already-working example to get you started.
 ;; It takes a stream of numbers and multiplies them by 2.
 ;; Go to the source file and read the comments about the catalog to get
 ;; an explanation about how it works.


back to sablono html

back to sablono html

--- frontend/components/landing_b.cljs
+++ frontend/components/landing_b.cljs
@@ -16,8 +16,9 @@
             [goog.dom]
             [goog.style]
             [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true])
-  (:require-macros [frontend.utils :refer [defrender html]]
+            [om.dom :as dom :include-macros true]
+            [sablono.core :as html :refer-macros [html]])
+  (:require-macros [frontend.utils :refer [defrender]]
                    [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                    [dommy.macros :refer [sel1 node]]))


Support cues with > 2 vars on Push UI.

Support cues with > 2 vars on Push UI.

Add an indicator and way of scrolling through all the cue variables two
at a time when there are more than two of them.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -629,6 +629,17 @@
         (set-pad-color controller x y color)
         (aset (:last-grid-pads controller) index color)))))

+(defn- cue-vars-for-encoders
+  "Find the correct cue variables that correspond to each of the two
+  encoders within a cue's display region, given the cue's variable
+  list and the offset by which the user has shifted the cue
+  variables."
+  [cue-vars var-offset]
+  (case (count cue-vars)
+    0 nil ; No variables to adjust
+    1 (vec (repeat 2 (first cue-vars)))
+    (vec (take 2 (drop var-offset (apply concat (repeat cue-vars)))))))
+
 (defn- fit-cue-variable-name
   "Picks the best version of a cue variable name to fit in the specified
   number of characters, then truncates it if necessary."
@@ -643,13 +654,14 @@
 (defn- cue-variable-names
   "Determines the names of adjustable variables to display under an
   active cue."
-  [cue]
-  (if (seq (:variables cue))
-    (if (= (count (:variables cue)) 1)
-      (fit-cue-variable-name (first (:variables cue)) 17)
-      (str (fit-cue-variable-name (first (:variables cue)) 8) " "
-           (fit-cue-variable-name (second (:variables cue)) 8)))
-    ""))
+  [controller cue effect-id]
+  (let [cue-vars (cue-vars-for-encoders (:variables cue) (get @(:cue-var-offsets controller) effect-id 0))]
+    (if (seq cue-vars)
+      (if (= (count (:variables cue)) 1)
+        (fit-cue-variable-name (first cue-vars) 17)
+        (str (fit-cue-variable-name (first cue-vars) 8) " "
+             (fit-cue-variable-name (second cue-vars) 8)))
+      "")))

 (defn- fit-cue-variable-value
   "Truncates the current value of a cue variable to fit available
@@ -680,12 +692,13 @@
   "Formats the current values of the adjustable variables to display
   under an active cue."
   [controller cue effect-id]
-  (if (seq (:variables cue))
-    (if (= (count (:variables cue)) 1)
-      (fit-cue-variable-value controller cue (first (:variables cue)) 17 effect-id)
-      (str (fit-cue-variable-value controller cue (first (:variables cue)) 8 effect-id) " "
-           (fit-cue-variable-value controller cue (second (:variables cue)) 8 effect-id)))
-    ""))
+  (let [cue-vars (cue-vars-for-encoders (:variables cue) (get @(:cue-var-offsets controller) effect-id 0))]
+    (if (seq cue-vars)
+      (if (= (count (:variables cue)) 1)
+        (fit-cue-variable-value controller cue (first cue-vars) 17 effect-id)
+        (str (fit-cue-variable-value controller cue (first cue-vars) 8 effect-id) " "
+             (fit-cue-variable-value controller cue (second cue-vars) 8 effect-id)))
+      "")))

 (defn- room-for-effects
   "Determine how many display cells are available for displaying
@@ -697,6 +710,10 @@
   "Display information about the four most recently activated
   effects (or three, if the metronome is taking up a slot)."
   [controller]
+
+  ;; First clean up any cue variable scroll offsets for effects that have ended
+  (swap! (:cue-var-offsets controller) select-keys (map :id (:meta @(:active-effects (:show controller)))))
+
   (let [room (room-for-effects controller)
         first-cell (- 4 room)
         fx-info @(:active-effects (:show controller))
@@ -710,12 +727,16 @@
             (let [effect (:effect (first fx))
                   info (first fx-meta)
                   ending ((:key info) (:ending fx-info))
-                  cue (:cue info)]
-              (write-display-cell controller 0 x (cue-variable-names cue))
+                  cue (:cue info)
+                  end-label (if ending " Ending  " "  End    ")
+                  scroll-vars (> (count (:variables cue)) 2)
+                  more-label (when scroll-vars (concat " More " [(:right-arrow special-symbols)]))]
+              (write-display-cell controller 0 x (cue-variable-names controller cue (:id info)))
               (write-display-cell controller 1 x (cue-variable-values controller cue (:id info)))
               (write-display-cell controller 2 x (or (:name cue) (:name (first fx))))
-              (write-display-cell controller 3 x (if ending " Ending" "  End"))
+              (write-display-cell controller 3 x (concat end-label more-label))
               (aset (:next-top-pads controller) (* 2 x) (top-pad-state :dim :red))
+              (when scroll-vars (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :dim :amber)))
               (when (seq (rest fx))
                 (recur (rest fx) (rest fx-meta) (inc x)))))
           ;; Draw indicators if there are effects hidden from view in either direction
@@ -1145,6 +1166,38 @@
                                    (handle-note-off [this message])
                                    (handle-aftertouch [this message])))))))

+(defn- handle-scroll-cue-vars
+  "Process a tap on one of the pads which indicate the user wants to
+  scroll forward in the list of cue variables."
+  [controller note]
+  (let [room (room-for-effects controller)
+        fx-info @(:active-effects (:show controller))
+        fx (vec (drop (- (count (:effects fx-info)) room) (:effects fx-info)))
+        fx-meta (vec (drop (- (count (:meta fx-info)) room) (:meta fx-info)))
+        offset (- 4 room)
+        x (quot (- note 21) 2)
+        index (- x offset)]
+    (when (and (seq fx) (< index (count fx)))
+      (let [effect (get fx index)
+            info (get fx-meta index)
+            cue (:cue info)
+            var-count (count (:variables cue))]
+        (when (> var-count 2)
+          (swap! (:cue-var-offsets controller) update-in [(:id info)] #(mod (+ 2 (or % 0)) var-count))
+          (controllers/add-overlay (:overlays controller)
+                                   (reify controllers/IOverlay
+                                     (captured-controls [this] #{note})
+                                     (captured-notes [this] #{})
+                                     (adjust-interface [this _]
+                                       (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :bright :amber))
+                                       true)
+                                     (handle-control-change [this message]
+                                       (when (and (= (:note message) note) (zero? (:velocity message)))
+                                         :done))
+                                     (handle-note-on [this message])
+                                     (handle-note-off [this message])
+                                     (handle-aftertouch [this message]))))))))
+
 (defn- move-origin
   "Changes the origin of the controller, notifying any registered
   listeners."
@@ -1170,6 +1223,10 @@
     (20 22 24 26) ; Effect end pads
     (when (pos? (:velocity message))
       (handle-end-effect controller (:note message)))
+
+    (21 23 25 27) ; Effect cue variable scroll pads
+    (when (pos? (:velocity message))
+      (handle-scroll-cue-vars controller (:note message)))

     ;; 28 ; Master button

@@ -1362,25 +1419,29 @@
 (defn- build-boolean-adjustment-overlay
   "Create an overlay for adjusting a boolean cue parameter. `note`
   identifies the encoder that was touched to bring up this overlay,
-  `cue` is the cue whose variable is being adjusted, `effect` is the
-  effect which that cue is running, and `info` is the metadata about
-  that effect."
-  [controller note cue effect info]
+  `cue` is the cue whose variable is being adjusted, `v` is the map
+  identifying the variable itself, `effect` is the effect which that
+  cue is running, and `info` is the metadata about that effect.
+
+  Also suppresses the ability to scroll through the cue variables
+  while the encoder is being held."
+  [controller note cue v effect info]
   (let [x (quot note 2)
         var-index (rem note 2)]
     (if (> (count (:variables cue)) 1)
       ;; More than one variable, adjust whichever's encoder was touched
       (reify controllers/IOverlay
-        (captured-controls [this] #{(control-for-top-encoder-note note)})
+        (captured-controls [this] #{(control-for-top-encoder-note note) (+ 21 (* 2 x))})
         (captured-notes [this] #{note})
         (adjust-interface [this _]
           (when (same-effect-active controller cue (:id info))
-            (draw-boolean-gauge controller x 8 (* 9 var-index)
-                                 cue (get (:variables cue) var-index) (:id info))
+            (draw-boolean-gauge controller x 8 (* 9 var-index) cue v (:id info))
+            (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
             true))
         (handle-control-change [this message]
-          (adjust-boolean-value controller message cue
-                                (get (:variables cue) var-index) (:id info)))
+          (when (= (:note message) (control-for-top-encoder-note note))
+            (adjust-boolean-value controller message cue v (:id info)))
+          true)
         (handle-note-on [this message])
         (handle-note-off [this message]
           :done)
@@ -1390,16 +1451,17 @@
       ;; suppress the other one.
       (let [paired-note (if (odd? note) (dec note) (inc note))]
         (reify controllers/IOverlay
-          (captured-controls [this] #{(control-for-top-encoder-note note)})
+          (captured-controls [this] #{(control-for-top-encoder-note note) (+ 21 (* 2 x))})
           (captured-notes [this] #{note paired-note})
           (adjust-interface [this _]
             (when (same-effect-active controller cue (:id info))
-              (draw-boolean-gauge controller x 17 0 cue
-                                   (first (:variables cue)) (:id info))
-              true))
+              (draw-boolean-gauge controller x 17 0 cue v (:id info)))
+            (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
+            true)
           (handle-control-change [this message]
-            (adjust-boolean-value controller message cue
-                                  (first (:variables cue)) (:id info)))
+            (when (= (:note message) (control-for-top-encoder-note note))
+              (adjust-boolean-value controller message cue v (:id info)))
+            true)
           (handle-note-on [this message]
             true)
           (handle-note-off [this message]
@@ -1410,25 +1472,29 @@
 (defn- build-numeric-adjustment-overlay
   "Create an overlay for adjusting a numeric cue parameter. `note`
   identifies the encoder that was touched to bring up this overlay,
-  `cue` is the cue whose variable is being adjusted, `effect` is the
-  effect which that cue is running, and `info` is the metadata about
-  that effect."
-  [controller note cue effect info]
+  `cue` is the cue whose variable is being adjusted, `v` is the map
+  identifying the variable itself, `effect` is the effect which that
+  cue is running, and `info` is the metadata about that effect.
+
+  Also suppresses the ability to scroll through the cue variables
+  while the encoder is being held."
+  [controller note cue v effect info]
   (let [x (quot note 2)
         var-index (rem note 2)]
     (if (> (count (:variables cue)) 1)
       ;; More than one variable, adjust whichever's encoder was touched
       (reify controllers/IOverlay
-        (captured-controls [this] #{(control-for-top-encoder-note note)})
+        (captured-controls [this] #{(control-for-top-encoder-note note) (+ 21 (* 2 x))})
         (captured-notes [this] #{note})
         (adjust-interface [this _]
           (when (same-effect-active controller cue (:id info))
-            (draw-variable-gauge controller x 8 (* 9 var-index)
-                                 cue (get (:variables cue) var-index) (:id info))
+            (draw-variable-gauge controller x 8 (* 9 var-index) cue v (:id info))
+            (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
             true))
         (handle-control-change [this message]
-          (adjust-variable-value controller message cue
-                                 (get (:variables cue) var-index) (:id info)))
+          (when (= (:note message) (control-for-top-encoder-note note))
+            (adjust-variable-value controller message cue v (:id info)))
+          true)
         (handle-note-on [this message])
         (handle-note-off [this message]
           :done)
@@ -1438,16 +1504,17 @@
       ;; suppress the other one.
       (let [paired-note (if (odd? note) (dec note) (inc note))]
         (reify controllers/IOverlay
-          (captured-controls [this] #{(control-for-top-encoder-note note)})
+          (captured-controls [this] #{(control-for-top-encoder-note note) (+ 21 (* 2 x))})
           (captured-notes [this] #{note paired-note})
           (adjust-interface [this _]
             (when (same-effect-active controller cue (:id info))
-              (draw-variable-gauge controller x 17 0 cue
-                                   (first (:variables cue)) (:id info))
+              (draw-variable-gauge controller x 17 0 cue v (:id info))
+              (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
               true))
           (handle-control-change [this message]
-            (adjust-variable-value controller message cue
-                                   (first (:variables cue)) (:id info)))
+            (when (= (:note message) (control-for-top-encoder-note note))
+              (adjust-variable-value controller message cue v (:id info)))
+            true)
           (handle-note-on [this message]
             true)
           (handle-note-off [this message]
@@ -1475,26 +1542,27 @@
 (defn- build-color-adjustment-overlay
   "Create an overlay for adjusting a color cue parameter. `note`
   identifies the encoder that was touched to bring up this overlay,
-  `cue` is the cue whose variable is being adjusted, `effect` is the
-  effect which that cue is running, and `info` is the metadata about
-  that effect."
-  [controller note cue effect info]
+  `cue` is the cue whose variable is being adjusted, `v` is the map
+  identifying the variable itself, `effect` is the effect which that
+  cue is running, and `info` is the metadata about that effect.
+
+  Also suppresses the ability to scroll through the cue variables
+  while the encoder is being held."
+  [controller note cue v effect info]
   (let [anchors (atom #{note})  ; Track which encoders are keeping the overlay active
         x (quot note 2)
-        var-index (min (rem note 2) (dec (count (:variables cue))))
-        cue-var (get (:variables cue) var-index)
         effect-id (:id info)]
     ;; Take full cell, using both encoders to adjust hue and saturation.
     (let [[hue-note sat-note] (if (odd? note) [(dec note) note] [note (inc note)])
           [hue-control sat-control] (map control-for-top-encoder-note [hue-note sat-note])]
       (reify controllers/IOverlay
-        (captured-controls [this] #{hue-control sat-control})
+        (captured-controls [this] #{hue-control sat-control (+ 21 (* 2 x))})
         (captured-notes [this] (clojure.set/union #{hue-note sat-note} (set (drop 36 (range 100)))))
         (adjust-interface [this _]
           (when (same-effect-active controller cue (:id info))
             ;; Draw the color picker grid
             (System/arraycopy color-picker-grid 0 (:next-grid-pads controller) 0 64)
-            (let [current-color (or (cues/get-cue-variable cue cue-var :show (:show controller) :when-id effect-id)
+            (let [current-color (or (cues/get-cue-variable cue v :show (:show controller) :when-id effect-id)
                                     (aget color-picker-grid 6))]
               ;; Show the preview color at the bottom right
               (aset (:next-grid-pads controller) 7 current-color)
@@ -1513,17 +1581,20 @@
                 (write-display-cell controller 0 x (str "H: " hue-str " S: " sat-str))
                 (write-display-text controller 1 (* x 17) hue-gauge)
                 (write-display-text controller 1 (+ 9 (* x 17)) sat-gauge))
+              ;; Darken the cue var scroll button if it was going to be lit
+              (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
               true)))
         (handle-control-change [this message]
-          ;; Adjust hue or saturation depending on controller
-          (let [current-color (or (cues/get-cue-variable cue cue-var :show (:show controller) :when-id effect-id)
-                                  (aget color-picker-grid 6))
-                delta (* (sign-velocity (:velocity message)) 0.5)]
-            (cues/set-cue-variable! cue cue-var
-                                    (if (= (:note message) hue-control)
-                                      (colors/adjust-hue current-color delta)
-                                      (colors/saturate current-color delta))
-                                    :show (:show controller) :when-id effect-id))
+          ;; Adjust hue or saturation depending on controller; ignore if it was the cue var scroll button
+          (when (#{hue-control sat-control} (:note message))
+            (let [current-color (or (cues/get-cue-variable cue v :show (:show controller) :when-id effect-id)
+                                    (aget color-picker-grid 6))
+                  delta (* (sign-velocity (:velocity message)) 0.5)]
+              (cues/set-cue-variable! cue v
+                                      (if (= (:note message) hue-control)
+                                        (colors/adjust-hue current-color delta)
+                                        (colors/saturate current-color delta))
+                                      :show (:show controller) :when-id effect-id)))
           true)
         (handle-note-on [this message]
           (let [note (:note message)]
@@ -1534,7 +1605,7 @@
               ;; It's a grid pad. Set the color based on the selected note, unless it's the preview pad.
               (when-not (= note 43)
                 (let [chosen-color (aget color-picker-grid (- note 36))]
-                  (cues/set-cue-variable! cue cue-var chosen-color :show (:show controller) :when-id effect-id)))))
+                  (cues/set-cue-variable! cue v chosen-color :show (:show controller) :when-id effect-id)))))
           true)
         (handle-note-off [this message]
           (swap! anchors disj (:note message))
@@ -1560,24 +1631,22 @@
       (let [effect (get fx index)
             info (get fx-meta index)
             cue (:cue info)
-            cue-var (case (count (:variables cue))
-                      0 nil ; No variables to adjust
-                      1 (first (:variables cue))
-                      (get (:variables cue) var-index))]
+            cue-vars (cue-vars-for-encoders (:variables cue) (get @(:cue-var-offsets controller) (:id info) 0))
+            cue-var (get cue-vars var-index)]
         (when cue-var
           (let [cur-val (cues/get-cue-variable cue cue-var :show (:show controller) :when-id (:id info))]
             (cond
               (or (number? cur-val) (#{:integer :float} (:type cue-var :float)))
               (controllers/add-overlay (:overlays controller)
-                                       (build-numeric-adjustment-overlay controller note cue effect info))
+                                       (build-numeric-adjustment-overlay controller note cue cue-var effect info))

               (or (= (type cur-val) :com.evocomputing.colors/color) (= (:type cue-var) :color))
               (controllers/add-overlay (:overlays controller)
-                                       (build-color-adjustment-overlay controller note cue effect info))
+                                       (build-color-adjustment-overlay controller note cue cue-var effect info))

               (or (= (type cur-val) Boolean) (= (:type cue-var) :boolean))
               (controllers/add-overlay (:overlays controller)
-                                       (build-boolean-adjustment-overlay controller note cue effect info))
+                                       (build-boolean-adjustment-overlay controller note cue cue-var effect info))

               :else  ; Something we don't know how to adjust
               nil)))))))
@@ -1729,6 +1798,7 @@
                :show                 show
                :origin               (atom [0 0])
                :effect-offset        (atom 0)
+               :cue-var-offsets      (atom {})
                :refresh-interval     refresh-interval
                :port-in              port-in
                :port-out             port-out
@@ -1849,4 +1919,3 @@
          :device-filter device-filter
          :cancel cancel-handler}
         {:type :push-watcher}))))
-


Handle ws: and wss:

Handle ws: and wss:

--- src/airhead_cljs/requests.cljs
+++ src/airhead_cljs/requests.cljs
@@ -60,8 +60,12 @@
 (get-updates!)

 (go
-  (let [host js/window.location.host
-        ws-path (str "ws://" host "/api/ws")
+  (let [location js/window.location
+        host     location.host
+        protocol location.protocol
+        ws-path (str (if (= protocol "https:")
+                       "wss://" "ws://")
+                     host "/api/ws")
         {:keys [ws-channel]} (<! (ws-ch ws-path {:format :json-kw}))]
     (loop []
       (let [{:keys [message]} (<! ws-channel)]


add additional constraints to output of (new-entries)

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2307,8 +2307,10 @@
                             :subcat {:2 {:cat :top}
                                      :3 '()}}}
                   (fn [lexeme]
-                    (dissoc-paths lexeme [[:synsem :sem :obj]
-                                          [:synsem :subcat :2]])))
+                    (unifyc
+                     (dissoc-paths lexeme [[:synsem :sem :obj]
+                                           [:synsem :subcat :2]])
+                     {:synsem {:subcat {:2 '()}}})))

                  (default ;; intransitive verbs' :obj is :unspec.
                   {:modal-with false


add lookup function

add lookup function

--- src/babel/italiano/grammar.clj
+++ src/babel/italiano/grammar.clj
@@ -4,7 +4,8 @@
    [babel.cache :refer [create-index]]
    [babel.enrich :refer [enrich]]
    [babel.italiano.lexicon :refer [lexicon]]
-   [babel.italiano.morphology :refer [fo]]
+   [babel.italiano.morphology :refer [analyze fo]]
+   [babel.parse :as parse]
    [babel.ug :refer :all]
    [clojure.tools.logging :as log]
    [dag-unify.core :refer (fail? get-in merge unifyc)]))
@@ -407,6 +408,8 @@
        :language "it"
        :language-keyword :italiano
        :morph fo
+       :lookup (fn [arg]
+                 (analyze arg lexicon))
        :enrich enrich
        :grammar grammar
        :lexicon lexicon
@@ -424,10 +427,21 @@
        :language "it"
        :language-keyword :italiano
        :morph fo
+       :lookup (fn [arg]
+                 (analyze arg lexicon))
        :enrich enrich
        :grammar grammar
        :lexicon lexicon
        :index (create-index grammar (flatten (vals lexicon)) head-principle)
        })))

+(defn toks [surface]
+  (parse/toks surface (:lexicon @small) (:lookup @small)))
+
+(defn parse [surface]
+  (parse/parse surface
+               (:lexicon @small)
+               (:lookup @small)
+               (:grammar @small)))
+
 (log/info "Italian grammar defined.")


fix permissions checking of recent threads

--- src/braid/server/db/thread.clj
+++ src/braid/server/db/thread.clj
@@ -160,8 +160,8 @@
             (t/minus (t/now) (t/weeks 1))
             thread-pull-pattern)
        (into ()
-             (comp (filter (comp (partial user-can-see-thread? conn user-id) :id))
-                   (map (comp db->thread first))
+             (comp (map (comp db->thread first))
+                   (filter (comp (partial user-can-see-thread? conn user-id) :id))
                    (map #(thread-add-last-open-at conn % user-id))))
        (sort-by (fn [t] (apply max (map (comp to-long :created-at) (t :messages))))
                 #(compare %2 %1))


nambah fitur download report

nambah fitur download report

--- src/clj/mobile_survey/core.clj
+++ src/clj/mobile_survey/core.clj
@@ -84,6 +84,22 @@
   (let [numbers (models/get-numbers-for-survey id)]
     (t/base (t/numbers-snippet numbers) '({}))))

+(defn create-report-file [survey-id]
+  (let [numbers (models/get-numbers-for-survey survey-id)
+        wb (xls/create-workbook "report" (cons ["Number" "Reply"]
+                                           (for [{:keys [number reply]} numbers]
+                                             [number reply])))
+        sheet (xls/select-sheet "report" wb)
+        header-row (first (xls/row-seq sheet))]
+    (do
+      (xls/set-row-style! header-row (xls/create-cell-style! wb {:background :yellow,
+                                                                 :font {:bold true}}))
+      (xls/save-workbook! (format "resources/public/temp/report_%d.xlsx" survey-id) wb))))
+
+(defn download-report-file [survey-id]
+  (create-report-file survey-id)
+  (redirect (format "/temp/report_%d.xlsx" survey-id)))
+
 (defn signout []
   (session/clear!)
   (redirect "/signin"))
@@ -97,4 +113,5 @@
         (create-survey (session/get :user_id) name descriptions content selectNumber incentiveOption numbersText numbersFile))
     (GET ["/detail/:id", :id #"[0-9]+"] [id]  (detail-survey (Integer/parseInt id)))
     (GET ["/delete/:id", :id #"[0-9]+"] [id] (delete-survey (Integer/parseInt id)))
-    (GET ["/numbers/:id", :id #"[0-9]+"] [id] (view-number (Integer/parseInt id))))
+    (GET ["/numbers/:id", :id #"[0-9]+"] [id] (view-number (Integer/parseInt id)))
+    (GET ["/download/report/:id", :id #"[0-9]+"] [id] (download-report-file (Integer/parseInt id))))


Fixed issuer name

Fixed issuer name

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -234,7 +234,7 @@
                                 :markdown_text criteria-text}]
                     :issuer   [{:id ""
                                 :language_code language
-                                :name (str (:name issuer) ": " (:org issuer))
+                                :name (:name issuer)
                                 :description (:description issuer)
                                 :url (:url issuer)
                                 :email (:contact issuer)
@@ -357,7 +357,7 @@
                                :markdown_text (http/alternate-get "text/x-markdown" criteria)}]
                    :issuer [{:id ""
                              :language_code ""
-                             :name (str (:name issuer) ": " (:org issuer))
+                             :name (:name issuer)
                              :description (:description issuer)
                              :url (:url issuer)
                              :email (:contact issuer)


compiler-stats work, print only 2 decimal places

--- src/cljs/bundled/lumo/util.clj
+++ src/cljs/bundled/lumo/util.clj
@@ -5,9 +5,11 @@
   {:added "1.0"}
   ([msg expr] `(measure true ~msg ~expr))
   ([enable msg expr]
-    `(if ~enable
-       (let [start# (cljs.core/system-time)
-             ret# ~expr]
-         (debug-prn (str ~msg ", elapsed time:") (- (cljs.core/system-time) start#) "msecs")
-         ret#)
-       ~expr)))
+   `(if ~enable
+      (let [start# (cljs.core/system-time)
+            ret# ~expr]
+        (debug-prn (str ~msg ", elapsed time:")
+          (.toFixed (- (cljs.core/system-time) start#) 2)
+          "msecs")
+        ret#)
+      ~expr)))


Switch to putting typed message on the channel that handles clicks, we can now handle other events

--- src/cljs/chess/components.cljs
+++ src/cljs/chess/components.cljs
@@ -19,14 +19,14 @@
     (display-name [_]
       "piece")))

-(defn square [[id p selected] owner {:keys [click-chan]}]
+(defn square [[id p selected] owner {:keys [action-chan]}]
   (reify
     om/IRender
     (render [_]
       (dom/div
        #js {:className (str "square" (if selected " selected"))
             :id        id
-            :onClick   #(put! click-chan id)}
+            :onClick   #(put! action-chan {:type :click :square id})}
        (if p
          (om/build piece p))))
     om/IDisplayName
@@ -37,34 +37,38 @@
   (reify
     om/IInitState
     (init-state [_]
-      {:click-chan (chan)})
+      {:action-chan (chan)})
     om/IRenderState
-    (render-state [this {click-chan :click-chan selected :selected}]
+    (render-state [this {action-chan :action-chan selected :selected}]
       (apply dom/div #js {:className "board"}
              (map
                (fn
                  [r]
                  (apply dom/div #js {:className "row"}
-                        (om/build-all square r {:opts {:click-chan click-chan}})))
+                        (om/build-all square r {:opts {:action-chan action-chan}})))
                (->> game
                     squares-and-pieces
                     (map (fn [[s p]] [s p (= s selected)]))
                     as-rows))))
     om/IDidMount
     (did-mount [_]
-      (let [click-chan (om/get-state owner :click-chan)]
+      (let [action-chan (om/get-state owner :action-chan)]
         (go-loop []
-                 (let [new-selection (<! click-chan)
-                       old-selection (om/get-state owner :selected)]
-                   (if old-selection
-                     (do
-                       (om/transact! app-state
-                                     (fn [{:keys [game hist]}]
-                                       {:game (move game old-selection new-selection)
-                                        :hist (vec (conj (seq hist) game))}))
-                       (om/set-state! owner :selected nil))
-                     (if (in (deref game) new-selection)
-                       (om/set-state! owner :selected new-selection))))
+                 (let [message (<! action-chan)
+                       message-type (message :type)]
+                   (println message-type)
+                   (condp = message-type
+                     :click (let [new-selection (message :square)
+                                  old-selection (om/get-state owner :selected)]
+                              (if old-selection
+                                (do
+                                  (om/transact! app-state
+                                                (fn [{:keys [game hist]}]
+                                                  {:game (move game old-selection new-selection)
+                                                   :hist (vec (conj (seq hist) game))}))
+                                  (om/set-state! owner :selected nil))
+                                (if (in (deref game) new-selection)
+                                  (om/set-state! owner :selected new-selection))))))
                  (recur))))
     om/IDisplayName
     (display-name [_]


Split rendering into Om components

Split rendering into Om components

--- src/cljs/communitics/core.cljs
+++ src/cljs/communitics/core.cljs
@@ -28,6 +28,22 @@
      :on-complete cb}))

+(defn user-view [user]
+  (reify
+    om/IRender
+    (render [_]
+      (dom/li nil (pr-str user)))))
+
+(defn users-view [users]
+  (reify
+    om/IRender
+    (render [_]
+      (dom/div nil
+               (dom/h1 nil "Github")
+               (dom/h3 nil (count users) " users")
+               (apply dom/ul nil
+                      (om/build-all user-view users))))))
+
 (om/root
   (fn [app owner]
     (reify
@@ -53,8 +69,9 @@
                           (fn [_]
                             (call-server
                               (fn [res]
+                                (println "Start crawling github for users")
                                 (om/transact! app :crawl-result (fn [_] res))
-                                (println "Craw github:" (:crawl-result @app)))
+                                (println "Crawled github, found " (:crawl-result @app)))
                               "/crawl"))}
                      "Crawl Github")
                    (dom/button
@@ -69,15 +86,13 @@
                               "/clear-database"))}
                      "Clear database")
                    (dom/label nil (str "Crawled and imported " (pr-str (:import-count (:crawl-result app))) " users."))
-                   #_(dom/textarea #js {:value (pr-str (:users app))}))
-          (dom/div nil
-                   (dom/h1 nil "Github")
-                   (dom/h3 nil (count (:users app)) " users")
-                   (apply dom/ul nil
-                          (map #(dom/li nil (pr-str %)) (:users app)))))
-        )))
+                   #_(dom/textarea #js {:value (pr-str (:users app))})
+                   (om/build users-view (:users app)))
+          ))))
   app-state
   {:target (. js/document (getElementById "app"))})
+
+

 (defn foo [v]


minor

minor

--- src/cljs/db_quiz/geometry.cljs
+++ src/cljs/db_quiz/geometry.cljs
@@ -34,7 +34,6 @@
 (defn path-travelled
   "Returns points up to distance travelled."
   ; FIXME: Refactor nasty sequence manipulations.
-  ; TODO: Add test (= (path-length *result*) distance-travelled)
   [path distance-travelled]
   {:pre [; Every path segment needs to have at least 2 points.
          (every? (partial < 1) (map count path))


Fixed mutating dom error with status update

--- src/cljs/file_upload/core.cljs
+++ src/cljs/file_upload/core.cljs
@@ -30,10 +30,10 @@
              :id "upload-file"}]]])

 (defn set-upload-indicator []
-  (session/put! :upload-status [:div
-                                [:h4 "Upload In Progress"]
-                                [:p [:span.fa.fa-spinner.fa-spin.fa-pulse.fa-4x]]
-                                [:p]]))
+  (let [class "fa fa-spinner fa-spin fa-pulse"]
+    (session/put! :upload-status [:div
+                                  [:p "Uploading file... "
+                                   [:span {:class class}]]])))

 (defn into-list [items]
   (into [:ul]
@@ -43,28 +43,27 @@
 (defn set-status [class title items]
   [:div {:class class}
    [:h4 title]
-   [:p (into-list items)]])
+   (into-list items)])

 ;;; cljs-ajax upload routines
 (defn handle-response-ok [resp]
   (let [rsp (js->clj resp :keywordize-keys true)
-        items [(str "Filename: " (:filename rsp))
-               (str "Size: " (:size rsp))
-               (str "Tempfile: " (:tempfile rsp))]]
-    (session/put! :upload-status (set-status "alert alert-success"
-                                             "Upload Successful"
-                                             items))))
+        status (set-status "alert alert-success"
+                           "Upload Successful"
+                           [(str "Filename: " (:filename rsp))
+                            (str "Size: " (:size rsp))
+                            (str "Tempfile: " (:tempfile rsp))])]
+    (session/put! :upload-status status)))

 (defn handle-response-error [ctx]
   (let [rsp (js->clj (:response ctx) :keywordize-keys true)
-        items [(str (:status ctx) " "
-                    (:status-text ctx))
-               (str (:message rsp))]]
-    (.log js/console (str "cljs-ajax error: " (:status ctx) " "
-                          (:status-text ctx) " " (:message rsp)))
-    (session/put! :upload-status (set-status "alert alert-danger"
-                                             "Upload Failure"
-                                             items))))
+        status (set-status "alert alert-danger"
+                           "Upload Failure"
+                           [(str "Status: " (:status ctx) " "
+                                 (:status-text ctx))
+                            (str (:message rsp))])]
+    (.log js/console (str "cljs-ajax error: " status))
+    (session/put! :upload-status status)))

 (defn cljs-ajax-upload-file [element-id]
   (let [el (.getElementById js/document element-id)
@@ -89,19 +88,19 @@

 ;;; goog.net.IFrameIO routines
 (defn iframe-response-ok [msg]
-  (let [items [(str "Filename: " (:filename msg))
-               (str "Size: " (:size msg))
-               (str "Tempfile: " (:tempfile msg))]]
-    (session/put! :upload-status (set-status "alert alert-success"
-                                             "Upload Successful"
-                                             items))))
+  (let [status (set-status "alert alert-success"
+                           "Upload Successful"
+                           [(str "Filename: " (:filename msg))
+                            (str "Size: " (:size msg))
+                            (str "Tempfile: " (:tempfile msg))])]
+    (session/put! :upload-status status)))

 (defn iframe-response-error [msg]
-  (let [items [(str "Status: " (:status msg))
-               (str (:message msg))]]
-    (session/put! :upload-status (set-status "alert alert-danger"
-                                             "Upload Failure"
-                                             items))))
+  (let [status (set-status "alert alert-danger"
+                           "Upload Failure"
+                           [(str "Status: " (:status msg))
+                            (str (:message msg))])]
+    (session/put! :upload-status status)))

 (defn handle-iframe-response [json-msg]
   (let [msg (js->clj json-msg :keywordize-keys true)]
@@ -121,6 +120,8 @@
         iframe (IframeIo.)]
     (events/listen iframe goog.net.EventType.COMPLETE
                    (fn [event]
+                     (let [rsp (.getResponseJson iframe)
+                           status ()])
                      (handle-iframe-response (.getResponseJson iframe))
                      (.dispose iframe)))
     (set-upload-indicator)


formatting

formatting

--- src/cljs/greffe/doc_comps.cljs
+++ src/cljs/greffe/doc_comps.cljs
@@ -84,13 +84,14 @@
            (when (:showButton state)
              (dom/div #js {:className "controls"}
                (let [elem-as-text (gm/to-gmark elem tei)]
-                 (dom/a #js {:onClick (fn [ev]
-                                        (om/set-state! owner :editContent elem-as-text)
-                                        (om/set-state!
-                                          owner
-                                          :editText
-                                          (not (om/get-state owner :editText))))}
-                  "Editer"))))
+                 (dom/a #js {:onClick
+                             (fn [ev]
+                               (om/set-state! owner :editContent elem-as-text)
+                               (om/set-state!
+                                 owner
+                                 :editText
+                                 (not (om/get-state owner :editText))))}
+                   "Editer"))))
            (when (:editText state)
              (dom/textarea #js {:value (:editContent state)
                                 :cols "50" :rows "3"


remove ranker require on subdb

remove ranker require on subdb

--- src/cljs/sm/sources/subdb.cljs
+++ src/cljs/sm/sources/subdb.cljs
@@ -1,6 +1,6 @@
 (ns sm.sources.subdb
   (:require-macros [wilkerdev.util.macros :refer [<? go-catch]])
-  (:require [sm.protocols :refer [SearchProvider UploadProvider Subtitle Linkable Ranker]]
+  (:require [sm.protocols :refer [SearchProvider UploadProvider Subtitle Linkable]]
             [wilkerdev.util.nodejs :refer [lstat fopen fread http] :as node]
             [wilkerdev.util :as util]))