connect websocket to correct host

connect websocket to correct host

--- src-cljs/index.cljs
+++ src-cljs/index.cljs
@@ -148,7 +148,12 @@
   (log "init")
   (setup-input)
   (set-username)
-  (reset! round-websocket (js/WebSocket. "ws://localhost:3000/api/v1/round"))
+  (let [location (aget js/window "location")
+        hostname (aget location "hostname")
+        port (aget location "port")
+        socket-url (str "ws://" hostname ":" port "/api/v1/round")]
+    (log "connecting to: " socket-url)
+    (reset! round-websocket (js/WebSocket. socket-url)))
   (doall
     (map #(aset @round-websocket (first %) (second %))
       [["onopen" (fn [] (log "OPEN"))]


Added missing 'prefix'

Added missing 'prefix'

--- resources/rules/pre_identifier_merge/pre_ice_rdf_load/step_a_ontology_to_ice/step_a_ontology_root_identifier_gen/root_property_identifier_gen.clj
+++ resources/rules/pre_identifier_merge/pre_ice_rdf_load/step_a_ontology_to_ice/step_a_ontology_root_identifier_gen/root_property_identifier_gen.clj
@@ -8,7 +8,7 @@
   :reify ([?/id {:ln (:localname ?/top_level_property)
                  :ns "ccp" :prefix "" :suffix ""}])
   :sparql-string "prefix oboInOwl: <http://www.geneontology.org/formats/oboInOwl#>
-                  rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
+                  prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
                   prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#>
                   prefix owl: <http://www.w3.org/2002/07/owl#>
   select ?top_level_property {


stop running printer in the background because of concurrency issues

--- src/bolth.clj
+++ src/bolth.clj
@@ -127,26 +127,30 @@
         (.printStackTrace e))
       (finally (deliver (nth finished worker-id) 1)))))

+(defn format-progress-result [^String r full-failures]
+  (if (= r ".")
+    "."
+    (do
+      (swap! full-failures conj r)
+      (if (.contains r "ERROR")
+        (redify "E")
+        (redify "F")))))
+
 (defn run-gathered-tests [^AbstractQueue tests-to-run pharrallelism]
   (let [results (LinkedBlockingQueue.)
-        printer-running (atom true)
         finished (into [] (map (fn [_] (promise)) (range pharrallelism)))
         workers (map #(run-worker results tests-to-run % finished) (range pharrallelism))
-        printer (future
-                  (while @printer-running
-                    (if-let [r (.poll results)]
-                      (print r)
-                      (Thread/sleep 10))))]
+        full-failures (atom [])]
     (try
       (dorun workers)
       (doseq [n finished]
         (deref n))
-      (reset! printer-running false)
-      (future-cancel printer)
+      (doseq [r (iterator-seq (.iterator results))]
+        (print (format-progress-result r full-failures)))
+      (doseq [failure @full-failures]
+        (print failure))
       (apply merge-with + (map (comp deref deref) finished))
       (finally
-        (reset! printer-running false)
-        (future-cancel printer)
         (doseq [worker workers]
           (future-cancel worker))))))


Documented :jar-name & :uberjar-name in sample.project.clj.

--- sample.project.clj
+++ sample.project.clj
@@ -41,5 +41,7 @@
   :resources-path "src/main/resources"
   :native-path "src/native" ; where to look for native dependencies
   :jar-dir "target/" ; where to place the project's jar file
+  :jar-name "sample.jar" ; name of the jar produced by 'lein jar'
+  :uberjar-name "sample-standalone.jar" ; as above for uberjar
   ;; You can set JVM-level options here.
   :jvm-opts "-Xmx1g")


not working but closer

not working but closer

--- src/advent/core.clj
+++ src/advent/core.clj
@@ -178,9 +178,6 @@
   [n]
   (- 65535 n))

-
-
-
 (defn parse-output-wire [s]
   (last (map str/trim (str/split s #"->"))))

@@ -193,7 +190,7 @@
   [value]
   (if (> (count value) 1)
     value
-    (keyword (first value))))
+    (Integer. (first value))))

 (defn map-values
   "returns a map of the map (m) with the values mapped over the function (f)"
@@ -221,10 +218,17 @@
   (map-values (parse-circuit-data-into-map (str/split (slurp circuit-input) #"\n")) single-values-to-keywords))

+
 (defn find-signal
   "returns the value of signal (keyword) within a circuit (map)"
   [signal circuit]
-  (if (keyword? (signal circuit))
+  (if (integer? (signal circuit))
     (signal circuit)
-    (println "more work to do"))
-  )+    (case (count (signal circuit))
+      2 ((let [value-as-string (last (signal circuit))
+               value (read-string (value-as-string))
+               is-value-number (number? value)]
+           (if is-value-number
+             (bit-not-unsigned value)
+             (find-signal (keyword value) circuit))))
+      3 (println "got three here"))))


started adding support for versioned components

--- src/arl_docker/core.clj
+++ src/arl_docker/core.clj
@@ -19,7 +19,9 @@
   (require comp-ns)
   (let [items (ns-publics comp-ns)
         spec (deref (get items 'spec))
-        spec2 (assoc spec :build (get items 'build))]
+        spec2 (assoc spec :build (get items 'build))
+        cname (:name spec)
+        ver (or (:version spec) "1.0")]
     (log/debug "parsing spec:" spec2)
     (log/debug ((:build spec2)))
     (assoc dict (:name spec2) spec2)))


very rudimentary (defn lazy-shuffle)

very rudimentary (defn lazy-shuffle)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -182,7 +182,7 @@
 (declare morph-with-recovery)

 (defn lazy-shuffle [seq]
-  seq)
+  (lazy-seq (shuffle seq)))

 (defn lightning-bolts [grammar lexicon spec depth index morph total-depth]
   "Returns a lazy-sequence of all possible trees given a spec, where


more dynamic user fetching

more dynamic user fetching

--- src/clj/hsm/fetcher.clj
+++ src/clj/hsm/fetcher.clj
@@ -22,7 +22,7 @@

 (defn get-user [user-action]
   (log/info "Download " user-action)
-  (when-let [body (safe-get (format "http://hackersome.com/user2/%s?json=1" user-action))]
+  (when-let [body (safe-get (format "http://hackersome.com/%s?json=1" user-action))]
     (let [content (safe-parse body)]
       [user-action content])))

@@ -30,7 +30,7 @@
   [action & [thread-count]]
   (let [[act datasource] (get-user action)]
     (cp/with-shutdown! [net-pool (cp/threadpool (or (Integer/parseInt thread-count) 20))]
-      (def results (cp/upmap net-pool get-user datasource))
+      (def results (cp/upmap net-pool get-user (map #(str "/user2/" %) datasource)))

       (doseq [[user-action content] results]
         (log/info user-action content))


don't extend string and array to ISeqable, change seq to deal with them if satisfies? ISeqable fails

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -376,9 +376,18 @@
   Strings."
   [coll]
   (when-not (nil? coll)
-    (if (satisfies? ASeq coll)
-      coll
-      (-seq coll))))
+    (cond
+      (satisfies? ISeqable coll)
+      (-seq coll)
+
+      ^boolean (goog.isArray coll)
+      (array-seq coll 0)
+
+      (and ^boolean (goog.isString coll)
+        (not (keyword? coll)))
+      (prim-seq coll 0)
+
+      :else (throw (js/Error. (str coll "is not ISeqable"))))))

 (defn first
   "Returns the first item in the collection. Calls seq on its
@@ -698,9 +707,6 @@
      (prim-seq array i)))

 (extend-type array
-  ISeqable
-  (-seq [array] (array-seq array 0))
-
   ICounted
   (-count [a] (alength a))

@@ -1912,9 +1918,6 @@
 (extend-type string
   IHash
   (-hash [o] (goog.string/hashCode o))
-
-  ISeqable
-  (-seq [string] (prim-seq string 0))

   ICounted
   (-count [s] (alength s))


rename login to login!

rename login to login!


get-key removed. Because we have raw-key function.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -247,19 +247,6 @@
 #+cljs
 (defn
   ^{:requires-bindings true
-    :processing-name "key"
-    :category "Input"
-    :subcategory "Keyboard"
-    :added "1.0"}
-  get-key []
-  "The system variable key always contains the value of the most recently pressed key on the keyboard.
-   For detecting the arrow keys, the keyCode variable is set to either UP, DOWN, LEFT, or RIGHT."
-  (.-key (current-graphics)))
-
-
-#+cljs
-(defn
-  ^{:requires-bindings true
     :processing-name "getSketchById()"
     :category nil
     :subcategory nil


Moved make-fenced-dispatcher to top of file.

--- src/cbfg/fence.cljs
+++ src/cbfg/fence.cljs
@@ -3,20 +3,6 @@
                     :refer [go go-loop]])
   (:require [cljs.core.async
              :refer [close! <! >! <!! >!! chan timeout onto-chan]]))
-
-(defn add-two [x delay]
-  (go
-   (<! (timeout delay))
-   (+ x 2)))
-
-(defn range-to [s e delay]
-  (let [c (chan)]
-    (go
-     (doseq [n (range s e)]
-       (<! (timeout delay))
-       (>! c n))
-     (close! c))
-    c))

 ;; request format
 ;; {:rq function-to-call :fence true-or-false}
@@ -53,6 +39,20 @@
        :else (do (>! out-channel v)
                  (recur inflights fenced fenced-res))))))

+(defn add-two [x delay]
+  (go
+   (<! (timeout delay))
+   (+ x 2)))
+
+(defn range-to [s e delay]
+  (let [c (chan)]
+    (go
+     (doseq [n (range s e)]
+       (<! (timeout delay))
+       (>! c n))
+     (close! c))
+    c))
+
 (def test-requests
   [{:rq #(add-two 1 2000)}
    {:rq #(add-two 4 1000)}


added sample doc link on swagger api desc

--- src/cia/handler.clj
+++ src/cia/handler.clj
@@ -70,7 +70,9 @@
   have not yet expired.  The highest priority Judgement becomes the
   active verdict.  If there is more than one Judgement with that
   priority, than Clean disposition has priority over all others, then
-  Malicious disposition, and so on down to Unknown.")
+  Malicious disposition, and so on down to Unknown.
+
+  Data structures documentation")


Fix argument completer creation.

Fix argument completer creation.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -69,7 +69,7 @@
       (let [fn-args (get-in cmds [k :fn-args])
             completion-hint (get-in cmds [k :completion-hint])]
         (if (or (not (nil? fn-args))
-                (not (nil? completion-hint)))
+                  (not (nil? completion-hint)))
           (conj v
                 (ArgumentCompleter.
                   [(StringsCompleter. (conj (vec (map name (cmd-aliases k))) (name k)))
@@ -83,9 +83,10 @@
                        (if (not (nil? completion-hint))
                          (.add candidates completion-hint))
                        (.add candidates "")
-                       0))])))))
+                       0))]))
+          v)))
     []
