small fix

small fix

--- src/cljs/salava/profile/ui/modal.cljs
+++ src/cljs/salava/profile/ui/modal.cljs
@@ -75,7 +75,7 @@
                         (for [index (range (count @blocks))]
                           [:div.row
                            [:div.col-xs-12 (ph/block (cursor blocks [index]) state index)]]))]]]]]]
-    [:div.col-xs-12 {:style {:margin-top "10px"}} [reporttool1 user-id fullname "user"]]]))
+    (when (session/get :user) [:div.col-xs-12 {:style {:margin-top "10px"}} [reporttool1 user-id fullname "user"]])]))


Core-test doesn't actually have to include the source.

--- examples/semi-sweet-examples/test/semi_sweet_simple/core_test.clj
+++ examples/semi-sweet-examples/test/semi_sweet_simple/core_test.clj
@@ -1,6 +1,5 @@

 (ns semi-sweet-simple.core-test
-  (:use [semi-sweet-simple.core] :reload-all)
   (:use [clojure.test])
   (:use [midje.checkers])
   (:use [midje.semi-sweet])


rm dead code

rm dead code

--- src/java_time/defconversion.clj
+++ src/java_time/defconversion.clj
@@ -53,25 +53,21 @@
   (g/types (map type xs)))

 (defn- call-conversion [nm tp args]
+  {:pre [(simple-symbol? tp)]}
   `(if-let [[path# fn#] (g/conversion-fn
                           @graph
                           (types-of ~args)
                           (g/types ~(to-seq tp)))]
-     (if-let [result#
-              (try (fn# ~args)
-                   (catch Exception e#
-                     (throw
-                       (ex-info "Conversion failed"
-                                {:path (:path path#), :arguments ~args, :to ~tp}
-                                e#))))]
-       (if (instance? clojure.lang.ISeq ~tp)
-         result#
-         (first result#))
-       (throw (ex-info
-                (format "Conversion from %s to %s returned nil!"
-                        ~args ~tp ~(str nm))
-                {:arguments ~args, :to ~tp, :constructor ~nm})))
-     (throw (ex-info (format "Could not convert %s to %s!" ~args ~tp ~(str nm))
+     (or (try (first (fn# ~args))
+              (catch Exception e#
+                (throw
+                  (ex-info "Conversion failed"
+                           {:path (:path path#), :arguments ~args, :to ~tp}
+                           e#))))
+         (throw (ex-info
+                  (format "Conversion from %s to %s returned nil!" ~args ~tp)
+                  {:arguments ~args, :to ~tp, :constructor ~nm})))
+     (throw (ex-info (format "Could not convert %s to %s!" ~args ~tp)
                      {:arguments ~args, :to ~tp, :constructor ~nm}))))

 (defn- gen-implicit-arities [nm tp arities]


[#1098] Save email as lowercase when editing a user

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/store.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/store.cljs
@@ -76,7 +76,7 @@
    (assert user-id (str "No user-id for user " user))
    (PUT (str "/rest/users/" user-id)
         (merge ajax/default-ajax-config
-               {:params {"user" user}
+               {:params {"user" (update-in user ["emailAddress"] s/lower-case)}
                 :handler (fn [response]
                            (let [user (get response "user")
                                  user-id (get user "keyId")]


Added IS_COALESCING to the XMLInputFactory to prevent contents of tags from being broken up.

--- src/main/clojure/clojure/data/xml.clj
+++ src/main/clojure/clojure/data/xml.clj
@@ -227,7 +227,9 @@
   a lazy sequence of Event records.  See clojure.data.xml/lazy-source-seq
   for similar results but without requiring an external pull parser."
   [^java.io.InputStream s]
-  (let [sreader (.createXMLStreamReader (XMLInputFactory/newInstance) s)]
+  (let [fac (doto (javax.xml.stream.XMLInputFactory/newInstance)
+              (.setProperty javax.xml.stream.XMLInputFactory/IS_COALESCING true))
+        sreader (.createXMLStreamReader fac s)]
     ;(.setNamespaceAttributesReporting xpp true)
     ;(.setInput xpp s)
     (pull-seq sreader)))


Actually reply back to flowdock with the message.

--- src/main/clojure/jarvis/bot.clj
+++ src/main/clojure/jarvis/bot.clj
@@ -4,6 +4,7 @@
             [jarvis.plugins :as plugins]
             [jarvis.util :as util]
             [clj-flowdock.api.flow :as flow]
+            [clj-flowdock.api.message :as m]
             [clj-flowdock.streaming :as streaming]
             [clojure.tools.logging :as log])
   (:import [java.util.concurrent Executors ExecutorService])
@@ -32,7 +33,7 @@
           :else (command/reply message plugin))
         (catch Exception e
           (log/error e (plugins/command-name plugin) "threw an exception")
-          (.getMessage e))))))
+          (m/reply message (.getMessage e)))))))

 (defn flow-stream [flow plugins]
   (listen [flow msg flow-connection]


close writer in shorts-test

close writer in shorts-test

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

--- acqEngine/src/org/micromanager/test.clj
+++ acqEngine/src/org/micromanager/test.clj
@@ -335,7 +335,7 @@
     (dorun
       (repeatedly n
                   #(.write writer img)))
-    ;(.close writer)
+    (.close writer)
     ))


Add details to pokemon, close #52, see #26

--- frontend/src/cruncher/views.cljs
+++ frontend/src/cruncher/views.cljs
@@ -72,9 +72,13 @@
     (let [pokemon (om/props this)]
       (dom/tr #js {:id        (str "poketable-row-details-" (:id pokemon))
                    :className "collapse"}
-              (dom/td #js {:className "well"
-                           :colSpan 13}
-                      "ahoi")))))
+              (dom/td #js {:className "well"})
+              (dom/td #js {:className "well" :colSpan 3} (dom/img #js {:src (str "img/pokemon/models/" (:pokemon_id pokemon) ".png")
+                                                                       :className "pokemon-image"}))
+              (dom/td #js {:className "well" :colSpan 10}
+                      (dom/div #js {:className "row"}
+                               (dom/div #js {:className "col-md-2"} "Available Candy:")
+                               (dom/div #js {:className "col-md-10"} (:candy pokemon))))))))
 (def poketable-entry-details (om/factory PokeTableEntryDetails {}))

 (defui PokeTableEntry
@@ -96,6 +100,7 @@
                                                  :value     (:id pokemon)})))
               (dom/td nil (favorite-td (:id pokemon) (:favorite pokemon)))
               (dom/td nil (:pokemon_id pokemon))
+              (dom/td nil (dom/img #js {:src (str "img/pokemon/models/" (:pokemon_id pokemon) ".png") :className "pokemon-image-thumb"}))
               (dom/td nil (:name pokemon))
               (dom/td nil (:nickname pokemon))
               (dom/td nil (:cp pokemon))
@@ -126,6 +131,7 @@
                                            (dom/th nil "")
                                            (vlib/sortable-table-header :favorite "Fav.")
                                            (vlib/sortable-table-header :pokemon_id "#")
+                                           (dom/th nil "")
                                            (vlib/sortable-table-header :name "Name")
                                            (vlib/sortable-table-header :nickname "Nickname")
                                            (vlib/sortable-table-header :cp "CP")
@@ -139,9 +145,7 @@
                         (dom/tbody nil
                                    (interleave
                                      (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))
-                                     (map #(poketable-entry-details (lib/merge-react-key %)) (lib/inventory-pokemon))))
-                        #_(apply dom/tbody nil
-                                 (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))))
+                                     (map #(poketable-entry-details (lib/merge-react-key %)) (lib/inventory-pokemon)))))
              #_(let [jquery (js* "$")]
                  (.stickyTableHeaders (jquery "#poketable"))))))
 (def poketable (om/factory PokeTable {}))


annoyingly, once more adapting chart height manually

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/charts/custom_fields.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/charts/custom_fields.cljs
@@ -110,7 +110,7 @@
       (let [indexed (map-indexed (fn [idx [k v]] [idx v]) stats)
             charts (:custom-field-charts options)
             chart-h1 (apply + (map (fn [[k cfg]] (:chart-h cfg)) charts))
-            chart-h 990]
+            chart-h 1030]
         (prn chart-h1)
         [:div
          [:svg


Testing JUnit fixtures

Testing JUnit fixtures

--- jvm-runner/test/codewars/runner/java_test.clj
+++ jvm-runner/test/codewars/runner/java_test.clj
@@ -1,10 +1,11 @@
 (ns codewars.runner.java-test
   (:require [clojure.test :refer :all]
             [codewars.core :refer [-main]]
-            [cheshire.core :as json]
-            [codewars.runner :refer [run]])
-  (:import [org.apache.commons.io.output WriterOutputStream]
-           [java.io PrintStream ByteArrayOutputStream]))
+            [cheshire.core :as json])
+  (:import [java.io PrintStream ByteArrayOutputStream]))
+
+(defn subseq? [a b]
+  (some #{a} (partition (count a) 1 b)))

 (defmacro with-java-out-str [& body]
   `(let [original-out# (PrintStream. (. System out))
@@ -39,3 +40,25 @@
        {:language "java"
         :solution "public class Hello {public static void main() {System.out.print(\"Hellooo!\");}}"})
       (is (= "Hellooo!" (with-java-out-str (-main)))))))
