Refactor winner_calculator service code.

--- src/clj/made_merits/service/winner_calculator.clj
+++ src/clj/made_merits/service/winner_calculator.clj
@@ -2,24 +2,35 @@
   (:require [clojure.set :as set]
             [clojure.walk :as walk]))

-(defn winners
-  [users-with-scores]
-  (let [max-score (apply max (map :score users-with-scores))]
-    (vec (map (fn [user-with-score]
-                (assoc user-with-score
+(defn- with-status
+  [scored-users]
+  (let [max-score (apply max (map :score scored-users))]
+    (vec (map (fn [scored-user]
+                (assoc scored-user
                        :status
-                       (if (= max-score (:score user-with-score))
+                       (if (= max-score (:score scored-user))
                          "winner"
                          "loser")))
-              users-with-scores))))
+              scored-users))))
+
+(defn- mark-everyone-as-a-loser
+  [users-with-status]
+  (map
+    (fn [user-with-status]
+      (assoc user-with-status :status "loser"))
+    users-with-status))
+
+(defn- more-than-one-winner?
+  [users-with-status]
+  (not= 1
+        (:winner
+          (walk/keywordize-keys
+            (frequencies
+              (map :status users-with-status))))))

 (defn with-winner
-  [users-with-scores]
-  (let [users-with-status (winners users-with-scores)]
-    (if (not= 1
-              (:winner
-                (walk/keywordize-keys
-                  (frequencies (map :status users-with-status)))))
-      (map (fn [user-with-status] (assoc user-with-status :status "loser"))
-           users-with-status)
+  [scored-users]
+  (let [users-with-status (with-status scored-users)]
+    (if (more-than-one-winner? users-with-status)
+      (mark-everyone-as-a-loser users-with-status)
       users-with-status)))


compose: fixed labels parsing

compose: fixed labels parsing

--- src/clj/swarmpit/docker/engine/mapper/compose.clj
+++ src/clj/swarmpit/docker/engine/mapper/compose.clj
@@ -30,7 +30,7 @@

 (defn add-swarmpit-labels
   [service map]
-  (when (-> service :deployment :autoredeploy) (merge map {autoredeploy-label "true"})))
+  (merge map (when (-> service :deployment :autoredeploy) {autoredeploy-label "true"})))

 (defn name-value->map
   [name-value-coll]


Move DSL functions to DSL

Move DSL functions to DSL

--- src/clojure/clojurewerkz/cassaforte/query/dsl.clj
+++ src/clojure/clojurewerkz/cassaforte/query/dsl.clj
@@ -81,7 +81,7 @@
 ;; Alter Table
 ;;

-(defn with-options
+(defn with
   [options]
   [:with-options options])

@@ -96,3 +96,11 @@
 (defn alter-column
   [column-name column-type]
   [:alter-column [column-name column-type]])
+
+(defn column-definitions
+  [m]
+  [:column-definitions m])
+
+;;
+;;
+;;


Add date related function calls

Add date related function calls

--- src/clojure/clojurewerkz/cassaforte/query/dsl.clj
+++ src/clojure/clojurewerkz/cassaforte/query/dsl.clj
@@ -1,4 +1,5 @@
-(ns clojurewerkz.cassaforte.query.dsl)
+(ns clojurewerkz.cassaforte.query.dsl
+  (:import [com.datastax.driver.core.querybuilder QueryBuilder]))

 ;;
 ;; SELECT Statement
@@ -14,8 +15,15 @@

 (defn all
   []
-  ;; TODO: resolve API inconsistency
   [:what-all nil])
+
+(defn unix-timestamp-of
+  [column-name]
+  [:what-fcall ["unixTimestampOf" [(QueryBuilder/raw (name column-name))]]])
+
+(defn date-of
+  [column-name]
+  [:what-fcall ["dateOf" [(QueryBuilder/raw (name column-name))]]])

 (defn columns
   [& columns]


Small rewriting of a test case

Small rewriting of a test case

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

--- src/conexp/contrib/tests/dl/languages/EL_gfp_exploration.clj
+++ src/conexp/contrib/tests/dl/languages/EL_gfp_exploration.clj
@@ -17,7 +17,10 @@

 ;;;

-(defn- term= [a b]
+(defn- term=
+  "Returns true iff the term a and b are syntactically equal upto
+  trivial rewriting."
+  [a b]
   (cond
    (and (not (seq? a)) (not (seq? b)))
    (= a b),
@@ -40,31 +43,38 @@
    :otherwise
    false))

-(defn- subsumption= [a b]
+(defn- subsumption=
+  "Returns true iff the subsumptions a and b are term= in both there
+  subsumee and subsumer."
+  [a b]
   (and (term= (expression-term (subsumee a))
               (expression-term (subsumee b)))
        (term= (expression-term (subsumer a))
               (expression-term (subsumer b)))))

+(defn- find-all-unequal
+  "Finds all elements in seq-1, that are not subsumption= to the
+  corresponding element in seq-2."
+  [seq-1 seq-2]
+  (when-not (and (empty? seq-1)
+                 (empty? seq-2))
+    (let [a (first seq-1),
+          b (first seq-2)]
+      (if (not (subsumption= a b))
+        (cons [a b]
+              (find-all-unequal (rest seq-1) (rest seq-2)))
+        (find-all-unequal (rest seq-1) (rest seq-2))))))
+
 (deftest- model-gcis-returns-correct-result
-  (are [model initial-ordering result] (letfn [(find-all-unequal [seq-1 seq-2]
-                                                 (when-not (and (empty? seq-1)
-                                                                (empty? seq-2))
-                                                   (let [a (first seq-1),
-                                                         b (first seq-2)]
-                                                     (if (not (subsumption= a b))
-                                                       (cons [a b]
-                                                             (find-all-unequal (rest seq-1) (rest seq-2)))
-                                                       (find-all-unequal (rest seq-1) (rest seq-2))))))]
-                                         (let [unequals (find-all-unequal (model-gcis model 'initial-ordering)
-                                                                          result)]
-                                           (if-not (empty? unequals)
-                                             (do
-                                               (doseq [[a b] unequals]
-                                                 (println "Got:" a)
-                                                 (println "Exp:" b))
-                                               false)
-                                             true)))
+  (are [model initial-ordering result] (let [unequals (find-all-unequal (model-gcis model 'initial-ordering)
+                                                                        result)]
+                                         (if-not (empty? unequals)
+                                           (do
+                                             (doseq [[a b] unequals]
+                                               (println "Got:" a)
+                                               (println "Exp:" b))
+                                             false)
+                                           true))
        paper-model [Male Female Father Mother]
        (with-dl SimpleDL
          (list (subsumption (and Female Male)


WIP on code

WIP on code

--- src/re_frame_async_flow_fx/core.cljs
+++ src/re_frame_async_flow_fx/core.cljs
@@ -2,32 +2,64 @@
   (:require [re-frame.core]
             [clojure.set :as set]))

+(def default-id  :async/flow)

-(defn startable-tasks
-  "Given a set of 'now-seen-events' and a set of already started tasks
-  return the list of tasks which should now be started."
+(defn all-events-seen?
+  [required-events seen-events]
+  (empty? (set/difference required-events seen-events)))
+
+
+(defn any-events-seen?
+  [required-events seen-events]
+  (seq (set/intersection seen-events required-events)))
+
+(def when->fn {:all-events-seen all-events-seen? :any-events-seen any-events-seen?})
+
+
+(defn newly-startable-tasks
+  "Given the accumulated set of seen events and the set of already started tasks,
+  return the list of tasks which should now be started.
+  In effect, give that the list of events seen has changed, what is the consequence."
   [rules now-seen-events started-tasks]
   (->> (remove (comp started-tasks :id) rules)
-       (filterv (fn [task]
-                  (condp = (:when task)
-                    :seen-all-of  (empty? (set/difference (:events task)  now-seen-events))
-                    :seen-any-of  (seq (set/intersection now-seen-events (:events task))))))))
+       (filterv (fn [task] ((:when task) (:events task) now-seen-events)))

 (defn make-flow-event-handler
   [{:keys [id db-path rules first-dispatch]}]
-  (let [all-events  (apply set/union (map :events rules))       ;; all of the events refered to in the spec
-        new-state (fn [db seen started]
-                    (assoc-in db db-path {:seen-events seen :started-tasks started}))
+  (let [id          (or id default-id)

+        ;; Subject to db-path, state is either stored in app-db or in a local atom
+        ;; Two pieces of state are maintained:
+        ;;  - the set of seen events
+        ;;  - the set of started tasks
+        local-store (atom {})
+        set-state   (if db-path
+                      (fn [db seen started]
+                        (assoc-in db db-path {:seen-events seen :started-tasks started}))
+                      (fn [db seen started]
+                        (reset! local-store {:seen-events seen :started-tasks started})
+                        db))
+        get-state   (if db-path
+                      (fn [db] (get-in db db-path))
+                      (fn [_]  @local-store))

-        ;;  rules'  XXX make all :dispatch a list PLUS make :done   [id :done]   then use rules' below
-        ;;
+        ;; Tweak supplied rules:
+        ;; - replace `:when` keyword value with a function
+        ;; - ensure that `:dispatch` is always a list and turn  `:done` into the right thing
+        ;; - ensure that :events is a set
+        rules   (-> rules
+                    (map (fn [rule]
+                           (update rule :when #(or (when->fn %1) %1))))
+                    (map (fn [rule]
+                           (update rule :dispatch (cond )))))
+
+        all-events  (apply set/union (map :events rules))       ;; all of the events refered to in the spec
         ]

     ;; return an event handler which will manage the flow
     ;; This event handler will receive 3 kinds of events
-    ;;   (dispatch [:id :steup])
+    ;;   (dispatch [:id :setup])
     ;;   (dispatch [:id :done])
     ;;   (dispatch [:id [:a :forwarded :event :vector])
     ;;
@@ -39,7 +71,7 @@
               ;;  1. Initialise the state  (seen-events and started-tasks)
               ;;  2. dispatch the first event, to kick start
               ;;  3. arrange for the events to get forwarded to this handler
-              :setup {:db (new-state db #{} #{})
+              :setup {:db (set-state db #{} #{})
                       :dispatch first-dispatch
                       :event-forwarder {:register id
                                         :events   all-events
@@ -49,36 +81,28 @@
               ;;  1. remove this event handler
               ;;  2. remove state
               ;;  3. stop the events forwarder
-              :done (do
-                      (re-frame.core/clear-event-handler! id)
-                      {:db (dissoc db db-path)
-                       :event-forwarder {:unregister id}})
+              :done {:db (dissoc db db-path)
+                     :event-forwarder {:unregister id}
+                     :deregister-event-handler id})          ;; XXX write this effects handler

-              ;;
               ;; A new event has been forwarded to this handler. What does it mean?
               ;;  1. does this new event mean we need to dispatch another
               ;;  2. remember that this new event has happened
-              (let [[event-id forwarded-event] event-v
-                    _   (assert (= id event-id))
-                    _   (assert (vector? forwarded-event))
-                    forwarded-event-id     (first forwarded-event)
-                    {:keys [seen-events started-tasks]} (get-in db db-path)
+              (let [[_ [forwarded-event-id & args]] event-v
+                    {:keys [seen-events started-tasks]} (get-state db)
                     new-seen-events    (conj seen-events forwarded-event-id)
-                    ready-tasks    (startable-tasks rules new-seen-events started-tasks)
-                    ready-task-ids (->> ready-tasks (map :dispatch) set)
-                    new-started-tasks (set/union started-tasks ready-task-ids)]
-                {:db       (new-state db new-seen-events new-started-tasks)
+                    ready-tasks        (newly-startable-tasks rules new-seen-events started-tasks)
+                    ready-task-ids     (->> ready-tasks (map :dispatch) set)
+                    new-started-tasks  (set/union started-tasks ready-task-ids)]
+                {:db       (set-state db new-seen-events new-started-tasks)
                  :dispatch (concat (map :dispatch ready-tasks))})))))

-(defn register-fx!
-  []
-  (re-frame.core/def-fx
-    :aync-flow
-    (fn [{:as flow :keys [id]}]
-      ;; XXX check that flow is valid.
-      (re-frame.core/def-event-fx
-        id                           ;; add debug middleware???  XXXX
-        (make-flow-event-handler flow))
-      (re-frame.core/dispatch [id :steup]))))
+(re-frame.core/def-fx
+  :aync-flow
+  (fn [{:as flow :keys [id]}]
+    (re-frame.core/def-event-fx
+      (or id default-id)                                 ;; add debug middleware???  XXXX
+      (make-flow-event-handler flow))
+    (re-frame.core/dispatch [id :steup])))


changes to handler

changes to handler

--- elephantdb-server/src/clj/elephantdb/ui/handler.clj
+++ elephantdb-server/src/clj/elephantdb/ui/handler.clj
@@ -8,39 +8,35 @@
             [compojure.route :as route]
             [elephantdb.client :as c]))

-(def conf-map {})
-
 (def VERSION "0.4.4-SNAPSHOT")

-(defn nodes [host port]
+;; ## Thrift client functions
+
+(defn node-status [host port]
   (c/with-elephant host port c
     (cond (c/updating? c) [:span {:class "label label-info"} "Loading"]
           (c/fully-loaded? c) [:span {:class "label label-success"} "Ready"]
           :else [:span {:class "label label-error"} "Error"])))

-(defn domains [host port]
+(defn domain-status [host port]
   (c/with-elephant host port c
     (when-let [statuses (c/get-status c)]
       (for [[domain status] (.get_domain_statuses statuses)]
         [(link-to (str "/node/" host "/domain/" domain) domain) (domain-status->elem status)]))))

-(defn metadata [host port domain]
+(defn domain-metadata [host port domain]
   (c/with-elephant host port c
     (when-let [metadata (c/get-domain-metadata c domain)]
       ;(expand-domain-metadata metadata)
       [:dl.dl-horizontal
-       [:dt "Latest Remote Version"]
-       [:dd (.get_remote_version metadata)]
-       [:dt "Latest Local Version"]
-       [:dd (.get_local_version metadata)]
-       [:dt "Shard Set"]
-       [:dd (.get_shard_set metadata)]
-       [:dt "Shard Count"]
-       [:dd (-> (.get_domain_spec metadata) (.get_num_shards))]
-       [:dt "Coordinator"]
-       [:dd  [:code (-> (.get_domain_spec metadata) (.get_coordinator))]]
-       [:dt "Shard Scheme"]
-       [:dd [:code (-> (.get_domain_spec metadata) (.get_shard_scheme))]]])))
+       [:dt "Latest Remote Version"] [:dd (.get_remote_version metadata)]
+       [:dt "Latest Local Version"] [:dd (.get_local_version metadata)]
+       [:dt "Shard Set"] [:dd (.get_shard_set metadata)]
+       [:dt "Shard Count"] [:dd (-> (.get_domain_spec metadata) (.get_num_shards))]
+       [:dt "Coordinator"] [:dd  [:code (-> (.get_domain_spec metadata) (.get_coordinator))]]
+       [:dt "Shard Scheme"] [:dd [:code (-> (.get_domain_spec metadata) (.get_shard_scheme))]]])))
+
+;; ## Views

 (defn template [title & body]
   (html5
@@ -65,7 +61,15 @@
               :styles [:condensed]
               :head ["Hostname" "Status"]
               :body (for [h (:hosts conf-map)]
-                      [(link-to (str "/node/" h) h) (nodes h (:port conf-map))]))
+                      [(link-to (str "/node/" h) h) (node-status h (:port conf-map))]))
+             ]
+            [:div
+             [:p "Configuration"]
+             [:pre
+              "{\n"
+              (for [[k v] conf-map]
+                (str k " " v "\n"))
+              "}"]
              ]))

 (defn node [conf-map id]
@@ -77,7 +81,7 @@
              (table
               :styles [:condensed]
               :head ["Domain" "Status"]
-              :body (domains id (:port conf-map))
+              :body (domain-status id (:port conf-map))
               )]))

 (defn domain [conf-map id domain]
@@ -88,7 +92,9 @@
              [:li.active domain]]
             [:h2 (str domain "@" id)]
             [:div
-             (metadata id (:port conf-map) domain)]))
+             (domain-metadata id (:port conf-map) domain)]))
+
+;; ## Routes

 (defroutes app-routes
   (GET "/"  {conf-map :conf-map} (index conf-map))


Switch to update now that it's available

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -225,12 +225,13 @@
   (if (= task-type :input)
     (let [candidates (:acker-candidates @peer-replica-view)
           _ (validate-ackable! candidates event)]
-      (assoc event
-             :onyx.core/batch
-             (map (fn [segment]
-                    (add-acker-id (rand-nth candidates)
-                                  (add-completion-id id segment)))
-                  (:onyx.core/batch event))))
+      (update event
+              :onyx.core/batch
+              (fn [batch]
+                (map (fn [segment]
+                       (add-acker-id (rand-nth candidates)
+                                     (add-completion-id id segment)))
+                     batch))))
     event))

 (defn add-messages-to-timeout-pool [task-type state event]


rewrite (defn comp-paths-to-complements)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -49,7 +49,7 @@
      (filter not-fail?)
      (map (fn [bolt] ;; for each bolt, create a map of complement positions within the bolt to possible complements for that position
             (assoc
-             (comp-paths-to-complements bolt (find-comp-paths bolt) model depth max-depth nil)
+             (comp-paths-to-complements bolt model depth max-depth)
              [] [bolt])))
      (filter #(not (some empty? (vals %))))
      (map (fn [each-bolt-and-comps] ;; for each such map in each bolt, find all possible combinations of complements, taking one complement per path.
@@ -152,14 +152,12 @@
       tree)))

 ;; TODO: rewrite using (recur)
-(defn comp-paths-to-complements [bolt comp-paths model depth max-depth accum]
+(defn comp-paths-to-complements [bolt model depth max-depth]
   (log/info (str "comp-paths-to-complements: depth=" depth "; max-depth: " max-depth ":" ((:morph-ps model) bolt)))
-  (if (not (empty? comp-paths))
-    (let [path (first comp-paths)
-          comps (filter not-fail? (comp-path-to-complements bolt path model depth max-depth))]
-      (comp-paths-to-complements bolt (rest comp-paths) model depth max-depth
-                                       (assoc accum
-                                        path comps)))))
+  (into {}
+        (map (fn [path]
+               [path (filter not-fail? (comp-path-to-complements bolt path model depth max-depth))])
+             (find-comp-paths bolt))))

 ;; TODO: lightning-bolts should use this.
 (defn get-lexemes [model spec]


move doc strings to proper place (before params)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -38,12 +38,13 @@

 ;; FIXME: truncate-children=false (the non-default option) is not propagated through all calls,
 ;; causing trees to be unexpectedly truncated.
-(defn generate [spec language-model
-                & {:keys [max-total-depth truncate-children lexicon]
-                   :or {max-total-depth max-total-depth
-                        lexicon nil
-                        truncate-children true}}]
+(defn generate
   "Returns a single expression generated by the given language model, constrained by the given spec."
+  [spec language-model
+   & {:keys [max-total-depth truncate-children lexicon]
+      :or {max-total-depth max-total-depth
+           lexicon nil
+           truncate-children true}}]
   (let [lexicon (if lexicon lexicon (:lexicon language-model))
         morph (:morph language-model)
         morph-ps (:morph-ps language-model)]
@@ -66,14 +67,13 @@
         (log/warn (str "generate: no expression could be generated for spec:" (strip-refs spec))))
       expression)))

-(defn generate-all [spec language-model total-depth
-                    & {:keys [max-total-depth truncate-children]
-                       :or {max-total-depth max-total-depth
-                            truncate-children true}}]
+(defn generate-all
   "Returns all possible expressions generated by the given language model, constrained by the given spec.
    Depending on the grammar in the language model, could be an infinite number of expressions."
-  (log/trace (str "generate-all: spec:" (strip-refs spec)))
-
+  [spec language-model total-depth
+   & {:keys [max-total-depth truncate-children]
+      :or {max-total-depth max-total-depth
+           truncate-children true}}]
   (let [total-depth (if total-depth total-depth 0)]
     (if truncate-children
       (->
@@ -84,12 +84,13 @@
        (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
        (add-all-comps language-model total-depth false max-total-depth)))))

-(defn lightning-bolts [language-model spec depth total-depth
+(defn lightning-bolts
+  "Returns a lazy-sequence of all possible bolts given a spec, where a bolt is a tree
+  such that only the head children are generated. This sequence is used by (generate (above))
+  to generate expressions by adding complements using (add-all-comps)."
+  [language-model spec depth total-depth
                        & {:keys [max-total-depth]
                           :or {max-total-depth max-total-depth}}]
-  "Returns a lazy-sequence of all possible bolts given a spec, where a bolt is a tree
-such that only the head children are generated. This sequence is used by (generate (above))
-to generate expressions by adding complements using (add-all-comps)."
   (let [grammar (:grammar language-model)
         depth (if depth depth 0)
         ;; this is the relative depth; that is, the depth from the top of the current lightning bolt.
@@ -147,12 +148,13 @@
            (lazy-cat lexical phrasal)
            (lazy-cat phrasal lexical))))))

-(defn add-all-comps [bolts language-model total-depth truncate-children max-total-depth]
+(defn add-all-comps
   "At each point in each bolt in the list of list of bolts,
-_bolt-groups_, add all possible complements at all open nodes in the
-bolt, from deepest and working upward to the top. Return a lazy
-sequence of having added all possible complements at each node in the
-bolt."
+  _bolt-groups_, add all possible complements at all open nodes in the
+  bolt, from deepest and working upward to the top. Return a lazy
+  sequence of having added all possible complements at each node in
+  the bolt."
+   [bolts language-model total-depth truncate-children max-total-depth]
   (lazy-mapcat
    (fn [bolt]
      (add-all-comps-with-paths [bolt] language-model total-depth
@@ -329,8 +331,9 @@
     (cons (vec (concat (take (- depth 1) (repeatedly (fn [] :head))) [:comp]))
           (find-comp-paths-in (- depth 1)))))

-(defn candidate-parents [rules spec]
+(defn candidate-parents
   "find subset of _rules_ for which each member unifies successfully with _spec_"
+  [rules spec]
   (log/trace (str "candidate-parents: spec: " (strip-refs spec)))
   (filter #(not (= :fail %))
           (pmap (fn [rule]
@@ -368,8 +371,12 @@
       (f (first coll))
       (lazy-mapcat f (rest coll))))))

-(defn lexemes-before-phrases [depth max-total-depth]
-  "returns true or false: true means generate by adding lexemes first; otherwise, by adding phrases first. Takes depth as an argument, which makes returning true (i.e. lexemes first) increasingly likely as depth increases."
+(defn lexemes-before-phrases
+  "returns true or false: true means generate by adding lexemes first;
+  otherwise, by adding phrases first. Takes depth as an argument,
+  which makes returning true (i.e. lexemes first) increasingly likely
+  as depth increases."
+  [depth max-total-depth]
   (if (not randomize-lexemes-before-phrases)
     false
     (if (> max-total-depth 0)
@@ -379,8 +386,9 @@
         (> (* 10 prob) (rand-int 10)))
       false)))

-(defn spec-info [spec]
+(defn spec-info
   "give a human-readable summary of _spec_."
+  [spec]
   (strip-refs
    (merge
     (if-let [cat (get-in spec [:synsem :cat])]


s/filtered-lexical-complements/lexical-complements/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -266,7 +266,7 @@
         bolt-child-synsem (strip-refs (get-in bolt (concat path [:synsem]) :top))
         bolt-child-italiano (strip-refs (get-in bolt (concat path [:italiano]) :top))

-        filtered-lexical-complements (lazy-shuffle
+        lexical-complements (lazy-shuffle
                                       (filter (fn [lexeme]
                                                 (and (not (= :fail (unify (strip-refs (get-in lexeme [:synsem] :top))
                                                                           bolt-child-synsem)))
@@ -295,7 +295,7 @@
                                                             :max-total-depth max-total-depth))
                         lexemes-before-phrases (lexemes-before-phrases total-depth max-total-depth)]
                     (cond (and lexemes-before-phrases
-                               (empty? filtered-lexical-complements)
+                               (empty? lexical-complements)
                                (= false (get-in spec [:phrasal] true)))
                           (log/warn (str "failed to generate any lexical complements with spec: "
                                          (strip-refs spec)))
@@ -306,7 +306,7 @@
                           (log/warn (str "failed to generate any phrasal complements with spec: "
                                          (strip-refs spec)))

-                          (and (empty? filtered-lexical-complements)
+                          (and (empty? lexical-complements)
                                (empty? phrasal-complements))

                           (let [message (str "add-complement-to-bolt: could generate neither phrasal "
@@ -324,7 +324,7 @@

                           lexemes-before-phrases
                           (take max-generated-complements
-                                (lazy-cat filtered-lexical-complements phrasal-complements))
+                                (lazy-cat lexical-complements phrasal-complements))
                           true
                           (do
                             (log/trace (str "successfully generated some complements for bolt:"
@@ -332,7 +332,7 @@
                                             " matching spec:"
                                             (spec-info spec)))

-                            (take max-generated-complements (lazy-cat phrasal-complements filtered-lexical-complements)))))))))
+                            (take max-generated-complements (lazy-cat phrasal-complements lexical-complements)))))))))

 (defn candidate-parents [rules spec]
   "find subset of _rules_ for which each member unifies successfully with _spec_"


Implement more metric functionality

Implement more metric functionality

--- src/beehive/metrics.clj
+++ src/beehive/metrics.clj
@@ -14,16 +14,21 @@

 (ns beehive.metrics
   (:require [beehive.utils :as utils])
-  (:import (net.uncontended.precipice.metrics DefaultActionMetrics Metric)))
+  (:import (net.uncontended.precipice.metrics ActionMetrics
+                                              DefaultActionMetrics
+                                              Metric)))

 (set! *warn-on-reflection* true)

-(defn get-count [metrics ^Metric metric]
-  (.getMetricCountForTotalPeriod metrics metric))
+(defn get-count [metrics metric]
+  (.getMetricCountForTotalPeriod ^ActionMetrics metrics metric))

 (defn get-count-for-period [metrics metric duration time-unit]
   (.getMetricCountForTimePeriod
-    metrics metric duration (utils/->time-unit time-unit)))
+    ^ActionMetrics metrics metric duration (utils/->time-unit time-unit)))
+
+(defn snapshot [metrics duration time-unit]
+  (.snapshot ^ActionMetrics metrics duration (utils/->time-unit time-unit)))

 (defn default-metrics
   ([{:keys [slots-to-track resolution time-unit]}]


Support dispatch-storm delay

Support dispatch-storm delay

--- src/cider_ci/builder/task.clj
+++ src/cider_ci/builder/task.clj
@@ -4,12 +4,18 @@

 (ns cider-ci.builder.task
   (:require
+    [cider-ci.builder.spec :as spec]
+    [cider-ci.builder.util :as util]
+
+    [cider-ci.utils.config :as config]
+    [cider-ci.utils.duration :as duration]
+    [cider-ci.utils.rdbms :as rdbms]
+
+    [clojure.java.jdbc :as jdbc]
+
     [clojure.tools.logging :as logging]
     [logbug.debug :as debug]
-    [cider-ci.utils.rdbms :as rdbms]
-    [cider-ci.builder.spec :as spec]
-    [clojure.java.jdbc :as jdbc]
-    [cider-ci.builder.util :as util]
+
   ))

@@ -37,6 +43,7 @@
              (rest pending-checks))
       errors)))

+
 ;### normalize task-spec ######################################################

 (defn- normalize-aggregate-succes [spec]
@@ -44,11 +51,26 @@
     spec
     (assoc spec :aggregate-state "satisfy-any")))

+(defn dispatch-storm-delay-default []
+  (or (config/parse-config-duration-to-seconds
+        :dispatch-storm-delay-default-duration)
+      5))
+
+(defn- normalize-dispatch-storm-delay [spec]
+  (if-let [dispatch-storm-delay-duration (:dispatch-storm-delay-duration spec)]
+    (-> spec (dissoc :dispatch-storm-delay-duration)
+        (assoc :dispatch_storm_delay_seconds
+               (-> dispatch-storm-delay-duration
+                   duration/parse-string-to-seconds
+                   Math/floor int)))
+    (assoc spec :dispatch_storm_delay_seconds (dispatch-storm-delay-default))))
+
 (defn- normalize-task-spec [raw-spec]
   (-> raw-spec
       clojure.walk/keywordize-keys
       (dissoc :job_id)
-      normalize-aggregate-succes))
+      normalize-aggregate-succes
+      normalize-dispatch-storm-delay))

 ;##############################################################################
@@ -58,7 +80,7 @@
         task-spec (normalize-task-spec raw-task-spec)
         db-task-spec (spec/get-or-create-task-spec task-spec)
         errors (validated-task-spec task-spec)
-        task-row (conj (select-keys task-spec [:name :state :error :priority])
+        task-row (conj (select-keys task-spec [:name :state :error :priority :dispatch_storm_delay_seconds])
                        {:job_id job-id
                         :traits (spec-map-to-array (or (:traits task-spec) {}))
                         :entity_errors errors


add as-vec utility function

add as-vec utility function

--- src/bract/core/util.clj
+++ src/bract/core/util.clj
@@ -76,3 +76,11 @@
      (alter-var-root var# (fn [old-val#] (or old-val# (do (vreset! old# old-val#) true))))
      (when-not @old#
        ~@body)))
+
+
+(defn as-vec
+  "Turn argument into a vector if it is a collection, else wrap the argument into a single-item vector."
+  [x]
+  (if (coll? x)
+    (vec x)
+    [x]))


Remove IResponse implementation and just use a plain function.

--- src/buddy/auth/http.clj
+++ src/buddy/auth/http.clj
@@ -37,6 +37,12 @@
   ([body status headers]
    {:status status :body body :headers headers}))

+(defn response?
+  [resp]
+  (and (map? resp)
+       (integer? (:status resp))
+       (map? (:headers resp))))
+
 (defn redirect
   "Returns a Ring compatible response for an HTTP 302 redirect."
   ([url] (redirect url 302))
@@ -53,16 +59,3 @@
   clojure.lang.IPersistentMap
   (-get-header [request header-name]
     (some-> (:headers request) (find-header header-name) val)))
-
-(extend-protocol IResponse
-  nil
-  (response? [_]
-    false)
-
-  Object
-  (response? [_] false)
-
-  clojure.lang.IPersistentMap
-  (response? [response]
-    (and (integer? (:status response))
-         (map? (:headers response)))))


Add initial Bifunctor protocol definition

--- src/cats/protocols.cljc
+++ src/cats/protocols.cljc
@@ -63,6 +63,10 @@
   "A data type that can be mapped over without altering its context."
   (-fmap [ftor f fv] "Applies function f to the value(s) inside the context of the functor fv."))

+(defprotocol Bifunctor
+  "A 'Functor' of two arguments."
+  (-bimap  [btor f g bv] "Map over both arguments at the same time."))
+
 (defprotocol Applicative
   "The Applicative abstraction."
   (-fapply [app af av]


Update protocols.cljc

Update protocols.cljc

--- src/cats/protocols.cljc
+++ src/cats/protocols.cljc
@@ -36,7 +36,7 @@
 (defprotocol Contextual
   "Abstraction that establishes a concrete type as a member of a context.

-  A great example es Maybe monad type Just. It implements
+  A great example is the Maybe monad type Just. It implements
   this abstraction to establish that Just is part of
   the Maybe monad."
   (-get-context [_] "Get the context associated with the type."))


some docstrings added

some docstrings added

--- src/push/util/code_wrangling.clj
+++ src/push/util/code_wrangling.clj
@@ -16,6 +16,7 @@

 (defn children
+  "Returns a `seq` on a node (without checking for type). Used for traversing code objects with `count-collection-points`."
   [node]
   (seq node))

@@ -59,7 +60,9 @@

-(defn find-in-tree [tree target]
+(defn find-in-tree
+  "Utility function that determines all the places where a target node or sub-tree exists within another tree. Each location is returned in a vector, which may end up being empty."
+  [tree target]
   (loop [loc (zip/seq-zip (seq tree))
          collector []]
     (if (zip/end? loc)


make minio lazy

make minio lazy

--- src/ci3/agent/cache.clj
+++ src/ci3/agent/cache.clj
@@ -2,7 +2,7 @@
   (:import io.minio.MinioClient)
   (:require [ci3.agent.shelk :as shelk]))

-(def client
+(defn client []
   (MinioClient. (System/getenv "CI3_SECRET_STORAGE_HOST")
                 (System/getenv "CI3_SECRET_STORAGE_ACCESSKEY")
                 (System/getenv "CI3_SECRET_STORAGE_SECRETKEY") true ))
@@ -10,18 +10,17 @@
 (def bucket
   (or (System/getenv "CI3_CONFIG_CACHE_BUCKET") "ci-cache"))

-
 ;; TODO: safe read and upload
 (defn archive-dir [dir to]
   (shelk/bash ["tar" "czvf" to dir ">/dev/null 2>&1"]))

 (defn upload-to-bucket [file-path k]
-  (.putObject client bucket k file-path))
+  (.putObject (client) bucket k file-path))

 (defn download-from-bucket [file-path k]
-  (.getObject client bucket k file-path))
+  (.getObject (client) bucket k file-path))

 (comment
-  (.bucketExists client bucket)
+  (.bucketExists (client) bucket)

   )


Change host resolution logging to debug

Change host resolution logging to debug

--- src/clj/shale/utils.clj
+++ src/clj/shale/utils.clj
@@ -32,7 +32,7 @@
   (re-matches #"(?:\d{1,3}\.){3}\d{1,3}" s))

 (defn resolve-host [host]
-  (logging/info (format "Resolving host %s..." host))
+  (logging/debug (format "Resolving host %s..." host))
   (if (is-ip? host)
     host
     (if-let [resolved (first ((dns-lookup host Type/A) :answers))]


fix grabbing user-info and putting it into :basic-auth

This fixes urls like 'http://user:password@foobar.com:8080/baz'
correctly setting the basic-auth headers

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -49,28 +49,28 @@
   #{200 201 202 203 204 205 206 207 300 301 302 303 307})

 (defn success?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (<= 200 status 299))

 (defn missing?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (= status 404))

 (defn conflict?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (= status 409))

 (defn redirect?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (<= 300 status 399))

 (defn client-error?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (<= 400 status 499))

 (defn server-error?
-  [{ :keys [status] }]
+  [{:keys [status]}]
   (<= 500 status 599))

 (defn wrap-exceptions [client]
@@ -341,6 +341,7 @@
   [request]
   (-> request
       wrap-query-params
+      wrap-basic-auth
       wrap-user-info
       wrap-url
       wrap-redirects
@@ -348,7 +349,6 @@
       wrap-input-coercion
       wrap-output-coercion
       wrap-exceptions
-      wrap-basic-auth
       wrap-accept
       wrap-accept-encoding
       wrap-content-type


Fix BindException from nrepl-server (#65)

* Improve get free port by setting SO_REUSEADDR

* get-free-port is done internally by nrepl.server, doing so here has the opposite effect of that intended

--- src/clojupyter/core.clj
+++ src/clojupyter/core.clj
@@ -16,16 +16,7 @@
             [clojure.walk :as walk]
             [taoensso.timbre :as log]
             [zeromq.zmq :as zmq])
-  (:import [java.net ServerSocket])
   (:gen-class :main true))
-
-(defn get-free-port!
-  "Get a free port. Problem?: might be taken before I use it."
-  []
-  (let [socket (ServerSocket. 0)
-        port (.getLocalPort socket)]
-    (.close socket)
-    port))

 (defn prep-config [args]
   (-> args
@@ -51,7 +42,6 @@

 (defn start-nrepl-server []
   (nrepl.server/start-server
-   :port (get-free-port!)
    :handler (clojupyer-nrepl-handler)))

 (defn exception-handler [e]


Simplified phase to just an :after bool.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -55,13 +55,13 @@
                                (assoc-in [:actxs child-actx]
                                          {:children {} :wait-chs {} :closed false})
                                (assoc-in [:actxs actx :children child-actx] true)))
-               [{:delta :actx-start :actx actx :child-actx child-actx :phase :curr}]))
+               [{:delta :actx-start :actx actx :child-actx child-actx :after true}]))
     :end (fn [vis actx args]
            (let [[child-actx result] args]
              (swap! vis #(-> %
                              (dissoc-in [:actxs child-actx])
                              (dissoc-in [:actxs actx :children child-actx])))
-             [{:delta :actx-end :actx actx :child-actx child-actx :phase :prev}]))}
+             [{:delta :actx-end :actx actx :child-actx child-actx}]))}
    :ago-loop
    {:loop-state (fn [vis actx args]
                   (swap! vis #(assoc-in % [:actxs actx :loop-state] (first args)))
@@ -85,7 +85,7 @@
                                (dissoc-in [:chs ch :msgs msg])))
                (when (nil? msg) ; The ch is closed.
                  (swap! vis #(dissoc-in % [:chs ch])))
-               [{:delta :take :msg msg :ch ch :actx actx :phase :prev :ch-name ch-name}]))}
+               [{:delta :take :msg msg :ch ch :actx actx :ch-name ch-name}]))}
    :aput
    {:before (fn [vis actx args]
               (let [[ch-name ch msg] args]
@@ -93,7 +93,7 @@
                                 (assoc-in [:actxs actx :wait-chs ch] [:put ch-name])
                                 (vis-add-ch ch nil)
                                 (assoc-in [:chs ch :msgs msg] true)))
-                [{:delta :put :msg msg :actx actx :ch ch :phase :prev :ch-name ch-name}]))
+                [{:delta :put :msg msg :actx actx :ch ch :ch-name ch-name}]))
     :after (fn [vis actx args]
              (let [[ch-name ch msg result] args]
                (swap! vis #(-> %
@@ -116,8 +116,7 @@
                                                  (assoc-in [:actxs actx :wait-chs ch]
                                                            [action])))
                                  (when (= action :put)
-                                   [{:delta :put :msg (first msgv) :actx actx :ch ch
-                                     :phase :prev}])))
+                                   [{:delta :put :msg (first msgv) :actx actx :ch ch}])))
                              ch-actions))))
     :after (fn [vis actx args]
              (let [[ch-bindings result] args
@@ -129,8 +128,7 @@
                (when (nil? result-msg) ; The ch is closed.
                  (swap! vis #(dissoc-in % [:chs result-ch])))
                (when (some #(= % result-ch) ch-bindings)
-                 [{:delta :take :msg result-msg :ch result-ch :actx actx
-                   :phase :prev}])))}})
+                 [{:delta :take :msg result-msg :ch result-ch :actx actx}])))}})

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

