Refs and 528

Refs and 528

--- Clojure/cp/src/cp/threads.clj
+++ Clojure/cp/src/cp/threads.clj
@@ -237,36 +237,200 @@
 	REFS:
 		synchronous, coordinated, STM
 		atomic, consistent, isolated.
-
+		any modification to a ref must happen in a transaction
+		in transaction value?
+
+	dosync - the scope of a transaction
+	alter - if all starting vals are the same when trying to commit then commit else restart
+	commute -
+	ref-set - similar to alter, with no regard for contraints, used to reinitilize values
 	)

 (defn character [name & {:as opts}]
-	(ref (merge {:name name :items #{} :health 500})
-				opts))
-
-(def smaug (character "Smaug" :health 600))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+	(ref (merge {:name name :items #{} :health 500}
+				opts)))
+
+(def smaug (character "Smaug" :health 500 :strength 400 :items (set (range 50))))
+(def bilbo (character "Bilbo" :health 100 :strength 100))
+(def gandalf (character "Gandalf" :health 75 :mana 750))
+
+(defn loot [from to]
+	(dosync
+		(when-let [item (first (:items @from))]
+			(alter to update-in [:items] conj item)
+			(alter from update-in [:items] disj item))))
+
+(wait-futures 1
+	(while (loot smaug bilbo))
+	(while (loot smaug gandalf)))
+
+(count (:items @bilbo))
+
+(map (comp count :items deref) [bilbo gandalf])
+(filter (:items @bilbo) (:items @gandalf))
+
+(= (/ (/ 120 3) 4) (/ (/ 120 4) 3))
+(= ((comp #(/ % 3) #(/ % 4)) 120) ((comp #(/ % 4) #(/ % 3)) 120))
+
+(def x (ref 0))
+
+(time (wait-futures 5
+	(dotimes [_ 1000]
+		(dosync (alter x + (apply + (range 1000)))))
+	(dotimes [_ 1000]
+		(dosync (alter x - (apply + (range 1000)))))))
+
+(time (wait-futures 5
+	(dotimes [_ 1000]
+		(dosync (commute x + (apply + (range 1000)))))
+	(dotimes [_ 1000]
+		(dosync (commute x - (apply + (range 1000)))))))
+
+(defn flawed-loot [from to]
+	(dosync
+		(when-let [item (first (:items @from))]
+			(commute to update-in [:items] conj item)
+			(commute from update-in [:items] disj item))))
+
+(wait-futures 1
+	(while (flawed-loot smaug bilbo))
+	(while (flawed-loot smaug gandalf)))
+
+(defn fixed-loot [from to]
+	(dosync
+		(when-let [item (first (:items @from))]
+			(commute to update-in [:items] conj item)
+			(alter from update-in [:items] disj item))))
+
+(wait-futures 1
+	(while (fixed-loot smaug bilbo))
+	(while (fixed-loot smaug gandalf)))
+
+(defn attack [agressor target]
+	(dosync
+		(let [damage (* (rand 0.1) (:strength @agressor))]
+			(commute target update-in [:health] #(max 0 (- % damage))))))
+
+(defn heal [healer target]
+	(dosync
+		(let [aid (* (rand 0.1) (:mana @healer))]
+			(when (pos? aid)
+				(commute healer update-in [:mana] -  (max 5 (/ aid 5)))
+				(commute target update-in [:health] + aid)))))
+
+(def alive? (comp pos? :health))
+
+(defn play [character action other]
+	(while (and
+		(alive? @character)
+		(alive? @other)
+		(action character other))
+	(Thread/sleep (rand-int 50))))
+
+(wait-futures 1
+	(play bilbo attack smaug)
+	(play smaug attack bilbo))
+
+(map (comp :health deref) [smaug bilbo])
+
+(defn reset-health []
+	(dosync
+		(alter smaug assoc :health 500)
+		(alter bilbo assoc :health 100)))
+
+(wait-futures 1
+	(play bilbo attack smaug)
+	(play smaug attack bilbo)
+	(play gandalf heal bilbo))
+
+(map (comp #(select-keys % [:name :health :mana]) deref)
+	[smaug bilbo gandalf])
+
+(dosync (ref-set bilbo {:name "Mr Jones"}))
+
+(defn enfore-max-health [name health]
+	(fn [character-data]
+		(or (<= (:health character-data) health)
+			(throw (IllegalStateException. (str name " is already at max health!"))))))
+
+(defn character [name & {:as opts}]
+	(let [cdata
+			(merge
+				{:name name :items #{} :health 500}
+				opts)
+		  cdata (assoc cdata :max-health (:health cdata))
+		  validators (list* (enfore-max-health name (:health cdata))
+		  					(:validators cdata))]
+		  (ref (dissoc cdata :validators)
+		  	:validator #(every? (fn [v] (v %)) validators))))
+
+(def smaug (character "Smaug" :health 500 :strength 400 :items (set (range 50))))
+(def bilbo (character "Bilbo" :health 100 :strength 100))
+(def gandalf (character "Gandalf" :health 75 :mana 750))
+
+(dosync (alter bilbo assoc-in [:health] 95))
+
+(defn heal [healer target]
+	(dosync
+		(let [aid (min (* (rand 0.1) (:mana @healer))
+					   (- (:max-health @target) (:health @target)))]
+		(when (pos? aid)
+			(commute healer update-in [:mana] - (max 5 (/ aid 5)))
+			(alter target update-in [:health] + aid)))))
+
+(defn unsafe []
+	(io! (println "writing to database ...")))
+
+(def x (ref (java.util.ArrayList.)))
+
+(wait-futures 2
+	(dosync
+		(dotimes [v 5]
+			(Thread/sleep (rand-int 50))
+			(alter x #(doto % (.add v))))))
+
+(def x (ref 0))
+
+(dosync
+	@(future (dosync (ref-set x 0)))
+	(ref-set x 1))
+
+(def a (ref 0 :min-history 50 :max-history 100))
+
+(future (dotimes [_ 500] (dosync
+	(Thread/sleep 20)
+	(alter a inc))))
+
+@(future (dosync (Thread/sleep 1000) @a))
+
+(ref-history-count a)
+
+(comment
+	VARS:
+
+	)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


ah-gawb-1396: Library: autocomplete during metadata intake  (#652)

* add typeahead to library metadata ui

--- src/cljs/main/broadfcui/page/workspace/summary/catalog/questions.cljs
+++ src/cljs/main/broadfcui/page/workspace/summary/catalog/questions.cljs
@@ -100,7 +100,7 @@
                            :onChange update-property
                            :rows 3}))

-(defn- render-typeahead [{:keys [prop colorize value-nullsafe update-property state property library-schema]}]
+(defn- render-ontology-typeahead [{:keys [prop colorize value-nullsafe update-property state property library-schema]}]
   [:div {:style {:marginBottom "0.75em"}}
    [comps/Typeahead {:field-attributes {:placeholder (:inputHint prop)
                                         :style (colorize {:width "100%" :marginBottom "0px"})
@@ -130,6 +130,23 @@
          (style/create-link {:text "Clear Selection"
                              :onClick #(apply swap! state update :attributes dissoc
                                               (library-utils/get-related-id+label-props library-schema property))})]]))])
+
+(defn- render-populate-typeahead [{:keys [prop property inputHint]}]
+  [:div {:style {:marginBottom "0.75em"}}
+   [comps/AutocompleteFilter
+    {:width "100%"
+     :ref "text-filter"
+     :placeholder inputHint
+     :bloodhoundInfo {:url (str (config/api-url-root) "/api/library/populate/suggest/" (name property) "/")
+                      :cache false
+                      :prepare (fn [query settings]
+                                 (clj->js
+                                   (assoc (js->clj settings)
+                                     :headers {:Authorization (str "Bearer " (utils/get-access-token))}
+                                     :type "GET"
+                                     :url (str (aget settings "url") query))))}
+     :typeaheadSuggestionTemplate (fn [result]
+                                    (str "
" result  "
"))}]])

 (defn- render-textfield [{:keys [colorize datatype prop value-nullsafe update-property]}]
   (style/create-text-field {:style (colorize {:width "100%"})
@@ -206,6 +223,7 @@
                 (cond enum (render-enum data)
                       (= type "boolean") (render-boolean data)
                       (= (:datatype renderHint) "freetext") (render-freetext data)
-                      (= (:typeahead prop) "ontology") (render-typeahead data)
+                      (= (:typeahead prop) "ontology") (render-ontology-typeahead data)
+                      (= (:typeahead prop) "populate") (render-populate-typeahead data)
                       :else (render-textfield data))])))
          (map keyword questions))]))})


Only run through update if there is something worth updating

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -42,19 +42,21 @@
                              (set! kind->name->fields->index (assoc-in kind->name->fields->index [kind name (vec fields)] index))
                              index)))
   (update-facts [this kind name fields facts&vals]
-                #_(when (> (alength facts&vals) 0)
-                  (prn :updating kind name fields (alength facts&vals)))
-                (assert (array? fields))
-                (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
-                (let [changed? false
-                      indexes (or (get-in kind->name->fields->index [kind name])
-                                  (let [filtered-fields (into-array (filter #(not (nil? %)) fields))]
-                                    [[(vec filtered-fields) (.get-or-create-index this kind name filtered-fields)]]))]
-                  (assert (seq indexes) (pr-str kind name))
-                  (doseq [[other-fields other-index] indexes]
-                    (when (true? (-update-facts facts&vals fields other-index (into-array other-fields)))
-                      (set!! changed? true)))
-                  changed?))
+                (if (> (alength facts&vals) 0)
+                  (do
+                    #_(prn :updating kind name fields (alength facts&vals))
+                    (assert (array? fields))
+                    (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
+                    (let [changed? false
+                          indexes (or (get-in kind->name->fields->index [kind name])
+                                      (let [filtered-fields (into-array (filter #(not (nil? %)) fields))]
+                                        [[(vec filtered-fields) (.get-or-create-index this kind name filtered-fields)]]))]
+                      (assert (seq indexes) (pr-str kind name))
+                      (doseq [[other-fields other-index] indexes]
+                        (when (true? (-update-facts facts&vals fields other-index (into-array other-fields)))
+                          (set!! changed? true)))
+                      changed?))
+                  false))
   (add-facts [this kind name fields facts]
              (let [facts&vals #js []]
                (dotimes [i (alength facts)]
@@ -94,26 +96,26 @@
               (let [fields (or (first (first (get-in kind->name->fields->index ["know" name])))
                                (first (first (get-in kind->name->fields->index ["remember" name])))
                                (first (first (get-in kind->name->fields->index ["forget" name]))))]
-                (assert (not (nil? fields)) name)
-                (let [fields (into-array fields)
-                      know-index (.get-or-create-index this "know" name fields)
-                      remember-index (.get-or-create-index this "remember" name fields)
-                      forget-index (.get-or-create-index this "forget" name fields)
-                      know-iter (btree/iterator know-index)
-                      remember-iter (btree/iterator remember-index)
-                      forget-iter (btree/iterator forget-index)
-                      facts&vals #js []]
-                  (.foreach remember-index
-                            (fn [key val]
-                              (when (and (not (.contains? know-iter key)) (not (.contains? forget-iter key)))
-                                (.push facts&vals key 1))))
-                  (.foreach forget-index
-                            (fn [key val]
-                              (when (and (.contains? know-iter key) (not (.contains? remember-iter key)))
-                                (.push facts&vals key -1))))
-                  (.clear-facts this "remember" name)
-                  (.clear-facts this "forget" name)
-                  (.update-facts this "know" (str "delta-" name) fields facts&vals))))
+                (when-not (nil? fields)
+                  (let [fields (into-array fields)
+                        know-index (.get-or-create-index this "know" name fields)
+                        remember-index (.get-or-create-index this "remember" name fields)
+                        forget-index (.get-or-create-index this "forget" name fields)
+                        know-iter (btree/iterator know-index)
+                        remember-iter (btree/iterator remember-index)
+                        forget-iter (btree/iterator forget-index)
+                        facts&vals #js []]
+                    (.foreach remember-index
+                              (fn [key val]
+                                (when (and (not (.contains? know-iter key)) (not (.contains? forget-iter key)))
+                                  (.push facts&vals key 1))))
+                    (.foreach forget-index
+                              (fn [key val]
+                                (when (and (.contains? know-iter key) (not (.contains? remember-iter key)))
+                                  (.push facts&vals key -1))))
+                    (.clear-facts this "remember" name)
+                    (.clear-facts this "forget" name)
+                    (.update-facts this "know" (str "delta-" name) fields facts&vals)))))
   (merge [this]
          (doseq [[name _] (kind->name->fields->index "know")]
            (.merge-facts this name)))


s/info/debug/

s/info/debug/

--- src/babel/directory.cljc
+++ src/babel/directory.cljc
@@ -29,9 +29,9 @@
            (if (realized? es)
              es
              (deliver es
-                      (do (log/info (str "starting to load Español model.."))
+                      (do (log/debug (str "starting to load Español model.."))
                           (let [model (babel.espanol.grammar/small)]
-                            (log/info (str "finished loading Espanol model."))
+                            (log/debug (str "finished loading Espanol model."))
                             (conj model
                                   {:generate-fn (fn [spec]
                                                   (es/generate spec :model model))


dissoc :dag_unify.core/serialized

dissoc :dag_unify.core/serialized

--- src/babel/lexiconfn.cljc
+++ src/babel/lexiconfn.cljc
@@ -218,7 +218,9 @@
 (defn embed-phon [lexical-entry]
   (cond (string? (get-in lexical-entry '(:english)))
         (unify {:english {:english (get-in lexical-entry '(:english))}}
-                (embed-phon (dissoc lexical-entry ':english)))
+               (embed-phon (-> lexical-entry
+                               (dissoc :dag_unify.core/serialized)
+                               (dissoc :english))))

         (and (string? (get-in lexical-entry '(:italiano)))
              (= :verb (get-in lexical-entry '(:synsem :cat))))


email invite when inviting new user

email invite when inviting new user

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -5,6 +5,7 @@
             [taoensso.timbre :as timbre :refer [debugf]]
             [clojure.core.async :as async :refer [<! <!! >! >!! put! chan go go-loop]]
             [chat.server.db :as db]
+            [chat.server.invite :as invites]
             [clojure.set :refer [difference intersection]]))

 (let [{:keys [ch-recv send-fn ajax-post-fn ajax-get-or-ws-handshake-fn
@@ -124,8 +125,9 @@
     (if (db/with-conn (db/user-in-group? user-id (?data :group-id)))
       (let [data (assoc ?data :inviter-id user-id)
             invitation (db/with-conn (db/create-invitation! data))]
-        (when-let [invited-user (db/with-conn (db/user-with-email (invitation :invitee-email)))]
-          (chsk-send! (invited-user :id) [:chat/invitation-recieved invitation])))
+        (if-let [invited-user (db/with-conn (db/user-with-email (invitation :invitee-email)))]
+          (chsk-send! (invited-user :id) [:chat/invitation-recieved invitation])
+          (invites/send-invite invitation)))
       ; TODO: indicate permissions error to user?
       (timbre/warnf "User %s attempted to invite %s to a group %s they don't have access to"
                     user-id (?data :invitee-email) (?data :group-id)))))


make explain-out public

make explain-out public

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -171,8 +171,8 @@
   [spec x]
   (explain-data* spec [] (if-let [name (spec-name spec)] [name] []) [] x))

-(defn- explain-out
-  "prints an explanation to *out*."
+(defn explain-out
+  "prints explanation data (per 'explain-data') to *out*."
   [ed]
   (if ed
     (do


Fix some indentation.

Fix some indentation.

--- src/clj/medusa/alert.clj
+++ src/clj/medusa/alert.clj
@@ -14,10 +14,10 @@
         (println "BODY: " subject)
         (println "===================================================="))
     (ses/send-email {:endpoint "us-west-2"}
-                    :destination {:to-addresses destinations}
-                    :source "telemetry-alerts@mozilla.com"
-                    :message {:subject subject
-                              :body {:text body}})))
+                     :destination {:to-addresses destinations}
+                     :source "telemetry-alerts@mozilla.com"
+                     :message {:subject subject
+                               :body {:text body}})))

 (defn- build-range
   "Returns 'abc123' if there's only 1 build. Otherwise, return 'abc123...def456'."


Use api instead of site defaults.

Use api instead of site defaults.

Removes anti-forgery.

--- src/clj/sally/server.clj
+++ src/clj/sally/server.clj
@@ -4,7 +4,7 @@
                        [route :refer [resources]])
             [com.stuartsierra.component :as component]
             [taoensso.timbre :refer [report info]]
-            (ring.middleware [defaults :refer [wrap-defaults site-defaults]]
+            (ring.middleware [defaults :refer [wrap-defaults api-defaults]]
                              [format :refer [wrap-restful-format]])
             [environ.core :refer (env)]
             [cemerick.piggieback :as piggieback]
@@ -20,7 +20,7 @@
               (resources "/react" {:root "react"})
               (GET "/" req (root-page req)))
       (wrap-restful-format)
-      (wrap-defaults site-defaults)))
+      (wrap-defaults api-defaults)))

 (defn- serve
   "Start a development server."


Use minified version of scripts

Use minified version of scripts

--- src/clj/subman/views.clj
+++ src/clj/subman/views.clj
@@ -8,7 +8,7 @@
           (include-css "/components/bootstrap/dist/css/bootstrap.css"
                        "/components/bootstrap/dist/css/bootstrap-theme.css"
                        "/components/font-awesome/css/font-awesome.css")
-          (include-js "/components/jquery/jquery.js"
-                      "/components/bootstrap/dist/js/bootstrap.js"
+          (include-js "/components/jquery/jquery.min.js"
+                      "/components/bootstrap/dist/js/bootstrap.min.js"
                       "/main.js")]
          [:body [:script "subman.core.run();"]]))


Fix random read function of bam reader.

Fix random read function of bam reader.

--- src/cljam/bam/reader.clj
+++ src/cljam/bam/reader.clj
@@ -95,13 +95,17 @@

 (defn- read-to-finish
   [^BAMReader rdr
+   ^Long start
    ^Long finish
    ^clojure.lang.IFn read-fn]
   (let [r ^BGZFInputStream (.reader rdr)]
-    (when (and (not (zero? (.available r)))
-               (> finish (.getFilePointer r)))
-      (cons (read-fn rdr (.refs rdr))
-            (lazy-seq (read-to-finish rdr finish read-fn))))))
+    (when (< start finish)
+      (.seek r start)
+      (when-not (zero? (.available r))
+        (let [result (read-fn rdr (.refs rdr))
+              curr (.getFilePointer r)]
+          (cons result
+                (lazy-seq (read-to-finish rdr curr finish read-fn))))))))

 (defn- read-alignments-first-only
   "It should be equivalent to [(first (filter window @candidates))]"
@@ -109,9 +113,8 @@
   (loop [left-spans spans]
     (when-let [span (first left-spans)]
       (let [[^Long begin ^Long finish] span]
-        (.seek ^BGZFInputStream (.reader rdr) begin)
         (or
-          (loop [left (read-to-finish rdr finish read-fn)]
+          (loop [left (read-to-finish rdr begin finish read-fn)]
             (when-let [one (first left)]
               (if (window one)
                 [one]
@@ -138,8 +141,7 @@
                   :deep read-alignment
                   :pointer pointer-read-alignment)
         candidates (flatten (map (fn [[^Long begin ^Long finish]]
-                                   (.seek ^BGZFInputStream (.reader rdr) begin)
-                                   (read-to-finish rdr finish read-fn)) spans))]
+                                   (read-to-finish rdr begin finish read-fn)) spans))]
     (if (= deep-or-shallow :first-only)
       (read-alignments-first-only rdr spans window read-fn)
       (filter window candidates))))
@@ -182,8 +184,7 @@
                         (<= start left)
                         (>= end left))))
         candidates (flatten (map (fn [[^Long begin ^Long finish]]
-                                   (.seek ^BGZFInputStream (.reader rdr) begin)
-                                   (read-to-finish rdr finish read-coordinate-alignment-block)) spans))]
+                                   (read-to-finish rdr begin finish read-coordinate-alignment-block)) spans))]
     (filter window candidates)))

 (defn load-headers


Require <? macro into core.cljs

Require <? macro into core.cljs

--- src/cljs/gtfve/core.cljs
+++ src/cljs/gtfve/core.cljs
@@ -1,5 +1,6 @@
 (ns gtfve.core
-  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
+  (:require-macros [cljs.core.async.macros :refer [go go-loop]]
+                   [gtfve.macros :refer [<?]])
   (:require [reagent.core :as reagent :refer [atom]]
             [reagent.session :as session]
             [secretary.core :as secretary :include-macros true]


fix open drop and use channels on it

fix open drop and use channels on it

--- src/cljs/smgui/main.cljs
+++ src/cljs/smgui/main.cljs
@@ -3,11 +3,11 @@
   (:require [om.core :as om]
             [om.dom :as dom]
             [smgui.components :refer [external-link pd]]
-            [smgui.search :refer [render-search search-for-path]]
+            [smgui.search :refer [render-search]]
             [smgui.settings :as settings]
             [smgui.gui :as gui]
             [smgui.track :as track]
-            [smgui.core :refer [app-state]]
+            [smgui.core :refer [app-state flux-channel]]
             [cljs.core.async :refer [put! chan <! >! timeout close!]]
             [clojure.data :as data]
             [clojure.string :as string]
@@ -63,4 +63,4 @@
   (enable-console-print!)
   (om/root main-view app-state {:target (.-body js/document)})
   (doseq [path gui/app-args]
-    (search-for-path path)))
+    (put! flux-channel {:cmd :add-search :path path})))


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -423,7 +423,7 @@
                          0
                          1)))
                 (vec (repeat (count (:errors ind)) 1)))
-              #_(if (and (:parent1-errors ind) (:parent2-errors ind))
+              (if (and (:parent1-errors ind) (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)
                                              (:parent1-errors ind)
@@ -435,7 +435,7 @@
                          (= e (max p1e p2e)) 3
                          :else 4)))
                 (vec (repeat (count (:errors ind)) 5)))
-              (if (and (:parent1-errors ind) (:parent2-errors ind))
+              #_(if (and (:parent1-errors ind) (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)
                                              (:parent1-errors ind)


apply simple button mixin to delete button on account page

--- src/cljs/wombats_web_client/components/cards/wombat.cljs
+++ src/cljs/wombats_web_client/components/cards/wombat.cljs
@@ -11,6 +11,6 @@
    [:div "wombat image"]
    [:div (:name wombat)]
    [:div.hover-state-edit
-    [:input {:type "button"
+    [:input.simple-button {:type "button"
              :value "DELETE"
              :on-click (open-delete-wombat-modal (:id wombat))}]]])


Small tweak of Byte/TYPE

Small tweak of Byte/TYPE

--- src/compojure/crypto.clj
+++ src/compojure/crypto.clj
@@ -38,7 +38,7 @@
    Defaults to SHA1PRNG."
   ([size] (secure-random-bytes size "SHA1PRNG"))
   ([size algorithm]
-     (let [seed (make-array (. Byte TYPE) size)]
+     (let [seed (make-array Byte/TYPE size)]
        (.nextBytes (SecureRandom/getInstance algorithm) seed)
        seed)))


latest dependencies

latest dependencies

--- iwaswhere-web/project.clj
+++ iwaswhere-web/project.clj
@@ -4,10 +4,10 @@
   :license {:name "GNU GENERAL PUBLIC LICENSE"
             :url  "http://www.gnu.org/licenses/gpl-3.0.en.html"}
   :dependencies [[org.clojure/clojure "1.9.0-alpha13"]
-                 [org.clojure/clojurescript "1.9.229"]
+                 [org.clojure/clojurescript "1.9.293"]
                  [org.clojure/tools.logging "0.3.1"]
                  [org.clojure/tools.namespace "0.2.11"]
-                 [com.taoensso/encore "2.85.0"]
+                 [com.taoensso/encore "2.86.1"]
                  [ch.qos.logback/logback-classic "1.1.7"]
                  [hiccup "1.0.5"]
                  [clj-pid "0.1.2"]


Use function reader macro inside the service

--- src/ashiba/core.cljs
+++ src/ashiba/core.cljs
@@ -16,19 +16,18 @@
   (params [_ route-params]
     (or (get-in route-params [:data :message]) "Hello!"))
   (start [_ params app-db]
-    (assoc-in app-db [:kw :message] params))
+    (assoc-in app-db [:kv :message] params))
   (handler [this in-chan out-chan]
     (go
       (loop [count 0]
         (let [[command args] (<! in-chan)]
           (when (= command :some-command)
-            (service/send-update this (fn [app-db]
-                                        (assoc-in app-db [:kw :message] (str "Hello #" count))) true))
+            (service/send-update this #(assoc-in % [:kv :message] (str "Hello #" count))))
           (when command (recur (inc count))))))))

 (defn message [app-db]
   (reaction
-   (get-in @app-db [:kw :message])))
+   (get-in @app-db [:kv :message])))

 (defn main-renderer [ctx]
   [:h1


whitespace

whitespace

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -137,9 +137,7 @@
                                                       (:morph model))
                                            ;; fallback to (:morph model) if
                                            ;; (:morph-ps is not available)
-
-                                           parents
-                                           (over (:grammar model) left-signs right-signs morph-ps)
+                                           parents (over (:grammar model) left-signs right-signs morph-ps)
                                            truncated-parents
                                            (if parse-with-truncate
                                              (pmap (fn [parent]
@@ -161,7 +159,6 @@
                                                        (string/join ","
                                                                     (map #(morph-ps %) right-signs))))
                                        (if parse-with-truncate truncated-parents parents)))
-
                                  ;; TODO: explain why we can use (first) here for the left- and right-strings.
                                    ;; Throw an exception if (> 1 (count left-strings)) or (> 1 (count right-strings))
                                    [(string/join " " [(first left-strings) (first right-strings)])]))


Bugfix heuristic calculation

Bugfix heuristic calculation

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -21,7 +21,7 @@
   (let [list-to-check (conj list-to-check :empty)]
   (if (and (= (.indexOf (rest list-to-check) opponent) -1) (= (.indexOf (rest list-to-check) :wall) -1))
     (let [count-in-list (reduce #(+ %1 (if (= %2 player) 1 0)) 0 list-to-check)]
-      (if (< count-in-list 4)
+      (if (<= count-in-list 4)
         count-in-list
         1000))
     0)))


Furthest

Furthest

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -3,83 +3,14 @@
             clojure.set
             clojure.data.priority-map
             [clojure.math.combinatorics :as combo])
-  (:gen-class))
-
-(def width-heuristic-calculation 5)
+  (:gen-class)
+  (:import (java.util.concurrent TimeoutException)))
+
+
 (def directors {:h  (map #(do [%1 0]) (range -5 6))
                 :v  (map #(do [0 %1]) (range -5 6))
                 :d1 (map #(do [%1 %1]) (range -5 6))
                 :d2 (map #(do [%1 (- %1)]) (range -5 6))})
-
-(defn gen-heuristic-dictionary
-  "Generate the dictionnary of heuristics values"
-  [depth]
-  (apply merge (for [x '(:min :max :wall :empty)]           ;
-                 (if (= depth 0)
-                   {x 0}
-                   {x (gen-heuristic-dictionary (dec depth))}))))
-
-(defn calc-positive-heuristic
-  ""
-  [list-to-check player opponent]
-
-  (if
-      (and
-        (= (.indexOf list-to-check opponent) -1)
-        (= (.indexOf list-to-check :wall) -1))
-    (let [count-in-list (reduce #(+ %1 (if (= %2 player) 1 0)) 0 list-to-check)]
-      (if (< count-in-list 3)
-        (Math/pow 2 count-in-list)
-        1000))
-    0))
-
-(defn calc-heuristic
-  ""
-  [list-to-check player opponent]
-
-  (+
-    (calc-positive-heuristic list-to-check player opponent))
-
-
-  (- (calc-positive-heuristic list-to-check player opponent)
-     (calc-positive-heuristic (reverse list-to-check) opponent player)))
-
-(defn fill-heuristics-dict
-  ""
-  []
-  (reduce #(assoc-in %1 %2 (calc-heuristic %2 :max :min))
-          (gen-heuristic-dictionary width-heuristic-calculation)
-          (apply clojure.math.combinatorics/cartesian-product
-                 (for [_ (range width-heuristic-calculation)] [:min :max :wall :empty]))))
-
-(defn generate-valid-keys
-  ""
-  [depth]
-  (let [half-keys (filter
-                    #(loop [keys %
-                            wall-done false]
-                      (if (empty? keys)
-                        true
-                        (if (and (not wall-done) (not (= (first keys) :wall)))
-                          (recur (rest keys) true)
-                          (if (and wall-done (= (first keys) :wall))
-                            false
-                            (recur (rest keys) wall-done)))))
-                    (combo/selections [:min :max :empty :wall] (/ depth 2)))]
-    (for [k1 half-keys k2 half-keys] (concat k1 (reverse k2)))))
-
-(def heuristic-dict (fill-heuristics-dict))
-
-(defn assoc-in!
-  "Associates a value in a nested associative structure, where ks is a
-  sequence of keys and v is the new value and returns a new nested structure.
-  If any levels do not exist, hash-maps will be created."
-  {:added  "1.0"
-   :static true}
-  [m [k & ks] v]
-  (if ks
-    (assoc! m k (assoc-in! (get m k) ks v))
-    (assoc! m k v)))

 (defn compute-path-value
   [path]
@@ -106,13 +37,10 @@
           (and prev-left-is-dead prev-right-is-dead))
       (if (not= prev-left-streak-type prev-right-streak-type)
         ; Types differents
-        (let [opl (if (= :min prev-left-streak-type) + +)
-              opr (if (= :min prev-right-streak-type) + +)]
+
           (+
-            (opl
               (cond
                 (not= :max prev-left-streak-type) 0
-
                 (= 4 prev-left-direct-streak) Double/POSITIVE_INFINITY
                 (and
                   (= 3 prev-left-direct-streak)
@@ -121,12 +49,11 @@
                   (= 0 prev-right-direct-streak)) 50000

                 (<= 4 (+ prev-left-streak-count prev-left-partial-streak-count)) (+ prev-left-direct-streak prev-left-streak-count)
-                :else 1))
-
-            (opr
+                :else 1)
+
               (cond

-                (not= :wall prev-right-streak-type) 0
+                (not= :max prev-right-streak-type) 0
                 (= 4 prev-right-direct-streak) Double/POSITIVE_INFINITY
                 (and
                   (= 3 prev-right-direct-streak)
@@ -136,23 +63,22 @@

                 (<= 4 (+ prev-right-streak-count prev-right-partial-streak-count))
                     (+ prev-right-direct-streak prev-right-streak-count)
-                :else 1))
-            ))
+                :else 1)
+            )
         ; Types identiques
-        (let [op (if (or (= :min prev-left-streak-type) (= :min prev-right-streak-type)) + +)]
-          (op (cond
-                (not= :max prev-left-streak-type) 0 ;
-                (= 4 (+ prev-left-direct-streak prev-right-direct-streak)) Double/POSITIVE_INFINITY
-
-                (and (= 3 (+ prev-left-direct-streak prev-right-direct-streak))
-                     (>= prev-right-partial-streak-count 1)
-                     (>= prev-left-partial-streak-count 1)) 50000
-                (<= 5 (+ prev-left-direct-streak prev-right-direct-streak)) 0
-
-                :else (+ prev-left-direct-streak
-                         prev-left-streak-count
-                         prev-right-direct-streak
-                         prev-right-streak-count)))))
+          (cond
+            (not= :max prev-left-streak-type) 0 ;
+            (= 4 (+ prev-left-direct-streak prev-right-direct-streak)) Double/POSITIVE_INFINITY
+
+            (and (= 3 (+ prev-left-direct-streak prev-right-direct-streak))
+                 (>= prev-right-partial-streak-count 1)
+                 (>= prev-left-partial-streak-count 1)) 50000
+            (<= 5 (+ prev-left-direct-streak prev-right-direct-streak)) 0
+
+            :else (+ prev-left-direct-streak
+                     prev-left-streak-count
+                     prev-right-direct-streak
+                     prev-right-streak-count)))

       (let [left (first left-part)
             right (first right-part)
@@ -208,15 +134,8 @@
           right-partial-streak-count
           right-direct-streak)))))

-(defn build-heuristic-dict-with-awesomeness
-  []
-  (persistent!
-    (reduce
-      (fn [col path]
-        (assoc-in! col path (compute-path-value path)))
-      (transient {})
-      []))
-  )
+(def compute-path-value (memoize compute-path-value))
+

 (def adjacent-transform
   (for [c1 (range -1 2)
@@ -230,6 +149,7 @@
          (< y 0)
          (>= x grid-w)
          (>= y grid-h))))
+(def in-bounds? (memoize in-bounds?))

 (defn gen-map-from-charmat
   "Generates map representation of blabla"
@@ -256,6 +176,7 @@
     (map
       #(map + point %)
       adjacent-transform)))
+(def gen-surrounding-points (memoize gen-surrounding-points))

 (defn gen-children-points
   [parent-state grid-w grid-h]
@@ -288,8 +209,8 @@
   {:v  x
    :h  y
    :d1 (- x y)
-   :d2 (- (dec grid-width) x y)}
-  )
+   :d2 (- (dec grid-width) x y)})
+(def line-index-from-point (memoize line-index-from-point))

 (defn gen-lines
   [points grid-w grid-h]
@@ -313,19 +234,14 @@
             (default-assoc h (indexes :h) x)
             (default-assoc v (indexes :v) y)
             (default-assoc d1 (indexes :d1) x)
-            (default-assoc d2 (indexes :d2) x)))))))        ; Todo: if it shits bricks, look here closely.
+            (default-assoc d2 (indexes :d2) x)))))))
+(def gen-lines (memoize gen-lines))
+

 (defn build-all-lines-from-state
   [state grid-w grid-h is-first-player]
-
   {:max (gen-lines (state is-first-player) grid-w grid-h)
-   :min (gen-lines (state (not is-first-player)) grid-w grid-h)}
-
-  ;{:max (gen-lines (state true) grid-w grid-h)
-  ; :min (gen-lines (state false) grid-w grid-h)}
-
-  ;
-  )
+   :min (gen-lines (state (not is-first-player)) grid-w grid-h)})

 (defn get-value-for-point
   [{max-lines :max min-lines :min}
@@ -399,79 +315,52 @@
   (or (= Double/POSITIVE_INFINITY (state :heuristic-result))
       (= Double/NEGATIVE_INFINITY (state :heuristic-result))))

-
-(defn- is-it-a-win?
-  ""
-  [grid-w grid-h state]
-  (let [point (state :last-move)
-        max-lines ((state :lines) :max)
-        min-lines ((state :lines) :min)
-        indexes (line-index-from-point point grid-w)
-        paths (map (fn [[linetype-max max-lines-for-type] [linetype-min min-lines-for-type]]
-                     (assert (= linetype-max linetype-min) (str "Map is not mixing the same lines - " linetype-max " with " linetype-min))
-                     (let [line-index (indexes linetype-max)
-                           max-line (or (max-lines-for-type line-index) #{})
-                           min-line (or (min-lines-for-type line-index) #{})
-                           ]
-
-                       (map
-                         (fn [[nx ny :as new-point]]
-                           (let [index-in-line (if (= linetype-max :v) ny nx)]
-                             (cond
-                               (not (in-bounds? grid-w grid-h new-point)) :wall
-                               (contains? max-line index-in-line) :max
-                               (contains? min-line index-in-line) :min
-                               :else :empty)))
-                         (map (partial map + point) (directors linetype-max)))))
-                   max-lines min-lines)]
-    (boolean (some true? (map (fn [path]
-                                (let [parts (partition 5 1 (assoc (into [] path) 5 :max))]
-                                  (reduce #(or %1
-                                               (apply (partial = :max) %2))
-                                          false
-                                          parts)
-                                  )) paths)))))
-
 (defn- negamax-inner
   ""
-  [state alpha beta got-time? is-first-player max-depth grid-width grid-height]
+  [state alpha beta got-time? is-first-player depth max-depth grid-width grid-height]
+
+  (when (not @got-time?)
+    (throw (TimeoutException. "Timeout!")))
+

   (if (empty? (state true))
     {:best-move [(long (/ grid-width 2)) (long (/ grid-height 2))]}
-    (if (and (is-terminal-state? state))
+    (if (is-terminal-state? state)
         {:best-move  (state :last-move)
          :best-value (state :heuristic-result)}

-      (if (= max-depth 0)
+      (if (= depth 0)
         {:best-move  (state :last-move)
-         :best-value (state :heuristic-result)
-         :who-win?   nil}
+         :best-value (- (state :heuristic-result))}

         (loop
-            [sucessors (generate-successor-states state grid-width grid-height (not is-first-player)) ; Flip is first player.
+            [sucessors (generate-successor-states state grid-width grid-height is-first-player) ; Flip is first player.
              best {:best-value Double/NEGATIVE_INFINITY
-                   :best-move  []
-                   :who-win?   nil}
+                   :best-move  nil}
              alpha alpha]

           (if (empty? sucessors)
             best
-            (let [{child-best-move :best-move tmp-child-best-value :best-value who-win? :who-win?} (negamax-inner (first (first sucessors))
-                                                                                (- beta)
-                                                                                (- alpha)
-                                                                                got-time?
-                                                                                (not is-first-player)
-                                                                                (dec max-depth)
-                                                                                grid-width
-                                                                                grid-height)
+            (let [{child-best-move      :best-move
+                   tmp-child-best-value :best-value :as child-stats} (negamax-inner (key (first sucessors))
+                                                                  (- beta)
+                                                                  (- alpha)
+                                                                  got-time?
+                                                                  (not is-first-player)
+                                                                  (dec depth)
+                                                                  max-depth
+                                                                  grid-width
+                                                                  grid-height)
                   child-best-value (- tmp-child-best-value)]
-
+              ;(if (= max-depth depth) (clojure.pprint/pprint child-stats))
                   (if (> child-best-value (best :best-value))
-                    (let [best {:best-value child-best-value :best-move child-best-move :who-win? who-win?}]
+                    (let [best {:best-value child-best-value :best-move ((key (first sucessors)) :last-move)}]
                       (if (> (best :best-value) alpha)
                         (let [alpha (best :best-value)]
                           (if (>= alpha beta)
-                            best
+                            (do
+                              best
+                              )
                             (recur (rest sucessors) best alpha)))
                         (recur (rest sucessors) best alpha)))
                     (recur (rest sucessors) best alpha)))))))))
@@ -479,26 +368,33 @@
 (defn negamax
   ""
   [is-first-player state got-time? grid-width grid-height ret-chan]
-  (loop
-      [deepness 1]
-
-    (if (and @got-time? (< deepness 10))
-      (let [point (negamax-inner state
-                               Double/NEGATIVE_INFINITY
-                               Double/POSITIVE_INFINITY
-                               got-time?
-                               is-first-player
-                               deepness         ; Steps
-                               grid-width grid-height)]
-        (when (not (empty? (point :best-move)))
-          (async/>!! ret-chan point))
-        (recur (inc deepness))))))
+  (try
+    (loop
+        [deepness 1]
+      (prn "deepness" deepness @got-time?)
+      (if (and @got-time?)
+        (let [point (negamax-inner state
+                                   Double/NEGATIVE_INFINITY
+                                   Double/POSITIVE_INFINITY
+                                   got-time?
+                                   is-first-player
+                                   deepness                 ; Steps
+                                   deepness
+                                   grid-width grid-height)]
+          (when (not (empty? (point :best-move)))
+            (async/>!! ret-chan point))
+          (recur (inc deepness)))
+
+        nil))
+    (catch TimeoutException e (prn "done"))
+
+  ))

 (defn -getNextMove
   "Gets the next best move"
   [charmat timeout]
   (let [ret-chan (async/chan (async/sliding-buffer 1))
-        timeout-chan (async/timeout (- timeout 5))
+        timeout-chan (async/timeout (- timeout 10))
         got-time? (atom true)
         charmat-seq (lazy-seq charmat)
         state (gen-map-from-charmat charmat-seq {true #{} false #{}} 0)
@@ -516,8 +412,7 @@

     ; Block on the timeout channel
     (async/<!! timeout-chan)
-
+    (swap! got-time? (fn [lastval] false))
     (let [{decision :best-move} (async/<!! ret-chan)]
-      (swap! got-time? (fn [lastval] false))
       (prn "sent:" decision)
       (into [] decision))))


add coloring for each piece type

add coloring for each piece type


This is a string not a symbol

This is a string not a symbol

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -86,7 +86,7 @@
     (api/write-meta config
                     (t/->Def groupid artifactid version "clojure.core" (name sym))
                     {:ns       "clojure.core"
-                     :name     (name sym)
+                     :name     sym
                      :doc      doc
                      :arglists forms
                      :src      ";; Special forms have no source"


Baseline version of calc-info-bits (lines only)

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -160,7 +160,7 @@
     (main all-words) )
   ( [game-words]
     (do-tests)
-    (let [tgt-word      "comaker"
+    (let [tgt-word      "uniformed"
           words-map     (group-by count game-words)  ; map keyed by word length
           word-list     (words-map (count tgt-word)) ; words of correct length
       ]


More things

More things

--- sound-tracker/project.clj
+++ sound-tracker/project.clj
@@ -9,7 +9,13 @@
                  [org.postgresql/postgresql "9.4-1201-jdbc41"]
                  [ring/ring-defaults "0.2.1"]]
   :plugins [[lein-ring "0.9.7"]]
-  :ring {:handler sound-tracker.handler/app}
+  :ring {:handler sound-tracker.handler/app
+         :ssl? true
+         :port 3000
+         :ssl-port 8002
+         :keystore "/home/patience/ssl/keystore.jks"
+         :key-password "password"
+         }
   :profiles
   {:dev {:dependencies [[javax.servlet/servlet-api "2.5"]
                         [ring/ring-mock "0.3.0"]]}})


Use new option name.

Use new option name.


Clean up (simplify) server code

Clean up (simplify) server code

Change-Id: Id8558449397234e11fef4e7dfacdcd9af6d4b433


Update beicon to 3.1.1

Update beicon to 3.1.1

Fix some uxbox bugs.

--- frontend/project.clj
+++ frontend/project.clj
@@ -28,7 +28,7 @@
                  [funcool/potok "2.0.0"]
                  [funcool/struct "1.0.0"]
                  [funcool/lentes "1.2.0"]
-                 [funcool/beicon "3.1.0"]
+                 [funcool/beicon "3.1.1"]
                  [funcool/cuerdas "2.0.3"]
                  [funcool/bide "1.4.0"]]
   :plugins [[lein-ancient "0.6.10"]]


drop namespaces on load

drop namespaces on load

--- clojure/src/dataloader/core.clj
+++ clojure/src/dataloader/core.clj
@@ -35,7 +35,7 @@

 (ns dataloader.core
   (:require [monger.core :as mg])
-  (:use [monger.collection :only [insert]])
+  (:require [monger.collection :as coll])
   (:import [com.mongodb MongoOptions ServerAddress]
            [org.bson.types ObjectId])
   (:gen-class))
@@ -113,11 +113,11 @@
   (def residx (System/getenv "_ENV_BEL_RESIDX"))

   (if (nil? host)
-    (println "no _ENV_MONGO_HOST is set"))
+    (outln "no _ENV_MONGO_HOST is set"))
   (if (nil? db)
-    (println "no _ENV_MONGO_DB is set"))
+    (outln "no _ENV_MONGO_DB is set"))
   (if (nil? residx)
-    (println "no _ENV_BEL_RESIDX is set"))
+    (outln "no _ENV_BEL_RESIDX is set"))
   (if (nil? (or host db residx))
     (System/exit 1))

@@ -125,10 +125,13 @@
   ; connect to MongoDB and set the database
   (mg/connect! { :host host })
   (mg/set-db! (mg/get-db db))
-  (println "okay")
+  (outln "okay")
+  (out "Dropping namespaces... ")
+  (coll/drop "namespaces")
+  (outln "okay")
   (doseq [x (namespace-urls residx)]
     (out (str x "... "))
     (download-ns x "temp.belns")
-    (insert "namespaces" (parse-namespace "temp.belns"))
+    (coll/insert "namespaces" (parse-namespace "temp.belns"))
     (outln "okay"))
   (mg/disconnect!))


core.clj; include url on ns and anno meta docs

--- clojure/src/dataloader/core.clj
+++ clojure/src/dataloader/core.clj
@@ -192,7 +192,7 @@
     (download-url x "temp.belns")
     (def nsmap (parse-namespace "temp.belns"))
     (def nsmeta-id (ObjectId.))
-    (def nsmeta-doc (assoc (dissoc nsmap :values) :_id nsmeta-id))
+    (def nsmeta-doc (assoc (dissoc nsmap :values) :_id nsmeta-id :url x))
     (coll/insert "namespaces" nsmeta-doc)
     (doseq [value (nsmap :values)]
       (def nsval-id (ObjectId.))
@@ -207,7 +207,7 @@
     (download-url x "temp.belanno")
     (def annomap (parse-annotation "temp.belanno"))
     (def annometa-id (ObjectId.))
-    (def annometa-doc (assoc (dissoc annomap :values) :_id annometa-id))
+    (def annometa-doc (assoc (dissoc annomap :values) :_id annometa-id :url x))
     (coll/insert "annotations" annometa-doc)
     (doseq [value (annomap :values)]
       (def annoval-id (ObjectId.))


Tweak gamepad harness.

Tweak gamepad harness.

--- test/org/playasophy/wonderdome/input/gamepad_harness.clj
+++ test/org/playasophy/wonderdome/input/gamepad_harness.clj
@@ -8,29 +8,37 @@
 (def system nil)

+(defn init!
+  "Initializes the gamepad harness."
+  []
+  (when-not system
+    (alter-var-root #'system
+      (constantly
+        (let [channel (async/chan (async/dropping-buffer 5))]
+          (if-let [input (gamepad/snes channel)]
+            (component/system-map
+              :channel channel
+              :input input
+              :process
+              (async/go-loop []
+                (prn (<! channel))
+                (recur)))
+            (println "No USB input device found!")))))))
+
+
 (defn start!
   "Creates and starts a gamepad input component attached to a channel and reader
   which will print events received to the console."
   []
-  (if system
-    (alter-var-root #'system
-      update-in [:input] component/start)
-    (alter-var-root #'system
-      (constantly
-        (let [channel (async/chan (async/dropping-buffer 5))]
-          (if-let [input (gamepad/snes channel)]
-            {:input (component/start input)
-             :channel channel
-             :process (async/go-loop []
-                        (prn (<! channel))
-                        (recur))}
-            (println "No USB input device found!"))))))
+  (when-not system
+    (init!))
+  (alter-var-root #'system component/start)
   :start)

 (defn stop!
-  "Stops the wonderdome system and closes the display window."
+  "Stops the gamepad harness from reporting events."
   []
   (when system
-    (alter-var-root #'system update-in [:input] component/stop))
+    (alter-var-root #'system component/stop))
   :stop)


Add repl utils

Add repl utils

--- src/time_tracker/core.clj
+++ src/time_tracker/core.clj
@@ -13,15 +13,32 @@
 (defn teardown! []
   (log/teardown-logging!))

-(defn start-server! []
-  (init!)
-  (log/info {:event ::server-start})
-  (let [stop-fn
-        (httpkit/run-server (web-service/app) {:port (Integer/parseInt (util/from-config :port))})]
-    (fn []
-      (stop-fn)
-      (log/info {:event ::server-stop})
-      (teardown!))))
+(defn start-server!
+  ([] (start-server! (web-service/app)))
+  ([app-handler]
+   (init!)
+   (log/info {:event ::server-start})
+   (let [stop-fn (httpkit/run-server app-handler
+                                     {:port (Integer/parseInt (util/from-config :port))})]
+     (fn []
+       (stop-fn)
+       (log/info {:event ::server-stop})
+       (teardown!)))))
+
+(defonce server-stop-fn (atom nil))
+
+(defn repl-start-server! []
+  (let [stop-fn (start-server!)]
+    (swap! server-stop-fn (constantly stop-fn))))
+
+(defn repl-stop-server! []
+  (when @server-stop-fn
+    (@server-stop-fn)
+    (reset! server-stop-fn nil)))
+
+(defn repl-restart-server! []
+  (repl-stop-server!)
+  (repl-start-server!))

 (defn- start-server-as-gid!
   "Starts the server and ensures that requests are always
@@ -29,11 +46,11 @@
   Returns a fuction to reset the var and stop the server."
   [google-id name]
   (let [reset-auth-var-fn (util/rebind-var!
-                           (var time-tracker.auth.core/auth-credentials)
-                           (constantly {:sub  google-id
-                                        :name name
-                                        :hd   "nilenso.com"}))
-        stop-server-fn    (start-server!)]
+                            (var time-tracker.auth.core/auth-credentials)
+                            (constantly {:sub  google-id
+                                         :name name
+                                         :hd   "nilenso.com"}))
+        stop-server-fn (start-server!)]
     (fn []
       (stop-server-fn)
       (reset-auth-var-fn))))


No need to explicitly set first instrument as first filename metric will force same

--- src/aeolian/midi/core.clj
+++ src/aeolian/midi/core.clj
@@ -8,8 +8,7 @@
 (def four-beat-metro (str "%%MIDI drum dzdzdzdz " beat " " beat " " beat " " beat " ""\n"))
 (def no-accents "%%MIDI nobeataccents\n")
 (def first-beat-emphasis "%%MIDI beatstring pmmm\n")
-(def starting-instrument "%%MIDI program 32\n")
-(def header (str starting-instrument first-beat-emphasis four-beat-metro no-accents "%%MIDI drumon\n%%MIDI gchord c\n"))
+(def header (str first-beat-emphasis four-beat-metro no-accents "%%MIDI drumon\n%%MIDI gchord c\n"))

 (def flute 73)
 (def voice 53)


Use proper base64 encoding on codecs ns.

--- src/buddy/core/codecs.clj
+++ src/buddy/core/codecs.clj
@@ -48,15 +48,15 @@

 (defn bytes->base64
   "Encode a bytes array to base64
-and return utf8 string."
+  and return utf8 string."
   [^bytes data]
-  (Base64/encodeBase64URLSafeString data))
+  (Base64/encodeBase64String data))

 (defn bytes->bbase64
   "Encode a bytes array to base64 and
-return bytearray."
+  return bytearray."
   [^bytes data]
-  (Base64/encodeBase64URLSafe data))
+  (Base64/encodeBase64 data))

 (defn base64->bytes
   "Decode from base64 to bytes."
@@ -67,7 +67,7 @@
   "Encode to urlsafe base64."
   [^String s]
   (-> (str->bytes s)
-      (Base64/encodeBase64URLSafeString)
+      (Base64/encodeBase64String)
       (str/trim)))

 (defn base64->str


Update copyright year on crypto ns.

Update copyright year on crypto ns.

--- src/buddy/core/crypto.clj
+++ src/buddy/core/crypto.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) 2013-2015 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2013-2016 Andrey Antukh <niwi@niwi.nz>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


(PE-3917) simplified expression

(PE-3917) simplified expression

--- src/clj/puppetlabs/master/services/jruby/jruby_puppet_core.clj
+++ src/clj/puppetlabs/master/services/jruby/jruby_puppet_core.clj
@@ -199,8 +199,7 @@
   create-pool-from-config :- PoolData
   "Create a new PoolData based on the config input."
   [{:keys [environment size]} :- PoolDefinition]
-  (let [size (if size size
-                      default-pool-size)]
+  (let [size (or size default-pool-size)]
     {:environment  (keyword environment)
      :pool         (instantiate-free-pool size)
      :size         size


fix syntax error

fix syntax error

--- src/cljs/vismod_reframe/solvers/multiplicative_order/core.cljs
+++ src/cljs/vismod_reframe/solvers/multiplicative_order/core.cljs
@@ -7,7 +7,7 @@

 (defn point-ring [point-count size]
-  (let [step (/ (2 * Math/PI) point-count)
+  (let [step (/ (* 2 Math/PI) point-count)
         half-pi (/ Math/PI 2)]
     (for [i (range point-count)
           :let [angle (- (* i step) half-pi)]]


Versio 1.0.0

Versio 1.0.0

--- mtg-pairings-server/project.clj
+++ mtg-pairings-server/project.clj
@@ -1,4 +1,4 @@
-(defproject mtg-pairings-server "0.2.0"
+(defproject mtg-pairings-server "1.0.0"
   :license {:name "MIT License"
             :url "http://www.opensource.org/licenses/mit-license.php"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Make compatible with graalvm (#543)

Make compatible with graalvm (#543)

--- src/clj_http/conn_mgr.clj
+++ src/clj_http/conn_mgr.clj
@@ -49,10 +49,10 @@
      (SSLIOSessionStrategy. ^SSLContext context ^HostnameVerifier verifier))))

 (def ^:private ^SSLConnectionSocketFactory secure-ssl-socket-factory
-  (SSLConnectionSocketFactory/getSocketFactory))
+  (delay (SSLConnectionSocketFactory/getSocketFactory)))

 (def ^:private ^SSLIOSessionStrategy secure-strategy
-  (SSLIOSessionStrategy/getDefaultStrategy))
+  (delay (SSLIOSessionStrategy/getDefaultStrategy)))

 (defn ^SSLConnectionSocketFactory SSLGenericSocketFactory
   "Given a function that returns a new socket, create an
@@ -178,16 +178,16 @@
        (.build))))

 (def ^:private regular-scheme-registry
-  (-> (RegistryBuilder/create)
-      (.register "http" (PlainConnectionSocketFactory/getSocketFactory))
-      (.register "https" secure-ssl-socket-factory)
-      (.build)))
+  (delay (-> (RegistryBuilder/create)
+             (.register "http" (PlainConnectionSocketFactory/getSocketFactory))
+             (.register "https" @secure-ssl-socket-factory)
+             (.build))))

 (def ^:private regular-strategy-registry
-  (-> (RegistryBuilder/create)
-      (.register "http" NoopIOSessionStrategy/INSTANCE)
-      (.register "https" secure-strategy)
-      (.build)))
+  (delay (-> (RegistryBuilder/create)
+             (.register "http" NoopIOSessionStrategy/INSTANCE)
+             (.register "https" @secure-strategy)
+             (.build))))

 (defn ^Registry get-custom-scheme-registry
   [{:keys [context verifier]}]
@@ -245,7 +245,7 @@
                        (opt req :insecure) (BasicHttpClientConnectionManager.
                                             @insecure-scheme-registry)

-                       :else (BasicHttpClientConnectionManager. regular-scheme-registry))]
+                       :else (BasicHttpClientConnectionManager. @regular-scheme-registry))]
     (when socket-timeout
       (.setSocketConfig conn-manager
                         (-> (.getSocketConfig conn-manager)
@@ -286,7 +286,7 @@
                              (opt req :insecure)
                              @insecure-strategy-registry

-                             :else regular-strategy-registry)
+                             :else @regular-strategy-registry)
         io-reactor (make-ioreactor {:shutdown-grace-period 1})]
     (doto (PoolingNHttpClientConnectionManager. io-reactor registry)
       (.setMaxTotal 1))))
@@ -312,7 +312,7 @@
                    (or keystore trust-store)
                    (get-keystore-scheme-registry config)

-                   :else regular-scheme-registry)]
+                   :else @regular-scheme-registry)]
     (PoolingHttpClientConnectionManager.
      registry nil nil nil timeout java.util.concurrent.TimeUnit/SECONDS)))

@@ -375,7 +375,7 @@
                    (or keystore trust-store)
                    (get-keystore-scheme-registry config)

-                   :else regular-strategy-registry)
+                   :else @regular-strategy-registry)
         io-reactor (make-ioreactor io-config)
         protocol-handler (HttpAsyncRequestExecutor.)
         io-event-dispatch (DefaultHttpClientIODispatch. protocol-handler


Fix typos

Fix typos

--- src/cljam/algo/pileup.clj
+++ src/cljam/algo/pileup.clj
@@ -77,7 +77,7 @@
            (<= min-mapq (.mapq aln))))))

 (defn resolve-base
-  "Find a piled-up base and an indel from a alignment."
+  "Find a piled-up base and an indel from an alignment."
   [^long ref-pos ^SAMAlignment aln]
   (let [relative-pos (- ref-pos (.pos aln))
         qual ((:quals-at-ref aln) relative-pos)
@@ -168,7 +168,7 @@
                    (keep (partial ->locus-pile chr)))))))))

 (defn align-pileup-seqs
-  "Align multiple pileed-up seqs."
+  "Align multiple piled-up seqs."
   [& xs]
   (if (<= (count xs) 1)
     (map (fn [{:keys [pos] :as m}] [pos [m]]) (first xs))


save handler clean up

save handler clean up

--- src/cljs/hit_wl/core.cljs
+++ src/cljs/hit_wl/core.cljs
@@ -111,6 +111,19 @@
       "Add Workout"])
    [draw-table (:workouts state-dict)]])

