some work on new mouse handler

some work on new mouse handler

--- src/cljs/triangulator/definitions.cljs
+++ src/cljs/triangulator/definitions.cljs
@@ -226,22 +226,44 @@
                      " value: " value)
             (when (= channel ctr-chan)
               (do
+                ;; when different than current
                 (>! out (dt/point [20 20]))
                 (println "changing to state: " value)
                 (recur value state)))
+
             (condp = item
-              :none (do
-                      (println "item = :none state = " state)
-                      (recur item state))
-              :point (do
-                      (println "item = :point state = " state)
-                      (recur item state))
-              :line (do
-                      (println "item = :line state = " state)
-                      (recur item state))
-              :triangle (do
-                      (println "item = :triangle state = " state)
-                      (recur item state)))
+              :none
+              (do
+                (println "item = :none state = " state)
+                (recur item state))
+              :point
+              (do
+                (println "item = :point state = " state)
+                (condp = channel
+                  move
+                  (do ;; clear-screen draw-state draw-point-coords
+                    (>! draw-chan clear)
+                    (>! draw-chan [;; style
+                                   (dt/style {:stroke :lt-grey
+                                              :fill :red})
+                                   (dt/line [value (project-x value)])
+                                   (dt/line [value (project-y value)])
+                                   (dt/point value)])
+                    (recur :point state))
+                  click
+                  (do ;; add point to state; reset loop
+                    (>! out (dt/point value))
+                    (recur :point :none))))
+
+              :line
+              (do
+                (println "item = :line state = " state)
+                (recur item state))
+
+              :triangle
+              (do
+                (println "item = :triangle state = " state)
+                (recur item state)))
             (recur item state)
             )))
     out))


Move the tags list under the headline instead of above.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -339,18 +339,18 @@
                    :class "row digest-post-block"
                    :height "16px"
                    :style (vertical-space-style 16)}
-                 (when (seq (:labels entry))
-                   [:tr
-                     [:td
-                       [:div.oc-labels
-                         (for [label (:labels entry)]
-                           (label-block label))]]])
                   [:tr
                     [:td
                       [:span.digest-post-attribution
                         [:span.digest-post-attribution-name (:name publisher)]
                         " in "
                         [:span.digest-post-attribution-board (:board-name entry)]]]]
+                  (when (seq (:labels entry))
+                    [:tr
+                     [:td
+                      [:div.oc-labels
+                       (for [label (:labels entry)]
+                         (label-block label))]]])
                   [:tr
                     [:td
                       [:span.digest-post-headline-row


Install clojure 1.10.0 in lein variants

Install clojure 1.10.0 in lein variants

--- src/docker_clojure/dockerfile/lein.clj
+++ src/docker_clojure/dockerfile/lein.clj
@@ -35,8 +35,8 @@
         "ENV PATH=$PATH:$LEIN_INSTALL"
         "ENV LEIN_ROOT 1"
         ""
-        "# Install clojure 1.9.0 so users don't have to download it every time"
-        "RUN echo '(defproject dummy \"\" :dependencies [[org.clojure/clojure \"1.9.0\"]])' > project.clj \\"
+        "# Install clojure 1.10.0 so users don't have to download it every time"
+        "RUN echo '(defproject dummy \"\" :dependencies [[org.clojure/clojure \"1.10.0\"]])' > project.clj \\"
         "  && lein deps && rm project.clj"
         ""
         "CMD [\"lein\", \"repl\"]"])


breaks lein repl and then (use 'overtone.live)

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -530,9 +530,8 @@
     (catch Exception e nil))
   (apply node-free (all-ids :node))
   (clear-ids :node)
-  (alloc-id :node) ; ID zero is the root group
-  (dosync (ref-set overtone.core.synth/synth-groups* (zipmap (keys @overtone.core.synth/synth-groups*)
-                                          (repeat (count @overtone.core.synth/synth-groups*) (group :tail 0))))))
+  (alloc-id :node)) ; ID zero is the root group
+

 ;  Maybe it's better to keep the server log around???
 ;  (dosync (ref-set server-log* [])))


Beefed up pubsub in anticipation of use by almanac.

--- src/hxgm30/event/components/pubsub.clj
+++ src/hxgm30/event/components/pubsub.clj
@@ -14,7 +14,7 @@
 ;;;   Constants, Data, & Utility Functions   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def subscribers
+(def default-subscribers
   {tag/generic [:default]
    tag/subscribers-added [:default]})

@@ -105,7 +105,7 @@

 (defn subscribe-all
   ""
-  [system]
+  [system subscribers]
   (let [system (util/pubsub-component->system system)]
     (doseq [[event-type subscriber-funcs] subscribers]
       (subscribe-all-event system
@@ -116,7 +116,15 @@
 ;;;   Component Lifecycle Implementation   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defrecord PubSubComponent [dataflow])
+(defrecord PubSubComponent [
+  subscribers
+  ;; The 'dataflow' pubsub is intended for use in tracking low-level events
+  ;; in the system that relate to the manner in which data flows through the
+  ;; system.
+  dataflow
+  ;; The 'world' pubsub is intended for use by anything that needs to handle
+  ;; events that take place in the game world.
+  world])

 (defn start
   [this]
@@ -124,17 +132,23 @@
   (log/debug "Started pub-sub component.")
   (let [dataflow (pubsub/create-dataflow-pubsub
                   (config/event-system-type this))
-        component (assoc-in this [:dataflow] dataflow)]
+        world (pubsub/create-dataflow-pubsub
+               (config/event-system-type this))
+        component (assoc this :dataflow dataflow
+                              :world world)]
     (log/info "Adding subscribers ...")
-    (subscribe-all component)
+    (subscribe-all component (:subscribers this))
     component))

 (defn stop
   [this]
   (log/info "Stopping pub-sub component ...")
-  (if-let [pubsub-dataflow (get-in this [:dataflow])]
+  (when-let [pubsub-dataflow (:dataflow this)]
     (pubsub/delete pubsub-dataflow))
-  (let [component (assoc-in this [:dataflow] nil)]
+  (when-let [pubsub-world (:world this)]
+    (pubsub/delete pubsub-world))
+  (let [component (assoc this :dataflow nil
+                              :world nil)]
     (log/debug "Stopped pub-sub component.")
     component))

@@ -152,5 +166,7 @@

 (defn create-component
   ""
-  []
-  (map->PubSubComponent {}))
+  ([]
+   (create-component {}))
+  ([subscribers]
+   (map->PubSubComponent (merge default-subscribers subscribers))))


.length non writeable

.length non writeable

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -593,6 +593,16 @@
        ]
       [vars2 (with-type [:ass [:fident neident [:eadd [:elitint 1] [:plus] nexpr]] expr] etype)]
       )
+    [:fident nident ident]
+    (domonad phase-m
+      [[vars1 neident] (annotate-eident glob-state vars nident location annotate-expr)
+       tmp (match (get-type neident)
+             [:atype _] (err (str "array field 'length' not assignable in: " location))
+             :else (succ "ok"))
+       [type offset] (lookup-clss-field glob-state (get-type neident) name location)
+       ]
+      [vars1 (with-type [:fident nident [:elitint offset]] type)]
+      )
     ))

 (defn- annotate-incr
@@ -709,8 +719,8 @@

 (defn- analyze-fun
   [glob-state funexpr]
-  (match funexpr [_ [get-type] [_ name] args block]
-    (if (not (or (= get-type :void) (util/returns? block)))
+  (match funexpr [_ get-type [_ name] _ block]
+    (if (not (or (= get-type [:void]) (util/returns? block)))
       (err (str "return not found in function " name "\n" (util/ip-meta funexpr)))
       (check-type glob-state funexpr)
       )


Fix bad story merge.

Fix bad story merge.

--- src/mash_commander/nix/story.cljc
+++ src/mash_commander/nix/story.cljc
@@ -17,7 +17,6 @@
                           :allow ["ls"]
                           :wait-event {:type :new-line
                                        :then (eq {:type :new-line :line "ls"}
-                                                 {:then {:goto :page-2}})}}}}
                                                  {:goto :page-2})}}}}
    :page-2 {:allow []
             :say "Good job! The results of your command are shown underneath in the grey box."
@@ -27,8 +26,6 @@
             :say "Let's try something new. You can change directories with the `cd` command."
             :then {:say "Try changing into the `bin` directory by typing `cd bin`."
                    :then {:allow ["cd bin"]
-                          :wait-event {:test #(= {:type :new-line :line "cd bin"} %)}
-                          :then {:goto :page-4}}}}
                           :wait-event {:type :new-line
                                        :then (eq {:type :new-line :line "cd bin"}
                                                  {:goto :page-4})}}}}


Pull out common code for backloggery main list and wishlist

This is groundwork for compilation support

--- src/bltool/data/backloggery.clj
+++ src/bltool/data/backloggery.clj
@@ -10,6 +10,9 @@
                 ["--bl-pass" "backloggery password"]
                 ["--bl-stealth" "use 'stealth add' and 'stealth edit' when updating backloggery"
                  :flag true :default true])
+
+(def ^:dynamic *user* nil)
+(def ^:dynamic *cookies* nil)

 (defn- tag-seq [tag body]
   (filter #(= tag (:tag %)) (xml-seq body)))
@@ -78,17 +81,22 @@
        (filter #(first (tag-seq :a %)))
        (map gamebox-to-game)))

+(defn- read-all-games [extra-params]
+  (loop [games []
+         params { "aid" "1" "temp_sys" "ZZZ" "ajid" "0" "total" "0" }]
+    (println "Fetched" (count games) "games from Backloggery...")
+    (if params
+      (let [page (bl-more-games *cookies* *user* (conj extra-params params))]
+        (recur (concat games (bl-extract-games page)) (bl-extract-params page)))
+      (sort-by :name games))))
+
 (defmethod read-games "backloggery" [_]
   (let [user (:bl-name *opts*)
         pass (:bl-pass *opts*)
         cookies (bl-login user pass)]
-    (loop [games []
-           params { "aid" "1" "temp_sys" "ZZZ" "ajid" "0" "total" "0" }]
-      (println "Fetched" (count games) "games from Backloggery...")
-      (if params
-        (let [page (bl-more-games cookies user params)]
-          (recur (concat games (bl-extract-games page)) (bl-extract-params page)))
-        (sort-by :name games)))))
+    (binding [*user* user
+              *cookies* cookies]
+      (read-all-games {}))))

 (defmethod read-games "bl-html-debug" [_]
   (->> (:input *opts*)
@@ -103,13 +111,9 @@
   (let [user (:bl-name *opts*)
         pass (:bl-pass *opts*)
         cookies (bl-login user pass)]
-    (loop [games []
-           params { "aid" "1" "temp_sys" "ZZZ" "ajid" "0" "total" "0" }]
-      (println "Fetched" (count games) "games from Backloggery...")
-      (if params
-        (let [page (bl-more-games cookies user (conj {"wish" "1"} params))]
-          (recur (concat games (bl-extract-games page)) (bl-extract-params page)))
-        (sort-by :name games)))))
+    (binding [*user* user
+              *cookies* cookies]
+      (read-all-games {"wish" "1"}))))

 (defmethod write-games "bl-wishlist" [_ games]
   (println "No support for adding wishlist games yet."))


restore Monolith's discounted installs