+
+(deftest java-test-fixture
+  (testing "-main can handle a junit test"
+    (with-in-str
+      (json/generate-string
+       {:language "java"
+        :solution "public class Solution {
+                   public Solution(){}
+                   public int testthing(){return 3;}}",
+        :fixture "import static org.junit.Assert.assertEquals;
+                  import org.junit.Test;
+                  import org.junit.runners.JUnit4;
+                  public class TestFixture {
+                     public TestFixture(){}
+                     @Test public void myTestFunction(){
+                        Solution s = new Solution();
+                         assertEquals(\"wow\", 3, s.testthing());
+                         System.out.println(\"test out\");}}"})
+      (let [test-out-string (with-java-out-str (-main))]
+        (is (.contains test-out-string "<DESCRIBE::>myTestFunction(TestFixture)"))
+        (is (.contains test-out-string "test out"))
+        (is (.contains test-out-string "<PASSED::>Test Passed<:LF:>"))))))


Removing some debug statements.

Removing some debug statements.

--- src/ahnentafel/gedcom/query.clj
+++ src/ahnentafel/gedcom/query.clj
@@ -30,11 +30,10 @@
                             (if-let [record
                                      (or (and xref (find-xref tree xref))
                                          (find-item tree "INDI"))]
-                              (do (println "") (println record) (println "")
-                                (assoc m
-                                      :start-record
-                                      {:name (find-item-value record "NAME")
-                                       :xref (:xref record)}))
+                              (assoc m
+                                     :start-record
+                                     {:name (find-item-value record "NAME")
+                                      :xref (:xref record)})
                               m))]
      (-> {:number-of-records (count (:subordinate-lines tree))
           :destination (header-value "DEST")


add subcat default restrictions for proper nouns, nouns, and verbs

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -108,7 +108,14 @@
        {:synsem {:subcat '()}})
       (if-has
        [:synsem :propernoun] true
-       {:synsem {:subcat '()}})))
+       {:synsem {:subcat '()}})
+      (if-has
+       [:synsem :cat] :noun
+       {:synsem {:subcat {:1 {:cat :det}}}})
+      (if-has
+       [:synsem :cat] :verb
+       {:synsem {:subcat {:1 {:cat :noun}
+                          :2 '()}}})))

 ;; TODO: factor out Italian-specific parts and promote to babel.lexiconfn.
 ;; TODO: see if we can use Clojure transducers here. (http://clojure.org/reference/transducers)
@@ -136,10 +143,10 @@
       ;; TODO: throw error or warning in certain cases:
       ;; (= true (fail? value))
       ;;
-
-     ;; common nouns need a gender (but propernouns do not need one).
-     ;; TODO: throw error rather than just throwing out entry.
-     (filter-vals
+
+      ;; common nouns need a gender (but propernouns do not need one).
+      ;; TODO: throw error rather than just throwing out entry.
+      (filter-vals
       #(or (not (and (= :noun (get-in % [:synsem :cat]))
                      (= :none (get-in % [:synsem :agr :gender] :none))
                      (= false (get-in % [:synsem :propernoun] false))))
@@ -154,47 +161,16 @@
            (and (log/warn (str "ignoring lexical entry with no :cat: " (strip-refs %)))
                 false)))

+     ;; end of language-specific grammar rules
+
+     ;; begin world-knowledge constraints
      (constrain-vals-if
       (fn [val]
         (not (nil? (get universals (get-in val [:synsem :sem :pred])))))
       (fn [val]
         (get universals (get-in val [:synsem :sem :pred]))))

-     ;; TODO: refactor this; it's very monolithic currently:
-     intransitivize
-
-     ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
-     ;; TODO: refactor this; it's very monolithic currently:
-     transitivize
-
-     (constrain-vals-if
-      (fn [val]
-        (and (= :noun (get-in val [:synsem :cat]))
-             (= true (get-in val [:synsem :reflexive]))
-             (= true (get-in val [:synsem :pronoun]))))
-      (fn [val]
-        (unify (let [case (atom :acc)
-                     cat (atom :noun)]
-                 {:synsem {:cat cat
-                           :pronoun true
-                           :subcat '()
-                           :reflexive true
-                           :case case}
-                  :italiano {:cat cat
-                             :case case}}))))
-     (constrain-vals-if
-      (fn [val]
-        (and (= (get-in val [:synsem :cat]) :noun)
-             (or (= (get-in val [:synsem :agr :gender]) :masc)
-                 (= (get-in val [:synsem :agr :gender]) :fem))
-             (= false (get-in val [:synsem :propernoun] false))
-             (= false (get-in val [:synsem :pronoun] false))
-             (not (= '() (get-in val [:synsem :subcat] :top)))))
-      ;; some nouns e.g. "casa" may have a sense that requires no determiner (subcat = '())
-      ;; in such cases, don't apply agreement-noun.
-      (fn [val]
-        (unify val agreement-noun)))
-
+     ;; TODO: consider doing encyclopedia constraints
      ))


adding a get-chunks function to the models.chunks namespace

--- src/bitfondue/models/chunks.clj
+++ src/bitfondue/models/chunks.clj
@@ -8,3 +8,7 @@
   (database/insert-chunk<! config/database
                            (:title chunk)))

+(defn get-chunks
+  "Retrieve chunks"
+  []
+  (database/get-chunks config/database))


fix usage of subs in tilde-expand-path

fix usage of subs in tilde-expand-path

--- src/brainbot/nozzle/real_fs.clj
+++ src/brainbot/nozzle/real_fs.clj
@@ -142,7 +142,7 @@
   (cond
     (= path "~")
       (System/getProperty "user.home")
-    (= "~/" (subs path 0 2))
+    (.startsWith path "~/")
       (str (System/getProperty "user.home") (subs path 1))
     :else
       path))


Planned skeleton of functions / views

Planned skeleton of functions / views

--- src/matchmaker/core.cljs
+++ src/matchmaker/core.cljs
@@ -1,17 +1,40 @@
 (ns matchmaker.core
     (:require [reagent.core :as reagent :refer [atom]]))
+
+(defn parse-players [txt]
+  [])
+
+(defn parse-attendance [txt]
+  [])
+
+(defn can-play [players attendance]
+  [])
+
+(defn group-teams [players]
+  [])

 ;; -------------------------
 ;; Views

-(defn home-page []
-  [:div [:h2 "Welcome to Reagent"]])
+(defn editor [value]
+  [:textarea {:value @value
+              :on-change #(reset! value (-> % .-target .-value))}])
+
+(defn root []
+  (let [players-txt (atom "")
+        attendance-txt (atom "")]
+    [[(editor players-txt)]
+     [(editor attendance-txt)]
+     (let [players (parse-players players-txt)
+           attendance (parse-attendance attendance-txt)
+           teams (group-teams (can-play players attendance))]
+       [:p "TODO: Everything."])]))

 ;; -------------------------
 ;; Initialize app

 (defn mount-root []
-  (reagent/render [home-page] (.getElementById js/document "app")))
+  (reagent/render [root] (.getElementById js/document "app")))

 (defn init! []
   (mount-root))


db component added

db component added

--- src/mission_match/db.clj
+++ src/mission_match/db.clj
@@ -1,21 +1,60 @@
-(ns mission-match.db
-  (:require [monger.core :as mg]
-            [com.stuartsierra.component :as component]))
+    (ns mission-match.db
+      (:require [monger.core :as mg]
+                [monger.collection :as mc]
+                [com.stuartsierra.component :as component]))

-(defstate conn
-    :start  mg/connect
-    :stop   mg/disconnect)

-(use '[mission-match.db :refer [conn]])
+    (defrecord Connection []
+      component/Lifecycle

-(mount.core/defstate db
-  :start (mg/get-db conn "mission-match"))
-
+      (start [component]
+        (println "Starting Connectio")
+        (let [conn (mg/connect) ]
+          (assoc component :conn conn)))
+
+      (stop [component]
+        (println "Stopping Database")))

-(defrecord Database []
-  component/Lifecycle

-  (start [component]
-    (println "Starting Database")
-    (let [conn (mg/connect)]
-      (assoc component :conn conn))))
+    (defrecord Database [conn]
+      component/Lifecycle
+
+      (start [component]
+        (println "Starting Database")
+        (let [db (mg/get-db (:conn conn) "mission-match")]
+          (assoc component :db db))))
+
+    (defn new-connection  []
+        (map->Connection  {}))
+
+    (defn new-database  []
+        (map->Database  {}))
+
+    (defn db-system []
+      (component/system-map
+        :conn (new-connection)
+        :db (component/using
+              (new-database)
+              [:conn])))
+
+    (def sys (atom (db-system)))
+
+    (defn start! []
+      (reset! sys (component/start @sys)))
+
+    (defn stop! []
+      (reset! sys (component/stop @sys)))
+
+    (start!)
+
+
+    (defn get-db []
+      (:db (:db @sys)))
+
+    (defn test-db-system []
+      (mc/insert (get-db) "test" {:text "this is a db-system-test"})
+      (if
+        (= (:text (mc/find-one-as-map (get-db) "test" {}))
+          "this is a db-system-test")
+        (println "db-system-test passes")
+        (println "db-system-test fails")))


bumped up Selmer version

bumped up Selmer version

--- luminus/hello/project.clj
+++ luminus/hello/project.clj
@@ -6,7 +6,7 @@
    [lib-noir "0.6.6"]
    [compojure "1.1.5"]
    [ring-server "0.2.8"]
-   [selmer "0.3.6"]
+   [selmer "0.4.0"]
    [com.taoensso/timbre "1.6.0"]
    [com.postspectacular/rotor "0.1.0"]
    [com.taoensso/tower "1.5.1"]


Make the base page hiccup template better

--- src/clj/comic_reader/server.clj
+++ src/clj/comic_reader/server.clj
@@ -15,8 +15,10 @@

 (c/defroutes routes
   (c/GET "/" [] (hp/html5
-                 [:input#history_state {:type "hidden"}]
-                 (hp/include-js "js/compiled/main.js")))
+                 [:head]
+                 [:body
+                  [:input#history_state {:type "hidden"}]
+                  (hp/include-js "js/compiled/main.js")]))
   (c/GET "/blank" [] "")
   (c/context "/api/v1" []
     (c/GET "/sites" []


Fixed bad merge

Fixed bad merge

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -451,7 +451,7 @@
                                                        (fn [coll] (conj (remove-once #(not= (:cid %) (:cid sw)) coll) st)))
                                                      (swap! state update-in [:runner :scored]
                                                        (fn [coll] (conj (remove-once #(not= (:cid %) (:cid st)) coll)
-                                                                        (dissoc sw :counter :abilities :events))))
+                                                                        (dissoc sw :abilities :events))))
                                                      (gain-agenda-point state :runner (- swpts stpts))
                                                      (gain-agenda-point state :corp (- stpts swpts))
                                                      (doseq [c (get-in @state [:corp :scored])]


implement Heinlein Grid

implement Heinlein Grid

--- src/clj/game/cards-upgrades.clj
+++ src/clj/game/cards-upgrades.clj
@@ -93,6 +93,19 @@
                                                                (get-in corp (:zone card))))))
                                 :msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}

+   "Heinlein Grid"
+   {:effect (req (add-watch state (keyword (str "heinlein" (:cid card)))
+                   (fn [k ref old new]
+                     (let [clicknew (get-in new [:runner :click])
+                           clickold (get-in old [:runner :click])]
+                       (when (< clicknew clickold)
+                         (resolve-ability ref side
+                           {:req (req this-server)
+                            :msg "force the Runner to lose all credits" :once :per-turn
+                            :effect (effect (lose :runner :credit :all))}
+                          card nil))))))
+    :leave-play (req (remove-watch state (keyword (str "heinlein" (:cid card)))))}
+
    "Hokusai Grid"
    {:events {:successful-run {:req (req this-server) :msg "do 1 net damage"
                               :effect (req (damage state side :net 1 {:card card}))}}}


Update clear-wait-prompt to not require the wait prompt to be first in the prompt queue. Fixes interaction with high-priority prevention prompts hiding wait prompts for Snare.

--- src/clj/game/core-abilities.clj
+++ src/clj/game/core-abilities.clj
@@ -308,8 +308,8 @@
 (defn clear-wait-prompt
   "Removes the first 'Waiting for...' prompt from the given side's prompt queue."
   [state side]
-  (when (= :waiting (-> @state side :prompt first :prompt-type))
-    (swap! state update-in [side :prompt] rest)))
+  (when-let [wait (some #(when (= :waiting (:prompt-type %)) %) (-> @state side :prompt))]
+    (swap! state update-in [side :prompt] (fn [pr] (filter #(not= % wait) pr)))))

 ;;; Psi games
 (defn psi-game


Properly close streams.

Properly close streams.

--- src/clj/geschichte/platform.clj
+++ src/clj/geschichte/platform.clj
@@ -68,17 +68,15 @@
                              (go-loop [m (<! out)]
                                (when m
                                  (debug "client sending msg to:" url m)
-                                 (if (= (:topic m) :binary-fetched)
-                                   (cli/send ws :byte (let [out (ByteArrayOutputStream.)]
-                                                        (.write out (byte 0))
-                                                        (.write out (:value m))
-                                                        (.toByteArray out)))
-                                   (let [baos (ByteArrayOutputStream. (* 100 1024 1024))
-                                         writer (transit/writer baos :json)]
-                                     (.write baos (byte-array 1 (byte 1)))
-                                     (transit/write writer m)
-                                     (cli/send ws :byte (.toByteArray baos)))
-                                   #_(cli/send ws :text (str " " (pr-str m))))
+                                 (with-open [baos (ByteArrayOutputStream.)]
+                                   (if (= (:topic m) :binary-fetched)
+                                     (do
+                                       (.write baos (byte 0))
+                                       (.write baos (:value m)))
+                                     (let [writer (transit/writer baos :json)]
+                                       (.write baos (byte-array 1 (byte 1)))
+                                       (transit/write writer m)))
+                                   (cli/send ws :byte (.toByteArray baos)))
                                  (recur (<! out))))
                              (async/put! opener [in out])
                              (async/close! opener))
@@ -97,12 +95,12 @@
                                    (async/put! in (with-meta m {:host host})))

                                  1
-                                 (let [bais (ByteArrayInputStream. blob)
-                                       reader (transit/reader bais :json)
-                                       m (transit/read reader)]
-                                   (debug "client received transit blob from:"
-                                          url (take 10 (map byte blob)))
-                                   (async/put! in (with-meta m {:host host}))))))
+                                 (with-open [bais (ByteArrayInputStream. blob)]
+                                   (let [reader (transit/reader bais :json)
+                                         m (transit/read reader)]
+                                     (debug "client received transit blob from:"
+                                            url (take 10 (map byte blob)))
+                                     (async/put! in (with-meta m {:host host})))))))
                      :close (fn [ws code reason]
                               (info "closing" ws code reason)
                               (async/close! in)
@@ -146,16 +144,15 @@
                            (if (@channel-hub channel)
                              (do
                                (debug "server sending msg:" url (pr-str m))
-                               (if (= (:topic m) :binary-fetched)
-                                 (send! channel ^bytes (let [out (ByteArrayOutputStream.)]
-                                                         (.write out (byte 0))
-                                                         (.write out (:value m))
-                                                         (.toByteArray out)))
-                                 (let [baos (ByteArrayOutputStream. (* 100 1024 1024))
-                                       writer (transit/writer baos :json)]
-                                   (.write baos (byte-array 1 (byte 1)))
-                                   (transit/write writer m)
-                                   (send! channel (.toByteArray baos) #_(str " " (pr-str m))))))
+                               (with-open [baos (ByteArrayOutputStream.)]
+                                 (if (= (:topic m) :binary-fetched)
+                                   (do
+                                     (.write baos (byte 0))
+                                     (.write baos (:value m)))
+                                   (let [writer (transit/writer baos :json)]
+                                     (.write baos (byte-array 1 (byte 1)))
+                                     (transit/write writer m)))
+                                 (send! channel ^bytes (.toByteArray baos))))
                              (debug "dropping msg because of closed channel: " url (pr-str m)))
                            (recur (<! out))))
                        (on-close channel (fn [status]
@@ -165,7 +162,7 @@
                        (on-receive channel (fn [data]
                                              (if (string? data)
                                                (do
-                                                 (debug "server received data:" url data)
+                                                 (debug "server received string data:" url data)
                                                  (async/put! in
                                                              (with-meta
                                                                (read-string-safe @tag-table data)
@@ -181,12 +178,12 @@
                                                      (async/put! in (with-meta m {:host host})))

                                                    1
-                                                   (let [bais (ByteArrayInputStream. blob)
-                                                         reader (transit/reader bais :json)
-                                                         m (transit/read reader)]
-                                                     (debug "client received transit blob from:"
-                                                            url (take 10 (map byte blob)))
-                                                     (async/put! in (with-meta m {:host host})))))))))))]
+                                                   (with-open [bais (ByteArrayInputStream. blob)]
+                                                     (let [reader (transit/reader bais :json)
+                                                           m (transit/read reader)]
+                                                       (debug "client received transit blob from:"
+                                                              url (take 10 (map byte blob)))
+                                                       (async/put! in (with-meta m {:host host}))))))))))))]
      {:new-conns conns
       :channel-hub channel-hub
       :url url


Exclude dungeon generation from starting area

--- src/cljc/robinson/worldgen.cljc
+++ src/cljc/robinson/worldgen.cljc
@@ -328,7 +328,10 @@
         n                     (rn/create-noise (rr/create-random seed))
         volcano-pos           (get-in state [:world :volcano-pos])
         lava-xys              (get-in state [:world :lava-points])
-        encounter             (rand-nth [:normal :pirate-ship])]
+        starting-pos          (rp/player-starting-pos state)
+        encounter             (if (rc/farther-than? starting-pos (rp/player-pos state) 80)
+                                :normal
+                                (rand-nth [:normal :pirate-ship]))]
     {:seed seed
      :pos {:x x :y y}
      :spawned-monsters {}


Notes and ideas

Notes and ideas

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -50,7 +50,7 @@
 (def app-state
   (r/atom
     {:cards {}
-     :filter ""
+     :filter "" ; BUG - If we had two boards, the cards should be the same, but not the filters
     }))

 (defn update-card!
@@ -63,6 +63,10 @@
 (defn add-cards!
   "Add several cards to the application state"
   [cards]
+  ; BUG - Keeping the ::show-details at app-state means that rendering twice
+  ; the component would lead to the GUI being updated at two places
+  ; => It cannot be in the component alone (if you want the expand all)
+  ;    But it should be in a state specific to the board (assoc container)
   (let [default-state {::show-details false}
         to-gui-card #(vector (:card-id %) (merge % default-state))]
     (swap! app-state
@@ -157,6 +161,7 @@
   (let [filter (r/cursor app-state [:filter])
         cards (reaction (filter-by-title @filter (:cards @app-state)))]
     [:div
+     ; TODO - Try to add a button to show details to all tickets
      (render-filter filter)
      [render-board @cards]]
   ))


Put two Waypoints on each image

Put two Waypoints on each image

One activates on the top of an image when going down, the other
activates on the bottom of an image being at the bottom while going up.

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -60,22 +60,34 @@
 (defn img-component [site
                      {:keys [comic]}
                      {:keys [chapter page tag]}]
-  (let [waypoint (clojure.core/atom nil)]
+  (let [waypoints (clojure.core/atom nil)]
     (reagent/create-class
      {:component-did-mount
       (fn [this]
-        (let [wp (js/Waypoint.
-                  #js {:element (reagent/dom-node this)
-                       :handler #(r/go-to
-                                  (r/read-path
-                                   {:site site
-                                    :comic comic
-                                    :chapter chapter
-                                    :page page}))})]
-          (reset! waypoint wp)))
+        (let [node (reagent/dom-node this)
+              go-to-comic #(r/go-to
+                            (r/read-path
+                             {:site site
+                              :comic comic
+                              :chapter chapter
+                              :page page}))
+              wp-down
+              (js/Waypoint.
+               #js {:element node
+                    :handler #(when (= %
+                                       "down")
+                                (go-to-comic))})
+              wp-up
+              (js/Waypoint.
+               #js {:element node
+                    :offset "bottom-in-view"
+                    :handler #(when (= %
+                                       "up")
+                                (go-to-comic))})]
+          (reset! waypoints [wp-up wp-down])))
       :componentWillUnmount
       (fn []
-        (.destroy @waypoint))
+        (map #(.destroy %) @waypoints))
       :reagent-render
       (fn [site location {:keys [tag]}]
         tag)})))


I it is :(

I it is :(

--- src/cljs/mokkameister/core.cljs
+++ src/cljs/mokkameister/core.cljs
@@ -58,7 +58,8 @@
 (defn chart [chart-data]
   (let [month-count (map :count chart-data)]
     [:pre.chart (js/chart (clj->js month-count)
-                          (clj->js {:width 85}))]))
+                          (clj->js {:width 85
+                                    :pointChar "I"}))]))

 (defn- chart-title []
   (let [brew  (rand-nth-weighted {"Brygg" 8, "Mikrodosar" 2, "Kaffidoktorar" 1})


clean

clean

--- src/cljs/reagent_demo/core.cljs
+++ src/cljs/reagent_demo/core.cljs
@@ -26,7 +26,6 @@

 (defonce timer (atom (js/Date.)))

-
 (defn rand-hex-char []
   (char (rand-nth (concat (range 48 58) (range 66 72)))))

@@ -37,7 +36,7 @@
   (reset! color (rand-hex))
   (reset! timer (js/Date.)))

-(defonce time-updater (js/setInterval interval 100))
+(defonce time-updater (js/setInterval interval 500))

 (defn clock []
   (let [time-str (-> @timer .toTimeString (clojure.string/split " ") first)]
@@ -63,8 +62,8 @@
 (secretary/defroute "/about" []
   (session/put! :current-page #'about-page))

-  (secretary/defroute "/clock" []
-    (session/put! :current-page #'clock-page))
+(secretary/defroute "/clock" []
+  (session/put! :current-page #'clock-page))

 ;; -------------------------
 ;; History


remove reflection warning

remove reflection warning

--- src/clojure/flambo/function.clj
+++ src/clojure/flambo/function.clj
@@ -2,8 +2,6 @@
   (:require [serializable.fn :as sfn]
             [flambo.kryo :as kryo]
             [flambo.cache :as cache]))
-
-(set! *warn-on-reflection* true)

 (defn- serfn? [f]
   (= (type f) :serializable.fn/serializable-fn))
@@ -67,4 +65,3 @@
 (gen-function PairFunction pair-function)
 (gen-function DoubleFunction double-function)
 (gen-function DoubleFlatMapFunction double-flat-map-function)
-


Catch errors

Catch errors

--- src/clojure/nightcode/utils.clj
+++ src/clojure/nightcode/utils.clj
@@ -159,12 +159,14 @@
 (defn tree-path-to-str
   "Gets the string path for the given JTree path object."
   [^TreePath tree-path]
-  (some-> tree-path
-          .getPath
-          last
-          .getUserObject
-          :file
-          .getCanonicalPath))
+  (try
+    (some-> tree-path
+            .getPath
+            last
+            .getUserObject
+            :file
+            .getCanonicalPath)
+    (catch Exception _)))

 (defn get-relative-path
   "Returns the selected path as a relative URI to the project path."


Add back core response logging with added request durations.

--- metlog-vault/src-server/metlog_vault/core.clj
+++ metlog-vault/src-server/metlog_vault/core.clj
@@ -56,17 +56,21 @@
   (GET "/dashboard" [] (render-dashboard))
   (route/not-found "Resource Not Found"))

-(defn wrap-request-logging [ app num ]
+                                        ; https://github.com/slester/browser-caching
+
+(defn wrap-request-logging [ app ]
   (fn [req]
-    (log/debug 'REQUEST (:request-method req) (:uri req))
-    (let [resp (app req)]
-      (log/debug 'RESPONSE (:status resp))
+    (log/trace 'REQ (:request-method req) (:uri req) (:params req))
+    (let [begin-t (. System (nanoTime))
+          resp (app req)]
+      (log/info 'RESP (:status resp) (:uri req) "-" (/ (- (. System (nanoTime)) begin-t) 1000000.0))
       resp)))

 (def handler (-> all-routes
                  (data/wrap-db-connection)
                  (ring-resource/wrap-resource "public")
                  (not-modified/wrap-not-modified)
+                 (wrap-request-logging)
                  (handler/site)))

 (defn start-webserver [ http-port ]


Add view post button at the bottom of the notify emails.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -526,6 +526,8 @@
       (spacer 16 "note-paragraph" "note-paragraph")
       (paragraph notification-html-content "note-paragraph note-left-padding" "text-left" "note-x-margin")
       (spacer 16 "note-paragraph bottom-note-paragraph" "note-paragraph bottom-note-paragraph")
+      (spacer 24)
+      (left-button "read_post" entry-url)
       (spacer 56)]))

 (defn- token-prep [token-type msg]


Fix typo

Fix typo

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -99,7 +99,7 @@
       obj)))

 (defn idify
-  "Attempts to convert all objs in col to a sc id. Mapjs objs to
+  "Attempts to convert all objs in col to a sc id. Maps objs to
    themselves if a conversion wasn't possible."
   [col]
   (map to-id col))


don't break everything

don't break everything

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -59,7 +59,8 @@
     [:meta {:charset    "utf-8"}]
     [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]

-    [:meta {:name "description" :content (or (strip-html (:meta-description view-data))
+    [:meta {:name "description" :content (or (when (seq (:meta-description view-data))
+                                               (strip-html (:meta-description view-data)))
                                              "Your wireframe should be easy to share with any developer on your team. Design fast with iPhone and iPad collaboration. Precursor is productive prototyping.")}]

     [:meta {:name "viewport"                              :content "width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no"}]


Add twitter share button

Add twitter share button

--- src/pict_source/site.clj
+++ src/pict_source/site.clj
@@ -4,17 +4,34 @@
             [pict-source.dictionary :as dictionary]))

 (def title "Pict")
+
 (def slogan "открытый словарь программистов")
+
 (def google-analytics-code
   "<script>
     (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
     (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
     m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
     })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
-
     ga('create', 'UA-47078794-4', 'auto');
     ga('send', 'pageview');
+  </script>")

+(def twitter-share-button
+  "<a href=\"https://twitter.com/share\" class=\"twitter-share-button\"
+    data-url=\"http://pict.divshot.io\"
+    data-text=\"Check this out: open, multi language programmers dictionary\">
+      Tweet
+  </a>
+  <script>
+    !function(d,s,id){
+      var js,fjs=d.getElementsByTagName(s)[0],
+      p=/^http:/.test(d.location)?'http':'https';
+      if(!d.getElementById(id)){
+        js=d.createElement(s);js.id=id;
+        js.src=p+'://platform.twitter.com/widgets.js';
+        fjs.parentNode.insertBefore(js,fjs);
+    }}(document, 'script', 'twitter-wjs');
   </script>")

 (defn layout [req content]
@@ -37,6 +54,7 @@
            [:a {:href (str "/" lang "/")} lang])]]]
       content
       [:footer {:class "row"}
+       [:p twitter-share-button]
        [:p {:class "copyright"}
         "© 2015 "
         [:a {:href "http://shvetsovdm.github.io"}


Fix back button navigation

Fix back button navigation

Former-commit-id: f32547aaf86067d24475818577531d074d94a239

--- src/messenger/android/core.cljs
+++ src/messenger/android/core.cljs
@@ -1,9 +1,9 @@
 (ns messenger.android.core
   (:require-macros
-    [natal-shell.components :refer [navigator view text image touchable-highlight list-view
-                                    toolbar-android]]
+    [natal-shell.components :refer [navigator view text image touchable-highlight
+                                    list-view toolbar-android]]
     [natal-shell.data-source :refer [data-source clone-with-rows]]
-    [natal-shell.back-android :refer [add-event-listener]]
+    [natal-shell.back-android :refer [add-event-listener remove-event-listener]]
     [natal-shell.core :refer [with-error-view]]
     [natal-shell.alert :refer [alert]])
   (:require [om.next :as om :refer-macros [defui]]
@@ -21,19 +21,21 @@

 (def app-registry (.-AppRegistry js/React))

-(def initialized-atom (atom false))
+(def back-button-handler-atom (atom {:nav nil
+                                     :handler nil}))
+
 (defn init-back-button-handler! [nav]
-  (if (not @initialized-atom)
-    (swap! initialized-atom
-           (fn [initialized]
-             (when (not initialized)
-               (add-event-listener "hardwareBackPress"
-                                   (fn []
-                                     (binding [state/*nav-render* false]
-                                       (when (< 1 (.-length (.getCurrentRoutes nav)))
-                                         (.pop nav)
-                                         true)))))
-             true))))
+  (let [back-button-handler @back-button-handler-atom]
+    (when (not= (:nav back-button-handler) nav)
+      (remove-event-listener "hardwareBackPress" (:handler back-button-handler))
+      (let [new-listener (fn []
+                           (binding [state/*nav-render* false]
+                             (when (< 1 (.-length (.getCurrentRoutes nav)))
+                               (.pop nav)
+                               true)))]
+        (reset! back-button-handler-atom {:nav nav
+                                          :handler new-listener})
+        (add-event-listener "hardwareBackPress" new-listener)))))

 (defui AppRoot
   static om/IQuery


Make web/start idempotent again [IMMUTANT-155]

--- modules/web/src/main/clojure/immutant/web.clj
+++ modules/web/src/main/clojure/immutant/web.clj
@@ -18,13 +18,11 @@
 (ns immutant.web
   "Associate one or more Ring handlers with your application, mounted
    at unique context paths"
-  (:require [immutant.registry     :as reg]
-            [clojure.tools.logging :as log]
-            [immutant.utilities :as util]
+  (:require [immutant.registry      :as reg]
+            [clojure.tools.logging  :as log]
+            [immutant.utilities     :as util]
             [ring.middleware.reload :as ring])
   (:use immutant.web.internal))
-
-

 (def  ^{:arglists '([context? handler & {:keys [reload]}])} start
   "Registers a Ring handler that will be called when requests are
@@ -44,14 +42,24 @@
                      handler
                      {:dirs [(util/app-relative "src")]})
                     handler)
-          sub-context-path (normalize-subcontext-path sub-context-path)]
-      (log/info "Registering ring handler at sub-context path:" sub-context-path)
-      (store-servlet-info! (servlet-name sub-context-path)
-                           {:wrapper (install-servlet "org.immutant.web.servlet.RingServlet"
-                                                      sub-context-path)
-                            :sub-context sub-context-path
-                            :handler handler})
+          sub-context-path (normalize-subcontext-path sub-context-path)
+          servlet-name (servlet-name sub-context-path)]
+      (if-let [existing-info (get-servlet-info servlet-name)]
+        (do
+          (log/info "Updating ring handler at sub-context path:" sub-context-path)
+          (store-servlet-info!
+           servlet-name
+           (assoc existing-info :handler handler)))
+        (do
+          (log/info "Registering ring handler at sub-context path:" sub-context-path)
+          (store-servlet-info!
+           servlet-name
+           {:wrapper (install-servlet "org.immutant.web.servlet.RingServlet"
+                                      sub-context-path)
+            :sub-context sub-context-path
+            :handler handler})))
       nil)))
+

 (defn stop
   "Deregisters the Ring handler attached to the given sub-context-path. If no sub-context-path is given,
@@ -66,3 +74,5 @@
            (remove-servlet sub-context-path (:wrapper info)))
          (log/warn "Attempted to deregister ring handler at sub-context path:" sub-context-path ", but none found")))))

+
+


Work around http://dev.clojure.org/jira/browse/ASYNC-176.

--- src/replikativ/core.cljc
+++ src/replikativ/core.cljc
@@ -11,7 +11,7 @@
             #?(:clj [full.async :refer [<? <<? <?? go-try go-loop-try alt?]])
             #?(:clj [full.lab :refer [go-for go-loop-super go-super]])
             #?(:clj [clojure.core.async :as async
-                     :refer [>! timeout chan put! pub sub unsub close!]]
+                     :refer [>! timeout chan put! pub sub unsub close! go]]
                :cljs [cljs.core.async :as async
                       :refer [>! timeout chan put! pub sub unsub close!]]))
   #?(:cljs (:require-macros [cljs.core.async.macros :refer (go go-loop alt!)]
@@ -142,7 +142,7 @@
    ;; we can update the in memory datastructure
    (<? (get-crdt cold-store mem-store [user crdt-id]))
    (let [[first-id id] (<? (k/append cold-store [user crdt-id :log] pub))
-         [old new]
+         [old-state new-state]
          (<? (k/update-in mem-store [[user crdt-id]]
                           (fn [{:keys [description public state crdt]}]
                             (let [state (or state (key->crdt (:crdt pub)))]
@@ -157,7 +157,7 @@
                                               :elem {:crdt (:crdt new)
                                                      :method :handshake
                                                      :op (-handshake (:state new))}})))
-     [old new])))
+     [old-state new-state])))

 (defn publish-in


(TK-33) Update non-proxied path test

(TK-33) Update non-proxied path test

Update non-proxied path test to verify that the ProxyServlet
can follow a redirect from the target server to a location
not under the original proxy path.

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_proxy_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_proxy_test.clj
@@ -68,7 +68,11 @@
        (add-ring-handler
          target-webserver#
          ~ring-handler
-         "/hello"))
+         "/hello")
+       (add-ring-handler
+         target-webserver#
+         ~ring-handler
+         "/goodbye"))
      (with-app-with-config proxy-app#
        [jetty9-service]
        {:webserver ~proxy}
@@ -499,7 +503,7 @@
           (is (= (:status response) 200))
           (is (= (:body response) "Hello, World!")))))

-    (testing "proxy-redirect to non-proxied path on correct host fails"
+    (testing "proxy-redirect to non-proxied path on correct host succeeds"
       (with-target-and-proxy-servers
         {:target       {:host "0.0.0.0"
                         :port 9000}
@@ -510,5 +514,9 @@
                         :path "/hello"}
          :proxy-opts   {:follow-redirects true}
          :ring-handler redirect-different-proxy-path}
+        (let [response (http-get (str "http://localhost:9000/hello"))]
+          (is (= (:status response) 200))
+          (is (= (:body response) "Hello, World!")))
         (let [response (http-get (str "http://localhost:10000/hello-proxy"))]
-          (is (= (:status response) 404)))))))
+          (is (= (:status response) 200))
+          (is (= (:body response) "Hello, World!")))))))


Add pre-post map and more typehints to translate

--- src/superstring/core.clj
+++ src/superstring/core.clj
@@ -587,10 +587,16 @@
   (translate \"gabba\" {\\a \\b} #{\\b}) => gbb
   (translate \"gabba\" {\\a nil} #{\\b}) => g"
   (^String
-   [^String s tmap]
+   [^String s ^clojure.lang.APersistentMap tmap]
+   {:pre [(string? s) (map? tmap)]
+    :post [(string? %)]}
    (translate s tmap #{}))
   (^String
-   [^String s tmap delete-chars]
+   [^String s
+    ^clojure.lang.APersistentMap tmap
+    ^clojure.lang.APersistentSet delete-chars]
+   {:pre [(string? s) (map? tmap) (set? delete-chars)]
+    :post [(string? %)]}
    (->> s
         (remove delete-chars)
         (map (fn [c] (let [replacement (get tmap c :not-found)]


Housekeeping

Housekeeping

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -635,7 +635,6 @@
   [creds table prim-key-conds
    & [{:keys [last-prim-kvs return index order limit consistent? return-cc?]
        :or   {order :asc}}]]
-  (println (query|scan-conditions prim-key-conds))
   (as-map
    (.query (db-client creds)
      (doto-maybe (QueryRequest.) g


Add LocalSecondaryIndexDescription `as-map` implementation

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -31,6 +31,7 @@
              KeySchemaElement
              KeysAndAttributes
              LocalSecondaryIndex
+             LocalSecondaryIndexDescription
              Projection
              ProvisionedThroughput
              ProvisionedThroughputDescription
@@ -230,7 +231,7 @@
      (when-let [c (.getConsistentRead  result)] {:consistent c})
      (when-let [k (.getKeys            result)] {:keys (utils/fmap as-map (into [] k))})))

-  ;; TODO CreateTableResult, ListTablesResult, UpdateTableResult
+  ;; TODO CreateTableResult, ListTablesResult, UpdateTableResult, Projection

   BatchGetItemResult
   (as-map [result]
@@ -247,13 +248,19 @@
       {:name          (.getTableName table)
        :creation-date (.getCreationDateTime table)
        :item-count    (.getItemCount table)
-       :size-bytes    (.getTableSizeBytes table)
+       :size          (.getTableSizeBytes table)
        :key-schema    (as-map (.getKeySchema table))
        :throughput    (as-map (.getProvisionedThroughput table))
-       ;; :indexes    (as-map (.getLocalSecondaryIndexes table)) ; TODO
+       :indexes       (as-map (.getLocalSecondaryIndexes table))
        :status        (-> (.getTableStatus table) (str/lower-case) (keyword))}))

-  ;; LocalSecondaryIndexDescription ; TODO
+  LocalSecondaryIndexDescription
+  (as-map [idx]
+    {:name       (.getIndexName idx)
+     :size       (.getIndexSizeBytes idx)
+     :item-count (.getItemCount idx)
+     :key-schema (as-map (.getKeySchame idx))
+     :projection (as-map (.getProjection idx))})

   ProvisionedThroughputDescription
   (as-map [throughput]


Cosmetics.

Cosmetics.

--- clojure/src/advent2017/day9.clj
+++ clojure/src/advent2017/day9.clj
@@ -6,7 +6,7 @@
 (def puzzle (read-puzzle "day9.data" (comp first ->lines)))

 (defn solve [input]
-  (reduce (fn [{:keys [mode depth depths garbage] :as state} c]
+  (reduce (fn [{:keys [mode depth] :as state} c]
             (case mode
               :group   (case c
                          \{ (-> state


humph

humph

--- clojure/src/dnd/showScreen.cljs
+++ clojure/src/dnd/showScreen.cljs
@@ -12,7 +12,10 @@
         ]
     (.color256    term 7)
     (.bgColor256  term 0)
-    (dorun (map #(let [[x y] %] (.moveTo term x y "X")) coords))
+    (dorun (map
+             #(let [[x y] %
+                    y (inc y)]
+                (.moveTo term x y "X")) coords))
     ))

 (defn draw-block [term block]


Adds pick

Adds pick

--- src/the_little_clojurian/chapter4.clj
+++ src/the_little_clojurian/chapter4.clj
@@ -171,3 +171,16 @@
   (is (= (length '(hotdogs)) 1))
   (is (= (length '(hotdogs with mustard sauerkraut and pickles)) 6))
   (is (= (length '(ham and cheese on rye)) 5)))
+
+(with-test
+  (def pick
+    (fn [n lat]
+      (cond (zero? n) nil
+            (zero? (sub1 n)) (car lat)
+            :else (pick (sub1 n) (cdr lat)))))
+
+  (is (= (pick 0 '(apple)) nil))
+  (is (= (pick 1 '()) nil))
+  (is (= (pick 1 '(apple)) 'apple))
+  (is (= (pick 2 '(apple bananas)) 'bananas))
+  (is (= (pick 4 '(apple)) nil)))


Fix useful.datatype for clojure 1.4.

Fix useful.datatype for clojure 1.4.

In particular, stop un-munging __meta back to --meta - the former
works fine and has fewer moving parts, and the latter is broken in
1.4 (their bug, not ours, AFAICT).

--- src/useful/datatypes.clj
+++ src/useful/datatypes.clj
@@ -7,8 +7,6 @@

 (defn- normalize-field-name [field]
   (-> (name field)
-      (s/replace #"_QMARK_" "?")
-      (s/replace #"_"       "-")
       symbol))

 (defn- ^Class coerce-class
@@ -37,7 +35,7 @@
                          (if-let [i (index (normalize-field-name field))]
                            (assoc vals i val)
                            (assoc-in vals
-                             [(index '--extmap) (keyword field)] val)))
+                             [(index '__extmap) (keyword field)] val)))
                        (vec (repeat (count fields) nil))
                        (into-map attrs))]
     `(new ~type ~@vals)))
@@ -79,7 +77,7 @@
                          (if-let [i (index (normalize-field-name field))]
                            (assoc vals
                              i (apply list f (get vals i) args))
-                           (let [i (index '--extmap)]
+                           (let [i (index '__extmap)]
                              (assoc vals
                                i (apply list `update (get vals i) (keyword field) args)))))
                        (vec (map #(list '. r %) fields))


Improve the state chooser item code ever so slightly

--- src/web/components/state_chooser.cljs
+++ src/web/components/state_chooser.cljs
@@ -12,15 +12,11 @@
     [:id :name :type])
   Object
   (render [this]
-    (let [{:keys [id name type]} (om/props this)]
+    (let [{:keys [id name type]} (om/props this)
+          prefixes #"refs/heads/|refs/remotes/|refs/tags/"]
       (dom/option #js {:value id}
-        (condp = type
-          :branch "b "
-          :tag "t "
-          " ")
-        (str/replace name
-                     #"refs/heads/|refs/remotes/|refs/tags/"
-                     "")))))
+        (condp = type :branch "b " :tag "t " " ")
+        (str/replace name prefixes "")))))

 (def state-chooser-item (om/factory StateChooserItem {:keyfn :id}))


Add open chan to MPD socket to handle connection event

--- src/zirconia/socket.cljs
+++ src/zirconia/socket.cljs
@@ -55,26 +55,46 @@
            write-ch (chan 10 (map event->command))
            read-ch (chan)
            buffer-ch (chan)
+           open-ch (chan)
            socket-ch (socket-chan read-ch
                                   write-ch
                                   {:on-close (fn [] (close-socket socket))})]

-       (go-loop []
-         ;; process one command at a time
-         (let [command (<! write-ch)
-               block-ch (chan)]
-           (.write socket command
-                   (fn []
-                     (go
-                       (let [response (<! process-ch)
-                             event (command->event command)]
-                         (>! read-ch (assoc event :response response))
-                         (close! block-ch)))))
-           (<! block-ch)
-           (recur)))
+       (go-loop [connection false]
+         ;; wait until open connection
+         (if-not connection
+           (do (<! open-ch)
+               (recur true))
+
+           ;; process one command at a time
+           (let [command (<! write-ch)
+                 block-ch (chan)]
+             (.write socket command
+                     (fn []
+                       (go
+                         (let [response (<! process-ch)
+                               event (command->event command)]
+                           (>! read-ch (assoc event :response response))
+                           (close! block-ch)))))
+             (<! block-ch)
+             (recur true))))

        (.on socket "data"
-            (fn [data] (put! buffer-ch (str data))))
+            (fn [data]
+              (put! buffer-ch (str data))))
+
+       (.on socket "connect"
+            (fn []
+              (.log js/console (str "Connected to MPD: " host ":" port))
+              (close! open-ch)))
+
+       (.on socket "error"
+            (fn [error]
+              (.log js/console (pr-str error))))
+
+       (.on socket "close"
+            (fn [_]
+              (.log js/console "Connection to MPD closed")))

        ;; TODO: abstract this code out of connect fn
        ;;       so that it is more generic/reusable
@@ -85,6 +105,7 @@

              #"^OK MPD.*"
              (do
+               (.log js/console data)
                (>! read-ch {:command :ok-mpd
                             :args []
                             :response data})
@@ -92,7 +113,7 @@

              #"^ACK"
              (do
-               (.log js/console data)
+               (.log js/console (str "ACK: " data))
                (recur ""))

              #"^OK$"


Use clearTimeout and propagate closed state correctly.

--- src/ago/core.cljs
+++ src/ago/core.cljs
@@ -136,6 +136,7 @@
   (closed? [_]
     (get-in @ago-world [:closed buf-id] false))
   (close! [this]
+    (set! (.-closed m2m-ch) (protocols/closed? this))
     (swap! ago-world #(assoc-in % [:closed buf-id] true))
     (protocols/close! m2m-ch)))

@@ -257,8 +258,7 @@
 (defn ssa-take [state blk ^not-native c]
   (let [ago-ch (aget state ioc-helpers/USER-START-IDX)
         ago-world (chan-ago-world ago-ch)
-        active? #(and (seqv-alive? ago-world (chan-seqv ago-ch))
-                      (seqv-alive? ago-world (chan-seqv c)))]
+        active? #(seqv-alive? ago-world (chan-seqv ago-ch))]
     (if-let [cb (protocols/take!
                  c (fn-handler
                     active?
@@ -276,8 +276,7 @@
 (defn ssa-put [state blk ^not-native c val]
   (let [ago-ch (aget state ioc-helpers/USER-START-IDX)
         ago-world (chan-ago-world ago-ch)
-        active? #(and (seqv-alive? ago-world (chan-seqv ago-ch))
-                      (seqv-alive? ago-world (chan-seqv c)))]
+        active? #(seqv-alive? ago-world (chan-seqv ago-ch))]
     (if-let [cb (protocols/put!
                  c val
                  (fn-handler
@@ -328,7 +327,7 @@
 (defn timeout-handler [ago-world]
   (swap! ago-world seqv+) ; Updates logical-ms.
   (swap! curr-js-timeout-id (fn [x]
-                              (when x (js/cancelTimeout x))
+                              (when x (js/clearTimeout x))
                               nil))
   (let [logical-ms (:logical-ms @ago-world)
         timeouts2 (loop [timeouts (:timeouts @ago-world)]
@@ -340,9 +339,8 @@
                         timeouts)))]
     (swap! ago-world #(assoc % :timeouts timeouts2))
     (when-let [[soonest-ms chs] (first timeouts2)]
-      (let [tid (js/setTimeout (fn [] (timeout-handler ago-world))
-                               (- soonest-ms logical-ms))]
-        (reset! curr-js-timeout-id tid)))))
+      (reset! curr-js-timeout-id (js/setTimeout (fn [] (timeout-handler ago-world))
+                                                (max 0 (- soonest-ms logical-ms)))))))

 (defn ago-timeout [ago-world delay-ms] ; Logical milliseconds from now.
   (let [timeout-at (+ delay-ms (:logical-ms @ago-world))


tmp fix for test data file path

tmp fix for test data file path

--- src/spcr/core.clj
+++ src/spcr/core.clj
@@ -13,7 +13,12 @@
             [spcr.parser :as parser :refer [file->dicts]])
   (:import [com.mongodb MongoOptions ServerAddress]))

-(def test-data "../resources/data/PEB_ETF.csv")
+(def test-data  (str
+                 (clojure.string/replace
+                  (-> (java.io.File. ".") .getAbsolutePath)
+                  #"\."
+                  "")
+                 "PEB_ETF.csv"))
 (def testp "/home/cab/DEV/projects/spcr/resources/data/PEB_ETF.csv")

 (defroutes endpoints


remove cake.tasks.run from defaults

remove cake.tasks.run from defaults

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -40,7 +40,7 @@
         [tasks task-opts] (split-with symbol? (:tasks opts))
         task-opts (apply hash-map task-opts)]
     `(do (alter-var-root #'*project* (fn [_#] (cake.project/create '~name ~version '~opts)))
-         (require '~'[cake.tasks help run jar test compile dependencies release swank clean version])
+         (require '~'[cake.tasks help jar test compile dependencies release swank clean version])
          ~@(for [ns tasks]
              `(try-load (require '~ns)))
          (undeftask ~@(:exclude task-opts)))))


simplify view code and use proper async non-blocking push

--- src/caws/core.clj
+++ src/caws/core.clj
@@ -106,7 +106,6 @@

        (route (keyword (.toLowerCase command)) path in-chan out-chan)
        (go-loop [token (<! out-chan)]
-                (println "TOKEN" token)
                 (cond
                  (instance? Long token)
                  (do (.write socket-channel (string->buffer (str "HTTP " token "\n")))
@@ -198,53 +197,59 @@
                           (let [next (mappings prefix)]
                             (if (instance? java.util.Map next)
                               (route* next full-path (.substring path (count prefix)) in-chan out-chan)
-                              (go
-                               (binding [*out-channel out-chan
-                                         *in-channel in-chan
-                                         *path path
-                                         *response-code nil]
-                                 (try
-                                  (next)
-                                  (catch Exception e
-                                    (>! out-chan 500)
-                                    (>! out-chan :body)
-                                    (>! out-chan (str e))
-                                    (>! out-chan :end))
-                                  ))))
+                              (next path in-chan out-chan))
                             )
                           (recur (rest prefixes))
                           )
                         ))))]
     (fn [command path in-chan out-chan]
-      (println "command = " command)
       (route** (mappings command) path path in-chan out-chan))))

-(defn send-code [code]
-  (set! *response-code code)
-  (>!! *out-channel
-      (condp = code
-        :ok 200
-        :error 500
-        :bad-response 400
-        :not-found 404)))
-
-(defn send-headers [headers]
-  (if (nil? *response-code)
-    (send-code :ok))
-
-  (>!! *out-channel :headers)
-  (>!! *out-channel headers))
-
-(defn send-body [body]
-  (>!! *out-channel :body)
-  (>!! *out-channel body)
-  (>!! *out-channel :end))
-
-(defn home []
+(defmacro send-code [code]
+  `(let [o# ~'out-chan code# ~code]
+     (set! ~'*response-code code#)
+     (>! o#
+         (condp = code#
+           :ok 200
+           :error 500
+           :bad-response 400
+           :not-found 404))))
+
+(defmacro send-headers [headers]
+  `(let [o# ~'out-chan]
+     (if (nil? ~'*response-code)
+       (send-code :ok))
+
+     (>! o# :headers)
+     (>! o# ~headers)))
+
+(defmacro send-body [body]
+  `(let [o# ~'out-chan]
+     (>! o# :body)
+     (>! o# ~body)
+     (>! o# :end)))
+
+(defmacro write-error [e]
+  `(let [o# ~'out-chan]
+     (>! o# 500)
+     (>! o# :body)
+     (>! o# (str ~e))
+     (>! o# :end)))
+
+(defmacro view [name & body]
+  `(defn ~name [~'path ~'in-chan ~'out-chan]
+     (go
+      (binding [~'*response-code nil]
+        (try
+         ~@body
+         (catch Exception e
+           (write-error e)))))))
+
+(view home
   (send-headers {:content-type "text"})
   (send-body "This is the home page\n"))

-(defn bing []
+(view bing
   (send-headers {:content-type "text"})
   (send-body "This is the Bing\n"))


Use protocol instead of multi method

Use protocol instead of multi method

--- src/cljam/lsb.clj
+++ src/cljam/lsb.clj
@@ -10,46 +10,52 @@
   ([size]
      (.order (ByteBuffer/allocate size) ByteOrder/LITTLE_ENDIAN)))

-(defmulti skip (fn [r & _] (class r)))
+;;; skip

-(defmethod skip DataInputStream
-  [^DataInputStream rdr ^Integer n]
-  (.skipBytes rdr n)
-  nil)
+(defprotocol Skippable
+  (skip [this n]))

-(defmethod skip ByteBuffer
-  [^ByteBuffer bb ^Integer n]
-  (.position bb (+ (.position bb) n))
-  nil)
+(extend-protocol Skippable
+  DataInputStream
+  (skip [^DataInputStream rdr n]
+    (.skipBytes rdr n)
+    nil)
+  ByteBuffer
+  (skip [^ByteBuffer bb n]
+    (.position bb (+ (.position bb) n))
+    nil))

 ;;; reading

-(defmulti read-bytes (fn [r & _] (class r)))
+(defprotocol BytesReadble
+  (read-bytes [this l] [this buffer offset l]))

-(defmethod read-bytes DataInputStream
-  ([^DataInputStream rdr l]
-     (let [ba (byte-array l)]
-       (.read rdr ba 0 l)
-       ba))
-  ([^DataInputStream rdr buffer offset l]
-     (loop [total-read 0]
-       (when (< total-read l)
-         (let [n (.read rdr buffer (+ offset total-read) (- l total-read))]
-           (if (neg? n)
-             (throw (EOFException. "Premature EOF"))
-             (recur (+ total-read n))))))))
-
-(defmethod read-bytes ByteBuffer
-  ([^ByteBuffer bb len]
-     (let [ba (byte-array len)]
-       (.get bb ba 0 len)
-       ba))
-  ([^ByteBuffer bb buffer offset len]
-     (.get bb buffer offset len)))
+(extend-protocol BytesReadble
+  DataInputStream
+  (read-bytes
+    ([^DataInputStream rdr l]
+       (let [ba (byte-array l)]
+         (.read rdr ba 0 l)
+         ba))
+    ([^DataInputStream rdr buffer offset l]
+       (loop [total-read 0]
+         (when (< total-read l)
+           (let [n (.read rdr buffer (+ offset total-read) (- l total-read))]
+             (if (neg? n)
+               (throw (EOFException. "Premature EOF"))
+               (recur (+ total-read n))))))))
+  ByteBuffer
+  (read-bytes
+    ([^ByteBuffer bb len]
+       (let [ba (byte-array len)]
+         (.get bb ba 0 len)
+         ba))
+    ([^ByteBuffer bb buffer offset len]
+       (.get bb buffer offset len))))

 (defn- read-byte-buffer
   [rdr ^ByteBuffer bb l]
-  {:pre (< l (.capacity bb))}
+  {:pre (<= l (.capacity bb))}
   (read-bytes rdr (.array bb) 0 l)
   (.limit bb (.capacity bb))
   (.position bb l))


Remove unused functions.

Remove unused functions.

--- src/uxbox/main/data/colors.cljs
+++ src/uxbox/main/data/colors.cljs
@@ -15,20 +15,6 @@
             [uxbox.main.state :as st]
             [uxbox.main.repo :as rp]))

-;; --- Helpers
-
-(defn- assoc-collection
-  [state coll]
-  (let [id (:id coll)
-        coll (assoc coll :type :own)]
-    (assoc-in state [:color-colls-by-id id] coll)))
-
-(defn- dissoc-collection
-  "A reduce function for dissoc the color collection
-  to the state map."
-  [state id]
-  (update state :color-colls-by-id dissoc id))
-
 ;; --- Initialize

 (declare fetch-collections)


Remove wrong preconditions on projects services.

--- src/uxbox/services/projects.clj
+++ src/uxbox/services/projects.clj
@@ -132,13 +132,11 @@

 (defn- decode-page-metadata
   [{:keys [page-metadata] :as result}]
-  (s/assert ::us/bytes page-metadata)
   (merge result (when page-metadata
                   {:page-metadata (-> page-metadata blob/decode t/decode)})))

 (defn- decode-page-data
   [{:keys [page-data] :as result}]
-  (s/assert ::us/bytes page-data)
   (merge result (when page-data
                   {:page-data (-> page-data blob/decode t/decode)})))


Two additional tests added

Two additional tests added

--- test/clj_fileutils/fileutils_test.clj
+++ test/clj_fileutils/fileutils_test.clj
@@ -54,3 +54,13 @@
     (testing "if the clj-fileutils.fileutils/move-file function definition exists."
         (is (callable? 'clj-fileutils.fileutils/move-file))))

+(deftest test-make-temporary-log-file-name-existence
+    "Check that the clj-fileutils.fileutils/make-temporary-log-file-name function definition exists."
+    (testing "if the clj-fileutils.fileutils/make-temporary-log-file-name function definition exists."
+        (is (callable? 'clj-fileutils.fileutils/make-temporary-log-file-name))))
+
+(deftest test-make-temporary-directory-existence
+    "Check that the clj-fileutils.fileutils/make-temporary-directory function definition exists."
+    (testing "if the clj-fileutils.fileutils/make-temporary-directory function definition exists."
+        (is (callable? 'clj-fileutils.fileutils/make-temporary-directory))))
+


fix name

fix name


Add exception to log message when exporting a metric fails.

--- src/wonko/export/prometheus.clj
+++ src/wonko/export/prometheus.clj
@@ -9,7 +9,6 @@
            io.prometheus.client.hotspot.DefaultExports
            java.util.concurrent.locks.ReentrantLock
            java.io.StringWriter))
-

 (defonce
   ^{:doc "This contains prometheus created metrics in a map of the form:
@@ -47,15 +46,15 @@
             created-registry)))))

 (defn register-event [{:keys [service metric-value properties] :as event}]
-  ;; FIXME: This is a broad fix to make this function thread-safe. We should
-  ;; understand the problem better and apply the fix in a more localized way.
   (try
     (let [registry (get-or-create-registry service)
           metric (get-or-create-metric registry event)
           label-values (get-label-values properties)]
       (register/metric metric (assoc event :label-values label-values)))
     (catch Exception e
-      (log/info {:msg "unable to register event in prometheus" :event event}))))
+      (log/info {:msg "unable to register event in prometheus"
+                 :event event
+                 :exception (bean e)}))))

 (defn metrics-endpoint [service]
   (let [registry (get-in @created-metrics [service :registry])


New test to confirm we don't create duplicated relationships

--- test/tropefest/test/parsing_nodes.clj
+++ test/tropefest/test/parsing_nodes.clj
@@ -1,5 +1,6 @@
 (ns tropefest.test.parsing-nodes
   (:require [clojure.test :refer :all]
+            [clojurewerkz.neocons.rest.cypher :as cy]
             [tropefest.test.db-nodes :as tdb]
             [tropefest.test.parsing :as tp]
             [tropefest.parsing :refer :all]
@@ -109,6 +110,24 @@
                           :url "http://tvtropes.org/pmwiki/pmwiki.php/Main/TakeMeInstead")
     ))

+(deftest test-record-page-twice
+  ; See note on test-record-page-local about the provenance URL
+  ;
+  ; On this test I query for the links directly using cypher instead of our
+  ; helper functions since those already do DISTINCT and would not return
+  ; duplicates.
+  (tdb/wipe-test-db)
+  (let [path  (str tp/test-file-path "TakeMeInstead-pruned.html")
+        conn  (tdb/get-test-connection)
+        saved (record-page! conn path "http://tvtropes.org/pmwiki/pmwiki.php/Main/TakeMeInstead")
+        again (record-page! conn path "http://tvtropes.org/pmwiki/pmwiki.php/Main/TakeMeInstead")
+        links (cy/tquery conn "MATCH (n:Main {id:'Main/TakeMeInstead'})-[r]->() RETURN r")
+        ]
+    (is (= (count saved) 5))                                ; There's only five links on the file
+    (is (= (count again) 5))                                ; Same number of links is returned the second time
+    (is (= (count links) 5))                                ; No duplicated links are created
+    ))
+
 (deftest test-record-page-with-redirect
   ; On this test we pass a provenance URL which will differ from the page's og:url
   ; so that we can test that:


Handle case where multiple users have same token, get only distinct tokens on channel.

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -74,7 +74,7 @@

 (defn get-user-tokens-on-channel
   [channel-id]
-  (map get-user-token (get-channel-subscribers channel-id)))
+  (distinct (map get-user-token (get-channel-subscribers channel-id))))

 (defn add-event-to-channel-db
   [channel-id event]


Move join game to own event

Move join game to own event

--- src/gin/games.clj
+++ src/gin/games.clj
@@ -232,6 +232,52 @@
   [event player]
   (str (:event/type event)))

+(defn event-join-game [game player]
+  {:event :join-game
+   :game-id (:game/id game)
+   :player1 (get-in game [:game/player1 :account/name])
+   :player2 (get-in game [:game/player2 :account/name])
+   :us player
+   :to-start (if (= (:game/to-start game) (:game/player1 game))
+               :player1
+               :player2)
+   :turn (if (= (:game/turn game) (:game/player1 game))
+           :player1
+           :player2)
+   :result
+   (when-let [result (:game/result game)]
+     (if-let [winner (:game/winner game)]
+       (if (or (and (= player :player1)
+                    (= (:game/winner game) (:game/player1 game)))
+               (and (= player :player2)
+                    (= (:game/winner game) (:game/player2 game))))
+         :our-win
+         :opp-win)
+       :pat-tie)
+     )
+   :discards
+   (->> (iterate :card.discard/next (:game/discard game))
+        (take-while identity)
+        reverse
+        (mapv (fn [card]
+                {:suit (:card/suit card)
+                 :rank (:card/rank card)})))
+   :our-cards (mapv (fn [card]
+                      {:suit (:card/suit card)
+                       :rank (:card/rank card)})
+                    (get game (if (= player :player1)
+                                :game/player1-cards
+                                :game/player2-cards)))
+   :their-cards
+   (for [card  (get game (if (= player :player1)
+                           :game/player2-cards
+                           :game/player1-cards))]
+     (if (:game/result game)
+       {:suit (:card/suit card)
+        :rank (:card/rank card)}
+       {:suit :hidden
+        :rank :hidden}))})
+
 (defresource game-events
   :available-media-types ["text/event-stream"]
   :allowed? (fn [ctx]
@@ -279,54 +325,10 @@
                                                   latest-tx (get-in ctx [:game :game/last-event :event/tx :db/id])
                                                   from-t (d/tx->t latest-tx)
                                                   game (get-in ctx [:game])]
-
                                               (debug "latest-tx: " latest-tx (d/touch (get-in ctx [:game :game/last-event])))
                                               (async/put! c (str "id: " from-t "\r\n"
                                                            "data: "
-                                                           {:event :join-game
-                                                            :game-id (:game/id game)
-                                                            :player1 (get-in game [:game/player1 :account/name])
-                                                            :player2 (get-in game [:game/player2 :account/name])
-                                                            :us player
-                                                            :to-start (if (= (:game/to-start game) (:game/player1 game))
-                                                                        :player1
-                                                                        :player2)
-                                                            :turn (if (= (:game/turn game) (:game/player1 game))
-                                                                    :player1
-                                                                    :player2)
-                                                            :result
-                                                            (when-let [result (:game/result game)]
-                                                              (if-let [winner (:game/winner game)]
-                                                                (if (or (and (= player :player1)
-                                                                             (= (:game/winner game) (:game/player1 game)))
-                                                                        (and (= player :player2)
-                                                                             (= (:game/winner game) (:game/player2 game))))
-                                                                  :our-win
-                                                                  :opp-win)
-                                                                :pat-tie)
-                                                              )
-                                                            :discards
-                                                            (->> (iterate :card.discard/next (:game/discard game))
-                                                                 (take-while identity)
-                                                                 reverse
-                                                                 (mapv (fn [card]
-                                                                         {:suit (:card/suit card)
-                                                                          :rank (:card/rank card)})))
-                                                            :our-cards (mapv (fn [card]
-                                                                               {:suit (:card/suit card)
-                                                                                :rank (:card/rank card)})
-                                                                             (get game (if (= player :player1)
-                                                                                :game/player1-cards
-                                                                                :game/player2-cards)))
-                                                            :their-cards
-                                                            (for [card  (get game (if (= player :player1)
-                                                                                :game/player2-cards
-                                                                                :game/player1-cards))]
-                                                              (if (:game/result game)
-                                                                {:suit (:card/suit card)
-                                                                 :rank (:card/rank card)}
-                                                                {:suit :hidden
-                                                                 :rank :hidden}))}
+                                                           (event-join-game game player)
                                                            "\r\n\r\n"))
                                               from-t)
                                             0 ;; game hasn't started


Add simpler nested tags test

Add simpler nested tags test

--- test/datemo/arb_test.clj
+++ test/datemo/arb_test.clj
@@ -29,6 +29,11 @@
            (html->arb (html [:div "A"] [:div "B"]))
            (build-arb [[:arb {:original-tag :div} "A"]
                        [:arb {:original-tag :div} "B"]]))))
+    (testing "nested tags"
+      (is (=
+           (build-arb[[:arb {:original-tag :div} "parent"
+                       [:arb {:original-tag :p} "child"]]])
+           (html->arb (html [:div "parent" [:p "child"]])))))
     (testing "with nested tag in middle of text"
       (is (= (html->arb (html [:p "Paragraph with " [:strong "bold"] " text."]))
              (build-arb [[:arb {:original-tag :p}


4Clojure (~58)

4Clojure (~58)

--- 4clojure/4clojure.clj
+++ 4clojure/4clojure.clj
@@ -390,3 +390,32 @@
       {}
       (let [[x xs] ((juxt first rest) xss)]
         (conj (foo (filter #(not= x %) xs)) [x (count (filter #(= x %) xss))])))))
+
+; 56
+(def fifty-six
+  (fn dist [xs]
+    (if (empty? xs)
+      '()
+      (cons (first xs) (dist (filter #(not= (first xs) %) xs))))))
+
+(= (fifty-six [1 2 1 3 1 2 4]) [1 2 3 4])
+(= (fifty-six [:a :a :b :b :c :c]) [:a :b :c])
+(= (fifty-six '([2 4] [1 2] [1 3] [1 3])) '([2 4] [1 2] [1 3]))
+(= (fifty-six (range 50)) (range 50))
+
+; 57
+(def fifty-seven '(5 4 3 2 1))
+
+( = fifty-seven ((fn foo [x] (when (> x 0) (conj (foo (dec x)) x))) 5))
+
+; 58
+(def fifty-eight
+  (fn cp [f & fs]
+    (if (nil? fs)
+      (fn [& i] (apply f i))
+      (fn [& i] (f (apply (apply cp fs) i))))))
+
+(= [3 2 1] ((fifty-eight rest reverse) [1 2 3 4]))
+(= 5 ((fifty-eight (partial + 3) second) [1 2 3 4]))
+(= true ((fifty-eight zero? #(mod % 8) +) 3 5 7 9))
+(= "HELLO" ((fifty-eight #(.toUpperCase %) #(apply str %) take) 5 "hello world"))


Modify cross entropy loss to support nils (missing values) in target vector

--- cortex/src/cortex/optimise.cljc
+++ cortex/src/cortex/optimise.cljc
@@ -438,14 +438,16 @@
   cp/PLossFunction
   (loss [this v target]
     ;;np.sum(np.nan_to_num(-y*np.log(a)-(1-y)*np.log(1-a)))
-    (let [a (m/mul (m/negate target) (m/log (m/add SMALL-NUM v)))
+    (let [target (process-nulls v target)
+          a (m/mul (m/negate target) (m/log (m/add SMALL-NUM v)))
           b (m/mul (m/sub 1.0 target) (m/log (m/sub (+ 1.0 (double SMALL-NUM)) v)))
           c (/ (double (m/esum (m/sub a b)))
                (double (m/ecount v)))]
       c))

   (loss-gradient [this v target]
-    (m/sub v target)))
+    (let [target (process-nulls v target)]
+      (m/sub v target))))

 (defn cross-entropy-loss [] (->CrossEntropyLoss))


Adding default param for job routes creationg function.

--- common-app-lib/src/cmr/common_app/api/routes.clj
+++ common-app-lib/src/cmr/common_app/api/routes.clj
@@ -52,31 +52,33 @@
 (defn job-api-routes
   "Creates common routes for managing jobs such as pausing and resuming. The caller must have
   system ingest management update permission to call any of the jobs routes."
-  [additional-job-routes]
-  (context "/jobs" []
-    ;; Pause all jobs
-    (POST "/pause" {:keys [request-context params headers]}
-      (let [context (acl/add-authentication-to-context request-context params headers)]
-        (acl/verify-ingest-management-permission context :update)
-        (jobs/pause-jobs (get-in context [:system :scheduler]))
-        {:status 204}))
+  ([]
+   (job-api-routes nil))
+  ([additional-job-routes]
+   (context "/jobs" []
+     ;; Pause all jobs
+     (POST "/pause" {:keys [request-context params headers]}
+       (let [context (acl/add-authentication-to-context request-context params headers)]
+         (acl/verify-ingest-management-permission context :update)
+         (jobs/pause-jobs (get-in context [:system :scheduler]))
+         {:status 204}))

-    ;; Resume all jobs
-    (POST "/resume" {:keys [request-context params headers]}
-      (let [context (acl/add-authentication-to-context request-context params headers)]
-        (acl/verify-ingest-management-permission context :update)
-        (jobs/resume-jobs (get-in context [:system :scheduler]))
-        {:status 204}))
+     ;; Resume all jobs
+     (POST "/resume" {:keys [request-context params headers]}
+       (let [context (acl/add-authentication-to-context request-context params headers)]
+         (acl/verify-ingest-management-permission context :update)
+         (jobs/resume-jobs (get-in context [:system :scheduler]))
+         {:status 204}))

-    ;; Retrieve status of jobs - whether they are paused or active
-    (GET "/status" {:keys [request-context params headers]}
-      (let [context (acl/add-authentication-to-context request-context params headers)]
-        (acl/verify-ingest-management-permission context :update)
-        (let [paused? (jobs/paused? (get-in context [:system :scheduler]))]
-          {:status 200
-           :body (json/generate-string {:paused paused?})})))
+     ;; Retrieve status of jobs - whether they are paused or active
+     (GET "/status" {:keys [request-context params headers]}
+       (let [context (acl/add-authentication-to-context request-context params headers)]
+         (acl/verify-ingest-management-permission context :update)
+         (let [paused? (jobs/paused? (get-in context [:system :scheduler]))]
+           {:status 200
+            :body (json/generate-string {:paused paused?})})))

-    additional-job-routes))
+     additional-job-routes)))

 (defn health-api-routes
   "Creates common routes for checking the health of a CMR application. Takes a health-fn which