+(defn append-new-workout []
+  (let [new-workouts (conj (:workouts @state)
+                           (->> (:edited-workout @state)
+                                (map (fn [[k v]] [(name k) (str v)]))
+                                (into {:is-new? true})))]
+                          ;; (.log js/console (str  new-workouts))
+                          ;;(.log js/console (str @state))
+                                        ;transact!
+    (swap! state assoc :workouts new-workouts)
+    (swap! state assoc :edited-workout {})
+    (swap! state update-in [:add-edit-workout-open?] not)
+    (.log js/console (str (:workouts @state)))))
+
 (def edit-workout-form-template
   [:div
    (row "Date" [:datepicker {:field :datepicker :id :edited-workout.date}])
@@ -125,17 +138,7 @@
      [:option {:key :pull-back} "Pull back"]]
     [:button {:type "submit"
               :class "btn btn-default"
-              :onClick #(let [new-workouts (conj (:workouts @state)
-                                                 (->> (:edited-workout @state)
-                                                      (map (fn [[k v]] [(name k) (str v)]))
-                                                      (into {:is-new? true})))]
-                          ;; (.log js/console (str  new-workouts))
-                          ;;(.log js/console (str @state))
-                                        ;transact!
-                          (swap! state assoc :workouts new-workouts)
-                          (swap! state assoc :edited-workout {})
-                          (swap! state update-in [:add-edit-workout-open?] not)
-                          (.log js/console (str (:workouts @state))))
+              :onClick append-new-workout
               }
      "Add"]]])


