feat(aoc): remove legacy require in day6

--- clojure/adventofcode/src/adventofcode/days/day6.clj
+++ clojure/adventofcode/src/adventofcode/days/day6.clj
@@ -1,6 +1,5 @@
 (ns adventofcode.days.day6
-  (:require [clojure.string :as str]
-            [clojure.java.io :as io]))
+  (:require [clojure.java.io :as io]))

 (defn input [path]
   (line-seq (io/reader path)))


Introduce a second stage queue to the agent to accomodate temporary loss of connectivity to the vault.

--- metlog-agent/src/metlog_agent/core.clj
+++ metlog-agent/src/metlog_agent/core.clj
@@ -52,12 +52,17 @@
       (.drainTo sensor-result-queue snapshot))
     (seq snapshot)))

+(def update-queue (java.util.concurrent.LinkedBlockingQueue.))
+
 (defn update-vault []
-  (log/debug "update-vault")
-  (let [url (config-property "vault.url" "http://localhost:8080/data")
-        data { :body (pr-str (take-result-queue-snapshot))}]
-    (log/info "Posting" data " to " url)
-    (client/post url data)))
+  (locking update-queue
+    (.addAll update-queue (take-result-queue-snapshot))
+    (let [url (config-property "vault.url" "http://localhost:8080/data")
+          data { :body (pr-str (seq update-queue))}]
+      (log/debug "Posting" data " to " url)
+      (let [ post-response (client/post url data) ]
+        (when (= (:status post-response) 200)
+          (.clear update-queue))))))

 (defn -main
   "I don't do a whole lot ... yet."


entered predicate understand-deeply-simply

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1056,13 +1056,13 @@
                           :sem {:pred :understand}}}

    "understand (deeply)" {:synsem {:cat :verb
-                            :sem {:pred :cenare}}
+                            :sem {:pred :understand-deeply}}
                    :english {:present {:3sing "understands (deeply)"}
                              :past "understood (deeply)"
                              :participle "understanding (deeply)"}}

 "understand (simply)" {:synsem {:cat :verb
-                            :sem {:pred :cenare}}
+                            :sem {:pred :understand-deeply}}
                    :english {:present {:3sing "understands (simply)"}
                              :past "understood (simply)"
                              :participle "understanding (simply)"}}


set {:reflexive false} as default for {:cat :verb}

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1,8 +1,12 @@
 (ns babel.english.lexicon
+  (:refer-clojure :exclude [get-in])
   (:require
-   [babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)]
+   [babel.lexiconfn :refer (compile-lex if-then
+                                        map-function-on-map-vals unify)]
    [babel.english.morphology :as morph]
-   [babel.english.pos :refer :all]))
+   [babel.english.pos :refer :all]
+   [dag-unify.core :refer [fail? get-in]]))
+

 (def lexicon-source
   {
@@ -1384,7 +1388,18 @@
                          intransitivize

                          ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
-                         transitivize)))
+                         transitivize
+
+                         ;; if a verb has an object,
+                         ;; and the object is not {:reflexive true}
+                         ;; then the object is {:reflexive false}
+
+                         (if-then {:synsem {:cat :verb
+                                            :subcat {:2 {:reflexive false}}}}
+                                  {:synsem {:subcat {:2 {:reflexive false}}}}))))
+
+
+


Use the common require-resolve, and give a more meaningful error if nrepl can't be found.