@@ -204,7 +202,7 @@
   ["<line class='" class "' x1='" x1 "' y1='" y1 "' x2='" x2 "' y2='" y2
    "' stroke='" stroke "' stroke-width='1' marker-end='url(#triangle)'/>"])

-(defn vis-svg-actxs [vis positions deltas phase]
+(defn vis-svg-actxs [vis positions deltas after]
   (let [stroke-width 1
         line-height 21
         chs (:chs vis)
@@ -233,7 +231,7 @@
                      (:wait-chs actx-info))))
            (:actxs vis))
      (mapv (fn [delta]
-             (when (= phase (:phase delta))
+             (when (= after (not (not (:after delta))))
                (let [childy (actx-y (:child-actx delta))
                      ay (actx-y (:actx delta))
                      cy (ch-y (:ch delta))]
@@ -310,12 +308,12 @@
         (when (and (not (zero? @event-delay)) (not-empty deltas) vis-last vis-last-positions)
           (set-el-innerHTML (str el-prefix "-svg")
                             (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
-                                                               deltas :prev))))
+                                                               deltas false))))
           (when (> @event-delay 0) (<! (timeout @event-delay)))
           (when (< @event-delay 0) (<! step-ch)))
         (assign-positions @vis @root-actx vis-positions actx-ch-ch-infos nil)
         (let [vis-next-html (apply str (flatten (vis-html-actx @vis @root-actx actx-ch-ch-infos)))
-              vis-next-svg (apply str (flatten (vis-svg-actxs @vis @vis-positions deltas :curr)))]
+              vis-next-svg (apply str (flatten (vis-svg-actxs @vis @vis-positions deltas true)))]
           (set-el-innerHTML (str el-prefix "-html") vis-next-html)
           (set-el-innerHTML (str el-prefix "-svg") vis-next-svg)
           (if (or (not= vis-next-html vis-last-html)


Little more DRY.

Little more DRY.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -226,41 +226,31 @@
            (:actxs vis))
      (mapv (fn [delta]
              (when (= phase (:phase delta))
-               (case (:delta delta)
-                 :put (when (get chs (:ch delta))
-                        ["<g transform='translate(500," (actx-y (:actx delta)) ")'>"
-                         "<line class='delta' x1='0' y1='0' x2='100' y2='"
-                         (- (ch-y (:ch delta)) (actx-y (:actx delta)))
-                         "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/>"
-                         "</g>"
-                         (when (:ch-name delta)
-                           ["<text class='ch-name' x='540' y='"
-                            (* 0.5 (+ (actx-y (:actx delta)) (ch-y (:ch delta))))
-                            "'>" (:ch-name delta) "</text>"])])
-                 :take (when (get chs (:ch delta))
-                         ["<g transform='translate(600," (ch-y (:ch delta)) ")'>"
-                          "<line class='delta' x1='0' y1='0' x2='-100' y2='"
-                          (- (actx-y (:actx delta)) (ch-y (:ch delta)))
-                          "' stroke='" (if (:msg delta) "green" "black")
-                          "' stroke-width='1' marker-end='url(#triangle)'/>"
-                          "</g>"
-                          (when (:ch-name delta)
-                            ["<text class='ch-name' x='540' y='"
-                             (* 0.5 (+ (actx-y (:actx delta)) (ch-y (:ch delta))))
-                             "'>" (:ch-name delta) "</text>"])])
-                 :actx-start (when (> (actx-y (:child-actx delta)) line-height)
-                               ["<g transform='translate(30," (actx-y (:actx delta)) ")'>"
-                                "<line class='delta' x1='0' y1='0' x2='30' y2='"
-                                (- (actx-y (:child-actx delta)) (actx-y (:actx delta)))
-                                "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/>"
-                                "</g>"])
-                 :actx-end (when (> (actx-y (:child-actx delta)) line-height)
-                             ["<g transform='translate(60," (actx-y (:child-actx delta)) ")'>"
-                              "<line class='delta' x1='0' y1='0' x2='-30' y2='"
-                              (- (actx-y (:actx delta)) (actx-y (:child-actx delta)))
-                              "' stroke='black' stroke-width='1' marker-end='url(#triangle)'/>"
-                              "</g>"])
-                 nil)))
+               (let [childy (actx-y (:child-actx delta))
+                     ay (actx-y (:actx delta))
+                     cy (ch-y (:ch delta))]
+                 [(case (:delta delta)
+                    :put (when (get chs (:ch delta))
+                           ["<g transform='translate(500," ay ")'>"
+                            "<line class='delta' x1='0' y1='0' x2='100' y2='" (- cy ay)
+                            "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/></g>"])
+                    :take (when (get chs (:ch delta))
+                            ["<g transform='translate(600," cy ")'>"
+                             "<line class='delta' x1='0' y1='0' x2='-100' y2='" (- ay cy)
+                             "' stroke='" (if (:msg delta) "green" "black")
+                             "' stroke-width='1' marker-end='url(#triangle)'/></g>"])
+                    :actx-start (when (> childy line-height)
+                                  ["<g transform='translate(30," ay ")'>"
+                                   "<line class='delta' x1='0' y1='0' x2='30' y2='" (- childy ay)
+                                   "' stroke='green' stroke-width='1' marker-end='url(#triangle)'/></g>"])
+                    :actx-end (when (> childy line-height)
+                                ["<g transform='translate(60," childy ")'>"
+                                 "<line class='delta' x1='0' y1='0' x2='-30' y2='" (- ay childy)
+                                 "' stroke='black' stroke-width='1' marker-end='url(#triangle)'/></g>"])
+                    nil)
+                  (when (:ch-name delta)
+                    ["<text class='ch-name' x='540' y='" (* 0.5 (+ ay cy))
+                     "'>" (:ch-name delta) "</text>"])])))
            deltas)]))

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