TEMPORARILY disable exception for duplicate instruction definition

--- src/clojush/pushstate.clj
+++ src/clojush/pushstate.clj
@@ -38,7 +38,7 @@
 (defn register-instruction
   "Add the provided name to the global list of registered instructions."
   [name]
-  (if (some #{name} @registered-instructions)
+  (if false ;;(some #{name} @registered-instructions) ;*****TEMPORARY*****
     (throw (Exception. (str "Duplicate Push instruction defined:" name)))
     (swap! registered-instructions conj name)))


test deletion of placeholder sections

test deletion of placeholder sections

--- test/open_company/integration/section/section_manipulation.clj
+++ test/open_company/integration/section/section_manipulation.clj
@@ -39,7 +39,8 @@

 (def categories (map name open-company.resources.common/category-names))

-(with-state-changes [(before :facts (do (company/delete-all-companies!)
+(with-state-changes [(around :facts (schema.core/with-fn-validation ?form))
+                     (before :facts (do (company/delete-all-companies!)
                                         (company/create-company r/open r/coyote)
                                         (section/put-section r/slug :update r/text-section-1 r/coyote)
                                         (section/put-section r/slug :finances r/finances-section-1 r/coyote)
@@ -155,6 +156,33 @@

     (future-facts "when the new order is NOT valid"))

+  (facts "about placeholder section removal"
+    (let [slug     "hello-world"
+          payload  {:name "Hello World" :description "x"}
+          response (mock/api-request :post "/companies" {:body payload})
+          company  (company/get-company slug)]
+      ;; ensure all placeholder sections are in company
+      (:sections company) => {:progress ["update" "growth" "challenges" "team" "product"]
+                              :financial ["finances"]
+                              :company ["values" "mission"]}
+      (:growth company) => truthy
+      (:challenges company) => truthy
+      (:team company) => truthy
+      (:product company) => truthy
+      (:mission company) => truthy
+      (let [new-set {:progress ["update" "finances" "help"]
+                     :company ["values"]}
+            response (mock/api-request :patch (company-rep/url slug) {:body {:sections new-set}})
+            body     (mock/body-from-response response)
+            company  (company/get-company slug)]
+        (:status response) => 200
+        (:sections company) => new-set
+        (:growth company) => falsey
+        (:challenges company) => falsey
+        (:team company) => falsey
+        (:product company) => falsey
+        (:mission company) => falsey)))
+
   (facts "about section removal"

     ;; verify the initial set of sections
@@ -252,4 +280,4 @@
           (:team db-company) => nil
           (:help db-company) => (contains r/text-section-1)
           (:diversity db-company) => nil
-          (:values db-company) => (contains r/text-section-1)))))+          (:values db-company) => (contains r/text-section-1)))))


Output to rotored log as well as standard out

--- src/leiningen/new/onyx_app/src/onyx_app/launcher/launch_prod_peers.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/launcher/launch_prod_peers.clj
@@ -6,6 +6,7 @@
             [onyx.plugin.kafka]
             [onyx.plugin.sql]
             {{#docker?}}[taoensso.timbre :as t]{{/docker?}}
+            {{#docker?}}[taoensso.timbre.appenders.3rd-party.rotor :as rotor]{{/docker?}}
             {{#metrics?}}[onyx.lifecycle.metrics.metrics]{{/metrics?}}
             {{#metrics?}}[onyx.lifecycle.metrics.timbre]{{/metrics?}}))

@@ -20,6 +21,11 @@
         config (read-config (clojure.java.io/resource "config.edn") {:profile :default})
         peer-config (-> (:peer-config config)
                         {{#docker?}}(assoc :onyx.log/config {:appenders
+                                                             :rotor (-> (rotor/rotor-appender
+                                                                          {:path "onyx.log"
+                                                                           :max-size (* 512 102400)
+                                                                           :backlog 5})
+                                                                        (assoc :min-level :info))
                                                              {:standard-out
                                                               {:enabled? true
                                                                :async? false


upgrade lein-cljsbuild to 1.0.6 upgrade lein-figwheel to 0.3.3

--- examples/hello-famous/project.clj
+++ examples/hello-famous/project.clj
@@ -11,8 +11,8 @@
                            [com.famous/famous "0.5.1"]
                            [reagent "0.5.0"]]

-            :plugins [[lein-cljsbuild "1.0.4"]
-                      [lein-figwheel "0.2.5"]]
+            :plugins [[lein-cljsbuild "1.0.6"]
+                      [lein-figwheel "0.3.3"]]

             :source-paths ["src"]
             :resource-paths ["/home/ssd2/sto/workspace/reagent/target/reagent-0.5.1-SNAPSHOT-standalone.jar" "resources"]


Print some diagnostics if sending an email fails. Might help debugging #86, but more likely will just make it easier to manually reset passwords until we get it figured out

--- src/foreclojure/login.clj
+++ src/foreclojure/login.clj
@@ -4,7 +4,9 @@
         hiccup.page-helpers
         [foreclojure utils config users]
         compojure.core
-        [amalloy.utils :only [rand-in-range]]
+        [amalloy.utils :only [rand-in-range keywordize]]
+        [clojail.core :only [thunk-timeout]]
+        clojure.stacktrace
         somnium.congomongo)
   (:require [sandbar.stateful-session :as session]
             [ring.util.response :as response]))
@@ -87,30 +89,52 @@
        (text-field :email)
        [:button {:type "submit"} "Reset!"])]]])

-(def pw-chars "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVWXY1234567890")
+(let [pw-chars "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVWXY1234567890"]
+  (defn random-pwd []
+    (let [pw (apply str
+                    (repeatedly 10 #(rand-nth pw-chars)))
+          hash (.encryptPassword (StrongPasswordEncryptor.) pw)]
+      (keywordize [pw hash]))))
+
+(defn try-to-email [email name id]
+  (let [{:keys [pw hash]} (random-pwd)]
+    (try
+      (thunk-timeout
+       (fn []
+         (update! :users
+                  {:_id id}
+                  {:$set {:pwd hash}})
+         (send-email
+          {:from "team@4clojure.com"
+           :to [email]
+           :subject "Password reset"
+           :body
+           (str "The password for your 4clojure.com account "
+                name " has been reset to " pw ". Make sure to change it"
+                " soon at https://4clojure.com/login/update - pick"
+                " something you'll remember!")})
+         {:success true})
+       10 :sec)
+      (catch Throwable t
+        {:success false, :exception t,
+         :message (.getMessage t),
+         :trace (with-out-str
+                  (binding [*err* *out*]
+                    (print-cause-trace t)))
+         :pw pw, :hash hash}))))

 (defn do-reset-password! [email]
   (if-let [{id :_id, name :user} (fetch-one :users
                                             :where {:email email}
                                             :only [:_id :user])]
-    (let [pw (apply str
-                    (repeatedly 10 #(rand-nth pw-chars)))
-          pw-hash (.encryptPassword (StrongPasswordEncryptor.) pw)]
-      (update! :users
-               {:_id id}
-               {:$set {:pwd pw-hash}})
-      (send-email
-       {:from "team@4clojure.com"
-        :to [email]
-        :subject "Password reset"
-        :body
-        (str "The password for your 4clojure.com account "
-             name " has been reset to " pw ". Make sure to change it"
-             " soon at https://4clojure.com/login/update - pick"
-             " something you'll remember!")})
-      (session/session-put! :login-to "/login/update")
-      (flash-msg "Your password has been reset! You should receive an email soon"
-                 (login-url "/login/update")))
+    (let [{:keys [success] :as diagnostics} (? (try-to-email email name id))]
+      (if success
+        (do (session/session-put! :login-to "/login/update")
+            (flash-msg "Your password has been reset! You should receive an email soon."
+                       (login-url "/login/update")))
+        (do (spit (? (str name ".pwd")) (? diagnostics))
+            (flash-error (str "Something went wrong emailing your new password! Please contact team@4clojure.com - we'll reset it manually and look into the problem. When you do, please mention your username.")
+                         "/login/reset"))))
     (flash-error "We don't know anyone with that email address!"
                  "/login/reset")))


removed unnecessary print statement

removed unnecessary print statement

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -112,7 +112,6 @@
 (defn upload-added-watch-fn! [_ _ old-state new-state]
   (let [new-upload-ids (clojure.set/difference (set (keys (:uploads new-state)))
                                                (set (keys (:uploads old-state))))]
-    (println "NEW UPLOAD IDS" new-upload-ids)
     (if-not (empty? new-upload-ids)
       (swap! app-state/app-state
              assoc


Fix path to the minified rxjs bundled file.

--- assets/deps.cljs
+++ assets/deps.cljs
@@ -1,5 +1,5 @@
 {:foreign-libs
  [{:file "_rxjs/rx.all.js"
-   :file-min "_rxjs/rx.all.minjs"
+   :file-min "_rxjs/rx.all.min.js"
    :provides ["beicon.extern.rxjs"]}]
  :externs ["_rxjs/externs.js"]}


implemented new tag style

implemented new tag style

--- src-cljs/pepa/style.cljs
+++ src-cljs/pepa/style.cljs
@@ -29,8 +29,9 @@
 (def default-text grey-2)

 (def tags-text default-text)
-(def tags-background "#e8eaea")
+(def tags-background dark-background)
 (def tags-selected-background light-blue-background)
+(def tags-border "#e8e8e8")

 (def border-light "#f0f0f0")
 (def border-dark "#cbcbcb")
@@ -230,7 +231,8 @@
                         ;; Not sure if this is a good idea
                         :font-size (px color-size)
                         :line-height (px color-size)
-                        :height (px color-size)}
+                        :height (px color-size)
+                        :border :none}
                [:.tag-name {:position :absolute
                             :top "50%" :transform "translateY(-50%)"
                             :overflow :hidden
@@ -239,7 +241,8 @@
                          :padding {:left (px 4), :right (px 4)}}]
                [:.color {:width (px color-size)
                          :height (px color-size)
-                         :float :right}]])]
+                         :float :right
+                         :border-radius "50%"}]])]
            [:.show-more {:font-weight :bold
                          :font-size (px 10)
                          :cursor :pointer}]]
@@ -495,7 +498,9 @@

 (def generic-sidebar-css
   [:.sidebar
-   [:aside {:padding {:left (px 25)
+   [:aside {:display :flex
+            :flex-direction :column
+            :padding {:left (px 25)
                       :right (px 25)}}
     [:ul.meta {:font-size (pt 10)
                :line-height (pt 15)
@@ -513,7 +518,14 @@
                     :overflow :hidden
                     :vertical-align :top
                     :text-overflow :ellipsis}
-                   (calc-property :width ["70%" - left-padding]))])]]]])
+                   (calc-property :width ["70%" - left-padding]))])]]
+    [:.buttons {:display :flex
+                :flex-direction :column
+                :justify-content :space-between
+                :flex-wrap :wrap}
+     [:button {:margin-top (px 10)
+               :flex-grow 1
+               }]]]])

 (def workflow-css
   [:.workflow {:height "100%" :width "100%"
@@ -545,44 +557,56 @@
                :min-height (px tags-min-height)
                :line-height (px (+ 2 tags-min-height))}
      [:&.editable (list
-                   {:padding-left (px tag-icon-box)
+                   {:padding {:left (px tag-icon-box)
+                              :top (px 6)}
                     :border (str "1px solid " border-dark)
                     :border-radius (px 3)
                     :height :auto
                     :background {:image (image-url "tag-icon.svg")
                                  :repeat :no-repeat
                                  :size (px 14)
-                                 :position [[(px 4) (px 4)]]
+                                 :position [[(px 8) (px 8)]]
                                  :color :white}
                     :white-space :initial}
                    (calc-property :width ["100%" -  (px tag-icon-box)]))
       [:&:before {:content (pr-str "Tags:")
-                  :font-size (em 1.2)}]]
-     (let [tag-height 16]
+                  :font-size (em 1.2)
+                  :display :block
+                  :float :left
+                  :line-height (px 18)
+                  :margin-left (px 2)
+                  }]]
+     (let [tag-height 15
+           tag-inner-margin 2
+           radius  (px 5)]
        [:li.tag {:display :inline-block
                  :background-color tags-background
                  :height (px tag-height)
-                 :padding {:left (px 4)
-                           :right (px 4)}
-                 :margin {:left (px 2)
-                          :right (px 2)}
+                 :padding {:right (px 10)}
+                 :margin {:left (px tag-inner-margin)
+                          :right (px tag-inner-margin)}
                  :color tags-text
-                 :line-height (px tag-height)
+                 :border (str "1px solid " tags-border)
                  :text-decoration :none
                  :outline :none
-                 :border-radius (em 0.5)}
-        [:&.selected {:background-color tags-selected-background
-                      :border (str "1px solid" border-dark)
-                      :padding {:left (px 3)
-                                :right (px 3)}}]
+                 :overflow :hidden
+                 :border-radius radius}
+        [:a {:display :block
+             :height "100%"}]
+        [:.tag-name {:margin-left (px tag-inner-margin)
+                     :line-height (px tag-height)
+                     :height (px tag-height)
+                     :display :inline-block
+                     :vertical-align :top}]
+        [:&.selected {:background-color tags-selected-background}]
         (let [color-size 8]
+
           [:.color {:display :inline-block
-                    :height (px color-size)
-                    :width (px color-size)
-                    :margin-right (px 2)
+                    :height (px tag-height)
+                    :width (px tag-height)
+                    :margin-right (px tag-inner-margin)
                     ;; Border looks horrible on non-high-DPI screens
                     ;; :border "1px solid white"
-                    :border-radius "50%"
                     }])])
      (let [input-padding 5]
        [:li {:display :inline-block}


improve error handling when calculating effective image (#1742)

* turn on calculate-effective-image for all jobs

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -54,6 +54,11 @@
         "exec 2>$COOK_SANDBOX/stderr; "
         "exec /bin/sh -c \"$1\"")
    "--"])