--- modules/core/src/main/clojure/immutant/repl.clj
+++ modules/core/src/main/clojure/immutant/repl.clj
@@ -44,8 +44,6 @@
   ([interface port]
      (let [{{:keys [nrepl-middleware nrepl-handler]} :repl-options}
          (registry/get :project)
-         require-resolve #(do (-> % namespace symbol require)
-                              (resolve %))
          interface-address (or (util/lookup-interface-address interface)
                                interface
                                (util/management-interface-address))]
@@ -58,15 +56,15 @@
            (when (and nrepl-middleware nrepl-handler)
              (throw (IllegalArgumentException.
                      "Can only use one of :nrepl-handler or :nrepl-middleware")))
-           (let [handler (or (and nrepl-handler (require-resolve nrepl-handler))
+           (let [handler (or (and nrepl-handler (util/require-resolve nrepl-handler))
                              (->> nrepl-middleware
                                   (map #(cond
                                          (var? %) %
-                                         (symbol? %) (require-resolve %)
+                                         (symbol? %) (util/require-resolve %)
                                          (list? %) (eval %)))
-                                  (apply (util/try-resolve
+                                  (apply (util/require-resolve
                                           'clojure.tools.nrepl.server/default-handler))))]
-             (when-let [server ((util/try-resolve 'clojure.tools.nrepl.server/start-server)
+             (when-let [server ((util/require-resolve 'clojure.tools.nrepl.server/start-server)
                                 :handler handler
                                 :port (fix-port port)
                                 :bind interface-address)]


Fix arguments to s3-host

Fix arguments to s3-host

--- src/braid/base/server/spa.clj
+++ src/braid/base/server/spa.clj
@@ -32,9 +32,7 @@
               :basejs (when prod-js?
                         (str (digest/from-file (str "public/js/prod/base.js"))))
               :api_domain (config :api-domain)
-              :asset_domain (s3/s3-host
-                              {:bucket (config :aws-bucket)
-                               :region (config :aws-region)})
+              :asset_domain (s3/s3-host config)
               :extra_scripts
               (->> @additional-scripts
                    (map (fn [s] (if (fn? s) (s) s)))


activity still color

activity still color

--- src/cljs/meins/electron/renderer/ui/locations_map.cljs
+++ src/cljs/meins/electron/renderer/ui/locations_map.cljs
@@ -141,7 +141,7 @@
     "running" "red"
     "in_vehicle" "blue"
     "on_bicycle" "orange"
-    "still" "#AAA"
+    "still" "turquoise"
     "deeppink"))

 (defn line-feature-mapper [line-data]


update clojars repo URL

update clojars repo URL

--- packages/shadow-cljs-jar/src/shadow/cljs/npm/deps.clj
+++ packages/shadow-cljs-jar/src/shadow/cljs/npm/deps.clj
@@ -45,7 +45,7 @@

   ;; FIXME: resolve conflicts?
   (let [repositories
-        (-> (merge aether/maven-central {"clojars" "https://clojars.org/repo"})
+        (-> (merge aether/maven-central {"clojars" "https://repo.clojars.org"})
             (merge (ensure-s3p-private-key-file (get-in config [:repositories])))
             (merge (ensure-s3p-private-key-file (get-in config [:maven :repositories])))
             (merge (ensure-s3p-private-key-file (get-in config [:user-config :maven :repositories]))))


[scamp] rewrite several tests to build expected values functionally

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -41,15 +41,15 @@
             [[:message-envelope "node-id0" :new-subscription "node-id1"]],
             :network
             {"node-id0"
-             {:self {:id "node-id0"},
-              :upstream #{},
-              :downstream #{},
-              :messages-seen {}},
+             (assoc (core/node-contact-address->node "node-id0")
+                    :upstream #{},
+                    :downstream #{},
+                    :messages-seen {}),
              "node-id1"
-             {:self {:id "node-id1"},
-              :upstream #{},
-              :downstream #{"node-id0"},
-              :messages-seen {}}}}))))
+             (assoc (core/node-contact-address->node "node-id1")
+                    :upstream #{},
+                    :downstream #{"node-id0"},
+                    :messages-seen {})}}))))

 (deftest forward-subscription-test
   (scamp-test
@@ -90,151 +90,134 @@
                {:message-envelopes [],
                 :network
                 {"node-id0"
-                 {:self {:id "node-id0"},
-                  :upstream #{"node-id1"},
-                  :downstream #{"node-id2" "node-id3"},
-                  :messages-seen {"1" 1, "3" 1, "4" 1, "5" 5, "9" 1}},
+                 (assoc (core/node-contact-address->node "node-id0")
+                        :upstream #{"node-id1"},
+                        :downstream #{"node-id2" "node-id3"},
+                        :messages-seen {"1" 1, "3" 1, "4" 1, "5" 5, "9" 1}),
                  "node-id1"
-                 {:self {:id "node-id1"},
-                  :upstream #{"node-id2"},
-                  :downstream #{"node-id2" "node-id3" "node-id0"},
-                  :messages-seen {"2" 1, "4" 1, "5" 9, "9" 2, "10" 1, "11" 5}},
+                 (assoc (core/node-contact-address->node "node-id1")
+                        :upstream #{"node-id2"},
+                        :downstream #{"node-id2" "node-id3" "node-id0"},
+                        :messages-seen {"2" 1, "4" 1, "5" 9, "9" 2, "10" 1, "11" 5}),
                  "node-id2"
-                 {:self {:id "node-id2"},
-                  :upstream #{"node-id3" "node-id0" "node-id1"},
-                  :downstream #{"node-id3" "node-id1"},
-                  :messages-seen
-                  {"6" 1, "4" 1, "5" 10, "7" 1, "8" 1, "9" 1, "11" 5}},
+                 (assoc (core/node-contact-address->node "node-id2")
+                        :upstream #{"node-id3" "node-id0" "node-id1"},
+                        :downstream #{"node-id3" "node-id1"},
+                        :messages-seen
+                        {"6" 1, "4" 1, "5" 10, "7" 1, "8" 1, "9" 1, "11" 5}),
                  "node-id3"
-                 {:self {:id "node-id3"},
-                  :upstream #{"node-id2" "node-id0" "node-id1"},
-                  :downstream #{"node-id2"},
-                  :messages-seen {"12" 1, "13" 1, "11" 3, "14" 1}}}}
+                 (assoc (core/node-contact-address->node "node-id3")
+                        :upstream #{"node-id2" "node-id0" "node-id1"},
+                        :downstream #{"node-id2"},
+                        :messages-seen {"12" 1, "13" 1, "11" 3, "14" 1})}}
                ))))))

 (deftest receive-msg-new-subscription-test
   (scamp-test
    #(binding [scamp.core/*rand* testing-rand*]
-      (is (= (core/receive-msg :new-subscription
-                               core/default-config
-                               {:self {:id "Auri"}
-                                :upstream #{"Kvothe" "Mandrag"}
-                                :downstream #{"Fulcrum" "Scaperling" "Foxen" "Underthing" "Mantle" "Withy" "Crumbledon" "Cricklet" "The Twelve"}
-                                :messages-seen {}}
-                               "Ninewise"
-                               "43")
-             [{:self {:id "Auri"},
-               :upstream #{"Mandrag" "Kvothe" "Ninewise"},
-               :downstream
-               #{"Fulcrum" "Crumbledon" "Mantle" "Cricklet" "Foxen" "The Twelve"
-                 "Underthing" "Withy" "Scaperling"},
-               :messages-seen {}}
-              [[:message-envelope "Foxen" :forwarded-subscription "Ninewise" "1"]
-               [:message-envelope
-                "The Twelve"
-                :forwarded-subscription
-                "Ninewise"
-                "2"]
-               [:message-envelope
-                "Cricklet"
-                :forwarded-subscription
-                "Ninewise"
-                "3"]
-               [:message-envelope
-                "Crumbledon"
-                :forwarded-subscription
-                "Ninewise"
-                "4"]
-               [:message-envelope "Foxen" :forwarded-subscription "Ninewise" "5"]
-               [:message-envelope "Fulcrum" :forwarded-subscription "Ninewise" "6"]
-               [:message-envelope "Mantle" :forwarded-subscription "Ninewise" "7"]
-               [:message-envelope
-                "Scaperling"
-                :forwarded-subscription
-                "Ninewise"
-                "8"]
-               [:message-envelope
-                "The Twelve"
-                :forwarded-subscription
-                "Ninewise"
-                "9"]
-               [:message-envelope
-                "Underthing"
-                :forwarded-subscription
-                "Ninewise"
-                "10"]
-               [:message-envelope
-                "Withy"
-                :forwarded-subscription
-                "Ninewise"
-                "11"]]]
-             )))))
+      (let [node-base (assoc (core/node-contact-address->node "Auri")
+                             :upstream #{"Kvothe" "Mandrag"}
+                             :downstream #{"Fulcrum" "Scaperling" "Foxen" "Underthing" "Mantle" "Withy" "Crumbledon" "Cricklet" "The Twelve"}
+                             :messages-seen {})]
+        (is (= (core/receive-msg :new-subscription
+                                 core/default-config
+                                 node-base
+                                 "Ninewise"
+                                 "43")
+               [(update node-base :upstream conj "Ninewise")
+                [[:message-envelope "Foxen" :forwarded-subscription "Ninewise" "1"]
+                 [:message-envelope
+                  "The Twelve"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "2"]
+                 [:message-envelope
+                  "Cricklet"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "3"]
+                 [:message-envelope
+                  "Crumbledon"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "4"]
+                 [:message-envelope "Foxen" :forwarded-subscription "Ninewise" "5"]
+                 [:message-envelope "Fulcrum" :forwarded-subscription "Ninewise" "6"]
+                 [:message-envelope "Mantle" :forwarded-subscription "Ninewise" "7"]
+                 [:message-envelope
+                  "Scaperling"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "8"]
+                 [:message-envelope
+                  "The Twelve"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "9"]
+                 [:message-envelope
+                  "Underthing"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "10"]
+                 [:message-envelope
+                  "Withy"
+                  :forwarded-subscription
+                  "Ninewise"
+                  "11"]]]
+               ))))))

 (deftest receive-msg-new-upstream-node-test
   (scamp-test
    #(binding [scamp.core/*rand* testing-rand*]
-      (let [result (core/receive-msg :new-upstream-node
+      (let [node-base (assoc (core/node-contact-address->node "Braedee")
+                             :upstream #{"Charon"}
+                             :downstream #{"Elnear" "Luzali" "Cat"}
+                             :messages-seen {})
+            result (core/receive-msg :new-upstream-node
                                      core/default-config
-                                     {:self {:id "Braedee"}
-                                      :upstream #{"Charon"}
-                                      :downstream #{"Elnear" "Luzali" "Cat"}
-                                      :messages-seen {}}
+                                     node-base
                                      "Elnear"
                                      "43")]
         (is (= result
-               [{:self {:id "Braedee"},
-                 :upstream #{"Elnear" "Charon"},
-                 :downstream #{"Luzali" "Elnear" "Cat"},
-                 :messages-seen {}}
-                  []]))))))
+               [(update node-base :upstream conj "Elnear")
+                []]))))))

 (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"]]]))))))
+      (let [node-base (assoc (core/node-contact-address->node "Braedee")
+                             :upstream #{"Charon"}
+                             :downstream #{"Elnear" "Luzali" "Cat"}
+                             :messages-seen {})]
+        (let [dup (core/receive-msg :forwarded-subscription
+                                    core/default-config
+                                    node-base
+                                    "Elnear"
+                                    "43")]
+          (is (= dup
+                 [node-base
+                  [[:message-envelope "Luzali" :forwarded-subscription "Elnear" "43"]]])))
+
+        (let [keep (core/receive-msg :forwarded-subscription
+                                     core/default-config
+                                     (assoc node-base :downstream #{})
+                                     "Mikah"
+                                     "43")]
+          (is (= keep
+                 [(assoc node-base :downstream #{"Mikah"})
+                  [[:message-envelope "Mikah" :new-upstream-node "Braedee" "1"]]])))
+
+        (let [new-node-base (assoc node-base
+                                   :downstream
+                                   #{"Daric" "Lazuli" "Argentyne" "Jiro" "Talitha"})
+              fwd (core/receive-msg :forwarded-subscription
+                                    core/default-config
+                                    new-node-base
+                                    "Mikah"
+                                    "43")]
+          (is (= fwd
+                 [new-node-base
+                  [[:message-envelope "Talitha" :forwarded-subscription "Mikah" "43"]]])))))))

 (deftest msg->envelope-test
   ;; Probably a worthless test, but does ensure that 'scamp-test
@@ -281,19 +264,19 @@
 (deftest receive-msg-node-node-removal
   (scamp-test
    #(binding [scamp.core/*rand* testing-rand*]
-      (let [rem (core/receive-msg :node-removal
+      (let [node-base (assoc (core/node-contact-address->node "Braedee")
+                             :upstream #{"Charon" "Centauri"}
+                             :downstream #{"Daric" "Centauri"}
+                             :messages-seen {})
+            rem (core/receive-msg :node-removal
                                   core/default-config
-                                  {:self {:id "Braedee"}
-                                   :upstream #{"Charon" "Centauri"}
-                                   :downstream #{"Daric" "Centauri"}
-                                   :messages-seen {}}
+                                  node-base
                                   "Centauri"
                                   "43")]
         (is (= rem
-               [{:self {:id "Braedee"},
-                 :upstream #{"Charon"},
-                 :downstream #{"Daric"},
-                 :messages-seen {}}
+               [(assoc node-base
+                       :upstream #{"Charon"}
+                       :downstream #{"Daric"})
                 []]))))))


Indicator :indicated_TTP allows multiple RelatedTTP

--- src/cia/schemas/indicator.clj
+++ src/cia/schemas/indicator.clj
@@ -66,7 +66,7 @@
     (s/optional-key :valid_time_position) ValidTime
     (s/optional-key :observable) c/Observable
     (s/optional-key :composite_indicator_expression) CompositeIndicatorExpression
-    (s/optional-key :indicated_TTP) rel/RelatedTTP
+    (s/optional-key :indicated_TTP) [rel/RelatedTTP]
     (s/optional-key :likely_impact) s/Str
     (s/optional-key :suggested_COAs) rel/RelatedCOAs
     (s/optional-key :confidence) v/HighMedLow


I think this might help fix the mongo exception's we're getting during signup - same as the fix for projects.

--- src/circle/workers/github.clj
+++ src/circle/workers/github.clj
@@ -91,7 +91,7 @@
         email (-> json :email)
         name (-> json :name)
         new-user (merge user {:fetched_name name :fetched_email email})]
-    (mongo/update! :users user new-user)))
+    (mongo/update! :users (select-keys user [:_id]) new-user)))

 (defn add-deploy-key
   "Given a username/repo pair, like 'arohner/CircleCI', generate and install a deploy key"


Adding an optimization for DL exploration

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

--- src/conexp/contrib/dl/languages/EL_gfp_exploration.clj
+++ src/conexp/contrib/dl/languages/EL_gfp_exploration.clj
@@ -81,22 +81,26 @@

                    P-map        (assoc P-map
                                   P_k [all-P_k all-P_k-closure]),
-                   next-Pi_k    (conj Pi_k P_k)
-
-		   implications (if (empty? new-concepts)
-                                  (let [new-impl (make-implication
-                                                  P_k
-                                                  (set-of D | D (seq M_k)
-                                                              :when (subsumed-by? all-P_k-closure D)))]
-                                    (if (not-empty (conclusion new-impl))
-                                      (conj implications new-impl)
-                                      implications))
-                                  (set-of impl | [P [_ all-P-closure]] P-map
-                                                 :let [impl (make-implication
-                                                             P
-                                                             (set-of D | D (seq next-M_k)
-                                                                         :when (subsumed-by? all-P-closure D)))]
-                                                 :when (not-empty (conclusion impl)))),
+                   next-Pi_k    (conj Pi_k P_k),
+
+		   implications (let [new-impl (make-implication P_k
+                                                                 (set-of D | D (seq M_k)
+                                                                             :when (subsumed-by? all-P_k-closure D))),
+                                      impls    (if (empty? new-concepts)
+                                                 implications
+                                                 (set-of impl | old-impl implications
+                                                                :let [P (premise old-impl),
+                                                                      Q (conclusion old-impl),
+                                                                      P-closure (second (get P-map P)),
+                                                                      impl (make-implication
+                                                                            P
+                                                                            (into Q
+                                                                                (set-of D | D new-concepts
+                                                                                :when (subsumed-by? P-closure D))))]
+                                                                :when (not-empty (conclusion impl))))]
+                                  (if (not-empty (conclusion new-impl))
+                                    (conj impls new-impl)
+                                    impls))
 		   background-knowledge
                                 (minimal-implication-set next-M_k),


Clear loaded-libs when a new browser connection is established.

--- src/clj/cljs/repl/browser.clj
+++ src/clj/cljs/repl/browser.clj
@@ -26,6 +26,8 @@
                              :promised-conn nil
                              :return-value-fn nil
                              :client-js nil}))
+
+(def loaded-libs (atom #{}))

 (defn- connection
   "Promise to return a connection when one is available. If a
@@ -98,9 +100,11 @@
   "Given a form and a return value function, send the form to the
   browser for evaluation. The return value function will be called
   when the return value is received."
-  [form return-value-fn]
-  (do (set-return-value-fn return-value-fn)
-      (send-and-close @(connection) 200 form "text/javascript")))
+  ([form return-value-fn]
+     (send-for-eval @(connection) form return-value-fn))
+  ([conn form return-value-fn]
+     (do (set-return-value-fn return-value-fn)
+         (send-and-close conn 200 form "text/javascript"))))

 (defn- return-value
   "Called by the server when a return value is received."
@@ -189,9 +193,13 @@
     (if-let [request (read-request rdr)]
       (case (:method request)
         :get (handle-get opts conn request)
-        :post (do (when-not (= (:content request) "ready")
-                    (return-value (:content request)))
-                  (set-connection conn))
+        :post (if (= (:content request) "ready")
+                (do (reset! loaded-libs #{})
+                    (send-for-eval conn
+                                   "goog.provide('cljs.user');"
+                                   identity))
+                (do (return-value (:content request))
+                    (set-connection conn)))
         (.close conn))
       (.close conn))))

@@ -231,8 +239,6 @@
              {:status :error
               :value (str "Could not read return value: " ret)})))))