fixed overlapping use of symbol 'tasks'

fixed overlapping use of symbol 'tasks'

--- src/distillery/core.clj
+++ src/distillery/core.clj
@@ -1,6 +1,6 @@
 (ns distillery.core
   (:require [clojure.pprint :refer (pprint)])
-  (:require [distillery.tasks :as tasks]))
+  (:require [distillery.tasks :as dt]))

 ;(def root "D:\\Daten\\FH\\OLL\\") ;; FHB
 ;(def root "D:\\Repository\\Projekte\\Arbeit\\FHB\\OLL\\") ;; HOME
@@ -23,19 +23,19 @@
              :results-file (str root "Media\\Audio\\de-DE\\transcript\\Der Lambda-Kalkül (720).srr")}]})

 (def job (-> job-descr
-             tasks/load-speech-recognition-results
-             tasks/analyze-speech-recognition-results))
+             dt/load-speech-recognition-results
+             dt/analyze-speech-recognition-results))

-(def tasks {:prep tasks/prepare-output-dir
-            :main-page tasks/create-index-page
-            :categories-page tasks/create-categories-page
-            :videos-page tasks/create-videos-page
-            :glossary-page tasks/create-glossary-page
-            :videos tasks/create-video-pages})
+(def tasks {:prep dt/prepare-output-dir
+            :main-page dt/create-index-page
+            :categories-page dt/create-categories-page
+            :videos-page dt/create-videos-page
+            :glossary-page dt/create-glossary-page
+            :videos dt/create-video-pages})

 ((:prep tasks) job)