+
+(defn synthetic-pod?
+  "Given a pod name, returns true if it has the synthetic pod prefix"
+  [pod-name]
+  (str/starts-with? pod-name cook-synthetic-pod-name-prefix))

 ; DeletionCandidateTaint is a soft taint that k8s uses to mark unneeded
 ; nodes as preferably unschedulable. This taint is added as soon as the
@@ -805,7 +810,10 @@
         {:keys [custom-shell init-container set-container-cpu-limit? sidecar]} (config/kubernetes)
         checkpoint (calculate-effective-checkpointing-config job task-id)
         job-submit-time (tools/job->submit-time job)
-        image (calculate-effective-image (config/kubernetes) job-submit-time image checkpoint task-id)
+        pod-name (str task-id)
+        image (if (synthetic-pod? pod-name)
+                image
+                (calculate-effective-image (config/kubernetes) job-submit-time image checkpoint task-id))
         checkpoint-memory-overhead (:memory-overhead checkpoint)
         use-cook-init? (and init-container pod-supports-cook-init?)
         use-cook-sidecar? (and sidecar pod-supports-cook-sidecar?)
@@ -847,7 +855,7 @@
         computed-mem (if checkpoint-memory-overhead (add-as-decimals mem checkpoint-memory-overhead) mem)]

     ; metadata