restore Monolith's discounted installs

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -256,14 +256,22 @@
    {:effect (effect (gain :memory 3))}

    "Monolith"
-   {:prevent {:damage [:net :brain]}
-    :effect (effect (gain :memory 3)) :leave-play (effect (lose :memory 3))
-    :abilities [{:msg (msg "prevent 1 brain or net damage by trashing " (:title target))
-                 :priority true
-                 :choices (req (filter #(= (:type %) "Program") (:hand runner)))
-                 :prompt "Choose a program to trash" :effect (effect (trash target)
-                                                                     (damage-prevent :brain 1)
-                                                                     (damage-prevent :net 1))}]}
+   (let [mhelper (fn mh [n] {:prompt "Choose a program to install"
+                             :choices {:req #(and (= (:type %) "Program") (= (:zone %) [:hand]))}
+                             :effect (req (install-cost-bonus state side [:credit -4])
+                                          (runner-install state side target nil)
+                                            (when (< n 3)
+                                              (resolve-ability state side (mh (inc n)) card nil)))})]
+     {:prevent {:damage [:net :brain]}
+      :effect (effect (gain :memory 3)
+                      (resolve-ability (mhelper 1) card nil))
+      :leave-play (effect (lose :memory 3))
+      :abilities [{:msg (msg "prevent 1 brain or net damage by trashing " (:title target))
+                   :priority true
+                   :choices (req (filter #(= (:type %) "Program") (:hand runner)))
+                   :prompt "Choose a program to trash" :effect (effect (trash target)
+                                                                       (damage-prevent :brain 1)
+                                                                       (damage-prevent :net 1))}]})

    "Muresh Bodysuit"
    {:events {:pre-damage {:once :per-turn :once-key :muresh-bodysuit


Function to return list of files in specified directory

--- src/clj_fileutils/fileutils.clj
+++ src/clj_fileutils/fileutils.clj
@@ -1,5 +1,5 @@
 ;
-;  (C) Copyright 2015, 2016  Pavel Tisnovsky
+;  (C) Copyright 2015, 2016, 2017, 2018  Pavel Tisnovsky
 ;
 ;  All rights reserved. This program and the accompanying materials
 ;  are made available under the terms of the Eclipse Public License v1.0
@@ -84,3 +84,15 @@
         (.mkdir temp-dir)
         temp-dir))

+(defn filelist
+    "Return list of files that resides in specified directory."
+    (   [directory]
+        (->> (.listFiles (new java.io.File directory))
+             (filter #(.isFile %))
+             (map #(.getName %))))
+    (   [directory extension]
+        (->> (.listFiles (new java.io.File directory))
+             (filter #(.isFile %))
+             (map #(.getName %))
+             (filter #(.endsWith % extension)))))
+


Put the filter in the render-app

Put the filter in the render-app

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -50,10 +50,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (def app-state
-  (r/atom
-    {:cards {}
-     :filter "" ; BUG - If we had two boards, the cards should be the same, but not the filters
-    }))
+  (r/atom {:cards {}}))

 (defn add-cards!
   "Add several cards to the application state"
@@ -179,10 +176,10 @@
   ; - The DOM needs to be that deep, but not functions
   ; - But you can create the card at the top
   ; - And then you can assemble them (group-by or filter)
-  (let []
+  (let [filter (r/atom "")]
     (fn []
-      (let [filter (r/cursor app-state [:filter])
-            cards (r/cursor app-state [:cards])
+      (let [cards (r/cursor app-state [:cards])
+            filtered (reaction (filter-by-title @filter @cards))

             on-add-card #(js/alert "toto - use route to display the form")
             on-toggle-all #(swap! cards toggle-all-cards)
@@ -195,8 +192,7 @@
          (render-filter filter)
          [render-add-card on-add-card]
          [render-toggle-all on-toggle-all]
-         [render-board
-          (filter-by-title @filter @cards)
+         [render-board @filtered
           (render-card on-toggle-card on-remove-task on-check-task on-add-task)]
         ]))
   ))


Further improvement

Further improvement

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -55,12 +55,10 @@
 (defn remove-task-from!
   "Remove a task from a card"
   [card-id task-id]
-  (defn rem-task [cards]
-    (update-in cards [card-id :tasks]
-       (fn [tasks]
-         (filterv #(not= (:task-id %) task-id) tasks))
-    ))
-  (swap! card-list rem-task))
+  (defn filter-ids [tasks]
+    (filterv #(not= (:task-id %) task-id) tasks))
+  (swap! card-list #(update-in % [card-id :tasks] filter-ids)
+))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Remove excessive requires

Remove excessive requires

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -1,13 +1,6 @@
 (ns comic-reader.main
   (:require [comic-reader.api :as api]
-            [comic-reader.session :as session]
             [comic-reader.history :as history]
-            [comic-reader.pages.sites
-             :refer [site-list]]
-            [comic-reader.pages.comics
-             :refer [comic-list]]
-            [comic-reader.pages.viewer
-             :refer [comic-viewer]]
             [reagent.core :as reagent :refer [atom]]
             [reagent.ratom :refer-macros [reaction]]
             [re-frame.core :as rf]))


Remove header

Remove header

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -109,9 +109,7 @@
   [:div "Invalid/Unknown route"])

 (defmethod page :main [state]
-  [:div
-   [:h3 "Top Stories"]
-   [top-stories state]])
+  [top-stories state])

 (defmethod page :item [state]
   (when-let [entry (get-in state [:current-item :item])]


Refactor anim-score into using create-class

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -63,22 +63,20 @@
      ^{:key id} [:li [comment (r/wrap sub-data
                                       swap! comments assoc id)]])])

-(defn anim-score-fn []
-  (let [this (r/current-component)]
-    [:span {:class (if (:updated? (r/state this))
-                     "new"
-                     "old")}
-     (:value (r/props this))]))
-
 (def anim-score
-  (with-meta anim-score-fn
-    {:component-will-receive-props (fn [this new-props]
-                                     (let [old-val (:value (r/props this))
-                                           new-val (:value (get new-props 1))]
-                                       (when-not (= old-val new-val)
-                                         (r/set-state this {:updated? true})
-                                         (go (async/timeout 1)
-                                             (r/set-state this {:updated? false})))))}))
+  (r/create-class
+   {:component-will-receive-props (fn [this new-props]
+                                    (let [old-val (:value (r/props this))
+                                          new-val (:value (get new-props 1))]
+                                      (when-not (= old-val new-val)
+                                        (r/set-state this {:updated? true})
+                                        (go (async/timeout 1)
+                                            (r/set-state this {:updated? false})))))
+    :render (fn [this]
+              [:span {:class (if (:updated? (r/state this))
+                               "new"
+                               "old")}
+               (:value (r/props this))])}))

 (defn story-title [title url]
   [:p.title [:a {:href url} title]


11-1 prevent-default

11-1 prevent-default

--- src/cljs/modern_cljs/login.cljs
+++ src/cljs/modern_cljs/login.cljs
@@ -1,20 +1,20 @@
 (ns modern-cljs.login
-  (:use [domina :only [by-id value]]))
+  (:use [domina :only [by-id value]])
+  (:require [domina.events :as ev])
+  )

-(defn validate-form []
-  (let [email (by-id "email")
-        password (by-id "password")]
-    (if (and (> (count (value email)) 0)
-             (> (count (value password)) 0))
+(defn validate-form [e]
+  (let [email (value (by-id "email"))
+        password (value (by-id "password"))]
+    (.log js/console  email password)
+    (if (and (> (count email) 0)
+             (> (count password) 0))
       true
-      (do (js/alert "Please, complete the form!")
-          false))))
+      (do
+        (ev/prevent-default e)
+        (js/alert "Please, complete the form!")))))

 (defn ^:export init []
   (if (and js/document
-           (.-getElementById js/document))
-    (let [login-form (.getElementById js/document "loginForm")]
-      (set! (.-onsubmit login-form) validate-form))))
-
-;; (set! (.-onload js/window) init)
-
+           (aget js/document "getElementById"))
+    (ev/listen! (by-id "submit") :click validate-form)))


try last redirect option

try last redirect option

--- src/cljs/montheway/mmodern.cljs
+++ src/cljs/montheway/mmodern.cljs
@@ -186,7 +186,7 @@
          response (<! (http/get url))]
      (if (contains? response :trace-redirects)
        (do
-         (let [redirect-url (-> response :trace-redirects first)
+         (let [redirect-url (-> response :trace-redirects last)
                r-response (<! (http/get (-> response :trace-redirects first)))]
            (dommy/append! (sel1 :body) [:p (str  "Mapquest redirect-url:"
                                                  redirect-url)])


Implemented close-under-implications with LinClosure

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -8,7 +8,10 @@

 (ns conexp.fca.implications
   (:use conexp.base
-	conexp.fca.contexts))
+        conexp.fca.contexts)
+  (:import [java.util HashMap HashSet]))
+
+(ns-doc "Implications for Formal Concept Analysis")

 ;;;

@@ -44,7 +47,7 @@
   "Creates an implication (premise => conclusion $\\setminus$ premise)."
   [premise conclusion]
   (let [premise (set premise)
-	conclusion (set conclusion)]
+        conclusion (set conclusion)]
     (Implication. premise (difference conclusion premise))))

 ;;;
@@ -61,34 +64,29 @@
   (forall [intent (context-intents ctx)]
     (respects? intent impl)))

-(defn- add-immediate-elements
-  "Adds all elements which follow from implications with premises in
-  initial-set."
-  [implications initial-set]
-  (loop [conclusions []
-	 impls implications
-	 unused-impls []]
-    (if (empty? impls)
-      [(apply union initial-set conclusions) unused-impls]
-      (let [impl (first impls)]
-	(if (and (subset? (premise impl) initial-set)
-		 (not (subset? (conclusion impl) initial-set)))
-	  (recur (conj conclusions (conclusion impl))
-		 (rest impls)
-		 unused-impls)
-	  (recur conclusions
-		 (rest impls)
-		 (conj unused-impls impl)))))))
-
 (defn- close-under-implications
-  "Computes smallest superset of set being closed under given implications."
-  [implications set]
-  (loop [set set
-	 impls implications]
-    (let [[new impls] (add-immediate-elements impls set)]
-      (if (= new set)
-	new
-	(recur new impls)))))
+  "Computes smallest superset of start being closed under given implications."
+  [implications start]
+  ;; this is LinClosure
+  (let [^HashMap counts (HashMap.),
+        ^HashMap list   (HashMap.),
+        ^HashSet update (HashSet. start),
+        ^HashSet newdep (HashSet. start)]
+    (doseq [impl implications]
+      (.put counts impl (count (premise impl)))
+      (doseq [a (premise impl)]
+        (.put list a (conj (.get list a) impl))))
+    (while (seq update)
+      (let [a (first update)]
+        (.remove update a)
+        (doseq [impl (.get list a)]
+          (.put counts impl (dec (.get counts impl)))
+          (when (zero? (.get counts impl))
+            (let [z (HashSet. (conclusion impl))]
+              (.removeAll z newdep)
+              (.addAll newdep z)
+              (.addAll update z))))))
+    (set newdep)))

 (defn clop-by-implications
   "Returns closure operator given by implications."
@@ -100,7 +98,7 @@
   implications."
   [implication implications]
   (subset? (conclusion implication)
-	   (close-under-implications implications (premise implication))))
+           (close-under-implications implications (premise implication))))

 (defn minimal-implication-set?
   "Checks whether given set of implications is minimal, i.e. no
@@ -132,27 +130,32 @@
   proper subsets of initial-set. This is needed for computing the
   stem-base."
   [implications initial-set]
-  (loop [conclusions []
-	 impls implications
-	 unused-impls []]
+  (loop [conclusions  [],
+         impls        implications,
+         unused-impls []]
     (if (empty? impls)
       [(apply union initial-set conclusions) unused-impls]
       (let [impl (first impls)]
-	(if (and (proper-subset? (premise impl) initial-set)
-		 (not (subset? (conclusion impl) initial-set)))
-	  (recur (conj conclusions (conclusion impl))
-		 (rest impls)
-		 unused-impls)
-	  (recur conclusions
-		 (rest impls)
-		 (conj unused-impls impl)))))))
+        (if (and (proper-subset? (premise impl) initial-set)
+                 (not (subset? (conclusion impl) initial-set)))
+          (recur (conj conclusions (conclusion impl))
+                 (rest impls)
+                 unused-impls)
+          (recur conclusions
+                 (rest impls)
+                 (conj unused-impls impl)))))))

 (defn clop-by-implications*
   "Returns closure operator given by implications. Closed sets are
   computed from implications with premises being proper subsets."
   [implications]
-  (binding [add-immediate-elements add-immediate-elements*]
-    (partial close-under-implications implications)))
+  (fn [set]
+    (loop [set set,
+           impls implications]
+      (let [[new impls] (add-immediate-elements* impls set)]
+        (if (= new set)
+          new
+          (recur new impls))))))

 (defn stem-base
   "Returns stem base of given context. Uses background-knowledge as


refactored org-name and repo-name in the project model to use the keys on project

--- src-cljs/frontend/models/project.cljs
+++ src-cljs/frontend/models/project.cljs
@@ -25,10 +25,10 @@
   (str "/" (-> project vcs-type routes/->short-vcs) "/" (vcs-url/project-name project) "/edit"))

 (defn repo-name [project]
-  (vcs-url/repo-name (:vcs_url project)))
+  (:reponame project))

 (defn org-name [project]
-  (vcs-url/org-name (:vcs_url project)))
+  (:username project))

 (defn default-branch? [branch-name project]
   (= (name branch-name) (:default_branch project)))


Add date picker UI and notify for value changes

I put a datepicker widget so the user can change the documents date.
Whenever a new date is input we will update the document in the server.

--- src-cljs/pepa/workflows/document.cljs
+++ src-cljs/pepa/workflows/document.cljs
@@ -16,7 +16,8 @@
             [pepa.components.draggable :as draggable]
             [goog.events.KeyCodes :as keycodes])
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]
-                   [cljs.core.match.macros :refer [match]]))
+                   [cljs.core.match.macros :refer [match]])
+  (:import [goog.i18n DateTimeFormat DateTimeParse]))

 ;;; Editable Title Header

