fixed on-select and clean up

fixed on-select and clean up

--- frameworks/keyed/helix/src/demo/main.cljs
+++ frameworks/keyed/helix/src/demo/main.cljs
@@ -5,29 +5,12 @@
             ["react-dom" :as rdom]
             [demo.utils :as u]))

-(def start-time (atom nil))
-(def last-measure (atom nil))
-
-(defn start-measure [name]
-  (reset! start-time (.now js/performance))
-  (reset! last-measure name))
-
-(defn stop-measure []
-  (if-let [last @last-measure]
-    (.setTimeout js/window
-                 (fn []
-                   (reset! last-measure nil)
-                   (let [stop (.now js/performance)]
-                     (.log js/console (str last " took " (- stop @start-time)))))
-                 0)))
-
-
-(defnc row [{:keys [data selected? on-click on-delete]}]
+(defnc row [{:keys [data selected? on-select on-delete]}]
   (d/tr {:class (if selected? "danger")}
     (d/td {:class "col-md-1"}
           (:id data))
     (d/td {:class "col-md-4"}
-          (d/a {:on-click (fn [e] (on-click (:id data)))}
+          (d/a {:on-click (fn [e] (on-select (:id data)))}
                (:label data)))
     (d/td {:class "col-md-1"}
      (d/a {:on-click (fn [e] (on-delete (:id data)))}
@@ -41,46 +24,33 @@
   (js/console.log "re-render")
   (let [[data set-data] (use-state [])
         [selected set-selected] (use-state nil)
-        print-duration
-        (fn print-duration []
-          (stop-measure))
         run
         (fn run [_]
-          (start-measure "run")
           (set-data (vec (u/build-data id-atom 1000)))
           (set-selected nil))
         run-lots
         (fn run-lots [_]
-          (start-measure "runLots")
           (set-data (vec (u/build-data id-atom 10000)))
           (set-selected nil))
         add
         (fn add [_]
-          (start-measure "add")
           (set-data u/add id-atom))
         update-some
         (fn update-some []
-          (start-measure "update")
           (set-data u/update-some))
         clear
         (fn clear []
-          (start-measure "clear")
           (set-selected nil)
           (set-data []))
         swap-rows
         (fn swap-rows []
-          (start-measure "swapRows")
           (set-data u/swap-rows))
         select
         (fn select [id]
-          (start-measure "select")
           (set-selected id))
         delete
         (fn delete [id]
-          (start-measure "delete")
           (set-data u/delete-row id))]
-    (use-effect :always
-      (print-duration))
     (d/div
      {:class "container"}
      (d/div
@@ -88,7 +58,7 @@
       (d/div
        {:class "row"}
        (d/div {:class "col-md-6"}
-              (d/h1 (str "Helix (total rows " (count data) ")")))
+              (d/h1 (str "Helix")))
        (d/div {:class "col-md-6"}
               (d/div {:class "row"}
                      (d/div {:class "col-sm-6 smallpad"}


Adding a key to the list of selected tropes

For now it'll be a hash of the trope itself, but I expect we'll change
it to some guid in the future, when we need to keep a link to the
specific trope reference on the database.

--- src-cljs/tropology/core.cljs
+++ src-cljs/tropology/core.cljs
@@ -61,7 +61,6 @@
 (re-frame/register-handler
   :vote
   (fn [app-state [_ vote]]
-    (.log js/console (str "Voted  " vote))
     (let [current-ref (get-in app-state [:article-data :current-reference])]
       (if (= vote :like)
         (re-frame/dispatch [:add-like current-ref]))
@@ -205,7 +204,7 @@
          [:p "Selected items: "]
          [:ul
           (for [trope @like-list]
-            [:li (process-trope trope [false])])]
+            ^{:key (hash trope)} [:li (process-trope trope [false])])]
          ])
       ]])
   )


Support for default value for parse-int

Support for default value for parse-int

--- src/emender_jenkins/metadata_reader.clj
+++ src/emender_jenkins/metadata_reader.clj
@@ -36,9 +36,12 @@
 (def metadata (atom nil))

 (defn parse-int
-    [^String string]
-    (if (and string (re-matches #"[0-9]+" string))
-        (java.lang.Integer/parseInt string))) ; nil instead
+    ([^String string]
+     (parse-int string nil)) ; nil instead
+    ([^String string default-value]
+     (if (and string (re-matches #"[0-9]+" string))
+         (java.lang.Integer/parseInt string)
+         default-value)))

 (defn read-and-parse-list-of-commiters
     [jenkins-url job-name]


Remove duplicate check

Remove duplicate check

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -67,8 +67,7 @@
                                (str "Logged in as " (get-in data [:user :nickname])))
                       (dom/div #js {:className "col-md-5"}))
                     (dom/div #js {:className "col-md-2 text-center"}
-                             (when (lib/loading?)
-                               (loading-element)))
+                             (loading-element))

                     (if (lib/logged-in?)
                       (dom/div #js {:className "col-md-5 text-right pointer"


Convert some events from reify to deftype.

--- frontend/src/uxbox/main/data/shapes.cljs
+++ frontend/src/uxbox/main/data/shapes.cljs
@@ -109,15 +109,21 @@
   [data]
   (AddShape. data))

+;; --- Delete Shape
+
+(deftype DeleteShape [id]
+  udp/IPageUpdate
+  ptk/UpdateEvent
+  (update [_ state]
+    (println "DeleteShape$update" id)
+    (let [shape (get-in state [:shapes id])]
+      (impl/dissoc-shape state shape))))
+
 (defn delete-shape
   "Remove the shape using its id."
   [id]
-  (reify
-    udp/IPageUpdate
-    ptk/UpdateEvent
-    (update [_ state]
-      (let [shape (get-in state [:shapes id])]
-        (impl/dissoc-shape state shape)))))
+  {:pre [(uuid? id)]}
+  (DeleteShape. id))

 (defn update-shape
   "Just updates in place the shape."
@@ -603,15 +609,19 @@
   []
   (DuplicateSelected.))

+;; --- Delete Selected
+
+(deftype DeleteSelected []
+  ptk/WatchEvent
+  (watch [_ state stream]
+    (let [selected (get-in state [:workspace :selected])]
+      (rx/from-coll
+       (into [(deselect-all)] (map #(delete-shape %) selected))))))
+
 (defn delete-selected
   "Deselect all and remove all selected shapes."
   []
-  (reify
-    ptk/WatchEvent
-    (watch [_ state s]
-      (let [selected (get-in state [:workspace :selected])]
-        (rx/from-coll
-         (into [(deselect-all)] (map #(delete-shape %) selected)))))))
+  (DeleteSelected.))

 (deftype UpdateSelectedShapesAttrs [attrs]
   ptk/WatchEvent


Still cannot figure out why this is happening

--- src/lazubot/worker.clj
+++ src/lazubot/worker.clj
@@ -19,7 +19,9 @@
       (when-let [message (String. (<!! reply-out))]
         (println (str "Received " message))
         (try
-          (>!! reply-in (eval-form message))
+          (let [evaluated (eval-form message)]
+            (println (str "Sending " evaluated))
+            (>!! reply-in evaluated))
           (catch Exception e
             (>!! reply-in (str e))))
         (recur)))))


Add hooks using symbols instead of strings.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -88,7 +88,7 @@

 (defn run-task [task args]
   (load-hooks task)
-  ((join-hooks (@hooks task))
+  ((join-hooks (@hooks (symbol task)))
    #(apply (resolve-task task) args)))

 (defn ns->path [n]


Use with-ns so defproject works unqualified. Bind *compile-path* explicitly.

Not sure why explicit *compile-path* is required, but it was getting
reset somehow.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -1,6 +1,5 @@
 (ns leiningen.core
-  (:require [leiningen deps test compile]
-            [clojure.contrib.with-ns])
+  (:use [clojure.contrib.with-ns])
   (:gen-class))

 (def project nil)
@@ -15,15 +14,22 @@
                                   :root ~(.getParent (java.io.File. *file*)))))
        (def ~project-name project)))

+;; So it doesn't need to be fully-qualified in project.clj
+(with-ns 'user (use ['leiningen.core :only ['defproject]]))
+
 (defn read-project
   ([file] (load-file file)
      project)
   ([] (read-project "project.clj")))

 (defn -main [command & args]
-  (let [action (ns-resolve (symbol (str "leiningen." command))
-                           (symbol command))]
-    ;; TODO: ensure tasks run only once
-    (apply action (read-project) args)
-    ;; In case tests or some other task started any:
-    (shutdown-agents)))+  (let [action-ns (symbol (str "leiningen." command))
+        _ (require action-ns)
+        action (ns-resolve action-ns (symbol command))
+        project (read-project)]
+    (binding [*compile-path* (or (:compile-path project)
+                                 (str (:root project) "/classes/"))]
+      ;; TODO: ensure tasks run only once
+      (apply action project args)
+      ;; In case tests or some other task started any:
+      (shutdown-agents))))


Do not set a user-wide :dev profile as per lein docs.

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -1,5 +1,6 @@
 {:user
- {:plugin-repositories [["private-plugins"
+ {:env {:squiggly {:checkers [:eastwood]}}
+  :plugin-repositories [["private-plugins"
                          {:url "private repo url"}]]
         :singing {:gpg-key "matthew.russell@wormbase.org"}
         :dependencies [[clojure-ini "0.0.2"]
@@ -14,8 +15,6 @@
  :repl {:dependencies [[acyclic/squiggly-clojure "0.1.6"]
                        [datomic-schema-grapher "0.0.1"]
                        [org.clojure/tools.nrepl "0.2.12"]]}
- :dev {:env
-       {:squiggly {:checkers [:eastwood]}}}
  ;; VisualVM profiling opts
  :jvm-opts ["-Dcom.sun.management.jmxremote"
             "-Dcom.sun.management.jmxremote.ssl=false"


-- adding the DatePicker to the list of working MaterialUI components

--- src/om_material_ui/core.cljx
+++ src/om_material_ui/core.cljx
@@ -12,6 +12,7 @@
   AppCanvas
   Circle
   Checkbox
+  DatePicker
   DialogWindow
   Dialog
   DropDownIcon


gt and lt filters for pace, distance duration and avghr

--- src/ontrail/mongerfilter.clj
+++ src/ontrail/mongerfilter.clj
@@ -3,6 +3,8 @@
 	(:require 	[clj-time.format :as format]
 				[clojure.string :as string]
 			  	[clj-time.core :as time]))
+
+(def #^{:private true} logger (org.slf4j.LoggerFactory/getLogger (str *ns*)))

 (def multi-parser (format/formatter (time/default-time-zone)
                                     "dd.MM.yyyy"
@@ -10,6 +12,13 @@
                                     "yyyy"))

 (defn parse-date [val] (format/parse multi-parser val))
+
+(defn parse-long [val]
+    (try
+      (Long/valueOf val)
+    (catch Exception exception
+      (.info logger (str exception " with " val))
+      0)))

 (defn conv-fun [sport-key]
 	(if (sport-key #{:distance :duration})
@@ -37,10 +46,15 @@
 (defn make-basic-query [query-keys]
 	(vec (map (partial apply or-filter) query-keys)))

+(defn long-cmp-keys[]
+	(vec (for [op ["lte" "gte" "lt" "gt"] qkey ["pace" "distance" "duration" "avghr"]]
+		(keyword (str op "_" qkey)))))
+
 (defn make-query-from [params]
   (let [basic-query (make-basic-query (select-keys params [:user :tags :sport :distance :duration]))
-  		date-range-query (make-range-query parse-date (select-keys params [:lte_creationDate :gte_creationDate]))]
-  	{$and (vec (concat basic-query date-range-query))}))
+  		date-range-query (make-range-query parse-date (select-keys params [:lte_creationDate :gte_creationDate]))
+  		long-range-query (make-range-query parse-long (select-keys params (long-cmp-keys)))]
+  	{$and (vec (concat basic-query date-range-query long-range-query))}))

 (defn sortby [params]
 	(if-let [sortkey (:sb params)]


.info --> .trace

.info --> .trace

--- src/ontrail/sportsummary.clj
+++ src/ontrail/sportsummary.clj
@@ -87,7 +87,7 @@
   (let [now (time/now)
         year (time/year now)
         up-to-month (+ 2 (time/month now))]
-    (.info logger (str "memoizing after reset for: " user))
+    (.trace logger (str "memoizing after reset for: " user))
     (doall (get-overall-summary user))
     (doall (get-overall-tags-summary user))
     (doall (get-year-summary-sport user year))


Drop all scheduler related data, too.

Drop all scheduler related data, too.

--- src/onyx/log/commands/gc.clj
+++ src/onyx/log/commands/gc.clj
@@ -15,7 +15,10 @@
           (reduce (fn [new job] (update-in new [:killed-jobs] remove-f)) x jobs)
           (reduce (fn [new job] (update-in new [:tasks] dissoc job)) x jobs)
           (reduce (fn [new job] (update-in new [:allocations] dissoc job)) x jobs)
-          (reduce (fn [new job] (update-in new [:completions] dissoc job)) x jobs))))
+          (reduce (fn [new job] (update-in new [:completions] dissoc job)) x jobs)
+          (reduce (fn [new job] (update-in new [:task-schedulers] dissoc job)) x jobs)
+          (reduce (fn [new job] (update-in new [:percentages] dissoc job)) x jobs)
+          (reduce (fn [new job] (update-in new [:task-percentages] dissoc job)) x jobs))))

 (extensions/apply-log-entry {:fn :gc :args {:id 1}}
                             {:jobs [:j1 :j2 :j3]


Pre-generate task ids since they're not really egress-ids any more

Clean up onyx-function task

--- src/onyx/static/planning.clj
+++ src/onyx/static/planning.clj
@@ -5,7 +5,7 @@
   (:import [java.util UUID]))

 (defmulti create-io-task
-  (fn [element parents children]
+  (fn [task-ids element parents children]
     (:onyx/type element)))

 (defn only [coll]
@@ -18,57 +18,60 @@
   (let [matches (filter #(= task-name (:onyx/name %)) catalog)]
     (only matches)))

-(defn egress-ids-from-children [elements]
-  (into {} (map #(hash-map (:onyx/name %) (java.util.UUID/randomUUID)) elements)))
+(defn egress-ids-from-children [task-ids elements]
+  (into {}
+        (map (juxt identity task-ids)
+             (map :onyx/name elements))))

 (defmulti create-task
-  (fn [catalog task-name parents children-names]
+  (fn [task-ids catalog task-name parents children-names]
     (:onyx/type (find-task catalog task-name))))

 (defmethod create-task :default
-  [catalog task-name parents children-names]
+  [task-ids catalog task-name parents children-names]
   (let [element (find-task catalog task-name)
         children (map (partial find-task catalog) children-names)]
-    (create-io-task element parents children)))
+    (create-io-task task-ids element parents children)))

-(defn onyx-function-task [catalog task-name parents children-names]
+(defn onyx-function-task [task-ids catalog task-name parents children-names]
   (let [element (find-task catalog task-name)
-        children (map (partial find-task catalog) children-names)]
-    (if (= (count (into #{} (map (comp (:onyx/name element) :egress-ids) parents))) 1)
-      [{:id (get (:egress-ids (first parents)) (:onyx/name element))
-        :name (:onyx/name element)
-        :egress-ids (egress-ids-from-children children)}]
+        children (map (partial find-task catalog) children-names)
+        element-name (:onyx/name element)
+        task-id (task-ids element-name)]
+    (if (= (count parents) 1)
+      [{:id task-id
+        :name element-name
+        :egress-ids (egress-ids-from-children task-ids children)}]
       (concat
-       [{:id (get (:egress-ids (first parents)) (:onyx/name element))
-         :name (:onyx/name element)
-         :egress-ids (egress-ids-from-children children)}]
-       (map #(assoc-in % [:egress-ids (:onyx/name element)]
-                       (get (:egress-ids (first parents)) (:onyx/name element)))
-            (rest parents))))))
+        [{:id task-id
+          :name element-name
+          :egress-ids (egress-ids-from-children task-ids children)}]
+        (map #(assoc-in % [:egress-ids (:onyx/name element)] task-id)
+             (rest parents))))))

 (defmethod create-task :function
-  [catalog task-name parents children-names]
-  (onyx-function-task catalog task-name parents children-names))
+  [task-ids catalog task-name parents children-names]
+  (onyx-function-task task-ids catalog task-name parents children-names))

 (defmethod create-task :grouper
-  [catalog task-name parents children-names]
-  (onyx-function-task catalog task-name parents children-names))
+  [task-ids catalog task-name parents children-names]
+  (onyx-function-task task-ids catalog task-name parents children-names))

 (defmethod create-task :aggregator
-  [catalog task-name parents children-names]
-  (onyx-function-task catalog task-name parents children-names))
+  [task-ids catalog task-name parents children-names]
+  (onyx-function-task task-ids catalog task-name parents children-names))

 (defmethod create-io-task :input
-  [element parent children]
-  [{:id (UUID/randomUUID)
+  [task-ids element parent children]
+  [{:id (task-ids (:onyx/name element))
     :name (:onyx/name element)
-    :egress-ids (egress-ids-from-children children)}])
+    :egress-ids (egress-ids-from-children task-ids children)}])

 (defmethod create-io-task :output
-  [element parents children]
+  [task-ids element parents children]
   (let [task-name (:onyx/name element)]
-    [{:id (get (:egress-ids (first parents)) (:onyx/name element))
-      :name (:onyx/name element)}]))
+    [{:id (task-ids task-name)
+      :name task-name}]))

 (defn to-dependency-graph [workflow]
   (reduce (fn [g edge]
@@ -78,16 +81,22 @@
 (defn remove-dupes [coll]
   (map last (vals (group-by :name coll))))

+(defn gen-task-ids [nodes]
+  (into {}
+        (map (juxt identity (fn [_] (java.util.UUID/randomUUID)))
+             nodes)))
+
 (defn discover-tasks [catalog workflow]
   (let [dag (to-dependency-graph workflow)
-        sorted-dag (dep/topo-sort dag)]
+        sorted-dag (dep/topo-sort dag)
+        task-ids (gen-task-ids sorted-dag)]
     (remove-dupes
      (reduce
       (fn [tasks element]
         (let [parents (dep/immediate-dependencies dag element)
               children (dep/immediate-dependents dag element)
               parent-entries (filter #(some #{(:name %)} parents) tasks)]
-          (concat tasks (create-task catalog element parent-entries children))))
+          (concat tasks (create-task task-ids catalog element parent-entries children))))
       []
       sorted-dag))))


Fix typo.

Fix typo.

--- src/lib/cljs/one/browser/animation.cljs
+++ src/lib/cljs/one/browser/animation.cljs
@@ -635,6 +635,6 @@
                       {:effect :slide :up 40 :time 200}))
   (event/listen-once label-up
                      "finish"
-                     #(js/alert "Anaimation finished."))
+                     #(js/alert "Animation finished."))
   (start label-up)
   )


switch away from goog.provide as Closure checks for this, use goog/constructNamespace_ for now. While it would seem to make sense to just goog.provide cljs.user in cljs.core, this will likely cause trouble later when we support files without namespaces (which will likely all live under cljs.user)

--- src/main/cljs/clojure/browser/repl.cljs
+++ src/main/cljs/clojure/browser/repl.cljs
@@ -120,7 +120,7 @@
     ;; suppress useless Google Closure error about duplicate provides
     (set! (.-isProvided_ js/goog) (fn [name] false))
     ;; provide cljs.user
-    (goog/provide "cljs.user")
+    (goog/constructNamespace_ "cljs.user")
     (set! (.-writeScriptTag__ js/goog)
       (fn [src opt_sourceText]
         ;; the page is already loaded, we can no longer leverage document.write


Update task.clj

Update task.clj

--- src/iyye/bios/task.clj
+++ src/iyye/bios/task.clj
@@ -71,8 +71,8 @@
   (run-on-all-tasks #(future-cancel @(:task-future %))))

 (defn resume []
-  (run-on-all-tasks #(ref-set (:task-future %) (future (while (not (Thread/interrupted))
-                                                            (dorun [((:function %))]))))))
+  (run-on-all-tasks #(dosync (ref-set (:task-future %) (future (while (not (Thread/interrupted))
+                                                            (dorun [((:function %))])))))))

 (defn shutdown []
   "Trivial now. FIXME Yumzya later add saving in-progress tasks"


doc strings

doc strings

--- src/pipeline/grafter/pipeline/types.clj
+++ src/pipeline/grafter/pipeline/types.clj
@@ -1,4 +1,4 @@
-(ns ^:no-doc grafter.pipeline.types
+(ns grafter.pipeline.types
   "This namespace code for parsing and interpreting
   grafter.pipeline/declare-pipeline type signatures.  In particular it
   defines a macro deftype-reader that can be used to coerce/read
@@ -25,10 +25,10 @@
 ;; already know the target type from the pipelines declaration.

-(defmulti type-reader (fn [target-type input-value]
-                        [target-type (type input-value)]))
-
-(defmulti can-parse-type? identity)
+(defmulti ^:no-doc type-reader (fn [target-type input-value]
+                                 [target-type (type input-value)]))
+
+(defmulti ^:no-doc can-parse-type? identity)

 (defmethod can-parse-type? :default [v]
   false)
@@ -114,7 +114,7 @@
          (type-reader (:class et) sa)) expected-types supplied-args))

 ;;[Symbol] -> {:arg-types [Symbol], :return-type Symbol]}
-(defn parse-type-list
+(defn ^:no-doc parse-type-list
   "Parses a given list of symbols expected to represent a pipeline
   type definition. Validates the list has the expected format - n >= 0
   parameter types followed by a '-> followed by the return
@@ -165,7 +165,7 @@
       (throw (IllegalArgumentException. (str "Unsupported pipeline parameter type: " param-class))))))

 ;;Namespace -> Symbol -> Var
-(defn resolve-var
+(defn ^:no-doc resolve-var
   "Attempts to resolve a named var inside the given namespace. Throws
   an exception if the resolution fails."
   [ns v]
@@ -221,7 +221,7 @@
              correlated-docs)))))

 ;;Var -> [Symbol] -> Metadata -> PipelineDef
-(defn create-pipeline-declaration
+(defn ^:no-doc create-pipeline-declaration
   "Inspects a var containing a pipeline function along with an
   associated type definition and metadata map. The type definition
   should declare the type of each parameter and the return type of the


adding more documentation to the database migrations functions

--- src/bitfondue/migrations.clj
+++ src/bitfondue/migrations.clj
@@ -4,14 +4,22 @@
             [bitfondue.config :as config]
             [cheshire.core :refer :all]))

-(defn load-config []
+;; Database Migrations
+
+(defn ^:private load-config
+  "Create the configuration map for the migration/rollback functions"
+  []
   {:datastore  (jdbc/sql-database config/database)
    :migrations (jdbc/load-resources "migrations")})

-(defn migrate []
+(defn migrate
+  "Helper function to be called to run the database migrations against the current environment settings"
+  []
   (repl/migrate (load-config)))

-(defn rollback []
+(defn rollback
+  "Helper function to be called to run the database rollbacks against the current environment settings"
+  []
   (repl/rollback (load-config)))


Add list-platform-test

Add list-platform-test

--- test/grimoire/api/web_test.clj
+++ test/grimoire/api/web_test.clj
@@ -32,6 +32,15 @@
     (is (succeed? ?res))
     (doseq [?v (result ?res)]
       (is (t/version? ?v)))))
+
+(deftest list-platform-test
+  (let [v    (->  (t/->Group "org.clojure")
+                  (t/->Artifact "clojure")
+                  (t/->Version "1.6.0"))
+        ?res (api/list-platforms test-config v)]
+    (is (succeed? ?res))
+    (doseq [?platform (result ?res)]
+      (is (t/platform? ?platform)))))

 (deftest list-ns-test
   (let [v    (->  (t/->Group "org.clojure")
@@ -77,7 +86,7 @@
     (doseq [ns (result ?nss)]
       (is (t/namespace? ns))
       (is (succeed? (api/read-meta test-config ns)))
-
+
       (let [?defs (api/list-defs test-config ns)]
         (is (succeed? ?defs))
         (doseq [d (result ?defs)]


(PDB-4636) run-migrations: move pending-migration lookup inside txn

Arguably more appropriate (though still perhaps not sufficient to
fully protect migrations), and prepares for some broader migration
protections.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1630,43 +1630,42 @@
                    unexpected))))
     true))

+(defn analyze-if-exists [tables]
+  (let [exists?  (->> "select tablename from pg_catalog.pg_tables"
+                      jdbc/query-to-vec
+                      (map :tablename)
+                      set)
+        tables (filter exists? tables)]
+    (log/info (trs "Updating table statistics for: {0}" (str/join ", " tables)))
+    (apply jdbc/do-commands-outside-txn
+           (map #(str "vacuum analyze " %) tables))))
+
 (defn run-migrations
   []
+  (require-valid-schema)
   (let [small-tables (set ["value_types" "report_statuses"])
-        analyze (fn [tables]
-                  (let [exists?  (->> "select tablename from pg_catalog.pg_tables"
-                                      jdbc/query-to-vec
-                                      (map :tablename)
-                                      set)
-                        tables (filter exists? tables)]
-                    (log/info (trs "Updating table statistics for: {0}"
-                                   (str/join ", " tables)))
-                    (apply jdbc/do-commands-outside-txn
-                           (map #(str "vacuum analyze " %) tables))))]
-    (require-valid-schema)
-    (if-let [pending (seq (pending-migrations))]
-      (let [tables (jdbc/with-db-transaction []
-                     (->> pending
-                          (map (fn [[version migration]]
-                                 (log/info (trs "Applying database migration version {0}" version))
-                                 (let [t0 (now)]
-                                   (let [result (migration)]
-                                     (record-migration! version)
-                                     (log/info (trs "Applied database migration version {0} in {1} ms"
-                                                    version (in-millis (interval t0 (now)))))
-                                     result))))
-                          (filter map?)
-                          (map ::vacuum-analyze)
-                          (apply set/union small-tables)))]
-        (analyze tables)
-        true)
-      (do
-        (log/info (trs "There are no pending migrations"))
-        ;; Always analyze these since we had a good long period where
-        ;; the post-migration analysis above wasn't actually working,
-        ;; and since this shouldn't be expensive.
-        (analyze small-tables)
-        false))))
+        tables (jdbc/with-db-transaction []
+                 (when-let [pending (seq (pending-migrations))]
+                   (->> pending
+                        (map (fn [[version migration]]
+                               (log/info (trs "Applying database migration version {0}"
+                                              version))
+                               (let [t0 (now)]
+                                 (let [result (migration)]
+                                   (record-migration! version)
+                                   (log/info (trs "Applied database migration version {0} in {1} ms"
+                                                  version (in-millis (interval t0 (now)))))
+                                   result))))
+                        (filter map?)
+                        (map ::vacuum-analyze)
+                        seq)))]
+    (when-not tables
+      (log/info (trs "There are no pending migrations")))
+    ;; Always analyze these since we had a good long period where
+    ;; the post-migration analysis above wasn't actually working,
+    ;; and since this shouldn't be expensive.
+    (analyze-if-exists (apply set/union small-tables tables))
+    (not (empty? tables))))

 (defn migrate! []
   "Migrates database to the latest schema version. Does nothing if


Address PR comments

Address PR comments

Add a comment explaining the decision to remove :decompress-body
from the http-opts map.

--- src/puppetlabs/ring_middleware/core.clj
+++ src/puppetlabs/ring_middleware/core.clj
@@ -12,6 +12,9 @@
   (wrap-cookies
     (fn [req]
       (if (.startsWith ^String (:uri req) (str proxied-path "/"))
+        ; Remove :decompress-body from the options map, as if this is
+        ; ever set to true, the response returned to the client making the
+        ; proxy request will be truncated
         (let [http-opts (dissoc http-opts :decompress-body)
               uri (URI. remote-uri-base)
               remote-uri (URI. (.getScheme uri)


Reader remove 'bm-newest-voom-ver-by-spec before changing relations.

The upcoming changes will break the compilability of this function and
I am only keeping it for reference.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1273,6 +1273,7 @@

 ;; ===== point filtering query =====

+#_
 (defn bm-newest-voom-ver-by-spec
 "
 - given a particular projname at a path and version criteria


Defend against hung fifo

Defend against hung fifo

I saw such a hang happen once, but wasn't able to track down the cause or
reproduce.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -696,6 +696,8 @@
           (print (str " " p)))
         (println)))))

+(def fifo-timeout 1000 #_milliseconds)
+
 (declare voom)
 (defn box
   "Entry point for the box shell alias, not to be used manually."
@@ -707,11 +709,13 @@
         fofifo (future (-> ofifo FileOutputStream. OutputStreamWriter.))
         fififo (future (-> ififo FileInputStream.))]
     (binding [*pwd* fpwd
-              *ofifo* @fofifo
-              *ififo* @fififo]
-      (.read *ififo* (byte-array 5))
+              *ofifo* (deref fofifo fifo-timeout nil)
+              *ififo* (deref fififo fifo-timeout nil)]
+      (if (and *ofifo* *ififo*)
+        (.read *ififo* (byte-array 5))
+        (println "INFO: fifo failed -- no env changes will be attempted."))
       (apply voom proj rargs)
-      ;; TODO formalize break/exit handling
+      ;; TODO formalizE break/exit handling
       (fcmd "break"))))

 ;; === lein entrypoint ===


:fire: Remove unused comment.

:fire: Remove unused comment.

--- backend/src/uxbox/tasks.clj
+++ backend/src/uxbox/tasks.clj
@@ -24,8 +24,6 @@
    [uxbox.tasks.delete-object]
    [uxbox.tasks.impl :as impl]
    [uxbox.util.time :as dt]))
-
-;; --- Scheduler Executor Initialization

 ;; --- State initialization


Fixing typo.

Fixing typo.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -270,7 +270,7 @@
              [:a {:href "mailto:billing@circleci.com"} "billing@circleci.com"]
              " to cancel." ]}

-   {:question "What if I want something customer?"
+   {:question "What if I want something custom?"
     :answer ["Feel free to contact us "
              [:a {:href "mailto:billing@circleci.com"} "billing@circleci.com"]]}

@@ -467,7 +467,7 @@
             [:legend (str "OS X Plans")]
             (when-not (pm/osx-ga-plan? plan)
               (om/build limited-release-notice plan))
-            [:p "Your selection selection below only applies to OS X service and will not affect Linux Containers."]
+            [:p "Your selection below only applies to OS X service and will not affect Linux Containers."]
             (when (and (pm/osx-trial-plan? plan) (not (pm/osx-trial-active? plan)))
               [:p "The OS X trial you've selected has expired, please choose a plan below."])
             (when (and (pm/osx-trial-plan? plan) (pm/osx-trial-active? plan))


Fix parameter

Fix parameter

--- src/puppeteer/domain/usecase/deploy.clj
+++ src/puppeteer/domain/usecase/deploy.clj
@@ -19,14 +19,14 @@

 (defn- prepare-deployment
   [{:keys [deploy-repository]}
-   {:keys [conf build] :as job}]
+   {:keys [conf build user-name repo-name branch-name] :as job}]
   (let [deployment (deployrepo/get-resource
                      deploy-repository
-                     {:user (:user-name conf)
-                      :repo (:repo-name conf)
-                      :ref (:branch-name conf)
+                     {:user user-name
+                      :repo repo-name
+                      :ref branch-name
                       :path (-> conf :k8s :deployment)})
-        app (str (:repo-name conf) "-" (:branch-name conf))]
+        app (str repo-name "-" branch-name)]
     (-> deployment
         (assoc-in [:metadata :name] app)
         (assoc-in [:spec :template :metadata :labels :app] app)
@@ -35,14 +35,14 @@

 (defn- prepare-service
   [{:keys [deploy-repository]}
-   {:keys [conf build] :as job}]
+   {:keys [conf build user-name repo-name branch-name] :as job}]
   (let [service (deployrepo/get-resource
                   deploy-repository
-                  {:user (:user-name conf)
-                   :repo (:repo-name conf)
-                   :ref (:branch-name conf)
+                  {:user user-name
+                   :repo repo-name
+                   :ref branch-name
                    :path (-> conf :k8s :service)})
-        app (str (:repo-name conf) "-" (:branch-name conf))]
+        app (str repo-name "-" branch-name)]
     (-> service
         (assoc-in [:metadata :name] app)
         (assoc-in [:selector :app] app))))


added some repl helper functions

added some repl helper functions

--- src/moomoo/handler.clj
+++ src/moomoo/handler.clj
@@ -2,11 +2,11 @@
   (:require [compojure.core :refer :all]
             [compojure.route :as route]
             [selmer.parser :as selmer]
-            [ring.middleware.defaults :refer [wrap-defaults
+            [ring.middleware.defaults :refer [wrap-defaults
                                               site-defaults]]
             [taoensso.sente :as sente]
             [org.httpkit.server :as http-kit]
-            [taoensso.sente.server-adapters.http-kit
+            [taoensso.sente.server-adapters.http-kit
              :refer (get-sch-adapter)]
             [clojure.core.async
              :as a
@@ -26,9 +26,9 @@

 (defroutes app-routes
   (GET "/" [] "
Hello world!
")
-  (GET "/:room-id" [room-id] (selmer/render-file "views/room.html"
+  (GET "/:room-id" [room-id] (selmer/render-file "views/room.html"
                                                  {:room-id room-id}))
-
+
   (GET "/:room-id/chsk" req (ring-ajax-get-or-ws-handshake req))
   (POST "/:room-id/chsk" req (ring-ajax-post req))

@@ -40,15 +40,29 @@
       ring.middleware.params/wrap-params))

 (defn event-handler [f]
-  #_(println f)
   (let [event (:event f)
         event-id (first event)
         event-params (second event)
         uid (:uid f)]
     (when (= event-id :room/sign-in)
-      (println "User signing in as" (:username event-params)
+      (println "User signing in as" (:username event-params)
                "in room" (:room-id event-params))
       (chsk-send! uid [:foo/bar {:hello "world"}]))))

 (defn start-router! []
   (sente/start-server-chsk-router! ch-chsk event-handler))
+
+(defn start-server! [port]
+  (def stop-ring-server! (http-kit/run-server app {:port port}))
+  (def stop-socket-server! (start-router!)))
+
+(defn stop-server! []
+  (when-not (nil? stop-ring-server!)
+    (stop-ring-server!)
+    (stop-socket-server!)
+    (def stop-ring-server! nil)
+    (def stop-socket-server! nil)))
+
+(defn reset-server! []
+  (stop-server!)
+  (start-server! 3000))


Add comment (and hopefully force re-test).

--- src/clj/game/core-events.clj
+++ src/clj/game/core-events.clj
@@ -15,6 +15,8 @@
   "Removes all event handlers defined for the given card."
   [state side card]
   (let [cdef (card-def card)]
+    ;; Combine normal events and derezzed events. Any merge conflicts should not matter
+    ;; as they should cause all relevant events to be removed anyway.
     (doseq [e (merge (:events cdef) (:derezzed-events cdef))]
       (swap! state update-in [:events (first e)]
              #(remove (fn [effect] (= (get-in effect [:card :cid]) (:cid card))) %))))


Reorganise a bit, improve code-reload workflow

--- src/cljs/geoforms/forms.cljs
+++ src/cljs/geoforms/forms.cljs
@@ -3,7 +3,7 @@
             [reagent-forms.core :refer [bind-fields init-field value-of]]
             [geoforms.db :as db]))

-;;; state
+;;; state and logic

 (def app-state
   (atom
@@ -23,6 +23,41 @@

 (defn district-ideas [d]
   (filter (comp #(some #{d} %) :districts) @db/ideas))
+
+(def email-regex #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$")
+
+(defn validate-user
+  "Build map of {key error} pairs, where each {error} relates to persion.{key}"
+  [doc]
+  (let [person (:person doc)]
+    (cond-> {}
+      (empty? (:first-name person))
+      (assoc :first-name "First name is empty")
+
+      (empty? (:last-name person))
+      (assoc :last-name "Last name is empty")
+
+      (empty? (:email person))
+      (assoc :email "Email is empty")
+
+      (when-let [email (:email person)]
+        (nil? (re-find email-regex email)))
+      (assoc :email "Email is not valid")
+
+      (nil? (:age person))
+      (assoc :age "Age is not set"))))
+
+(defn validate-user!
+  "Update errors atom, and return true if there were any errors."
+  [doc]
+  (let [errors (validate-user @doc)]
+    (swap! doc assoc :errors errors)
+    (empty? errors)))
+
+(defn submit!
+  "Ensure the signing user exists and their support is noted."
+  [doc]
+  (db/create-user! (:person doc) @db/supported-ideas))

 ;;; view helpers

@@ -75,11 +110,6 @@
        "Pick a category..."]
       (for [c @db/categories]
         [:option {:value c :key c} c])]])
-
-(defn idea-form [district]
-  ;; a button to open a modal?
-  ;; what about wanting to create an idea for multiple districts?
-  )

 (defn list-idea-blocks-component []
   (let [districts @db/districts]
@@ -95,19 +125,24 @@
                            :on-change #(let [supported? (-> % .-target .-checked)]
                                          (db/set-idea-support! id supported?))}
             [:label [:input {:type :checkbox :id id}] title]])
-         [idea-form d]
+         ;; a button to open a modal?
+         ;; what about wanting to create an idea for multiple districts?
+         [:a.btn.btn-xs.btn-default {:disabled true} (str "Add idea to " d)]
          [:br]]))]))

-(defn add-idea-component []
-  [:div
-   (input-placeholder "Idea title" :text :idea.idea)
+(defn add-idea-form []
+  [:div
+   (input "Idea title" :text :idea.idea)
    [select-cat-component]
    [:p
     [:textarea.form-control
      {:rows "4" :placeholder "If necessary, add a description"}]]
    (for [i (range 3)]
      [:div {:key i}
-      (input-placeholder "Add a reference URL" :text (symbol (str "idea.url." i)))])
+      (input-placeholder "Add a reference URL" :text (symbol (str "idea.url." i)))])])
+
+(defn add-idea-component []
+  [:div
    [:button.btn.btn-default
     {:on-click #(db/create-idea! {:title     "More pizza"
                                   :desc      "Food for me"
@@ -184,60 +219,26 @@

 ;;; PAGE

-(def email-regex #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$")
-
-(defn validate-user
-  "Build map of {key error} pairs, where each {error} relates to persion.{key}"
-  [doc]
-  (let [person (:person doc)]
-    (cond-> {}
-      (empty? (:first-name person))
-      (assoc :first-name "First name is empty")
-
-      (empty? (:last-name person))
-      (assoc :last-name "Last name is empty")
-
-      (empty? (:email person))
-      (assoc :email "Email is empty")
-
-      (when-let [email (:email person)]
-        (nil? (re-find email-regex email)))
-      (assoc :email "Email is not valid")
-
-      (nil? (:age person))
-      (assoc :age "Age is not set"))))
-
-(defn validate-user!
-  "Update errors atom, and return true if there were any errors."
-  [doc]
-  (let [errors (validate-user @doc)]
-    (swap! doc assoc :errors errors)
-    (empty? errors)))
-
-(defn submit!
-  "Ensure the signing user exists and their support is noted."
-  [doc]
-  (db/create-user! (:person doc) @db/supported-ideas))
+(defonce user-doc
+  (atom {:person {:first-name       "Blake"
+                  :last-name        "Hake"
+                  :email            "blake@hake.fake.com"
+                  :age              :18-24
+                  :alert-ideas?     true
+                  :alert-volunteer? true
+                  :alert-districts? true}}))

 (defn page []
-  (let [doc (atom {:person {:first-name       "Blake"
-                            :last-name        "Hake"
-                            :email            "blake@hake.fake.com"
-                            :age              :18-24
-                            :alert-ideas?     true
-                            :alert-volunteer? true
-                            :alert-districts? true}})]
-    (fn []
-      [:div
-       [bind-fields
-        form-template
-        doc
-        (fn [k v _]
-          (let [after (assoc-in @doc k v)
-                errors (validate-user after)]
-            (assoc after :errors errors)))]
-
-       [:button.btn.btn-default
-        {:on-click #(when (validate-user! doc)
-                      (submit! @doc))}
-        "Submit"]])))
+  (fn []
+    [:div
+     [bind-fields
+      form-template
+      user-doc
+      (fn [k v _]
+        (let [after (assoc-in @user-doc k v)
+              errors (validate-user after)]
+          (assoc after :errors errors)))]
+
+     [:button.btn.btn-default
+      {:on-click #(when (validate-user! user-doc) (submit! @user-doc))}
+      "Submit"]]))


add stalky stuff and includes?

add stalky stuff and includes?

--- src/cljs/uberblick/core.cljs
+++ src/cljs/uberblick/core.cljs
@@ -21,7 +21,7 @@
 ;; State

 (defonce people-atom (local-storage (atom []) :people))
-(defonce filters (local-storage (atom ["(startsWith? :KeyscanStatus \"In\")"]) :filters))
+(defonce filters (local-storage (atom ["(starts-with? :KeyscanStatus \"In\")"]) :filters))

 (def all-profile-keys '(:IsObjectivesAdmin :LaborCategoryID :FirstName :LaborRoleID :OversightPercent :WorkTeamID :BusinessUnitName :MobileNumber :PhotoFileName :IsCandidateAdmin :CanCommunicateClient :UserSystemID :Email :CreatedDate :BillingTargetHoursPerYear :Title :MobileNumberCountryCode :IsClient :IsScheduleConfirmationRulesEnforced :LastName :IsScheduleAdmin :UserName :Extension :TimeZoneName :HomeNumber :IsNotAPerson :UserID :KeyscanUpdated :HasDirectReports :IsAdmin :BusinessUnitID :CountryID :CompanyBusinessUnitID :TimeZoneID :PhotoPath :Name :Roles :CompanyBusinessUnitName :IsWeeklyReviewAdmin :Enabled :TagName :Supervisors :KeyscanStatus :OutOfOfficeReason :Status))
 ; (take! (genome/<get-all-active-klickster-profiles) (fn [profiles] (->> (apply merge profiles ) keys prn)))
@@ -107,29 +107,27 @@
               ((fn [new-expr]
                  `(fn [~my-user]
                     (let [~'substring? (fn [~'string ~'subsstr] (> (.indexOf ~'string ~'subsstr) -1))
-                          ~'startsWith? (fn [~'string ~'substr] (.startsWith ~'string ~'substr))]
+                          ~'starts-with? (fn [~'string ~'substr] (.startsWith ~'string ~'substr))
+                          ~'includes? (fn [~'coll ~'item] (some #{~'item} ~'coll))]
                       ~new-expr))) ,,,,)
               ((fn [expr] (prn expr) expr))
               (eval-str ,,,))))

+(defn nil->Out [by-floors]
+  (into {}
+        (for [[k v] by-floors]
+          [(if (nil? k) "Out!" k) v]))  )
+
+
 (defn filter-people [people]
-  (let [all-the-people (try
-                         (if-not (empty? @filters)
-                           (let [my-filters (map #(create-filter-fn all-profile-keys %) @filters)]
-                             (filter (apply every-pred my-filters) people))
-                           people)
-                         (catch :default e
-                           (println "Error while filtering")
-                           (prn e)))
-        nil->Out (fn [by-floors]
-                   (into {}
-                         (for [[k v] by-floors]
-                           [(if (nil? k) "Out!" k) v])))]
-    (some->> all-the-people
-             (group-by :KeyscanStatus)
-             (nil->Out)  ; mark the OUT ones for better processing!
-             (into (sorted-map)) ; sort
-             )))
+  (try
+    (if-not (empty? @filters)
+      (let [my-filters (map #(create-filter-fn all-profile-keys %) @filters)]
+        (filter (apply every-pred my-filters) people))
+      people)
+    (catch :default e
+      (println "Error while filtering")
+      (prn e))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -190,12 +188,45 @@
 (defn home-page []
   (try
     [:div
-     (let [people (filter-people @people-atom)]
+     (let [people (some->> (filter-people @people-atom)
+                           (group-by :KeyscanStatus)
+                           (nil->Out)  ; mark the OUT ones for better processing!
+                           (into (sorted-map)) ; sort
+                           )]
        (cond
          (nil? people) [:h2 "There has been an error while applying your filters!"]
          (= 0 (count people)) [:h2 "No one that fits your filters is in!"]
          :else (for [[floor people] people]
                  ^{:key floor} [Floor floor people])))]
+    (catch :default e
+      (prn e)
+      [:h2 "There has been an error while applying your filters!"])))
+
+(defn StalkyPersonCard [user]
+  [:div.z-depth-1.tooltip {:style {:max-width 100
+                                   :margin 5
+                                   :text-align :center}}
+   [:span.tooltiptext [:pre {:style {:text-align :left}} (prettify user)]]
+   [:div {:style {:width 100
+                  :height 100
+                  :background-image (str "url(" (:PhotoPath user) ")")
+                  :background-size "100% auto"
+                  :background-repeat :no-repeat}
+          :on-click #(.open js/window (genome/profile-link user))}]
+   [:div {:style {:width "100%" :font-size 16}} (:FirstName user)]
+   [:div {:style {:width "100%" :font-size 16 :font-weight :bold}} (:KeyscanStatus user)]
+   ])
+
+(defn Stalky []
+  (try
+    [:div {:style {:display :flex}}
+     (let [people (->> (filter-people @people-atom)
+                   (sort-by :FirstName))]
+       (cond
+         (nil? people) [:h2 "There has been an error while applying your filters!"]
+         (= 0 (count people)) [:h2 "No one that fits your filters is in!"]
+         :else (for [dude people]
+                    ^{:key (:UserID dude)} [StalkyPersonCard dude])))]
     (catch :default e
       (prn e)
       [:h2 "There has been an error while applying your filters!"])))
@@ -213,9 +244,6 @@
                (reset! readme content-md))))
     (fn []
       [:div {:dangerouslySetInnerHTML {:__html @readme}}])))
-
-(defn about [] (About))
-

 (defn Instructions
@@ -275,14 +303,15 @@
        [:h3 "Examples"]
        [:p "Here are some example filters to get you started!"]
        [Examples current-profile [
-                                  "(startsWith? :FirstName \"M\")"
+                                  "(starts-with? :FirstName \"M\")"
                                   "(= :LaborRoleID \"APPLDEVL\")"
-                                  "(= :WorkTeamID $WorkTeamID)"
-                                  "(substring? :Title \"Quality\")"
-                                  "(>= :UserID $UserID)"
+                                  "(= :WorkTeamID $WorkTeamID) ; Klicksters in your team "
+                                  "(substring? :Title \"Quality\") ; Klicksters that have 'Quality' in their title"
+                                  "(> :UserID $UserID) ; Klicksters that got hired after you"
                                   "(= :KeyscanStatus \"In 4th Flr N\")"
-                                  "(or (startsWith? :FirstName \"M\") (substring? :Title \"Edit\"))"
-                                  "(startsWith? :KeyscanStatus \"In\")"
+                                  "(or (starts-with? :FirstName \"M\") (substring? :Title \"Edit\"))"
+                                  "(starts-with? :KeyscanStatus \"In\")"
+                                  "(includes? :Supervisors $UserID) ; Klicksters who report to you"
                   ]]
        [:hr]
        [:h3 "References"]
@@ -299,11 +328,15 @@
 (secretary/defroute "/" []
   (session/put! :current-page #'home-page))

+(secretary/defroute "/stalky" []
+  (session/put! :current-page #'Stalky))
+
 (secretary/defroute "/about" []
-  (session/put! :current-page #'about))
+  (session/put! :current-page #'About))

 (secretary/defroute "/filters" []
   (session/put! :current-page #'Filters))
+
 ;; -------------------------
 ;; History
 ;; must be called after routes have been defined


Add get-value method to Context protocol.

--- src/cljx/cats/protocols.cljx
+++ src/cljx/cats/protocols.cljx
@@ -28,7 +28,8 @@

 (defprotocol Context
   "A type that is part of a computational context."
-  (get-context [_]))
+  (get-context [_] "Get the monad instance for curent value.")
+  (get-value [_] "Unwrap the value from context."))

 (defprotocol Functor
   (fmap [ftor f fv] "Applies function f to the value(s) inside the context of the functor fv."))


show all users, roles

show all users, roles

--- src/clojento/views/admin.clj
+++ src/clojento/views/admin.clj
@@ -1,6 +1,6 @@
 (ns clojento.views.admin
   (:require [clojento.models.admin :as admin] [clojento.views.common :as common])
-  (:use [noir.core :only [defpage url-for]]
+  (:use [noir.core :only [defpage defpartial url-for]]
         [noir.response :only [redirect]]
         [korma.core :only [select fields]]
         [hiccup.core :only [html]]))
@@ -10,10 +10,19 @@
 	[:h1 (str "User " id " Detail Page")]
 	[:hr]))

+(defpartial user-line [{:keys [user_id username firstname lastname]}]
+	[:tr
+		[:td user_id]
+		[:td [:a {:href (url-for user_show {:id user_id})} username]]
+		[:td firstname]
+		[:td lastname]
+	])
+
+
 (defpage users_index "/admin/users" {} (common/layout
 	[:h1 "Users"]
 	[:hr]
-	(let [users (select admin/user) user (first users)]
+	(let [users (select admin/user)]
 		[:table
 			[:thead [:tr
 				[:th "id"]
@@ -21,14 +30,7 @@
 				[:th "firstname"]
 				[:th "lastname"]
 			]]
-			[:tbody
-				[:tr
-					[:td (get user :user_id)]
-					[:td [:a {:href (url-for user_show {:id (get user :user_id)})} (get user :username)]]
-					[:td (get user :firstname)]
-					[:td (get user :lastname)]
-				]
-			]
+			[:tbody (map user-line users) ]
 		])))

 (defpage role_show "/admin/role/:id" {id :id}
@@ -36,22 +38,23 @@
 	[:h1 (str "Role " id " Detail Page")]
 	[:hr]))

+(defpartial role-line [{id :role_id, name :role_name, type :role_type}]
+	[:tr
+		[:td id]
+		[:td [:a {:href (url-for role_show {:id id})} name]]
+		[:td type]
+	])
+
 (defpage roles_index "/admin/roles" {} (common/layout
 	[:h1 "Roles"]
 	[:hr]
-	(let [roles (select admin/role) role (first roles)]
+	(let [roles (select admin/role)]
 		[:table
 			[:thead [:tr
 				[:th "id"]
 				[:th "name"]
 				[:th "type"]
 			]]
-			[:tbody
-				[:tr
-					[:td (get role :role_id)]
-					[:td [:a {:href (url-for role_show {:id (get role :role_id)})} (get role :role_name)]]
-					[:td (get role :role_type)]
-				]
-			]
+			[:tbody (map role-line roles) ]
 		])))


Fix binary db bug: White and black Elo were always the same.

--- src/clojure/clj_chess/db.clj
+++ src/clojure/clj_chess/db.clj
@@ -76,7 +76,7 @@
                                    ["Result" (:result x)]
                                    ["WhiteElo" (when-let [elo (:white_elo x)]
                                                  (pr-str elo))]
-                                   ["BlackElo" (when-let [elo (:white_elo x)]
+                                   ["BlackElo" (when-let [elo (:black_elo x)]
                                                  (pr-str elo))]]
                                   (when-let [fen (:startfen x)]
                                     [["SetUp" "1"]


Change decode to decode-array.

Change decode to decode-array.

--- src/multihash/core.clj
+++ src/multihash/core.clj
@@ -3,6 +3,10 @@
   (:require
     [clojure.string :as str])
   (:import
+    (java.io
+      InputStream
+      IOException
+      PushbackInputStream)
     java.security.MessageDigest))

@@ -248,19 +252,24 @@
   (bytes->hex (encode mhash)))

-(defn decode
-  "Decodes a hex string or byte array into a multihash value."
-  [encoded]
-  (let [^bytes encoded (if (string? encoded)
-                         (hex->bytes encoded)
-                         encoded)
-        code (aget encoded 0)
+(defn decode-array
+  "Decodes a byte array directly into multihash. Throws `IOException` on
+  malformed input, and `IllegalArgumentException` if the multihash is invalid."
+  [^bytes encoded]
+  (when (< (alength encoded) 3)
+    (throw (IOException.
+             (str "Cannot read multihash from byte array: " (alength encoded)
+                  " is less than the minimum of 3"))))
+  (let [code (aget encoded 0)
         length (aget encoded 1)
-        payload-length (- (alength encoded) 2)]
-    (when (not= length payload-length)
-      (throw (IllegalArgumentException.
-               (str "Encoded digest length " length " does not match actual "
-                    "digest payload of " payload-length " bytes"))))
+        payload (- (alength encoded) 2)]
+    (when (< length 1)
+      (throw (IOException.
+               (str "Encoded length " length " is invalid"))))
+    (when (< payload length)
+      (throw (IOException.
+               (str "Encoded digest length " length " exceeds actual "
+                    "remaining payload of " payload " bytes"))))
     (let [digest (byte-array length)]
       (System/arraycopy encoded 2 digest 0 length)
       (create code digest))))


fix #1448 #1741 - workaround to identify a group chat by existence of group-id rather than unreliable group-chat flag

--- src/status_im/chat/events/commands.cljs
+++ src/status_im/chat/events/commands.cljs
@@ -6,8 +6,6 @@
             [status-im.data-store.messages :as msg-store]
             [status-im.utils.handlers :refer [register-handler-fx]]
             [status-im.components.status :as status]
-            [status-im.chat.constants :as const]
-            [status-im.commands.utils :as commands-utils]
             [status-im.i18n :as i18n]
             [status-im.utils.platform :as platform]))

@@ -15,12 +13,13 @@

 (defn generate-context
   "Generates context for jail call"
-  [{:keys [chats] :accounts/keys [current-account-id]} chat-id to]
+  [{:keys [chats] :accounts/keys [current-account-id]} chat-id to group-id]
   (merge {:platform platform/platform
           :from     current-account-id
           :to       to
           :chat     {:chat-id    chat-id
-                     :group-chat (get-in chats [chat-id :group-chat])}}
+                     :group-chat (or (get-in chats [chat-id :group-chat])
+                                     (not (nil? group-id)))}}
          i18n/delimeters))

 ;;;; Coeffects
@@ -70,9 +69,9 @@
  [trim-v]
  (fn [{:keys [db]}
       [{{:keys [command content-command params type]} :content
-        :keys [chat-id jail-id] :as message}
+        :keys [chat-id jail-id group-id] :as message}
        data-type]]
-   (let [{:keys [chats]
+   (let [{:keys          [chats]
           :accounts/keys [current-account-id]
           :contacts/keys [contacts]} db
          jail-id (or jail-id chat-id)
@@ -85,10 +84,10 @@
                             data-type]
              to            (get-in contacts [chat-id :address])
              jail-params   {:parameters params
-                            :context (generate-context db chat-id to)}]
-         {:chat-fx/call-jail {:jail-id jail-id
-                              :path path
-                              :params jail-params
+                            :context (generate-context db chat-id to group-id)}]
+         {:chat-fx/call-jail {:jail-id                 jail-id
+                              :path                    path
+                              :params                  jail-params
                               :callback-events-creator (fn [jail-response]
                                                          [[::jail-command-data-response
                                                            jail-response message data-type]])}})


Adjust job status messaging info

Adjust job status messaging info

--- services/mailit.clj
+++ services/mailit.clj
@@ -7,17 +7,27 @@
            (pg/eoi? result-maps) (pg/done)

            (every? map? result-maps)
-           (let [msgs (for [retmap result-maps]
+           (let [base (->> result-maps first :value second fs/dirname)
+                 msgs (for [retmap result-maps]
                         (let [name (retmap :name)
                               [bams csv] (retmap :value)
                               bams (map fs/basename bams)
                               csv (fs/basename csv)
                               exit (retmap :exit)
                               err (retmap :err)]
-                          (if (= exit :succss)
+                          (if (= exit :success)
                             [exit csv]
                             [exit err [bams csv]])))
-                 msg (->> msgs (cons intro) (map str) (str/join "\n"))]
+                 overall (reduce (fn[R x]
+                                   (cond (= x R :success) R
+                                         (= x R :fail) R
+                                         :else :mixed))
+                                 (map first msgs))
+                 msg (->> msgs
+                          (cons (str "Base '" base "'"))
+                          (cons (str "Overall " overall))
+                          (cons intro)
+                          (map str) (str/join "\n"))]
              (pg/send-msg [recipient] subject msg))

            :else


Do not use loop in entry parsing

Do not use loop in entry parsing

--- src/clojure_pf/core/form.clj
+++ src/clojure_pf/core/form.clj
@@ -39,20 +39,21 @@

 ; Form token utilities

-(defn- pull-token [form valid?]
+(defn- pull-token [form pred]
   "Pulls the next token from a form.
-  If the validator returns true for the token, it is returned along
+  If the predicate returns true for the token, it is returned along
   with the rest of the form. Otherwise, nil is returned along
   with the original form."
   (let [token (first form)
-        tail  (rest form)]
-    (if (valid? token)
+        tail  (next form)]
+    (if (pred token)
       [token tail]
       [nil form])))

-(defn- pull-entry [form]
-  "Parses an entry from a form.
-  If successful, returns an entry and the rest of the form in a list."
+(defn- pull-entry [entries form]
+  "Parses an entry to a list of entries from a form.
+  If successful, returns an entry appended to the given entries
+  and the rest of the form in a list."
   (let [[field tail]  (pull-token form keyword?)
         [kind tail]   (pull-token tail keyword?)
         [size tail]   (pull-token tail number?)
@@ -60,15 +61,14 @@
                         (->ScalarEntry field kind)
                         (->ArrayEntry field kind size))]
     (if (entry->valid? entry)
-      [entry tail])))
+      [(conj entries entry) tail])))

 ; Exports

 (defn to-entries [form]
   "Parses a list of packet field entries from a form."
-  (loop [entries  []
-         form form]
-    (let [[entry tail] (pull-entry form)]
-      (if-not entry
-        entries
-        (recur (conj entries entry) tail)))))
+  (let [[entries _] (->> [[] form]
+                         (iterate (partial apply pull-entry))
+                         (take-while some?)
+                         last)]
+    entries))


Fixes https://github.com/lspector/Clojush/issues/225

When going through the list of genetic operators, we now check when
there's just one operator left and choose that. This avoids the
rare but occassional situation where we'd get a `NullPointerException`
because we'd run through the whole list of operators without the sum
of the probabilities getting past the random number.

--- src/clojush/pushgp/breed.clj
+++ src/clojush/pushgp/breed.clj
@@ -135,7 +135,8 @@
     (let [prob (lrand)]
       (loop [vectored-go-probabilities (reductions #(assoc %2 1 (+ (second %1) (second %2)))
                                                    (vec genetic-operator-probabilities))]
-        (if (<= prob (second (first vectored-go-probabilities)))
+        (if (or (= 1 (count vectored-go-probabilities))
+                (<= prob (second (first vectored-go-probabilities))))
           (perform-genetic-operator (first (first vectored-go-probabilities)) population location rand-gen argmap)
           (recur (rest vectored-go-probabilities)))))))


Count the number of events Riemann processes.

--- riemann.config.clj
+++ riemann.config.clj
@@ -65,7 +65,7 @@
       ; Gauges are special -- they're super simple.

       gauges #(where (tagged "gauge")
-                     (graph))
+                     graph)

       ; Shortcut to send a stream along to all metrics.

@@ -76,6 +76,10 @@
                         (timers))
       ]
   (streams
+    (with {:host "riemann" :service "raw-events-processed" :metric 1.0}
+          (fill-in-last 5 {:metric 0.0}
+                        (rate 5 graph)))
+
     (adjust add-environ-name
             (by [:host :service]
                 (metrics)))


use new config file

use new config file


Indentation

Indentation

--- src/postal/message.clj
+++ src/postal/message.clj
@@ -87,7 +87,7 @@
       (doseq [addr addrs]
         (add-recipient! jmsg rtype addr charset)))
     :otherwise
-      (add-recipient! jmsg rtype addrs charset))
+    (add-recipient! jmsg rtype addrs charset))
   jmsg)

 (declare eval-bodypart eval-multipart)
@@ -115,19 +115,19 @@
                           encode-filename))
         (.setDisposition (name (:type part)))
         (cond-> (:content-type part)
-                (.setHeader "Content-Type" (:content-type part)))
+          (.setHeader "Content-Type" (:content-type part)))
         (cond-> (:content-id part)
-                (.setContentID (str "<" (:content-id part) ">")))
+          (.setContentID (str "<" (:content-id part) ">")))
         (cond-> (:file-name part)
-                (.setFileName (encode-filename (:file-name part))))
+          (.setFileName (encode-filename (:file-name part))))
         (cond-> (:description part)
-                (.setDescription (:description part)))))
+          (.setDescription (:description part)))))
     (doto (javax.mail.internet.MimeBodyPart.)
       (.setContent (:content part) (:type part))
       (cond-> (:file-name part)
-              (.setFileName (encode-filename (:file-name part))))
+        (.setFileName (encode-filename (:file-name part))))
       (cond-> (:description part)
-              (.setDescription (:description part))))))
+        (.setDescription (:description part))))))

 (defn eval-multipart [parts]
   (let [;; multiparts can have a number of different types: mixed,


added logging of query for profiling

added logging of query for profiling

--- src/main.clj
+++ src/main.clj
@@ -15,6 +15,9 @@
   (let [query (.get obj "query")
         request_id (.getAwsRequestId ctx)]

+    (print (str request_id ": "))
+    (println query)
+
     {"res" (athena-cmd.core/exec query :folder request_id)
      "request_id" request_id}))


rearrange buttons for new menu and remove drawer

--- frontend/components/aside.cljs
+++ frontend/components/aside.cljs
@@ -171,18 +171,24 @@
             slim-aside? (get-in app state/slim-aside-path)]
         (html
          [:nav.aside-left-nav {:class (when slim-aside? "slim")}
+
           [:a.aside-item.logo  {:title "Home"
                                 :data-placement "right"
                                 :data-trigger "hover"
                                 :href "/"}
            [:div.logomark
             (common/ico :logo)]]
-          [:a.aside-item {:title "Settings"
+
+          [:a.aside-item {:on-click #(put! controls-ch [:user-options-toggled])
                           :data-placement "right"
                           :data-trigger "hover"
-                          :href "/account"}
-           [:i.fa.fa-cog]
-           [:span "Settings"]]
+                          :title "Account"
+                          :class (when (get-in app state/user-options-shown-path)
+                                  "open")}
+           [:img {:src (gh-utils/gravatar-url {:gravatar_id (:gravatar-id opts)
+                                               :login (:login opts)
+                                               :size 50})}]
+           (:login opts)]

           [:a.aside-item {:title "Documentation"
                           :data-placement "right"
@@ -218,38 +224,13 @@

           [:a.aside-item {:data-placement "right"
                           :data-trigger "hover"
-                          :title "Invite Teammate"
-                          ;; modal lives in aside
-                          :on-click #(utils/open-modal "#inviteForm")}
-           [:i.fa.fa-envelope-o]
-           [:span "Invite Teammate"]]
-
-          [:a.aside-item {:data-placement "right"
-                          :data-trigger "hover"
                           :title "Expand"
                           :on-click #(put! controls-ch [:slim-aside-toggled])}
            (if slim-aside?
              [:i.fa.fa-long-arrow-right]
              (list
               [:i.fa.fa-long-arrow-left]
-              [:span "Collapse"]))]
-
-          [:div.aside-slideup
-           [:a.aside-item {:href "/account"
-                           :data-placement "right"
-                           :data-trigger "hover"
-                           :title "User Account"}
-            [:img {:src (gh-utils/gravatar-url {:gravatar_id (:gravatar-id opts)
-                                                :login (:login opts)
-                                                :size 50})}]
-            (:login opts)]
-
-           [:a.aside-item {:href "/logout"
-                           :data-placement "right"
-                           :data-trigger "hover"
-                           :title "Logout"}
-            [:i.fa.fa-sign-out]
-            [:span "Logout"]]]])))))
+              [:span "Collapse"]))]])))))

 (defn aside [app owner]
   (reify


Append datasource if present

Append datasource if present

--- joplin.jdbc/src/joplin/jdbc/database.clj
+++ joplin.jdbc/src/joplin/jdbc/database.clj
@@ -77,7 +77,10 @@
 ;; Code driven sql migrations

 (defn- append-uri [target]
-  (assoc target :connection-uri (get-in target [:db :url])))
+  (-> (:db target)
+      (select-keys [:url :datasource])
+      (clojure.set/rename-keys {:url :connection-uri})
+      (merge target)))

 (defmethod migrate-db :jdbc [target & args]
   (binding [*migration-table* (get-table target)]


made CSS class argument optional for most HTML generator functions

--- src/distillery/view/html.clj
+++ src/distillery/view/html.clj
@@ -48,11 +48,11 @@
   ([content]
   {:tag :p :content (safe-content content)})
   ([css-class content]
-  {:tag :p :attrs {:class css-class} :content (safe-content content)}))
+  (assoc-in (paragraph content) [:attrs :class] css-class)))

 (defn headline
   "Wrappes the given content into a headline. Headline levels from 1 to 8 are supported."
-  [level content]
+  ([level content]
   (let [head-sym
         (cond
           (= level 1) :h1
@@ -64,6 +64,8 @@
           (= level 7) :h7
           (= level 8) :h8)]
     {:tag head-sym :content (safe-content content)}))
+  ([level css-class content]
+   (assoc-in (headline level content) [:attrs :class] css-class)))

 (defn preformatted
   "Wrappes the given text into a pre element."
@@ -77,28 +79,38 @@

 (defn div
   "Creates a div container with a given CSS class and some content."
-  [css-class content]
-  {:tag :div :attrs {:class css-class} :content (safe-content content)})
+  ([content]
+   {:tag :div :content (safe-content content)})
+  ([css-class content]
+   (assoc-in (div content) [:attrs :class] css-class)))

 (defn span
   "Creates a span container with a given CSS class and some text."
-  [css-class content]
-  {:tag :span :attrs {:class css-class} :content (safe-content content)})
+  ([content]
+   {:tag :span :content (safe-content content)})
+  ([css-class content]
+   (assoc-in (span content) [:attrs :class] css-class)))

 (defn list-item
   "Creates a list item."
-  [content]
-  {:tag :li :content (safe-content content)})
+  ([content]
+   {:tag :li :content (safe-content content)})
+  ([css-class content]
+   (assoc-in (list-item content) [:attrs :class] css-class)))

 (defn ulist
   "Creates an unordered list with a given CSS class and a sequence of list items."
-  [css-class items]
-  {:tag :ul :attrs {:class css-class} :content (vec items)})
+  ([items]
+   {:tag :ul :content (vec items)})
+  ([css-class items]
+   (assoc-in (ulist items) [:attrs :class] css-class)))

 (defn olist
   "Creates an ordered list with a given CSS class and a sequence of list items."
-  [css-class items]
-  {:tag :ol :attrs {:class css-class} :content (vec items)})
+  ([items]
+   {:tag :ol :content (vec items)})
+  ([css-class items]
+   (assoc-in (olist content) [:attrs :class] css-class)))

 (defn jshref
   "Creates a URI referencing a JavaScript call."


Websocket transport: Correct argument order for run-pipeline.

--- src/riemann/transport/websockets.clj
+++ src/riemann/transport/websockets.clj
@@ -71,8 +71,8 @@
                                    ; latency
                                    (let [t1 (System/nanoTime)]
                                      (run-pipeline
+                                       (enqueue ch (event-to-json event))
                                        {:error-handler (fn [_] (close ch))}
-                                       (enqueue ch (event-to-json event))
                                        ; When the write completes, measure
                                        ; latency
                                        (fn measure [_]


Bug Fix for undo tests

Bug Fix for undo tests

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -12,7 +12,7 @@
 ;;
 ;;
 (def ^:private config (atom {:max-undos 50   ;; Maximum number of undo states maintained
-                             :path  []}))     ;; undo and redos will apply to only this path within app-db
+                             :path  nil}))     ;; undo and redos will apply to only this path within app-db
 (defn set-max-undos!
   [n]
   (swap! config assoc :max-undos n))
@@ -131,13 +131,19 @@
 (defn- undo
   [undos cur redos]
   (let [u @undos
+        r (cons @cur @redos)
+        path (undo-path-ks)]
+    (if path
+      (swap! cur assoc-in path (last u))
+      (reset! cur (last u)))
+    (reset! redos r)
+    (reset! undos (pop u))))
+
+(defn- undo-explain
+  [undos cur redos]
+  (let [u @undos
         r (cons @cur @redos)]
-
-    (.log js/console "in undo")
-    (.log js/console cur)
-    (.log js/console (undo-path-ks))
-    (.log js/console (last u))
-    (swap! cur assoc-in (undo-path-ks) (last u))
+    (reset! cur (last u))
     (reset! redos r)
     (reset! undos (pop u))))

@@ -146,7 +152,7 @@
   [n]
   (when (and (pos? n) (undos?))
     (undo undo-list app-db redo-list)
-    (undo undo-explain-list app-explain redo-explain-list)
+    (undo-explain undo-explain-list app-explain redo-explain-list)
     (recur (dec n))))

 (handlers/register-base     ;; not a pure handler
@@ -162,8 +168,19 @@
 (defn- redo
   [undos cur redos]
   (let [u (conj @undos @cur)
+        r  @redos
+        path (undo-path-ks)]
+    (if path
+      (swap! cur assoc-in path (first r))
+      (reset! cur (first r)))
+    (reset! redos (rest r))
+    (reset! undos u)))
+
+(defn- redo-explain
+  [undos cur redos]
+  (let [u (conj @undos @cur)
         r  @redos]
-    (swap! cur assoc-in (undo-path-ks) (first r))
+    (reset! cur (first r))
     (reset! redos (rest r))
     (reset! undos u)))

@@ -172,7 +189,7 @@
   [n]
   (when (and (pos? n) (redos?))
     (redo undo-list app-db redo-list)
-    (redo undo-explain-list app-explain redo-explain-list)
+    (redo-explain undo-explain-list app-explain redo-explain-list)
     (recur (dec n))))

 (handlers/register-base     ;; not a pure handler
@@ -216,16 +233,3 @@
         (handler db event-vec)))))

 (def undoable (with-meta undoable_ {:re-frame-factory-name "undoable"}))
-
-
-
-;; middleware
-(defn fsm-trigger
-  [trigger update-fn fsm-path]
-  (fn fsm-middleware
-    [handler]
-    (fn fsm-handler
-      [db event-v]
-      (let [new-db (handler db event-v)]
-         (update-fn new-db event-v trigger fsm-path)))))   ;; think about access to event-v
-


A little cleanup

A little cleanup

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -198,7 +198,7 @@

 (defprotocol IComputedImpl
   (-peek-at [this])
-  (-check-clean [this])
+  (^boolean -check-clean [this])
   (-handle-change [this sender oldval newval])
   (-update-watching [this derefed]))

@@ -261,9 +261,10 @@
       (set! norun? true)
       (doseq [w watching]
         (when (and (instance? Reaction w)
-                   (not (== (.-dirtyness w) clean)))
-          (when-not (-check-clean w)
-            ((or (.-auto-run w) run) w))))
+                   (not (-check-clean w)))
+          (if-some [ar (.-auto-run w)]
+            (ar w)
+            (run w))))
       (set! norun? false)
       (when (== dirtyness maybe-dirty)
         (set! dirtyness clean)))
@@ -277,13 +278,13 @@
                       dirty)]
       (when (> new-dirty old-dirty)
         (set! dirtyness new-dirty)
-        (if (some? auto-run)
+        (if-some [arun auto-run]
           (when-not norun?
-            (if-not (identical? auto-run run)
-              (auto-run this)
-              (when-not (-check-clean this)
-                (auto-run this))))
-          (-notify-watches this state state)))))
+            (when-not (and (identical? arun run)
+                           (-check-clean this))
+              (arun this)))
+          (-notify-watches this state state))))
+    nil)

   (-update-watching [this derefed]
     (doseq [w derefed]


Changed to script to load easier

Changed to script to load easier

--- src/foreclojure/data-set.clj
+++ src/foreclojure/data-set.clj
@@ -303,5 +303,7 @@
                      "(= (__ [1 1 2 3 3 2 2 3]) '(1 2 3 2 3))"]
              :secret-tests ["(= (__ [[1 2] [1 2] [3 4] [1 2]]) '([1 2] [3 4] [1 2]))"]})))

-(defn -main [& args]
-  (load-problem-data))
+(do
+  (println "Loading the data")
+  (load-problem-data)
+  (println "Data is loaded"))


Try to stop people from spawning threads

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -53,8 +53,10 @@
           "You've solved the problem! If you log in we can track your progress.")]
     (flash-msg (str message " " gist-link) "/problems")))

+(def restricted-list ['use 'require 'in-ns 'future 'agent 'send 'send-off 'pmap 'pcalls])
+
 (defn get-tester [restricted]
-  (into secure-tester (concat ['use 'require 'in-ns] (map symbol restricted))))
+  (into secure-tester (concat restricted-list (map symbol restricted))))

 (def sb (sandbox*))


Fix *-cell fns

Fix *-cell fns

--- src/robinson/world.clj
+++ src/robinson/world.clj
@@ -120,14 +120,14 @@
   [state x y f]
   (let [place-id (xy->place-id state x y)
         [ax ay]  (place-id->anchor-xy state place-id)
-        [x y]    [(- y ay) (- x ax)]]
+        [x y]    [(- x ax) (- y ay)]]
     (update-in state [:world :places place-id y x] f)))

 (defn assoc-cell
   [state x y & keyvals]
   (let [place-id (xy->place-id state x y)
         [ax ay]  (place-id->anchor-xy state place-id)
-        [x y]    [(- y ay) (- x ax)]]
+        [x y]    [(- x ax) (- y ay)]]
     (reduce (fn [state [k v]]
               (assoc-in state [:world :places place-id y x k] v))
             state
@@ -137,7 +137,7 @@
   [state x y k]
   (let [place-id (xy->place-id state x y)
         [ax ay]  (place-id->anchor-xy state place-id)
-        [x y]    [(- y ay) (- x ax)]]
+        [x y]    [(- x ax) (- y ay)]]
     (dissoc-in state [:world :places place-id y x k])))

 (defn player-cellxy


tuning...

tuning...

--- src/sormilla/video.clj
+++ src/sormilla/video.clj
@@ -92,9 +92,11 @@
          ~@body)
        (when v# (recur)))))

+(def run (atom false))
+
 (defn video-streaming []
   (try
-    (while true
+    (while @run
       (let [socket      (open-socket)
             out         (agent (io/output-stream (io/file (str "sormilla-" (.format (java.text.SimpleDateFormat. "yyyyMMdd-HHmmss") (java.util.Date.)) ".h264"))))
             reader      (make-reader (BufferedInputStream. (.getInputStream socket)))
@@ -103,7 +105,7 @@
           (doto (.getOutputStream socket)
             (.write (byte-array (map bin/ubyte [1 0 0 0])))
             (.flush))
-          (while true
+          (while @run
             (let [data (reader)]
                 (send-off out save data)
                 (swap! world assoc :image (decoder (second data)))))
@@ -125,10 +127,14 @@

 (def service (reify system/Service
                (start! [this config]
-                 (reset! video-source (if (:video-sim config) (InetAddress/getByName "localhost") comm/drone-ip))
+                 (reset! run true)
+                 (reset! video-source (if (:video-sim config)
+                                        (do (println "Using simulated video") (InetAddress/getByName nil))
+                                        (do (println "Real video") comm/drone-ip)))
                  (task/submit :video video-streaming)
                  config)
                (stop! [this]
+                 (reset! run false)
                  (task/cancel :video))))

 ; ffmpeg -f h264 -an -i capture.h264 stream.m4v


expose :package-name in release-snapshot data

--- src/main/shadow/build/output.clj
+++ src/main/shadow/build/output.clj
@@ -659,7 +659,7 @@
           sources-info
           (->> build-sources
                (map (fn [src-id]
-                      (let [{:keys [resource-name output-name type provides] :as src}
+                      (let [{:keys [resource-name package-name output-name type provides] :as src}
                             (data/get-source-by-id state src-id)

                             {:keys [js source] :as output}
@@ -674,6 +674,9 @@
                              :requires (into #{} (data/deps->syms state src))
                              :js-size (count js)}
                             (cond->
+                              (seq package-name)
+                              (assoc :package-name package-name)
+
                               (string? source)
                               (assoc :source-size (count source))
                               )))))


fix typo in doc string

fix typo in doc string

--- src/tripod/router.cljc
+++ src/tripod/router.cljc
@@ -16,7 +16,7 @@

 (defn linear-search
   "Given a sequence of routes, return a linear search router.
-  Matches the :uri key inside the request qith the paths in the route table"
+  Matches the :uri key inside the request with the paths in the route table"
   [routes]
   (let [matcher-routes (map #(assoc % :matcher (path-matcher %)) routes)]
     (reify
@@ -25,4 +25,4 @@
         (some (fn [{:keys [matcher] :as route}]
                 (when-let [path-params (matcher req)]
                   [(dissoc route :matcher) (assoc req :path-params path-params)]))
-              matcher-routes)))))+              matcher-routes)))))


Remove dead code.

Remove dead code.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -204,7 +204,6 @@
                 onyx.core/storage onyx.core/monitoring onyx.core/tenancy-id]} (get-event state)
         pipeline (get-input-pipeline state)
         checkpoint (oi/checkpoint pipeline)
-        messenger (get-messenger state)
         checkpoint-bytes (checkpoint-compress checkpoint)]
     (.set ^AtomicLong (:checkpoint-size monitoring) (alength checkpoint-bytes))
     (checkpoint/write-checkpoint storage tenancy-id job-id (t/replica-version state)


Increase default subscriber count for test run

--- src/onyx/static/default_vals.clj
+++ src/onyx/static/default_vals.clj
@@ -29,7 +29,7 @@
    :onyx.messaging.aeron/embedded-driver? true
    :onyx.messaging.aeron/offer-idle-strategy :high-restart-latency
    :onyx.messaging.aeron/poll-idle-strategy :high-restart-latency
-   :onyx.messaging.aeron/subscriber-count 3
+   :onyx.messaging.aeron/subscriber-count 4
    :onyx.messaging.netty/thread-pool-sizes 1
    :onyx.messaging.netty/connect-timeout-millis 1000
    :onyx.messaging.netty/pending-buffer-size 10000


Allow much larger messages and longer timeouts

--- src/org/timmc/heim_logger/v2.clj
+++ src/org/timmc/heim_logger/v2.clj
@@ -4,7 +4,8 @@
             [gniazdo.core :as ws]
             [org.timmc.heim-logger.common :as cm])
   (:import (clojure.lang ExceptionInfo)
-           (java.util.concurrent.atomic AtomicLong)))
+           (java.util.concurrent.atomic AtomicLong)
+           (org.eclipse.jetty.websocket.common WebSocketSession)))

 (defn ssocket
   "Get the socket from a session."
@@ -20,7 +21,7 @@

 (def blocking-call-timeout-ms
   "How many milliseconds to wait, maximum, on a blocking call."
-  5000)
+  60000)

 (defn now<-call-command-blocking-start
   "Redefable time lookup."
@@ -95,7 +96,9 @@
       (deliver blocked-promise msg))))

 (defn on-connect
-  [session _jetty-ws-session]
+  [session ^WebSocketSession jetty-ws-session]
+  (.setMaxTextMessageSize (.getPolicy jetty-ws-session)
+                          655360)
   (send-packet session "nick" {:name "hillbot v2"}))

 (defn on-receive


add last-minute changes to the migration script

--- src/pc/admin/migrate_storage.clj
+++ src/pc/admin/migrate_storage.clj
@@ -24,12 +24,11 @@

 (defn datoms->transaction [t]
   (let [datoms (:tx-data t)
-        new-txid (d/tempid :db.part/tx)
         old-txid (-> datoms first :e)]
     (->> datoms
       (mapv pcd/datom->transaction)
       (mapv (fn [d] (update-in d [1] #(if (= % old-txid)
-                                        new-txid
+                                        :tempid
                                         %)))))))

 (def random-uri "/F4WAmHkFNzEPZ9izhuikzT7hUOw")
@@ -99,18 +98,7 @@
   (Thread/sleep (* 1000 10 2))
   (reset-resolve-tempid))

-(defn ensure-premade-schema []
-  @(d/transact (pcd/conn) [{:db/doc "dummy attribute so that we can pre-generate entity ids for a migration"
-                            :db/cardinality :db.cardinality/one
-                            :db/id (d/tempid :db.part/db)
-                            :db/ident :pre-made
-                            :db/valueType :db.type/ref
-                            :db.install/_attribute :db.part/db}
-                           {:db/id (d/tempid :db.part/db)
-                            :db/ident :pre-made/free-to-postgres}]))
-
 (defn setup-old-server []
-  (ensure-premade-schema)
   (startup-premade-ids)
   (setup-transaction-queue)
   (setup-transaction-server))
@@ -119,11 +107,20 @@
 (defonce popped-transactions (atom []))

 (def transaction-url (str "http://104.156.231.173:8067" random-uri))
+
+(defn replace-tempid [txdata]
+  (mapv (fn [d] (update-in d [1] #(if (= :tempid %)
+                                    (d/tempid :db.part/tx)
+                                    %)))
+        txdata))
+
 (defn fetch-transaction []
   (-> (http/get transaction-url)
     :body
     read-string
-    :data))
+    :data
+    replace-tempid))
+

 (defn start-transaction-queue-consumer []
   (reset! queue-consumer-interrupt false)


Don't "listify" arguments to the boot macro

- (def task3 (comp (task1) (task2)))
- (boot task3) ; Now works

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -684,14 +684,13 @@
   strings then they are treated as if they were given on the command line.
   Otherwise they are assumed to evaluate to task middleware."
   [& argv]
-  (let [->list #(cond (seq? %) % (vector? %) (seq %) :else (list %))
-        ->app  (fn [xs] `(apply comp (filter fn? [~@xs])))]
+  (let [->app (fn [xs] `(apply comp (filter fn? [~@xs])))]
     `(try @(future
              (util/with-let [_# nil]
                (#'run-tasks
                  ~(if (every? string? argv)
                     `(apply #'construct-tasks [~@argv])
-                    (->app (map ->list argv))))))
+                    (->app argv)))))
           (finally (#'do-cleanup!)))))

 ;; Low-Level Tasks, Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Brian says use mapcat

Brian says use mapcat

--- scripts/gosync.clj
+++ scripts/gosync.clj
@@ -21,8 +21,8 @@

 ;; /jobStatus.json

-(defn parse-build-info [jsonResp]
-  (let [buildInfo (:building_info (first jsonResp))
+(defn parse-build-info [json-response]
+  (let [buildInfo (:building_info (first json-response))
         buildStartTime (tc/to-long (tf/parse (:build_building_date buildInfo)))
         buildEndTime (tc/to-long (tf/parse (:build_completed_date buildInfo)))
         result (:result buildInfo)
@@ -55,8 +55,7 @@
   (let [stageHistory (get-json "/api/stages/%s/%s/history" pipeline stage)
         stageInstances (:stages stageHistory)]
     (map #(assoc % :stageName stage :pipelineName pipeline)
-         (apply concat
-                (map job-instances-for-stage-instance stageInstances)))))
+         (mapcat job-instances-for-stage-instance stageInstances))))

 ;; /api/pipelines/%pipelines/instance/%run
@@ -92,8 +91,7 @@
   (let [pipelineGroups (get-json "/api/config/pipeline_groups")
         pipelineGroup (first (filter #(= pipelineGroupName (:name %)) pipelineGroups))
         pipelines (:pipelines pipelineGroup)]
-    (apply concat
-           (map stages-for-pipeline pipelines))))
+    (mapcat stages-for-pipeline pipelines)))

 ;; upload
@@ -116,8 +114,7 @@
   (->> (concat (stages-for-pipeline-group "Development")
                (stages-for-pipeline-group "Verification")
                (stages-for-pipeline-group "Production"))
-       (map job-instances-for-stage)
-       (apply concat)
+       (mapcat job-instances-for-stage)
        (map augment-job-with-inputs)
        (map job-data-for-instance)))


improve test

improve test

--- test/clj/just_married/api/rvsp_test.clj
+++ test/clj/just_married/api/rvsp_test.clj
@@ -17,13 +17,21 @@

 (deftest rvsp-api-test
   (testing "Rvsp test"
-    (let [response
-          (sut/rvsp! {:json-params {:name     "Name"
-                                    :email    "My email"
-                                    :how-many "3"
-                                    :comment  "My comment"
-                                    :coming   "true"}})]
+    (let [params   {:name     "Name"
+                    :email    "My email"
+                    :how-many "3"
+                    :comment  "My comment"
+                    :coming   "true"}
+          ;; bit of a hack to get transform the data
+          params-from-db (dissoc (assoc params
+                                       :how_many 3
+                                       :coming true)
+                                 :how-many)
+
+          response (sut/rvsp! {:json-params params})]

       (is (= 201 (-> response :status)))
       (let [rows (jdbc/query (db/db-spec) (get-rvsps))]
-        (is (= 1 (count rows)))))))
+        (is (= [params-from-db]
+               (map #(dissoc % :id :created_at :phone_number)
+                    rows)))))))


Referring for better readability in repl-test.cljs.

--- test/cljs/cljs_bootstrap/repl_test.cljs
+++ test/cljs/cljs_bootstrap/repl_test.cljs
@@ -1,7 +1,8 @@
 (ns ^:figwheel-load cljs-bootstrap.repl-test
   (:require [cljs.test :refer-macros [deftest is]]
             [cljs-bootstrap.repl :as repl]
-            [cljs-bootstrap.common :as common]))
+            [cljs-bootstrap.common :as common :refer [echo-callback valid-eval-result?
+                                                      extract-message success? result]]))

 (defn reset-env
   []
@@ -12,104 +13,104 @@
   (is (symbol? (repl/current-ns)) "The current ns should be a symbol"))

 (deftest process-pst
-  (let [[success error] (do (repl/read-eval-print {} common/echo-callback "(throw (ex-info \"Exception\" {:tag :exception}))")
-                            (repl/read-eval-print {} common/echo-callback "*e"))]
+  (let [[success error] (do (repl/read-eval-print {} echo-callback "(throw (ex-info \"Exception\" {:tag :exception}))")
+                            (repl/read-eval-print {} echo-callback "*e"))]
     (is success "Eval of *e with error should return successfully")
-    (is (common/valid-eval-result? error) "Eval of *e with error should be a valid result")
+    (is (valid-eval-result? error) "Eval of *e with error should be a valid result")
     (is (re-find #"xception" error) "Eval of *e with error should return the correct message")
     (reset-env))
   ;; This test fails in phanthomjs, but is correctly handled inside the browser
-  (let [[success trace] (do (repl/read-eval-print {} common/echo-callback "(throw (ex-info \"Exception\" {:tag :exception}))")
-                            (repl/read-eval-print {} common/echo-callback "(pst)"))]
+  (let [[success trace] (do (repl/read-eval-print {} echo-callback "(throw (ex-info \"Exception\" {:tag :exception}))")
+                            (repl/read-eval-print {} echo-callback "(pst)"))]
     (is success "(pst) with previous error should return successfully")
-    (is (common/valid-eval-result? trace) "(pst) with previous error should be a valid result")
+    (is (valid-eval-result? trace) "(pst) with previous error should be a valid result")
     (is (re-find #"cljs\$core\$ExceptionInfo" trace) "(pst) with previous error should return the trace as string")
     (reset-env))
-  (let [[success trace] (repl/read-eval-print {} common/echo-callback "(pst)")]
+  (let [[success trace] (repl/read-eval-print {} echo-callback "(pst)")]
     (is success "(pst) with no error should return successfully")
-    (is (common/valid-eval-result? trace) "(pst) with no error should be a valid result")
+    (is (valid-eval-result? trace) "(pst) with no error should be a valid result")
     (is (= "nil" trace) "(pst) with no error should return nil")
     (reset-env)))

 (deftest process-doc
-  (let [[success error] (repl/read-eval-print {} common/echo-callback "(doc 'println)")]
+  (let [[success error] (repl/read-eval-print {} echo-callback "(doc 'println)")]
     (is (not success) "(doc 'symbol) should have correct error")
     (reset-env))
-  (let [[success result] (repl/read-eval-print {} common/echo-callback "(doc println)")]
+  (let [[success result] (repl/read-eval-print {} echo-callback "(doc println)")]
     (is success "(doc symbol) should succeed")
-    (is (common/valid-eval-result? result) "(doc symbol) should be a valid result")
+    (is (valid-eval-result? result) "(doc symbol) should be a valid result")
     ;; Cannot test #"cljs.core\/println" because of a compilation bug?
     (is (re-find #"cljs\.core.{1}println" result) "(doc symbol) should return valid docstring")
     (reset-env)))

 (deftest process-in-ns
-  (let [[success error] (repl/read-eval-print {} common/echo-callback "(in-ns \"first.namespace\")")]
+  (let [[success error] (repl/read-eval-print {} echo-callback "(in-ns \"first.namespace\")")]
     (is (not success) "(in-ns \"string\") should NOT succeed")
-    (is (= "Argument to in-ns must be a symbol" (common/extract-message error)) "(in-ns \"string\") should have correct error")
+    (is (= "Argument to in-ns must be a symbol" (extract-message error)) "(in-ns \"string\") should have correct error")
     (reset-env))
-  (let [[success error] (repl/read-eval-print {} common/echo-callback "(in-ns first.namespace)")]
+  (let [[success error] (repl/read-eval-print {} echo-callback "(in-ns first.namespace)")]
     (is (not success) "(in-ns symbol) should NOT succeed")
     ;; Weird, but at least gives off an error
-    (is (or (re-find #"is not defined" (common/extract-message error))
-            (re-find #"Argument to in-ns must be a symbol" (common/extract-message error)) ) "(in-ns symbol) should have correct error")
+    (is (or (re-find #"is not defined" (extract-message error))
+            (re-find #"Argument to in-ns must be a symbol" (extract-message error)) ) "(in-ns symbol) should have correct error")
     (reset-env))
-  (let [[success result] (repl/read-eval-print {} common/echo-callback "(in-ns 'first.namespace)")]
+  (let [[success result] (repl/read-eval-print {} echo-callback "(in-ns 'first.namespace)")]
     (is success "(in-ns 'symbol) should succeed")
-    (is (common/valid-eval-result? result) "(in-ns 'symbol) should be a valid result")
+    (is (valid-eval-result? result) "(in-ns 'symbol) should be a valid result")
     (is (= "nil" result) "(in-ns 'symbol) should return nil")
     (reset-env))

     ;; Note that (do (in-ns 'my.namespace) (def a 3) (in-ns 'cljs) my.namespace/a)
     ;; Does not work in ClojureScript!
-    (let [[success result] (do (repl/read-eval-print {} common/echo-callback "(in-ns 'first.namespace)")
-                               (repl/read-eval-print {} common/echo-callback "(def a 3)")
-                               (repl/read-eval-print {} common/echo-callback "(in-ns 'second.namespace)")
-                               (repl/read-eval-print {} common/echo-callback "first.namespace/a"))]
+    (let [[success result] (do (repl/read-eval-print {} echo-callback "(in-ns 'first.namespace)")
+                               (repl/read-eval-print {} echo-callback "(def a 3)")
+                               (repl/read-eval-print {} echo-callback "(in-ns 'second.namespace)")
+                               (repl/read-eval-print {} echo-callback "first.namespace/a"))]
       (is (= "3" result) "Defining in ns should intern persistent var")
       (reset-env)))

 (deftest process-ns
-  (let [[success error] (repl/read-eval-print {} common/echo-callback "(ns 'first.namespace)")]
+  (let [[success error] (repl/read-eval-print {} echo-callback "(ns 'first.namespace)")]
     (is (not success) "(ns 'something) should NOT succeed")
-    (is (re-find #"Namespaces must be named by a symbol" (common/extract-message error)) "(ns 'something) should have correct error")
+    (is (re-find #"Namespaces must be named by a symbol" (extract-message error)) "(ns 'something) should have correct error")
     (reset-env))
-  (let [[success result] (repl/read-eval-print {} common/echo-callback "(ns first.namespace)")]
+  (let [[success result] (repl/read-eval-print {} echo-callback "(ns first.namespace)")]
     (is success "(ns something) should succeed")
-    (is (common/valid-eval-result? result) "(ns something) should be a valid result")
+    (is (valid-eval-result? result) "(ns something) should be a valid result")
     (is (= "nil" result) "(ns something) should return \"nil\"")
     (reset-env)))

 (deftest process-require
-  (let [[success error] (repl/read-eval-print {} common/echo-callback "(require something)")]
+  (let [[success error] (repl/read-eval-print {} echo-callback "(require something)")]
     (is (not success) "(require something) should NOT succeed")
-    (is (re-find #"is not ISeqable" (common/extract-message error)) "(require something) should have correct error")
+    (is (re-find #"is not ISeqable" (extract-message error)) "(require something) should have correct error")
     (reset-env))
-  (let [[success error] (repl/read-eval-print {:verbose true} common/echo-callback "(require \"something\")")]
+  (let [[success error] (repl/read-eval-print {:verbose true} echo-callback "(require \"something\")")]
     (is (not success) "(require \"something\") should NOT succeed")
-    (is (re-find #"Argument to require must be a symbol" (common/extract-message error)) "(require \"something\") should have correct error")
+    (is (re-find #"Argument to require must be a symbol" (extract-message error)) "(require \"something\") should have correct error")
     (reset-env))
-  (let [[success value] (repl/read-eval-print {} common/echo-callback "(require 'something.ns)")]
+  (let [[success value] (repl/read-eval-print {} echo-callback "(require 'something.ns)")]
     (is success "(require 'something.ns) should succeed")
-    (is (common/valid-eval-result? value) "(require 'something.ns) should be a valid result")
+    (is (valid-eval-result? value) "(require 'something.ns) should be a valid result")
     (is (= "nil" value) "(require 'something.ns) should return nil")
     (reset-env))

-  (let [[success result] (do (repl/read-eval-print {} common/echo-callback "(ns a.ns)")
-                             (repl/read-eval-print {} common/echo-callback "(def a 3)")
-                             (repl/read-eval-print {} common/echo-callback "(ns b.ns)")
-                             (repl/read-eval-print {} common/echo-callback "(require 'a.ns)"))]
+  (let [[success result] (do (repl/read-eval-print {} echo-callback "(ns a.ns)")
+                             (repl/read-eval-print {} echo-callback "(def a 3)")
+                             (repl/read-eval-print {} echo-callback "(ns b.ns)")
+                             (repl/read-eval-print {} echo-callback "(require 'a.ns)"))]
     (is success "(require 'a.ns) from b.ns should succeed")
-    (is (common/valid-eval-result? result) "(require 'a.ns) from b.ns should be a valid result")
+    (is (valid-eval-result? result) "(require 'a.ns) from b.ns should be a valid result")
     (is (= 'b.ns (repl/current-ns)) "(require 'a.ns) from b.ns should not change namespace")
     (reset-env))

-  (let [[success result] (do (repl/read-eval-print {} common/echo-callback "(ns c.ns)")
-                             (repl/read-eval-print {} common/echo-callback "(def referred-a 3)")
-                             (repl/read-eval-print {} common/echo-callback "(ns d.ns)")
-                             (repl/read-eval-print {} common/echo-callback "(require '[c.ns :refer [referred-a]])")
-                             (repl/read-eval-print {} common/echo-callback "referred-a"))]
+  (let [[success result] (do (repl/read-eval-print {} echo-callback "(ns c.ns)")
+                             (repl/read-eval-print {} echo-callback "(def referred-a 3)")
+                             (repl/read-eval-print {} echo-callback "(ns d.ns)")
+                             (repl/read-eval-print {} echo-callback "(require '[c.ns :refer [referred-a]])")
+                             (repl/read-eval-print {} echo-callback "referred-a"))]
     (is success "(require '[c.ns :refer [referred-a]]) should succeed")
-    (is (common/valid-eval-result? result) "(require '[c.ns :refer [referred-a]]) should have a valid result")
+    (is (valid-eval-result? result) "(require '[c.ns :refer [referred-a]]) should have a valid result")
     (is (= 'd.ns (repl/current-ns)) "(require '[c.ns :refer [referred-a]]) should not change namespace")
     (is (= "3" result) "(require '[c.ns :refer [referred-a]]) should intern persistent var")
     (reset-env)))
@@ -119,7 +120,7 @@
         swapping-callback (fn [s r] (swap! results conj [s r]))]
     (let [rs (repl/read-eval-print {} swapping-callback "_arsenununpa42")]
       (is (= 1 (count @results)) "Evaluating an undefined symbol should return one message only")
-      (is (not (common/success? (first @results))) "Evaluating an undefined symbol should not succeed")
-      (is #(re-find #"undeclared Var.*_arsenununpa42" (common/result (first @results))) "Evaluating an undefined symbol should")
+      (is (not (success? (first @results))) "Evaluating an undefined symbol should not succeed")
+      (is #(re-find #"undeclared Var.*_arsenununpa42" (result (first @results))) "Evaluating an undefined symbol should")
       (reset! results [])
       (reset-env))))