-    (.setName metadata (str task-id))
+    (.setName metadata pod-name)
     (.setNamespace metadata namespace)
     (.setLabels metadata labels)
     (when pod-annotations
@@ -1029,11 +1037,6 @@
   "Extract the name of a pod from the pod itself"
   [^V1Pod pod]
   (-> pod .getMetadata .getName))
-
-(defn synthetic-pod?
-  "Given a pod name, returns true if it has the synthetic pod prefix"
-  [pod-name]
-  (str/starts-with? pod-name cook-synthetic-pod-name-prefix))

 (defn pod-unschedulable?
   "Returns true if the given pod status has a PodScheduled


Done?

Done?

--- clojure/src/life/core.clj
+++ clojure/src/life/core.clj
@@ -16,14 +16,19 @@
         flat (s/join "\n" (map #(s/join " " %) lines))]
     (println flat)))

-(defn pos [[x y]]
-  (+ x (* board-size y)))
+(defn p2->1 [[x y]]
+  (+ (mod x board-size)
+     (* board-size (mod y board-size))))
+
+(defn p1->2 [n]
+  [(mod (mod n board-size) board-size)
+   (mod (quot n board-size) board-size)])

 (defn get-p [m p]
-  (get m (pos p)))
+  (get m (p2->1 p)))

 (defn set-p [m p v]
-  (assoc m (pos p) v))
+  (assoc m (p2->1 p) v))

 (defn add-glider [board]
   (-> board
@@ -33,18 +38,40 @@
       (set-p [0 2] 1)
       (set-p [1 2] 1)))