@@ -133,7 +134,15 @@
      (om/build pages-list (:pages document)
                {:state state})]))

-(ui/defcomponent ^:private meta-pane [document owner]
+(ui/defcomponent ^:private date-picker [{:keys [document_date]} owner]
+  (render-state [_ {:keys [date value]}]
+    [:input {:type "date"
+             :value value
+             :on-change (fn [e] (do
+                                  (om/set-state! owner :value e.target.value)
+                                  (async/put! date e.target.value)))}]))
+
+(ui/defcomponent ^:private meta-pane [{:keys [document_date] :as document} owner]
   (render [_]
     [:.sidebar
      [:header "Meta"]
@@ -146,6 +155,12 @@
        (om/build tags/tags-input document
                  {:state (om/get-state owner)})]

+      (let [formatter (DateTimeFormat. "yyyy-MM-dd")]
+        (om/build date-picker document
+                  {:init-state {:value (when document_date
+                                         (.format formatter document_date))}
+                   :state (om/get-state owner)}))
+
       ;; Buttons: Download, Delete, etc.
       [:.buttons
        [:button.download {:on-click #(js/window.open
@@ -181,12 +196,13 @@
   (init-state [_]
     {:page-number 1
      :pages (async/chan)
-     :tag-changes (async/chan)})
+     :tag-changes (async/chan)
+     :date-changes (async/chan)})
   (will-mount [_]
     ;; Start handling tag change events etc.
     (go-loop []
-      (let [{:keys [pages tag-changes]} (om/get-state owner)
-            [event port] (alts! [pages tag-changes])]
+      (let [{:keys [pages tag-changes date-changes]} (om/get-state owner)
+            [event port] (alts! [pages tag-changes date-changes])]
         (when (and event port)
           (condp = port
             pages
@@ -200,12 +216,20 @@
                                        :add data/add-tags
                                        :remove data/remove-tags)
                              [tag])
+                  (api/update-document!)))
+
+            date-changes
+            (let [date (js/Date.)]
+              (.parse (DateTimeParse. "yyyy-MM-dd") event date)
+              (-> @document
+                  (assoc :document_date date)
                   (api/update-document!))))
           (recur)))))
   (render-state [_ state]
     (let [{:keys [page-number]} state
           page-events (:pages state)
           tag-changes (:tag-changes state)
+          date-changes (:date-changes state)
           sidebars (om/observe owner (data/ui-sidebars))
           current-page (nth (:pages (om/value document))
                             (dec (or page-number 1)))]
@@ -228,7 +252,8 @@
          [:.pane {:style {:min-width width :max-width width}
                   :key "meta-pane"}
           (om/build meta-pane document
-                    {:init-state {:tags tag-changes}})])])))
+                    {:init-state {:tags tag-changes
+                                  :date date-changes}})])])))

 (defmethod draggable/pos->width ::thumbnails [sidebars sidebar [x _]]
   (draggable/limit


Give request-dumper a better name, add elucidation.

--- src/demo/web.clj
+++ src/demo/web.clj
@@ -5,7 +5,7 @@
             [ring.middleware.resource :refer [wrap-resource]]
             [ring.util.response       :refer [response]]))