-(def loaded-libs (atom #{}))
-
 (defn- object-query-str
   "Given a list of goog namespaces, create a JavaScript string which, when evaluated,
   will return true if all of the namespaces exist and false if any do not exist."
@@ -253,8 +259,7 @@
 (extend-protocol repl/IJavaScriptEnv
   clojure.lang.IPersistentMap
   (-setup [this]
-    (do (comp/with-core-cljs (start-server this))
-        (browser-eval "goog.provide('cljs.user');")))
+    (comp/with-core-cljs (start-server this)))
   (-evaluate [_ _ js] (browser-eval js))
   (-load [this ns url] (load-javascript this ns url))
   (-put [_ _ _] nil)


Fix for badges page not loading when user has no badges

--- src/clj/salava/badge/main.clj
+++ src/clj/salava/badge/main.clj
@@ -104,8 +104,7 @@
                     (select-user-badges-all {:user_id user-id} (u/get-db ctx)))
         tags (if-not (empty? badges) (select-taglist {:user_badge_ids (map :id badges)} (u/get-db ctx)))
         badges-with-tags (map-badges-tags badges tags)
-        badges-with-notifications (map-badges-notifications ctx user-id badges-with-tags)]
-
+        badges-with-notifications (when (seq badges)(map-badges-notifications ctx user-id badges-with-tags))]
     (map #(badge-issued-and-verified-by-obf ctx %) badges-with-notifications)))

 (defn user-badges-to-export


[n.activity] Wrap all methods in safe-for-ui

--- src/clojure/neko/activity.clj
+++ src/clojure/neko/activity.clj
@@ -140,7 +140,7 @@
              `(defn ~(symbol (str prefix mname))
                 [~(vary-meta (first args) assoc :tag name)
                  ~@(rest args)]
-                ~@body))))))
+                (safe-for-ui ~@body)))))))

 (defn get-state [^ActivityWithState activity]
   (.getState activity))


Updated pipeline options to support livescript

--- src/clojure/staircase/app.clj
+++ src/clojure/staircase/app.clj
@@ -25,7 +25,8 @@
                                              :engine :v8
                                              :as-resource "tools"
                                              :coffee "src/coffee"
-                                             :less "src/less")
+                                             :ls     "src/ls"
+                                             :less   "src/less")
             :config (app-options options)
             :secrets (secrets)
             :session-store (sessions/new-pg-session-store)


CMR-677: Return errors in the xml format for requests with accept headers indicating xml; otherwise use JSON format.

--- src/cmr/common/api/errors.clj
+++ src/cmr/common/api/errors.clj
@@ -1,5 +1,6 @@
 (ns cmr.common.api.errors
-  (:require [cmr.common.log :refer [error]]))
+  (:require [cmr.common.log :refer [error]]
+            [clojure.data.xml :as x]))

 (def type->http-status-code
   {:not-found 404
@@ -11,6 +12,18 @@
 (def internal-error-ring-response
   {:status 500 :body {:errors ["An Internal Error has occurred."]} :content-type :json})

+(defn- response-type-body
+  "Returns the response content-type and body for the given errors and format"
+  [errors xml-format?]
+  (let [content-type (if xml-format? "application/xml" "application/json")
+        body (if xml-format?
+               (x/indent-str
+                 (x/element :errors {}
+                            (for [err errors]
+                              (x/element :error {} err))))
+               {:errors errors})]
+    [content-type body]))
+
 (defn exception-handler
   "A ring exception handler that will handle errors thrown by the cmr.common.services.errors
   functions."
@@ -20,11 +33,14 @@
       (catch clojure.lang.ExceptionInfo e
         (let [data (ex-data e)]
           (if (:type data)
-            (let [{:keys [type errors]} data
-                  status-code (type->http-status-code type)]
+            (let [accept-format (get-in request [:headers "accept"])
+                  xml-format? (when accept-format (re-find #"xml" accept-format))
+                  {:keys [type errors]} data
+                  status-code (type->http-status-code type)
+                  [content-type response-body] (response-type-body errors xml-format?)]
               {:status status-code
-               :headers {"Content-Type" "application/json"}
-               :body {:errors errors}})
+               :headers {"Content-Type" content-type}
+               :body response-body})
             (do
               (error e)
               internal-error-ring-response))))


reset 'latitude' column to its proper state.

--- test/metabase/api/meta/field_test.clj
+++ test/metabase/api/meta/field_test.clj
@@ -55,11 +55,12 @@

 ;; ## PUT /api/meta/field/:id
 ;; Check that we can update a Field
+;; TODO - this should NOT be modifying a field from our test data, we should create new data to mess with
 (expect-eval-actual-first
     (match-$ (sel :one Field :id (field->id :venues :latitude))
       {:description nil
        :table_id (table->id :venues)
-       :special_type "latitude"
+       :special_type "fk"
        :name "LATITUDE"
        :updated_at $
        :active true
@@ -69,8 +70,8 @@
        :preview_display true
        :created_at $
        :base_type "FloatField"})
-  (let [result ((user->client :rasta) :put 200 (format "meta/field/%d" (field->id :venues :latitude)) {:special_type :latitude})]
+  (let [result ((user->client :rasta) :put 200 (format "meta/field/%d" (field->id :venues :latitude)) {:special_type "fk"})]
     ;; this is sketchy. But return the Field back to its unmodified state so it won't affect other unit tests
-    (upd Field (field->id :venues :latitude) :special_type nil)
+    (upd Field (field->id :venues :latitude) :special_type "latitude")
     ;; return the modified Field
     result))


Update label-codec tests.

Update label-codec tests.

--- test/multicodec/codecs/label_test.clj
+++ test/multicodec/codecs/label_test.clj
@@ -10,29 +10,14 @@
       ByteArrayOutputStream)))

-#_
-(deftest header-codec
-  (let [foo (mock-codec :foo "/foo")
-        wrapped (wrap/wrap-header foo)]
-    (testing "codec construction"
-      (is (= "/foo" (:header wrapped))
-          "header should inherit wrapped codec by default")
-      (let [wrapped (wrap/wrap-header foo "/bar")]
-        (is (= "/bar" (:header wrapped))
-            "header should be settable with second arg")))
-    (testing "predicates"
-      (is (codec/encodable? wrapped nil)
-          "predicate should pass through")
-      (is (codec/decodable? wrapped (:header foo))
-          "wrapped codec header should be decodable"))
-    (testing "encoding roundtrip"
-      (let [encoded (codec/encode wrapped 1234)]
-        (is (= "/foo" (header/read-header! (ByteArrayInputStream. encoded)))
-            "should write codec header to content")
-        (is (= [:foo "1234"] (codec/decode wrapped encoded))
-            "should read header and delegate to codec")))
-    (testing "bad header"
-      (let [baos (ByteArrayOutputStream.)]
-        (codec/encode-with-header! foo baos "/bar" :abc)
-        (is (thrown? RuntimeException
-                     (codec/decode wrapped (.toByteArray baos))))))))
+(deftest label-codec
+  (let [codec (label/label-codec "/foo/")
+        baos (ByteArrayOutputStream.)]
+    (is (not (codec/processable? codec "/bin/")))
+    (is (codec/processable? codec "/foo/"))
+    (is (= :stream (codec/decode-stream codec nil :stream))
+        "labels have no effect on decoding stream")
+    (is (= baos (codec/encode-stream codec nil baos)))
+    (let [output-bytes (.toByteArray baos)
+          input (ByteArrayInputStream. output-bytes)]
+      (is (= "/foo/" (header/read! input))))))


Load user.clj if present on classpath

Load user.clj if present on classpath

--- server/src/main/clojure/vimclojure/core.clj
+++ server/src/main/clojure/vimclojure/core.clj
@@ -24,9 +24,11 @@

 (defn init-server
   []
-  ; Check for doc macro. 1.2 in c.core, 1.3 in c.repl
-  (when-not (ns-resolve 'clojure.core 'doc)
-    (binding [*ns* *ns*]
-      (in-ns 'user)
-      (refer-clojure)
-      (use 'clojure.repl))))
+  (binding [*ns* *ns*]
+    (in-ns 'user)
+    (refer-clojure)
+    ; Check for doc macro. 1.2 in c.core, 1.3 in c.repl
+    (when-not (ns-resolve 'clojure.core 'doc)
+      (use 'clojure.repl))
+    (when (io/resource "user.clj")
+      (load "user"))))


Fix this dumbass typo

Fix this dumbass typo

--- fulcro-todo/src/main/app/ui.cljs
+++ fulcro-todo/src/main/app/ui.cljs
@@ -79,7 +79,7 @@
                                                                            :text "world"})]})
   Object
   (render [this]
-          (let [{:keys [item-list/items]} (om/props his)]
+          (let [{:keys [item-list/items]} (om/props this)]
             (if (empty? items)
               (dom/div
                #js {:className "item-list"}


removed useless map

removed useless map

--- src/corpus_utils/document.clj
+++ src/corpus_utils/document.clj
@@ -24,7 +24,6 @@
 (def MetadataSchema
   "Schema of a document's possible metadata"
   (merge BCCWJAnnotationSchema
-         {}
          {:title     s/Str
           :author    s/Str
           (s/optional-key :gender) (s/enum :male :female :mixed)


Declare more config files

Declare more config files

--- tasks/leiningen/fatdeb.clj
+++ tasks/leiningen/fatdeb.clj
@@ -80,7 +80,9 @@
     (.mkdirs (file dir "DEBIAN"))
     (write (file dir "DEBIAN" "control") (control project))
     (write (file dir "DEBIAN" "conffiles")
-           (join "\n" ["/etc/cyanite.yaml"]))
+           (join "\n" ["/etc/cyanite.yaml"
+                       "/etc/init.d/cyanite.yaml"
+                       "/etc/default/cyanite"]))

     ; Preinst
     (copy (file (:root project) "pkg" "deb" "preinst.sh")


RR: assoc-in :selected instead of replacing :views

--- src/hatti/views/dataview.cljs
+++ src/hatti/views/dataview.cljs
@@ -111,7 +111,7 @@
        shared/app-state
        (fn [app-state]
          (-> app-state
-             (assoc-in [:views] {:selected view})
+             (assoc-in [:views: :selected] view)
              (assoc-in [:views :settings] {:active-tab settings-section})
              (assoc-in [:views :settings :integrated-apps]
                        {:active-section app-type}))))


more efficient recv queue

more efficient recv queue

--- src-cljs/frontend/talaria.cljs
+++ src-cljs/frontend/talaria.cljs
@@ -128,18 +128,16 @@

 (defn consume-recv-queue [tal-state handler]
   (let [recv-queue (:recv-queue @tal-state)]
-    (loop [msg (pop-atom recv-queue)]
-      (when msg
-        (cond
-          (keyword-identical? :tal/reply (:op msg))
-          (run-callback tal-state (:tal/cb-uuid msg) (:data msg))
-
-          (keyword-identical? :tal/close (:op msg))
-          (close-connection tal-state)
-
-          :else
-          (handler msg))
-        (recur (pop-atom recv-queue))))))
+    (doseq [msg (pop-all recv-queue)]
+      (cond
+        (keyword-identical? :tal/reply (:op msg))
+        (run-callback tal-state (:tal/cb-uuid msg) (:data msg))
+
+        (keyword-identical? :tal/close (:op msg))
+        (close-connection tal-state)
+
+        :else
+        (handler msg)))))

 (defn start-recv-queue [tal-state handler]
   (let [recv-queue (:recv-queue @tal-state)]


Show now-playing track

Show now-playing track

--- src/airhead_cljs/core.cljs
+++ src/airhead_cljs/core.cljs
@@ -22,7 +22,7 @@

 (defn playlist-get []
   (GET "/api/playlist"
-       {:handler #(swap! state assoc :playlist (% "next"))
+       {:handler #(swap! state assoc :playlist %)
         :response-format :json}))

 (defn playlist-add [id]
@@ -98,7 +98,9 @@
 (defn playlist-component []
   [:div.library
    [:h2 "Playlist"]
-   [:ul (for [uuid (@state :playlist)]
+   [:div.now-playing "Now playing: "
+    [track-component (get-in @state [:playlist "current"])]]
+   [:ul.next (for [uuid (get-in @state [:playlist "next"])]
           [:li
            [playlist-remove-component uuid]
            [track-component uuid]])]])


Minor changes.

Minor changes.

--- profiles.clj
+++ profiles.clj
@@ -3,17 +3,15 @@
   :aliases {"test-all" ["with-profile" "dev,1.8:dev" "test"]}
   :source-paths ["dev"]
   :dependencies [[clj-http "1.1.2" :exclusions [org.clojure/tools.reader]]
-                 [org.clojure/clojurescript "1.7.189"]
+                 [org.clojure/clojurescript "1.7.189" :exclusions [org.clojure/tools.reader]]
                  [aleph "0.4.0" :exclusions [io.netty/netty-all]]
                  [org.clojure/tools.namespace "0.2.11"]
                  [ring/ring-core "1.4.0" :exclusions [javax.servlet/servlet-api
                                                       org.clojure/tools.reader
                                                       org.clojure/clojure
                                                       clj-time]]]
-  :plugins [[lein-ancient "0.6.7" :exclusions [org.clojure/tools.reader]]]}
-
- :doc
- {:plugins [[funcool/codeina "0.3.0"]]
+  :plugins [[lein-ancient "0.6.7" :exclusions [org.clojure/tools.reader]]
+            [funcool/codeina "0.3.0"]]
   :codeina {:sources ["src/clojure"]
             :exclude [catacumba.impl.context
                       catacumba.impl.atomic
@@ -50,7 +48,7 @@
                         "-Xms4g"]
    :main ^:skip-aot bench}]

- :1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC1"]]}
+ :1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC3"]]}

  ;; Examples
  :examples


Some renaming, and two new callbacks, :operation-decorator and :response-decorator

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -236,7 +236,6 @@

   nil or s/Any returns nil.

-
   Typically, the result of this is wrapped inside map with key :schema."
   [swagger-options swagger-object schema]
   (cond-let
@@ -295,6 +294,7 @@
   "Uses the :responses metadata to identify possible responses."
   [swagger-options swagger-object routing-entry paths-key]
   (let [responses (-> routing-entry :meta :responses)
+        decorator (:response-decorator swagger-options)
         reducer   (fn [so [status-code schema]]
                     (t/track
                       #(format "Describing %d response." status-code)
@@ -304,39 +304,47 @@
                                             ;; description is required in the Response Object, so we need some default here.
                                             "Documentation not provided.")
                             [so' schema-reference] (->swagger-schema swagger-options so schema)
-                            response    (remove-nil-vals {:description description
-                                                          :schema      schema-reference})]
+                            response    (->> {:description description
+                                              :schema      schema-reference}
+                                             remove-nil-vals
+                                             (decorator swagger-options so routing-entry status-code schema))]
                         (assoc-in so' (concat paths-key [:responses status-code]) response))))]
     (reduce reducer swagger-object responses)))

-(defn default-path-item-object-injector
-  "Injects a PathItemObject based on a routing entry.
+(defn default-operation-decorator
+  "Decorates a PathItemObject (which describes a single Rook endpoint) just before it is added to the Swagger object.
+  This implementation returns it unchanged."
+  [swagger-options swagger-object routing-entry path-item-object]
+  path-item-object)
+
+(defn default-operation-injector
+  "Injects an Object object based on a single routing entry.

   The paths-key is a coordinate into the swagger-object where the PathItemObject should be created.

   Returns the modified swagger-object."
   [swagger-options swagger-object routing-entry paths-key]
   (let [{endpoint-meta :meta} routing-entry
-        swagger-meta          (:swagger endpoint-meta)
-        description           (or (:description swagger-meta)
-                                  (:doc endpoint-meta))
-        summary               (:summary swagger-meta)
-        path-params-injector  (:path-params-injector swagger-options)
-        query-params-injector (:query-params-injector swagger-options)
-        body-params-injector  (:body-params-injector swagger-options)
-        responses-injector    (:responses-injector swagger-options)
-        params-key            (concat paths-key ["parameters"])]
+        swagger-meta (:swagger endpoint-meta)
+        description  (or (:description swagger-meta)
+                         (:doc endpoint-meta))
+        summary      (:summary swagger-meta)
+        {:keys [path-params-injector query-params-injector body-params-injector responses-injector
+                operation-decorator]} swagger-options
+        params-key   (concat paths-key ["parameters"])]
     (as-> swagger-object %
           (assoc-in % paths-key
-                    (remove-nil-vals {:description     description
-                                      :summary         summary
+                    (remove-nil-vals {:description description
+                                      :summary     summary
                                       ;; This is required inside a Operation object:
-                                      :responses       (sorted-map)
-                                      :x-rook-endpoint (:function endpoint-meta)}))
+                                      :responses   (sorted-map)
+                                      :operationId (:function endpoint-meta)}))
           (path-params-injector swagger-options % routing-entry params-key)
           (query-params-injector swagger-options % routing-entry params-key)
           (body-params-injector swagger-options % routing-entry params-key)
-          (responses-injector swagger-options % routing-entry paths-key))))
+          (responses-injector swagger-options % routing-entry paths-key)
+          (update-in % paths-key (fn [operation]
+                                   (operation-decorator swagger-options % routing-entry operation))))))

 (defn default-route-injector
   "The default route converter.  The swagger-options may contain an override of this function.
@@ -366,15 +374,15 @@
     #(format "Describing endpoint %s `/%s'."
              (-> routing-entry :method name .toUpperCase)
              (->> routing-entry :path (str/join "/")))
-    (let [path-str        (-> routing-entry :path path->str)
+    (let [path-str           (-> routing-entry :path path->str)
           ;; Ignoring :all for the moment.
-          method-str      (-> routing-entry :method name)
-          pio-constructor (:path-item-object-injector swagger-options)]
+          method-str         (-> routing-entry :method name)
+          operation-injector (:operation-injector swagger-options)]
       ;; Invoke the constructor for the path info. It may need to make changes to the :definitions, so we have
       ;; to let it modify the entire Swagger object ... but we help it out by providing the path
       ;; to where the PathInfoObject (which describes what Rook calls a "route").
-      (pio-constructor swagger-options swagger-object routing-entry
-                       [:paths path-str method-str]))))
+      (operation-injector swagger-options swagger-object routing-entry
+                          [:paths path-str method-str]))))

 (defn- routing-entry->map
   [[method path _ endpoint-meta]]
@@ -390,10 +398,15 @@
       (assoc routing-entry :method m))))

 (defn default-configurer
-  "The configurer is passed the final swagger object and can make final changes to it. This implementation
-  does nothing, returning the swagger object unchanged."
+  "The configurer is passed the swagger options, the final Swagger object, and the seq of routing entries,
+   and can make final changes to it. This implementation does nothing, returning the Swagger object unchanged."
   [swagger-options swagger-object routing-entries]
   swagger-object)