+(defn alive-neighbours [board [x y]]
+  (let [offsets [[-1 -1] [0 -1] [1 -1]
+                 [-1 0]         [1 0]
+                 [-1 1]  [0 1]  [1 1]]]
+    (reduce
+     (fn [alive [ox oy]]
+       (if (= 1 (get-p board [(+ x ox) (+ y oy)])) (inc alive) alive))
+     0
+     offsets)))
+
 (defn setup []
-  (q/frame-rate 1)
+  (q/frame-rate 10)
   {:board (add-glider initial-board)})

+;; Any live cell with fewer than two live neighbours dies, as if caused by under-population.
+;; Any live cell with two or three live neighbours lives on to the next generation.
+;; Any live cell with more than three live neighbours dies, as if by over-population.
+;; Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
+
 (defn step [board]
-  board)
-  ;; (loop [next initial-board
-  ;;        x 0
-  ;;        y 0]
-  ;;   (if (= x y board-size)
-  ;;     next
-  ;;     (recur))))
+  (into
+   []
+   (map-indexed
+    (fn [n state]
+      (let [pos (p1->2 n)
+            neighbours (alive-neighbours board pos)
+            alive? (= 1 state)]
+        (cond
+          (and alive? (< neighbours 2)) 0
+          (and alive? (> neighbours 3)) 0
+          (and alive? (or (= 2 neighbours) (= 3 neighbours))) 1
+          (and (not alive?) (= 3 neighbours)) 1
+          :else state)))
+    board)))

 (defn update-state [state]
   (update state :board step))


