helpers to work with db component in dev

--- dev/user.clj
+++ dev/user.clj
@@ -9,6 +9,7 @@
             [ring.middleware.stacktrace :as stacktrace]
             [foosball.system :as system]
             [foosball.models.db :as db]
+            [foosball.models.domains.openids :as openid]
             [dev-data :as d]
             [taoensso.timbre :as timbre]
             [taoensso.timbre.appenders (socket :as socket-appender)]
@@ -66,7 +67,14 @@
   []
   (cemerick.austin.repls/cljs-repl repl-env))

-(defn delete-database-and-stop []
+(defn delete-database-and-stop! []
   (db/delete! (:db system))
   (stop)
   :ok)
+
+
+(defn conn []
+  (get-in system [:db :connection]))
+
+(defn db []
+  (datomic.api/db (conn)))


Log notification response

Log notification response

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -364,7 +364,7 @@
         (when (granted-is "default")
           [:div.section
            "You haven't given CircleCI access to notify you through the browser — "
-           [:a {:href "javascript:void(0)", :on-click #(notifs/request-permission (fn [response] (when (notifs/notifications-granted) (raise! owner [:turn-notifs-on]))))} "click here to turn permissions on."]])
+           [:a {:href "javascript:void(0)", :on-click #(notifs/request-permission (fn [response] (utils/mlog "Notifications are now: " response) (when (notifs/notifications-granted) (raise! owner [:turn-notifs-on]))))} "click here to turn permissions on."]])
         [:div.section
          [:form
           [:div.radio


Contain story stats horizontally.

Contain story stats horizontally.

--- src-cljs/frontend/components/stories.cljs
+++ src-cljs/frontend/components/stories.cljs
@@ -40,19 +40,14 @@
              [:br]
              "John, Director of Engineering, Shopify"]]]]]

-        #_ [:div.outer-section
+        [:div.outer-section
          [:section.container
-          [:h2.text-center "A better way to build and deploy applications"]
-          (om/build docker-diagram app)
-          ]]
-
-        [:div.outer-section
-         [:div.stories-stats
-          [:dl
-           [:dt "Developers"] [:dd "1,300"]
-           [:dt "Funding"]    [:dd "122m"]
-           [:dt "Technology"] [:dd "Ruby"]
-           [:dt "Past Setup"] [:dd "Internal"]]]
+          [:div.stories-stats
+           [:dl
+            [:dt "Developers"] [:dd "1,300"]
+            [:dt "Funding"]    [:dd "122m"]
+            [:dt "Technology"] [:dd "Ruby"]
+            [:dt "Past Setup"] [:dd "Internal"]]]]

          [:section.container
           [:h2 "Background"]


NodeInRedis->NodeView

NodeInRedis->NodeView

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -335,7 +335,7 @@
          reserve-after-create nil
          current-url nil}
     :as requirements}]
-  (s/validate (s/maybe NodeInRedis) node)
+  (s/validate (s/maybe NodeView) node)
   (info (format "Creating a new session.\nRequirements: %s"
                 (str requirements)))
   (if (= 0 (count (nodes/nodes-under-capacity)))


Add selenium tests for build-file project.

--- src/cljs/hatnik/web/client/form/project_menu.cljs
+++ src/cljs/hatnik/web/client/form/project_menu.cljs
@@ -33,7 +33,7 @@
 (defn build-file-body-addition [project]
   [(u/form-field {:data project
                   :field :build-file
-                  :id "project-name"
+                  :id "build-file"
                   :title "Build file"
                   :type :text
                   :validator (schm/string-of-length 1 1028)


fix comments inflection

fix comments inflection

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -272,7 +272,7 @@

            [:p.issue-foot
             [:a {:role "button"}
-             (str comment-count " comment" (when (< 1 comment-count) "s"))]
+             (str comment-count " comment" (when (not= 1 comment-count) "s"))]
             [:span " for "]
             [:a {:role "button"}
              ; "feature"


Mouse button 2 can also zoom

Mouse button 2 can also zoom

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/draw/nodes_and_connections.clj
+++ src/conexp/contrib/draw/nodes_and_connections.clj
@@ -412,6 +412,7 @@
 	(.event zoom-obj scn evt x y)
 	(when (and scn
                    (or (= evt GWindow/BUTTON1_UP)
+                       (= evt GWindow/BUTTON2_UP)
                        (= evt GWindow/BUTTON3_UP)))
 	  (call-scene-hook scn :zoom)
 	  (call-scene-hook scn :image-changed))))))


Improve docs for [line]

Improve docs for [line]

--- src/re_demo/line.cljs
+++ src/re_demo/line.cljs
@@ -29,7 +29,8 @@
                            :gap      "10px"
                            :children [[component-title "Demo"]
                                       [paragraphs
-                                       [:span "Here is some sample code..."]]
+                                       [:p "Look at the title up the top, and notice the line under it."]
+                                       [:p "Here is some sample code..."]]
                                       [:pre
                                        {:style {:width "40em"}}
 "[h-box


Complete equalities koans test

Complete equalities koans test

--- clojure/koans/src/koans/01_equalities.clj
+++ clojure/koans/src/koans/01_equalities.clj
@@ -1,21 +1,21 @@
 (meditations
   "We shall contemplate truth by testing reality, via equality."
-  (= __ true)
+  (= true true)

   "To understand reality, we must compare our expectations against reality."
-  (= __ (+ 1 1))
+  (= 2 (+ 1 1))

   "You can test equality of many things"
-  (= (+ 3 4) __ (+ 2 __))
+  (= (+ 3 4) 7 (+ 2 5))

   "Some things may appear different, but be the same"
-  (= 2 2/1 __)
+  (= 2 2/1 6/3)

   "You cannot generally float to heavens of integers"
-  (= __ (= 2 2.0))
+  (= false (= 2 2.0))

   "But a looser equality is also possible"
-  (== 2.0 2 __)
+  (== 2.0 2 2/1)

   "When things cannot be equal, they must be different"
-  (not= :fill-in-the-blank __))
+  (not= :fill-in-the-blank :blank-filled))


selfdual.clj: added a convexity test

selfdual.clj: added a convexity test

--- clojure/org/gavrog/clojure/selfdual2d.clj
+++ clojure/org/gavrog/clojure/selfdual2d.clj
@@ -35,15 +35,15 @@
   (let [t (face-sizes ds)]
     (and (<= (count (unique t)) 2) (some #(= 3 %) t))))

-(defn good-net? [ds]
-  (try (do (.getSkeleton (Tiling. ds)) true)
-    (catch IllegalArgumentException e false)))
+(defn- good-node [net pos v]
+  (not (empty? (.goodCombinations net (.allIncidences net v) pos))))

-;;TODO this does not work
-(defn non-disk-face-free? [ds]
-  (let [ds (Covers/toroidalCover2D ds)
-        fq (frequencies (map second (face-vertex-signatures ds)))]
-    (not (some #(> (second %) 2) fq))))
+(defn convex? [ds]
+  (if-let [net (try (.getSkeleton (Tiling. ds))
+                 (catch IllegalArgumentException e))]
+    (let [pos (.barycentricPlacement net)]
+      (every? (partial good-node net pos)
+              (.nodes net)))))

 (defn andp [& preds]
   (fn [& args]
@@ -58,7 +58,7 @@
 ;; All self-dual, 2d euclidean tilings with only two face sizes and at least
 ;; one triangle.
 (defn d-syms [max-size]
-  (let [good? (andp self-dual? minimal? euclidean? good-face-sizes? good-net?)]
+  (let [good? (andp self-dual? minimal? euclidean? good-face-sizes? convex?)]
     (for [dset (d-sets max-size)
           dsym (lazy-seq (DefineBranching2d. dset 3 3 Whole/ZERO))
           :when (good? dsym)]


Clean up

Clean up

--- src/all/cider_ci/server/socket/front.cljs
+++ src/all/cider_ci/server/socket/front.cljs
@@ -19,16 +19,6 @@
     [timothypratley.patchin :refer [diff patch]]
     ))

-(defonce push-pending? (atom false))
-
-(def client-state-push-to-server-keys [:current-page])
-
-(add-watch
-  client-state :set-push-pending
-  (fn [_ _ old-state new-state]
-    (when (not= (select-keys old-state client-state-push-to-server-keys)
-                (select-keys new-state client-state-push-to-server-keys))
-      (reset! push-pending? true))))

 (declare chsk ch-chsk chsk-send! chsk-state)

@@ -67,21 +57,6 @@
                            (assoc new-state :updated_at (js/moment))))
       nil))

-(defn push-to-server []
-  (if-not @push-pending?
-    (js/setTimeout push-to-server 200)
-    (do (reset! push-pending? false)
-        (swap! state/socket* assoc :msg_sent_at (js/moment))
-        (chsk-send! [:client/state
-                     {:full (select-keys @client-state
-                                         client-state-push-to-server-keys)}]
-                    1000
-                    (fn [reply]
-                      ;(js/console.log (with-out-str (pprint ["push-to-server/reply" reply])))
-                      (when-not (sente/cb-success? reply)
-                        (reset! push-pending? true))
-                      (js/setTimeout push-to-server 200))))))
-

 ;;; routing state ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -95,7 +70,7 @@
     (chsk-send! [:front/routing-state (dissoc @state/routing-state* :page)]
                 1000
                 (fn [reply]
-                  (js/console.log (with-out-str (pprint ["push-routing-state-to-server!/reply" reply])))
+                  ;(js/console.log (with-out-str (pprint ["push-routing-state-to-server!/reply" reply])))
                   (when-not (sente/cb-success? reply)
                     (set-push-routing-state-pending))))
     (set-push-routing-state-pending)))
@@ -126,7 +101,6 @@
   (sente/start-chsk-router! ch-chsk event-msg-handler)
   ; doesn't work here because socket is not open yet
   (start-push-routing-state-to-server)
-  ;(js/setTimeout push-to-server 100)
   )

@@ -164,9 +138,6 @@
      [:section.active
       [:h3 "@state/socket-active?*"]
       [pre-component-pprint @state/socket-active?*]]
-     [:section.push-pending
-      [:h3 "@push-pending?"]
-      [pre-component-pprint @push-pending?]]
      [:section.state-socket
       [:h3 "@state/socket*"]
       [pre-component-pprint @state/socket*]]]]


ensure clojure is in uberjar

ensure clojure is in uberjar

--- ssclj/tools/build.boot
+++ ssclj/tools/build.boot
@@ -22,7 +22,7 @@
   #(vec (concat %
                 (merge-defaults
                   ['sixsq/default-deps (get-env :version)]
-                  '[[org.clojure/clojure]
+                  '[[org.clojure/clojure :scope "compile"]
                     [org.clojure/data.xml]
                     [org.clojure/tools.cli]


parallel use of popNextImage

parallel use of popNextImage

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

--- acqEngine/src/org/micromanager/test.clj
+++ acqEngine/src/org/micromanager/test.clj
@@ -1,5 +1,6 @@
 (ns org.micromanager.test
   (:import (java.util List)
+           (java.util.concurrent Executors)
            (mmcorej TaggedImage)
            (org.json JSONObject)
            (org.micromanager MMStudioMainFrame)
@@ -104,12 +105,35 @@

 (defn test-speed [n]
   (do (core startSequenceAcquisition n 0 true)
-      (time (def q (doall (take-while identity (pop-n n))))))
-  (println (count q) (core isBufferOverflowed)))
+      (time (dotimes [i n] (pop-next))))
+  (println (core isBufferOverflowed)))

-(defn simple-test [n]
+(defn fill-circular-buffer [n]
   (core startSequenceAcquisition n 0 true)
-  (while (core isSequenceRunning) (Thread/sleep 10))
+  (while (core isSequenceRunning) (Thread/sleep 10)))
+
+(defn single-thread-pop-test [n]
+  (fill-circular-buffer n)
   (time (dotimes [i n]
           (core popNextImage))))

+
+(defn multithread-pop [nthreads n]
+  (fill-circular-buffer n)
+  (let [pop-service (Executors/newFixedThreadPool nthreads)
+        pop-fn (cast Runnable #(core popNextImage))]
+    (time
+      (do
+        (dotimes [i n]
+          (.submit pop-service pop-fn))
+        (while (pos? (core getRemainingImageCount))
+          (Thread/sleep 1))))))
+
+(defn repeat-with-params [f & more]
+  (doseq [[n args] (partition 2 more)]
+    (println n args)
+    (doall
+      (repeatedly n #(apply f args)))))
+
+
+


use .edn-based generation for imperfect

use .edn-based generation for imperfect

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -1099,42 +1099,13 @@
        (get-in word '(:italiano))))

 (defn regular-imperfect [word]
-  (let [infinitive (if (get-in word [:infinitive]) ;; imperfect
-                     (get-in word [:infinitive])
-                     (get-in word [:italiano]))
-        ;; e.g.: lavarsi => lavare
-        infinitive (if (re-find #"[aei]rsi$" infinitive)
-                     (string/replace infinitive #"si$" "e")
-                     infinitive)
-        person (get-in word '(:agr :person))
-        number (get-in word '(:agr :number))
-        stem (stem-for-imperfect infinitive)]
-    (cond
-      (and (= person :1st) (= number :sing))
-      (str stem "vo")
-
-      (and (= person :2nd) (= number :sing))
-      (str stem "vi")
-
-      (and (= person :3rd) (= number :sing))
-      (str stem "va")
-
-      (and (= person :1st) (= number :plur))
-
-      (str stem "vamo")
-
-      (and (= person :2nd) (= number :plur))
-      (str stem "vate")
-
-      (and (= person :3rd) (= number :plur))
-      (str stem "vano")
-
-      (string? infinitive)
-      (str infinitive )
-
-      :else
-      (clojure.core/merge word
-                          {:error 1}))))
+  (let [unifying-patterns
+        (remove nil? (mapcat #(if (not (= :fail (unify (:u %) word)))
+                                (:g %))
+                             regular-imperfect-generate-patterns))
+        infinitive (get-in word [:italiano])]
+    (first (remove nil? (do-replace-on infinitive unifying-patterns)))))
+
 (defn passato-as-head? [word]
   ;; "fare [past]" + "bene" => "fatto bene"
   (and (= (get-in word '(:cat)) :verb)


add support for mongolab | fs | #3

add support for mongolab | fs | #3

--- src/clj/conference_rating/db_handler.clj
+++ src/clj/conference_rating/db_handler.clj
@@ -3,9 +3,15 @@
                  [monger.collection :as mc])
         (:import org.bson.types.ObjectId))

+(def mongolab-uri (System/getenv "MONGOLAB_URI"))
+
+(defn- connect []
+  (if mongolab-uri
+    (mg/connect {:uri mongolab-uri })
+    (mg/connect {:host "127.0.0.1" :port 27017})))

 (defn add-conference []
-  (let [conn (mg/connect {:host "127.0.0.1" :port 27017})
+  (let [conn (connect)
         db   (mg/get-db conn "crdb")
         document { :_id (ObjectId.) :name "Devoxx" :description "Devoxx is a conference" }]
     (mc/insert db "conferences" document)


Fixing require for real in embedded-ai

Fixing require for real in embedded-ai

--- src/clj/zetawar/players/embedded_ai.cljs
+++ src/clj/zetawar/players/embedded_ai.cljs
@@ -1,10 +1,12 @@
 (ns zetawar.players.embedded-ai
   (:require
-   [cljs.core.async :as async :refer [go-loop]]
+   [cljs.core.async :as async]
    [datascript.core :as d]
    [taoensso.timbre :as log]
    [zetawar.app :as app]
-   [zetawar.game :as game]))
+   [zetawar.game :as game])
+  (:require-macros
+   [cljs.core.async.macros :refer [go go-loop]]))

 #_(defn handle-event* [{:as player-ctx :keys []} msg]
     (let [ev-ctx (assoc player-ctx :db @conn)


Make certain incorrect optimisation calls throw earlier

It is very easy to forget that the optimisation functions sgd-clojure,
adadelta-clojure, etc. must be *called* in order to obtain an optimiser.
If you do forget, it is often hard to debug the error, since functions
can *also* be optimisers, but with a different interface. This commit
introduces a check to see if you have accidentally passed a function
which returns an optimiser map or function, and to throw an informative
error in that situation.

--- cortex/src/cortex/optimise/optimisers.clj
+++ cortex/src/cortex/optimise/optimisers.clj
@@ -44,7 +44,12 @@
   (compute-parameters [this gradient parameters]
     (cp/compute-parameters
       {:update (fn [state gradient]
-                 (update state :params this gradient))}
+                 (let [state (update state :params this gradient)]
+                   ;; This makes it much easier to debug a common mistake:
+                   (when (map? (:params state))
+                     (throw (IllegalStateException.
+                              "fn acting as optimiser must return vector: did you need to call the fn to produce an optimiser map or fn?")))
+                   state))}
       gradient
       parameters)))


restore delayed processing

restore delayed processing

--- src/clj/clj_money/models/transactions.clj
+++ src/clj/clj_money/models/transactions.clj
@@ -531,7 +531,7 @@
                    new-balance)
             [new-index new-balance]))))))

-(defn- recalculate-account
+(defn recalculate-account
   "Recalculates statistics for items in the the specified account
   as of the specified date"
   [storage account-id as-of]
@@ -555,6 +555,16 @@
   (->> (:items transaction)
        (map :account-id)
        (into #{})))
+
+(defn- save-delayed-info
+  [settings {:keys [entity-id transaction-date] :as transaction}]
+  (-> settings
+      (update-in [entity-id :delayed-account-ids]
+                 concat
+                 (extract-account-ids transaction))
+      (update-in [entity-id :earliest-date] #(if %
+                                               (earlier % transaction-date)
+                                               transaction-date))))

 (defn create
   "Creates a new transaction"
@@ -576,11 +586,7 @@
                       (map before-save-item)
                       (map #(create-transaction-item* s %))))
           (if (delay-balances? (:entity-id validated))
-            (swap! ambient-settings
-                   update-in
-                   [(:entity-id validated) :delayed-account-ids]
-                   concat
-                   account-ids)
+            (swap! ambient-settings #(save-delayed-info % validated))
             (doseq [account-id account-ids]
               (recalculate-account s account-id (:transaction-date validated))))
           (reload s created))))))
@@ -828,11 +834,12 @@
      (let [result# (do ~@body)]

        ; Recalculate balances for affected accounts
-       ; TODO rework to use recalculate-account
-       #_(->> (get-in @ambient-settings [~entity-id :delayed-account-ids])
-            (map #(hash-map :account-id % :index -1 :balance 0M))
-            (map #(recalculate-account-items ~storage-spec %))
-            doall)
+       (let [{account-ids# :delayed-account-ids
+              as-of# :earliest-date} (get @ambient-settings ~entity-id)]
+
+         (with-transacted-storage [s# ~storage-spec]
+           (doseq [account-id# account-ids#]
+             (recalculate-account s# account-id# as-of#))))

        ; clean up the ambient settings as if we were never here
        (swap! ambient-settings dissoc ~entity-id)


fix nan

fix nan

--- src/cljs/bills_to_beans/transactions.cljs
+++ src/cljs/bills_to_beans/transactions.cljs
@@ -38,7 +38,7 @@
              (format "%.2f" (* -1 (get-in @data [:postings changed-idx :amount]))))
       (swap! data assoc-in
              [:postings other-idx :currency]
-             (format "%.2f" (get-in @data [:postings changed-idx :currency])))
+             (get-in @data [:postings changed-idx :currency]))
       )))

 (defn <posting-amount> [idx data ui-state]


Don't preventDefault on every event for lesson 10, I like to refresh via the keyboard. Also, don't print out so much to the console.

--- src/cljs/gampg/learn_gamma/lesson_10.cljs
+++ src/cljs/gampg/learn_gamma/lesson_10.cljs
@@ -467,9 +467,8 @@
                                                                 :s     [:forward -0.001]
                                                                 :down  [:forward -0.001]
                                                                 nil)]
-                                        (.preventDefault event)
-                                        (println [:movement direction] speed)
                                         (when direction
+                                          (.preventDefault event)
                                           (swap! state assoc-in [:movement direction] speed)))))
       (js/document.addEventListener "keyup"
                                     (fn [event]
@@ -493,8 +492,7 @@
                                                                 :s     [:forward 0.0]
                                                                 :down  [:forward 0.0]
                                                                 nil)]
-                                        (.preventDefault event)
-                                        (println [:movement direction] speed)
                                         (when direction
+                                          (.preventDefault event)
                                           (swap! state assoc-in [:movement direction] speed))))))))


Adding numeric range to the list of required validators so that it will work in CI.

--- src/cmr/search/services/query_service.clj
+++ src/cmr/search/services/query_service.clj
@@ -26,6 +26,7 @@
             [cmr.search.validators.temporal]
             [cmr.search.validators.date-range]
             [cmr.search.validators.attribute]
+            [cmr.search.validators.numeric-range]

             [cmr.search.services.parameter-validation :as pv]
             [cmr.search.services.collection-query-resolver :as r]


Adding attribute validation to loaded namespaces.

--- src/cmr/search/services/query_service.clj
+++ src/cmr/search/services/query_service.clj
@@ -25,6 +25,7 @@
             [cmr.search.validators.validation :as v]
             [cmr.search.validators.temporal]
             [cmr.search.validators.date-range]
+            [cmr.search.validators.attribute]

             [cmr.search.services.parameter-validation :as pv]
             [cmr.search.services.collection-query-resolver :as r]


prevent compilation warnings about *metamodel* var - possibly a temporary solution - not decided yet

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -426,7 +426,10 @@
 			 (proxy [Metadata$VersionComparator][](compareTo [old new] -1)) ;version-comparator
 			 [(Attribute. :name String false (proxy [Getter][] (get [^Model model] (.getName model))))])) ;attributes

-(defonce ^Model *metamodel* (SimpleModelView. "MetaModel" metamodel-metadata))
+;; TODO: I like the earmuffs on this var, but have no intention of
+;; rebinding its root at runtime - hence I need the :dynamic hint to
+;; avoid compiler warnings
+(def ^:dynamic ^Model *metamodel* (SimpleModelView. "MetaModel" metamodel-metadata))
 (insert *metamodel* *metamodel*)

 ;; TODO - this could be ASYNC - should be loaded from SPRING CONFIG


add initial support for running a SQL query straight into a Model

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -5,6 +5,11 @@
 	   DynamicClassLoader
 	   ISeq
 	   Keyword
+	   )
+	  (java.sql
+	   Connection
+	   ResultSet
+	   ResultSetMetaData
 	   )
 	  (java.util
 	   Collection
@@ -301,6 +306,36 @@

 ;;--------------------------------------------------------------------------------

+(defn sql-attributes
+  "Derive a sequence of MetaData attributes from a SQL ResultSet"
+  [#^ResultSetMetaData sql-metadata]
+  (map
+   (fn [column]
+       [(keyword (.getColumnName sql-metadata column))
+	(Class/forName (.getColumnClassName sql-metadata column))
+	true])			 ;we don't know - so assume mutability
+   (range 1 (+ 1 (.getColumnCount sql-metadata)))))
+
+(defn sql-data
+  "Create a sequence from some MetaData and a SQL ResultSet"
+  [#^Metadata metadata #^ResultSet result-set]
+  (let [creator (.getCreator metadata)]
+    (loop [output nil]
+      (if (.next result-set)
+	(recur
+	 (cons
+	  (.create
+	   creator
+	   (into-array
+	    Object
+	    (map
+	     (fn [#^Integer column] (.getObject result-set column))
+	     (range 1 (+ 1 (count (.getAttributeKeys metadata)))))))
+	  output))
+	output))))
+
+;;--------------------------------------------------------------------------------
+

 (defn model [#^String model-name version-key #^Metadata metadata]
   (let [version-fn (if version-key
@@ -319,3 +354,14 @@
      name
      metadata
      (fn [old new] (> (.get version-getter new) (.get version-getter old))))))
+
+(defn sql-model
+  "make a SQL query and return the ResultSet as a Model"
+  [model-name #^Connection connection #^String sql]
+  (let [result-set (.executeQuery (.prepareStatement connection sql))
+	metadata (record-metadata [:id] (sql-attributes (.getMetaData result-set))) ;lets use records...
+	data (sql-data metadata result-set)
+	sql-model (model model-name nil metadata)]
+    (.close result-set)
+    (insert-n sql-model data)
+    sql-model))


get sql-model going

get sql-model going

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -343,9 +343,16 @@

 (defn sql-model
   "make a SQL query and return the ResultSet as a Model"
-  [model-name #^Connection connection #^String sql]
+  [model-name #^Connection connection #^String sql primary-keys version-keys version-comparator]
   (let [result-set (.executeQuery (.prepareStatement connection sql))
-	metadata (record-metadata [:id] [] nil (sql-attributes (.getMetaData result-set))) ;lets use records...
+	;;metadata (record-metadata [:id] [] nil (sql-attributes (.getMetaData result-set))) ;lets use records...
+	metadata (custom-metadata
+		  (name (gensym "org.dada.core.SQLModel"))
+		  Object
+		  primary-keys
+		  version-keys
+		  version-comparator
+		  (sql-attributes (.getMetaData result-set)))
 	data (sql-data metadata result-set)
 	sql-model (model model-name metadata)]
     (.close result-set)


Use case instead of map for consistency mapping.

--- src/containium/ring_session_cassandra.clj
+++ src/containium/ring_session_cassandra.clj
@@ -53,14 +53,15 @@

 (defn- do-prepared
   [pp-query consistency & args]
-  (let [consistency ({:any ConsistencyLevel/ANY
+  (let [consistency (case consistency
+                      :any ConsistencyLevel/ANY
                       :one ConsistencyLevel/ONE
                       :two ConsistencyLevel/TWO
                       :three ConsistencyLevel/THREE
                       :quorum ConsistencyLevel/QUORUM
                       :all ConsistencyLevel/ALL
                       :local-quorum ConsistencyLevel/LOCAL_QUORUM
-                      :each-quorum ConsistencyLevel/EACH_QUORUM} consistency)
+                      :each-quorum ConsistencyLevel/EACH_QUORUM)
         result (QueryProcessor/processPrepared pp-query consistency query-state
                                                (map ->bytebuffer args))]
     (when (instance? ResultMessage$Rows result)


Set Cache-Control: no-cache on responses (#586)

* Add no-cache header to figwheel server

* Set Cache-Control: no-cache on responses

Cache-Control: no-cache tells the browser that it may cache the
response, but it must always revalidate the cached response with the
server, before using it. This is equivalent to setting

Cache-Control: max-age=0, must-revalidate

max-age=0 means that the response is always stale, and must-revalidate
means that the client must always revalidate stale resources.

Expires: -1 is not needed, all modern browsers support Cache-Control.
IE8 (and below?) treat 'Cache-Control: no-cache' as 'no-store', meaning
that they will always revalidate the cache. That seems a small price to
pay for the simpler reasoning about caching by only using Cache-Control.

https://developers.google.com/web/fundamentals/performance/optimizing-content-efficiency/http-caching
has good information on the current state of the art for HTTP caching.
https://jakearchibald.com/2016/caching-best-practices/#pattern-2-mutable-content-always-server-revalidated
has a good explanation of exactly the caching pattern that we are
looking to employ.

See also https://stackoverflow.com/a/19938619/826486 for more discussion
on Cache-Control: no-cache.

Based on #464, but fixes merge conflicts, and removes Expires: -1.

Fixes #546.

* Return 304 when files haven't been modified

Figwheel will generate the response for the static file, and then the
wrap-not-modified middleware checks the response to see if the request
headers show that the client already has this version of the file. If
so, it will return a 304, rather than sending the whole file again.

--- sidecar/src/figwheel_sidecar/components/figwheel_server.clj
+++ sidecar/src/figwheel_sidecar/components/figwheel_server.clj
@@ -14,6 +14,7 @@
    [ring.util.response :refer [resource-response] :as response]
    [ring.util.mime-type :as mime]
    [ring.middleware.cors :as cors]
+   [ring.middleware.not-modified :as not-modified]
    [org.httpkit.server :refer [run-server with-channel on-close on-receive send! open?]]

    [com.stuartsierra.component :as component]))
@@ -200,6 +201,22 @@
     #(possible-fn %)
     #(handler %)))

+(defn wrap-no-cache
+  "Add 'Cache-Control: no-cache' to responses.
+   This allows the client to cache the response, but
+   requires it to check with the server every time to make
+   sure that the response is still valid, before using
+   the locally cached file.
+
+   This avoids stale files being served because of overzealous
+   browser caching, while still speeding up load times by caching
+   files."
+  [handler]
+  (fn [req]
+    (some-> (handler req)
+      (update :headers assoc
+              "Cache-Control" "no-cache"))))
+
 (defn server
   "This is the server. It is complected and its OK. Its trying to be a basic devel server and
    also provides the figwheel websocket connection."
@@ -217,6 +234,8 @@
      (handle-index            http-server-root)
      (handle-figwheel-websocket server-state)

+     (wrap-no-cache)
+     (not-modified/wrap-not-modified)
      ;; adding cors to support @font-face which has a strange cors error
      ;; super promiscuous please don't uses figwheel as a production server :)
      (cors/wrap-cors


Clean

Clean

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -22,9 +22,6 @@
   p/AuthService
   (allow? [this d]
     (let [res (p/auth? this d)]
-      (log/error :res res)
-      (log/error :vis (set/subset? (:auth-visualisations res) auth-visualisations-set))
-      (log/error :ds (set/subset? (:auth-datasets res) auth-datasets-set))
       (and (set/subset? (:auth-visualisations res) auth-visualisations-set)
            (set/subset? (:auth-datasets res) auth-datasets-set))))
   (auth? [this {:keys [dataset-ids visualisation-ids]}]


removed whitespace

removed whitespace

--- src/cljs/wombats_web_client/components/countdown_timer.cljs
+++ src/cljs/wombats_web_client/components/countdown_timer.cljs
@@ -40,7 +40,7 @@
                assoc
                :timeout-fn
                (.setTimeout js/window
-                            (fn []
+                            (fn []
                               (swap! cmpnt-state
                                      assoc
                                      :interval-fn


CMR-669: Changed seach-paging-depth-limit from var to function.

--- src/cmr/search/services/parameters/parameter_validation.clj
+++ src/cmr/search/services/parameters/parameter_validation.clj
@@ -22,8 +22,9 @@
   (:import clojure.lang.ExceptionInfo
            java.lang.Integer))

-(def search-paging-depth-limit
+(defn search-paging-depth-limit
   "The maximum value for page-num * page-size"
+  []
   (cfg/config-value :search-paging-depth-limit 1000000 #(Integer. %)))

 (def case-sensitive-params
@@ -50,7 +51,7 @@
   "Get a value from the params as an Integer or nil value. Throws NumberFormatException
   if the value cannot be converted to an Integer."
   [params value-keyword]
-  (if-let [value-str (value-keyword params)]
+  (when-let [value-str (value-keyword params)]
     (Integer. value-str)))

 (defn page-size-validation
@@ -87,7 +88,7 @@
   "Validates that the paging depths (page-num * page-size) does not exceed a set limit."
   [concept-type params]
   (try
-    (let [limit search-paging-depth-limit
+    (let [limit (search-paging-depth-limit)
           page-size (get-ivalue-from-params params :page-size)
           page-num (get-ivalue-from-params params :page-num)]
       (when (and page-size


fixed date ranges

fixed date ranges

--- src/main/cljs/clojurebridgemn/client.cljs
+++ src/main/cljs/clojurebridgemn/client.cljs
@@ -475,7 +475,7 @@
      [:br]
      [:br]
      [:i [:a {:href "http://www.eventbrite.com/e/clojurebridge-mn-fall-2015-tickets-18237438670"} "Sign up now"]]
-     " for our fall workshop September 11/12!"
+     " for our fall workshop September 11-12!"
      ;; "Save the date! Our next ClojureBridgeMN workshop is scheduled for 9/11-12 !"
      ]}
    :logos
@@ -609,13 +609,13 @@
    {:debug
     [:div "ClojureBridge has been made possible locally through the generous support of our sponsors and individual donors"
      [:ul
-      [:li "September 11/12 2015: Vidku"
+      [:li "September 11-12 2015: Vidku"
        [:br]
        [:img {:alt "Vidku"
               :src "images/sponsors/vidku_400x400.png"
               }]
        ]
-      [:li "June 26/27 2015: BridgeFoundry, Clockwork, O'Reilly"
+      [:li "June 26-27 2015: BridgeFoundry, Clockwork, O'Reilly"
        [:br]
        [:img {:alt "Bridge Foundry"
               :src "images/clojurebridge.png"
@@ -627,7 +627,7 @@
               :src "images/sponsors/ORM.jpg"
               }]
        ]
-      [:li "March 6/7 2015: UMSEC, Trivent, Adobe, O'Reilly"
+      [:li "March 6-7 2015: UMSEC, Trivent, Adobe, O'Reilly"
        [:br]
        [:img {:alt "UMSEC"
               :src "images/sponsors/umseclogo.jpg"
@@ -643,7 +643,7 @@
               }]
        ]
       [:li
-       "May 16/17 2014: DevJam Studios, Code 42, Brick Alloy, Lispcast"
+       "May 16-17 2014: DevJam Studios, Code 42, Brick Alloy, Lispcast"
        [:br]
        [:img {:alt "DevJam Studios"
               :src "images/sponsors/DevJam-Studios.png"
@@ -696,7 +696,7 @@
      [:br]
      "Stay tuned for more information about our upcoming workshop at "
      [:a {:href "http://vidku.com"} "Vidku"]
-     " on September 11/12!"
+     " on September 11-12!"
      [:br]
      [:br]
      "Want to connect with the local Clojure community?"


checkpoint - pivot broken - but getting there

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -50,34 +50,37 @@
 ;;----------------------------------------------------------------------------------------------------------------------

 (def types [
-	    "blue whale"
-	    "sei whale"
-	    "bottlenose dolphin"
-	    "killer whale"
-	    "false killer whale"
-	    "amazon river dolphin"
-	    "narwhal"
-	    "sperm whale"
-	    "pilot whale"
-	    "beluga whale"
-	    "humpback whale"
-	    "fin whale"
-	    "right whale"
-	    "bowhead whale"
-	    "brydes whale"
-	    "minke whale"
-	    "gray whale"
-	    "spinner dolphin"
-	    "melon headed whale"
-	    "beaked whale"
+	    "blue" "grey" "sei"
+	    ;; "blue whale"
+	    ;; "sei whale"
+	    ;; "bottlenose dolphin"
+	    ;; "killer whale"
+	    ;; "false killer whale"
+	    ;; "amazon river dolphin"
+	    ;; "narwhal"
+	    ;; "sperm whale"
+	    ;; "pilot whale"
+	    ;; "beluga whale"
+	    ;; "humpback whale"
+	    ;; "fin whale"
+	    ;; "right whale"
+	    ;; "bowhead whale"
+	    ;; "brydes whale"
+	    ;; "minke whale"
+	    ;; "gray whale"
+	    ;; "spinner dolphin"
+	    ;; "melon headed whale"
+	    ;; "beaked whale"
 	    ])
+
+(def num-years 3)

 (def max-weight 172) ;; metric tons
 (def max-length 32.9) ;; metres

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

-(if false
+(if true
   (def *metamodel*
        (new org.dada.core.MetaModelImpl
 	    "Cetacea"
@@ -123,7 +126,7 @@
       Object
       [id
        0
-       (Date. (rand-int 10)
+       (Date. (rand-int num-years)
 	      (rand-int 12)
 	      (+ (rand-int 28) 1))
        (rnd types)
@@ -215,36 +218,47 @@

 (defn metamodel [#^Model src-model]
   (let [metametadata (seq-metadata 1)
-	metamodel (model (str "Meta-" (.getName src-model)) nil metametadata)]
+	prefix (.getName src-model)
+	prefix-fn (fn [& _] prefix)
+	metamodel (model (str "Meta-" prefix) nil metametadata)]
     (insert *metamodel* metamodel)
-    (insert metamodel [src-model])
-    [metamodel (.getMetadata src-model) []]))
+    (insert metamodel [src-model '()])
+    [metamodel (.getMetadata src-model) prefix []]))

 (import org.dada.core.View)
 (import org.dada.core.Update)

 (defn meta-view [#^String suffix #^Model src-metamodel f]
+  ;; create a metamodel into which t place our results...
   (let [tgt-metamodel (model (str (.getName src-metamodel) suffix) nil (.getMetadata src-metamodel))]
-  (insert *metamodel* tgt-metamodel)
-  (connect
-   src-metamodel
-   (proxy [View] []
-	  (update [insertions alterations deletions]
-		  (doall (map (fn [#^Update insertion] (apply f tgt-metamodel (.getNewValue insertion))) insertions)))))
-  tgt-metamodel))
-
-(defn split [[#^Model src-metamodel #^Metadata src-metadata #^Collection extra-keys] split-key & [split-key-fn subchain]]
+    ;; register it with the global metamodel
+    (insert *metamodel* tgt-metamodel)
+    ;; view upstream metamodel for arrival of results
+    (connect
+     src-metamodel
+     (proxy [View] []
+	    (update [insertions alterations deletions]
+		    (doall (map (fn [#^Update insertion] (apply f tgt-metamodel (.getNewValue insertion))) insertions)))))
+    tgt-metamodel))
+
+(defn split [[#^Model src-metamodel #^Metadata src-metadata prefix #^Collection extra-keys] split-key & [split-key-fn subchain]]
+  (println "split" prefix "by" split-key ":" extra-keys)
   [(meta-view
-    (str ".split(" split-key")")
+    (str ".split|" split-key)
     src-metamodel
-    (fn [tgt-metamodel model & extra-values]
+    ;; create our own metamodel and view upstream metamodel for new
+    ;; models - each time one is inserted call following fn...
+    (fn [tgt-metamodel model extra-values]
 	(do-split
 	 model
 	 split-key
 	 (or split-key-fn list)
 	 identity
+	 ;; each time a model is inserted into this metamodel, create
+	 ;; a new metamodel for branch of our parent and kick off a
+	 ;; fresh split into it...
 	 (fn [#^Model model extra-value]
-	     (let [model-entry (list* model (concat extra-values [extra-value]))]
+	     (let [model-entry (list model (concat extra-values [extra-value]))]
 	       (insert tgt-metamodel model-entry)
 	       (insert *metamodel* model)
 	       (if subchain
@@ -252,29 +266,33 @@
 		  [(meta-view
 		    (str "=" extra-value)
 		    tgt-metamodel
-		    (fn [tgt-metamodel2 model & extra-values]
+		    (fn [tgt-metamodel2 model extra-values]
 			;;(insert tgt-metamodel tgt-metamodel2)
-			(insert tgt-metamodel2 [model])
+			(insert tgt-metamodel2 [model extra-values])
 			;;(insert *metamodel* model)
 			))
 		   src-metadata
-		   []]))
+		   (str prefix "." split-key "=" extra-value)
+		   (concat extra-keys [split-key])]))
 	       model
 	       )))))
    src-metadata
+   (str prefix "." split-key)
    (concat extra-keys [split-key])])

 ;; extra keys are inserted into attribute list
 ;; extra values are carried in model's row in metamodel
 ;; each split adds an extra key/value downstream that we may need to unwrap upstream
-(defn ccount [[#^Model src-metamodel #^Metadata src-metadata #^Collection extra-keys]
+(defn ccount [[#^Model src-metamodel #^Metadata src-metadata prefix #^Collection extra-keys]
 	      & [count-key]]
+  (println "count:" prefix ":" extra-keys)
   (let [extra-attributes (map (fn [key] (.getAttribute src-metadata key)) extra-keys)
 	tgt-metadata (count-reducer-metadata extra-keys count-key extra-attributes)]
     [(meta-view
       (str "." (count-value-key count-key))
       src-metamodel
-      (fn [tgt-metamodel #^Model src-model & extra-values]
+      (fn [tgt-metamodel #^Model src-model extra-values]
+	  ;;(println "CCOUNT DATA:" extra-values)
 	  (let [count-model (do-reduce-count
 			     (.getName src-model)
 			     (.getMetadata src-model)
@@ -282,18 +300,19 @@
 			     count-key
 			     extra-values)]
 	    (insert *metamodel* count-model)
-	    (insert tgt-metamodel (list* count-model extra-values))
+	    (insert tgt-metamodel [count-model extra-values])
 	    (connect src-model count-model))))
      tgt-metadata
+     (str prefix ".count")
      extra-keys]))

-(defn union [[#^Model src-metamodel #^Metadata src-metadata #^Collection extra-keys] & [#^String prefix]]
+(defn union [[#^Model src-metamodel #^Metadata src-metadata prefix #^Collection extra-keys] & [#^String prefix]]
   (let [tgt-model (model (str (or prefix (name (gensym "UNION"))) ".union()") nil src-metadata)
 	tgt-metamodel (meta-view ".union()" src-metamodel (fn [tgt-metamodel src-model & extra-values] (connect src-model tgt-model)))]
     (insert *metamodel* tgt-model)
-    (insert tgt-metamodel [tgt-model])
-    [tgt-metamodel src-metadata extra-keys]))
+    (insert tgt-metamodel [tgt-model '()])
+    [tgt-metamodel src-metadata (str prefix ".union()") extra-keys]))

 (defn pivot-metadata [#^Metadata src-metadata #^Collection keys #^Collection pivot-values value-key]
   (let [value-type (.getAttributeType src-metadata value-key)]
@@ -309,13 +328,14 @@
 ;; pivot-key - e.g. :time
 ;; pivot-values - e.g. years
 ;; value-key - e.g. :count(*) - needed to find type of new columns
-(defn pivot [[#^Model src-metamodel #^Metadata src-metadata #^Collection extra-keys] pivot-key pivot-values value-key]
+(defn pivot [[#^Model src-metamodel #^Metadata src-metadata prefix #^Collection extra-keys] pivot-key pivot-values value-key]
+  (println "pivot" prefix ":" extra-keys)
   (let [pivot-name (str ".pivot(" value-key "/" pivot-key")")
 	pivot-metadata (pivot-metadata src-metadata extra-keys pivot-values value-key)
 	tgt-model (PivotModel.
-		   (str (name (gensym "PIVOT")) pivot-name)
+		   (str prefix pivot-name)
 		   src-metadata
-		   (fn [old new] new)
+		   (fn [old new] new)	;TODO - sort out version-fn
 		   value-key
 		   pivot-values
 		   pivot-metadata)
@@ -323,48 +343,39 @@
 		       pivot-key
 		       src-metamodel
 		       (fn [tgt-metamodel src-model & extra-values]
+			   (println "PIVOT DATA:" extra-values)
 			   (connect src-model tgt-model)))]
     (insert *metamodel* tgt-model)
-    (insert tgt-metamodel [tgt-model])
-    [tgt-metamodel src-metadata extra-keys]))
+    (insert tgt-metamodel [tgt-model '()])
+    [tgt-metamodel src-metadata (str prefix ".PIVOT()") extra-keys]))

 ;;--------------------------------------------------------------------------------

 (def all-whales (metamodel whales-model))
 (def counted-whales (ccount all-whales))

-(def #^NavigableSet years
-     (TreeSet.
-      (collection
-       (Date. 0 0 1)
-       (Date. 1 0 1)
-       (Date. 2 0 1)
-       (Date. 3 0 1)
-       (Date. 4 0 1)
-       (Date. 5 0 1)
-       (Date. 6 0 1)
-       (Date. 7 0 1)
-       (Date. 8 0 1)
-       (Date. 9 0 1))))
+(def #^NavigableSet years (TreeSet. (apply collection (map #(Date. % 0 1) (range num-years)))))

 (def whales-by-type
-     (union
+     ;;(union
       (split
        all-whales
        :type
        nil
        #(pivot
-	  (ccount
-	   (split
-	    %
-	    :time
-	    (fn [time] (list (or (.lower years time) time)))
-	    ))
+	 (ccount
+	  (split
+	   %
+	   :time
+	   (fn [time] (list (or (.lower years time) time)))
+	   )
+	  )
 	 :time
 	 years
 	 (keyword (count-value-key nil)))
        )
-      "HEHE"))
+;;      "HEHE")
+)

 ;;(def counted-whales-by-type (ccount whales-by-type))
 ;;(def grouped-counted-whales-by-type (union counted-whales-by-type "Whales.split(:type).count()"))
@@ -376,12 +387,13 @@

 ;; create some whales...

-(def num-whales 1000)
+(def num-whales 10
+)

 (time
  (doall
   (let [batcher (Batcher. 999 1000 (list whales-model))]
-    (pmap (fn [id] (insert whales-model (whale id))) (range num-whales)))))
+    (map (fn [id] (insert whales-model (whale id))) (range num-whales))))) ;TODO: reinstate pmap later

 (println "LOADED: " num-whales)


Uncomment tests

Uncomment tests

--- test/clojure/clojurewerkz/cassaforte/cql_test.clj
+++ test/clojure/clojurewerkz/cassaforte/cql_test.clj
@@ -402,23 +402,24 @@
         (truncate s :users))))

   (deftest test-raw-cql-insert
-    (comment
-      (testing "With default session"
-        (client/execute s "INSERT INTO users (name, city, age) VALUES ('Alex', 'Munich', 19);")
-        (is (= {:name "Alex" :city "Munich" :age (int 19)}
-               (first (client/execute s "SELECT * FROM users;"))))
-        (client/execute s "TRUNCATE users;"))
-      (testing "Prepared statement"
-        (client/execute s (client/as-prepared "INSERT INTO users (name, city, age) VALUES (?, ?, ?);"
-                                              "Alex" "Munich" (int 19))
-                        {:prepared true})
-        (is (= {:name "Alex" :city "Munich" :age (int 19)}
-               (first (client/execute s "SELECT * FROM users;"))))
-        (client/execute s "TRUNCATE users;"))))
+    (testing "With default session"
+      (client/execute s "INSERT INTO users (name, city, age) VALUES ('Alex', 'Munich', 19);")
+      (is (= {:name "Alex" :city "Munich" :age (int 19)}
+             (first (client/execute s "SELECT * FROM users;"))))
+      (client/execute s "TRUNCATE users;"))
+    (testing "Prepared statement"
+      (client/execute s
+                      (client/bind
+                       (client/prepare s "INSERT INTO users (name, city, age) VALUES (?, ?, ?);")
+                       ["Alex" "Munich" (int 19)]))
+      (is (= {:name "Alex" :city "Munich" :age (int 19)}
+             (first (client/execute s "SELECT * FROM users;"))))
+      (client/execute s "TRUNCATE users;")))

   (deftest test-insert-nils
-    (comment
-      (client/prepared
-       (let [r {:name "Alex" :city "Munich" :age nil}]
-         (insert s :users r)
-         (is (= r (first (select s :users)))))))))
+    (let [r {:name "Alex" :city "Munich" :age nil}]
+      (client/execute s
+                      (client/bind
+                       (client/prepare s "INSERT INTO users (name, city, age) VALUES (?, ?, ?);")
+                       ["Alex" "Munich" nil]))
+      (is (= r (first (select s :users)))))))


Correct compilation error in code

Correct compilation error in code

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -147,7 +147,7 @@
   ([length-unit]
    (condp = length-unit
      :ft (make-measurement (tuc/draw-normal 18000 1500) :ft)
-     :m (length-as (typical-toe-measured-measured-depth) :m))))
+     :m (length-as (typical-toe-measured-depth) :m))))

 (def typical-stage-top typical-measured-depth-in-horizontal)


call (remove-top-values) to correctly query the expressions table for the correct matching expressions

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -9,7 +9,7 @@
     [clojure.string :as string]
     [clojure.tools.logging :as log]
     [clojure.tools.namespace.repl :refer [refresh refresh-all]]
-    [dag_unify.core :refer [fail? get-in merge strip-refs serialize unify ref?]]
+    [dag_unify.core :refer [fail? get-in merge remove-top-values strip-refs serialize unify ref?]]
     [korma.core :refer [exec-raw]]))

 ;; TODO: more fine-grained approach to dealing with exceptions:
@@ -300,7 +300,7 @@
                           AND language=?")
                        [(json/write-str spec) target-language]]
                       :results)))]
-    (log/debug (str "current-target-count for spec: " spec "=" current-target-count))
+    (log/info (str "current-target-count for spec: " spec "=" current-target-count))
     (let [count (- count current-target-count)]
       (if (> current-target-count 0)
         (log/debug (str "There are already " current-target-count " expressions for: " spec)))
@@ -323,7 +323,7 @@
   (let [language (:language model)
         debug (log/debug (str "fill-language-by-spec: language: " language))
         debug (log/debug (str "fill-language-by-spec: spec: " spec))
-        json-spec (json/write-str spec)
+        json-spec (json/write-str (remove-top-values spec))
         current-count
         (:count
          ;; TODO: move this block to babel.reader/checking-for-existing-expressions
@@ -333,9 +333,9 @@
                        WHERE structure @> ?::jsonb
                          AND active=true
                          AND language=?"
-                       [(json/write-str spec) language]]
+                       [json-spec language]]
                       :results)))]
-    (log/debug (str "current-count for spec: " spec "=" current-count))
+    (log/info (str "current-count for json-spec: " json-spec "=" current-count))
     (let [count (- count current-count)]
       (if (> current-count 0)
         (log/debug (str "There are already " current-count " expressions for: " spec)))


Added a settings button

Added a settings button

--- src/webapp/client/views/login_panel.cljs
+++ src/webapp/client/views/login_panel.cljs
@@ -183,22 +183,31 @@

 (defn logged-in-panel []
-    (el :div {:class "row" :style "padding: 5px; width:300px;"} [
+    (el :div {:class "row" :style "padding: 5px; width:400px;"} [
         (el :div
                           {:id    "signed-in-as-text"
                            :text  "Signing in..."
-                           :class "col-md-6"
+                           :class "pull-left"
+                           :style "margin-right: 20px; margin-top:10px;"

          })

         (el :button
                           {:id    "logout-button"
-                           :class "btn btn-default col-md-5 pull-right"
+                           :class "btn btn-default "
                            :text "Logout"
                            :style "margin-right: 20px;"
                            :onclick #(swap-section
                                                 :#top-right
                                                 (signup-panel-html))})
+
+        (el :button
+                          {:id    "settings-button"
+                           :class "btn btn-default"
+                           :text "Settings"
+                           :style "margin-right: 20px;"
+         })
+
 ]))


minor.

minor.

--- ssclj/tools/src/com/sixsq/slipstream/tools/cli/ssconfig.clj
+++ ssclj/tools/src/com/sixsq/slipstream/tools/cli/ssconfig.clj
@@ -413,7 +413,7 @@
   (->> [""
         "Adds or updates different parts of the SlipStream service configuration in DB."
         ""
-        "Usage: program-name [options] <list-of-files>"
+        "Usage: [options] <list-of-files>"
         ""
         "Options:"
         options-summary


[#670] Fixed lint errors

[#670] Fixed lint errors

--- backend/src/akvo/lumen/admin/add_tenant.clj
+++ backend/src/akvo/lumen/admin/add_tenant.clj
@@ -178,9 +178,9 @@

 (defn update-client
   [request-headers api-root {:strs [id] :as client}]
-  (-> (client/put (format "%s/clients/%s" api-root id)
-                  {:body (json/encode client)
-                   :headers request-headers})))
+  (client/put (format "%s/clients/%s" api-root id)
+                {:body (json/encode client)
+                 :headers request-headers}))

 (defn add-tenant-urls-to-client
   [client url]


Code cleaning on drawarea.

Code cleaning on drawarea.

--- src/uxbox/main/ui/workspace/drawarea.cljs
+++ src/uxbox/main/ui/workspace/drawarea.cljs
@@ -79,12 +79,12 @@
   [{:keys [points] :as shape}]
   (letfn [(on-click [event]
             (dom/stop-propagation event)
-            (swap! drawing-shape
-                   (fn [shape]
-                     (let [points (:points shape)
-                           points (vec (butlast points))]
-                       (assoc shape :points points :close? true))))
-            (rx/push! drawing-stoper true))]
+            (swap! drawing-shape drop-last-point)
+            (rx/push! drawing-stoper true))
+          (drop-last-point [shape]
+            (let [points (:points shape)
+                  points (vec (butlast points))]
+              (assoc shape :points points :close? true)))]
     (let [{:keys [x y]} (first points)]
       [:g
        (-> (assoc shape :drawing? true)


Added similarity utility.

Added similarity utility.

--- src/clojush/util.clj
+++ src/clojush/util.clj
@@ -346,6 +346,14 @@
               (range (inc (count b)))
               a))))

+(defn similarity
+  [sequence1 sequence2]
+  "Returns a number between 0 and 1, indicating how similar the sequences are as a normalized,
+  inverted Levenshtein distance, it 1 indicating identity and 0 indicating no similarity."
+  (let [dist (levenshtein-distance sequence1 sequence2)
+        max-dist (max (count sequence1) (count sequence2))]
+    (/ (- max-dist dist) max-dist)))
+
 ;;;;;;;;;;;;;;:::::;;;;;;;;;;;;;;
 ;; Simple Statistic Functions
 ;; From: https://github.com/clojure-cookbook/clojure-cookbook/blob/master/01_primitive-data/1-20_simple-statistics.asciidoc
@@ -376,4 +384,3 @@
             top-val (nth sorted halfway)]
            (mean [bottom-val top-val])))))

-


CMR-4998: Fixed variable name capitalization.

--- umm-spec-lib/src/cmr/umm_spec/migration/version/service.clj
+++ umm-spec-lib/src/cmr/umm_spec/migration/version/service.clj
@@ -53,7 +53,7 @@
                                                    (:SupportedProjections service-options))))
       (dissoc :SupportedProjections)))

-(defn- duplicate-supported-Formats
+(defn- duplicate-supported-formats
   "Duplicate the SupportedFormats in v1.1 ServiceOptions to SupportedInputFormats
   and SupportedOutputFormats in v1.2 ServiceOptions when migrate from 1.1 to 1.2."
   [service-options]
@@ -102,7 +102,7 @@
   [service-options]
   (-> service-options
       (update :SupportedFormats supported-Formats-1-1->1-2)
-      duplicate-supported-Formats))
+      duplicate-supported-formats))

 (defn- revert-supported-projections
   "Revert the SupportedInputProjections and SupportedOutputProjections in v1.2 ServiceOptions


[#672] WIP removed redundant imports from akvo.lumen.import.csv

--- backend/src/akvo/lumen/import/csv.clj
+++ backend/src/akvo/lumen/import/csv.clj
@@ -5,10 +5,7 @@
             [clojure.java.io :as io]
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as s])
-  (:import com.ibm.icu.text.CharsetDetector
-           java.util.UUID
-           org.postgresql.PGConnection
-           org.postgresql.copy.CopyManager))
+  (:import com.ibm.icu.text.CharsetDetector))

 (defn- get-cols


Switch handshake test to new Actor-based model

For messaging.

The test runs to completion, after it times out. Which is an improvement.

--- test/frereth_cp/message/message_test.clj
+++ test/frereth_cp/message/message_test.clj
@@ -202,7 +202,8 @@
         ;; Something that spans multiple packets would be better, but
         ;; that seems like a variation on this test.
         ;; Although this *does* take me back to the beginning, where
-        ;; I was trying to figure out ways to gen the tests via spec.
+        ;; I was trying to figure out ways to gen the tests based upon
+        ;; a protocol defined by something like spec.
         cheezburgr-length 182
         client-child-cb (fn [bs]
                           (is bs)
@@ -212,7 +213,7 @@
                             (is incoming)
                             ;; We're receiving the initial ::orly? response in State 0.
                             ;; The ::yarly disappears
-                            ;; FIXME: Where
+                            ;; FIXME: Where?
                             (log/info (str "Client (state "
                                            @client-state
                                            ") received: "
@@ -292,62 +293,78 @@
                         (log/info "Success!"))
                       (fn [bad] (is (not bad))))

-    (reset! client-atom (message/initial-state "Client" false))
-    (message/start! @client-atom client-parent-cb client-child-cb)
-
-    ;; It seems like this next part really shouldn't happen until the initial message arrives
-    ;; from the client.
-    ;; Actually, it starts when the Initiate(?) packet arrives as part of the handshake. So
-    ;; that isn't quite true
-    (reset! server-atom (message/initial-state "Server" true))
-    (message/start! @server-atom server-parent-cb server-child-cb)
-
-    (try
-      (strm/consume (fn [bs]
-                      (log/info "Message from client to server")
-                      (let [srvr-agent @server-atom]
-                        (if-let [err (agent-error srvr-agent)]
-                          (do
-                            (log/error "Server failed!")
-                            (dfrd/error! succeeded? err))
-                          (message/parent->! srvr-agent bs))))
-                    client->server)
-      (strm/consume (fn [bs]
-                      (log/info "Message from server to client")
-                      (let [client-agent @client-atom]
-                        (if-let [err (agent-error client-agent)]
-                          (do
-                            (log/error "Client failed!")
-                            (dfrd/error! succeeded? err))
-                          (message/parent->! client-agent bs))))
-                    server->client)
-
-      (let [initial-message (Unpooled/buffer K/k-1)
-            helo (.getBytes (pr-str ::ohai!))]
-        ;; Kick off the exchange
-        (message/child->! @client-atom helo)
-        ;; TODO: Find a reasonable value for this timeout
-        (let [really-succeeded? (deref succeeded? 10000 ::timed-out)]
-          (log/info "Bottom of message-test")
-          (is (not (agent-error @client-atom)))
-          (is (not (agent-error @server-atom)))
-          (when (= really-succeeded? ::timed-out)
-            ;; Double deref to get to the agent state.
-            (let [{:keys [::specs/flow-control]
-                   :as client-state} @(deref client-atom)]
-              ;; I'm mostly interested in the next-action inside flow-control
-              ;; Down-side to switching to manifold for scheduling:
-              ;; I don't really have any insight into what's going on
-              ;; here.
-              ;; Q: Is that true? Or have I just not studied its
-              ;; docs thoroughly enough?
-              (is (not flow-control))))
-          (is (= ::kthxbai really-succeeded?))
-          (is (= 5 @client-state))))
-      (finally
-        (log/info "Cleaning up")
-        (message/halt! @client-atom)
-        (message/halt! @server-atom)))))
+    (let [client-init (message/initial-state "Client" false)
+          client-io (message/start! client-init client-parent-cb client-child-cb)
+          server-init (message/initial-state "Server" true)
+          ;; It seems like this next part really shouldn't happen until the initial message arrives
+          ;; from the client.
+          ;; Actually, it starts when the Initiate(?) packet arrives as part of the handshake. So
+          ;; that isn't quite true
+          server-io (message/start! server-init server-parent-cb server-child-cb)]
+      (reset! client-atom client-io)
+      (reset! server-atom server-io)
+
+      (try
+        (strm/consume (fn [bs]
+                        (log/info "Message from client to server")
+                        (let [srvr-state (message/get-state server-io ::timed-out)]
+                          (if (or (= ::timed-out srvr-state)
+                                  (instance? Throwable srvr-state)
+                                  (nil? srvr-state))
+                            (do
+                              (log/error srvr-state "Server failed!")
+                              (dfrd/error! succeeded? srvr-state))
+                            (message/parent->! server-io bs))))
+                      client->server)
+        (strm/consume (fn [bs]
+                        (log/info "Message from server to client")
+                        (let [client-state (message/get-state client-io ::timed-out)]
+                          (if (or (= ::timed-out client-state)
+                                  (instance? Throwable client-state)
+                                  (nil? client-state))
+                            (do
+                              (log/error client-state "Client failed!")
+                              (dfrd/error! succeeded? client-state))
+                            (message/parent->! client-io bs))))
+                      server->client)
+
+        (let [initial-message (Unpooled/buffer K/k-1)
+              helo (.getBytes (pr-str ::ohai!))]
+          ;; Kick off the exchange
+          (message/child->! client-io helo)
+          ;; TODO: Find a reasonable value for this timeout
+          (let [really-succeeded? (deref succeeded? 10000 ::timed-out)]
+            (log/info "Bottom of message-test")
+            (let [client-state (message/get-state client-io ::timed-out)]
+              (is (not (or (= client-state ::timed-out)
+                           (instance? Throwable client-state)
+                           (nil? client-state))))
+              (when (= really-succeeded? ::timed-out)
+                (let [{:keys [::specs/flow-control]} client-state]
+                  ;; I'm mostly interested in the next-action inside flow-control
+                  ;; Down-side to switching to manifold for scheduling:
+                  ;; I don't really have any insight into what's going on
+                  ;; here.
+                  ;; Q: Is that true? Or have I just not studied its
+                  ;; docs thoroughly enough?
+                  (is (not flow-control))
+                  (is (not client-io)))))
+            (let [srvr-state (message/get-state server-io ::timed-out)]
+              (is (not (or (= srvr-state ::timed-out)
+                           (instance? Throwable srvr-state)
+                           (nil? srvr-state)))))
+            (is (= ::kthxbai really-succeeded?))
+            (is (= 5 @client-state))))
+        (finally
+          (log/info "Cleaning up")
+          (try
+            (message/halt! client-io)
+            (catch Exception ex
+              (log/error ex "Trying to halt client")))
+          (try
+            (message/halt! server-io)
+            (catch Exception ex
+              (log/error ex "Trying to halt server"))))))))
 (comment (handshake))

 (deftest overflow-from-child


properly handle deleting whole focused form

--- cljs/src/main/plastic/cogs/editor/ops/editing.cljs
+++ cljs/src/main/plastic/cogs/editor/ops/editing.cljs
@@ -6,13 +6,15 @@
             [plastic.cogs.editor.ops.cursor :as selection]
             [plastic.onion.core :as onion]
             [plastic.util.zip :as zip-utils]
-            [rewrite-clj.zip :as zip]))
+            [rewrite-clj.zip :as zip]
+            [plastic.cogs.editor.toolkit.id :as id]))

 (defn select-next-thing-for-case-of-selected-node-removal [editor]
-  (let [cursor-id (editor/get-cursor editor)]
-    (if (= cursor-id (editor/get-focused-form-id editor))
-      (selection/apply-move-cursor editor :move-next-form)  ; for case of deleting whole focused form
-      (selection/apply-move-cursor editor :structural-left :structural-right :structural-up))))
+  (let [cursor-id (id/id-part (editor/get-cursor editor))
+        moves-to-try (if (= cursor-id (editor/get-focused-form-id editor))
+                       [:move-next-form :move-prev-form]    ; case of deleting whole focused form
+                       [:structural-left :structural-right :structural-up])]
+    (apply selection/apply-move-cursor editor moves-to-try)))

 (defn set-cursor-to-node-if-exists [editor node-id]
   (let [node-loc (editor/find-node-loc editor node-id)]


Switched to hash-map weights in weighted kmeans test (wrong ow); Tried setting up uniform starting clusters; Still failing...

--- test/cluster_tests.clj
+++ test/cluster_tests.clj
@@ -234,6 +234,11 @@
   (doseq [[n r] (map vector names mat)]
     (println n ":" r)))

+(defn init-clsts
+  [f coll]
+  (->> coll
+       (group-by f)
+       (map (fn [[i mems]] {:id i :members mems}))))

 (deftest weighted-kmeans
   (testing (str "Should give the same result as regular kmeans where rows have been duplicated according to a set "
@@ -244,17 +249,23 @@
             n-cmnts      3
             ; First create the base matrix, and a random set of integer weights
             uniq-positions   (for [_ (range n-uniq)] (random-vec* n-cmnts))
-            ptpt-names       (for [i (range n-uniq)] (str "p" i))
+            ptpt-names       (for [i (range n-uniq)] i)
             weights          (for [_ (range n-uniq)] (inc (rand-int* n-dups-max)))
+            uniq-init        (init-clsts #(mod % 3) ptpt-names)
             ; Use the weights to create a matrix where the rows have been duplicated according to weights
             duped-positions  (dup-matrix-from-weights uniq-positions weights)
             duped-names      (dup-rownames-from-weights ptpt-names weights)
             duped-data       (named-matrix duped-names [:x :y :z] duped-positions)
+            duped-init       (init-clsts #(mod (first %) 3) duped-names)
             ; Run kmeans on the various data
             deduped-data     (named-matrix ptpt-names [:x :y :z] uniq-positions)
-            weighted-clsts   (kmeans deduped-data 3 :weights weights)
-            unweighted-clsts (kmeans deduped-data 3)
-            duped-clsts      (kmeans duped-data 3)]
+            weighted-clsts   (kmeans deduped-data 3
+                                     :last-clusters uniq-init
+                                     :weights (into {} (map vector ptpt-names weights)))
+            unweighted-clsts (kmeans deduped-data 3
+                                     :last-clusters uniq-init)
+            duped-clsts      (kmeans duped-data 3
+                                     :last-clusters duped-init)]
         (is (= (setify-members weighted-clsts)
                (setify-members duped-clsts :trans first)))))))


Split base into two functions (base and common).

Also:
* added support for total line counts
* started working on map support

--- src/clj/mx/roads/forgotten/blog/web/content/data.clj
+++ src/clj/mx/roads/forgotten/blog/web/content/data.clj
@@ -15,30 +15,37 @@
                  (map :author)
                  set
                  count)
+   :lines (->> posts
+               (map :line-count)
+               (reduce +))
    :words (->> posts
                (map :word-count)
-               (reduce + 0))
+               (reduce +))
    :chars (->> posts
                (map :char-count)
-               (reduce + 0))})
+               (reduce +))})

 (defn base
+  []
+  {:page-data {:base-path "/blog"
+               :site-title (config/name)
+               :site-description (config/description)
+               :index "index"
+               :about "about"
+               :community "community"
+               :archives "archives"
+               :categories "categories"
+               :tags "tags"
+               :authors "authors"
+               :active nil}})
+
+(defn common
   ([]
-    (base {}))
+    (common {}))
   ([posts]
-    {:page-data {:base-path "/blog"
-                 :site-title (config/name)
-                 :site-description (config/description)
-                 :index "index"
-                 :about "about"
-                 :community "community"
-                 :archives "archives"
-                 :categories "categories"
-                 :tags "tags"
-                 :authors "authors"
-                 :active nil}
-      :posts-data posts
-      :posts-stats (posts-stats posts)}))
+    (assoc (base)
+           :posts-data posts
+           :posts-stats (posts-stats posts))))

 (def generic-page
   {:title nil
@@ -61,7 +68,7 @@
 (defn about
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "about.md"
                           (markdown-page)
@@ -70,14 +77,14 @@
 (defn community
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "community")
       (assoc :content (assoc generic-page :title "Community"))))

 (defn contact
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "contact.md"
                           (markdown-page)
@@ -86,7 +93,7 @@
 (defn powered-by
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "powered-by.md"
                           (markdown-page)
@@ -95,7 +102,7 @@
 (defn license
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "license.md"
                           (markdown-page)
@@ -104,7 +111,7 @@
 (defn privacy
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "privacy.md"
                           (markdown-page)
@@ -113,7 +120,7 @@
 (defn disclosure
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "about")
       (assoc :content (-> "disclosure.md"
                           (markdown-page)
@@ -126,7 +133,7 @@
 (defn post
   [posts post-data]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "archives")
       (assoc :post-data post-data
              :tags (blog/tags [post-data]))))
@@ -138,7 +145,7 @@
                                  (take (dec post-count)
                                        (rest posts)))]
     (-> posts
-        (base)
+        (common)
         (assoc-in [:page-data :active] "index")
         (assoc :headlines-heading "Headlines"
                :headlines-desc (str "We like to keep things simple at FRMX. "
@@ -150,6 +157,19 @@
                :headliner headliner
                :posts-data grouped-posts))))

+(defn map-minimal
+  [map-data]
+  (-> (base)
+      (assoc-in [:page-data :active] "maps")
+      (assoc :map-data map-data)))
+
+(defn map-common
+  [posts map-data]
+  (-> posts
+      (common)
+      (assoc-in [:page-data :active] "maps")
+      (assoc :map-data map-data)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;   Listings Pages   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -157,7 +177,7 @@
 (defn archives
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "archives")
       (assoc :content (assoc generic-page :title "Archives")
              :posts-data (blog/data-for-archives posts))))
@@ -165,7 +185,7 @@
 (defn categories
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "categories")
       (assoc :content (assoc generic-page :title "Categories")
              :posts-data (blog/data-for-categories posts))))
@@ -173,7 +193,7 @@
 (defn tags
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "tags")
       (assoc :content (assoc generic-page :title "Tags")
              :posts-data (blog/data-for-tags posts))))
@@ -181,7 +201,7 @@
 (defn authors
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "authors")
       (assoc :content (assoc generic-page :title "Authors")
              :posts-data (blog/data-for-authors posts))))
@@ -193,7 +213,7 @@
 (defn design
   [posts]
   (-> posts
-      (base)
+      (common)
       (assoc-in [:page-data :active] "design")
       (assoc :content (assoc generic-page :title "Design"))))


(MAINT) remove duplicate def

(MAINT) remove duplicate def

--- test/unit/puppetlabs/services/config/puppet_server_config_service_test.clj
+++ test/unit/puppetlabs/services/config/puppet_server_config_service_test.clj
@@ -17,11 +17,6 @@
 (def service-and-deps
   [puppet-server-config-service jruby-puppet-pooled-service jetty9-service
    profiler/puppet-profiler-service])
-
-(def required-config
-  (merge (jruby-testutils/jruby-puppet-tk-config
-           (jruby-testutils/jruby-puppet-config 1))
-         {:webserver    {:port 8081}}))

 (def test-resources-dir
   "./dev-resources/puppetlabs/services/config/puppet_server_config_service_test")


argument of interval

argument of interval

--- src/desafio/core.clj
+++ src/desafio/core.clj
@@ -217,6 +217,7 @@
 (def state (atom {}))

 (defn init [args]
+  (swap! state assoc :interval (Integer/parseInt (first args)))
   (swap! state assoc :running true))

 (defn start []
@@ -228,7 +229,7 @@
       (cassandra2elasticsearch esconn casconn)
       (println "elasticsearch2cassandra")
       (elasticsearch2cassandra esconn casconn)
-      (Thread/sleep 2000))))
+      (Thread/sleep (:interval @state)))))

 (defn stop []
   (swap! state assoc :running false))
@@ -246,7 +247,6 @@

 ;; Enable command-line invocation
 (defn -main [& args]
-  (println args)
   (init args)
   (start))


Evolve consumers: run on dedicated thread; pass original reason

--- src/flatgui/test.clj
+++ src/flatgui/test.clj
@@ -69,14 +69,11 @@
 (defn init-container [c]
   (FGTestAppContainer/init c))

-(defn check-property [container target property expected-value]
-  (test/is (= expected-value (.getProperty container target property))))
-
 (defn get-property [container target property] (.getProperty container target property))

 (defn wait-for-property-pred [container target property pred]
   (let [actual-value (loop [a 0
-                            interval 1
+                            interval 5
                             v (.getProperty container target property)]
                        (if (and (not (pred v)) (< a wait-attempts))
                          (do
@@ -88,6 +85,9 @@
                              (.getProperty container target property)))
                          v))]
     (test/is (pred actual-value) (str "Failed for actual value was " (if (coll? actual-value) (str "[coll count=" (count actual-value) "] ") "") actual-value))))
+
+(defn wait-for-property [container target property expected-value]
+  (wait-for-property-pred container target property (fn [v] (= expected-value v))))

 ;;
 ;; Mouse


CMR-3807 Adds params to ACL search GET test

--- access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
@@ -207,9 +207,10 @@
         (is (= (u/acls->search-response (count all-acls) all-acls {:page-size 4 :page-num 2})
                (dissoc (ac/search-for-acls (u/conn-context) {:page_size 4 :page_num 2}) :took)))))
     (testing "GET and POST return the same results"
+      (is (some? (:hits (ac/search-for-acls-get (u/conn-context) {:page_size 3 :page_num 2}))))
       (is
-        (= (dissoc (ac/search-for-acls (u/conn-context) {}) :took)
-           (dissoc (ac/search-for-acls-get (u/conn-context) {}) :took))))))
+        (= (dissoc (ac/search-for-acls (u/conn-context) {:page_size 3 :page_num 2}) :took)
+           (dissoc (ac/search-for-acls-get (u/conn-context) {:page_size 3 :page_num 2}) :took))))))

 (deftest acl-search-by-any-id-test
   (let [token (e/login (u/conn-context) "user1")


Have make-guess & make-clue functions

Have make-guess & make-clue functions

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -139,7 +139,7 @@
   (vec
     (for [ letter target-vec ] (guesses-set letter)) ))

-(defn run-tests []
+(defn do-tests []
   (println "----------------------------------------")
   (println "Tests:")

@@ -228,7 +228,7 @@
 (defn main
   ( [] (main tst-words) )
   ( [word-seq]
-      (run-tests)
+      (do-tests)
       (println "----------------------------------------")
       (let [words-map     (words-by-length word-seq)
             max-word-len  (apply max (keys words-map) )
@@ -250,4 +250,4 @@
 )
 (defn -main [& args] (apply main args) )

-; (defonce sanity-check (run-tests) )
+; (defonce sanity-check (do-tests) )


Some more refactoring on permutations.clj

--- clojure/org/gavrog/clojure/permutations.clj
+++ clojure/org/gavrog/clojure/permutations.clj
@@ -1,21 +1,23 @@
 (ns org.gavrog.clojure.permutations)

-(deftype BacktrackingGenerator [root complete? branch? children extract]
+(deftype BacktrackingGenerator [root children extract desc]
   clojure.lang.Seqable
-  (seq [gen] (map extract (filter complete? (tree-seq branch? children root)))))
+  (seq [_] (filter (comp not nil?)
+                   (map extract (tree-seq (constantly true) children root))))
+  Object
+  (toString [_] (str desc)))

 (defn permutations [n]
   (let [keys (range 1 (inc n))
         root {:perm {}
               :unused (into #{} keys)
               :unseen (into #{} keys)}
-        complete? (comp empty? :unused)
-        branch? (comp seq :unused)
         children (fn [node] (let [{:keys [perm unused unseen]} node]
                               (when-let [i (first unused)]
                                 (for [k unseen]
                                   {:perm (assoc perm i k)
                                    :unused (disj unused i)
                                    :unseen (disj unseen k)}))))
-        extract :perm]
-        (BacktrackingGenerator. root complete? branch? children extract)))
+        extract (fn [node] (when (empty? (:unused node)) (:perm node)))
+        desc (list `permutations n)]
+        (BacktrackingGenerator. root children extract desc)))


Arrows look better on the map

Arrows look better on the map

--- devcards/frontend/devcards/map.cljs
+++ devcards/frontend/devcards/map.cljs
@@ -208,33 +208,36 @@
 (defn map-svg [things-in-columns edges]
   (let [width 150
         height 40
-        x-spacing 50
+        x-spacing 100
         cs (coords things-in-columns)]
     (html
-     [:svg {:width "100%"
-            :height "500"}
-      (for [[x things] (map-indexed vector things-in-columns)]
-        (for [[y thing] (map-indexed vector things)]
-          (if thing
-            [:rect {:stroke "black"
-                    :fill "none"
-                    :width width
-                    :height height
-                    :x (* x (+ width x-spacing))
-                    :y (* y (+ height 10))}])))
-      (for [[from to] edges
-            :let [[fx fy] (get cs from)
-                  [tx ty] (get cs to)]]
-        (let [start (fn [x y]
-                      [(+ width (* x (+ width x-spacing)))
-                       (+ (/ height 2) (* y (+ height 10)))])
-              end (fn [x y]
-                    [(* x (+ width x-spacing))
-                     (+ (/ height 2) (* y (+ height 10)))])]
-          (arrow (start fx fy)
-                 (end tx ty)
-                 (- (first (end tx ty)) 20)
-                 10)))])))
+     [:div {:style {:overflow "auto"}}
+      [:svg {:width "2000"
+             :height "500"}
+       (for [[x things] (map-indexed vector things-in-columns)]
+         (for [[y thing] (map-indexed vector things)]
+           (if thing
+             [:rect {:stroke "black"
+                     :fill "none"
+                     :width width
+                     :height height
+                     :x (* x (+ width x-spacing))
+                     :y (* y (+ height 10))}])))
+       (for [[from to] edges
+             :let [[fx fy] (get cs from)
+                   [tx ty] (get cs to)]]
+         (let [start (fn [x y]
+                       [(+ width (* x (+ width x-spacing)))
+                        (+ (/ height 2) (* y (+ height 10)))])
+               end (fn [x y]
+                     [(* x (+ width x-spacing))
+                      (+ (/ height 2) (* y (+ height 10)))])
+               steps-back (- (count (nth things-in-columns tx)) ty)
+               strut-offset (* 20 steps-back)]
+           (arrow (start fx fy)
+                  (end tx ty)
+                  (- (first (end tx ty)) strut-offset)
+                  10)))]])))

 (defn has-far-arrows? [graph columns node]
   (zero? (g/out-degree (g/subgraph graph (conj (apply concat (rest columns)) node))


start-component fn revised in playground

--- playground/aug.clj
+++ playground/aug.clj
@@ -90,8 +90,27 @@
                         {:components (components-map system-map)})))

+(defn with-component-dependencies
+  "Runs the given function for all the dependencies of the given `component`
+  and the `component` itself and update the given `system` with the result
+  of the execution."
+  [system-map component f]
+  (let [components-map  (conj (component-dependencies system-map component)
+                              component)]
+    (updat! system-map :components
+                   (map f components-map))))

+(defn start-component!
+  "Starts the given `component` of the given `system`."
+  [system-map component]
+  (with-component-dependencies system-map component call-start))
+
+
+(defn start!
+  "Starts the given `system-map`."
+  [system-map]
+  (map #(start-component! system-map %) (get-components system-map)))


common/encode: convert times to ints.

common/encode: convert times to ints.

--- src/reimann/common.clj
+++ src/reimann/common.clj
@@ -45,7 +45,8 @@
 (defn pre-dump-event
   "Transforms an event (map) into a form suitable for protocol buffer encoding."
   [e]
-  (let [e (if (:metric e) (assoc e :metric_f (float (:metric e))) e)]
+  (let [e (if (:metric e) (assoc e :metric_f (float (:metric e))) e)
+        e (if (:time   e) (assoc e :time     (int   (:time e)))   e)]
     e))

 (defn post-load-event


Rewrite simple example to match new README WIP

--- examples/simple/src/simpleexample/core.cljs
+++ examples/simple/src/simpleexample/core.cljs
@@ -1,103 +1,186 @@
 (ns simpleexample.core
   (:require-macros [reagent.ratom :refer [reaction]])
   (:require [reagent.core :as reagent]
-            [re-frame.core :refer [reg-event-db
-                                   path
-                                   reg-sub
-                                   dispatch
-                                   dispatch-sync
-                                   subscribe]]))
-
-;; trigger a dispatch every second
-(defonce time-updater (js/setInterval
-                        #(dispatch [:timer (js/Date.)]) 1000))
-
-(def initial-state
-  {:timer (js/Date.)
-   :time-color "#f88"})
+            [re-frame.core :as rf]))

-;; -- Event Handlers ----------------------------------------------------------
+;; Read this file from the top towards the bottom.
+
+;; Normally I'd recomended you write a schema for the appplication
+;; state. But I'm going to skip that step to keep things simple.
+;;
+;; Suffice it to say the application state looks like this:
+;;   {:time       (js/Date.)
+;;    :time-color "#f88"}
+;;
+;; See FAQ #1 for details on how to inspect application state.
+
+;; -- Domino 1 - Events -------------------------------------------------------
+;;
+;; To send an event you call `dispatch` with a single vector argument.
+;;
+;;    (dispatch [:event-id  value1 value2])
+;;
+;; The first element in the vector identifies the kind of event. The
+;; further elements are optional, additional data associated with the event.
+;;
+;; Below we send a `:timer` event every second. But, typically,
+;; events are `dispatch`ed when a button is clicked or an
+;; HTTP POST's on-success is called or a web sockets gets a new packet.
+;;
+;; So `dispatch` gets called in various places.
+;;
+;; Later, when we get to Domino 5 (view functions) you'll see
+;; an example of DOM elements causing a `dispatch`.
+
+(defn dispatch-timer-event
+  []
+  (let [now (js/Date.)]
+    (rf/dispatch [:timer now])))
+
+;; an event will be dispatched every second
+(defonce time-updater (js/setInterval dispatch-timer-event 1000))

-(reg-event-db                 ;; setup initial state
-  :initialize                     ;; usage:  (dispatch [:initialize])
-  (fn
-    [db _]
-    (merge db initial-state)))    ;; what it returns becomes the new state
+;; -- Domino 2 - Event Handlers -----------------------------------------------
+;;
+;; Associate a "handler function" with each kind of event.
+;;
+;; This application has three events, identified by keywords:
+;;   :initialise
+;;   :time-color-change
+;;   :timer
+;;
+;; Because there's 3 events, below you'll see `reg-event-db`
+;; called 3 times, registering 3 handlers, each like this:
+;;   (reg-event-db
+;;      :a-keyword-id-for-the-event
+;;      a-function-which-will-handle-the-event)
+;;
+;; Any event handler registered via `reg-event-db` will look like this:
+;;    (fn [db v]
+;;       ...)
+;; It will take two parameters, the current application state `db`
+;; and the event vector `v` which is being handled.
+;; It must compute and return the new state of the application.
+;;
+;; Below, you'll sometimes see it written as:
+;;   (fn [db [_ something]]  <-- 2nd vec param destructured to get payload value
+;;       ...)
+;;
+;; An event handler return `effects`.  We're using
+;; `reg-event-db` here which assumes the only effect required (for this event)
+;; is a change to application state.  When you need to do other effects,
+;; like sending emails, or http POSTing, or writing to localstore, you
+;; would use the more sophisticated `reg-event-fx`  (note the trailing -fx) which
+;; is described in the tutorial. We're keeping it simple for the moment.
+
+(rf/reg-event-db              ;; sets up initial application state
+  :initialize                 ;; usage:  (dispatch [:initialize])
+  (fn [_ _]                   ;; the two parameters are not important here, so use _
+    {:time (js/Date.)         ;; What it returns becomes the new application state
+     :time-color "#f88"}))    ;; so the application state will initially be a map with two keys

-(reg-event-db
-  :time-color                     ;; usage:  (dispatch [:time-color 34562])
-  (path [:time-color])            ;; this is middleware
-  (fn
-    [time-color [_ value]]        ;; path middleware adjusts the first parameter
-    value))
+(rf/reg-event-db                ;; usage:  (dispatch [:time-color-change 34562])
+  :time-color-change            ;; dispatched when the user enters a new colour into the UI
+  (fn [db [_ new-color-value]]  ;; -db event handlers given 2 parameters:  current application state and event (a vector)
+    (assoc db :time-color new-color-value)))   ;; compute and return the new application state

-(reg-event-db
-  :timer
-  (fn
-    ;; the first item in the second argument is :timer the second is the
-    ;; new value
-    [db [_ value]]
-    (assoc db :timer value)))    ;; return the new version of db
+(rf/reg-event-db                 ;; usage:  (dispatch [:timer a-js-Date])
+  :timer                         ;; every second an event of this kind will be dispatched
+  (fn [db [_ new-time]]          ;; note how the 2nd parameter is desctructure to obtain the data value
+    (assoc db :time new-time)))  ;; compute and return the new application state

-;; -- Subscription Handlers ---------------------------------------------------
+;; -- Domino 3 - Efect Handlers -----------------------------------------------
+;;
+;; You almost never have to write effect handlers. You just use the standard
+;; re-frame ones or, sometimes, ones from a library.
+;;
+;; In this simple app, the only effect returned by event handlers is that
+;; of changing application state, which is a standard effect, and even THAT
+;; effect is implied (rather than explicit) because we are using the
+;; helpful registration function `reg-event-db`
+;;
+;; Just know that effects are happening but we don't need to do anything.  We'll
+;; learn more about effect handlers later.

-(reg-sub
-  :timer
-  (fn
-    [db _]             ;; db is the value currently in the app-db atom
-    (:timer db)))
+;; -- Domino 4 - Subscription Handlers ----------------------------------------
+;;
+;; These query functions take application state and return a "materialised view"
+;; of that state. A computation over the current application state.
+;;
+;; Now, the examples below are trivial. They just extract part of the application
+;; state and return it. Virtually no computation.
+;;
+;; More interesting subscriptions and more explanation can be found in the
+;; todomvc example.
+;;
+;; `reg-sub` associates a `query identifier` with a function which computes
+;;  that query, like this:
+;;   (reg-sub
+;;     :some-query-id      ;; query identifier
+;;     some-function)      ;; the function which will compute the query
+;; If ever a view requests data like this:
+;;     `(listen [:some-query-id])`   ;; note use of `:some-query-id`
+;; then `some-function` will be used to perform the query over applciation state
+;; when a
+;;
+;; Each time application state changes, `some-function` will be
+;; called again to compute a new materialised view (a new computation)
+;; and that new value will be given to any view function which is subscribed
+;; to `:some-query-id`. The view function itself will then also be called again
+;; to create new DOM (because it depends on a query value which changed).
+;;
+;; re-frame will ensure the necessary calls are made, at the right time.
+;;
+(rf/reg-sub
+  :time
+  (fn [db _]     ;; db is current app state. 2nd usused param is query vector
+    (:time db))) ;; return a query computation over the application state

-
-(reg-sub
+(rf/reg-sub
   :time-color
-  (fn
-    [db _]
+  (fn [db _]
     (:time-color db)))

-;; -- View Components ---------------------------------------------------------
-
-(defn greeting
-  [message]
-  [:h1 message])
-
+;; -- Domino 5 - View Functions ----------------------------------------------
+;;
+;; We're using Reagent here.
+;; These functions turn data into DOM. They render the UI.
+;; The data they return is a hiccup formated description of the DOM required.
+;; They take two sources of data:
+;;   - arguments
+;;   - queries which obtain data from the application state.
+;;
+;;
+;; Noitce that color-input has a dispatch

 (defn clock
   []
-  (let [time-color (subscribe [:time-color])
-        timer (subscribe [:timer])]
-    (fn clock-render
-        []
-        (let [time-str (-> @timer
-                           .toTimeString
-                           (clojure.string/split " ")
-                           first)
-              style {:style {:color @time-color}}]
-             [:div.example-clock style time-str]))))
-
+  [:div.example-clock
+   {:style {:color (rf/listen [:time-color])}}
+   (-> (rf/listen [:time])
+       .toTimeString
+       (clojure.string/split " ")
+       first)])

 (defn color-input
   []
-  (let [time-color (subscribe [:time-color])]
-    (fn color-input-render
-        []
-        [:div.color-input
-         "Time color: "
-         [:input {:type "text"
-                  :value @time-color
-                  :on-change #(dispatch
-                               [:time-color (-> % .-target .-value)])}]])))
+  [:div.color-input
+   "Time color: "
+   [:input {:type "text"
+            :value (rf/listen [:time-color])
+            :on-change #(rf/dispatch [:time-color-change (-> % .-target .-value)])}]])  ;; <---

-(defn simple-example
+(defn ui
   []
   [:div
-   [greeting "Hello world, it is now"]
+   [:h1 "Hello world, it is now"]
    [clock]
    [color-input]])

@@ -107,7 +190,7 @@

 (defn ^:export run
   []
-  (dispatch-sync [:initialize])
-  (reagent/render [simple-example]
+  (dispatch-sync [:initialize])     ;; puts a value into application state
+  (reagent/render [ui]              ;; mount the application's ui into '<div id="app" />'
                   (js/document.getElementById "app")))


drawing red and blue marbles

drawing red and blue marbles

--- src/nonaga/draw.cljs
+++ src/nonaga/draw.cljs
@@ -1,5 +1,5 @@
 (ns nonaga.draw
-  (:require
+  (:require
     [dommy.utils :as utils]
     [dommy.core :as dommy])
   (:use-macros
@@ -25,26 +25,54 @@

 (def svg
   (make-svg "svg"
-            :xmlns "http://www.w3.org/2000/svg"
+            :xmlns "http://www.w3.org/2000/svg"
             :viewbox "0 0 1200 800"
             :width  "200px"
             :height "200px"))

 (defn ring [x y]
-  (make-svg "circle" :cx x :cy y :r 18 :fill "transparent" :stroke "blue"))
+  (make-svg "circle"
+            :cx x
+            :cy y
+            :r 14
+            :fill "transparent"
+            :stroke "grey"
+            :stroke-width "7px"))
+
+(defn marble [x y color]
+  (make-svg "circle"
+            :cx x
+            :cy y
+            :r 8
+            :fill color))

 (dommy/append! (sel1 :body) svg)

 (def rings
   (list
-       [1 4] [2 4] [3 4]
+       [1 4] [2 4] [3 4]
      [0 3] [1 3] [2 3] [3 3]
-   [0 2] [1 2] [2 2] [3 2] [4 2]
-     [0 1] [1 1] [2 1] [3 1]
+   [0 2] [1 2] [2 2] [3 2] [4 2]
+     [0 1] [1 1] [2 1] [3 1]
        [1 0] [2 0] [3 0]))

-(def svg-node
-  (sel1 :svg))
+
+(def reds
+  (list
+       [1 4]
+
+                           [4 2]
+
+       [1 0]))
+
+(def blues
+  (list
+                   [3 4]
+
+   [0 2]
+
+                   [3 0]))
+

 (defn hex-coord->svg-coord [[hex-x hex-y]]
   (let [x (+ 20 (* 40 hex-x) (if (odd? hex-y) 20 0))
@@ -60,6 +88,11 @@
        (map hex-coord->svg-coord)
        (mapv (fn [[x y]] (dommy/append! svg-node (ring x y))))))

+(defn draw-marbles [svg-node coords color]
+  (->> coords
+       (map hex-coord->svg-coord)
+       (mapv (fn [[x y]] (dommy/append! svg-node (marble x y color))))))
+
 (defn draw-coords [svg-node coords]
   (letfn [(draw [coord [x y]]
             (let [text (make-text (- x 10) (+ y 5) (coord->str coord))]
@@ -68,7 +101,9 @@
          (map hex-coord->svg-coord)
          (mapv draw coords))))

-(draw-rings svg-node rings)
+(draw-marbles svg reds "red")
+(draw-marbles svg blues "blue")
+(draw-rings svg rings)

-; (draw-coords svg-node rings)
+; (draw-coords svg rings)


add :wait-for

add :wait-for

--- src/osmium/eval.cljc
+++ src/osmium/eval.cljc
@@ -97,6 +97,12 @@
 (defmethod eval!* :wait [driver [_ milliseconds]]
   (Thread/sleep milliseconds))

+(defmethod eval!* :wait-for [driver [_ q timeout interval]]
+  (taxi/wait-until driver
+                   (fn [_] (taxi/exists? driver {:css q}))
+                   (or timeout 5000)
+                   (or interval 500)))
+
 (declare expand)

 (defmulti eval! (fn [driver xs] (type (first xs))))


Update core; localize max-generations to run

--- clojure/src/evolution_programs/core.clj
+++ clojure/src/evolution_programs/core.clj
@@ -13,8 +13,6 @@
   (fn [p g]
     (doseq [l loggers] (l p g))))

-(def max-generations 20)
-
 (defn preserving-fittest [f]
   (fn [& args]
     (let [population (last args)
@@ -28,14 +26,15 @@
   ([objective limits]
    (run objective limits (spread-logger (console/logger) (chart/logger))))
   ([objective limits logger]
-   (ga/run
-     objective
-     (preserving-fittest selection/binary-tournament-without-replacement)
-     (preserving-fittest (partial recombination/crossover-mutation
-                                  (partial crossover/simulated-binary-with-limits limits)
-                                  (partial mutation/parameter-based-with-limits limits max-generations)))
-     (ga/terminate-max-generations? max-generations)
-     (random-generators/generate-population 20 limits)
-     logger)))
+   (let [max-generations 50]
+     (ga/run
+       objective
+       (preserving-fittest selection/binary-tournament-without-replacement)
+       (preserving-fittest (partial recombination/crossover-mutation
+                                    (partial crossover/simulated-binary-with-limits limits)
+                                    (partial mutation/parameter-based-with-limits limits max-generations)))
+       (ga/terminate-max-generations? max-generations)
+       (random-generators/generate-population 30 limits)
+       logger))))

 (defn maximize [f & options] (apply run (cons (objective/maximize f) options)))


Update core; make preserving-fittest private

--- clojure/src/evolution_programs/core.clj
+++ clojure/src/evolution_programs/core.clj
@@ -13,7 +13,7 @@
   (fn [p g]
     (doseq [l loggers] (l p g))))

-(defn preserving-fittest [f]
+(defn- preserving-fittest [f]
   (fn [& args]
     (let [population (last args)
           fittest (apply max-key #(:fitness (meta %)) population)


updated internal hrefs to refer to new hash-free urls rather than filenames. This should help analytics and SEO.

--- src/prais2/core.cljc
+++ src/prais2/core.cljc
@@ -142,7 +142,7 @@

      ([fragment static]
       (if static
-        (str "/" fragment ".html")
+        (str "/" fragment)
         (if (= prefix "#")
           (str "/#/" fragment)
           (str "/" fragment))))))                           ;; :todo test
@@ -150,7 +150,7 @@
 #?(:clj
    (defn irl "internal resource locator"
      ([fragment _]                                          ; static option
-      (str "/" fragment ".html"))
+      (str "/" fragment))

      ([fragment]
       (irl fragment true))
@@ -209,10 +209,6 @@
   ;;(core/isrc "/assets/foo.png" :style {:color "red"} :width 3)
   ;;=> {:src "/assets/foo.png", :style {:color "red"}, :width 3}
   )
-
-
-
-

 #?(:cljs


minor

minor

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -304,9 +304,10 @@
                                                                  :min 0
                                                                  :max 1
                                                                  :step 0.01
-                                                                 :value (:slider-axis-value @core/app)
+                                                                ; :value (:slider-axis-value @core/app)
                                                                  }))
-                      handler #((do (put! event-bus [:slider-axis-value (.getValue slider)])))
+                      handler #(do
+                                 (put! event-bus [:slider-axis-value (.getValue slider)]))
                       state' (assoc state :slider slider :handler handler)]

                   (.on slider "slide" handler)


CMR-1294: Added newline

CMR-1294: Added newline

--- metadata-db-app/src/migrations/012_add_granule_index_with_revision_date.clj
+++ metadata-db-app/src/migrations/012_add_granule_index_with_revision_date.clj
@@ -10,6 +10,7 @@
   (doseq [t (h/get-granule-tablenames)]
     (h/sql (format "create index %s_crddr on %s (concept_id, revision_id, deleted, delete_time, revision_date)"))
     (h/sql (format "drop index %s_crdi" t))))
+
 (defn down
   "Migrates the database down from version 12."
   []


[input-text] should callback with the text, not the event object.