-(tasks/long-task "Complete run"
+(dt/long-task "Complete run"
   (doseq
     [task (rest (vals tasks))]
     (task job)))


updated init-state for units

updated init-state for units

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -44,9 +44,6 @@
       (vec (for [n (range 0 bench-size)]
        (dom/td nil))))))

-(defn update-player-position []
-    (om/update! (om/ref-cursor (:selected-unit (om/root-cursor app-state))) {:x 888 :y 999}))
-
 (defn blank-unit [data owner]
   (reify
     om/IInitState
@@ -54,28 +51,26 @@
                 {:init-state {:x (data :x) :y (data :y)}})
     om/IRender
     (render [_]
-      (dom/td #js {:onClick update-player-position}))))
+      (dom/td nil))))

 (defn player-unit [data owner]
   (reify
     om/IInitState
     (init-state [_]
-                {:init-state {:x (data :x) :y (data :y)}})
-    om/IRender
-    (render [_]
+                {:position {:x (data :x) :y (data :y)}})
+    om/IRenderState
+    (render-state [_ _]
       (if (:player data)
         (dom/td #js {:onClick #(om/update! (om/ref-cursor (:selected-unit (om/root-cursor app-state))) data)}
           (dom/img #js {:src player-image }))
         (om/build blank-unit data)))))

-
-
 (defn ball-unit [data owner]
   (reify
-    om/IInitState
-    (init-state [_]
-                {:init-state {:x (data :x) :y (data :y)}})
+;;     om/IInitState
+;;     (init-state [_]
+;;       {:x (data :x) :y (data :y)})
     om/IRender
     (render [_]
       (if (:ball data)
@@ -105,7 +100,7 @@
             (om/build ball-unit
               (find-unit x y (:loose-balls (:cells data))))
             (om/build player-unit
-              (find-unit x y (players data))))))))))
+              (find-unit x y (players data)) {:init-state {:x x :y y}}))))))))
   (bench)))