+
+(defn default-response-decorator
+  "A callback to decorate a specific response object just before it is stored into the swagger-object."
+  [swagger-options swagger-object routing-entry status-code response-schema response-object]
+  response-object)

 (def default-data-type-mappings
   {s/Int     {:type :integer}
@@ -417,11 +430,13 @@
    :route-injector                 default-route-injector
    :configurer                     default-configurer
    :data-type-mappings             default-data-type-mappings
-   :path-item-object-injector      default-path-item-object-injector
+   :operation-injector             default-operation-injector
+   :operation-decorator            default-operation-decorator
    :path-params-injector           default-path-params-injector
    :query-params-injector          default-query-params-injector
    :body-params-injector           default-body-params-injector
-   :responses-injector             default-responses-injector})
+   :responses-injector             default-responses-injector
+   :response-decorator             default-response-decorator})

 (defn construct-swagger-object
   "Constructs the root Swagger object from the Rook options, swagger options, and the routing table


make messaging more clear when swank is unavailable

--- src/cake/tasks/swank.clj
+++ src/cake/tasks/swank.clj
@@ -26,7 +26,7 @@
   (bake (:require [cake.swank :as swank])
         [opts (swank-opts project opts)]
         (if (not (swank/installed?))
-          (do (println "swank-clojure not installed.")
+          (do (println "swank-clojure is not in your library path.")
               (println "add swank-clojure as a dependency in project.clj or touch .cake/swank to enable"))
           (if (swank/running?)
             (let [num (swank/num-connections), s (if (= 1 num) "" "s")]


What idiot committed this? Oh, wait.

What idiot committed this? Oh, wait.

--- modules/messaging/src/main/clojure/immutant/messaging.clj
+++ modules/messaging/src/main/clojure/immutant/messaging.clj
@@ -175,16 +175,6 @@
           (.close connection)
           (throw e))))))

-(defn pipeline [opts-or-fn & fns]
-  (let [[opts fns] (if (fn? opts-or-fn)
-                     [opts-or-fn fns]
-                     [nil (cons opts-or-fn fns)])
-        queue-name (str "queue.pipeline-" (java.util.UUID/randomUUID))]
-    (start queue-name)
-
-
-    ))
-
 (defn request
   "Send a message to queue and return a delay that will retrieve the response.
    Implements the request-response pattern, and is used in conjunction
@@ -211,11 +201,11 @@
    same options as listen."
   [queue f & {:keys [decode?] :or {decode? true} :as opts}]
   {:pre [(queue? queue)]}
-  (letfn [(respond* [^javax.jms.Message msg]
-            (publish (.getJMSDestination msg)
-                     (f (codecs/decode-if decode? msg))
-                     :correlation-id (.getJMSMessageID msg)
-                     :encoding (codecs/get-encoding msg)))]
+  (let-fn [(respond* [^javax.jms.Message msg]
+                     (publish (.getJMSDestination msg)
+                              (f (codecs/decode-if decode? msg))
+                              :correlation-id (.getJMSMessageID msg)
+                              :encoding (codecs/get-encoding msg)))]
     (mapply listen queue respond*
             (assoc (update-in opts [:selector]
                               #(str "synchronous = 'true'"


Minor formatting tweaks

Minor formatting tweaks

--- src/leiningen/amp/package.clj
+++ src/leiningen/amp/package.clj
@@ -176,11 +176,11 @@

         ; Target paths (where the AMP gets constructed)
         target                 (io/file (:target-path project))
-        tgt-amp                (io/file target              "amp")
-        tgt-module-properties  (io/file tgt-amp             "module.properties")
-        tgt-file-mapping       (io/file tgt-amp             "file-mapping.properties")
-
-        tgt-lib                (io/file tgt-amp             "lib")
+        tgt-amp                (io/file target  "amp")
+        tgt-module-properties  (io/file tgt-amp "module.properties")
+        tgt-file-mapping       (io/file tgt-amp "file-mapping.properties")
+
+        tgt-lib                (io/file tgt-amp "lib")

         ; Output AMP file
         tgt-amp-file           (target-file project target)]


Use a relative path for the source map URL.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -934,9 +934,9 @@
    (str ";(function(){\n" js "\n})();\n")
    js))

-(defn add-source-map-link [{:keys [source-map] :as opts} js]
+(defn add-source-map-link [{:keys [source-map output-to] :as opts} js]
   (if source-map
-    (str js "\n//@ sourceMappingURL=" source-map)
+    (str js "\n//@ sourceMappingURL=" (path-relative-to (io/file output-to) {:url source-map}))
     js))

 (defn build


CLJS-788: spurious warnings about goog namespaces

Earliers version of the third party lib included populated
goog/deps.js. Add a simple hack to make sure we are considering the
canonical goog/deps.js file.

--- src/clj/cljs/js_deps.clj
+++ src/clj/cljs/js_deps.clj
@@ -201,7 +201,10 @@
   (letfn [(parse-list [s] (when (> (count s) 0)
                             (-> (.substring ^String s 1 (dec (count s)))
                                 (string/split #"'\s*,\s*'"))))]
-    (with-open [reader (io/reader (io/resource "goog/deps.js"))]
+    (with-open [reader (io/reader
+                         (first
+                           (filter (fn [res] (re-find #"\/google-closure-library\/" (.getPath res)))
+                             (enumeration-seq (.getResources (ClassLoader/getSystemClassLoader) "goog/deps.js")))))]
       (->> (line-seq reader)
            (map #(re-matches #"^goog\.addDependency\(['\"](.*)['\"],\s*\[(.*)\],\s*\[(.*)\]\);.*" %))
            (remove nil?)


Remove some local testing logs and add a debug log

--- src/clj/runbld/store.clj
+++ src/clj/runbld/store.clj
@@ -6,7 +6,7 @@
             [elasticsearch.connection.http :as http]
             [elasticsearch.document :as doc]
             [elasticsearch.indices :as indices]
-            [robert.bruce :refer [try-try-again]]
+            [robert.bruce :refer [*try* try-try-again]]
             [runbld.io :as io]
             [runbld.schema :refer :all]
             [runbld.util.date :as date]
@@ -205,29 +205,33 @@
    (when (seq docs)
      (let [make (fn [doc]
                   {:index {:source doc}})
-           actions (atom (doall (map make docs)))]
+           actions (atom (doall (map make docs)))
+           tries 10]
        ;; Special case of try-try-again b/c we want some decay to
        ;; give ES time to recover
        (try-try-again
-        {:tries 10
+        {:tries tries
          :sleep 1000
          :decay :golden-ratio
          :error-hook
          (fn [ex]
-           (io/log "error!")
            (when-let [data (ex-data ex)]
              (when (= :elasticsearch.document/bulk-error (:type data))
                ;; Filter out successful actions
                (reset! actions
                        (->> (:items data)
                             (filter #(= 429 (:status %)))
-                            (map :original-item))))))}
-        #(do
-           (io/log :count (count @actions))
-           (io/log :after (count (:items (doc/bulk (:conn opts)
-                                                   (opts :log-index-write)
-                                                   (name DocType)
-                                                   {:body @actions}))))))))))
+                            (map :original-item)))
+               (debug/log "There was an error during bulk, retrying"
+                          (count @actions) "items."
+                          (- tries *try*) "tries remain.")
+               ;; explicit return of nil so that try-try-again retries
+               ;; happen as configured
+               nil)))}
+        #(doc/bulk (:conn opts)
+                   (opts :log-index-write)
+                   (name DocType)
+                   {:body @actions}))))))

 (s/defn after-log
   ([opts :- OptsElasticsearch]


Add Level Schema to Alert

Add Level Schema to Alert

--- src/cljs/lens/alert.cljs
+++ src/cljs/lens/alert.cljs
@@ -4,9 +4,16 @@
   (:require [om.core :as om]
             [om-tools.core :refer-macros [defcomponent]]
             [om-tools.dom :as d :include-macros true]
-            [lens.event-bus :as bus]))
+            [lens.event-bus :as bus]
+            [schema.core :as s :include-macros true]))

-(defn alert! [owner level msg]
+(def Level
+  "Alert level as available in Bootstrap."
+  (s/enum :success :info :warning :danger))
+
+(s/defn alert!
+  "Show an alert banner with level and message."
+  [owner level :- Level msg]
   (bus/publish! owner ::open {:level level :msg msg}))

 (defn internal-error! [owner n]


Remove last note if blank

Remove last note if blank

--- src/cljs/notes/core.cljs
+++ src/cljs/notes/core.cljs
@@ -1,4 +1,3 @@
-; TODO: 2) onblur see if it saves!
 (ns notes.core
     (:require-macros [cljs.core.async.macros :refer [go]]
                      [datomic-cljs.macros :refer [<?]])
@@ -189,16 +188,23 @@
 (defn go-up [app note]
   (let [existing-list (:notes @app)
         index (index-of (:notes @app) @note)
+        id (:db/id @note)
         note-above (get existing-list (- index 1))
         final-list (notes-with-editing-row-updated existing-list (:db/id note-above))]
     (if (> index 0)
-      (do
-      (om/update! app :notes final-list)
-      (persist-update @note)
+      (if (not (string/blank? (:note/title @note)))
+        (do
+          (om/update! app :notes final-list)
+          (persist-update @note)
+        )
+        (do
+          (om/update! app :notes (into [] (remove #(= (:db/id %) id) final-list)))
+          (js/console.log (str "subiendo" @note))
+          )
+      )
       )
     )
   )
-)

 (defn go-down [app note]
   (let [existing-list (:notes @app)


bin pixels cont.

bin pixels cont.

--- src/clojure2d/pixels.clj
+++ src/clojure2d/pixels.clj
@@ -661,39 +661,70 @@
 ;;;;;;;;;;; Accumulator Bins for pixels - in progress

 (defprotocol BinPixelsProto
+  (add-density [binpixels x y])
+  (get-density [binpixels x y])
   (add-pixel [binpixels x y ch1 ch2 ch3])
-  (to-pixels [binpixels width height]))
+  (to-pixels [binpixels gamma prepow] [binpixels gamma] [binpixels]))

 (deftype BinPixels [^doubles bins
                     ^doubles ch1
                     ^doubles ch2
                     ^doubles ch3
+                    ^ints density
                     ^double rminx ^double rmaxx ^double rminy ^double rmaxy ^long sizex ^long sizey
-                    fnormx fnormy fbilinear-add]
+                    fnormx fnormy
+                    fbilinear-add fgaussian-add]
   Object
   (toString [_] (str "[" rminx "," rmaxx "]x" "[" rminy "," rmaxy "] -> " "[" sizex "," sizey "]"))
   BinPixelsProto

+  (add-density [_ x y]
+    (let [xx (bit-shift-right (long x) 3)
+          yy (bit-shift-right (long y) 3)
+          sx (bit-shift-right sizex 3)
+          sy (bit-shift-right sizey 3)]
+      (when (and (< -1 xx sx)
+                 (< -1 yy sy))
+        (let [idx (+ xx (* yy sx))]
+          (aset density idx (inc (aget density idx)))))))
+
+  (get-density ^int [_ x y]
+    (let [xx (bit-shift-right (long x) 3)
+          yy (bit-shift-right (long y) 3)
+          sx (bit-shift-right sizex 3)
+          sy (bit-shift-right sizey 3)]
+      (when (and (< -1 xx sx)
+                 (< -1 yy sy))
+        (let [idx (+ xx (* yy sx))]
+          (aget density idx)))))
+
   (add-pixel [t x y ch1 ch2 ch3]
     (let [^double vx (fnormx x)
-          ^double vy (fnormy y)]
-      (fbilinear-add vx vy))
+          ^double vy (fnormy y)
+          ivx (long vx)
+          ivy (long vy)]
+      (if (< (aget bins (+ ivx (* ivy sizex))) 5.0) ;; uzaleznic od min/max, fgaussian i fbilinear jako czesc typu
+        (fgaussian-add vx vy)
+        (fbilinear-add vx vy))
+      )
+
     t)
-
-  (to-pixels [t width height]
+
+  (to-pixels [_ gamma prepow]
     (let [^double mn (areduce bins idx ret Double/MAX_VALUE (min ret (aget bins idx)))
           ^double mx (areduce bins idx ret -1.0 (max ret (aget bins idx)))
-          fc (/ 1.0 (- mx mn))
-          ^doubles lnbins (amap bins idx ret (m/sqrt (m/log2 (inc (* fc (- (aget bins idx) mn))))))
-          ^Pixels p (make-pixels width height)]
+          fc (if (== mn mx) 0.0 (/ 1.0 (- mx mn)))
+          ^doubles lnbins (amap bins idx ret (m/pow (m/log2 (inc (m/pow (* fc (- (aget bins idx) mn)) prepow))) gamma))
+          ^Pixels p (make-pixels sizex sizey)]
       (println mn)
       (println mx)
-      (dotimes [idx (* ^long width ^long height)]
+      (dotimes [idx (* sizex sizey)]
         (let [c (* 255.0 ^double (aget lnbins idx))]
           (set-color p idx (Vec4. c c c 255))))
-      p
-      )
-    )
+      p))
+  (to-pixels [t gamma] (to-pixels t gamma 1.1))
+  (to-pixels [t] (to-pixels t 0.5 1.1))
+
   )

 (defn- make-bilinear-add-fn
@@ -733,25 +764,76 @@
            (aset bins p (+ v (* vv (- 1.0 restx) (- 1.0 resty))))))))
     ([^double vx ^double vy] (local-bilinear-add-fn vx vy 1.0))))

-(defn make-binpixels
+
+(defn- gauss-kernel-val
+  ""
+  ^double [^double invsigma2 ^double x ^double y]
+  (m/exp (- (* (+ (* x x) (* y y)) invsigma2))))
+
+(defn get-gaussian-kernel-fn
+  ""
+  ^doubles [insigma]
+  (let [sigma (double insigma)
+        r (int (* 3.0 (m/sqrt sigma)))
+        rn (range (- r) (inc r))
+        r21 (inc (* 2 r))
+        invsigma2 (/ 1.0 (* 2.0 sigma sigma))
+        ^double sum (reduce + (for [x rn
+                                    y rn]
+                                (gauss-kernel-val invsigma2 x y)))
+        ^doubles arr (double-array (* r21 r21))]
+    (dotimes [y r21]
+      (let [row (* y r21)]
+        (dotimes [x r21]
+          (let [xx (- x r)
+                yy (- y r)]
+            (aset arr (+ row x) (/ (gauss-kernel-val invsigma2 xx yy) sum))))))
+    arr))
+
+(def get-gaussian-kernel (memoize get-gaussian-kernel-fn))
+
+(defn make-gaussian-add-fn
+  ""
+  [^doubles bins ^long sizex ^long sizey]
+  (fn local-gaussian-add-fn
+    ([^double vx ^double vy ^double vv]
+     (let [ivx (long vx)
+           ivy (long vy)
+           val (aget bins (+ ivx (* ivy sizey)))
+           ^double nval (m/cnorm val 5.0 0.0 0.1 2.0)
+           ^doubles kernel (get-gaussian-kernel (* 0.1 (int (* 20.0 (m/log (inc nval))))))
+           len (m/sqrt (alength kernel))
+           len2 (int (/ len 2.0))]
+       (dotimes [y len]
+         (let [row (* y len)]
+           (dotimes [x len]
+             (let [xx (+ ivx (- x len2))
+                   yy (+ ivy (- y len2))
+                   idx (+ xx (* yy sizex))]
+               (when (and (< -1.0 xx sizex) (< -1.0 yy sizey))
+                 (aset bins idx (+ (aget bins idx)
+                                   (* vv (aget kernel (+ row x))))))))))))
+    ([^double vx ^double vy] (local-gaussian-add-fn vx vy 1.0))))
+
+(m/log 351)
+
+(defn make-binpixels
   "Create BinPixels type"
   ^BinPixels [[rminx rmaxx rminy rmaxy] ^long sizex ^long sizey]
   (let [bins (double-array (* sizex sizey))
         ch1 (double-array (* sizex sizey))
         ch2 (double-array (* sizex sizey))
         ch3 (double-array (* sizex sizey))
+        density (int-array (bit-shift-right (* sizex sizey) 6))
         fnormx (m/make-norm rminx rmaxx 0 sizex)
         fnormy (m/make-norm rminy rmaxy 0 sizey)
-        fbilinear-add (make-bilinear-add-fn bins sizex sizey)]
-    (BinPixels. bins ch1 ch2 ch3 rminx rmaxx rminy rmaxy sizex sizey fnormx fnormy fbilinear-add)))
+        fbilinear-add (make-bilinear-add-fn bins sizex sizey)
+        fgaussian-add (make-gaussian-add-fn bins sizex sizey)]
+    (BinPixels. bins ch1 ch2 ch3 density rminx rmaxx rminy rmaxy sizex sizey fnormx fnormy fbilinear-add fgaussian-add)))

 ;;(def ^BinPixels bp (make-binpixels [-10 10 -10 10] 1000 1000))