-(defn request-dumper
+(defn echo-request
   "Dump the request"
   [request]
   (response (with-out-str (pprint request))))
@@ -17,7 +17,7 @@

 (def assets
   "Serve static assets from resources/public/"
-  (wrap-resource #'request-dumper "public"))
+  (wrap-resource #'echo-request "public"))

 ;;; The Ring Session example: https://github.com/ring-clojure/ring/wiki/Sessions
 (defn counter [{session :session}]
@@ -28,5 +28,10 @@

 (defn -main
   [& {:as args}]
-  (run request-dumper args)
+
+  ;; this uses an Undertow handler by default, which is faster
+  (run echo-request args)
+
+  ;; using a servlet allows the session to be shared in a WildFly
+  ;; cluster and allow access to the session from websockets
   (run (create-servlet #'counter) :path "/counter"))


Update prop name.

Update prop name.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -8,7 +8,7 @@

 (def public-representation-props [:uuid :slug :name :team-id :logo-url :logo-width :logo-height
                            :boards :created-at :updated-at])
-(def representation-props (concat public-representation-props [:author :authors :must-see-count :section-names]))
+(def representation-props (concat public-representation-props [:author :authors :must-see-count :default-section-names]))

 (defun url
   ([slug :guard string?] (str "/orgs/" slug))
@@ -101,7 +101,7 @@
                     public-representation-props)]
     (json/generate-string
       (-> org
-        (assoc :section-names (vec (sort config/sections)))
+        (assoc :default-section-names (vec (sort config/sections)))
         (org-links access-level)
         (change-link access-level user-id)
         (notify-link access-level user-id)


Fixed map error.

Fixed map error.

--- src/onyx/coordinator/queue/hornetq.clj
+++ src/onyx/coordinator/queue/hornetq.clj
@@ -20,7 +20,7 @@
   [element parent children phase]
   {:name (:onyx/name element)
    :ingress-queues (get (:egress-queues parent) (:onyx/name element))
-   :egress-queues (:hornetq/queue-name element)
+   :egress-queues {:self (:hornetq/queue-name element)}
    :phase phase
    :consumption (:onyx/consumption element)})


whitespace fix.

whitespace fix.

--- src/kixi/hecuba/routes.clj
+++ src/kixi/hecuba/routes.clj
@@ -37,51 +37,52 @@

 (defn app-routes [store]
   (routes
-    ;; landing page
-    (GET "/" [] index-page)
-    ;; login/logout
-    (GET (compojure-route :login) [] login-form)
-    (friend/logout (ANY (compojure-route :logout) request (redirect "/")))
+   ;; landing page
+   (GET "/" [] index-page)
+   ;; login/logout
+   (GET (compojure-route :login) [] login-form)
+   (friend/logout (ANY (compojure-route :logout) request (redirect "/")))
+
+   ;; main application
+   (GET (compojure-route :app) [] app-page)
+
+   ;; clojurescript
+   (route/resources "/cljs" {:root "cljs/"})
+
+   ;; js/css/etc
+   (route/resources "/" {:root "site/"})

-    ;; main application
-    (GET (compojure-route :app) [] app-page)
+   ;; API
+   ;; Programmes
+   (routes
+    ;; Index
+    (ANY (amon-index-route :programmes-index) []
+         (programmes/index store))
+    ;; index redirect
+    (ANY (amon-resource-route :programmes-index) []
+         (redirect (amon-index-route :programmes-index)))
+
+    ;; Resource
+    (ANY (amon-resource-route :programme-resource [:programme_id]) [programme_id]
+         (programmes/resource store)))

-    ;; clojurescript
-    (route/resources "/cljs" {:root "cljs/"})
-
-    ;; js/css/etc
-    (route/resources "/" {:root "site/"})
+   ;; Programmes/Projects
+   (routes
+    (ANY (amon-index-route :programme-projects-index [:programme_id]) [programme_id]
+         (projects/index store))
+    ;; index redirect
+    (ANY (amon-resource-route :programme-projects-index [:programme_id]) [programme_id]
+         (redirect (amon-index-route :programme-projects-index [programme_id]))))

-    ;; API
-    ;; Programmes
-    (routes
-     ;; Index
-     (ANY (amon-index-route :programmes-index) []
-          (programmes/index store))
-     ;; index redirect
-     (ANY (amon-resource-route :programmes-index) []
-          (redirect (amon-index-route :programmes-index)))
-
-     ;; Resource
-     (ANY (amon-resource-route :programme-resource [:programme_id]) [programme_id]
-          (programmes/resource store)))
+   ;; Projects/Properties
+   (routes (ANY (amon-index-route :project-properties-index [:project_id]) [project_id]
+                (properties/index store))
+           ;; index redirect
+           (ANY (amon-resource-route :project-properties-index [:project_id]) [project_id]
+                (redirect (amon-index-route :project-properties-index [project_id]))))

-    ;; Programmes/Projects
-    (routes (ANY (amon-index-route :programme-projects-index [:programme_id]) [programme_id]
-                 (projects/index store))
-            ;; index redirect
-            (ANY (amon-resource-route :programme-projects-index [:programme_id]) [programme_id]
-                 (redirect (amon-index-route :programme-projects-index [programme_id]))))
-
-    ;; Projects/Properties
-    (routes (ANY (amon-index-route :project-properties-index [:project_id]) [project_id]
-                 (properties/index store))
-            ;; index redirect
-            (ANY (amon-resource-route :project-properties-index [:project_id]) [project_id]
-                 (redirect (amon-index-route :project-properties-index [project_id]))))
-
-    ;; 404
-    (route/not-found not-found-page)))
+   ;; 404
+   (route/not-found not-found-page)))

 (defrecord Routes [context]
   component/Lifecycle


Use a more visually pleasing starting melody.

--- src/leipzig_live/core.cljs
+++ src/leipzig_live/core.cljs
@@ -7,10 +7,10 @@
     [reagent.core :as reagent]))

 (def initial-text
-  "(->> (phrase [1 1 1 1] [0 1 2 0])
-       (where :time (bpm 90))
-       (where :duration (bpm 90))
-       (where :pitch (comp equal-temperament B major)))")
+  "(->> (phrase [1 1/2 1/2 1 1 2 2] [0 1 0 2 -3 -10 -10])
+     (where :time (bpm 180))
+     (where :duration (bpm 180))
+     (where :pitch (comp equal-temperament C sharp major)))")

 (defonce state-atom
   (reagent/atom


CLJC bugfix: IAtom is an interface, not a protocol

--- src/re_frame/interop.clj
+++ src/re_frame/interop.clj
@@ -37,7 +37,7 @@
   (atom x))

 (defn ratom? [x]
-  (satisfies? clojure.lang.IAtom x))
+  (instance? clojure.lang.IAtom x))

 (defn make-reaction
   "On JVM Clojure, return a `deref`-able thing which invokes the given function


Update pedestal version

Update pedestal version

--- integration-tests/apps/pedestal/hello/project.clj
+++ integration-tests/apps/pedestal/hello/project.clj
@@ -3,13 +3,8 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.5.0"]
-                 [io.pedestal/pedestal.service "0.1.1"]
-
-                 ;; Remove this line and uncomment the next line to
-                 ;; use Tomcat instead of Jetty:
-                 [io.pedestal/pedestal.jetty "0.1.1"]
-                 ;; [io.pedestal/pedestal.tomcat "0.1.1"]
+  :dependencies [[org.clojure/clojure "1.5.1"]
+                 [io.pedestal/pedestal.service "0.2.1"]

                  ;; Logging
                  [ch.qos.logback/logback-classic "1.0.7"]


inlined search* into fetch

inlined search* into fetch

--- src/karras.clj
+++ src/karras.clj
@@ -81,7 +81,7 @@
   (.getDB connection (keyword-str db-name)))

 (defn drop-db [#^DBObject db]
-    (.dropDatabase db))
+  (.dropDatabase db))

 (defn list-collections [#^Mongo db]
   (map keyword (.getCollectionNames db)))
@@ -137,7 +137,17 @@
   ([collection query obj]
       (update collection query obj :multi)))

-(defn- search* [#^DBCollection collection query include exclude  limit skip sort count?]
+(defnk fetch
+  "Fetch a seq of documents that match a given query.
+   Accepts the following keywords:
+       :limit, maximum number of documents to return
+       :skip, where in the result set the seq will begin, i.e. paging
+       :include, which keys to include in the result set, can not be combined with :exclude
+       :exclude, which keys to exclude from the result set, can not be combined with :include
+       :sort, which keys to order by
+       :count, if true return the count of the result set, defaults to false"
+  [collection query
+   :limit nil :skip nil :include nil :exclude nil :sort nil :count false]
   (let [cursor (if query
                  (if (or include exclude)
                    (let [keys (merge (zipmap (remove nil? include)
@@ -164,49 +174,29 @@
       (.count cursor)
       (map to-clj cursor))))

-(defnk fetch
-  "Fetch a seq of documents that match a given query.
-   Accepts the following keywords:
-       :limit, maximum number of documents to return
-       :skip, where in the result set the seq will begin, i.e. paging
-       :include, which keys to include in the result set, can not be combined with :exclude
-       :exclude, which keys to exclude from the result set, can not be combined with :include
-       :sort, which keys to order by
-       :count, if true return the count of the result set, defaults to false"
-  [collection query
-   :limit nil :skip nil :include nil :exclude nil :sort nil :count false]
-  (search* collection
-           query
-           include
-           exclude
-           limit
-           skip
-           sort
-           count))
-
 (defnk fetch-all
   "Fetch all the documents of a collection. Same options as fetch."
   [collection :limit nil :skip nil :include nil :exclude nil :sort nil :count false]
-  (search* collection
-           nil
-           include
-           exclude
-           limit
-           skip
-           sort
-           count))
+  (fetch collection
+         nil
+         include
+         exclude
+         limit
+         skip
+         sort
+         count))

 (defnk fetch-one
-  "Fetch one document of a collection. Supports same options as fetch exceept :limit and :count"
+  "Fetch one document of a collection. Supports same options as fetch except :limit and :count"
   [collection query :skip nil :include nil :exclude nil :sort nil]
-  (first (search* collection
-                  query
-                  include
-                  exclude
-                  1
-                  skip
-                  sort
-                  false)))
+  (first (fetch collection
+                query
+                include
+                exclude
+                1
+                skip
+                sort
+                false)))

 (defn count-docs
   "Returns the count of documents, optionally, matching a query"


Make sure fact equality works even without shape

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -25,8 +25,13 @@
 (deftype FactShape [id madlib keys]
   Object
   (toString [this]
-            (apply str (interleave madlib (map (fn [k] (str "[" (name k) "]")) keys)))))
-
+            (apply str (interleave madlib (map (fn [k] (str "[" (name k) "]")) keys))))
+  IEquiv
+  (-equiv [this other]
+          (and (instance? FactShape other)
+               (= id (.-id other)))))
+
+;; if given a shape behaves like a record, otherwise behaves like a vector
 (deftype Fact [shape values ^:mutable __hash]
   Object
   (toString [this]
@@ -37,12 +42,14 @@
   IEquiv
   (-equiv [this other]
           (and (instance? Fact other)
-               (= (.-id shape) (.-id (.-shape other)))
+               (= shape (.-shape other))
+               (== (alength values) (alength (.-values other)))
                (loop [i 0]
                  (if (>= i (alength values))
                    true
-                   (when (= (aget values i) (aget (.-values other) i))
-                     (recur (+ i 1)))))))
+                   (if (= (aget values i) (aget (.-values other) i))
+                     (recur (+ i 1))
+                     false)))))

   IHash
   (-hash [this] (caching-hash this hash-array __hash))
@@ -127,6 +134,8 @@
   (get x :b)

+  (= eg (fact-shape ::eg "[a] has a [b] with a [c]"))
+
   (fact (fact-shape ::eg "[a] has a [b] with a [c]") #js ["a" "b" "c"])

   (= x x)
@@ -134,6 +143,11 @@
   (= x (fact (id->fact-shape ::eg) #js ["a" "b" "c"]))
   (= x (fact eg #js ["a" "b" "c"]))
   (= x (->eg "a" "b" "c"))
+  (= (Fact. nil #js ["a" "b" "c"]) (Fact. nil #js ["a" "b" "c"]))
+
+  (= x (Fact. nil #js ["a" "b" "c"]))
+  (= x (Fact. eg #js ["a" "b" 0]))
+  (= x (fact (fact-shape ::foo "[a] has a [b] with a [c]") #js ["a" "b" "c"]))

   (fact-ixes x #js [2 1])
   )


Fixed pre-route (/user.* => /user/*).

Fixed pre-route (/user.* => /user/*).

--- src/cadence/security.clj
+++ src/cadence/security.clj
@@ -13,5 +13,5 @@
        :unauthorized-redirect-uri "/login"
        :default-landing-uri "/"})

-(pre-route [:any "/user.*"] {:as req}
+(pre-route [:any "/user/*"] {:as req}
        (friend/authenticated nil))


Fixed the temp problem in the def case too

--- src/clj/minijava/gas.clj
+++ src/clj/minijava/gas.clj
@@ -78,7 +78,7 @@
    clojure.lang.IPersistentMap)

 ;; precondition: instr is a cmpl/imull/subl/addl/movl
-(defn extract-use-temps [instr set]
+(defn extract-use-temps [instr]
   (case (type instr)
     :minijava.gas/cmpl (let [arg1 (:a instr)
                              arg2 (:b instr)
@@ -97,20 +97,26 @@
           (conj set arg1)
           set))))

+;; precondition: instr is a cmpl/imull/subl/addl/movl
+(defn extract-def-temps [instr]
+  (let [dst (:dst instr)]
+    (if (= (type dst) :minijava.temp/Temp)
+        (hash-set dst)
+        (hash-set))))
+
 ;;returns a list of all temps used by this instruction
 (defn uses [instr]
-  (let [use-set (hash-set)]
-    (case (type instr)
-      :minijava.gas/ret   (hash-set (tm/temp :eip))
-      :minijava.gas/jcc   nil
-      :minijava.gas/jmp   nil
-      :minijava.gas/call  nil
-      :minijava.gas/cmpl  (extract-use-temps instr use-set)
-      :minijava.gas/imull (extract-use-temps instr use-set)
-      :minijava.gas/subl  (extract-use-temps instr use-set)
-      :minijava.gas/addl  (extract-use-temps instr use-set)
-      :minijava.gas/movl  (extract-use-temps instr use-set)
-      nil))) ;;catch LABEL, MEMORY, CONST
+  (case (type instr)
+    :minijava.gas/ret   (hash-set (tm/temp :eip))
+    :minijava.gas/jcc   nil
+    :minijava.gas/jmp   nil
+    :minijava.gas/call  nil
+    :minijava.gas/cmpl  (extract-use-temps instr)
+    :minijava.gas/imull (extract-use-temps instr)
+    :minijava.gas/subl  (extract-use-temps instr)
+    :minijava.gas/addl  (extract-use-temps instr)
+    :minijava.gas/movl  (extract-use-temps instr)
+    nil)) ;;catch LABEL, MEMORY, CONST

 ;;the set of temps defined by this instruction
 (defn defs [instr]
@@ -120,9 +126,9 @@
     :minijava.gas/jmp   nil
     :minijava.gas/call  nil
     :minijava.gas/cmpl  nil
-    :minijava.gas/imull (hash-set (:dst instr))
-    :minijava.gas/subl  (hash-set (:dst instr))
-    :minijava.gas/addl  (hash-set (:dst instr))
-    :minijava.gas/movl  (hash-set (:dst instr))
+    :minijava.gas/imull (extract-def-temps instr)
+    :minijava.gas/subl  (extract-def-temps instr)
+    :minijava.gas/addl  (extract-def-temps instr)
+    :minijava.gas/movl  (extract-def-temps instr)
     nil)) ;;catch LABEL, MEMORY, CONST


It works!

It works!

--- src/cljs/kenny/core.cljs
+++ src/cljs/kenny/core.cljs
@@ -74,6 +74,9 @@
 (defn ceil [i]
   (.ceil js/Math i))

+(defn round [i]
+  (.round js/Math i))
+
 (defn floor [i]
   (.floor js/Math i))

@@ -172,10 +175,22 @@
     hero
     ))

-(defn on-ground? [hero]
+(defn nearest-vertical-border [bottom]
+  (* (round (/ bottom 70)) 70)
+  )
+
+(defn on-ground? [original-hero hero]
   (if (on-block? (get-in hero [:position]) 1)
     (update-in hero [:dy] + 0.75)
-    hero
+    (if (> 0 (get-in hero [:dy]))
+      (if (in-block? (get-in hero [:position]) 1)
+        (let [new-hero (update-in hero [:dy] + 0.75)]
+          (update-in new-hero [:position :bottom] (fn [_] (nearest-vertical-border (get-in original-hero [:position :bottom]))))
+          )
+        hero
+        )
+      hero
+      )
     ))

 (defn spike-damage [hero]
@@ -213,7 +228,7 @@
   )

 (defn home? [original-hero hero]
-  (if (on-block? (get-in original-hero [:position]) 5)
+  (if (in-block? (get-in original-hero [:position]) 5)
     (merge original-hero {:game-won true})
     hero
     )
@@ -255,13 +270,13 @@
                            ;;((partial bouncing bounce))
                            ((partial on-blue-trampete? blue-trampete))
                            ((partial on-red-trampete? red-trampete))
-                           on-ground?
                            grav
-                           ;;spike-damage
-                           ;;((partial time-up? original-hero app))
-                           ;;((partial home? original-hero))
+                           ((partial on-ground? original-hero))
+                           spike-damage
+                           ((partial time-up? original-hero app))
+                           ((partial home? original-hero))
                            ((partial blocked? original-hero))
-                           ;;((partial game-over? original-hero))
+                           ((partial game-over? original-hero))
                            )]
           (om/transact! app [:hero] (fn [hero] (merge hero new-hero)))
           )
@@ -376,11 +391,11 @@
                  (dom/tbody nil
                             (dom/tr nil
                                     (dom/th nil "Red Trampoline")
-                                    (om/build table-cell (get-in app [:settings :red-trampete]) {:init-state {:options (mapv (fn [i] [i]) (range 1 7))}})
+                                    (om/build table-cell (get-in app [:settings :red-trampete]) {:init-state {:options (mapv (fn [i] [i]) (range 1 5))}})
                                     )
                             (dom/tr nil
                                     (dom/th nil "Blue Trampoline")
-                                    (om/build table-cell (get-in app [:settings :blue-trampete]) {:init-state {:options (mapv (fn [i] [i]) (range 1 7))}})
+                                    (om/build table-cell (get-in app [:settings :blue-trampete]) {:init-state {:options (mapv (fn [i] [i]) (range 1 5))}})
                                     )
                             (dom/tr nil
                                     (dom/th nil "Spiel Dauer")


Experiment with variations of :discounted-case-improvements

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -256,15 +256,18 @@
                                      (if (<= (first case-history) error-threshold)
                                        0 ;; solved, improvement doesn't matter
                                        (let [improvements (mapv (fn [[newer-error older-error]]
-                                                                  (if (> (- older-error newer-error) 0)
-                                                                    1.0
-                                                                    0.0))
+                                                                  (let [imp (- older-error newer-error)]
+                                                                    (if (> imp 0)
+                                                                      1.0
+                                                                      0.0)))
                                                                 (partition 2 1 case-history))
                                              weights (iterate (partial * (- 1 improvement-discount)) 0.5)
                                              sum (reduce + (mapv * improvements weights))]
                                          (if (<= sum 0)
                                            1.0E100
-                                           (* (first case-history) (/ 1.0 sum)))))))))
+                                           ;(* (first case-history) (/ 1.0 sum))
+                                           (+ (first case-history) (- 1.0 sum))
+                                           )))))))
                           (= cat :reproductive-fidelity)
                           (let [g (:genome ind)]
                             (- 1.0
@@ -361,3 +364,5 @@
             me (calculate-meta-errors new-ind argmap)]
         (assoc new-ind :meta-errors me)))))

+
+


add main handle function

add main handle function

--- src/codeitlater/core.clj
+++ src/codeitlater/core.clj
@@ -8,7 +8,6 @@
 (defn make-pattern [commentMark]
   (re-pattern (str commentMark ".+")))

-;TODO: delete commentMark and filter different type of comment
 (defn read-comments-inline [pattern line]
   (let [result (re-find pattern line)]
     result))
@@ -24,21 +23,39 @@
       )))

 (defn get-all-files
+  "return a lazy sequence including all files"
   ([]
-   (doall (map #(.getPath %) (file-seq (io/file ".")))))
+   (map #(.getPath %) (file-seq (io/file "."))))
   ([root]
-   (doall (map #(.getPath %) (file-seq (io/file root)))))
-  ([root & filetypes]
-   (let [typepatterns (for [filetype filetypes] (re-pattern (str filetype "$")))]
-     (for [thisfile (doall (file-seq (io/file root)))
-           typepattern typepatterns
-           :let [filename (.getPath thisfile)]
-           :when (re-find typepattern filename)]
-       filename)))
+   (map #(.getPath %) (file-seq (io/file root))))
   )
+
+(defn read-files ;TODO: directory format
+  "commentMarkFunc is a curry function to give read-comments-in-file
+=> (partial read-comments-inline (make-pattern commentMark))"
+  ([commentMarkFunc]
+   (doall (for [filepath (get-all-files)]
+            (conj (read-comments-in-file filepath
+                                         commentMarkFunc)
+                  filepath))))
+  ([commentMarkFunc root]
+   (doall (for [filepath (get-all-files root)]
+            (conj (read-comments-in-file filepath
+                                         commentMarkFunc)
+                  filepath))))
+  ([commentMarkFunc root & filetypes]
+   (let [typepatterns (for [filetype filetypes
+                            :when (not= "" filetype)]
+                        (re-pattern (str ".+" filetype "$")))]
+     (doall (for [filepath (get-all-files root)
+                  typepattern typepatterns
+                  :when (re-matches typepattern filepath)]
+              (conj (read-comments-in-file filepath
+                                           commentMarkFunc)
+                    filepath))))))

 (defn -main [& args]
   (println args)
   (println (read-comments-inline (make-pattern testMark) "aaa//test"))
-  (println (read-comments-in-file "/Users/ccQ/Desktop/log"
-                                  (partial read-comments-inline (make-pattern testMark)))))
+  (println (read-files (partial read-comments-inline (make-pattern ";")) "./src" "clj" ""))
+)


professional pride

professional pride

--- src-clj/acha/achievement.clj
+++ src-clj/acha/achievement.clj
@@ -177,11 +177,19 @@
          {:username author
           :time time})))])

-; TODO date achievements
 (def professional-pride
   [:professional-pride
    (fn [commit-info]
-     nil)])
+     (let [time (:time commit-info)
+           ; TODO Correct timezone
+           cal (Calendar/getInstance)
+           _ (.setTime cal time)
+           commit-day (.get cal Calendar/DAY_OF_YEAR)]
+       (when (= [1024] [commit-day])
+         {:username (:author commit-info)
+          :time time})))])
+
+; TODO date achievements
 (def turkey-day
   [:turkey-day
    (fn [commit-info]


Selection: Fix un-selection without control.

--- src-cljs/pepa/selection.cljs
+++ src-cljs/pepa/selection.cljs
@@ -51,7 +51,9 @@

       (empty? modifiers)
       (assoc selection
-             :selected #{element}
+             :selected (if (= (:selected selection) #{element})
+                         #{}
+                         #{element})
              :last-clicked element)

       (control modifiers)
@@ -76,6 +78,12 @@
             (click (make-click 5 [])))]
   (assert (= #{5} (:selected s)))
   (assert (= 5 (:last-clicked s))))
+
+(let [s (-> (->Selection (range 10) nil nil)
+            (click (make-click 3 []))
+            (click (make-click 3 [])))]
+  (assert (= #{} (:selected s)))
+  (assert (= 3 (:last-clicked s))))

 ;;; Control Selection


add query-job to run query and insert results into a table

--- bigquery/src/gclouj/bigquery.clj
+++ bigquery/src/gclouj/bigquery.clj
@@ -1,6 +1,6 @@
 (ns gclouj.bigquery
   (:require [clojure.walk :as walk])
-  (:import [com.google.gcloud.bigquery BigQueryOptions BigQuery$DatasetListOption DatasetInfo DatasetId BigQuery$TableListOption TableInfo TableId BigQuery$DatasetOption BigQuery$TableOption Schema Field Field$Type Field$Mode TableInfo$StreamingBuffer InsertAllRequest InsertAllRequest$RowToInsert InsertAllResponse BigQueryError BigQuery$DatasetDeleteOption QueryRequest QueryResponse QueryResult JobId Field Field$Type$Value FieldValue FieldValue$Attribute LoadJobInfo LoadConfiguration BigQuery$JobOption JobInfo$CreateDisposition JobInfo$WriteDisposition JobStatistics JobStatistics$LoadStatistics JobStatus JobStatus$State FormatOptions]
+  (:import [com.google.gcloud.bigquery BigQueryOptions BigQuery$DatasetListOption DatasetInfo DatasetId BigQuery$TableListOption TableInfo TableId BigQuery$DatasetOption BigQuery$TableOption Schema Field Field$Type Field$Mode TableInfo$StreamingBuffer InsertAllRequest InsertAllRequest$RowToInsert InsertAllResponse BigQueryError BigQuery$DatasetDeleteOption QueryRequest QueryResponse QueryResult JobId Field Field$Type$Value FieldValue FieldValue$Attribute LoadJobInfo LoadConfiguration BigQuery$JobOption JobInfo$CreateDisposition JobInfo$WriteDisposition JobStatistics JobStatistics$LoadStatistics JobStatus JobStatus$State FormatOptions QueryJobInfo QueryJobInfo$Priority UserDefinedFunction]
            [com.google.common.hash Hashing]
            [java.util List Collections]))

@@ -97,6 +97,11 @@
   (to-clojure [x] {:job-id     (to-clojure (.jobId x))
                    :statistics (to-clojure (.statistics x))
                    :email      (.userEmail x)
+                   :status     (to-clojure (.status x))})
+  QueryJobInfo
+  (to-clojure [x] {:job-id     (to-clojure (.jobId x))
+                   :statistics (to-clojure (.statistics x))
+                   :email      (.userEmail x)
                    :status     (to-clojure (.status x))}))

 (defn service
@@ -217,12 +222,10 @@
     (.defaultDataset builder (DatasetId/of project-id dataset-id))
     (when max-results
       (.maxResults builder max-results))
-    (when dry-run?
-      (.dryRun builder dry-run?))
+    (.dryRun builder dry-run?)
     (when max-wait-millis
       (.maxWaitTime builder max-wait-millis))
-    (when use-cache?
-      (.useQueryCache builder use-cache?))
+    (.useQueryCache builder use-cache?)
     (let [q (.build builder)]
       (to-clojure (.query service q)))))

@@ -231,16 +234,44 @@
 (defn job [service {:keys [project-id job-id] :as job}]
   (to-clojure (.getJob service (JobId/of project-id job-id) (into-array BigQuery$JobOption []))))

-
-(defn load-job [service {:keys [project-id dataset-id table-id] :as table} {:keys [format create-disposition write-disposition]} & uris]
+(def create-dispositions {:needed JobInfo$CreateDisposition/CREATE_IF_NEEDED
+                          :never  JobInfo$CreateDisposition/CREATE_NEVER})
+
+(def write-dispositions {:append   JobInfo$WriteDisposition/WRITE_APPEND
+                         :empty    JobInfo$WriteDisposition/WRITE_EMPTY
+                         :truncate JobInfo$WriteDisposition/WRITE_TRUNCATE})
+
+(def priorities {:batch       (QueryJobInfo$Priority/BATCH)
+                 :interactive (QueryJobInfo$Priority/INTERACTIVE)})
+
+(defn load-job
+  [service {:keys [project-id dataset-id table-id] :as table} {:keys [format create-disposition write-disposition]} & uris]
   (let [config-builder (LoadConfiguration/builder (TableId/of project-id dataset-id table-id)
                                                   ({:json (FormatOptions/json)
                                                     :csv  (FormatOptions/csv)} (or format :json)))]
-    (.createDisposition config-builder ({:needed JobInfo$CreateDisposition/CREATE_IF_NEEDED
-                                         :never JobInfo$CreateDisposition/CREATE_NEVER} (or create-disposition :never)))
-    (.writeDisposition config-builder ({:append JobInfo$WriteDisposition/WRITE_APPEND
-                                        :empty  JobInfo$WriteDisposition/WRITE_EMPTY
-                                        :truncate JobInfo$WriteDisposition/WRITE_TRUNCATE} (or write-disposition :append)))
+    (.createDisposition config-builder (create-dispositions (or create-disposition :never)))
+    (.writeDisposition config-builder (write-dispositions (or write-disposition :append)))
     (let [configuration (.build config-builder)
           job           (.build (LoadJobInfo/builder configuration ^List uris))]
       (to-clojure (.create service job (into-array BigQuery$JobOption []))))))
+
+(defn- user-defined-function
+  "Creates a User Defined Function suitable for use in BigQuery queries. Can be a Google Cloud Storage uri (e.g. gs://bucket/path), or an inline JavaScript code blob."
+  [udf]
+  (if (.startsWith udf "gs://")
+    (UserDefinedFunction/fromUri udf)
+    (UserDefinedFunction/inline udf)))
+
+(defn query-job
+  [service query {:keys [create-disposition write-disposition large-results? destination-table use-cache? flatten-results? priority udfs]}]
+  (let [{:keys [project-id dataset-id table-id]} destination-table
+        builder                                  (QueryJobInfo/builder query)]
+    (.createDisposition builder (create-dispositions (or create-disposition :never)))
+    (.writeDisposition builder (write-dispositions (or write-disposition :append)))
+    (.allowLargeResults builder large-results?)
+    (.useQueryCache builder use-cache?)
+    (.flattenResults builder flatten-results?)
+    (when destination-table
+      (.destinationTable builder (TableId/of project-id dataset-id table-id)))
+    (.priority builder (priorities (or priority :batch)))
+    (to-clojure (.create service (.build builder) (into-array BigQuery$JobOption [])))))


heroku not seeing env vars at compile time

--- src/gh_waiting_room/service.clj
+++ src/gh_waiting_room/service.clj
@@ -11,29 +11,33 @@

 (def db (atom {}))

-(def gh-auth
+(defn- gh-auth
+  []
   {:auth (or (System/getenv "GITHUB_AUTH")
              (throw (ex-info "Set $GITHUB_AUTH to basic auth in order fetch github issues." {})))})

-(def gh-user
+(defn- gh-user
+  []
   (or (System/getenv "GITHUB_USER")
       (throw (ex-info "Set $GITHUB_USER to the user who owns the issues." {}))))

-(def issue-url-regex (re-pattern
-                      (or (System/getenv "GITHUB_ISSUE_REGEX")
-                          (str "github.com/" gh-user))))
+(defn- issue-url-regex
+  []
+  (re-pattern
+   (or (System/getenv "GITHUB_ISSUE_REGEX")
+       (str "github.com/" (gh-user)))))

 (def gh-hide-labels (when-let [labels (System/getenv "GITHUB_HIDE_LABELS")]
                       (clojure.string/split labels #"\s*,\s*")))

 (defn- api-options
   []
-  (merge {:filter "all" :all-pages true} gh-auth))
+  (merge {:filter "all" :all-pages true} (gh-auth)))

 (defn- issue-filter
   [issue]
   (and (not (get-in issue [:repository :private]))
-   (re-find issue-url-regex (str (:html_url issue)))
+   (re-find (issue-url-regex) (str (:html_url issue)))
        (if gh-hide-labels
          (not (some
                (set gh-hide-labels)


perm checking tracing

perm checking tracing

--- src/celestial/persistency/systems.clj
+++ src/celestial/persistency/systems.clj
@@ -67,6 +67,7 @@
   [f & args]
   (let [system (first (filter map? args))
         id (first (filter #(or (number? %) (and (string? %) (re-find #"\d+" %))) args))]
+    (trace "perm checking" f args)
     (if (is-system? system)
       (assert-access system)
       (assert-access (hookless-get id)))


Introduce some threading

Introduce some threading

--- src-cljs/frontend/notifications.cljs
+++ src-cljs/frontend/notifications.cljs
@@ -28,14 +28,14 @@
 (defn notify [title properties]
   (when (and (notifications-granted?)
              (ld/feature-on? "web-notifications"))
-    (goog.events/listen
-      (new js/Notification
-        title
-        (clj->js (merge
-                   properties
-                   {:lang "en"})))
-      "click"
-      notification-on-click)))
+    (-> (new js/Notification
+             title
+             (clj->js (merge
+                        properties
+                        {:lang "en"})))
+        (goog.events/listen
+          "click"
+          notification-on-click))))

 (defn status-icon-path [status-name]
   (utils/cdn-path (str "/img/email/"status-name"/icon@3x.png")))


changed template colors for the error template

--- src/selmer/validator.clj
+++ src/selmer/validator.clj
@@ -19,19 +19,19 @@
                padding-top:  5px;
                padding-left: 25px;
                color: white;
-               background: #a31306;
-               text-shadow: 1px 1px #333;
-               border-bottom: 1px solid #800000;
+               background: #a32306;
+               text-shadow: 1px 1px #33333;
+               border-bottom: 1px solid #710000;
            }
            #error-wrap {
-               border-top: 5px solid #d36e6b;
+               border-top: 5px solid #d46e6b;
            }
            #error-message {
                color: #800000;
-               background: #f5a19f;
+               background: #f5a29f;
                padding: 10px;
-               text-shadow: 1px 1px #FFAAAA;
-               border-top: 1px solid #f4b0ae;
+               text-shadow: 1px 1px #FFBBBB;
+               border-top: 1px solid #f4b1ae;
            }
            #file-wrap {
                border-top: 5px solid #2a2a2a;


Fix lint warnings

Fix lint warnings

--- src/clj_chrome_devtools/cljs/test.clj
+++ src/clj_chrome_devtools/cljs/test.clj
@@ -15,7 +15,7 @@

-(defn no-op-log [& args]
+(defn no-op-log [& _args]
   nil)

 (defn println-log [& args]
@@ -81,7 +81,7 @@
         (io/delete-file runner)))))

 (defn build [project-clj build-id test-runner-namespaces]
-  (let [{:keys [source-paths compiler] :as build}
+  (let [{:keys [source-paths compiler] :as _build}
         (build-by-id project-clj build-id)]
     (log "Building ClojureScript, source paths: " source-paths)
     (with-test-runner-source test-runner-namespaces (last source-paths)
@@ -101,7 +101,7 @@
       (str/replace "__RUNNER__" runner)
       (str/replace "__JS__" (slurp js))))

-(defn- file-handler [{:keys [uri request-method] :as req}]
+(defn- file-handler [{:keys [uri request-method] :as _req}]
   (log "REQUEST: " uri)
   (let [file (io/file "." (subs uri 1))]
     (if (and (= request-method :get) (.canRead file))
@@ -200,13 +200,11 @@
      (chrome-fixture
       (fn []
         (log "Chrome launched")
-        (let [con (:connection @automation/current-automation)
-              port (random-free-port)
+        (let [port (random-free-port)
               server (http-server/run-server (fn [req]
                                                (or (and ring-handler (ring-handler req))
                                                    (file-handler req)))
                                              {:port port})
-              dir (io/file ".")
               f (File/createTempFile "test" ".html" (io/file "."))
               url (str "http://localhost:" port "/" (.getName f))]
           (try


refactor evidence error message

refactor evidence error message

--- src/cljs/salava/page/ui/settings.cljs
+++ src/cljs/salava/page/ui/settings.cljs
@@ -8,7 +8,7 @@
             [salava.core.i18n :refer [t]]
             [salava.core.helper :refer [dump]]
             [salava.page.ui.helper :as ph]))
-;;fix, show error message!
+
 (defn save-settings [state next-url]
   (let [{:keys [id tags visibility password]} (:page @state)]
     (reset! (cursor state [:message]) nil)
@@ -18,8 +18,12 @@
                 :visibility visibility
                 :password password}
        :handler (fn [data]
-                  (if (= "error" (:status data))
-                    (swap! state assoc :message (keyword (:message data)))
+                  (if (and (= "error" (:status data)) (= (:message data) "page/Evidenceerror"))
+                    (swap! state assoc :message (keyword (:message data))
+                           :page {:id id
+                                  :tag tags
+                                  :password password
+                                  :visibility "public"})
                     (navigate-to next-url)
                     )
                   )})))
@@ -31,11 +35,12 @@
         new-tag-atom (cursor state [:new-tag])
         password-atom (cursor state [:page :password])]
     [:div {:id "page-settings"}
-     (when-not (clojure.string/blank? @(cursor state [:message]))
-       [:div.alert.alert-warning (t @(cursor state [:message])) ])
+
      [ph/edit-page-header (t :page/Settings ": " name)]
-     [ph/edit-page-buttons id :settings (fn [next-url] (save-settings (:page @state) next-url))]
+     [ph/edit-page-buttons id :settings (fn [next-url] (save-settings state next-url))]
      [:div {:class "panel page-panel" :id "settings-panel"}
+      (when-not (clojure.string/blank? @(cursor state [:message]))
+        [:div.alert.alert-warning (t @(cursor state [:message])) ])
       [:div.form-group
        [:label {:for "page-tags"}
         (t :page/Pagetags)]
@@ -92,8 +97,8 @@
       [:div.form-group
        [:button {:class    "btn btn-primary"
                  :on-click #(do
-                             (.preventDefault %)
-                             (save-settings state (str "/page/preview/" id)))
+                              (.preventDefault %)
+                              (save-settings state (str "/page/preview/" id)))
                  :disabled (and (empty? @password-atom)
                                 (= @visibility-atom "password"))}
         (t :page/Save)]]]]))


some profiling notes

some profiling notes

--- src/com/billpiel/mem_tracer/trace.clj
+++ src/com/billpiel/mem_tracer/trace.clj
@@ -84,30 +84,33 @@
   "Traces a single call to a function f with args. 'name' is the
 symbol name of the function."
   [workspace name f args meta']
+
   (let [parent (or *trace-log-parent*
                    workspace)
-        this (mk-fn-tree :parent parent
-                          :name name
-                          :args args
-                          :meta meta')
-        idx (-> (start-trace (:children parent)
-                             this)
-                count
-                dec)]
-    (let [value (binding [*trace-log-parent* this]
+        this    (mk-fn-tree :parent parent  ;; mk-fn-tree = 200ms
+                               :name name
+                               :args args
+                               :meta meta')
+        idx  (-> (start-trace (:children parent) ;; start-trace = 20ms
+                                   this)
+                      count
+                      dec)]
+    (let [value (binding [*trace-log-parent* this]  ;; binding = 50ms
                   (try
                     (apply f args)
                     (catch Throwable t
                       (end-trace (:children parent)
                                  idx
-                                 {:throw (Throwable->map t)
+                                 {:throw (Throwable->map** t)
                                   :ended-at (now)})
                       (throw t))))]
-      (end-trace (:children parent)
+       (end-trace (:children parent)   ;; end-trace = 75ms
                  idx
                  {:return value
                   :ended-at (now)})
       value)))
+
+;; mk-fn-tree + start-trace + binding + end-trace = 345ms

 (defn apply-trace-to-var
   [^clojure.lang.Var v workspace]


Download link fix

Download link fix

--- src/sinon_docs/pages.clj
+++ src/sinon_docs/pages.clj
@@ -9,7 +9,7 @@
   (let [version (:version current-release)
         date (:date current-release)]
     (str/replace html "
"
-                 (str "
<a href=\"releases/sinon-" version
+                 (str "
Download Sinon.JS " version "

"
                       date " - Changelog - "
                       "More builds/versions
"))))


Align the table names to get live working

--- src/layzee/adapters/web/api.clj
+++ src/layzee/adapters/web/api.clj
@@ -26,10 +26,10 @@
   (fn [opts]
     (twitter/lazy-web settings/twitter-bearer-token opts)))

+(def ^{:private true} database-name settings/dynamo-db-tweet-table-name)
+
 (def ^{:private true} conversation-search
-     #(conversation/for (nice-api/get-tweet settings/amazon-credential settings/dynamo-db-tweet-table-name settings/oauth-credential) (:id_str %)))
-
-(def ^{:private true} database-name "layzee-web")
+     #(conversation/for (nice-api/get-tweet settings/amazon-credential database-name settings/oauth-credential) (:id_str %)))

 (def init-database
      (memoize (fn[] (db/new-table settings/amazon-credential database-name))))


Refactor usage of read-binary-file

Refactor usage of read-binary-file

--- src/leiningen/droid/library.clj
+++ src/leiningen/droid/library.clj
@@ -19,7 +19,7 @@
      :bytes (.toByteArray
              (with-open [in (io/input-stream f)
                          out (java.io.ByteArrayOutputStream.)]
-              (read-binary-file in out)))
+               (read-binary-file in out)))
      :path (str (io/file "res" (relativize-path res-dir f)))}))

 (defn filespecs-hook
@@ -33,35 +33,24 @@

 ;; ## Resource extraction

-(defn- extract-file
-  "Takes a ZipInputStream and writes its current entry to the
-  specified file."
-  [zip-in out-filename]
-  (with-open [bos (io/make-output-stream out-filename {})]
-    (let [buffer (byte-array 4096)]
-      (loop []
-        (let [r (.read zip-in buffer)]
-          (when-not (= r -1)
-            (.write bos buffer 0 r)
-            (recur)))))))
-
 (defn extract-resources-from-jar
   "Takes a JAR file and extracts all files under res/ directory to
   `out-dir`."
   [jar-file out-dir]
-  (let [zis (ZipInputStream. (io/input-stream jar-file))
-        res-dir (str "res" File/separator)]
-    (loop [found-res false]
-      (if-let [entry (.getNextEntry zis)]
-        (if (and (.startsWith (str entry) res-dir)
-                 (not (.isDirectory entry)))
-          (let [out-file (io/file out-dir (str entry))]
-            (clojure.java.io/make-parents out-file)
-            (extract-file zis out-file)
-            (recur true))
-          (recur found-res))
-        (when found-res
-          (str out-dir File/separator "res"))))))
+  (with-open [zis (ZipInputStream. (io/input-stream jar-file))]
+    (let [res-dir (str "res" File/separator)]
+      (loop [found-res false]
+        (if-let [entry (.getNextEntry zis)]
+          (if (and (.startsWith (str entry) res-dir)
+                   (not (.isDirectory entry)))
+            (let [out-file (io/file out-dir (str entry))]
+              (clojure.java.io/make-parents out-file)
+              (with-open [out (io/make-output-stream out-file {})]
+                (read-binary-file zis out))
+              (recur true))
+            (recur found-res))
+          (when found-res
+            (str out-dir File/separator "res")))))))

 (defn extract-resources-from-deps
   "Extracts resources from all project dependencies. Returns a list of


Update core.clj

Update core.clj

--- src/swagger_gen/core.clj
+++ src/swagger_gen/core.clj
@@ -19,8 +19,6 @@

 (defmethod load-swagger-file :yaml [spec]
   (yml/from-file spec false))
-
-;; **************************************************************

 (defn extract-args
   [attributes]
@@ -73,8 +71,6 @@
         {k v}
         (keywordize-keys {k v})))))

-;; **************************************************************
-
 (defn normalize-swagger-spec
   "Attach normalized data that is easier to work with to the spec"
   [spec]


Validate schemas in test

Validate schemas in test

--- src/leiningen/new/onyx_app/test/onyx_app/jobs/sample_job_test.clj
+++ src/leiningen/new/onyx_app/test/onyx_app/jobs/sample_job_test.clj
@@ -1,13 +1,16 @@
 (ns {{app-name}}.jobs.sample-job-test
-    (:require [clojure.test :refer [deftest is]]
+    (:require [clojure.test :refer [deftest is use-fixtures]]
               [{{app-name}}.jobs.sample-submit-job :refer [build-job]]
               [{{app-name}}.tasks.core-async :refer [get-core-async-channels]]
               [onyx api
                [test-helper :refer [feedback-exception! load-config validate-enough-peers! with-test-env]]]
               [onyx.plugin.core-async :refer [take-segments!]]
               [onyx.plugin.seq]
+              [schema.test]
               {{#metrics?}}[onyx.lifecycle.metrics.metrics]{{/metrics?}}
               {{#metrics?}}[onyx.lifecycle.metrics.timbre]{{/metrics?}}))
+
+(use-fixtures :once schema.test/validate-schemas)

 (deftest onyx-dev-job-test
   (let [id (java.util.UUID/randomUUID)


Print stack

Print stack

--- src/nube/app.clj
+++ src/nube/app.clj
@@ -191,6 +191,7 @@
           (kill-app-instance app image tag))))
     "App successfully deployed!"
     (catch Exception e
+      (.printStackTrace e)
       (println "Rolling back deploy")
       (doseq [instance (load-pending-app-instances app)]
         (let [[host port] (ssplit instance)]
@@ -305,6 +306,6 @@
   (future
     (loop []
       (health-check-instances)
-      (Thread/sleep 10000)
+      (Thread/sleep 5000)
       (recur))))


Improve API doc.

Improve API doc.

--- src/afterglow/ola_client.clj
+++ src/afterglow/ola_client.clj
@@ -1,4 +1,7 @@
 (ns afterglow.ola-client
+  "Interface to the automatically generated protocol buffer
+  communication classes which communicate with the Open Lighting
+  Architecture olad daemon."
   (:require [flatland.protobuf.core :refer :all]
             [clojure.java.io :as io]
             [clojure.core.cache :as cache]
@@ -19,28 +22,35 @@
 (def ^:private version-masked (bit-and (bit-shift-left protocol-version 28) version-mask))
 (def ^:private size-mask 0x0fffffff)

-;; Local port on which the OLA server listens
-(def ^:private olad-port 9010)
-
-;; How long to cache handlers to be called when OLA server responds. If an hour
-;; has gone by, we can be sure that request is never going to see a response.
-(def ^:private request-cache-ttl (.convert java.util.concurrent.TimeUnit/MILLISECONDS
+(def ^:private olad-port
+  "The local port on which the OLA server listens"
+  9010)
+
+(def ^:private
+  request-cache-ttl
+  "How long to cache handlers to be called when OLA server responds.
+  If an hour has gone by, we can be sure that request is never going to
+  see a response."
+  (.convert java.util.concurrent.TimeUnit/MILLISECONDS
                                            1 java.util.concurrent.TimeUnit/HOURS))

-;; The channel used to communicate with the thread that talks to the OLA server
-(defonce ^:private channel (atom nil))
+(defonce ^:private
+  ^{:doc "The channel used to communicate with the thread that talks to the OLA server"}
+  channel
+  (atom nil))

 (defn- next-request-id
-  "Assign the sequence number for a new request, wrapping at the protocol limit.
-Will be safe because it will take far longer than an hour to wrap, and stale
-requests will thus be long gone."
+  "Assign the sequence number for a new request, wrapping at the
+  protocol limit. Will be safe because it will take far longer than an
+  hour to wrap, and stale requests will thus be long gone."
   [request-counter]
   (swap! request-counter #(if (= % Integer/MAX_VALUE)
                             1
                             (inc %))))

 (defn- disconnect-server
-  "Disconnects any active OLA server connection, and returns the new value the @connection atom should hold."
+  "Disconnects any active OLA server connection, and returns the new
+  value the @connection atom should hold."
   [conn]
   (when (:socket conn)
     (try
@@ -50,8 +60,9 @@
   nil)

 (defn- connect-server
-  "Establishes a new connection to the OLA server, returning the value the @connection atom should hold for using it.
-Takes the current connection, if any, as its argument, in case cleanup is needed."
+  "Establishes a new connection to the OLA server, returning the value
+  the @connection atom should hold for using it. Takes the current
+  connection, if any, as its argument, in case cleanup is needed."
   [conn]
   (when (:socket conn)
     (disconnect-server conn)) ;; Clean up any old connection, e.g. if a read failed
@@ -71,12 +82,14 @@
       (warn e "Unable to connect to olad server, is it running?"))))

 (defn- build-header
-  "Calculates the correct 4-byte header value for an OLA request of the specified length."
+  "Calculates the correct 4-byte header value for an OLA request of
+  the specified length."
   [length]
   (bit-or (bit-and length size-mask) version-masked))

 (defn- parse-header
-  "Returns the length encoded by a header value, after validating the protocol version."
+  "Returns the length encoded by a header value, after validating the
+  protocol version."
   [header]
   (if (= (bit-and header version-mask) version-masked)
     (bit-and header size-mask)
@@ -84,8 +97,8 @@
                             (bit-shift-right (bit-and header version-mask) 28))))))

 (defn- read-fully
-  "Will fill the buffer to capacity, or throw an exception. Returns the number of bytes read."
-  ^long [^InputStream input ^bytes buf]
+  "Will fill the buffer to capacity, or throw an exception. Returns
+  the number of bytes read." ^long [^InputStream input ^bytes buf]
   (loop [off 0 len (alength buf)]
     (let [in-size (.read input buf off len)]
       (cond
@@ -94,8 +107,9 @@
         :else (recur (+ off in-size) (- len in-size))))))

 (defn- write-safely-internal
-  "Recursive portion of write-safely, try to write a message to the olad server, reopen
-  connection and recur if that fails and it is the first failure."
+  "Recursive portion of write-safely, try to write a message to the
+  olad server, reopen connection and recur if that fails and it is the
+  first failure."
   [^bytes header ^bytes message ^Boolean first-try ^clojure.lang.Atom connection]
   (try
       (.write (:out @connection) header)
@@ -112,12 +126,14 @@
           (write-safely-internal header message false connection)))))

 (defn- write-safely
-  "Try to write a message to the olad server, reopen connection and retry once if that failed."
+  "Try to write a message to the olad server, reopen connection and
+  retry once if that failed."
   [^bytes header ^bytes message ^clojure.lang.Atom connection]
   (write-safely-internal header message true connection))

 (defn- store-handler
-  "Record a handler in the cache so it will be ready to call when the OLA server responds."
+  "Record a handler in the cache so it will be ready to call when the
+  OLA server responds."
   [request-id response-type handler request-cache]
   (if (cache/has? @request-cache request-id)
     (do
@@ -126,14 +142,16 @@
     (swap! request-cache #(cache/miss % request-id {:response-type response-type :handler handler}))))

 (defn- find-handler
-  "Look up the handler details for a request id, removing them from the cache."
+  "Look up the handler details for a request id, removing them from
+  the cache."
   [request-id request-cache]
   (when-let [entry (cache/lookup @request-cache request-id)]
     (swap! request-cache #(cache/evict % request-id))
     entry))

 (defn- handle-response
-  "Look up the handler associated with an OLA server response and call it on a new thread."
+  "Look up the handler associated with an OLA server response and call
+  it on a new thread."
   [wrapper request-cache]
   (if-let [handler-entry (find-handler (:id wrapper) request-cache)]
     (let [response-length (.size (:buffer wrapper))
@@ -144,8 +162,10 @@
     (warn "Cannot find handler for response, too old?" wrapper)))

 (defn- channel-loop
-  "Reads from the internal request channel until it closes, formatting messages to be sent to the OLA server socket.
-  Can be run on an unbuffered core.async channel because this is fast, local async I/O."
+  "Reads from the internal request channel until it closes, formatting
+  messages to be sent to the OLA server socket. Can be run on an
+  unbuffered core.async channel because this is fast, local async
+  I/O."
   [channel connection request-cache]
   (let [request-counter (atom 0)
         header-buffer (.order (ByteBuffer/allocate 4) (ByteOrder/nativeOrder))
@@ -173,9 +193,10 @@
 (declare shutdown)

 (defn- process-requests
-  "Set up loops to read requests on our local channel and send them to the OLA server, and read its responses
-  and  dispatch them to the proper handlers. Needs to be called in a future since it uses blocking reads from
-  the server socket."
+  "Set up loops to read requests on our local channel and send them to
+  the OLA server, and read its responses and dispatch them to the
+  proper handlers. Needs to be called in a future since it uses
+  blocking reads from the server socket."
   [channel]

   (let [connection (atom (connect-server nil))
@@ -220,20 +241,21 @@
         (info "Created OLA request processor." (future (process-requests c)))
         c)))

-(defn destroy-channel
+(defn- destroy-channel
   [c]
   (when c
     (close! c))
   nil)

 (defn start
-  "Explicitly start event handling thread and OLA server connection; generally unnecessary, as
-send-request will call if necessary."
+  "Explicitly start event handling thread and OLA server connection;
+  generally unnecessary, as send-request will call if necessary."
   []
   (swap! channel create-channel))

 (defn shutdown
-  "Stop the event handling thread and close the OLA server connection, if they exist."
+  "Stop the event handling thread and close the OLA server connection,
+  if they exist."
   []
   (swap! channel destroy-channel))

@@ -244,7 +266,8 @@
   (>!! @channel [name message response-type response-handler]))

 (defn wrap-message-if-needed
-  "Checks if a message is already a protobuf, and if not constructs one of the appropriate type"
+  "Checks if a message is already a protobuf, and if not constructs
+  one of the appropriate type."
   [message message-type]
   (if (= (type message) flatland.protobuf.PersistentProtocolBufferMap)
     message


Removed garbage.

Removed garbage.

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -528,44 +528,4 @@

       (let [{decision :best-move} (async/<!! ret-chan)]
         (swap! got-time? (fn [lastval] false))
-        (into [] decision))))
-
-  (defn chantest
-    []
-    (let [c (async/chan (async/sliding-buffer 1))
-          heuristic-c (async/chan (async/sliding-buffer 1))
-          timeout-chan (async/timeout 1999)]
-      (async/go
-        ; Compute layers and feed them to the channel as long as it's opened.
-        (loop [x 0]
-
-          (if                                               ;(not last-chan-op-result)
-              (clojure.core.async.impl.protocols/closed? heuristic-c)
-            (println "Chan c was closed. Has stopped digging down layers")
-            (do
-              ;(Thread/sleep (rand-int 300))
-              (println "Computed configurations of layer " x)
-              (async/>! c x)
-              (recur (inc x))))))
-      (letfn [(chan-taker [] (async/alts!! [timeout-chan c] :priority true))]
-        (async/go
-
-          (loop [[result source] (chan-taker)]
-            (if (not result)
-              (do
-                (println "Chan h was closed. Has stopped minimaxing"))
-              (do
-                (println "Started Calculating heuristic val of layer " result)
-                ;(Thread/sleep (rand-int 600))
-                (println "Done    Calculating heuristic val of layer " result)
-                (async/>! heuristic-c result)
-                (recur (chan-taker)))))))
-      ; Let's block on the timeout channel
-      (async/<!! timeout-chan)
-      ; We must stop this madness, close those chans!
-      (async/close! c)
-      (async/close! heuristic-c)
-      ; We return the last value found in the heuristic-channel (If there is none, we're damned. We be blocking here)
-      ; Todo: Use alts! to get a value and not say here forever.
-      (async/<!! heuristic-c)))
-
+        (into [] decision))))


remove deleted migration

remove deleted migration

--- src/clj/iwaswhere_web/migrations.clj
+++ src/clj/iwaswhere_web/migrations.clj
@@ -143,7 +143,6 @@
     (fs/mkdirs geonames-path)
     (doseq [f (f/filter-by-name files #"\d{4}-\d{2}-\d{2}a?.jrn")]
       (with-open [reader (clojure.java.io/reader f)]
-        (prn f)
         (let [lines (line-seq reader)]
           (doseq [line lines]
             (try
@@ -170,3 +169,43 @@
                 (count countries) "countries found.")
       (doseq [[c days] (reverse (sort-by second days-per-country))]
         (println c days "days")))))
+
+(defn remove-deleted
+  "Lookup geolocation for entries with lat and lon."
+  ; (use 'iwaswhere-web.migrations)
+  ; (time (m/remove-deleted "./data/migration/remove-deleted" "./data/migration/out/"))
+  [path out-dir]
+  (let [files (file-seq (clojure.java.io/file path))
+        state (atom {:deleted #{}})
+        geonames-path "./data/geonames/"
+        local-fmt (ctf/with-zone (ctf/formatters :year-month-day)
+                                 (ct/default-time-zone))]
+    (fs/mkdirs out-dir)
+    (doseq [f (f/filter-by-name files #"\d{4}-\d{2}-\d{2}a?.jrn")]
+      (with-open [reader (clojure.java.io/reader f)]
+        (let [lines (line-seq reader)]
+          (doseq [line lines]
+            (try
+              (let [parsed (clojure.edn/read-string line)]
+                (when (:deleted parsed)
+                  (let [ts (:timestamp parsed)]
+                    (swap! state update-in [:deleted] #(set (conj % ts))))))
+              (catch Exception ex
+                (log/error "Exception" ex "when parsing line:\n" line)))))))
+    (doseq [f (f/filter-by-name files #"\d{4}-\d{2}-\d{2}a?.jrn")]
+      (with-open [reader (clojure.java.io/reader f)]
+        (let [lines (line-seq reader)
+              filename (.getName f)]
+          (log/info filename)
+          (doseq [line lines]
+            (try
+              (let [parsed (clojure.edn/read-string line)
+                    ts (:timestamp parsed)
+                    serialized (str (pr-str parsed) "\n")
+                    out-file (str out-dir filename)]
+                (when-not (contains? (:deleted @state) ts)
+                  (spit out-file serialized :append true)))
+              (catch Exception ex
+                (log/error "Exception" ex "when parsing line:\n" line)))))))
+    (let [deleted (:deleted @state)]
+      (log/info (count deleted) " deleted."))))


Catch errors silently for the redis and redismq event publishers (#767)

--- src/ctia/flows/hooks/event_hooks.clj
+++ src/ctia/flows/hooks/event_hooks.clj
@@ -1,6 +1,6 @@
 (ns ctia.flows.hooks.event-hooks
-  (:require [clojure.tools.logging :as log])
   (:require
+   [clojure.tools.logging :as log]
    [ctia.events :as events]
    [ctia.flows.hook-protocol :refer [Hook]]
    [ctia.lib.redis :as lr]
@@ -17,9 +17,12 @@
   (destroy [_]
     :nothing)
   (handle [_ event _]
-    (lr/publish conn
-                publish-channel-name
-                event)
+    (try
+      (lr/publish conn
+                  publish-channel-name
+                  event)
+      (catch Exception e
+        (log/error e "Unable to push an event to Redis")))
     event))

 (defn redis-event-publisher []
@@ -35,7 +38,10 @@
   (destroy [_]
     :nothing)
   (handle [self event _]
-    (rmq/enqueue (get self :queue) event)
+    (try
+      (rmq/enqueue (get self :queue) event)
+      (catch Exception e
+        (log/error e "Unable to push an event to Redis")))
     event))

 (defn redismq-publisher []
@@ -59,7 +65,10 @@
   (destroy [_]
     :nothing)
   (handle [_ event _]
-    (events/send-event event)
+    (try
+      (events/send-event event)
+      (catch Exception e
+        (log/error e "Unable to push an event to Redis")))
     event))

 (defn- judgement?


add volumes to mono and stereo sample players

--- src/overtone/sc/sample.clj
+++ src/overtone/sc/sample.clj
@@ -15,17 +15,17 @@
   (do
     (defsynth mono-player
       "Plays a single channel audio buffer."
-      [buf 0 rate 1.0 start-pos 0.0 loop? 0]
-      (out 0 (pan2
-              (play-buf 1 buf rate
-                        1 start-pos loop?
-                        FREE))))
+      [buf 0 rate 1.0 start-pos 0.0 loop? 0 vol 1]
+      (out 0 (* vol (pan2
+                     (play-buf 1 buf rate
+                               1 start-pos loop?
+                               FREE)))))

-    (defsynth stereo-player [buf 0 rate 1.0 start-pos 0.0 loop? 0]
+    (defsynth stereo-player [buf 0 rate 1.0 start-pos 0.0 loop? 0 vol 1]
       (out 0
-           (play-buf 2 buf rate
-                     1 start-pos loop?
-                     FREE)))))
+           (* vol (play-buf 2 buf rate
+                            1 start-pos loop?
+                            FREE))))))

 (defonce loaded-samples* (ref {}))


Few additions.

Few additions.

--- src/pe_core_utils/core.clj
+++ src/pe_core_utils/core.clj
@@ -58,7 +58,7 @@
       m)))

 (defn trim-keys
-  [keys m]
+  [m keys]
   (reduce (fn [new-map key] (dissoc new-map key))
           m
           keys))