updater

updater

--- electron-cljs/src/iwaswhere_electron/update/ui.cljs
+++ electron-cljs/src/iwaswhere_electron/update/ui.cljs
@@ -38,6 +38,9 @@
   (let [download (fn [_]
                    (info "Download button clicked")
                    (put-fn [:update/download]))
+        check-beta (fn [_]
+                     (info "Check beta versions")
+                     (put-fn [:update/check-beta]))
         {:keys [version releaseDate]} (:info status-msg)]
     [:div.updater
      [:h1 "New version of iWasWhere available."]
@@ -46,7 +49,9 @@
       [:div [:strong "Release date: "] (subs releaseDate 0 10)]]
      [cancel-btn put-fn]
      " "
-     [:button {:on-click download} "download"]]))
+     [:button {:on-click download} "download"]
+     " "
+     [:button {:on-click check-beta} "check for beta version"]]))

 (defn downloading [status-msg put-fn]
   (let [{:keys [total percent bytesPerSecond transferred]} (:info status-msg)


Emit to resource dirs instead of asset dirs

- Emitted files are on the class path for Jetty eg to serve.

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -124,4 +124,4 @@
                      (get :warnings 0))))
         (when unified-mode
           (write-shim! shim incs cljs output-path output-dir))
-        (-> fileset (core/add-asset tmp-dir) core/commit!)))))
+        (-> fileset (core/add-resource tmp-dir) core/commit!)))))