-;;(dotimes [x 100000000]
-;;(add-pixel bp (r/grand) (r/grand) 1 2 3))
-
-
-
-;;(save-pixels  (to-pixels bp 1000 1000) "test.png")
-
-
+;;(time (dotimes [x 50000000]
+;;        (add-pixel bp (r/grand) (r/grand) 1 2 3)))
+
+;;(save-pixels  (to-pixels bp) "test4.png")


Edit examples to be more useful

Edit examples to be more useful

--- test/layzee/integration/storage/dynamo_db_examples.clj
+++ test/layzee/integration/storage/dynamo_db_examples.clj
@@ -24,10 +24,8 @@

 (defn new-table[amazon-credential name]
   (far/ensure-table (client-opts amazon-credential) name
-                    [:id :n]  ; Primary key named "id", (:n => number type)
-                    {:throughput {:read 1 :write 1} ; Read & write capacity (units/sec)
-                     :block? true ; Block thread during table creation
-   }))
+                    [:id :s]
+                    {:throughput {:read 1 :write 1} :block? true }))

 (defn delete-table[amazon-credential name]
   (when (table-exists? amazon-credential name)
@@ -37,27 +35,19 @@
   (doseq [name (list-tables amazon-credential)]
     (delete-table amazon-credential name)))

-(defn save[amazon-credential table-name item]
-  (far/put-item (client-opts amazon-credential) (symbol table-name) item))
+(defn set[amazon-credential table-name name value]
+  (far/put-item (client-opts amazon-credential) (symbol table-name) { :id name :data (far/freeze value)} ))
+
+(defn get[amazon-credential table-name name]
+  (:data (far/get-item (client-opts amazon-credential) (symbol table-name) { :id name } { :attrs [:data] :consistent? true} )))

 (def test-table-name "lazy-web-test")

-(facts "The basics"
-       ;;(delete-all-tables settings/amazon-credential)
-
-       (future-fact "It fails with error when table already exists")
-
-       (fact "create a new table like this"
-             (delete-table settings/amazon-credential test-table-name)
-             (new-table settings/amazon-credential test-table-name)
-             (list-tables settings/amazon-credential) => '(:lazy-web-test)))
-
 (facts "Can add items to a table"
        (new-table settings/amazon-credential test-table-name)
-
+
        (future-fact "You can only add maps -- NOT strings for example")

        (fact "for example"
-             (save settings/amazon-credential test-table-name
-                   {:id 0
-                    :name "Bang" :data (far/freeze {:id_str "abc" :text "The tweet text"} )})))+             (set settings/amazon-credential test-table-name "1" {:text "The tweet goes here"})
+             (get settings/amazon-credential test-table-name "1") => {:text "The tweet goes here"}))


remove tests for /companies customization

--- test/open_company/integration/company/company_list.clj
+++ test/open_company/integration/company/company_list.clj
@@ -102,13 +102,7 @@
         (map :slug companies) => (just (set [(:slug r/open) uni-slug (:slug r/buffer)])) ; verify slugs
         (doseq [company companies] ; verify HATEOAS links
           (hateoas/verify-link "self" "GET" (company-rep/url company) company-rep/media-type (:links company))
-          (if (#{uni-slug "open"} (:slug company))
-            (do
-              ;; open + uni have been created by coyote/camus respectively which belong to
-              ;; the same org meaning coyote should have write access to both companies
-              (count (:links company)) => 2
-              (hateoas/verify-link "partial-update" "PATCH" (company-rep/url company) company-rep/media-type (:links company)))
-            (count (:links company)) => 1))))
+          (count (:links company)) => 1)))

     (fact "removed companies are not listed"
       (company/delete-company (:slug r/buffer))


Ensure user sub returns nil if no such user

--- src/braid/client/subs.cljs
+++ src/braid/client/subs.cljs
@@ -58,10 +58,10 @@
         u
         (let [g-id (state :open-group-id)
               group-bots (get-in state [:groups g-id :bots])]
-          (-> group-bots
-              (->> (filter (fn [b] (= (b :user-id) user-id))))
-              first
-              (assoc :bot? true)))))))
+          (some-> group-bots
+                  (->> (filter (fn [b] (= (b :user-id) user-id))))
+                  first
+                  (assoc :bot? true)))))))

 (reg-sub
   :users


Removed test that's no longer valid.

Removed test that's no longer valid.

--- test/cmr/opendap/tests/unit/rest/handler/collection.clj
+++ test/cmr/opendap/tests/unit/rest/handler/collection.clj
@@ -1,72 +0,0 @@
-(ns cmr.opendap.tests.unit.rest.handler.collection
-  "Note: this namespace is exclusively for unit tests."
-  (:require
-   [cheshire.core :as json]
-   [clojure.test :refer :all]
-   [cmr.opendap.rest.handler.collection :as collection]
-   [cmr.opendap.testing.util :as util]))
-
-;; XXX These now need to be re-worked ... and moved, since the latest code
-;; changes mean they're not simple unit tests anymore (they make multiple calls
-;; to CMR Search, so they're integration or system tests).
-
-; (deftest generate-via-get
-;   (let [pvt-func #'collection/generate-via-get
-;         concept-id :C123-PROV]
-;     (is (= {:collection-id "C123-PROV"
-;             :format "nc"
-;             :granules []
-;             :exclude-granules false
-;             :variables []
-;             :subset nil
-;             :bounding-box nil}
-;            (util/parse-response
-;             (pvt-func {:params {}} "/search" "token" concept-id))))
-;     (is (= {:collection-id "C123-PROV"
-;             :format "nc"
-;             :granules []
-;             :exclude-granules false
-;             :variables ["V1-PROV" "V2-PROV"]
-;             :subset ["lat(56.109375,67.640625)"
-;                      "lon(-9.984375,19.828125)"]
-;             :bounding-box nil}
-;            (util/parse-response
-;             (pvt-func {:params
-;                        {:variables "V1-PROV,V2-PROV"
-;                         :subset ["lat(56.109375,67.640625)"
-;                                  "lon(-9.984375,19.828125)"]}}
-;                       "/search"
-;                       "token"
-;                       concept-id))))))
-
-; (deftest generate-via-post
-;   (let [pvt-func #'collection/generate-via-post
-;         concept-id :C123-PROV]
-;     (is (= {:collection-id "C123-PROV"
-;             :format "nc"
-;             :granules []
-;             :exclude-granules false
-;             :variables []
-;             :subset nil
-;             :bounding-box nil}
-;            (util/parse-response
-;             (pvt-func (util/create-json-stream-payload {})
-;                       "/search"
-;                       "token"
-;                       concept-id))))
-;     (is (= {:collection-id "C123-PROV"
-;             :format "nc"
-;             :granules []
-;             :exclude-granules false
-;             :variables ["V1-PROV" "V2-PROV"]
-;             :subset ["lat(56.109375,67.640625)"
-;                      "lon(-9.984375,19.828125)"]
-;             :bounding-box nil}
-;            (util/parse-response
-;             (pvt-func (util/create-json-stream-payload
-;                        {:variables "V1-PROV,V2-PROV"
-;                         :subset ["lat(56.109375,67.640625)"
-;                                  "lon(-9.984375,19.828125)"]})
-;                       "/search"
-;                       "token"
-;                       concept-id))))))


refactors to release

refactors to release

--- src/cake/tasks/release.clj
+++ src/cake/tasks/release.clj
@@ -4,7 +4,7 @@

 (def *success* (atom false))

-(defn- scp
+(defn scp
   "call the scp ant task with options"
   [user to-file to-path & options]
   (let [settings {:trust true
@@ -14,37 +14,34 @@
         options (into settings options)]
     (ant Scp options)))

+(defn- get-key-options
+  "check the project options for a keyfile"
+  []
+  (seq (map file (filter #(not (nil? %))
+                         (map #(-> % opts first)
+                              [:i :identity])))))

-;check here, can probably get rid of the when-let wierdness if you make these fns return a string
-(comment defn- get-key-setting
+(defn get-key-setting
   "look for a keyfile specified in options or config"
-  [& [env]]
-  (when-let [path (or (first (or (map #(get opts %) [:i :identity])))
-                      (when env (get config (str env ".keyfile"))))]
-    [(file path)]))
+  [env]
+  (when-let [kf (get config (str env ".keyfile"))]
+    [(file kf)]))

-(defn- get-key-setting
-  "look for a keyfile specified in options or config"
-  [& [env]]
-  (or (seq (filter #(not (nil? %))
-                   (map #(-> % opts first)
-                        [:i :identity])))
-      (seq (when env (get config (str env ".keyfile"))))))
-
-(defn- detect-keys
+(defn get-keys-in
   "look for id_rsa, id_dsa, or identity in path"
   [path]
   (seq (filter #(.exists %)
                (map #(file (java.io.File. path) ".ssh" %)
                     ["id_rsa" "id_dsa" "identity"]))))

-(defn- find-keys [& [env]]
-  (let [keys (or (let [x (get-key-setting env) foo (println "x:" x)] x)
-                 (detect-keys (System/getProperty "user.home")))]
+(defn find-keys [& [env]]
+  (let [keys (or (get-key-options)
+                 (when env (get-key-setting env))
+                 (get-keys-in (System/getProperty "user.home")))]
     (when keys (apply println "Using keyfiles:" (map #(-> % .toString .trim) keys)))
     keys))

-(defn- transfer
+(defn try-scp
   ([user source dest keys passphrase]
      (doseq [key keys :while (not @*success*)]
        (print (.toString key) "...")
@@ -59,24 +56,24 @@
        (catch org.apache.tools.ant.BuildException e
          (println "Incorrect Password.")))))

-(defn- merge-settings [{env :env :as settings}]
+(defn merge-settings [{env :env :as settings}]
   (let [defaults {:user (or (get config (str env ".user"))
                             (System/getProperty "user.name"))
                   :keys (find-keys env)
                   :passphrase (when (:p opts) (prompt-read "Enter passphrase"))}]
     (merge defaults settings)))

-(defn- deploy*
+(defn deploy*
   [settings]
-  (let [{user :user source :source hosts :hosts path :path keys :keys passphrase :passphrase} (merge-settings settings)]
+  (let [{:keys [user source hosts path keys passphrase]} (merge-settings settings)]
     (doseq [host hosts]
       (let [dest (str host ":" path)]
         (println "Attempting to copy:" (.toString source) "to" dest)
-        (transfer user source dest keys passphrase)
+        (try-scp user source dest keys passphrase)
         (when-not @*success*
           (when (and keys (not (:p opts)))
             (println "All keyfiles failed, if a keyfile passphrase is required, use the -p flag"))
-          (transfer user source dest))))))
+          (try-scp user source dest))))))

 (defn deploy [& args]
   (if (vector? (first args))


documentation and cleanup

documentation and cleanup

--- src/clj/ceres/executor.clj
+++ src/clj/ceres/executor.clj
@@ -4,7 +4,7 @@
             [clojurewerkz.quartzite.jobs :as j]
             [clojurewerkz.quartzite.conversion :as qc]
             [clojurewerkz.quartzite.jobs :refer [defjob]]
-            [clojurewerkz.quartzite.schedule.daily-interval :refer [schedule with-repeat-count with-interval-in-days with-interval-in-minutes time-of-day every-day starting-daily-at ending-daily-at]]
+            [clojurewerkz.quartzite.schedule.daily-interval :refer [schedule time-of-day every-day starting-daily-at ending-daily-at]]
             [ceres.curator :as curator]
             [taoensso.timbre :as timbre]))

@@ -15,7 +15,6 @@
       (info "Writing articles backup...")
     (curator/backup-articles path)))

-
 (defjob TweetBackup [ctx]
   (let [path (get (qc/from-job-data ctx) "folder-path")]
       (info "Writing tweets backup...")
@@ -23,8 +22,9 @@

 (defjob OriginBackup [ctx]
   (let [path (get (qc/from-job-data ctx) "folder-path")]
-      (info "Writing tweets backup...")
+      (info "Writing origins backup...")
     (curator/backup-origins path)))
+

 (defn tweets-backup-schedule
   "Create a schedule to backup the tweets at 3 am"
@@ -63,8 +63,9 @@
                     (ending-daily-at (time-of-day 3 05 01)))))]
     (qs/schedule job trigger)))

+
 (defn origins-backup-schedule
-  "Create a schedule to backup the articles at 3.10 am"
+  "Create a schedule to backup the origins at 3.10 am"
   [path]
   (let [job (j/build
              (j/of-type OriginBackup)
@@ -81,6 +82,7 @@
                     (ending-daily-at (time-of-day 3 10 01)))))]
     (qs/schedule job trigger)))

+
 (defn start-executor
   "Run the schedules"
   [path]


Get a run credit if Corporate Scandal is active

--- src/clj/game/core-runs.clj
+++ src/clj/game/core-runs.clj
@@ -17,7 +17,7 @@
        (swap! state assoc :per-run nil
               :run {:server s :position (count ices) :ices ices :access-bonus 0
                     :run-effect (assoc run-effect :card card)})
-       (gain-run-credits state side (get-in @state [:corp :bad-publicity]))
+       (gain-run-credits state side (+ (get-in @state [:corp :bad-publicity]) (get-in @state [:corp :has-bad-pub])))
        (swap! state update-in [:runner :register :made-run] #(conj % (first s)))
        (update-all-ice state :corp)
        (trigger-event state :runner :run s)))))


difference function

difference function

--- src/cljc/commos/delta.cljc
+++ src/cljc/commos/delta.cljc
@@ -1,5 +1,6 @@
 (ns commos.delta
-  (:require [clojure.set :refer [difference]]
+  (:require [clojure.set :as set]
+            [clojure.data :as data]
             [commos.shared.core :refer [flatten-keys]]))

 (defn- collect
@@ -62,6 +63,21 @@
   (->> m
        positive-diagnostic-deltas
        (map summable-delta)))
+
+(defn difference
+  "Returns difference between x and y in deltas.  Adding the returned
+  deltas to x gives y."
+  [x y]
+  (cond (and (map x) (map? y))
+        (let [[neg pos _] (data/diff x y)]
+          (concat (negative-deltas neg)
+                  (positive-deltas pos)))
+
+        (and (set? x) (set? y))
+        [[:in (difference y x)]]
+
+        :else
+        [[:is y]]))

 ;; Helpers on deltas
 (defn diagnostic-delta
@@ -138,7 +154,7 @@
     :in (into (or val #{}) (collect new-val))
     :ex (if (map? val)
           (apply dissoc val (collect new-val))
-          (difference val (collect new-val)))
+          (set/difference val (collect new-val)))

     :on (reduce add* val (positive-deltas new-val))
     :off (reduce add* val (negative-deltas new-val))))


Disabling login/submit button while there's a WIP authentication (#22)

--- src/cljs/memento/core.cljs
+++ src/cljs/memento/core.cljs
@@ -44,6 +44,7 @@
   (fn [app-state _]
     (dispatch [:set-token (cookies/get :token nil)])
     (merge app-state {:ui-state {:is-busy?      false
+                                 :wip-login?    false
                                  :section       :login
                                  :current-query ""
                                  :results-page  0
@@ -65,7 +66,7 @@
                                       :handler       #(dispatch [:set-token (:token %)])
                                       :error-handler #(dispatch [:login-error %])}))
       )
-    app-state
+    (assoc-in app-state [:ui-state :wip-login?] true)
     ))

 (register-handler
@@ -77,6 +78,7 @@
     (-> app-state
         (assoc-in [:credentials :token] token)
         (assoc-in [:ui-state :section] (if (empty? token) :login :write))
+        (assoc-in [:ui-state :wip-login?] false)
         (assoc-in [:credentials :password] nil)
         (assoc-in [:credentials :password2] nil))))

@@ -89,6 +91,7 @@
           message   (if is-unauth "Invalid username/password" (:status-text result))
           msg-type  (if is-unauth "alert-danger" "alert-warning")]
       (-> app-state
+          (assoc-in [:ui-state :wip-login?] false)
           (assoc-in [:credentials :message] {:text message :type msg-type})
           (assoc-in [:credentials :token] nil)
           (assoc-in [:credentials :password] nil)
@@ -344,8 +347,7 @@
             ))
         [memory-pager]
         ]