Updated function call.

Updated function call.

--- src/dragon/cli/show.clj
+++ src/dragon/cli/show.clj
@@ -33,7 +33,7 @@
   (log/debug "Got args:" args)
   (case cmd
     :all (pprint (config/dragon))
-    :port (pprint (config/get-port))
+    :port (pprint (config/port))
     :metadata (if-let [post (first args)]
                 (pprint (meta/get post))
                 (pprint (meta/get-all)))


Use busy-label to show circular busy progress

--- src/ecregister/core.clj
+++ src/ecregister/core.clj
@@ -3,13 +3,12 @@
   (:use [seesaw.core])
   (:use [seesaw.mig])
   (:use [seesaw.border])
+  (:use [seesaw.swingx])
   (:use [seesaw.widgets.log-window])
   (:require [clojure.string :refer [blank?]])
   (:require [clojure.core.async :refer [chan >!! <!! <! >! alts!! alts! timeout thread put! go go-loop close!]])
   (:require [ecregister.avatars :as av])
   )
-(require '[ecregister.avatars :as av])
-(use '[seesaw.border])

 ;; to be evaluated in *scratch*, to be executed in clj buffer
 ;; (define-key clojure-mode-map (kbd "C-c SPC")
@@ -45,7 +44,24 @@
       (config! (select form [:#save-label-new])
                :text (str (:save-dir-new @state) filename)))))

-;;(require '[clojure.core.async :refer [chan >!! <!! <! >! alts!! alts! timeout thread put! go go-loop close!]])
+(defn show-busy-indicators [show? form]
+  (let [label-ava-orig (select form [:#orig-ava])
+        label-ava-stamped (select form [:#stamped-ava])]
+    (if show?
+      (do
+        (config! label-ava-orig :icon (config label-ava-orig :user-data))
+        (config! label-ava-orig :busy? true)
+        (config! label-ava-stamped :icon (config label-ava-stamped :user-data))
+        (config! label-ava-stamped :busy? true))
+      (do
+        ;; save their custom icons and temporarily replace them with nil ones
+        ;; this is done to hide busy indicator on start and let it by shown only later before busy anim is launched
+        (config! label-ava-orig :user-data (config label-ava-orig :icon))
+        (config! label-ava-orig :icon nil)
+        (config! label-ava-stamped :user-data (config label-ava-stamped :icon))
+        (config! label-ava-stamped :icon nil)
+        ))))
+
 (defn prepare-avatars [username lb-log form]
   "Fetches an avatar from server, fills in image views, stamps it"
   (when (not (blank? username))
@@ -53,6 +69,7 @@
     (go
      (let [c (chan)
            resp (<! (av/get-avatar-url username c))]
+       (show-busy-indicators false form)
        (if (= resp :error)
          (log lb-log (str "failed to retrieve avatar image for '" username "'\n"))
          (let [image (<! (av/read-image (first resp) c))
@@ -71,12 +88,12 @@
               :items [[(label "Имя пользователя:") ""]
                       [(text :id :username :columns 15)]
                       [(vertical-panel
-                        :items [(label :id :orig-ava
+                        :items [(busy-label :id :orig-ava
                                        :border (line-border :color "#ddd" :thickness 1)
                                        :halign :center
                                        :valign :center
                                        :size [106 :by 106]) [:fill-v 10]
-                                (label :id :stamped-ava
+                                (busy-label :id :stamped-ava
                                        :border (line-border :color "#ddd" :thickness 1)
                                        :halign :center
                                        :valign :center
@@ -127,6 +144,7 @@
                               ;; important to put it back to channel immediately so others could read
                               (>! active-chan false)
                               (update-state :username (text te-name))
+                              (show-busy-indicators true form)
                               (prepare-avatars (text te-name) lb-log form)
                               ))))

@@ -181,6 +199,7 @@
                   )
                 )
               ))
+    (show-busy-indicators false form)
     form))

 (defn build-posts-tab []


[#111939863] Remove css shadow from screenshot

--- src/homepage/styles.clj
+++ src/homepage/styles.clj
@@ -54,8 +54,7 @@
              [:h3 {:font-weight "400"}]]
             [:.button {:max-width (px 200)
                        :margin    "0 auto"}]
-            [:.image {:width      (percent 100)
-                      :box-shadow "0px 2px 2px 0px rgba(34, 36, 38, 0.25)"}]]
+            [:.image {:width      (percent 100)}]]
            [:a {:text-decoration "none"
                 :color           teal
                 :font-size       (em 0.8)}]
@@ -207,4 +206,4 @@
                                      :margin     "0em 1em"}]
                                    [:#appboard
                                     [:.overview.row {:text-align "center"
-                                                     :justify-content "center"}]]]))
+                                                     :justify-content "center"}]]]))


fix typo

fix typo

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -69,7 +69,7 @@
 (defn wrap-object-events [ed obj]
   (dom/on (->elem ed) :contextmenu #(object/raise obj :menu! %))
   (on ed :dragstart #(.preventDefault %2))
-  (on ed :dragstenter #(.preventDefault %2))
+  (on ed :dragenter #(.preventDefault %2))
   (on ed :dragover #(.preventDefault %2))
   (on ed :drop #(.preventDefault %2))
   (on ed :scroll #(object/raise obj :scroll %))


datan hakeminen watcherilta

datan hakeminen watcherilta

--- mtg-pairings-wer/src/mtg_pairings/watcher.clj
+++ mtg-pairings-wer/src/mtg_pairings/watcher.clj
@@ -13,66 +13,75 @@
         new-tournaments (remove #((set (keys @state)) (:TournamentId %)) tournaments)
         new-tournaments (into {} (for [tournament new-tournaments]
                                    [(:TournamentId tournament)
-                                    {:name (:Name tournament)
+                                    {:name (:Title tournament)
                                      :rounds (:NumberOfRounds tournament)
-                                     :teams {:uploaded []
-                                             :waiting []}
-                                     :seatings {:uploaded []
-                                                :waiting []}
-                                     :pairings {:uploaded []
-                                                :waiting []}
-                                     :results {:uploaded []
-                                               :waiting []}
+                                     :day (:StartDate tournament)
+                                     :teams []
+                                     :seatings []
+                                     :pairings []
+                                     :results []
                                      :tracking false}]))]
     (swap! state merge new-tournaments)
     (doseq [[id t] new-tournaments]
       (handler id))))

-(defn ^:private round-done [results]
+(defn ^:private round-done? [results]
   (not-any? neg? (map :team1_wins results)))
-
-(defn ^:private set-uploaded! [k]
-  (fn [tournament]
-    (let [data (get-in tournament [k :waiting])]
-      (if (seq data)
-        (-> tournament
-          (assoc-in [k :waiting] [])
-          (assoc-in [k :uploaded] data))
-        tournament))))

 (defn ^:private tournament-checker [handlers]
   (fn [db tournament-id]
     (println "Checking tournament" tournament-id)
-    (letfn [(handler [type values]
+    (letfn [(handler! [type values]
               (let [f (get handlers type)]
-                (when (and (not= (get-in @state [tournament-id type :uploaded]) values)
-                           (not= (get-in @state [tournament-id type :waiting]) values))
-                  (swap! state assoc-in [tournament-id type :waiting] values)
+                (when (not= (get-in @state [tournament-id type]) values)
+                  (swap! state assoc-in [tournament-id type] values)
                   (when f
                     (f tournament-id)))))]
-      (handler :teams (reader/teams db tournament-id))
-      (handler :seatings (reader/seatings db tournament-id))
-      (handler :pairings (reader/pairings db tournament-id))
-      (handler :results (filter round-done (reader/results db tournament-id))))))
+      (handler! :teams (reader/teams db tournament-id))
+      (handler! :seatings (reader/seatings db tournament-id))
+      (handler! :pairings (reader/pairings db tournament-id))
+      (handler! :results (filter round-done? (reader/results db tournament-id))))))
+
+(defn get-tournament [id]
+  (let [tournament (get @state id)]
+    (select-keys tournament [:name :rounds :day])))
+
+(defn get-pairings [id round]
+  (nth (get-in @state [id :pairings]) (dec round) nil))
+
+(defn get-pairings-count [id]
+  (count (get-in @state [id :pairings])))
+
+(defn get-seatings [id]
+  (seq (get-in @state [id :seatings])))
+
+(defn get-results [id round]
+  (nth (get-in @state [id :results]) (dec round) nil))
+
+(defn get-results-count [id]
+  (count (get-in @state [id :results])))
+
+(defn get-teams [id]
+  (seq (get-in @state [id :teams])))

 (defn start! [path & {:as handlers}]
   (let [file (File. path)
         fname (.getName file)
-        checker (tournament-checker handlers)
-        on-change (fn [files]
-                    (doseq [f files
-                            :when (= fname (.getName f))]
-                      (with-open [db (reader/open (.getPath f))]
-                        (check-tournaments! db (:tournament handlers))
-                        (doseq [[id tourn] @state
-                                :when (:tracking tourn)]
-                          (checker db id)))))]
+        checker! (tournament-checker handlers)
+        on-change! (fn [files]
+                     (doseq [f files
+                             :when (= fname (.getName f))]
+                       (with-open [db (reader/open (.getPath f))]
+                         (check-tournaments! db (:tournament handlers))
+                         (doseq [[id tourn] @state
+                                 :when (:tracking tourn)]
+                           (checker! db id)))))]
     (if-not (.exists file)
       (throw (FileNotFoundException. path))
       (reset! watcher (watch/watcher [(.getParent file)]
                         (watch/rate 100)
                         (watch/file-filter (filename fname))
-                        (watch/on-change on-change))))))
+                        (watch/on-change on-change!))))))

 (defn stop! []
   (when @watcher


Fix ex-info call in dev-extras

Fix ex-info call in dev-extras

--- lib.app.dev/src/dev_extras.clj
+++ lib.app.dev/src/dev_extras.clj
@@ -96,7 +96,8 @@
           (let [builds# (keys @figwheel.main/build-registry)]
             (if (= (count builds#) 1)
               (figwheel.main.api/cljs-repl (first builds#))
-              (throw (ex-info "A build must be specified, please call with an argument"))))))))
+              (throw (ex-info "A build must be specified, please call with an argument"
+                              {:builds builds#}))))))))
   ([build-id]
    ;; Assume figwheel main
    (eval


Yet further docstrings

Yet further docstrings

--- src/processing/core.clj
+++ src/processing/core.clj
@@ -920,17 +920,28 @@
 ;; $$match
 ;; $$max

-(defn millis [] (.millis *applet*))
+(defn millis
+  "Returns the number of milliseconds (thousandths of a second) since
+  starting an applet. This information is often used for timing
+  animation sequences."
+  []
+  (.millis *applet*))

 ;; $$min

-(defn minute [] (PApplet/minute))
+(defn minute
+  "Returns the current minute as a value from 0 - 59"
+  []
+  (PApplet/minute))

 (defn model-x [x y z] (.modelX *applet* (float x) (float y) (float z)))
 (defn model-y [x y z] (.modelY *applet* (float x) (float y) (float z)))
 (defn model-z [x y z] (.modelZ *applet* (float x) (float y) (float z)))

-(defn month [] (PApplet/month))
+(defn month
+  "Returns the current month as a value from 1 - 12."
+  []
+  (PApplet/month))

 ;; $$mouseClicked
 ;; $$mouseDragged
@@ -1275,21 +1286,49 @@
 ;; $$saveStrings

 (defn scale
+  "Increases or decreases the size of a shape by expanding and
+  contracting vertices. Objects always scale from their relative
+  origin to the coordinate system. Scale values are specified as
+  decimal percentages. For example, the function call (scale 2)
+  increases the dimension of a shape by 200%. Transformations apply to
+  everything that happens after and subsequent calls to the function
+  multiply the effect. For example, calling (scale 2) and then
+  (scale 1.5) is the same as (scale 3). If scale is called within
+  draw, the transformation is reset when the loop begins again. Using
+  this fuction with the z parameter requires passing P3D or OPENGL
+  into the size parameter as shown in the example above. This function
+  can be further controlled by push-matrix and pop-matrix."
   ([s] (.scale *applet* (float s)))
   ([sx sy] (.scale *applet* (float sx) (float sy))))

 (defn screen-x
-  ([x y] (.screenX *applet* (float x) (float y)))
-  ([x y y] (.screenX *applet* (float x) (float y))))
+  "Takes a three-dimensional x, y, z position and returns the x value
+  for where it will appear on a (two-dimensional) screen, once
+  affected by translate, scale or any other transformations"
+  [x y z]
+  (.screenX *applet* (float x) (float y) (float z)))

 (defn screen-y
-  ([x y] (.screenY *applet* (float x) (float y)))
-  ([x y z] (.screenY *applet* (float x) (float y) (float z))))
+  "Takes a three-dimensional x, y, z position and returns the y value
+  for where it will appear on a (two-dimensional) screen, once
+  affected by translate, scale or any other transformations"
+  [x y z]
+  (.screenY *applet* (float x) (float y) (float z)))

 (defn screen-z
-  [x y z] (.screenX *applet* (float x) (float y) (float z)))
-
-(defn seconds [] (PApplet/second))
+  "Given an x, y, z coordinate, returns its z value.
+   This value can be used to determine if an x, y, z coordinate is in
+   front or in back of another (x, y, z) coordinate. The units are
+   based on how the zbuffer is set up, and don't relate to anything
+   'real'. They're only useful for in comparison to another value
+   obtained from screen-z, or directly out of the zbuffer"
+  [x y z]
+  (.screenX *applet* (float x) (float y) (float z)))
+
+(defn seconds
+  "Returns the current second as a value from 0 - 59."
+  []
+  (PApplet/second))

 ;; $$selectFolder
 ;; $$selectInput


Remove server def

Remove server def

--- src/clj/decktouch/handler.clj
+++ src/clj/decktouch/handler.clj
@@ -26,6 +26,3 @@
 (def app
   (let [handler (wrap-reload (wrap-params routes site-defaults))]
     (if (env :dev?) (wrap-reload (wrap-exceptions handler)) handler)))
-
-(defonce server
-  (jetty/run-jetty app {:port 8080}))


condensed running total function code down into fewer jobs.

--- src/clj/forma/source/fire.clj
+++ src/clj/forma/source/fire.clj
@@ -119,7 +119,7 @@

 ;; Combines various fire tuples into one.
-(defaggregateop combine
+(defaggregateop comb
   ([] (FireTuple. 0 0 0 0))
   ([state tuple] (add-fires state tuple))
   ([state] [state]))
@@ -131,17 +131,37 @@
   (<- [?dataset ?m-res ?new-t-res ?tilestring ?tperiod ?sample ?line ?newtuple]
       (datetime->period ?new-t-res ?datestring :> ?tperiod)
       (identity t-res :> ?new-t-res)
-      (combine ?tuple :> ?newtuple)
+      (comb ?tuple :> ?newtuple)
       (src ?dataset ?m-res ?t-res ?tilestring ?datestring ?sample ?line ?tuple)))
+
+(defn running-sum
+  "Given an accumulator, an initial value and an addition function,
+  transforms the input sequence into a new sequence of equal length,
+  increasing for each value."
+  [acc init add-func tseries]
+  (first (reduce (fn [[coll last] new]
+                   (let [last (add-func last new)]
+                     [(conj coll last) last]))
+                 [acc init] tseries)))
+
+(defn running-fire-sum
+  "Special case of `running-sum` for `FireTuple` thrift objects."
+  [tseries]
+  (let [empty (FireTuple. 0 0 0 0)]
+    (->> (.getValues tseries)
+         (running-sum [] empty add-fires)
+         (mk-ts (.startPeriod tseries)
+                (.endPeriod tseries)))))

 (defn fire-series
   "Aggregates fires into timeseries."
   [t-res start end src]
   (let [empty (FireTuple. 0 0 0 0)]
-    (<- [?dataset ?m-res ?t-res ?tilestring ?tperiod ?sample ?line ?tseries]
+    (<- [?dataset ?m-res ?t-res ?tilestring ?sample ?line ?ct-series]
         (src ?dataset ?m-res ?t-res ?tilestring ?tperiod ?sample ?line ?tuple)
         (:sort ?tperiod)
-        (sparse-expansion [t-res start end empty] ?tperiod ?tuple :> ?tseries))))
+        (sparse-expansion [t-res start end empty] ?tperiod ?tuple :> ?tseries)
+        (running-fire-sum ?tseries :> ?ct-series))))

 (defn run-rip
   "Rips apart fires!"


yeah no touching ...

yeah no touching ...

--- src/clj/shadow/cljs/build.clj
+++ src/clj/shadow/cljs/build.clj
@@ -1168,16 +1168,13 @@
                                              (let [macro (assoc macro
                                                                 :scan :macro
                                                                 :last-modified new-mod)]
-                                               (doseq [{:keys [file] :as rc} (->> used-by (map #(get-in state [:sources %])))
-                                                       :when file]
-                                                 ;; FIXME: this is soooooo ugly
-                                                 ;; touching the file to make sure it is always
-                                                 ;; modified when the macro is edited
-                                                 ;; FIXME: this modification causes the loop below to also add the file to the modified list
-                                                 ;; FIXME: should not assume there is a file!
-                                                 (.setLastModified file new-mod))
-
-                                               (conj result macro)
+                                               (->> used-by
+                                                    (map #(get-in state [:sources %]))
+                                                    (map (fn [rc]
+                                                           (assoc rc
+                                                                  :scan :modified
+                                                                  :last-modified new-mod)))
+                                                    (into (conj result macro)))
                                                ))))
                                        []))]


unify resulting hash-map keys' to a set, not vector for diff/intersect/etc.

--- src/clj_css_analyzer/core.clj
+++ src/clj_css_analyzer/core.clj
@@ -34,7 +34,7 @@
 (defn- css-map[css-data]
   (reduce
     #(let [v (peek %2)
-        k (pop %2)]
+        k (set (pop %2))]
       (assoc %1 k v))
       {} (parsed-css-to-vectors css-data)))

@@ -45,7 +45,8 @@
     (clojure.string/trim)
     (clojure.string/split #"\s+")
     (->> (map #(keyword (str "*." %))))
-      vec))
+      set ;vec
+      ))

 (defn- css-from-html-map[elements]
   (reduce (fn [res node]
@@ -61,6 +62,12 @@
 (def styles-from-css (css-map css-data))
 (def styles-from-html (css-from-html-map styled-els))

-;(pprint (keys styles-from-css))
-;(pprint (keys styles-from-html))
+(pprint (keys styles-from-css))
+(pprint (keys styles-from-html))

+;;;;;;;;;;;;;;;;;
+;; todo
+
+; diff
+;  + unify resulting hash-map keys' to a set, not vector — diff/intersect/...
+;


Color most hotkeys

Color most hotkeys

--- src/cljc/robinson/render.cljc
+++ src/cljc/robinson/render.cljc
@@ -150,34 +150,52 @@
   ([s]
    (str->chars s :white :black))
   ([s fg bg]
-   (map (fn [c] {:c c :fg fg :bg bg :style #{}})
+   (str->chars s fg bg #{}))
+  ([s fg bg style]
+   (map (fn [c] {:c c :fg fg :bg bg :style style})
         s)))

 (defn markup->chars
-  [x y s]
-  (let [z (zip-str (str "" s ""))]
-    (println "s" s)
-    (map-indexed (fn [idx c] (assoc c :c  (str (get c :c))
-                                      :x  (+ x idx)
-                                      :y  y
-                                      :fg (color->rgb (get c :fg))
-                                      :bg (color->rgb (get c :bg))))
-                 (reduce (fn [characters v]
-                           (cond
-                             (string? v)
-                               (concat characters
-                                       (str->chars v))
-                             (map? v)
-                               (concat characters
-                                       (str->chars (-> v :content first)
-                                                   (if (= (get v :tag) :color)
-                                                     (keyword (get-in v [:attrs :fg] :white))
-                                                     :white)
-                                                   (if (= (get v :tag) :color)
-                                                     (keyword (get-in v [:attrs :bg] :black))
-                                                     :black)))))
-                         []
-                         (-> z zip/node :content)))))
+  ([x y s]
+   (markup->chars x y s :white :black))
+  ([x y s fg bg]
+   (markup->chars x y s fg bg #{}))
+  ([x y s fg bg style]
+   (if (re-find #"^\s*$" s)
+     (map (fn [idx] {:c     " "
+                     :x     (+ x idx)
+                     :y     y
+                     :fg    (color->rgb fg)
+                     :bg    (color->rgb bg)
+                     :style style})
+          (range (count s)))
+     (let [body    (str "" s "")
+           z       (zip-str body)
+           content (-> z zip/node :content)
+           characters
+       (map-indexed (fn [idx c] (assoc c :c     (str (get c :c))
+                                         :x     (+ x idx)
+                                         :y     y
+                                         :fg    (color->rgb (get c :fg))
+                                         :bg    (color->rgb (get c :bg))
+                                         :style style))
+                    (reduce (fn [characters v]
+                              (cond
+                                (string? v)
+                                  (concat characters
+                                          (str->chars v fg bg style))
+                                (map? v)
+                                  (concat characters
+                                          (str->chars (-> v :content first)
+                                                      (if (= (get v :tag) :color)
+                                                        (keyword (get-in v [:attrs :fg] fg))
+                                                        fg)
+                                                      (if (= (get v :tag) :color)
+                                                        (keyword (get-in v [:attrs :bg] bg))
+                                                        bg)))))
+                            []
+                            content))]
+      characters))))

 (defn put-string
   ([^robinson.aterminal.ATerminal screen x y string]
@@ -230,6 +248,21 @@
 (defn is-menu-state? [state]
   (contains? #{:inventory :describe-inventory :pickup :drop :eat} (get-in state [:world :current-state])))

+(defn markup-length [s]
+ (let [body    (str "" s "")
+       z       (zip-str body)
+       content (-> z zip/node :content)]
+   (reduce (fn [n v]
+             (cond
+               (string? v)
+                 (+ n
+                    (count v))
+               (map? v)
+                 (+ n
+                    (-> v :content first count))))
+           0
+           content)))
+
 (defn center-text [s width]
   (let [n-ws-left (int (/ (- width (count s)) 2))
         n-ws-right (int (+ 0.5 (/ (- width (count s)) 2)))]
@@ -237,6 +270,15 @@

 (defn left-justify-text [s width]
   (let [n-ws (- width (count s))]
+   (apply str (concat s (repeat n-ws " ")))))
+
+(defn center-markup [s width]
+  (let [n-ws-left (int (/ (- width (markup-length s)) 2))
+        n-ws-right (int (+ 0.5 (/ (- width (markup-length s)) 2)))]
+   (apply str (concat (repeat n-ws-left " ") s (repeat n-ws-right " ")))))
+
+(defn left-justify-markup [s width]
+  (let [n-ws (- width (markup-length s))]
    (apply str (concat s (repeat n-ws " ")))))

 (defn render-line
@@ -248,9 +290,9 @@
         ;; pad to width
         s        (if center
                    ;; center justify
-                   (center-text line width)
+                   (center-markup line width)
                    ;; left justify
-                   (left-justify-text line width))
+                   (left-justify-markup line width))
         [fg bg]  (if invert
                    [bg fg]
                    [fg bg])
@@ -258,7 +300,8 @@
                    #{:underline}
                    #{})]
     #_(log/info "put-string" (format "\"%s\"" line) "width" width)
-    (put-string screen x y s fg bg style)))
+    #_(put-string screen x y s fg bg style)
+    (put-chars screen (markup->chars x y s fg bg style))))

 (defn render-rect-border
@@ -290,7 +333,7 @@
     (if (< i (count items))
       (let [item (nth items i)]
         (render-line screen x (+ y i) width (get item :s) (get item :fg) (get item :bg) (get item :style)))
-      (render-line screen x (+ y i) width "" :white :white #{}))))
+      (render-line screen x (+ y i) width " " :white :white #{}))))

 (defn render-text
   [screen position title text]
@@ -331,8 +374,8 @@
   ([screen title selected-hotkeys items x y width height {:keys [use-applicable center border center-title]
                                                           :or {:use-applicable false :border false :center false :center-title false}}]
    ;; items is list of {:s "string" :fg :black :bg :white}
-   (let [items    (map (fn [item] {:s (format #?(:clj  "%c%c%s%s %s %s"
-                                                 :cljs "%s%s%s%s %s %s")
+   (let [items    (map (fn [item] {:s (format #?(:clj  "<color fg=\"highlight\">%c</color>%c%s%s %s %s"
+                                                 :cljs "<color fg=\"highlight\">%s</color>%s%s%s %s %s")
                                               (or (item :hotkey)
                                                   \ )
                                               (if (contains? selected-hotkeys (item :hotkey))


attempting to add touch events

attempting to add touch events

--- src/cljs/palimpsest/core.cljs
+++ src/cljs/palimpsest/core.cljs
@@ -28,6 +28,7 @@
 (def drawn-strokes (atom []))
 (def undone-strokes (atom '()))
 (def stroke-thickness (atom 1))
+(def current-touch-id (atom nil))

 (defn event->coord [event]
   (let [canvasrect (.getBoundingClientRect canvas-element)]
@@ -59,6 +60,26 @@
 (defn mouseup-handler [event]
   (when (= 0 (.-button event))
     (finish-stroke)))
+
+(defn touchstart-handler [event]
+  (let [touches (filter #(> (.-force %) 0.0) (.-targetTouches event))]
+    (when-not (empty? touches)
+      (swap! current-touch-id #(-> (first touches) .-identifier))
+      (start-stroke (event->coord (first touches))))))
+
+(defn find-matching-touch [touches]
+  (let [matching (filter #(= @current-touch-id (.-identifier %)) touches)]
+    (if (empty? matching) nil (first matching))))
+
+(defn touchmove-handler [event]
+  (let [touch (find-matching-touch (.-targetTouches event))]
+    (when (and (not (nil? touch)) @dragging)
+      (add-drawn-coord (event->coord touch)))))
+
+(defn touchend-handler [event]
+  (let [touch (find-matching-touch (.-targetTouches event))]
+    (when-not (nil? touch)
+      (finish-stroke))))

 (defn redraw-all-strokes [ctx strokes]
   (drawing/clear-screen ctx)
@@ -142,9 +163,12 @@
   (setup-click-handler ["increase-thickness", "decrease-thickness"])
   (setup-input-handler ["stroke-thickness"])
   (add-canvas-handlers
-    ["mousemove" mousemove-handler]
-    ["mousedown" mousedown-handler]
-    ["mouseup"   mouseup-handler])
+    ["touchmove"  touchmove-handler]
+    ["touchstart" touchstart-handler]
+    ["touchend"   touchend-handler]
+    ["mousemove"  mousemove-handler]
+    ["mousedown"  mousedown-handler]
+    ["mouseup"    mouseup-handler])
   (canvas/fill-style canvas-context "#000"))

 (init)


CMR-377: Adding KML mime type.

CMR-377: Adding KML mime type.

--- src/cmr/common/mime_types.clj
+++ src/cmr/common/mime_types.clj
@@ -13,7 +13,8 @@
    "application/iso19115+xml" :iso19115
    "application/dif+xml" :dif
    "text/csv" :csv
-   "application/atom+xml" :atom})
+   "application/atom+xml" :atom
+   "application/vnd.google-earth.kml+xml" :kml})

 (def format->mime-type
   {:json "application/json"
@@ -23,7 +24,8 @@
    :iso19115 "application/iso19115+xml"
    :dif "application/dif+xml"
    :csv "text/csv"
-   :atom "application/atom+xml"})
+   :atom "application/atom+xml"
+   :kml "application/vnd.google-earth.kml+xml"})

 (defn mime-type->format
   "Converts a mime-type into the format requested."


Add more functions to sql dsl.

Add more functions to sql dsl.

--- src/cljooq/dsl.clj
+++ src/cljooq/dsl.clj
@@ -1,13 +1,6 @@
 (ns cljooq.dsl
   "Sql building dsl"
   (:import org.jooq.impl.DSL))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Types
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defrecord QueryPart [q])
-(defn query-part [q] (QueryPart. q))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Protocols for constructors
@@ -18,6 +11,9 @@

 (defprotocol ITable
   (table [_] "Table constructor"))
+
+(defprotocol ICondition
+  (condition [_] "Condition constructor"))

 (defprotocol IVal
   (val [_] "Val constructor"))
@@ -38,20 +34,102 @@
   (table [s] (DSL/table s))

   clojure.lang.Keyword
-  (table [kw] (table (name kw))))
+  (table [kw] (table (name kw)))
+
+  org.jooq.Table
+  (table [t] t))
+
+(extend-protocol ICondition
+  java.lang.String
+  (condition [s] (DSL/condition s))
+
+  org.jooq.impl.CombinedCondition
+  (condition [c] c)
+
+  org.jooq.impl.SQLCondition
+  (condition [c] c)
+
+  clojure.lang.PersistentVector
+  (condition [v]
+    (let [sql    (first v)
+          params (rest v)]
+      (->> (into-array Object params)
+           (DSL/condition sql)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DSL functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn select
-  [& args]
-  (->> (mapv field args)
+  "Start select statement."
+  [& fields]
+  (->> (map field fields)
        (into-array org.jooq.Field)
        (DSL/select)))

 (defn from
+  "Creates from clause."
   [q & tables]
   (->> (map table tables)
        (into-array org.jooq.Table)
        (.from q)))
+
+(defn join
+  "Create join clause."
+  [q t]
+  (.join q t))
+
+(defn on
+  [q cond]
+  (.on q cond))
+
+(defn where
+  "Create where clause with variable number
+  of conditions (that are implicitly combined
+  with `and` logical operator)."
+  [q & clauses]
+  (->> (map condition clauses)
+       (into-array org.jooq.Condition)
+       (.where q)))
+
+(defn exists
+  "Create an exists condition."
+  [q select']
+  (DSL/exists select'))
+
+(defn limit
+  "Creates limit clause."
+  [q num]
+  (.limit q num))
+
+(defn offset
+  "Creates offset clause."
+  [q num]
+  (.offset q num))
+
+(defn as
+  "Set alias."
+  [q name]
+  (.as q name))
+
+(defn and
+  "Logican operator `and`."
+  [& conditions]
+  (let [conditions (map condition conditions)]
+    (reduce (fn [acc v] (.and acc v))
+            (first conditions)
+            (rest conditions))))
+
+(defn or
+  "Logican operator `or`."
+  [& conditions]
+  (let [conditions (map condition conditions)]
+    (reduce (fn [acc v] (.or acc v))
+            (first conditions)
+            (rest conditions))))
+
+(defn not
+  "Negate a condition."
+  [c]
+  (DSL/not c))
+


Logging: setting :console false works again.

Closes #336

--- src/riemann/logging.clj
+++ src/riemann/logging.clj
@@ -60,20 +60,20 @@
   :files           A list of files to log to. If provided, a seq is expected
                    containing maps with a :path and an optional :layout key
                    which can be any of: :riemann, :json-event :json-eventv1
-
+
   Example:
-
+
   (init {:console false :file \"/var/log/riemann.log\"})"
   [& opts]
   ;; Reset loggers
   (let [{:keys [file
                 files
-                console
-                console-layout]} (if (and (= 1 (count opts))
-                                          (map? (first opts)))
-                                   (first opts)
-                                   (apply array-map opts))
-         console (or console true)
+                console-layout]
+         :as opts} (if (and (= 1 (count opts))
+                            (map? (first opts)))
+                     (first opts)
+                     (apply array-map opts))
+         console (get opts :console true)
          logger (doto (Logger/getRootLogger) (.removeAllAppenders))]

     (when console


New function in DB module: read-component-name

--- src/hurvinek/db_interface.clj
+++ src/hurvinek/db_interface.clj
@@ -70,6 +70,19 @@
         (->
             (jdbc/query db-spec/hurvinek-db
                             ["select name from groups where id=?" group-id])
+            first
+            (get :name))
+        (catch Exception e
+            (println e)
+            nil)))
+
+(defn read-component-name
+    "Read name of component for the given component id."
+    [component-id]
+    (try
+        (->
+            (jdbc/query db-spec/hurvinek-db
+                            ["select name from components where id=?" component-id])
             first
             (get :name))
         (catch Exception e


consistent import names

consistent import names

--- src/desdemona/ui/core.cljs
+++ src/desdemona/ui/core.cljs
@@ -1,6 +1,6 @@
 (ns desdemona.ui.core
   (:require [desdemona.ui.nav :refer [nav]]
-            [reagent.core :as reagent :refer [atom]]
+            [reagent.core :as r :refer [atom]]
             [reagent.session :as session]
             [secretary.core :as secretary :include-macros true]
             [accountant.core :as accountant]))
@@ -11,7 +11,7 @@
    [(session/get :current-page)]])

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

 (defn init!
   []


Some clean-up and begin refactorisation

Some clean-up and begin refactorisation

--- src-cljs/photon/ui/frontend.cljs
+++ src-cljs/photon/ui/frontend.cljs
@@ -13,10 +13,12 @@
            goog.net.EventType))

 (defonce app-state (atom {:stream nil
+                          :random (rand 10)
                           :current nil
                           :initial-value ""
                           :reduction ""
                           :projections []
+                          :active-page "Dashboard"
                           :new-projection false}))
 (defonce localhost (let [href (.-href (.-location js/window))]
                      (clojure.string/join
@@ -37,6 +39,16 @@

 (defn update-box [owner box-ref]
   (.highlightBlock js/hljs (om/get-node owner box-ref)))
+
+(defn label [text]
+  (dom/label #js {:className "input-label"} text))
+
+(defn input [value fn-update]
+  (dom/input
+      #js {:className "wide-input"
+           :type "text" :ref "name"
+           :value value
+           :onChange fn-update}))

 (defn widget-new-projection [params owner]
   (let [data (:data params)]
@@ -50,22 +62,15 @@
         (dom/div
             #js {:className "new-projection"}
             (dom/h1 #js {:className "view-title"} "New Projection")
-            (dom/div
-                #js {:className "box"}
-              (dom/div
-                  nil
-                (dom/label #js {:className "input-label"} "Projection name")
-                (dom/input
-                    #js {:className "wide-input"
-                         :type "text" :ref "name"
-                         :value (:projection-name data)
-                         :onChange
-                         (fn [ev]
-                           (om/update! data :projection-name
-                                       (.-value (.-target ev))))}))
-              (dom/div
-                  nil
-                (dom/label #js {:className "input-label"} "Stream name")
+            (dom/div #js {:className "box"}
+              (dom/div nil
+                (label "Projection name")
+                (input (:projection-name data)
+                       (fn [ev]
+                         (om/update! data :projection-name
+                                     (.-value (.-target ev))))))
+              (dom/div nil
+                (label "Stream name")
                 (dom/input
                     #js {:className "wide-input"
                          :type "text" :ref "name"
@@ -74,8 +79,7 @@
                          (fn [ev]
                            (om/update! data :stream-name
                                        (.-value (.-target ev))))}))
-              (apply dom/div
-                     #js {:className "radio"}
+              (apply dom/div #js {:className "radio"}
                      "Language:"
                      (map #(dom/div
                                nil
@@ -87,8 +91,7 @@
                              %)
                           ["clojure" "javascript"]))
               (dom/div nil "Initial value")
-              (dom/pre
-               nil
+              (dom/pre nil
                (dom/code #js {:className "clojure"}
                          (dom/div
                              #js {:contentEditable "true"
@@ -101,8 +104,7 @@
                                     (update-box owner "initial-value-box"))}
                              (:initial-value data))))
               (dom/div nil "Code: content of (fn [prev item] ... )")
-              (dom/pre
-               nil
+              (dom/pre nil
                (dom/code #js {:className "clojure"}
                          (dom/div
                              #js {:contentEditable "true"
@@ -114,8 +116,7 @@
                                                 (.-textContent (.-target ev)))
                                     (update-box owner "code-box"))}
                              (:reduction data))))
-              (dom/div
-                  nil
+              (dom/div nil
                 (dom/button
                     #js {:onClick
                          (fn [_]
@@ -657,7 +658,7 @@
   (reify
     om/IInitState
     (init-state [_]
-      (assoc data :root-owner owner :active-page "Dashboard"))
+      (assoc data :root-owner owner))
     om/IDidMount
     (did-mount [_]
       (subscribe-streams! owner)
@@ -665,15 +666,15 @@
       (subscribe-stats! owner))
     om/IRenderState
     (render-state [_ state]
+      (swap! app-state (fn [_] state))
       (dom/div
         nil
         (om/build main-menu
                   {:data state
                    :items ["Dashboard" "Streams" "Projections"
-                           "New Projection" "New Stream"
-                           "Analyse Data"]})
+                           "New Projection" "New Stream"]})
         (dom/div nil
-          (condp = (:active-page state)
+          (condp = (:active-page (om/get-state owner))
             "Dashboard" (om/build widget-dashboard state)
             "Streams" (om/build widget-streams state)
             "Projections" (om/build widget-projections state)


external settings and cleaner API

external settings and cleaner API

--- src/es/node.clj
+++ src/es/node.clj
@@ -1,35 +1,66 @@
+(comment
+   Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+   Licensed under the Apache License,
+   Version 2.0  (the "License") you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.)
+
 (ns es.node
   "An embedded ES node instance"
+  (:import
+    [org.elasticsearch.node NodeBuilder])
   (:require
+    [celestial.common :refer (get!)]
+    [clojurewerkz.elastisch.native.conversion :as cnv]
     [clojurewerkz.elastisch.native :as es]
-    [clojurewerkz.elastisch.native.index :as idx]
-    [clojurewerkz.elastisch.native.document :as doc]))
+    ))

 (def ES (atom nil))

-(defn start-node
+(defn build-local-node
+  [settings]
+    (.build
+      (doto (NodeBuilder/nodeBuilder)
+      (.settings (cnv/->settings settings))
+      (.data true)
+      (.local true))))
+
+
+(defn settings
+   "embedded ES settings"
+   []
+   (merge (get! :elasticsearch) {
+      :node.name "celestial" :cluser.name "celestial-cluster"
+      :local true :http.enabled false
+    }))
+
+(defn start
   "launch en embedded ES node"
   []
-  (reset! ES
-          (es/start-local-node
-            (es/build-local-node
-              {:node.name "celestial"
-               :cluser.name "celestial-cluster"
-               :path.logs "/tmp/celestial-es"
-               :path.data "/tmp/celestial-es"
-               :path.work "/tmp/celestial-es"
-               :local true :http.enabled false }))))
+  (reset! ES (es/start-local-node (build-local-node (settings)))))

-(defn stop-node
+(defn connect
+   []
+  (es/connect-to-local-node! @ES))
+
+(defn start-n-connect
+   "Both starts the node and connects to it"
+   []
+  (start)
+  (connect))
+
+(defn stop
   "stops embedded ES node"
   []
   (.close @ES)
   (reset! ES nil))

-(comment (start-node)
-         (stop-node)
-         ;; (println @ES)
-         (es/connect-to-local-node! @ES)
-         (idx/create "myapp2_development" )
-         (doc/put "myapp2_development" "person"  "10" {:username "ronen"})
-         (doc/get "myapp2_development" "person" "10"))
+;; (start)
+;; (stop)
+;; (idx/create "myapp2_development" )
+;; (doc/put "myapp2_development" "person"  "10" {:username "ronen"})
+;; (doc/get "myapp2_development" "person" "10")


Include error in coercion exception data

--- src/fnhouse/middleware.clj
+++ src/fnhouse/middleware.clj
@@ -60,6 +60,7 @@
                     {:type :coercion-error
                      :schema schema
                      :data data
+                     :error error
                      :context context}))
             res))))))


add missing disambiguation

add missing disambiguation

--- src/house/rooms/front.cljc
+++ src/house/rooms/front.cljc
@@ -85,7 +85,7 @@
 (def cash (item/make ["bunch of cash" "cash" "money" "wads" "wads of cash"] "Around 15 thousand pesos, I estimated."
                      :take {:pre true
                             :points 150}))
-(def box (item/make "box" "Shoes, I guessed."
+(def box (item/make ["box" "wardrobe box" "shoe box"] "Shoes, I guessed."
                     :take "I wasn’t interested in the box, but maybe in its contents."
                     :open {:pre true
                            :say "The box was full of wads of cash that I quickly estimated in around 15 thousand pesos."


better reflective error messages

better reflective error messages

--- src/insn/op.clj
+++ src/insn/op.clj
@@ -84,7 +84,9 @@
                  (.getType f))]
      (if (== 1 (count types))
        (&fn v cls fname (first types))
-       (throw (ex-info (str "no field found with name '" fname "'") {})))))
+       (let [msg (format "no %s field found with name '%s'"
+                         (if static? "static" "instance") fname)]
+         (throw (ex-info msg {:candidates types}))))))
   ([v cls fname ftype]
    (.visitFieldInsn v &op (util/class-desc cls)
                     (name fname) (util/type-desc ftype))))
@@ -182,13 +184,15 @@
                                       [(.getReturnType m)]))]
                   (if (== 1 (count descs))
                     (first descs)
-                    (let [init (if (zero? (count descs))
-                                 "no method"
-                                 "multiple methods")
-                          msg (str init " found with name '" mname "'"
-                                   (when-not (neg? arity)
-                                     (str " with arity " arity)))]
-                      (throw (ex-info msg {:arity arity})))))
+                    (let [nstr (if (zero? (count descs)) "no" "multiple")
+                          type (if static? "static" "instance")
+                          plural (if (= nstr "no") "" "s")
+                          msg (format "%s %s method%s found with name '%s'%s"
+                                      nstr type plural mname
+                                      (if (neg? arity)
+                                        ""
+                                        (str " with arity " arity)))]
+                      (throw (ex-info msg {:candidates descs})))))
                 desc-or-arity)]
      (.visitMethodInsn v &op (util/class-desc cls)
                        mname (util/method-desc desc)))))


optimized while stmt for infinite loop

optimized while stmt for infinite loop

--- src/kondolisp/compiler.clj
+++ src/kondolisp/compiler.clj
@@ -246,6 +246,30 @@

 (declare compile-pass1)

+(defn fold-constant [exp]
+  exp)
+
+(defn constant? [exp]
+  (cond
+   (or (= exp 't)
+       (= exp 'T))
+   true
+   ;;
+   :else false))
+
+(defn kondoval-nil? [exp]
+  (and (constant? exp)
+       (cond
+        (or (= exp 'nil)
+            (= exp 'NIL))
+        true
+        ;;
+        :else	false)))
+
+(defn kondoval-t? [exp]
+  (and (constant? exp)
+       (not (kondoval-nil? exp))))
+
 (defn compile-quote [exp]
   (cond
    (or (and (coll? exp)
@@ -300,7 +324,10 @@
         retry-label (gensym)]
     `((:VM_IVAL ~(make-num 0))
       (:VM_BIND ~(make-sym var))
+      (:VM_IVAL ~(make-nil))
+      (:VM_PUSH)
       ~retry-label
+      (:VM_POP)
       ~@(apply concat (map compile-pass1 body))
       (:VM_PUSH)
       ;; (:VM_VREF ~(make-sym var))
@@ -310,15 +337,32 @@
       ;; (:VM_VSET ~(make-sym var))
       ;; (:VM_VREF ~(make-sym var))
       (:VM_VINC ~(make-sym var))
-      (:VM_PUSH)
       (:VM_IVAL ~(make-num num))
       (:VM_LE)
       (:VM_BIF ~end-label)
-      (:VM_POP)
       (:VM_JMP ~retry-label)
       ~end-label
       (:VM_POP)
       (:VM_UNBIND 1))))
+
+(defn compile-while [pred body]
+  (let [retry-label (gensym),
+        end-label (gensym)
+        pred (fold-constant pred)]
+    (if (kondoval-t? pred)
+      `(~retry-label
+        ~@(apply concat (map compile-pass1 body))
+        (:VM_JMP ~retry-label))
+      `((:VM_IVAL ~(make-nil))
+        ~retry-label
+        (:VM_PUSH)
+        ~@(compile-pass1 pred)
+        (:VM_BIFN ~end-label)
+        (:VM_POP)
+        ~@(apply concat (map compile-pass1 body))
+        (:VM_JMP ~retry-label)
+        ~end-label
+        (:VM_POP)))))

 (defn builtin-fun-id [fname]
   (index (fn [pair] (= (first pair) fname))
@@ -416,18 +460,7 @@
             `(~@insts
               ~end-label))
           ;;
-	  ('while pred & body)	(let [retry-label (gensym),
-				      end-label (gensym)]
-				  `((:VM_IVAL ~(make-nil))
-                                    ~retry-label
-                                    (:VM_PUSH)
-				    ~@(compile-pass1 pred)
-				    (:VM_BIFN ~end-label)
-                                    (:VM_POP)
-				    ~@(apply concat (map compile-pass1 body))
-				    (:VM_JMP ~retry-label)
-				    ~end-label
-                                    (:VM_POP)))
+	  ('while pred & body)	(compile-while pred body)
 	  ;;
 	  ('dotimes (var num) & body)
           (compile-dotimes var num body)


fixed playlist continuation bug

fixed playlist continuation bug

--- src/server/client-interface.cljs
+++ src/server/client-interface.cljs
@@ -181,10 +181,14 @@
                           (rooms/next-track room
                             (fn [track-id sound-id]
                               (if-not (nil? track-id)
-                                (.emit (.to io room)
-                                       "track-change"
-                                       track-id
-                                       sound-id))))))))))))))))
+                                (rooms/track-complete room
+                                  (fn []
+                                    (rooms/clear-ready-to-start room
+                                      (fn []
+                                        (.emit (.to io room)
+                                               "track-change"
+                                               track-id
+                                               sound-id))))))))))))))))))))

   (.on socket "track-deleted"
     (fn []