Improve ClojureScript dependency check

Improve ClojureScript dependency check

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -7,19 +7,30 @@
             [boot.core :as core]
             [boot.pod :as pod]
             [boot.file :as file]
-            [boot.util :refer [dbug info warn]]
+            [boot.util :refer [dbug info warn guard]]
             [clojure.java.io :as io]
             [clojure.pprint :as pp]
             [clojure.string :as string]))

 (def cljs-version "1.7.48")

+(defn- cljs-depdendency []
+  (let [proj-deps    (core/get-env :dependencies)
+        cljs-dep?    (first (filter (comp #{'org.clojure/clojurescript} first) proj-deps))
+        cljs-exists? (guard (do (require 'cljs.build.api) true) false)]
+    (cond
+      ; org.clojure/clojurescript in project (non-transitive) deps - do nothing
+      cljs-dep?    nil
+      ; cljs.core on classpath, org.clojure/clojurescript not in project deps
+      cljs-exists? (do (warn "WARNING: No ClojureScript dependency in project dependencies but ClojureScript in classpath\n") nil)
+      ; no cljs on classpath, no project dep, add cljs dep to pod
+      :else        ['org.clojure/clojurescript cljs-version])))
+
 (def ^:private deps
   "ClojureScript dependency to load in the pod if
    none is provided via project"
-  (delay (remove pod/dependency-loaded?
-                 [['org.clojure/clojurescript cljs-version]
-                  ['ns-tracker "0.3.0"]])))
+  (delay (filter identity [(cljs-depdendency)
+                           ['ns-tracker "0.3.0"]])))

 (def ^:private QUALIFIERS
   "Order map for well-known Clojure version qualifiers."
@@ -34,22 +45,6 @@
                                             [3 0])]
     (when-not (>= (compare [major minor incremental qualifier-part1 qualifier-part2] [1 7 0 3 0]) 0)
       (warn "ClojureScript requires Clojure 1.7 or greater.\nSee https://github.com/boot-clj/boot/wiki/Setting-Clojure-version.\n"))))
-
-(defn- assert-cljs-dependency! []
-  (let [proj-deps  (core/get-env :dependencies)
-        proj-dep?  (set (map first proj-deps))
-        all-deps   (map :dep (pod/resolve-dependencies (core/get-env)))
-        trans-deps (remove #(-> % first proj-dep?) all-deps)
-        cljs?      #{'org.clojure/clojurescript}
-        find-cljs  (fn [ds] (first (filter #(-> % first cljs?) ds)))
-        parse-v    #(when % (string/split % #"\."))
-        trans-cljs (find-cljs trans-deps)
-        proj-cljs  (find-cljs proj-deps)]
-    (cond
-      (and proj-cljs (pos? (compare (parse-v (second proj-cljs)) (parse-v cljs-version))))
-      (warn "WARNING: CLJS version older than boot-cljs: %s\n" (second proj-cljs))
-      (and trans-cljs (not= (second trans-cljs) cljs-version))
-      (warn "WARNING: Different CLJS version via transitive dependency: %s\n" (second trans-cljs)))))

 (defn- read-cljs-edn
   [tmp-file]
@@ -202,7 +197,6 @@
   (let [tmp-result (core/tmp-dir!)
         compilers  (atom {})
         prev       (atom nil)]
-    (assert-cljs-dependency!)
     (comp
       (default-main :ids ids)
       (core/with-pre-wrap fileset


Update bob_test.clj

Update bob_test.clj

Woah --> Whoa

--- bob/bob_test.clj
+++ bob/bob_test.clj
@@ -5,7 +5,7 @@
   (is (= "Whatever." (bob/response-for "Tom-ay-to, tom-aaaah-to."))))

 (deftest responds-to-shouts
-  (is (= "Woah, chill out!" (bob/response-for "WATCH OUT!"))))
+  (is (= "Whoa, chill out!" (bob/response-for "WATCH OUT!"))))

 (deftest responds-to-questions
   (is (= "Sure." (bob/response-for "Does this cryogenic chamber make me look fat?"))))
@@ -17,16 +17,16 @@
   (is (= "Whatever." (bob/response-for "It's OK if you don't want to go to the DMV."))))

 (deftest responds-to-forceful-questions
-  (is (= "Woah, chill out!" (bob/response-for "WHAT THE HELL WERE YOU THINKING?"))))
+  (is (= "Whoa, chill out!" (bob/response-for "WHAT THE HELL WERE YOU THINKING?"))))

 (deftest responds-to-shouting-with-special-characters
-  (is (= "Woah, chill out!" (bob/response-for "ZOMG THE %^*@#$(*^ ZOMBIES ARE COMING!!11!!1!"))))
+  (is (= "Whoa, chill out!" (bob/response-for "ZOMG THE %^*@#$(*^ ZOMBIES ARE COMING!!11!!1!"))))

 (deftest responds-to-shouting-numbers
-  (is (= "Woah, chill out!" (bob/response-for "1, 2, 3 GO!"))))
+  (is (= "Whoa, chill out!" (bob/response-for "1, 2, 3 GO!"))))

 (deftest responds-to-shouting-with-no-exclamation-mark
-  (is (= "Woah, chill out!" (bob/response-for "I HATE YOU"))))
+  (is (= "Whoa, chill out!" (bob/response-for "I HATE YOU"))))

 (deftest responds-to-statement-containing-question-mark
   (is (= "Whatever." (bob/response-for "Ending with ? means a question."))))


Update layout-harness ns.

Update layout-harness ns.

--- dev/org/playasophy/wonderdome/geometry/layout_harness.clj
+++ dev/org/playasophy/wonderdome/geometry/layout_harness.clj
@@ -17,16 +17,15 @@

 (defn- draw-dome
-  [edges]
+  []
   (quil/stroke (quil/color 96 128))
   (quil/stroke-weight 3)
-  (let [sorted-edges (map vector (range) edges)]
-    (doseq [[i [a b]] sorted-edges]
-      (quil/line
-        (scale-point a)
-        (scale-point b))
-      (apply quil/text (str i)
-        (scale-point (cartesian/midpoint 1/2 a b))))))
+  (doseq [[[a b] i] (map vector dome-struts (range))]
+    (quil/line
+      (scale-point a)
+      (scale-point b))
+    (apply quil/text (str i)
+      (scale-point (cartesian/midpoint 1/2 a b)))))

@@ -46,7 +45,7 @@
   (quil/rotate-x 0.0 #_ 1.2)
   ;(quil/rotate-z (* (quil/frame-count) 0.003))
   (draw-axes 0.5)
-  (draw-dome dome-struts))
+  (draw-dome))

 (defn start!


Admin can only be true if someone is logged in.

--- src/cadence/security.clj
+++ src/cadence/security.clj
@@ -28,4 +28,5 @@
 (defn admin?
   "Return the role (not nil so its true) that isa? admin."
   ([user] (some #(isa? % ::admin) (:roles user)))
-  ([] (admin? (model/get-auth))))
+  ([] (when (model/identity)
+        (admin? (model/get-auth)))))


Added different sorting rule for classification solver

--- src/clj/asols/solver.clj
+++ src/clj/asols/solver.clj
@@ -20,16 +20,25 @@
      [ret# elapsed#]))

 (defprotocol SolverProtocol
-  (get-metrics [this net entries]))
+  (get-metrics [this net entries])
+  (sort-cases [this cases]))

 (defrecord ClassificationSolver [train-opts mutation-opts]
   SolverProtocol
   (get-metrics [_ net entries]
-    (trainer/calc-ca net entries)))
+    (trainer/calc-ca net entries))
+  (sort-cases [_ cases]
+    (sort-by
+      (fn [case]
+        [(- 1.0 (:train-metrics case))
+         (:train-cost case)])
+      cases)))

 (defrecord RegressionSolver [train-opts mutation-opts]
   SolverProtocol
-  (get-metrics [_ _ _] nil))
+  (get-metrics [_ _ _] nil)
+  (sort-cases [_ cases]
+    (sort-by :train-cost cases)))

 (defn- converged?
   [_ solving]
@@ -100,12 +109,9 @@
 (defn- make-combined-cases
   [solver net cases]
   (let [select-count 5
-        {base-cost :train-cost} (first (for [{m :mutation :as case} cases
-                                             :when (= ::m/identity (:operation m))]
-                                         case))
         selected-cases (->> cases
-                            (filter #(< (:train-cost %) base-cost))
-                            (sort-by :train-cost)
+                            (sort-cases solver)
+                            (take-while #(not= ::m/identity (:operation (:mutation %))))
                             (take select-count))]
     (for [select-count (range 2 (inc (count selected-cases)))
           :let [merge-cases (take select-count selected-cases)
@@ -137,7 +143,7 @@
           progress-chan (make-progress-chan out-chan (count mutations))
           [cases ms-took] (solve-mutations solver net mutations tpool progress-chan)
           all-cases (concat cases (make-combined-cases solver net cases))
-          [best-case & other-cases] (sort-by :train-cost all-cases)]
+          [best-case & other-cases] (sort-cases solver all-cases)]
       (make-solving solver net best-case other-cases ms-took))
     (catch InterruptedException _
       (debug "Detected thread interrupt"))))


fix duplicate entries in set literal issue in `cljs.closure/build-modules`

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -666,9 +666,11 @@
   (let [find-entry (fn [sources entry]
                      (some
                        (fn [source]
-                         (when (some #{(name entry) (name (comp/munge entry))}
-                                 (:provides source))
-                           source))
+                         (let [matcher
+                               (into #{}
+                                 [(name entry) (name (comp/munge entry))])]
+                           (when (some matcher (:provides source))
+                             source)))
                        sources))
         [sources' modules]
         (reduce