-       "panel-primary"
-       ]
+       "panel-primary"]
       )))

 (defn memory-list []
@@ -361,6 +363,7 @@
         confirm   (subscribe [:credentials :password2])
         message   (subscribe [:credentials :message])
         section   (subscribe [:ui-state :section])
+        wip?      (subscribe [:ui-state :wip-login?])
         signup?   (reaction (= :signup @section))
         u-class   (reaction (if (and @signup? (empty? @username)) " has-error"))
         pw-class  (reaction (if (and @signup? (> 5 (count @password))) " has-error"))
@@ -408,7 +411,7 @@

           ]
          [:div {:class "modal-footer"}
-          [:button {:type "button" :class "btn btn-primary" :on-click #(dispatch [:auth-request @signup?])} "Submit"]]
+          [:button {:type "button" :class "btn btn-primary" :disabled @wip? :on-click #(dispatch [:auth-request @signup?])} "Submit"]]
          ]]]
       )))


cljs/skyport.core: implement droid shot

cljs/skyport.core: implement droid shot

--- src/cljs/skyport/core.cljs
+++ src/cljs/skyport/core.cljs
@@ -277,7 +277,39 @@
                     :cy y
                     :r (/ TILE-SIZE 2)}]])))))

-(defmulti action-view :type)
+(defn droid-shot [{:keys [sequence from]} owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:sequence (reductions (partial mapv +)
+                             (:position (player! from))
+                             sequence)
+       :explosion nil
+       :time (/ 1000 (dec (count sequence)))
+       })
+    om/IRenderState
+    (render-state [_ {:keys [sequence explosion time]}]
+      (when-not (empty? sequence)
+        (js/setTimeout
+         (fn []
+           (let [[coord & sequence] sequence]
+             (om/set-state!
+              owner :sequence sequence)
+             (om/set-state!
+              owner :explosion (if (empty? sequence)
+                                 coord))))
+         time))
+      (if-let [[coord & _] sequence]
+        (let [[x y] (coords-to-pixel coord)]
+          (html
+           [:g {:class "droid"}
+            [:circle {:fill "black"
+                      :cx x
+                      :cy y
+                      :r (/ TILE-SIZE 3)}]]))
+        (om/build mortar-shot {:coord explosion
+                               :radius 1})))))
+
 (defmulti action-view
   (fn [action _] (:type action)))