-    (keys cmd-aliases)))
+    (keys cmds)))

 (defn create-jline-read-fn
   [cmds prompt-string]


hot fix for #88

hot fix for #88

--- src/clj/conference_rating/db_handler.clj
+++ src/clj/conference_rating/db_handler.clj
@@ -37,7 +37,7 @@

 (s/defn add-attendance [attendance :- schemas/Attendance db]
   (let [document (assoc attendance :_id (ObjectId.))]
-    (mc/update db "attendances" {:user (:user document) :conference-id (:conference-id document)} {$set {:user (:user document)}} {:upsert true})
+    (mc/insert db "attendances" document)
     (clear-id-in-doc document)))

 (s/defn remove-attendance [attendance :- schemas/Attendance db]


Attach body if it is not attached on `body-params` handler.

--- src/clojure/catacumba/handlers/parse.clj
+++ src/clojure/catacumba/handlers/parse.clj
@@ -109,4 +109,4 @@
          (nil? body)
          (->> (ctx/get-body! ctx)
               (p/map (fn [^TypedData body]
-                       (ctx/delegate {attr (parsefn ctx body)})))))))))
+                       (ctx/delegate {attr (parsefn ctx body) :body body})))))))))


attempt to get better exceptions

attempt to get better exceptions

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -85,42 +85,46 @@
      (try
        ~@body
        (catch ExceptionInfo e#
-         (throw (ExceptionInfo. (.getMessage e#)
-                                (if pt-name# (assoc (ex-data e#) :name pt-name#) (ex-data e#))
-                                (if-let [root# (.getCause e#)] root# e#))))
+         (if (or (:name (ex-data e#)) (nil? pt-name#))
+           (throw e#)
+           (throw (ExceptionInfo. (.getMessage e#)
+                                  (if pt-name# (assoc (ex-data e#) :name pt-name#) (ex-data e#))
+                                  (if-let [root# (.getCause e#)] root# e#)))))
        (catch Exception e#
-         ;; if var is unbound, nothing has been required
-         (let [required-at-start# (try-deref required-ns)]
-           ;; lock on something that should exist!
-           (locking #'locking
-             (let [already-required# (try-deref required-ns)]
-               (let [nss# (unloaded-ns-from-ex e#)]
-                 (log/debugf "Catched Exception %s at runtime with message -> %s => already initialized : %s / candidates for init : %s"
-                             (type e#) (.getMessage e#) (into #{} already-required#) (into [] nss#))
-                 (if (empty? nss#)
-                   (throw (ex-info "Runtime exception intercepted" (-> {:hostname (get-hostname)}
-                                                                       (cond-> pt-name# (assoc :name pt-name#))) e#))
-                   (let [missings# nss# ;; (remove already-required# nss#)
-                         missing-at-start?# (not (empty? (remove required-at-start# nss#)))]
-                     (if-not (empty? missings#)
-                       (do
-                         (log/debugf "Requiring missing namespaces at runtime: %s" (into [] missings#))
-                         (doseq [missing# missings#]
-                           (require missing#)
-                           (swap! required-ns conj missing#))
-                         ~@body)
-                       (if missing-at-start?#
-                         ~@body
+         (if (instance? ExceptionInfo e#)
+           (throw e#)
+           ;; if var is unbound, nothing has been required
+           (let [required-at-start# (try-deref required-ns)]
+             ;; lock on something that should exist!
+             (locking #'locking
+               (let [already-required# (try-deref required-ns)]
+                 (let [nss# (unloaded-ns-from-ex e#)]
+                   (log/debugf "Catched Exception %s at runtime with message -> %s => already initialized : %s / candidates for init : %s"
+                               (type e#) (.getMessage e#) (into #{} already-required#) (into [] nss#))
+                   (if (empty? nss#)
+                     (throw (ex-info "Runtime exception intercepted" (-> {:hostname (get-hostname)}
+                                                                         (cond-> pt-name# (assoc :name pt-name#))) e#))
+                     (let [missings# nss# ;; (remove already-required# nss#)
+                           missing-at-start?# (not (empty? (remove required-at-start# nss#)))]
+                       (if-not (empty? missings#)
                          (do
-                           (log/fatalf
-                            "Dynamic reloading of namespace failure. Already required: %s Attempted: %s"
-                            (into [] nss#) (into [] already-required#))
-                           (throw (ex-info "Dynamic reloading of namespace seems not to work"
-                                           (-> {:ns-from-exception (into [] nss#)
-                                                :ns-load-attempted (into [] already-required#)
-                                                :hostname (get-hostname)}
-                                               (cond-> pt-name# (assoc :name pt-name#)))
-                                           e#)))))))))))))))
+                           (log/debugf "Requiring missing namespaces at runtime: %s" (into [] missings#))
+                           (doseq [missing# missings#]
+                             (require missing#)
+                             (swap! required-ns conj missing#))
+                           ~@body)
+                         (if missing-at-start?#
+                           ~@body
+                           (do
+                             (log/fatalf
+                              "Dynamic reloading of namespace failure. Already required: %s Attempted: %s"
+                              (into [] nss#) (into [] already-required#))
+                             (throw (ex-info "Dynamic reloading of namespace seems not to work"
+                                             (-> {:ns-from-exception (into [] nss#)
+                                                  :ns-load-attempted (into [] already-required#)
+                                                  :hostname (get-hostname)}
+                                                 (cond-> pt-name# (assoc :name pt-name#)))
+                                             e#))))))))))))))))

 (defmacro safe-exec
   "Executes body while trying to sanely require missing ns if the runtime is not yet properly loaded for Clojure in distributed mode. Always wrap try block with this if you intend to eat every Exception produced.


s/repeat/limit/

s/repeat/limit/

--- src/demo/scheduling.clj
+++ src/demo/scheduling.clj
@@ -1,7 +1,6 @@
 (ns demo.scheduling
-  (:refer-clojure :exclude [repeat])
-  (:require [immutant.scheduling :refer [schedule unschedule repeat
-                                         at in every until cron]])
+  (:require [immutant.scheduling :refer [schedule unschedule at in
+                                         limit every until cron]])
   (:import java.util.Date))

 (defn print-time [] (println (Date.)))
@@ -28,7 +27,7 @@
 (def every-10ms-in-500ms-4-times
   (-> (in 500)
     (every 10)
-    (repeat 3)))
+    (limit 4)))

 (defn -main [& args]
   (schedule "timer" print-time every-5s))


Add dsl-literal?

Add dsl-literal?

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -58,6 +58,10 @@
        (finally
          (in-ns (ns-name old-ns)))))))

+(def dsl-literal?
+  "Is this a literal in the DSL?"
+  string?)
+
 (defn ^:private dsl->logic
   "Given a DSL query, compile it to the underlying logic (miniKanren)
   expressions."


added project location for dev on notebook

--- src/distillery/core.clj
+++ src/distillery/core.clj
@@ -3,6 +3,7 @@

 (def root "D:\\Daten\\FH\\OLL\\") ;; FHB
 ;(def root "D:\\Repository\\Projekte\\Arbeit\\FHB\\OLL\\") ;; HOME
+;(def root "C:\\Repository\\Projekte\\Arbeit\\FHB\\OLL\\") ;; NB

 (def job-descr
   {:job-name "Testlauf"


tweak build tasks

tweak build tasks

--- build.boot
+++ build.boot
@@ -246,7 +246,7 @@
                  "Home/jre/lib/rt.jar"))
     fileset))

-(deftask build
+(deftask package
   "Builds jar file."
   []
   (comp (assert-jdk7-bootclasspath)
@@ -255,7 +255,7 @@
         (jar)))

 (deftask deploy
-  "Builds uberjar, installs it to local Maven repo, and deploys it to Clojars."
+  "Builds jar file, installs it to local Maven repo, and deploys it to Clojars."
   []
-  (comp (build-jar) (push-release)))
-
+  (comp (package) (install) (push-release)))
+


"boot-reload" to 0.4.8

"boot-reload" to 0.4.8

--- build.boot
+++ build.boot
@@ -34,7 +34,7 @@
                   [tolitius/boot-stripper      "0.1.0-SNAPSHOT"  :scope "test"]
                   [com.cemerick/piggieback     "0.2.1"           :scope "test" :exclusions [org.clojure/clojurescript]]
                   [weasel                      "0.7.0"           :scope "test" :exclusions [org.clojure/clojurescript]]
-                  [adzerk/boot-reload          "0.4.2"           :scope "test"]
+                  [adzerk/boot-reload          "0.4.8"           :scope "test"]
                   [crisptrutski/boot-cljs-test "0.2.1-SNAPSHOT"  :scope "test"]])

 (require '[adzerk.bootlaces :refer :all]


bump some deps

bump some deps

--- build.boot
+++ build.boot
@@ -4,14 +4,14 @@
  :source-paths    #{"src/main"}
  :resource-paths  #{"resources"}
  :dependencies '[[org.clojure/clojurescript   "1.9.89"         :scope "provided"]
-                 [org.omcljs/om               "1.0.0-alpha40"  :scope "provided"]
+                 [org.omcljs/om               "1.0.0-alpha41"  :scope "provided"]
                  [devcards                    "0.2.1-7"]
                  [cljs-react-reload           "0.1.1"]

                  [org.clojure/core.async      "0.2.385"        :scope "test"]
                  [cljsjs/react-dom-server     "15.2.1-1"       :scope "test"]
-                 [sablono                     "0.7.2"          :scope "test"]
-                 [com.cognitect/transit-clj   "0.8.285"        :scope "test"]
+                 [sablono                     "0.7.3"          :scope "test"]
+                 [com.cognitect/transit-clj   "0.8.288"        :scope "test"]
                  [com.cemerick/piggieback     "0.2.1"          :scope "test"]
                  [pandeiro/boot-http          "0.7.3"          :scope "test"]
                  [adzerk/boot-cljs            "1.7.228-1"      :scope "test"]


Change the name of save-<foo>! to create-<foo>!; adds a new save-foo! method that checks for the existence of foo, then dispatches to either create or update.

--- src/doctopus/db.clj
+++ src/doctopus/db.clj
@@ -110,18 +110,25 @@
   (select tentacles-by-head
           (where {:head_name (:name head)})))

-(defn save-tentacle!
-  [tentacle]
-  (log/info "Saving tentacle:" tentacle)
+(defn create-tentacle!
+  [tentacle]
+  (log/info "Creating new tentacle in the db:" tentacle)
   (insert tentacles
           (values tentacle)))

 (defn update-tentacle!
   [tentacle]
-  (log/info "Updating tentacle" (:name tentacle) "with values:" tentacle)
+  (log/info "Record found, updating tentacle:" (:name tentacle) "with values:" tentacle)
   (update tentacles
           (set-fields tentacle)
           (where {:name (:name tentacle)})))
+
+(defn save-tentacle!
+  [tentacle]
+  (log/info "Saving tentacle" tentacle)
+  (if-not (empty? (get-tentacle (:name tentacle)))
+    (update-tentacle! tentacle)
+    (create-tentacle! tentacle)))

 (defn delete-tentacle!
   [tentacle]
@@ -144,7 +151,7 @@
   (select heads-by-tentacle
           (where {:tentacle_name (:name tentacle)})))

-(defn save-head!
+(defn create-head!
   [head]
   (log/info "Saving head:" head)
   (insert heads
@@ -152,10 +159,16 @@

 (defn update-head!
   [head]
-  (log/info "Updating head" (:name head) "with values" head)
+  (log/info "Updating head:" (:name head) "with values" head)
   (update heads
           (set-fields head)
           (where {:name (:name head)})))
+
+(defn save-head!
+  [head]
+  (if-not (empty? (get-head (:name head)))
+    (update-head! head)
+    (create-head! head)))

 (defn delete-head!
   [head]


Some renames

Some renames

--- src/cljs/conference_rating/conference_detail_page/aggregated_ratings.cljs
+++ src/cljs/conference_rating/conference_detail_page/aggregated_ratings.cljs
@@ -22,6 +22,7 @@
 (defn- selection-of-role-elements [aggregated-ratings role label]
   (let [count (role aggregated-ratings)]
     (if (> count 0) [badge (str label " " count) "badge-light-blue"])))
+

 (defn conference-badges [aggregated-ratings]
   [:div


small fix to readme rendering

small fix to readme rendering

--- src/fxc/handler.clj
+++ src/fxc/handler.clj
@@ -70,23 +70,21 @@
   [n s]
   (subs s 0 (min (count s) n)))

+(defn readme [request]
+  (conj {:session (web/check-session request)}
+        (web/render
+         (md/md-to-html-string
+          (slurp (let [accept (:accept request)
+                       readme "public/static/README-"
+                       lang (:language accept)
+                       locale (io/resource (str readme lang ".md"))]
+                   (if (nil? locale) (io/resource "public/static/README.md") locale)))))))
+
 (defroutes app-routes

-  (GET "/" request
-       (conj {:session (web/check-session request)}
-             (web/render
-              (md/md-to-html-string
-               (slurp (let [accept (:accept request)
-                            readme "public/static/README-"
-                            lang (:language accept)
-                            locale (io/resource (str readme lang ".md"))]
-                        (if (nil? locale) (io/resource (str readme ".md")) locale)))))))
+  (GET "/" request (readme request))

-  (GET "/about" request
-       (conj {:session (web/check-session request)}
-             (web/render
-              (md/md-to-html-string
-               (slurp (io/resource "public/static/README.md"))))))
+  (GET "/about" request (readme request))

   (GET "/share" request
        (let [config (web/check-session request)]


Upgrade cljsbuild.

Upgrade cljsbuild.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -16,7 +16,7 @@
                   [lein-clojars "0.9.1"]
                   [lein-pprint "1.1.2"]
                   [lein-ring "0.8.13"]
-                  [lein-cljsbuild "1.0.3"]
+                  [lein-cljsbuild "1.0.6"]
                   [lein-deps-tree "0.1.2"]
                   [mvxcvi/whidbey "0.4.1"]
                   [lein-typed "0.3.5"]


putting streams together, some problem with filtering

--- browser/cljs/settings.cljs
+++ browser/cljs/settings.cljs
@@ -5,10 +5,7 @@

-(defn append-text [settings which text]
-    (let [old-text (settings which)
-          new-text (str old-text " " text)]
-        (assoc settings which new-text)))
+

 ; (def print #(.log js/console %))
 ; (subscribe modifiers print)
@@ -25,9 +22,6 @@

 ; both of those^ scenarios are if changing has been set by change-setting!

-(-> modifiers
-    from-async
-    (rx/subscribe #(.log js/console %)))
 ; (subscribe modifiers (with-append))

 ; (-> characters
@@ -38,18 +32,35 @@
 (def incoming-clicks
     (rx/create #(reset! clicks-sub %)))

-(def settings-changes
-    (rx/create #()))
-
-
 (def changing
     (-> incoming-clicks
         (.merge (from-async characters))
         (rx/map #(map? %))
-        (rx/subscribe #(.log js/console %)))
-    )
+        (multi-sub #(.log js/console %))
+))

-(.log js/console changing)
+(defn only-when [predicates observable]
+    (-> observable
+        (rx/zip predicates
+            (fn [item bool]
+             {:item item :bool bool}))
+        (.filter :bool)
+        (multi-sub #(.log js/console %))
+        (rx/map :item)
+))
+
+(def valid-modifiers (only-when changing
+                        (from-async modifiers)))
+(def valid-characters (only-when changing
+                        (from-async characters)))
+
+(defn append-text [{:keys [settings button]} text]
+    (let [old-text (settings button)
+          new-text (str old-text " " text)]
+        (assoc settings button new-text)))
+
+(def settings-changes
+    (rx/zip incoming-clicks valid-modifiers append-text))

 (defn change-setting! [settings button]
     (let [action (keyword button)]


dont stop on random input, only eof should quit

closes #107

--- src/main/shadow/cljs/devtools/server.clj
+++ src/main/shadow/cljs/devtools/server.clj
@@ -209,7 +209,15 @@
       (netty/wait-for-close)))

 (defn wait-for-eof! []
-  (read *in* false ::eof))
+  (loop []
+    (let [x (try
+              (read *in* false ::eof)
+              (catch clojure.lang.LispReader$ReaderException e
+                ::continue)
+              (catch Exception e
+                ::eof))]
+      (when (not= x ::eof)
+        (recur)))))

 (defn watch-builds [build-ids options]
   (let [{:keys [supervisor] :as app}


Problem might be with deref not working

Problem might be with deref not working

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -29,15 +29,12 @@
 (defn korhal-init []
   [[] (atom {})])

-(defn korhal-deref [this]
-  @(.state this))
-
 (defn korhal-connected [this]
-  (.loadTypeData (:api @this)))
+  (.loadTypeData (:api @(.state this))))

 (defn korhal-gameStarted [this]
   (println "Here we go!")
-  (doto (:api @this)
+  (doto (:api @(.state this))
     (.enableUserInput)
     (.enablePerfectInformation)
     (.setGameSpeed 0)
@@ -50,20 +47,22 @@

 (defn korhal-gameUpdate [this]

+  (println "updating")
+
   ;; spawn a drone
-  (doseq [unit (.getMyUnits (:api @this))]
+  (doseq [unit (.getMyUnits (:api @(.state this)))]
     (when (= (.getTypeID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Zerg_Larva))
-      (when (and (>= (.. (:api @this) getSelf getMinerals) 50) (not (:morphed-drone this)))
+      (when (and (>= (.. (:api @(.state this)) getSelf getMinerals) 50) (not (:morphed-drone this)))
         (println "morphing a drone")
-        (.morph (:api @this) (.getID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Zerg_Drone))
+        (.morph (:api @(.state this)) (.getID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Zerg_Drone))
         (swap-keys (.state this) :morphed-drone true))))

   ;; collect minerals
-  (for [unit (.getMyUnits (:api @this))]
+  (for [unit (.getMyUnits (:api @(.state this)))]
     (when (= (.getTypeID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Zerg_Drone))
-      (when (and (.isIdle unit) (not (= (.getID unit) (:pool-drone @this))))
+      (when (and (.isIdle unit) (not (= (.getID unit) (:pool-drone @(.state this)))))
         (let [mineral? (fn [unit] (= (.getTypeID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Resource_Mineral_Field)))
-              mineral (first (filter mineral? (.getNeutralUnits (:api @this))))]
+              mineral (first (filter mineral? (.getNeutralUnits (:api @(.state this)))))]
         (.rightClick (.getID unit) (.getID mineral)))))))


fix indentation

fix indentation


(SERVER-876) Fix code_id ordering issue

(SERVER-876) Fix code_id ordering issue

This commit fixes test failures caused by the fact that
'as-jruby-request' was removing the :assoc-code-id key from the request
before 'with-code-id' had a chance to read it.

--- src/clj/puppetlabs/services/request_handler/request_handler_core.clj
+++ src/clj/puppetlabs/services/request_handler/request_handler_core.clj
@@ -334,9 +334,9 @@
   (fn [request]
     (->> request
          wrap-params-for-jruby
+         (with-code-id current-code-id)
          (as-jruby-request config)
          clojure.walk/stringify-keys
-         (with-code-id current-code-id)
          make-request-mutable
          (.handleRequest (:jruby-instance request))
          response->map)))


Test style customization

Test style customization

--- src/bakyeono/litedocx.clj
+++ src/bakyeono/litedocx.clj
@@ -20,7 +20,7 @@
                                      (w/tr (w/td 964 (w/p "a" "name"))
                                            (w/td 964 (w/p "a" "age"))
                                            (w/td 8072 (w/p "a" "description"))))
-                            (w/p "a"
+                            (w/p "para1"
                                  "This is a paragraph."))
         word-styles-xml (w/word-styles-xml styles)
         word-rels-document-xml-rels (w/word-rels-document-xml-rels resources)
@@ -38,7 +38,7 @@
   []
   (pack-docx
     "SAMPLE.docx"
-    []
+    [(w/paragraph-style "para1" :font "NanumGothic" :font-color "0000AA" :align "both")]
     (w/make-resources
       ["image/png" "foo.png" (load-byte-array "foo.png")])))


add github link to end of post

add github link to end of post

--- src/pc/views/blog/optimizing_om_apps.clj
+++ src/pc/views/blog/optimizing_om_apps.clj
@@ -85,7 +85,13 @@
      [:code.block
       [:span will-mount-code-block]
       [:span did-mount-code-block]]
-     [:p "Every mount and update gets stored to keep track of average and maximum render times."]]
+     [:p "Every mount and update gets stored to keep track of average and maximum render times."]
+
+     [:p
+      [:a {:href "https://github.com/PrecursorApp/om-i"} "Check it out on GitHub"]
+      "."]]
+
+

     [:article.blogpost-footnote
      [:p


(PDB-5145) Detect and log ERROR level messages if read-only user is misconfigured

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -583,6 +583,45 @@
   (require-valid-db-server min-version-override)
   (require-current-schema (trs "Database is not fully migrated.")))

+(defn validate-read-only-user
+  "Check that the postgres user supplied in the read-database config
+   has the appropriate read-only permissions. Log ERROR level warnings
+   if this user is not configured properly"
+  [read-db read-user]
+  (let [table-perms (jdbc/with-db-connection read-db
+                      (jdbc/query-to-vec
+                       ["select privilege_type, table_name
+                          from information_schema.table_privileges
+                          where grantee = ?;" read-user]))
+        table-owner (jdbc/with-db-connection read-db
+                      (jdbc/query-to-vec
+                       ["select * from pg_tables where tableowner = ?" read-user]))
+        superuser (jdbc/with-db-connection read-db
+                    (jdbc/query-to-vec
+                     ["select usesuper from pg_user where usename = ?" read-user]))
+        schema-owner (jdbc/with-db-connection read-db
+                       (jdbc/query-to-vec
+                        ["select pg_get_userbyid(nspowner)
+                           from pg_namespace
+                           where nspname = (select schemaname from pg_tables
+                                              where tablename = 'certnames')"]))
+        log-msg (fn [msg]
+                  (binding [*out* *err*]
+                    (println msg))
+                  (log/error msg))]
+
+    (when-not (every? (fn [r] (= "SELECT" (:privilege_type r))) table-perms)
+      (log-msg (trs "The read-database user is not configured properly because it has privileges other than SELECT on the puppetdb tables")))
+
+    (when (seq table-owner)
+      (log-msg (trs "The read-database user is not configured properly because it has ownership of tables")))
+
+    (when (:usesuper (first superuser))
+      (log-msg (trs "The read-database user is not configured properly because it is a superuser")))
+
+    (when (= read-user (:pg_get_userbyid (first schema-owner)))
+      (log-msg (trs "The read-database user is not configured properly because it owns the schema that contains the puppetdb database")))))
+
 (defn prep-db
   [{:keys [username migrator-username migrate min-required-version]}]
   (require-valid-db-server min-required-version)
@@ -915,6 +954,8 @@
                        (require-valid-db
                         (get-in config [:database :min-required-version])))

+                   _ (validate-read-only-user read-db (:connection-username read-database))
+
                    {:keys [command-chan command-loader dlo q]}
                    (init-queue config maybe-send-cmd-event! cmd-event-ch shutdown-for-ex)


(PDB-4308) Don't become unkillable on C-c during startup

...where "unkillable" of course doesn't include "kill -9".

Previously, if a shutdown were initiated (say via C-c) during the
init-with-db loop (i.e. during migrations), the loop would never exit,
and puppetdb would become unkillable.  This must be because some
shutdown hook is waiting on puppetdb's start method to finish (cf. JDK
Runtime/addShutdownHook documentation).

To make sure we notice the shutdown and bail out, register our own
shutdown hook to close the migrations database pool, which will cause
the next connection attempt to throw an exception that exits the loop.

The problem can be demonstrated easily by just putting a bad password
in the config file and running:

  ./pdb services -c pdb.ini

Then hit C-c.

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -339,17 +339,36 @@
   Throws {:type ::unsupported-database :current version :oldest
   version} if the current database is not supported."
   [write-db-config config]
+  ;; A C-c (SIGINT) will close the pool via the shutdown hook, which
+  ;; will then cause the pool connection to throw a (generic)
+  ;; SQLException.
   (with-open [db-pool (-> (assoc write-db-config
                                  :pool-name "PDBMigrationsPool"
                                  :connection-timeout 15000)
                           (jdbc/make-connection-pool database-metrics-registry))]
-    (while (not (try
-                  (initialize-schema {:datasource db-pool} config)
-                  true
-                  (catch java.sql.SQLTransientConnectionException e
-                    (log/error (str (trs "Will retry database connection after temporary failure: ")
-                                    ex))
-                    false))))))
+    (let [runtime (Runtime/getRuntime)
+          on-shutdown (doto (Thread.
+                             #(try
+                                (.close db-pool)
+                                (catch Exception ex
+                                  ;; Nothing to do but log it...
+                                  (log/error ex (trs "Unable to close migration pool")))))
+                        (.setName "PuppetDB migration pool closer"))]
+      (.addShutdownHook runtime on-shutdown)
+      (try
+        (while (not (try
+                      (initialize-schema {:datasource db-pool} config)
+                      true
+                      (catch java.sql.SQLTransientConnectionException e
+                        (log/error (str (trs "Will retry database connection after temporary failure: ")
+                                        ex))
+                        false))))
+        (finally
+          (try
+            (.removeShutdownHook runtime on-shutdown)
+            (catch IllegalStateException ex
+              ;; Ignore, because we're already shutting down.
+              nil)))))))

 (defn db-config->clean-request
   [config]


rename to flooding time

rename to flooding time

--- ws/nc-td.clj
+++ ws/nc-td.clj
@@ -50,9 +50,9 @@
          [:scale_y_log10]
          [:guides {:fill "none"}]
          [:xlab "Broadcaster"]
-         [:ylab "Temporal distance in minutes"]
+         [:ylab "Flooding time in minutes"]
          [:theme_bw]
-         [:ggtitle "Average temporal distance"])]
+         [:ggtitle "Average flooding time"])]
       {:width 12 :height 6 }))
 ;; @@
 ;; =>
@@ -81,7 +81,7 @@
          [:xlab "Day"]
          [:ylab "Hours"]
          [:theme_bw]
-         [:ggtitle (str "Average temporal distance evolution of " (element-name author))])]
+         [:ggtitle (str "Average fllotding time evolution of " (element-name author))])]
       {:width 5 :height 5})))
 ;; @@
 ;; =>
@@ -104,7 +104,7 @@
          [:xlab "Day"]
          [:ylab "Minutes"]
          [:theme_bw]
-         [:ggtitle "Average temporal distance evolution"])]
+         [:ggtitle "Average flooding time evolution"])]
       {:width 5 :height 5}))
 ;; @@
 ;; =>


CMR-4240 - Fixed docstring and added more examples.

--- dev-system/dev/user.clj
+++ dev-system/dev/user.clj
@@ -81,8 +81,19 @@

   Examples:
   ```
-  => (set-mode! :db :external)
+  => (set-modes! :db :external)
+  ```
+  ```
   => (set-modes! :elastic :in-memory :echo :external)
+  ```
+
+  Note that you can also pass these parameters to the `reset` function, which
+  will call `set-modes!` as shown above. Examples:
+  ```
+  => (reset :db :external)
+  ```
+  ```
+  => (reset :elastic :in-memory :echo :external)
   ```"
   ;; Note that the keys are listed below as a means of self-documentation; they
   ;; are not actually used individually, but rather as a whole with the
@@ -150,7 +161,15 @@

   If a run mode for a particular component is not passed, its value is taken
   from what is already in the `run-modes` global data structure. If no mode has
-  been set, the default from initialization will be used."
+  been set, the default from initialization will be used.
+
+  Examples:
+  ```
+  => (start :db :external)
+  ```
+  ```
+  => (start :elastic :in-memory :echo :external)
+  ```"
   ;; Note that even through the named args are not used, they are provided as
   ;; a means of self-documentation.
   [& {:keys [_elastic _echo _db _messaging] :as new-modes}]
@@ -215,8 +234,12 @@
   "Resets the development environment, taking optional keyword arguments for
   various run modes, e.g.:
   ```
-  (reset :db :external)
-  ```
+  => (reset :db :external)
+  ```
+  ```
+  => (reset :elastic :in-memory :echo :external)
+  ```
+
   See the docstring for `set-modes!` for more details.

   Environment resetting includes the reloading of any changed namespaces and


some repl control, command still messy

some repl control, command still messy

--- src/bitsplit_cli/core.clj
+++ src/bitsplit_cli/core.clj
@@ -5,25 +5,35 @@
           bitsplit-cli.bitcoind
           bitsplit-cli.filesystem))

+
+(def storage (->File "FAKE"))
+(def client (->Bitcoind ""))
+
 (defn read-prompt [prompt]
     (print prompt)
     (flush)
     (read-line))
-
 (def read-in (partial read-prompt "bitsplit> "))
-
+(defn exit? [command]
+    (->> "exit"
+          seq
+          (= (take 4 command))))
 (defn start-repl []
     (loop []
-        (let [commmand (read-in)]
-            (if-not (= commmand "exit")
+        (let [command (read-in)]
+            (if-not (exit? command)
                 (do
-                    (println "sup" commmand)
+                    (execute {
+                        :storage storage
+                        :command command
+                        :client client
+                        })
                     (recur))))))

 (defn -main [& args]
-    (if (empty? args)
-        (println "empty" args)
-        (start-repl)))
+    (if (empty? args)
+        (start-repl)
+        (println "empty" args)))

 ; A plan:
 ;  define a spec for the shell, then functions to handle each commmand


Add "counted-frames" comment

Add "counted-frames" comment

--- src/chouser/wallframe.clj
+++ src/chouser/wallframe.clj
@@ -3,8 +3,10 @@
             [clojure.core.rrb-vector :as fv]
             [clojure.pprint :refer [pprint]]))

+;; count, width, height
 (def counted-frames
-  [[1 34 44]
+  [
+   [1 34 44]
    [1 24.5 37]
    [1 10 10]
    [1 28.5 33.5]


prevent warning on constant expressions in finally block. This goes beyond what Clojure proper does, and I am not sure is worth it

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -346,10 +346,11 @@
               (emit-block subcontext statements ret)))
           (print "}"))
         (when finally
-          (print "finally {")
           (let [{:keys [statements ret]} finally]
-            (emit-block subcontext statements ret))
-          (print "}"))
+            (assert (not= :constant (:op ret)) "finally block cannot contain constant")
+            (print "finally {")
+            (emit-block subcontext statements ret)
+            (print "}")))
         (when (= :expr context) (print "})()")))
       (let [{:keys [statements ret]} try]
         (when (and statements (= :expr context)) (print "(function (){"))


Wrap some types that were accidentally not wrapped.

--- src/clj/guangyin/core.clj
+++ src/clj/guangyin/core.clj
@@ -488,7 +488,7 @@
   (year-month ([this] (wrap (YearMonth/parse this)))
               ([this param] (wrap (YearMonth/parse this (unwrap param)))))
   java.lang.Long
-  (year-month [year month] (YearMonth/of year month)))
+  (year-month [year month] (wrap (YearMonth/of year month))))

 (defn month?
   "Returns true if the given value is an exact month.
@@ -517,7 +517,7 @@
   java.time.ZoneId
   (month [this] (wrap (Month/from (LocalDate/now this))))
   java.lang.Long
-  (month [this] (Month/of this)))
+  (month [this] (wrap (Month/of this))))

 (defn month-day?
   "Returns true if the given value is a combination of month and day of month."
@@ -545,7 +545,7 @@
   (month-day ([this] (wrap (MonthDay/parse this)))
              ([this param] (wrap (MonthDay/parse this (unwrap param)))))
   java.lang.Long
-  (month-day [month day] (MonthDay/of month day)))
+  (month-day [month day] (wrap (MonthDay/of month day))))

 (defn day-of-week?
   "Returns true if the given value is an exact day of week.
@@ -574,7 +574,7 @@
   java.time.ZoneId
   (day-of-week [this] (wrap (DayOfWeek/from (LocalDate/now this))))
   java.lang.Long
-  (day-of-week [this] (DayOfWeek/of this)))
+  (day-of-week [this] (wrap (DayOfWeek/of this))))

 (defn zone-id?
   "Returns true if the given value is a time zone.


Support plus and minus using a map of units.

--- src/clj/guangyin/core.clj
+++ src/clj/guangyin/core.clj
@@ -715,19 +715,39 @@
   [nanos]
   (wrap (Duration/ofNanos nanos)))

+(defn- fplus
+  ([] 0)
+  ([x] (wrap x))
+  ([x [key val]]
+   (.plus (unwrap x) val (fields/all-units key)))
+  ([x keyval & more]
+   (reduce fplus (fplus x keyval) more)))
+
 (defn plus
   ([] 0)
   ([x] (wrap x))
-  ([x y] (wrap (.plus (unwrap x) (unwrap y))))
+  ([x y] (if (map? y)
+             (apply fplus x (seq y))
+             (.plus (unwrap x) (unwrap y))))
   ([x y & more]
-   (reduce plus (.plus (unwrap x) (unwrap y)) more)))
+   (reduce plus (plus x y) more)))
+
+(defn- fminus
+  ([] 0)
+  ([x] (wrap x))
+  ([x [key val]]
+   (.minus (unwrap x) val (fields/all-units key)))
+  ([x keyval & more]
+   (reduce fminus (fminus x keyval) more)))

 (defn minus
   ([] 0)
-  ([x] x)
-  ([x y] (wrap (.minus (unwrap x) (unwrap y))))
+  ([x] (wrap x))
+  ([x y] (if (map? y)
+             (apply fminus x (seq y))
+             (.minus (unwrap x) (unwrap y))))
   ([x y & more]
-   (reduce minus (.minus (unwrap x) (unwrap y)) more)))
+   (reduce minus (minus x y) more)))

 (defn multiplied-by
   [x ^long multiplicand]


adding rates to q-stats

adding rates to q-stats

--- src/clj/hface/refresh.clj
+++ src/clj/hface/refresh.clj
@@ -18,31 +18,39 @@
             :put-rate (rate-it pm cm :put-count :put-rate interval)
             :hit-rate (rate-it pm cm :hits :hit-rate interval)))

-(defn compare-and-rate-maps [previous current interval]
+(defn rate-q [pm cm interval]
+  (assoc cm :take-rate (rate-it pm cm :number-of-offers :take-rate interval)
+            :put-rate (rate-it pm cm :number-of-polls :put-rate interval)
+            :rejected-put-rate (rate-it pm cm :number-of-rejected-offers :rejected-put-rate interval)
+            :empty-take-rate (rate-it pm cm :number-of-empty-polls :empty-take-rate interval)))
+
+(defn compare-and-rate [rate previous current interval]
   (into {}
     (for [[k v] current]
-      (if-let [pv (k previous)]           ;; if there is a value in a prev map for this key
-        [k (rate-map pv v interval)]
-        [k (rate-map v v interval)]))))
+      (if-let [pv (k previous)]          ;; if there is a value in a prev map for this key
+        [k (rate pv v interval)]
+        [k (rate v v interval)]))))

-(defn add-map-ratings [p-stats            ;; previous stats
-                       c-stats            ;; current stats
-                       interval
-                       mtype]             ;; :map-stats, :multi-map-stats
-  (let [m-stats #(-> % :aggregated mtype)
-        previous (m-stats p-stats)
-        current (m-stats c-stats)]
-    (assoc-in c-stats [:aggregated mtype]
-              (compare-and-rate-maps previous current interval))))
+(defn add-ratings [c-stats               ;; current stats
+                   p-stats               ;; previous stats
+                   rate
+                   interval
+                   s-type]               ;; :map-stats, :multi-map-stats, :queue-stats
+  (let [stats #(-> % :aggregated s-type)
+        previous (stats p-stats)
+        current (stats c-stats)]
+    (assoc-in c-stats [:aggregated s-type]
+              (compare-and-rate rate previous current interval))))

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

 (defn refresh-stats
   "refreshing stats and adding rate metrics"
   [previous interval]
-  (let [current (cluster-stats)
-        with-map-rates (add-map-ratings @previous current interval :map-stats)
-        with-rates (add-map-ratings @previous with-map-rates interval :multi-map-stats)]     ;; TODO: refactor out and add other ratings
+  (let [with-rates (-> (cluster-stats)
+                       (add-ratings @previous rate-map interval :map-stats)
+                       (add-ratings @previous rate-map interval :multi-map-stats)
+                       (add-ratings @previous rate-q interval :queue-stats))]
     (reset! previous with-rates)))

 (defn collect-stats


auth client with tokens

auth client with tokens

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -109,17 +109,17 @@
         (apply-command db user (slack-text params)))))
   {:status 200 :body ""})

-(defn timestamp [{:keys [db]} {:keys [params]}]
-  (future
-    (when (valid-timestamp? params)
-      (when-let [user (api-user db params)]
-        (timbre/debugf "Received a timestamp: %s"
-                       (pr-str params))
-        (update-pings! db user [(-> params
-                                    (assoc :user-id (:id user))
-                                    (update :timestamp cli/str-number?)
-                                    (dissoc :username :password))]))))
-  {:status 200 :body ""})
+(defn timestamp [{:keys [db]} {:keys [params user-id]}]
+  (if (and (valid-timestamp? params) user-id)
+    (when-let [user (db/get-user-by-id db user-id)]
+      (timbre/debugf "Received a timestamp: %s"
+                     (pr-str params))
+      (update-pings! db user [(-> params
+                                  (assoc :user-id (:id user))
+                                  (update :timestamp cli/str-number?)
+                                  (dissoc :username :password))])
+      {:status 200 :body ""})
+    {:status 401 :body "unauthorized"}))

 (defn health-check [component]
   (fn [request]


Added mode functions for specific pin objects

--- src/clj_bots/pin_ctrl.clj
+++ src/clj_bots/pin_ctrl.clj
@@ -51,20 +51,35 @@
   [board f & args]
   (p/update-config board (fn [current-conf] (apply f current-conf args))))

-(defn pin-modes
-  "Returns a map of pin numbers to possible modes for the entire board, or the available modes of a specific pin."
-  ; Should add second 1-arity that checks for
-  ([board]
-   (p/pin-modes board))
-  ([board pin]
-   (get (pin-modes board) pin)))
+
+(defmulti pin-modes
+  "Returns a map of pin numbers to possible modes for the entire board, or the available modes of a specific pin.
+  Arguments should be `[board & [pin-n]]` or `[pin]`."
+  board-dispatch)
+
+(defmethod pin-modes true
+  [board & [pin-n]]
+  (if pin-n
+    (get (pin-modes board) pin-n)
+    (p/pin-modes board)))
+
+(defmethod pin-modes false
+  [pin]
+  (board-apply pin-modes pin))
+

 (defn current-pin-modes
-  "Returns a map of pin numbers to possible modes."
-  ([board]
-   (p/current-pin-modes board))
-  ([board pin]
-   (get (current-pin-modes board) pin)))
+  "Returns a map of pin numbers to their corresponding current modes."
+  [board]
+  (p/current-pin-modes board))
+
+(defn current-pin-mode
+  "Return the current mode of a specific pin."
+  ([board pin-n]
+   (get (current-pin-modes board) pin-n))
+  ([pin]
+   (board-apply current-pin-mode pin)))
+

 (defn set-default-board!
   "Set the default board implementation"


CMR-178: fixed indentation.

CMR-178: fixed indentation.

--- src/cmr/ingest/system.clj
+++ src/cmr/ingest/system.clj
@@ -23,34 +23,34 @@
   {:log log
    :config config
    :web web
-  []
-  {:log (log/create-logger)
-   :config default-config
-   :web (web/create-web-server 3002 routes/make-api)
-   :zipkin (context/zipkin-config "Ingest" false)})
+   []
+   {:log (log/create-logger)
+    :config default-config
+    :web (web/create-web-server 3002 routes/make-api)
+    :zipkin (context/zipkin-config "Ingest" false)})

-(defn start
-  "Performs side effects to initialize the system, acquire resources,
-  and start it running. Returns an updated instance of the system."
-  [this]
-  (info "System starting")
-  (let [started-system (reduce (fn [system component-name]
-                                 (update-in system [component-name]
-                                            #(lifecycle/start % system)))
-                               this
-                               component-order)]
-    (info "System started")
-    started-system))
+   (defn start
+     "Performs side effects to initialize the system, acquire resources,
+     and start it running. Returns an updated instance of the system."
+     [this]
+     (info "System starting")
+     (let [started-system (reduce (fn [system component-name]
+                                    (update-in system [component-name]
+                                               #(lifecycle/start % system)))
+                                  this
+                                  component-order)]
+       (info "System started")
+       started-system))

-(defn stop
-  "Performs side effects to shut down the system and release its
-  resources. Returns an updated instance of the system."
-  [this]
-  (info "System shutting down")
-  (let [stopped-system (reduce (fn [system component-name]
-                                 (update-in system [component-name]
-                                            #(lifecycle/stop % system)))
-                               this
-                               (reverse component-order))]
-    (info "System stopped")
-    stopped-system))
+   (defn stop
+     "Performs side effects to shut down the system and release its
+     resources. Returns an updated instance of the system."
+     [this]
+     (info "System shutting down")
+     (let [stopped-system (reduce (fn [system component-name]
+                                    (update-in system [component-name]
+                                               #(lifecycle/stop % system)))
+                                  this
+                                  (reverse component-order))]
+       (info "System stopped")
+       stopped-system))


Updating GA to remove query parameters.

Updating GA to remove query parameters.

--- src/clj/collect_earth_online/views.clj
+++ src/clj/collect_earth_online/views.clj
@@ -23,7 +23,7 @@
    [:link {:rel "shortcut icon" :href "favicon.ico"}]
    (when-let [ga-id (get-config :ga-id)]
      (list [:script {:async true :src (str "https://www.googletagmanager.com/gtag/js?id=" ga-id)}]
-           [:script (str "window.dataLayer = window.dataLayer || []; function gtag(){dataLayer.push(arguments);} gtag('js', new Date()); gtag('config', '" ga-id "');")]))
+           [:script (str "window.dataLayer = window.dataLayer || []; function gtag(){dataLayer.push(arguments);} gtag('js', new Date()); gtag('config', '" ga-id "', {'page_location': location.host + location.pathname});")]))
    (include-css "/css/bootstrap.min.css")
    (apply include-js
           "/js/jquery-3.5.1.slim.min.js"


refactor code

refactor code

--- src/cljs/salava/badge/ui/settings.cljs
+++ src/cljs/salava/badge/ui/settings.cljs
@@ -231,17 +231,17 @@
                                                     [:div {:class "col-md-12"}
                                                      [tag/new-tag-input (cursor state [:badge-settings :tags]) (cursor state [:badge-settings :new-tag]) state init-data]]]

-                                                   [:div.form-group
-                                                    [:label {:class "col-md-12 sub-heading" :for "evidence"} (t :badge/Evidence)]
-                                                    [:div
-                                                     (when-not (empty? (:evidences data))
-                                                      [:fieldset {:class "col-md-9 checkbox"}
-                                                       [:div.col-md-12 [:label {:for "show-evidence"}
-                                                                        [:input {:type      "checkbox"
-                                                                                :id        "show-evidence"
-                                                                                :on-change #(toggle-evidence state)
-                                                                                :checked   (get-in @state [:badge-settings :show_evidence])}]
-                                                                        (t :badge/Evidencevisibility)]]])]]
+                                                   [:div {:class "row"}
+                                                    [:label {:class "col-md-12 sub-heading" :for "evidence"}
+                                                     (t :badge/Evidence)]]
+                                                   (when-not (empty? (:evidences data))
+                                                     [:div.form-group[:fieldset {:class "col-md-9 checkbox"}
+                                                      [:div.col-md-12 [:label {:for "show-evidence"}
+                                                                       [:input {:type      "checkbox"
+                                                                                :id        "show-evidence"
+                                                                                :on-change #(toggle-evidence state)
+                                                                                :checked   (get-in @state [:badge-settings :show_evidence])}]
+                                                                       (t :badge/Evidencevisibility)]]]])
                                                    [evidence/evidence-block data state init-data]]]
                                             [:div.modal-footer]])]]))


Minor ui fix

Minor ui fix

--- src/cljs/salava/badgeIssuer/ui/my.cljs
+++ src/cljs/salava/badgeIssuer/ui/my.cljs
@@ -95,6 +95,7 @@
   (let [alert @(cursor state [:alert])
         {:keys [badge recipient_count]} alert]
    (.scrollTo js/window 0 0)
+   ;(fn []
    [:div#badge-creator.alert.alert-success.alert-dismissable
     [:button.close
      {:type "button"
@@ -115,7 +116,7 @@
       [:i {:class "fa fa-cog fa-spin fa-2x "}]
       [:span (str (t :core/Loading) "...")]]
      [:div
-      (when @(cursor state [:alert]) [issue-alert state])
+      (when @(cursor state [:alert]) (issue-alert state))
       [grid-form state]
       (if (not-activated?)
         [not-activated-banner]


Improved docstrings and minor renaming of private functions on accessrules ns.

--- src/clojure/buddy/auth/accessrules.clj
+++ src/clojure/buddy/auth/accessrules.clj
@@ -4,9 +4,19 @@
             [clojure.walk :refer [postwalk]]
             [clout.core :as clout]))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Rule Handler Protocol
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defprotocol IRuleHandlerResponse
+  "Protocol for uniform identification on
+  success value on rule handler response."
   (success? [_] "Check if a response is a success.")
   (get-value [_] "Get a hander response value."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Rule Handler Response Type
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (deftype RuleSuccess [v]
   IRuleHandlerResponse
@@ -36,7 +46,6 @@
   (toString [self]
     (with-out-str (print [v]))))

-
 (defn success
   "Function that return a success state
   from one access rule handler."
@@ -49,6 +58,9 @@
   ([] (RuleError. nil))
   ([v] (RuleError. v)))

+;; Default implementation for IRuleHandlerResponse protocol
+;; for nil and any boolean value.
+
 (extend-protocol IRuleHandlerResponse
   nil
   (success? [_] false)
@@ -58,7 +70,11 @@
   (success? [v] v)
   (get-value [_] nil))

-(defn compile-rule-handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- compile-rule-handler
   "Receives a rule handler and return a compiled version of it.

   The compiled version of rule handler consists in
@@ -124,7 +140,6 @@
                :else form))
             rule))

-
 (defn- compile-access-rule
   "Receives a access rule and return a compiled version of it.

@@ -133,7 +148,7 @@
   that will be used for match the url and `:handler` is a rule
   handler.

-  Little overview of aspect of one access rule:
+  Little overview of aspect of access rules:

     [{:uri \"/foo\"
       :handler user-access}
@@ -163,6 +178,7 @@
       :handler #<accessrules$compile_rule_handler$fn__14040$fn__14043...>
   "
   [accessrule]
+  {:pre [(map? accessrule)]}
   (let [handler (compile-rule-handler (:handler accessrule))
         matcher (cond
                  (:pattern accessrule)
@@ -195,8 +211,8 @@
   (mapv compile-access-rule accessrules))

 (defn- match-access-rules
-  "Iterates over all rules and try match each one
-  in order. Return a first matched rule or nil."
+  "Iterates over all access rules and try match each one
+  in order. Return a first matched access rule or nil."
   [accessrules request]
   (first (filter (fn [accessrule]
                    (let [matcher (:matcher accessrule)]
@@ -204,7 +220,17 @@
                  accessrules)))

 (defn- handle-error
-  [rsp request {:keys [reject-handler on-error redirect]}]
+  "Handles the error situation when access rules are
+  evaluated in `wrap-access-rules` middleware.
+
+  It receives a hanlder response (anything that rule handler may
+  return), a current request and a hashmap passwd to the access
+  rule defintion.
+
+  The received response are mandatory satisfies
+  IRuleHandlerResponse protocol."
+  [response request {:keys [reject-handler on-error redirect]}]
+  {:pre [(satisfies? IRuleHandlerResponse response)]}
   (let [val (get-value rsp)]
     (cond
      (ring/response? val)
@@ -226,8 +252,12 @@
      :else
      (throw-unauthorized))))

-(defn apply-match-rule
+(defn- apply-matched-access-rule
+  "Simple helper that executes the rule handler
+  of received access rule and returns the result."
   [match request]
+  {:pre [(map? match)
+         (contains? match :handler)]}
   (let [handler (:handler match)]
     (handler request)))

@@ -256,7 +286,7 @@
   (let [accessrules (compile-access-rules rules)]
     (fn [request]
       (if-let [match (match-access-rules accessrules request)]
-        (let [res (apply-match-rule match request)]
+        (let [res (apply-matched-access-rule match request)]
           (if (success? res)
            (handler request)
            (handle-error res request (merge opts match))))


Adapt routing implementation to helpers api changes.

--- src/clojure/catacumba/impl/routing.clj
+++ src/clojure/catacumba/impl/routing.clj
@@ -25,7 +25,7 @@
 (ns catacumba.impl.routing
   (:require [catacumba.impl.handlers :as handlers]
             [catacumba.impl.context :as ctx]
-            [catacumba.impl.helpers :as helpers])
+            [catacumba.impl.helpers :as ch])
   (:import ratpack.handling.Context
            ratpack.handling.Chain
            ratpack.handling.Handlers
@@ -44,7 +44,7 @@

 (defmethod attach-route :assets
   [^Chain chain [_ ^String path {:keys [dir indexes]}]]
-  (.files chain (helpers/action
+  (.files chain (ch/fn->action
                  (fn [^FileHandlerSpec spec]
                    (.path spec path)
                    (when indexes (.indexFiles spec (into-array String indexes)))
@@ -53,19 +53,19 @@
 (defmethod attach-route :prefix
   [^Chain chain [_ ^String path & handlers]]
   (let [callback #(reduce attach-route % handlers)]
-    (.prefix chain path ^Action (helpers/action callback))))
+    (.prefix chain path ^Action (ch/fn->action callback))))

 (defmethod attach-route :scope
   [^Chain chain [_ & handlers]]
   (let [callback #(reduce attach-route % handlers)]
-    (.insert chain ^Action (helpers/action callback))))
+    (.insert chain ^Action (ch/fn->action callback))))

 (defmethod attach-route :by-method
   [^Chain chain [_ handlersmap]]
   {:pre [(map? handlersmap)]}
   (letfn [(attach [^Context ctx ^ByMethodSpec spec [method handler]]
             (let [^Handler handler (handlers/adapter handler)
-                  ^Block block (helpers/block #(.handle handler ctx))]
+                  ^Block block (ch/fn->block #(.handle handler ctx))]
               (case method
                 :get (.get spec block)
                 :post (.post spec block)
@@ -77,7 +77,7 @@
               (run! attach' handlersmap)))]
     (.all chain (reify Handler
                   (^void handle [_ ^Context ctx]
-                    (.byMethod ctx (helpers/action (partial callback ctx))))))))
+                    (.byMethod ctx (ch/fn->action (partial callback ctx))))))))

 (defmethod attach-route :error
@@ -90,7 +90,7 @@
                                  (when (satisfies? handlers/IHandlerResponse response)
                                    (handlers/handle-response response context)))))]
               (.add rspec ServerErrorHandler ehandler)))]
-    (.register chain ^Action (helpers/action on-register))))
+    (.register chain ^Action (ch/fn->action on-register))))

 (defmethod attach-route :default
   [chain [method & handlers-and-path]]
@@ -99,8 +99,8 @@
       (let [^Handler handler (-> (mapv handlers/adapter (rest handlers-and-path))
                                  (Handlers/chain))]
         (case method
-          :any (.prefix chain path (helpers/action #(.all % handler)))
-          :all (.prefix chain path (helpers/action #(.all % handler)))
+          :any (.prefix chain path (ch/fn->action #(.all % handler)))
+          :all (.prefix chain path (ch/fn->action #(.all % handler)))
           :get (.get chain path handler)
           :post (.post chain path handler)
           :put (.put chain path handler)


#5 rename

#5 rename

--- src/kalar_plugins/templates/hiccup.clj
+++ src/kalar_plugins/templates/hiccup.clj
@@ -65,7 +65,7 @@
                  (kfile/touch output#)
                  (spit output# ~body)))))))))

-(defmacro def-navpage [head-url tail-url-ptn dir num-perpage body]
+(defmacro def-excerpts [head-url tail-url-ptn dir num-perpage body]
   `(def hiccup#
      (reify HiccupPlugin
        (hiccup-compile [this]
@@ -73,16 +73,17 @@
                index-abst-map# (zipmap (range 1 (+ 1 (count parts#))) parts#)
                first-abst# (first index-abst-map#)
                rest-absts# (rest index-abst-map#)]
-           (let [~'mp
+           (let [~'page_
                  (merge
                    {:posts (map #(load-md-abst (.getAbsolutePath %)) (val first-abst#))}
                    {:index (key first-abst#)})
                  output# (io/file (kfile/find-dest) ~head-url)]
+             (println ~'page_)
              (kfile/touch output#)
              (spit output# ~body))
            (dorun
              (for [posts-per-page# rest-absts#]
-               (let [~'mp (merge {:posts (map #(load-md-abst (.getAbsolutePath %)) (val posts-per-page#))}
+               (let [~'page_ (merge {:posts (map #(load-md-abst (.getAbsolutePath %)) (val posts-per-page#))}
                                  {:index (key first-abst#)})
                      output# (io/file (kfile/find-dest)
                                       (string/replace ~tail-url-ptn #":id" (str (key posts-per-page#))))]


32bit check & new scopes on if/while

32bit check & new scopes on if/while

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -279,7 +279,9 @@
   [glob-state vars expr]
   (let [location (util/ip-meta expr)]
     (match/match (first expr)
-      :elitint (util/succ [vars (with-type expr [:int])])
+      :elitint (if (or (> (second expr) 2147483647) (< (second expr) -2147483648))
+                 (util/err (str "int literal not in the [-2147483648, 2147483647] range in " location))
+                 (util/succ [vars (with-type expr [:int])]))
       :elittrue (util/succ [vars (with-type expr [:bool])])
       :elitfalse (util/succ [vars (with-type expr [:bool])])
       :estring (let
@@ -500,21 +502,21 @@
       :cond (m/domonad util/phase-m
               [
                [vars1 expr] (annotate-expr glob-state vars (second code))
-               [vars2 nblock] (annotate-code glob-state vars1 (third code))
-               res (check-types [:bool] (get-type expr) [vars2 [:cond expr nblock]] location)]
+               [vars2 nblock] (annotate-code glob-state (new-scope vars1) (third code))
+               res (check-types [:bool] (get-type expr) [(rm-scope vars2) [:cond expr nblock]] location)]
               res)
       :condelse (m/domonad util/phase-m
                   [
                    [vars1 expr] (annotate-expr glob-state vars (second code))
-                   [vars2 nblock1] (annotate-code glob-state vars1 (third code))
-                   [vars3 nblock2] (annotate-code glob-state vars2 (fourth code))
-                   res (check-types [:bool] (get-type expr) [vars3 [:condelse expr nblock1 nblock2]] location)]
+                   [vars2 nblock1] (annotate-code glob-state (new-scope vars1) (third code))
+                   [vars3 nblock2] (annotate-code glob-state (new-scope (rm-scope vars2)) (fourth code))
+                   res (check-types [:bool] (get-type expr) [(rm-scope vars3) [:condelse expr nblock1 nblock2]] location)]
                   res)
       :while (m/domonad util/phase-m
                [
                 [vars1 expr] (annotate-expr glob-state vars (second code))
-                [vars2 nblock] (annotate-code glob-state vars1 (third code))
-                res (check-types [:bool] (get-type expr) [vars2 [:while expr nblock]] location)]
+                [vars2 nblock] (annotate-code glob-state (new-scope vars1) (third code))
+                res (check-types [:bool] (get-type expr) [(rm-scope vars2) [:while expr nblock]] location)]
                res
                )
       :sexp (m/domonad util/phase-m


use babel/enrich

use babel/enrich

--- babel/espanol.clj
+++ babel/espanol.clj
@@ -3,12 +3,13 @@

 (require '[babel.cache :refer (build-lex-sch-cache create-index spec-to-phrases)])
 (require '[babel.forest :as forest])
-(require '[babel.espanol.grammar :as gram])
+(require '[babel.enrich :refer [enrich]])
+(require '[babel.espanol.grammar :refer [grammar]])
 (require '[babel.espanol.lexicon :as lex])
+(require '[babel.espanol.pos :refer :all])
 (require '[babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)])
 (require '[babel.espanol.morphology :as morph :refer [fo]])
 (require '[babel.parse :as parse])
-(require '[babel.espanol.pos :refer :all])
 (require '[babel.ug :refer :all])
 (require '[clojure.string :as string])
 (require '[clojure.tools.logging :as log])
@@ -37,8 +38,6 @@
                  (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                               (not (= :none (get-in % [:synsem :infl] :none))))
                          vals))))))
-
-
 (def small
   (future
     (let [grammar
@@ -85,63 +84,3 @@
        :index (create-index grammar (flatten (vals lexicon)) head-principle)
        })))

-(defn enrich [spec]
-  (let [against-pred (against-pred spec)]
-    (if true against-pred
-        (let [against-comp (map (fn [spec]
-                            (against-comp spec))
-                          (if (seq? against-pred)
-                            (seq (set against-pred))
-                            against-pred))]
-          (if (seq? against-comp)
-            (seq (set against-comp))
-            against-comp)))))
-
-(defn against-pred [spec]
-  (let [pred (get-in spec [:synsem :sem :pred] :top)]
-    (if (= :top pred)
-      spec
-      (mapcat (fn [lexeme]
-                (let [result (unify spec
-                                    {:synsem {:sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}
-                                    {:synsem {:essere (strip-refs (get-in lexeme [:synsem :essere] :top))}}
-                                    )]
-                  (if (not (fail? result))
-                    (list result))))
-              (matching-head-lexemes spec)))))
-
-(defn against-comp [spec]
-  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
-    (if (= :top pred-of-comp)
-      spec
-      (mapcat (fn [lexeme]
-                (let [result (unify spec
-                                    {:comp {:synsem {:agr (strip-refs (get-in lexeme [:synsem :agr] :top))
-                                                     :sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}})]
-                  (if (not (fail? result))
-                    (list result))))
-              (matching-comp-lexemes spec)))))
-
-(defn matching-head-lexemes [spec]
-  (let [pred-of-head (get-in spec [:synsem :sem :pred] :top)]
-    (if (= pred-of-head :top)
-      spec
-      (mapcat (fn [lexemes]
-                (mapcat (fn [lexeme]
-                          (if (= pred-of-head
-                                 (get-in lexeme [:synsem :sem :pred] :top))
-                            (list lexeme)))
-                        lexemes))
-              (vals @lexicon)))))
-
-(defn matching-comp-lexemes [spec]
-  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
-    (if (= pred-of-comp :top)
-      spec
-      (mapcat (fn [lexemes]
-                (mapcat (fn [lexeme]
-                          (if (= pred-of-comp
-                                 (get-in lexeme [:synsem :sem :pred] :top))
-                            (list lexeme)))
-                        lexemes))
-              (vals @lexicon)))))


Ensure there's no overlap between subsequent vault data write jobs

--- metlog-vault/src-server/metlog_vault/core.clj
+++ metlog-vault/src-server/metlog_vault/core.clj
@@ -25,27 +25,26 @@

 (defn queued-data-sink [ db-pool ]
   (let [ sample-queue (java.util.concurrent.LinkedBlockingQueue.) ]
-    (at-at/every 15000
+    (at-at/every 60000
                  (exception-barrier
                   #(.add sample-queue (make-sample "vault-ingress-queue-size"
                                                    (.size sample-queue)))
                   "Record ingress queue size")
                  my-pool)
-    (at-at/every 60000
-                 (exception-barrier
-                  #(let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]
-                     (locking sample-queue
-                       (.drainTo sample-queue snapshot))
-                     (when (> (count snapshot) 0)
-                       (log/info "Storing " (count snapshot) " samples.")
-                       (data/with-db-connection db-pool
-                         (data/store-data-samples (seq snapshot)))))
-                  "Store ingress queue contents")
-                 my-pool)
+    (at-at/interspaced 15000
+                       (exception-barrier
+                        #(let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]
+                           (locking sample-queue
+                             (.drainTo sample-queue snapshot))
+                           (when (> (count snapshot) 0)
+                             (log/info "Storing " (count snapshot) " samples.")
+                             (data/with-db-connection db-pool
+                               (data/store-data-samples (seq snapshot)))))
+                        "Store ingress queue contents")
+                       my-pool)
     (fn [ samples ]
       (log/info "Enqueuing " (count samples) " samples for later storage.")
       (doseq [ sample samples ]
-        (log/info "sample" sample)
         (.add sample-queue sample)))))

 (defmacro get-version []


Improve new project dialog

Improve new project dialog

--- src/net/sekao/nightcode/controller.clj
+++ src/net/sekao/nightcode/controller.clj
@@ -20,12 +20,12 @@
                   (.setTitle "New Project"))
         window (u/event->window event)]
     (when-let [file (.showSaveDialog chooser window)]
-      (let [dialog (doto (Alert. Alert$AlertType/NONE)
+      (let [dialog (doto (Alert. Alert$AlertType/INFORMATION)
                      (.setHeaderText "Creating project...")
                      (.setGraphic nil)
                      (.initOwner window)
                      (.initStyle StageStyle/UNDECORATED))]
-        (.add (.getButtonTypes dialog) ButtonType/CANCEL)
+        (-> dialog .getDialogPane (.lookupButton ButtonType/OK) (.setDisable true))
         (.show dialog)
         (future
           (b/new-project! file)


Added rm_case_rev_master -> ddl.clj

Added rm_case_rev_master -> ddl.clj

--- src/pg_demo/ddl.clj
+++ src/pg_demo/ddl.clj
@@ -1,8 +1,8 @@
 (ns pg-demo.ddl
-  (:require
+  (:require
             [clojure.string         :as str]
   )
-  (:use cooljure.core
+  (:use cooljure.core
         cooljure.misc)
   (:gen-class))

@@ -15,10 +15,10 @@
 ;   level       -> level_val
 ;***************************************************************************

-(def table-ddl
+(def table-ddl
   "A map from table-name (as keyword) to ddl (as map)"
   {
-    :rm_case_assess   ; key -> table-name
+    :rm_case_assess   ; key -> table-name
     { ; value -> table-ddl map

 ;     key -> column-name              value -> column-type
@@ -128,7 +128,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_classifications
     {
       :enterprise_id                  "numeric(38)"
@@ -142,7 +142,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_event
     {
       :enterprise_id                  "numeric(38)"
@@ -281,7 +281,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_event_assess
     {
       :enterprise_id                  "numeric(38)"
@@ -312,7 +312,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_followup
     {
       :enterprise_id                  "numeric(38)"
@@ -337,7 +337,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_master
     {
       :enterprise_id                  "numeric(38)"
@@ -444,7 +444,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_narrative
     {
       :enterprise_id                  "numeric(38)"
@@ -460,7 +460,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_pat_info
     {
       :enterprise_id                  "numeric(38)"
@@ -564,7 +564,7 @@
       :age_unit_id_at_vacc            "numeric(38)"
       :pat_age_at_vacc                "numeric(38)"
     }
-
+
     :rm_case_prod_drugs
     {
       :enterprise_id                  "numeric(38)"
@@ -663,7 +663,7 @@
       :effective_start_date           "date"
       :effective_end_date             "date"
     }
-
+
     :rm_case_product
     {
       :enterprise_id                  "numeric(38)"
@@ -780,7 +780,7 @@
       :vaers_block_id                 "numeric(38)"
       :prod_lic_id                    "numeric(38)"
     }
-
+
     :rm_case_reporters
     {
       :enterprise_id                  "numeric(38)"
@@ -835,7 +835,7 @@
       :notes_j                        "varchar(3900)"
       :institution_id                 "varchar(99)"
     }
-
+
     :rm_case_study
     {
       :enterprise_id                  "numeric(38)"
@@ -873,7 +873,7 @@
       :effective_end_date             "date"
       :cohort_id                      "numeric(38)"
     }
-
+
     :rm_lm_case_classification
     {
       :enterprise_id                  "numeric(38)"
@@ -885,7 +885,7 @@
       :deleted                        "date"
       :e2b_code                       "numeric(38)"
     }
-
+
     :rm_lm_causality
     {
       :enterprise_id                  "numeric(38)"
@@ -897,7 +897,7 @@
       :causality_j                    "varchar(99)"
       :deleted                        "date"
     }
-
+
     :rm_lm_countries
     {
       :enterprise_id                  "numeric(38)"
@@ -913,7 +913,7 @@
       :country_j                      "varchar(99)"
       :group_2_country                "numeric(38)"
     }
-
+
     :rm_lm_product
     {
       :enterprise_id                  "numeric(38)"
@@ -968,7 +968,7 @@
       :dev_intl_birth_date            "date"
       :comments_j                     "varchar(3900)"
     }
-
+
     :rm_lm_product_family
     {
       :enterprise_id                  "numeric(38)"
@@ -982,7 +982,7 @@
       :name_j                         "varchar(99)"
       :comments_j                     "varchar(3900)"
     }
-
+
     :rm_lm_report_type
     {
       :enterprise_id                  "numeric(38)"
@@ -999,7 +999,7 @@
       :deleted                        "date"
       :incl_research                  "numeric(38)"
     }
-
+
     :rm_meddra_smq_content
     {
       :global_dict_id                 "numeric(38)"
@@ -1013,7 +1013,7 @@
       :term_addition_version          "varchar(9)"
       :term_last_modified_version     "varchar(9)"
     }
-
+
     :rm_meddra_smq_list
     {
       :global_dict_id                 "numeric(38)"
@@ -1027,9 +1027,30 @@
       :status                         "varchar(9)"
       :smq_algorithm                  "varchar(999)"
     }
-
+
+    :rm_case_rev_master
+    {
+      enterprise_id                   "numeric(38)"
+      case_id                         "numeric(38)"
+      dlp_revision_number             "numeric(38)"
+      case_locked                     "numeric(38)"
+      data_cleanup                    "numeric(38)"
+      case_revision_date              "date"
+      date_locked                     "date"
+      site_id                         "numeric(38)"
+      state_id                        "numeric(38)"
+      country_id                      "numeric(38)"
+      effective_receipt_date          "date"
+      effective_receipt_date_j        "date"
+      effective_safety_date           "date"
+      effective_time_stamp            "date"
+      dcm_xref_num                    "numeric(38)"
+      revision_delete_flag            "numeric(38)"
+    }
+
     ; this is a "view" in ArgusMart
-    :case_version_table     ; no "rm_" prefix here!!!
+;   :case_version_table     ; no "rm_" prefix here!!!
+;   {}

   }
 )


first rule: dont write macro, second rule dont write multi arity macros

--- src/etcd_clojure/core.clj
+++ src/etcd_clojure/core.clj
@@ -19,6 +19,12 @@

 (defn- when-done [future-to-watch function-to-call]
   (future (function-to-call @future-to-watch)))
+
+(defmacro http-perform
+  ([body base]
+     `(parse-string (:body (~body (str ~base)))))
+  ([body base path]
+     `(parse-string (:body (~body (str ~base ~path))))))

 (defn connect!
   ([etcd-server-host] (connect! etcd-server-host 4001 7001))
@@ -72,7 +78,7 @@
   [key & {:keys [recursive]}]
   (let [url (str (base-url) "/keys/" key "?recursive=" recursive)]
     (map #(assoc {} :key (clojure.core/get % "key") :value (clojure.core/get % "value"))
-         (clojure.core/get-in (parse-string (:body (client/get url ))) ["node" "nodes"]))))
+         (clojure.core/get-in (http-perform client/get url) ["node" "nodes"]))))

 (defn list-in-order
   "Lists the content of a directory recursively and in order"
@@ -97,24 +103,24 @@
 (defn stats
   "Leader stats"
   []
-  (parse-string (:body (client/get (str (base-url) "/stats/leader")))))
+  (http-perform client/get (base-url) "/stats/leader"))

 (defn self-stats
   "Self Stats"
   []
-  (parse-string(:body (client/get (str (base-url) "/stats/self")))))
+  (http-perform client/get (base-url) "/stats/self"))

 (defn store-stats
   "Store stats"
   []
-  (parse-string (:body (client/get (str (base-url) "/stats/store")))))
+  (http-perform client/get (base-url) "/stats/store"))

 (defn machines
   "Machines"
   []
-  (parse-string (:body (client/get (str (admin-base-url) "/admin/machines")))))
+  (http-perform client/get (admin-base-url) "/admin/machines"))

 (defn config
   "Gets the config"
   []
-  (parse-string (:body (client/get (str (admin-base-url) "/admin/config")))))
+  (http-perform client/get (admin-base-url) "/admin/config"))


[scamp] Add real randomness in place of 0.4.

0.4 is not random. Or is it?

0.4 is predictable, that's for sure.

0.4 is also always < 0.5.

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -3,8 +3,14 @@
             [scamp.core :as core]
             [schema.core :as s]))

+(def random-instance (atom (java.util.Random.)))
+
+(defn reset-rand-state! [& seed]
+  (let [seed (or seed 43)]
+    (.setSeed @random-instance seed)))
+
 (defn- testing-rand*
-  ([] 0.4)
+  ([] (.nextFloat @random-instance))
   ([n] (* n (testing-rand*))))

 (defn- purge-envelope-id [envelope]


[scamp] add more tests, incl all 'receive-msg methods

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -23,6 +23,12 @@
   (core/reset-envelope-ids!)
   (reset-rand-state!)
   (f))
+
+(deftest maybe-conj-test
+  (is (= #{"susan" "howatch" "louis" "sachar"}
+         (core/maybe-conj #{"susan" "howatch" "louis"} "vinge" "sachar")))
+  (is (= #{"susan" "howatch" "louis" "sachar"}
+         (core/maybe-conj #{"susan" "howatch" "louis" "sachar"} "vinge" "vinge"))))

 (deftest subscribe-new-node-test
   (scamp-test
@@ -166,18 +172,71 @@

 (deftest receive-msg-new-upstream-node-test
   (scamp-test
-   #(is (= (core/receive-msg :new-upstream-node
-                             core/default-config
-                             {:self {:id "canticle"}
-                              :upstream #{}
-                              :downstream #{}
-                              :messages-seen {}}
-                             "liebowitz"
-                             "43")
-           [{:self {:id "canticle"},
-             :upstream #{"liebowitz"},
-             :downstream #{}
-             :messages-seen {}} []]))))
+   #(binding [scamp.core/*rand* testing-rand*]
+      (let [result (core/receive-msg :new-upstream-node
+                                     core/default-config
+                                     {:self {:id "Braedee"}
+                                      :upstream #{"Charon"}
+                                      :downstream #{"Elnear" "Luzali" "Cat"}
+                                      :messages-seen {}}
+                                     "Elnear"
+                                     "43")]
+        (is (= result
+               [{:self {:id "Braedee"},
+                 :upstream #{"Elnear" "Charon"},
+                 :downstream #{"Luzali" "Elnear" "Cat"},
+                 :messages-seen {}}
+                  []]))))))
+
+(deftest receive-msg-forwarded-subscription
+  (scamp-test
+   #(binding [scamp.core/*rand* testing-rand*]
+      (let [dup (core/receive-msg :forwarded-subscription
+                                  core/default-config
+                                  {:self {:id "Braedee"}
+                                   :upstream #{"Charon"}
+                                   :downstream #{"Elnear" "Luzali" "Cat"}
+                                   :messages-seen {}}
+                                  "Elnear"
+                                  "43")]
+        (is (= dup
+               [{:self {:id "Braedee"},
+                 :upstream #{"Charon"},
+                 :downstream #{"Luzali" "Elnear" "Cat"},
+                 :messages-seen {}}
+                [[:message-envelope "Luzali" :forwarded-subscription "Elnear" "43"]]])))
+
+      (let [keep (core/receive-msg :forwarded-subscription
+                                   core/default-config
+                                   {:self {:id "Braedee"}
+                                    :upstream #{"Charon"}
+                                    :downstream #{}
+                                    :messages-seen {}}
+                                   "Mikah"
+                                   "43")]
+        (is (= keep
+               [{:self {:id "Braedee"},
+                 :upstream #{"Charon"},
+                 :downstream #{"Mikah"},
+                 :messages-seen {}}
+                [[:message-envelope "Mikah" :new-upstream-node "Braedee" "1"]]])))
+
+      (let [fwd (core/receive-msg :forwarded-subscription
+                                  core/default-config
+                                  {:self {:id "Braedee"}
+                                   :upstream #{"Charon"}
+                                   :downstream #{"Daric" "Lazuli" "Argentyne" "Jiro" "Talitha"}
+                                   :messages-seen {}}
+                                  "Mikah"
+                                  "43")]
+        (is (= fwd
+               [{:self {:id "Braedee"},
+                 :upstream #{"Charon"},
+                 :downstream #{"Daric" "Jiro" "Argentyne" "Talitha" "Lazuli"},
+                 :messages-seen {}}
+                [[:message-envelope "Talitha" :forwarded-subscription "Mikah" "43"]]]))))))
+
+

 (deftest send-msg-new-upstream-node-test
   (scamp-test
@@ -238,6 +297,24 @@
                 [:message-envelope "node-id23" :node-removal "node-id19" "293"]]
                ))))))

+(deftest receive-msg-node-node-removal
+  (scamp-test
+   #(binding [scamp.core/*rand* testing-rand*]
+      (let [rem (core/receive-msg :node-removal
+                                  core/default-config
+                                  {:self {:id "Braedee"}
+                                   :upstream #{"Charon" "Centauri"}
+                                   :downstream #{"Daric" "Centauri"}
+                                   :messages-seen {}}
+                                  "Centauri"
+                                  "43")]
+        (is (= rem
+               [{:self {:id "Braedee"},
+                 :upstream #{"Charon"},
+                 :downstream #{"Daric"},
+                 :messages-seen {}}
+                []]))))))
+

 (comment


[scamp] add receive-msg-node-unsubscription-test

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -148,6 +148,32 @@
     world
     (recur (core/do-comm world) (dec n))))

+(deftest receive-msg-node-unsubscription-test
+  (scamp-test
+   (fn []
+     (binding [scamp.core/*rand* testing-rand*]
+       (let [world (-> (world-with-subs 24)
+                       core/do-all-comms
+                       (core/instruct-node-to-unsubscribe "node-id9")
+                       core/do-comm)]
+         (is (= (:message-envelopes world)
+                [[:message-envelope
+                  "node-id8"
+                  :node-replacement
+                  {:old "node-id9", :new "node-id10"}
+                  "154"]
+                 [:message-envelope
+                  "node-id10"
+                  :node-replacement
+                  {:old "node-id9", :new "node-id8"}
+                  "155"]
+                 [:message-envelope "node-id10" :node-removal "node-id9" "156"]
+                 [:message-envelope "node-id8" :node-removal "node-id9" "157"]
+                 [:message-envelope "node-id7" :node-removal "node-id9" "158"]
+                 [:message-envelope "node-id11" :node-removal "node-id9" "159"]
+                 [:message-envelope "node-id6" :node-removal "node-id9" "160"]])))))))
+
+

 (comment
   (binding [scamp.core/*rand* testing-rand*]


define class-properties in a single place

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -110,7 +110,9 @@
 ;; RUM specific code ===========================================================

 (let [get-k     "org.martinklepsch.derivatives/get"
-      release-k "org.martinklepsch.derivatives/release"]
+      release-k "org.martinklepsch.derivatives/release"
+      class-properties #?(:cljs {:childContextTypes {get-k     js/React.PropTypes.func
+                                                     release-k js/React.PropTypes.func}})]

   (defn rum-derivatives
     "Given the passed spec add get!/release! derivative functions to
@@ -118,8 +120,7 @@
     mixin."
     [spec]
     #?(:cljs
-       {:class-properties {:childContextTypes {get-k     js/React.PropTypes.func
-                                               release-k js/React.PropTypes.func}}
+       {:class-properties class-properties
         :child-context    (fn [_] (let [{:keys [release! get!]} (derivatives-pool spec)]
                                     {release-k release! get-k get!}))}))

@@ -127,8 +128,7 @@
     "Like rum-derivatives but get the spec from the arguments passed to the components (`:rum/args`) using `get-spec-fn`"
     [get-spec-fn]
     #?(:cljs
-       {:class-properties {:childContextTypes {get-k     js/React.PropTypes.func
-                                               release-k js/React.PropTypes.func}}
+       {:class-properties class-properties
         :init             (fn [s _] (assoc s ::spec (get-spec-fn (:rum/args s))))
         :child-context    (fn [s] (let [{:keys [release! get!]} (derivatives-pool (::spec s))]
                                     {release-k release! get-k get!}))}))
@@ -139,8 +139,7 @@
     [drv-k]
     #?(:cljs
        (let [token (rand-int 10000)] ; TODO think of something better here
-         {:class-properties {:contextTypes {get-k     js/React.PropTypes.func
-                                            release-k js/React.PropTypes.func}}
+         {:class-properties class-properties
           :will-mount    (fn [s]
                            (let [get-drv! (-> s :rum/react-component (gobj/get "context") (gobj/get get-k))]
                              (assert get-drv! "No get! derivative function found in component context")


Make mirror-camera available to scheduler

--- spectacles/src/spectacles/scheduler.clj
+++ spectacles/src/spectacles/scheduler.clj
@@ -68,6 +68,12 @@
                                :update spectacles.simple-camera/update
                                :draw   spectacles.simple-camera/draw
                                :name   "SimpleCam"
+                               :author "Aaron Arnett"}
+
+               :mirror-camera {:setup  spectacles.mirror-camera/setup
+                               :update spectacles.mirror-camera/update
+                               :draw   spectacles.mirror-camera/draw
+                               :name   "MirrorCam"
                                :author "Aaron Arnett"}})

 (def installations {:lifeinlights01 :logo-countdown       ;; Leeds north door
@@ -80,7 +86,7 @@
                     :lifeinlights08 :cyberspeed           ;; Kerr (A)
                     :lifeinlights09 :cyberspeed           ;; Kerr (B)
 ;;                    ;lifeinlights10 :                   ;; Unused
-:Spectre :simple-camera                    })
+:Spectre :mirror-camera                    })

 (defn select-sketch []
   (let [hostname (.getHostName (java.net.InetAddress/getLocalHost))]