Use correct name for csv delimiter

Use correct name for csv delimiter

--- src/clojure/flambo/sql.clj
+++ src/clojure/flambo/sql.clj
@@ -68,12 +68,12 @@
 (defn read-csv
   "Reads a file in table format and creates a data frame from it, with cases corresponding to
   lines and variables to fields in the file. A clone of R's read.csv."
-  [sql-context path &{:keys [header separator quote schema]
-                      :or   {header false separator "," quote "'"}}]
+  [sql-context path &{:keys [header delimiter quote schema]
+                      :or   {header false delimiter "," quote "'"}}]
   (let [options (new java.util.HashMap)]
     (.put options "path" path)
     (.put options "header" (if header "true" "false"))
-    (.put options "separator" separator)
+    (.put options "delimiter" delimiter)
     (.put options "quote" quote)
     (if schema
       (-> sql-context .read (.format "csv") (.options options) (.schema schema) .load)


fix data-website json

fix data-website json

--- src/clojure/nossal/web.clj
+++ src/clojure/nossal/web.clj
@@ -47,7 +47,7 @@
       [:noscript
       (map (fn [node] node) (get options :noscript []))]]
     [:body
-      [:script {:type "application/ld+json"} dat/data-website]
+      [:script {:type "application/ld+json"} (core/to-json dat/data-website)]

       (seq body)


fix misprints

fix misprints

--- logging-macro-demo/src/logging_macro_demo/core.clj
+++ logging-macro-demo/src/logging_macro_demo/core.clj
@@ -16,7 +16,7 @@
   Clojurewerkz/Joda currency library."
   [input] (mf/format (amount-of USD (round input 2))))

-(def balance [3367.01 7839.76 326478.01 23479.15])
+(def balances [3367.01 7839.76 326478.01 23479.15])

 (defn indices
   "Given a predicate function and a collection, return a list of collection
@@ -32,7 +32,7 @@
         body (drop (inc param-index) arg)
         func-name (second arg)
         params (nth arg param-index)
-        new-print-arg-statement `(println (str "(" '~func-name " " ~params ")"))
+        new-print-args-statement `(println (str "(" '~func-name " " ~params ")"))
         last-statement (take-last 1 body)
         body-remainder (drop-last 1 body)
         print-last-statement `(println (str '~func-name " result: " ~(first last-statement)))
@@ -44,7 +44,7 @@
     `(do
        (println "param-index: " ~param-index)
        (println "first-half: " ~first-half)
-       (println "body: " '~func-name)
+       (println "body: " '~body)
        (println "func-name: " '~func-name)
        (println "params: " '~params)
        (println "new-print-statement: " '~new-print-args-statement)
@@ -53,6 +53,8 @@
        (println "print-last-statement: " '~print-last-statement)
        (println "new-functoin: " '~new-function)
        (eval '~new-function))))
+
+(my-debug (defn add-meaning "Douglas Adams reference" [arg] (+ 42 arg)))

 (defmacro my-debug-sm
   "Call with a function definition and this will add logging to the start and end."


Saving language and tribe name

Saving language and tribe name

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -63,7 +63,7 @@
         name-settlement (.name language)
         pos (free-random-land)
         settlement (Settlement. id-settlement name-settlement 100 id-tribe pos)
-        tribe (Tribe. id-tribe nil nil [id-settlement])
+        tribe (Tribe. id-tribe name-tribe language [id-settlement])
         game (assoc-in game [:tribes id-tribe] tribe)
         game (assoc-in game [:settlements id-settlement] settlement)]
       (println "Creating tribe " tribe)


Spawning villages

Spawning villages

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -46,12 +46,13 @@
 (declare run-randomly)
 (declare get-settlement)
 (declare get-tribe)
+(declare get-next-id)

 (defn get-settlement [id]
   (get-in @game [:settlements id]))

 (defn get-tribe [id]
-  (get-in @game [:tribe id]))
+  (get-in @game [:tribes id]))

 (defn update-settlement [settlement]
   (let [id (.id settlement)]
@@ -97,6 +98,8 @@
   (time (let [img (calc-biome-map (get-world))]
     (def saved-biome-map img))))

+;(defn update-biome-map [] )
+
 ; --------------------------------------
 ; Tribe functions
 ; --------------------------------------
@@ -108,10 +111,20 @@
                 (.id s)
                 acc)) nil settlements)))

+(defn free-cell? [pos]
+  (nil? (settlement-at pos)))
+
 (defn land? [pos]
-  (let [ b (-> (get-world) .getBiome)
-         biome (.get b (:x pos) (:y pos))]
-    (not (= (.name biome) "OCEAN"))))
+  (let [x (:x pos) y (:y pos)
+        w (-> (get-world) .getDimension .getWidth)
+        h (-> (get-world) .getDimension .getHeight)]
+    (if (or (< x 0) (< y 0) (>= x w) (>= y h))
+      false
+      (let [ b (-> (get-world) .getBiome)
+             biome (.get b (:x pos) (:y pos))]
+        (not (= (.name biome) "OCEAN"))))))
+
+(def fastness 1000)

 (defn random-pos []
   (let [w (-> (get-world) .getDimension .getWidth)
@@ -124,6 +137,17 @@
     (if (land? rp)
       rp
       (free-random-land))))
+
+(defn free-random-land-near [center]
+  (let [cx (:x center)
+        cy (:y center)
+        all-cells-around (for [dx (range -5 5) dy (range -5 5)]
+                            {:x (+ cx dx) :y (+ cy dy)})
+        land-cells-around (filter land? all-cells-around)
+        free-land-cells-around (filter free-cell? land-cells-around)]
+    (if (empty? free-land-cells-around)
+      nil
+      (rand-nth free-land-cells-around))))

 (defn chance [p]
   (< (rand) p))
@@ -144,6 +168,32 @@

 (defn ghost-town? [settlement]
   (= 0 (.pop settlement)))
+
+(declare update-settlement-fun)
+
+(defn spawn-new-village-from [id-settlement]
+  (try
+    (let [old-village   (get-settlement id-settlement)
+        _               (assert (not (nil? id-settlement)) (str "Unable to find settlement " id-settlement " in game " @game))
+        tribe-id        (.owner old-village)
+        _               (assert (not (nil? tribe-id)) (str "Old village has no owner: " old-village))
+        tribe           (get-tribe tribe-id)
+        _               (assert (not (nil? tribe)) (str "No tribe found with id " tribe-id " in " @game))
+        language        (.language tribe)
+        new-village-name (.name language)
+        new-pos (free-random-land-near (.pos old-village))
+        _               (assert (not (nil? new-pos)))
+        pop-new-village 100
+        pop-old-village (- (.pop old-village) pop-new-village)
+        settlement (Settlement. (get-next-id) new-village-name pop-new-village (.id tribe) new-pos)
+        id-new-settlement (.id settlement)
+        new-settlements-list (conj (.settlements tribe) (.id settlement))
+        _ (update-tribe (assoc tribe :settlements new-settlements-list))
+        _ (swap! game assoc-in [:settlements (.id settlement)] settlement)]
+      (record-event (str "Village " new-village-name " is born from " (.name old-village)) nil)
+      (update-settlement-pop id-settlement pop-old-village)
+      (run-randomly (update-settlement-fun id-new-settlement) (* fastness 3) (* fastness 10)))
+    (catch AssertionError e (println "assertion failed: " (.getMessage e)))))

 (defn update-settlement-fun [id-settlement]
   (fn []
@@ -155,7 +205,7 @@
                 new-pop (int (* (.pop s) perc))]
             (update-settlement-pop id-settlement new-pop)))
         (when (= event :shrinking)
-          (let [perc (- 1.00 (/ (rand) 8.0))
+          (let [perc (- 1.00 (/ (rand) 7.5))
                 new-pop (int (* (.pop s) perc))]
             (update-settlement-pop id-settlement new-pop)))
         (let [s (get-settlement id-settlement)]
@@ -163,35 +213,36 @@
             (update-settlement-pop id-settlement 0)
             (update-biome-map)
             (record-event (str "Village " (.name s) " is now a ghost town") nil))
-          (when (and (> (.pop s) 500) (chance 0.1))
-            (println "Spawning a new village")
+          (when (and (> (.pop s) 500) (chance 0.15))
+            (spawn-new-village-from id-settlement)
             (update-biome-map)
             ))))))

-(def fastness 1000)
-
-(defn- create-tribe-in-game [game]
-  (let [id-tribe (.next-id game)
-        game (assoc game :next-id (inc id-tribe))
-        id-settlement (.next-id game)
-        game (assoc game :next-id (inc id-settlement))
-        language (generate-language)
-        name-tribe (.name language)
-        name-settlement (.name language)
-        pos (free-random-land)
-        settlement (Settlement. id-settlement name-settlement 100 id-tribe pos)
-        tribe (Tribe. id-tribe name-tribe language [id-settlement])
-        game (assoc-in game [:tribes id-tribe] tribe)
-        game (assoc-in game [:settlements id-settlement] settlement)]
-      (run-randomly (update-tribe-fun id-tribe) 3000 10000)
-      (run-randomly (update-settlement-fun id-settlement) (* fastness 3) (* fastness 10))
-      (record-event (str "Creating tribe " name-tribe) pos)
-      (record-event (str "Creating village " name-settlement) pos)
-      (update-biome-map)
-    game))
-
-(defn create-tribe []
-  (swap! game create-tribe-in-game))
+(defn get-next-id []
+  (let [next-id (.next-id @game)
+        _ (swap! game assoc :next-id (inc next-id))]
+    next-id))
+
+(defn- create-tribe []
+  (try
+    (let [id-tribe        (get-next-id)
+          id-settlement   (get-next-id)
+          language        (generate-language)
+          name-tribe      (.name language)
+          name-settlement (.name language)
+          pos             (free-random-land)
+          settlement      (Settlement. id-settlement name-settlement 100 id-tribe pos)
+          tribe           (Tribe. id-tribe name-tribe language [id-settlement])
+          _               (update-tribe tribe)
+          _               (update-settlement settlement)]
+          _               (assert (= settlement (get-settlement id-settlement)))
+          _               (assert (= tribe (get-tribe id-tribe)))
+        (run-randomly (update-tribe-fun id-tribe) 3000 10000)
+        (run-randomly (update-settlement-fun id-settlement) (* fastness 3) (* fastness 10))
+        (record-event (str "Creating tribe " name-tribe) pos)
+        (record-event (str "Creating village " name-settlement) pos)
+        (update-biome-map))
+    (catch AssertionError e (println "Create tribe: " (.getMessage e)))))

 ; --------------------------------------
 ; Game functions
@@ -218,9 +269,11 @@
     (run-every-n-seconds f n)))

 (defn run-randomly [f min max]
-  (future (Thread/sleep (+ min (rand-int (- max min))))
-    (f)
-    (run-randomly f min max)))
+  (.start (Thread.
+    (fn []
+      (while true (do
+                    (Thread/sleep (+ min (rand-int (- max min))))
+                    (f)))))))

 (defn init []
   (run-every-n-seconds pop-balancer 10))


Add an arity for a cache manager

Add an arity for a cache manager

--- modules/cache/src/main/clojure/immutant/cache/core.clj
+++ modules/cache/src/main/clojure/immutant/cache/core.clj
@@ -60,18 +60,22 @@

 (defn get-cache
   "Returns the named cache if it exists, otherwise nil"
-  [name]
-  (if (.isRunning @manager name)
-    (.getCache @manager name)))
+  ([name]
+     (get-cache name @manager))
+  ([name manager]
+     (if (.isRunning manager name)
+       (.getCache manager name))))

 (defn start
-  "Takes a name and an Infinispan Configuration object"
-  [name ^Configuration config]
-  (log/debug (str "Infinispan options for cache [" name "]: " config))
-  (.defineConfiguration @manager name config)
-  (when-let [cache (get-cache name)]
-    (.stop cache)
-    (.start cache))
-  (let [cache (.getCache @manager name)]
-    (util/at-exit #(.stop cache))
-    cache))
+  "Defines and [re]starts a named cache"
+  ([name ^Configuration config]
+     (start name config @manager))
+  ([name ^Configuration config manager]
+     (log/debug (str "Infinispan options for cache [" name "]: " config))
+     (.defineConfiguration manager name config)
+     (when-let [cache (get-cache name manager)]
+        (.stop cache)
+        (.start cache))
+     (let [cache (.getCache manager name)]
+       (util/at-exit #(.stop cache))
+       cache)))


added turn off

added turn off

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2133,7 +2133,15 @@
                     :sem {:pred :try}
                     :subcat {:2 '()}}}]

-   "understand" (let [common {:english {:past "understood"}}]
+    "turn off"
+   {:synsem {:cat :verb
+             :sem {:pred :turn-off}}
+    :english {:past "turned off"
+              :present {:3sing "turns off"}
+              :participle "turning off"}}
+
+
+    "understand" (let [common {:english {:past "understood"}}]
                   [(unify
                    common
                    {:synsem {:cat :verb


{:agr :gender} for "man" and "woman"

{:agr :gender} for "man" and "woman"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1181,7 +1181,8 @@
            :english {:past "made"}}

    "man" {:english {:plur "men"}
-          :synsem {:cat :noun
+          :synsem {:agr {:gender :masc}
+                   :cat :noun
                    :sem {:human true
                          :pred :man
                          :child false}}}
@@ -1874,7 +1875,8 @@
                      :participle "winning"}}

    "woman" {:english {:plur "women"}
-            :synsem {:cat :noun
+            :synsem {:agr {:gender :fem}
+                     :cat :noun
                      :sem {:human true
                            :pred :donna
                            :child false}}}


add comment

add comment

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2852,6 +2852,8 @@
        {:synsem {:cat :verb
                  :subcat {:2 {:subcat '()}}}})

+      ;; note that {:english {:exception true}} is
+      ;; set by (babel.english.morphology/exception-generator)
       (default
        {:english {:exception false}
         :synsem {:cat :verb}})


make a blank entry for 'caer'

make a blank entry for 'caer'

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -155,7 +155,7 @@
                         {:preterito-stem "cup"}
                :synsem {:cat :verb
                         :sem {:pred :fit}}}
-   "caer"
+   "caer" {}

    "cambiar" {:synsem {:cat :verb
                        :sem {:pred :change}}}


fix typo

fix typo

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -416,7 +416,8 @@
   "touer" {:synsem {:cat :verb
                     :sem {:pred :kill}}}
   "tu"
-  (let [common {:synsem {:cat :nom
+  (let [common {:synsem {:cat :noun
+                         :case :nom
                          :agr {:person :2nd
                                :number :sing}
                          :sem {:human true
@@ -427,8 +428,8 @@
      (unify gender-pronoun-agreement
             common
             {:synsem {:agr {:gender :masc}}})])
-    "vous"
-   (let [common {:synsem {:case :nom
+  "vous"
+  (let [common {:synsem {:case :nom
                          :agr {:person :2nd
                                :number :plur}
                          :sem {:human true


Fix typo

Fix typo

--- src/app/cljs/one/repmax/exercises/view.cljs
+++ src/app/cljs/one/repmax/exercises/view.cljs
@@ -25,7 +25,7 @@
 (defmethod render :exercises/search [{:keys [new]}]
   (render-exercise-list (-> new :exercise-search :exercises)))

-;; TODO Time this approach (i.e., rebuilding the whole list in a "scorched Earth" fasion)
+;; TODO Time this approach (i.e., rebuilding the whole list in a "scorched Earth" fashion)
 ;;      versus hiding/showing *existing* list items after a search.
 (defn- render-exercise-list [exercises]
   (let [content (xpath "//div[@id='exercise-list']/ol")]


WIP: interface for adding extensions

WIP: interface for adding extensions

--- src/chat/client/views/pages/extensions.cljs
+++ src/chat/client/views/pages/extensions.cljs
@@ -2,6 +2,33 @@
   (:require [om.core :as om]
             [om.dom :as dom]
             [chat.client.store :as store]))
+
+(defn new-asana-form
+  [data owner]
+  (dom/form #js {}
+    (dom/input #js {:type "text" :placeholder "foobar"})))
+
+; TODO: how to get list of available extensions?
+(def available-extensions
+  {"asana" new-asana-form})
+
+(defn new-extension-view
+  [data owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:type nil})
+    om/IRenderState
+    (render-state [_ state]
+      (dom/div #js {:className "new-extension"}
+        (dom/pre nil (pr-str state))
+        (apply dom/select
+          #js {:className "extension-select"
+               :onChange (fn [e]
+                           (om/set-state! owner :type (.. e -target -value)))}
+          (map (fn [t] (dom/option #js {:value t} ((fnil name "") t)))
+               (cons nil (keys available-extensions))))
+        ((get available-extensions (state :type) (constantly nil)) data owner)))))

 (defn extensions-page-view
   [data owner]
@@ -14,4 +41,5 @@
           (map (fn [ext]
                  (dom/div #js {:className "extension"}
                    (str (ext :id) ": " (name (ext :type)))))
-               (get-in data [:groups (data :open-group-id) :extensions])))))))
+               (get-in data [:groups (data :open-group-id) :extensions])))
+        (om/build new-extension-view data)))))