Protocolise printableness in graph previews

--- src/templater/grafter/rdf/preview.clj
+++ src/templater/grafter/rdf/preview.clj
@@ -2,7 +2,9 @@
   "Tool support for rendering previews of grafter.tabular graph-fn templates
   with values from datasets."
   (:require [clojure.walk]
-            [clojure.edn :as edn]))
+            [clojure.edn :as edn]
+            [grafter.tabular :refer [make-dataset]])
+  (:import [incanter.core Dataset]))

 (defn- symbolize-keys [m]
   (zipmap (map (comp symbol name) (keys m)) (vals m)))
@@ -46,7 +48,12 @@
          f)
        f)) form))

+;; The UnreadableForm record is used to wrap serializable representations of
+;; unserializable EDN/Clojure forms on the wire.
 (defrecord UnreadableForm [form-string form-class])
+
+(defn unreadable-form [val]
+  (->UnreadableForm (str val)  (str (.getName (class val)))))

 (defn- readable-form?
   "Returns false if the form can't be read, or returns the form (truthy) if it
@@ -57,13 +64,36 @@
     (catch IllegalArgumentException ex
       false)))

-(defn- ->printable-row [row-data]
-  (letfn [(make-readable [val]
-            (if (readable-form? val)
-              val
-              (->UnreadableForm (str val)  (str (.getName (class val))))))]
-    (zipmap (map make-readable (keys row-data))
-            (map make-readable (vals row-data)))))
+(defprotocol ToPrintable
+  (->printable-form [o]
+    "Converts object into a printable form by returning an UnreadableForm
+    representation of it (or its constituent parts if it can't be
+    serialized.)"))
+
+(extend-protocol ToPrintable
+  incanter.core.Dataset
+  (->printable-form [ds]
+    (make-dataset (map ->printable-form (:rows ds))
+                  (map ->printable-form (:column-names ds))))
+
+  java.util.Map
+  (->printable-form [form]
+    (letfn [(make-readable [val]
+              (if (readable-form? val)
+                val
+                (unreadable-form val)))]
+      (zipmap (map make-readable (keys form))
+              (map make-readable (vals form)))))
+
+  java.lang.Object
+  (->printable-form [form]
+    (if (readable-form? form)
+      form
+      (unreadable-form form)))
+
+  nil
+  (->printable-form [nl]
+    nil))

 (defn preview-graph
   "Takes a dataset a function built via grafter.tabular/graph-fn and a row
@@ -80,7 +110,7 @@
    (let [form (:grafter.tabular/template (meta graphf))
          bindings (first (second form))
          body-forms (drop 2 form)
-         printable-row-data (->printable-row (nth (:rows dataset) row nil))
+         printable-row-data (->printable-form (nth (:rows dataset) row nil))
          subs (substitution-map bindings printable-row-data)]

      {:bindings bindings :row printable-row-data :template


Test web push

Test web push

--- src/modal_synth/core.cljs
+++ src/modal_synth/core.cljs
@@ -49,6 +49,9 @@
 ;   - need a way to specify fader positions without actuating it and capturing new state
 ;     - 'send to pos' same problem
 ;chopper/tremolo (discourse)
+;fullscreen
+;rainmask into modal synth
+; - audio pipe utility page?

 (def gain-multiplier 1)
 (def delay-time-multiplier 0.05)


tests for consolidated service

tests for consolidated service

--- src/ohds/user_service.clj
+++ src/ohds/user_service.clj
@@ -6,7 +6,7 @@

 (def urls {:location "/locations"
            :individual "/individuals"
-           :socialgroup "/socialGroups"
+           :socialGroup "/socialGroups"
            :residency "/residencies"
            :membership "/memberships"
            :relationship "/relationships"
@@ -107,34 +107,37 @@
 (defrecord SocialGroup []
   Entity->Rest
   (create [this]
-    (post-entity :socialgroup this))
-  (fetch [this]
-    (fetch-entity :socialgroup this)))
+    (post-entity :socialGroup this))
+  (fetch [this]
+    (fetch-entity :socialGroup this)))

 (defrecord Residency []
   Entity->Rest
   (create [this]
-    (->> (nest-uuid :individual this)
-         (nest-uuid :location this)
-         (post-entity :residency this)))
+    (->> this
+         (nest-uuid :individual)
+         (nest-uuid :location)
+         (post-entity :residency)))
   (fetch [this]
     (fetch-entity :residency this)))

 (defrecord Membership []
   Entity->Rest
   (create [this]
-    (->> (nest-uuid :individual this)
-         (nest-uuid :socialGroup this)
-         (post-entity :membership this)))
+    (->> this
+         (nest-uuid :individual)
+         (nest-uuid :socialGroup)
+         (post-entity :membership)))
   (fetch [this]
     (fetch-entity :membership this)))

 (defrecord Relationship []
   Entity->Rest
   (create [this]
-    (->> (nest-uuid :individualA this)
-         (nest-uuid :individualB this)
-         (post-entity :relationship this)))
+    (->> this
+         (nest-uuid :individualA)
+         (nest-uuid :individualB)
+         (post-entity :relationship)))
   (fetch [this]
     (fetch-entity :relationship this)))

@@ -147,28 +150,54 @@
   (get-entity (bulk-url locations-url) :locations))

+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Manual Tests ;;;;
 (comment
-
-  (create (map->Location {:name "test location"
-                          :extId "test location"
-                          :type "RURAL"
-                          :collectionDateTime "2016-08-01T00:56:55.920Z"
-                          :collectedByUuid "UNKNOWN_STATUS"}))
-
-
-
   (find-user {:username "user"
               :password "password"})

   (find-fieldworker {:username "fieldworker"
                      :password "password"})

-  (create-location
-   {:name "test location"
-    :extId "test location"
-    :type "RURAL"
-    :collectionDateTime "2016-08-01T00:56:55.920Z"
-    :collectedByUuid "UNKNOWN_STATUS"})
-  )
+  (let [loc (create (map->Location {:name "test location"
+                                    :extId "test location"
+                                    :type "RURAL"
+                                    :collectionDateTime "2016-08-01T00:56:55.920Z"
+                                    :collectedByUuid "UNKNOWN_STATUS"}))
+
+        grp (create (map->SocialGroup {:groupName "test group"
+                                       :extId "test group"
+                                       :groupType "COHORT"
+                                       :collectionDateTime "2016-08-01T00:00:00.000Z"
+                                       :collectedByUuid "UNKNOWN_STATUS"}))
+
+        ind (create (map->Individual {:firstName "tester"
+                                      :extId "tester"
+                                      :gender "FEMALE"
+                                      :collectionDateTime "2016-08-01T00:00:00.000Z"
+                                      :collectedByUuid "UNKNOWN_STATUS"}))]
+
+    [(create (map->Residency {:individual ind
+                              :location loc
+                              :startType "BIRTH_MIGRATION"
+                              :startDate "2015-01-01T00:00:00.000Z"
+                              :collectionDateTime "2016-08-01T00:00:00.000Z"
+                              :collectedByUuid "UNKNOWN_STATUS"}))
+
+     (create (map->Membership {:socialGroup grp
+                               :individual ind
+                               :startType "BIRTH_MIGRATION"
+                               :startDate "2015-01-01T00:00:00.000Z"
+                               :collectionDateTime "2016-08-01T00:00:00.000Z"
+                               :collectedByUuid "UNKNOWN_STATUS"
+                               }))
+     (create (map->Relationship {:individualA ind
+                                 :individualB ind
+                                 :relationshipType "SELF"
+                                 :startDate "2015-01-01T00:00:00.000Z"
+                                 :collectionDateTime "2016-08-01T00:00:00.000Z"
+                                 :collectedByUuid "UNKNOWN_STATUS"
+                                 }))]
+    )
+)


munge synth args to handle non-idable maps in arbitrary places in the arg list.

Allows for arg-maps to be used in conjunction with :tgt & :pos hints in addition to non key worded positional args.

i.e.

(defsynth foo [freq 440 vol 1]
  (out 0 (* vol (sin-osc freq))))

(foo 330 {:vol 0.25})

(foo {:vol 0.25} :freq 220)

(foo :pos 3 330 {:vol 0.5})

(foo {:vol 1} {:freq 330})

Fixes #110

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -475,7 +475,7 @@
                                constants#)
                   constants# (into [] (set (concat constants# *constants*)))]
 ;;              (println "all ugens[" (count ugens#) "]: " ugens#)
-       [~sname ~params ugens# constants#])))))
+              [~sname ~params ugens# constants#])))))

 (defn synth-player
   [name params this & args]
@@ -497,13 +497,8 @@
     These can also be abbreviated:
     (foo :tgt 2 :pos :head)
     "
-    (let [arg-names (map keyword (map :name params))
-          args (if (and (= 1 (count args))
-                        (map? (first args))
-                        (not (id-able-type? (first args))))
-                 (flatten (seq (first args)))
-
-                 args)
+    (let [arg-names     (map keyword (map :name params))
+          args (or args [])
           [args sgroup] (if (or (= :target (first args))
                                 (= :tgt    (first args)))
                           [(drop 2 args) (second args)]
@@ -516,16 +511,21 @@
                                 (= :tgt    (first args)))
                           [(drop 2 args) (second args)]
                           [args sgroup])
+          args          (mapcat (fn [x] (if (and (map? x)
+                                                (not (id-able-type? x)))
+                                         (flatten (seq x))
+                                         [x]))
+                                args)
           args          (map #(if (id-able-type? %)
                                 (:id %) %) args)
-          defaults (into {} (map (fn [{:keys [name value]}]
-                                   [(keyword name) @value])
-                                 params))
-          arg-map  (arg-mapper args arg-names defaults)
-          synth-node (node name arg-map {:position pos :target sgroup })
-          synth-node (if (:instance-fn this)
-                       ((:instance-fn this) synth-node)
-                       synth-node)]
+          defaults      (into {} (map (fn [{:keys [name value]}]
+                                        [(keyword name) @value])
+                                      params))
+          arg-map       (arg-mapper args arg-names defaults)
+          synth-node    (node name arg-map {:position pos :target sgroup })
+          synth-node    (if (:instance-fn this)
+                          ((:instance-fn this) synth-node)
+                          synth-node)]
       (when (:instance-fn this)
         (swap! active-synth-nodes* assoc (:id synth-node) synth-node))
       synth-node))


no need for with-conf

no need for with-conf

--- test/celestial/integration/puppet.clj
+++ test/celestial/integration/puppet.clj
@@ -31,8 +31,7 @@
         (run-cycle f/redis-prox-spec f/redis-type))

   (fact "provisioning a vcenter instance" :integration :puppet :vcenter
-        (with-conf
-          (run-cycle f/redis-vc-spec f/redis-type)))
+        (run-cycle f/redis-vc-spec f/redis-type))

   (fact "provisioning an ec2 instance" :integration :puppet :ec2
         "assumes a working ec2 defs in ~/.celestial.edn"


tests for throwing failedbatchexception in finishedId

--- test/clj/backtype/storm/drpc_test.clj
+++ test/clj/backtype/storm/drpc_test.clj
@@ -2,9 +2,10 @@
   (:use [clojure test])
   (:import [backtype.storm.drpc ReturnResults DRPCSpout
             LinearDRPCTopologyBuilder])
-  (:import [backtype.storm.coordination CoordinatedBolt$FinishedCallback])
+  (:import [backtype.storm.coordination CoordinatedBolt$FinishedCallback FailedBatchException])
   (:import [backtype.storm LocalDRPC LocalCluster])
   (:import [backtype.storm.tuple Fields])
+  (:import [backtype.storm.generated DRPCExecutionException])
   (:use [backtype.storm bootstrap testing])
   (:use [backtype.storm.daemon common])
   (:use [backtype.storm clojure])
@@ -29,7 +30,7 @@
                                 exclamation-bolt)
                    "3" (bolt-spec {"2" :shuffle}
                                 (ReturnResults.))})]
-    (.submitTopology cluster "test" {TOPOLOGY-DEBUG true} topology)
+    (.submitTopology cluster "test" {} topology)

     (is (= "aaa!!!" (.execute drpc "test" "aaa")))
     (is (= "b!!!" (.execute drpc "test" "b")))
@@ -55,7 +56,7 @@
     (.addBolt builder exclamation-bolt-drpc 3)
     (.submitTopology cluster
                      "builder-test"
-                     {TOPOLOGY-DEBUG true}
+                     {}
                      (.createLocalTopology builder drpc))
     (is (= "aaa!!!" (.execute drpc "test" "aaa")))
     (is (= "b!!!" (.execute drpc "test" "b")))
@@ -173,3 +174,31 @@
     (.shutdown cluster)
     (.shutdown drpc)
     ))
+
+(defbolt fail-finish-bolt ["request" "result"] {:prepare true}
+  [conf context collector]
+  (bolt
+   (execute [tuple]
+            (ack! collector tuple))
+   CoordinatedBolt$FinishedCallback
+   (finishedId [this id]
+               (throw (FailedBatchException.))
+               )))
+
+(deftest test-drpc-fail-finish
+  (let [drpc (LocalDRPC.)
+        cluster (LocalCluster.)
+        builder (LinearDRPCTopologyBuilder. "fail2")
+        ]
+    (.addBolt builder fail-finish-bolt 3)
+
+    (.submitTopology cluster
+                     "fail2"
+                     {}
+                     (.createLocalTopology builder drpc))
+
+    (is (thrown? DRPCExecutionException (.execute drpc "fail2" "2")))
+
+    (.shutdown cluster)
+    (.shutdown drpc)
+    ))


fix tests

fix tests

--- test/clj/just_married/labels_test.clj
+++ test/clj/just_married/labels_test.clj
@@ -20,8 +20,9 @@
   (testing "gen table with one address"
     (is (= [:pdf-table
             {:width-percent 100, :horizontal-align :right}
-            [20 20 20]
+            [10 10 10]
             [[:pdf-cell
-              {:align :right}
+              {:align :right
+               :padding (repeat 4 8)}
               "Long group name\nMy street 42, Town 10022 (PR)\nItaly"]]]
            (sut/gen-table [sample-address])))))


immediately highlight square when dragging

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -5,6 +5,11 @@
             [chessground.common :as common :refer [pp square-key push-args!]]))

 (def over-class "drag-over")
+
+(defn- highlight-square [$el]
+  (when (not (jq/has-class $el over-class))
+    (jq/remove-class (jq/siblings $el) over-class)
+    (jq/add-class $el over-class)))

 (defn- on-start [_ event _]
   "Shift piece right under the cursor"
@@ -14,14 +19,13 @@
         center-y (+ (.-top pos) (/ (.height $el) 2))
         decay-x (- (.-pageX event) center-x)
         decay-y (- (.-pageY event) center-y)]
-    (jq/css $el {:left (str decay-x "px") :top (str decay-y "px")})))
+    (jq/css $el {:left (str decay-x "px") :top (str decay-y "px")})
+    (highlight-square (jq/parent $el))))

 (defn- on-move [_ event _]
   "Highlight the square under the dragged piece"
   (let [$el ($ (common/square-element (.-target event)))]
-    (when (not (jq/has-class $el over-class))
-      (jq/remove-class (jq/siblings $el) over-class)
-      (jq/add-class $el over-class))))
+    (highlight-square $el)))

 (defn make [channels component]
   "Make a react component draggable"


Pausing the game now also pauses the tetris theme if playing.

--- src/client/game/core.cljs
+++ src/client/game/core.cljs
@@ -78,6 +78,10 @@
   "Temp state of the board when paused"
   (atom nil))

+(def paused-music
+  "Temp state of the music when paused"
+  (atom nil))
+
 (def music-playing?
   "Boolean flag signaling if the music is playing or not"
   (atom false))
@@ -422,16 +426,19 @@
   []
   (reset! state @paused-board)
   (put! resume-grav 0)
-  (reset! paused? false))
+  (reset! paused? false)
+  (reset! music-playing? @paused-music))

 (defn pause-game!
   "Saves the current state of the board, loads the game-over animation and pauses gravity"
   []
   (reset! paused-board @state)
+  (reset! paused-music @music-playing?)
   (go-go-game-over!)
   (swap! state assoc :piece nil)
   (put! pause-grav 0)
-  (reset! paused? true))
+  (reset! paused? true)
+  (reset! music-playing? false))

 (defn toggle-pause-game!
   "Toggles pause on the game board"


CLJS-1077: analyze-deps infinite recursive loop

Delegate to second arity, passing nil for opts.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1104,7 +1104,7 @@
       false)))

 (defn analyze-deps
-  ([lib deps env] (analyze-deps lib deps env))
+  ([lib deps env] (analyze-deps lib deps env nil))
   ([lib deps env opts]
      (binding [*cljs-dep-set* (vary-meta (conj *cljs-dep-set* lib) update-in [:dep-path] conj lib)]
        (assert (every? #(not (contains? *cljs-dep-set* %)) deps)


consolidate resolve-var & resolve-existing-var - the only difference was the warning.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -111,91 +111,64 @@
   (and (get (:defs (@namespaces 'cljs.core)) sym)
        (not (contains? (-> env :ns :excludes) sym))))

+(defn resolve-var
+  "Resolve a var. Accepts a side-effecting confirm fn for producing
+   warnings about unresolved vars."
+  ([env sym] (resolve-var env sym nil))
+  ([env sym confirm]
+     (if (= (namespace sym) "js")
+       {:name sym :ns 'js}
+       (let [s (str sym)
+             lb (-> env :locals sym)]
+         (cond
+           lb lb
+
+           (namespace sym)
+           (let [ns (namespace sym)
+                 ns (if (= "clojure.core" ns) "cljs.core" ns)
+                 full-ns (resolve-ns-alias env ns)]
+             (when confirm
+               (confirm env full-ns (symbol (name sym))))
+             (merge (get-in @namespaces [full-ns :defs (symbol (name sym))])
+                    {:name (symbol (str full-ns) (str (name sym)))
+                     :ns full-ns}))
+
+           (.contains s ".")
+           (let [idx (.indexOf s ".")
+                 prefix (symbol (subs s 0 idx))
+                 suffix (subs s (inc idx))
+                 lb (-> env :locals prefix)]
+             (if lb
+               {:name (symbol (str (:name lb) suffix))}
+               (do
+                 (when confirm
+                   (confirm env prefix (symbol suffix)))
+                 (merge (get-in @namespaces [prefix :defs (symbol suffix)])
+                        {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix))
+                         :ns prefix}))))
+
+           (get-in @namespaces [(-> env :ns :name) :uses sym])
+           (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
+             (merge
+              (get-in @namespaces [full-ns :defs sym])
+              {:name (symbol (str full-ns) (str sym))
+               :ns (-> env :ns :name)}))
+
+           (get-in @namespaces [(-> env :ns :name) :imports sym])
+           (recur env (get-in @namespaces [(-> env :ns :name) :imports sym]) confirm)
+
+           :else
+           (let [full-ns (if (core-name? env sym)
+                           'cljs.core
+                           (-> env :ns :name))]
+             (when confirm
+               (confirm env full-ns sym))
+             (merge (get-in @namespaces [full-ns :defs sym])
+                    {:name (symbol (str full-ns) (str sym))
+                     :ns full-ns})))))))
+
 (defn resolve-existing-var [env sym]
-  (if (= (namespace sym) "js")
-    {:name sym :ns 'js}
-    (let [s (str sym)
-          lb (-> env :locals sym)]
-      (cond
-       lb lb
-
-       (namespace sym)
-       (let [ns (namespace sym)
-             ns (if (= "clojure.core" ns) "cljs.core" ns)
-             full-ns (resolve-ns-alias env ns)]
-         (confirm-var-exists env full-ns (symbol (name sym)))
-         (merge (get-in @namespaces [full-ns :defs (symbol (name sym))])
-           {:name (symbol (str full-ns) (str (name sym)))
-            :ns full-ns}))
-
-       (.contains s ".")
-       (let [idx (.indexOf s ".")
-             prefix (symbol (subs s 0 idx))
-             suffix (subs s (inc idx))
-             lb (-> env :locals prefix)]
-         (if lb
-           {:name (symbol (str (:name lb) suffix))}
-           (do
-             (confirm-var-exists env prefix (symbol suffix))
-             (merge (get-in @namespaces [prefix :defs (symbol suffix)])
-              {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix))
-               :ns prefix}))))
-
-       (get-in @namespaces [(-> env :ns :name) :uses sym])
-       (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
-         (merge
-          (get-in @namespaces [full-ns :defs sym])
-          {:name (symbol (str full-ns) (str sym))
-           :ns (-> env :ns :name)}))
-
-       (get-in @namespaces [(-> env :ns :name) :imports sym])
-       (recur env (get-in @namespaces [(-> env :ns :name) :imports sym]))
-
-       :else
-       (let [full-ns (if (core-name? env sym)
-                       'cljs.core
-                       (-> env :ns :name))]
-         (confirm-var-exists env full-ns sym)
-         (merge (get-in @namespaces [full-ns :defs sym])
-           {:name (symbol (str full-ns) (str sym))
-            :ns full-ns}))))))
-
-(defn resolve-var [env sym]
-  (if (= (namespace sym) "js")
-    {:name sym}
-    (let [s (str sym)
-          lb (-> env :locals sym)]
-      (cond
-       lb lb
-
-       (namespace sym)
-       (let [ns (namespace sym)
-             ns (if (= "clojure.core" ns) "cljs.core" ns)]
-         {:name (symbol (str (resolve-ns-alias env ns)) (name sym))})
-
-       (.contains s ".")
-       (let [idx (.indexOf s ".")
-             prefix (symbol (subs s 0 idx))
-             suffix (subs s idx)
-             lb (-> env :locals prefix)]
-         (if lb
-           {:name (symbol (str (:name lb) suffix))}
-           {:name sym}))
-
-       (get-in @namespaces [(-> env :ns :name) :uses sym])
-       (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
-         (merge
-          (get-in @namespaces [full-ns :defs sym])
-          {:name (symbol (str full-ns) (name sym))}))
-
-       (get-in @namespaces [(-> env :ns :name) :imports sym])
-       (recur env (get-in @namespaces [(-> env :ns :name) :imports sym]))
-
-       :else
-       (let [ns (if (core-name? env sym)
-                  'cljs.core
-                  (-> env :ns :name))]
-         {:name (symbol (str ns) (name sym))})))))
+  (resolve-var env sym confirm-var-exists))

 (defn confirm-bindings [env names]
   (doseq [name names]


add logout route

add logout route

--- src/clj/yambox/routes.clj
+++ src/clj/yambox/routes.clj
@@ -1,5 +1,6 @@
 (ns yambox.routes
   (:require
+   [cemerick.friend :as friend]
    [clj-http.client :as http]
    [compojure.core :as c]
    [compojure.route :as route]
@@ -22,7 +23,8 @@

 (c/defroutes main
   (c/GET "/" [] (static-html "index.html"))
-  (c/GET "/create" [] (tpl/page-create)))
+  (c/GET "/create" [] (tpl/page-create))
+  (friend/logout (c/GET "/logout" request (resp/redirect "/"))))

 (c/defroutes secure
   (c/GET "/page" req


fix misc/dot to stop atom/watch-fn race condition

--- src/cljc/tupelo/misc.cljc
+++ src/cljc/tupelo/misc.cljc
@@ -450,25 +450,6 @@
      (defn dots-config! ; #todo need docstring
        [ctx]        ; #todo check pos integers
        (swap! dots-ctx conj ctx))
-     (defn dot-counter-watch-fn
-       [key dot-counter-ref old-count new-count]
-       (let [decimation     (grab :decimation @dots-ctx)
-             counts-per-row (* decimation (grab :dots-per-row @dots-ctx))]
-         (locking dots-lock
-           (when (not= old-count new-count)
-             (when (zero? (rem old-count counts-per-row))
-               (it-> old-count
-                 (str it)
-                 (ts/pad-left it 10)
-                 (glue it \space)
-                 (print it))
-               (flush))
-             (when (zero? (rem old-count decimation))
-               (print \.)
-               (flush))
-             (when (zero? (rem new-count counts-per-row))
-               (newline)
-               (flush))))))

      (defn dot
        "Prints a single dot (flushed) to the console, keeping a running count of dots printed.  Wraps to a
@@ -484,15 +465,33 @@
                   (Thread/sleep 5)))
         "
        []
-       (swap! dot-counter inc))
+       (locking dots-lock
+         (let [[old-count new-count] (swap-vals! dot-counter inc)
+               decimation     (grab :decimation @dots-ctx)
+               counts-per-row (* decimation (grab :dots-per-row @dots-ctx))]
+           (when (zero? (rem old-count counts-per-row))
+             (it-> old-count
+               (str it)
+               (ts/pad-left it 10)
+               (glue it \space)
+               (print it))
+             (flush))
+           (when (zero? (rem old-count decimation))
+             (print \.)
+             (flush))
+           (when (zero? (rem new-count counts-per-row))
+             (newline)
+             (flush)))))

      (defmacro with-dots
        "Increments indentation level of all spy, spyx, or spyxx expressions within the body."
        [& body]
        `(do
-          (remove-watch dot-counter :dot-counter)
+          (newline)
+          (println "***** with-dots-new *****")
+          (newline)
+
           (reset! dot-counter 0)
-          (add-watch dot-counter :dot-counter dot-counter-watch-fn)
           (let [result# (do ~@body)]
             (newline)
             (println (#?(:clj format
@@ -506,7 +505,6 @@
        Useful for debugging purposes."
        [hid :- HID]
        nil)         ; #todo
-

      ;-----------------------------------------------------------------------------
      ; -> tupelo.files ?


Added missing reader argument to unread in number-literal?. Refs CLJS-48

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -56,7 +56,7 @@
   (or (numeric? initch)
       (and (or (= \+ initch) (= \- initch))
            (numeric? (let [next-ch (read-char reader)]
-                       (unread next-ch)
+                       (unread reader next-ch)
                        next-ch)))))

 (declare read macros dispatch-macros)


Add closing paren on final comment.

Add closing paren on final comment.

--- src/cljs/cljs/string.cljs
+++ src/cljs/cljs/string.cljs
@@ -154,4 +154,5 @@
                           (str replacement))]
         (if (next cm)
           (recur ret (rest cm))
-          ret))))+          ret)))))
+


Fixed visibility for canvas-action function

--- src/cljs/drawer/core.cljs
+++ src/cljs/drawer/core.cljs
@@ -32,7 +32,7 @@

 (def ^:private canvas-channel (chan))

-(defn- canvas-action
+(defn canvas-action
   "Adds an action into the canvas channel.
   This applies the action to the current state
   and updates the gui asynchronously."


new districts

new districts

--- src/cljs/geoforms/db.cljs
+++ src/cljs/geoforms/db.cljs
@@ -112,19 +112,34 @@
 (def categories (reaction (get @category-translations @language)))

 (def districts
-  (atom ["Beauport"
+  (atom ["Ancienne-Lorette"
+         "Beauport"
+         "Cap-Rouge"
          "Charlesbourg"
+         "Duberger-Les-Saules"
+         "Lac-Beauport"
+         "Lac-Saint-Charles"
          "Lairet"
+         "Lebourgneuf"
+         "Loretteville"
          "Maizerets"
          "Méandres"
          "Montcalm"
+         "Neufchâtel"
+         "Saint-Augustin"
+         "Saint-Émile"
          "Saint-Jean-Baptiste"
          "Saint-Roch"
          "Saint-Sauveur"
          "Sainte-Foy"
          "Sillery"
+         "Stoneham"
+         "Val-Bélair"
+         "Vanier"
          "Vieux-Limoilou"
+         "Vieux-Québec"
          "Autre"]))
+

 (def district-ideas
   (reaction (let [ds @districts


Missed state update

Missed state update

--- src/cljs/gtfve/state.cljs
+++ src/cljs/gtfve/state.cljs
@@ -6,6 +6,7 @@
    :environment :development
    :ui {:editor {:mode :view
                  :modes {:stops? false}
+                 :update-render? false
                  :map-options {:center {:lat 0
                                         :lng 0}}}
         :panel {:tab :stops


Setup websocket.

Setup websocket.

--- src/cljs/org_ui/core.cljs
+++ src/cljs/org_ui/core.cljs
@@ -1,8 +1,49 @@
 (ns org-ui.core
+  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
   (:require [om.core :as om :include-macros true]
-            [om.dom :as dom :include-macros true]))
+            [om.dom :as dom :include-macros true]
+            [chord.client :refer [ws-ch]]
+            [cljs.core.async :refer [<! >! put! close! chan]]))
+
+(enable-console-print!)

 (defonce app-state (atom {:text "Hello Chestnut!"}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; WebSocket
+
+(def server-url "ws://192.168.1.6:3034")
+(def new-msg-ch (chan))
+
+(defn send-msg! [msg]
+  (go
+    (>! new-msg-ch msg)))
+
+(defn send-loop [server-ch]
+  (go-loop []
+    (when-let [msg (<! new-msg-ch)]
+      (>! server-ch msg)
+      (recur))))
+
+(defn receive-msg! [server-ch]
+  (go-loop []
+    (when-let [msg (<! server-ch)]
+      (println msg)
+      (recur))))
+
+(defn setup-connection []
+  (go
+    (let [{:keys [ws-channel error]} (<! (ws-ch server-url
+                                                {:format :json}))]
+      (def server-ch ws-channel)
+      (receive-msg! server-ch)
+      (send-loop server-ch))))
+
+(setup-connection)
+(send-msg! "Hello Server")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Views

 (defn main []
   (om/root


Exercise 1.23

Exercise 1.23


--- src/sicp/chapter2/1_1.clj
+++ src/sicp/chapter2/1_1.clj
@@ -1,5 +1,73 @@
-(ns sicp.chapter2.1-1)
+(ns sicp.chapter2.1-1
+  (:require [sicp.chapter1.2-5 :refer [gcd]]
+            [sicp.common.list :refer :all]))

 ;;;; 2.1  Introduction to Data Abstraction

 ;;; 2.1.1  Example: Arithmetic Operations for Rational Numbers
+
+(declare make-rat numer denom)
+
+(defn add-rat [x y]
+  (make-rat (+ (* (numer x) (denom y))
+               (* (numer y) (denom x)))
+            (* (denom x) (denom y))))
+
+(defn sub-rat [x y]
+  (make-rat (- (* (numer x) (denom y))
+               (* (numer y) (denom x)))
+            (* (denom x) (denom y))))
+
+(defn mul-rat [x y]
+  (make-rat (* (numer x) (numer y))
+            (* (denom x) (denom y))))
+
+(defn div-rat [x y]
+  (make-rat (* (numer x) (denom y))
+            (* (denom x) (numer y))))
+
+(defn equal-rat? [x y]
+  (== (* (numer x) (denom y))
+      (* (numer y) (denom x))))
+
+(def x (kons 1 2))
+
+(car x)
+
+(cdr x)
+
+(def y (kons 3 4))
+
+(def z (kons x y))
+
+(car (car z))
+
+(car (cdr z))
+
+(defn make-rat [n d] (kons n d))
+
+(defn numer [x] (car x))
+
+(defn denom [x] (cdr x))
+
+(defn print-rat [x]
+  (println (format "%s/%s" (numer x) (denom x))))
+
+(def one-half (make-rat 1 2))
+#_(print-rat one-half)
+
+(def one-third (make-rat 1 3))
+#_(print-rat (add-rat one-half one-third))
+
+#_(print-rat (mul-rat one-half one-third))
+
+#_(print-rat (add-rat one-third one-third))
+
+#_(defn make-rat [n d]
+    (let [g (gcd n d)]
+      (kons (/ n g) (/ d g))))
+
+#_(print-rat (add-rat one-third one-third))
+
+;; Exercise 2.1
+;; TODO


Layout input format for :text

Layout input format for :text

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

--- src/conexp/io/layouts.clj
+++ src/conexp/io/layouts.clj
@@ -10,6 +10,7 @@
   (:use conexp.base
 	conexp.io.util
 	conexp.layouts.base)
+  (:require clojure.string)
   (:import [java.io PushbackReader]))

 (ns-doc "Implements IO for layouts.")
@@ -91,9 +92,50 @@
 (add-layout-input-format :text
                          (fn [_] (re-find #"^Node: " (read-line))))

+(defn- get-arguments
+  [line start]
+  (let [[first args] (rest (re-matches #"^([^:]*): (.*)$" line))]
+    (when-not (= first start)
+      (illegal-argument "Expected " start ", got " first))
+    (clojure.string/split args #", ")))
+
 (define-layout-input-format :text
   [file]
-  (unsupported-operation "Input in :text format is not yet supported."))
+  (let [lines (partition-by #(second (re-matches #"^([^:]*): .*$" %))
+                            (line-seq (reader file)))]
+    (when-not (= 5 (count lines))
+      (illegal-argument "File " file " does not contain a valid :text layout."))
+    (let [;; Node
+          pos  (reduce (fn [map line]
+                         (let [[node x y] (get-arguments line "Node")]
+                           (assoc map node [(Double/parseDouble x), (Double/parseDouble y)])))
+                       {}
+                       (nth lines 0)),
+          ;; Edge
+          conn (reduce (fn [set line]
+                         (conj set (get-arguments line "Edge")))
+                       #{}
+                       (nth lines 1)),
+          ;; Object
+          objs (reduce (fn [map line]
+                         (let [[node obj] (get-arguments line "Object")]
+                           (update-in map [node] conj obj)))
+                       {}
+                       (nth lines 2)),
+          ;; Attribute
+          atts (reduce (fn [map line]
+                         (let [[node att] (get-arguments line "Attribute")]
+                           (update-in map [node] conj att)))
+                       {}
+                       (nth lines 3)),
+          ;; Layout construction
+          nodes (map-by-fn (fn [node]
+                             [(set (objs node)), (set (atts node))])
+                           (keys pos))]
+      (make-layout (into {} (for [[number, coord] pos]
+                              [(nodes number), coord]))
+                   (set-of [(nodes x) (nodes y)]
+                           [[x y] conn])))))

 ;;; FCA-style


carry-reagent: better formatting of API docs

--- contrib/reagent/src/carry_reagent/core.cljs
+++ contrib/reagent/src/carry_reagent/core.cljs
@@ -5,11 +5,12 @@

 (defn connect
   "Arguments:
-  app - the app for which UI should be created
-  view-model - function which, given a read-only model ratom, returns reactions (e.g. in a map); returned value will be passed to a view:
-  view - Reagent component function with args: [view-model-return-value dispatch-signal]

-  Note that view-model function will be called only once.
+  * `app` - the app for which UI should be created
+  * `view-model` - function which, given a read-only model ratom, returns reactions (e.g. in a map); returned value will be passed to `view`
+  * `view` - Reagent component function with args: `[view-model dispatch-signal]`
+
+  Note that `view-model` function will be called only once.

   Returns a pair of: view-model value (mostly for testing/debugging) and argless component to be rendered by Reagent."
   [{:keys [model dispatch-signal] :as _app} view-model view]


Actually, client -> conn

Actually, client -> conn

Even though Welle docs call it a client, the name for that thing is
consistently "conn".

--- src/icecap/store/riak.clj
+++ src/icecap/store/riak.clj
@@ -4,14 +4,14 @@

 (defn riak-store
   "Creates a Riak-backed store."
-  [client bucket]
+  [conn bucket]
   (reify Store
     (create! [_ index blob]
-      (kv/store client bucket index blob))
+      (kv/store conn bucket index blob))
     (retrieve [_ index]
-      (kv/fetch-one client bucket index))
+      (kv/fetch-one conn bucket index))
     (delete! [_ index]
-      (kv/delete client bucket))))
+      (kv/delete conn bucket))))

 (defn bucket-props
   "Creates some bucket props suitable for an icecap bucket.


remove old dependency

remove old dependency

--- exercise3/src/de/haw/vs/station.clj
+++ exercise3/src/de/haw/vs/station.clj
@@ -3,8 +3,7 @@
             [clojure.tools.logging :as log]
             [clojure.core.async :as async]
             [de.haw.vs.networking.connector :as con]
-            [de.haw.vs.clock :as clk])
-  (:import (java.net MulticastSocket)))
+            [de.haw.vs.clock :as clk]))

 (defn range-starting-with-one [last]
   (->> (+ 1 last)


expanded key default to true

expanded key default to true

--- src/om_bootstrap/nav.cljs
+++ src/om_bootstrap/nav.cljs
@@ -88,7 +88,8 @@
   (render
    [_]
    (let [{:keys [opts children]} (om/get-props owner)
-         [bs props] (t/separate Nav opts {:bs-class "nav"})
+         [bs props] (t/separate Nav opts {:expanded? true
+                                          :bs-class "nav"})
          classes {:navbar-collapse (:collapsible? bs)
                   :collapse (not (:expanded? bs))
                   :in (:expanded? bs)}


picture generation

picture generation

--- src/ontrail/imgimport.clj
+++ src/ontrail/imgimport.clj
@@ -1,5 +1,6 @@
 (ns ontrail.imgimport
-  (:use [ontrail mongodb])
+  (:use [ontrail mongodb mongerfilter])
+  (:use clojure.java.io)
   (:require [clojure.java.io :as io]
             [monger.collection :as mc]
             [monger.result :as mr]
@@ -10,15 +11,35 @@
             [monger.joda-time])
   (:import [java.io File]))

+(defn imgs[body]
+  (let [body-html (html/html-snippet body)]
+    (mapv (comp :src :attrs) (flatten (html/select body-html [:img])))))
+
+(def qfilter (make-query-from {:gte_creationDate "1.11.2013"}))
+
 (defn find-all-imgs[]
-  (let [bodies (map :body (mc/find-maps EXERCISE {}))
-        body-htmls (map html/html-snippet bodies)
-        img-tags (flatten (map #(html/select % [:img]) body-htmls))]
-    (map (comp :src :attrs) img-tags)))
-
+  (let [bodies (map (fn [res] {:id (:_id res) :body (:body res)}) (mc/find-maps EXERCISE qfilter))]
+    (filter :id (mapv (fn [res]
+                        (let [imglist (imgs (:body res))]
+                          (if (> (count imglist) 0)
+                            {:id (:id res) :imgs (imgs (:body res))}
+                            {}))) bodies))))
+
 (defn print-all[]
-  (doall (for [img (find-all-imgs)] (printf "%s\n" img))))
+   (let [results (find-all-imgs)]
+     (flatten
+      (mapv (fn [result]
+              (let [id-string (.toString (:id result))
+                    imagelist (:imgs result)]
+                (mapv
+                 (fn [img]
+                   (format "<img width=\"500\" src=\"%s\"\n"
+                           id-string img))
+                 imagelist))) results))))
+
+

+(defn write-result []
+  (with-open [wrtr (writer "kollaasi.html")]
+    (mapv #(.write wrtr %) (print-all))))

-(defn -main [& args]
-  (print-all))


disable debug-print

disable debug-print

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -202,7 +202,7 @@

   (ack-segment [_ _ segment-id]
     (when-let [offset (:offset (get @pending-messages segment-id))]
-      (clojure.pprint/pprint ["ACK" (get @pending-messages segment-id)])
+      ;; (clojure.pprint/pprint ["ACK" (get @pending-messages segment-id)])
       (swap! pending-commits conj offset))
     (swap! pending-messages dissoc segment-id))


added attendre assurer augmenter boire

added attendre assurer augmenter boire

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -30,7 +30,21 @@
                          :sem {:pred :imparare}}}

     "attendre" {:synsem {:cat :verb
-                         :sem {:pred :wait}}}
+                         :sem {:pred :wait}}}
+
+    "assurer" {:synsem {:cat :verb
+                         :sem {:pred :assure}}}
+
+    "augmenter" {:synsem {:cat :verb
+                         :sem {:pred :increase}}}
+
+     "boire" {:synsem {:boot-stem1 "boiv"
+                        :boot-stem2 "buv"}
+    :français {:passato "bu"}
+             :synsem {:cat :verb
+                      :sem {:pred :drink}}}
+
+
    "avoir"
    {:synsem {:essere false
              :sem {:pred :avere}


pred cenare to have-dinner

pred cenare to have-dinner

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -459,12 +459,7 @@
    "caricare" {:italiano {:future-stem "carich"}
                :synsem {:cat :verb
                         :sem {:pred :caricare}}}
-
-   "cenare" {:synsem {:cat :verb
-                      :essere false
-                      :sem {:subj {:human true}
-                            :pred :cenare}}}
-
+
    "camicia"
     (unify agreement-noun
            common-noun
@@ -531,6 +526,11 @@
                              :place false
                              :speakable false}}})

+     "cenare" {:synsem {:cat :verb
+                      :essere false
+                      :sem {:subj {:human true}
+                            :pred :have-dinner}}}
+
      "chiacchierare" {:synsem {:cat :verb
                                :sem {:pred :chat}}}


merging

merging

--- src/braid/ui/styles/embed.cljs
+++ src/braid/ui/styles/embed.cljs
@@ -7,7 +7,7 @@
 (defn embed [pad]
   [:.embed
    {:margin [[0 (m/* -1 pad)]]
-    :padding [[pad 0]]
+    :padding [[pad 0 0]]
     :overflow "hidden"}

    [:.content
@@ -17,7 +17,8 @@
     {:background "black"
      :padding (m/* 0.5 pad)
      :color "white"
-     :-webkit-font-smoothing "antialiased"}
+     :-webkit-font-smoothing "antialiased"
+     :overflow "hidden"}

     [:.image
      {:width "75px"
@@ -26,6 +27,7 @@
       :margin-right (m// pad 2)}]

     [:.about
+     {:overflow "hidden"}

      [:.provider
       {:font-size "0.9em"
@@ -38,7 +40,9 @@
         :background-repeat "no-repeat"
         :background-size "contain"
         :vertical-align "middle"
-        :margin-right "0.25em"}]
+        :margin-right "0.25em"
+        :white-space "nowrap"
+        :max-width "10em"}]

       [:.name
        {:display "inline-block"


Fix docs fns.

Fix docs fns.

--- src/quil/helpers/docs.clj
+++ src/quil/helpers/docs.clj
@@ -63,7 +63,7 @@
   See subcategory-map for format of subcategory."
   [fn-metas]
   (let [cats (fields-as-sorted-set fn-metas :category)
-        idxs (map str (rest (range)))
+        idxs (rest (range))
         idxd-cats (zipmap idxs cats)]
     (into (sorted-map)
       (for [[idx cat] idxd-cats]
@@ -174,4 +174,4 @@
   (doseq [fn-meta (filter :category fn-metas)]
     (generate-function-page fn-meta folder)))

-;(generate-all quil.core/fn-metas "../wiki")
+;(generate-all @(resolve 'quil.core/fn-metas) "../wiki")


Added more error code

Added more error code

--- src/clinvar_submitter/form.clj
+++ src/clinvar_submitter/form.clj
@@ -57,11 +57,13 @@
   (if(nil? (ld-> t i "contribution")) (report/append-to-report r "\n\n*E-401: Interpretation evaluation date not provided"))
   (let [contribution (ld-> t i "contribution")]
     (if (nil? (get contribution "onDate")) ""
+      (try
       (.format
         (java.text.SimpleDateFormat. "'=\"'yyyy-MM-dd'\"'")
         (.parse
           (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSSSSSXXX")
-          (get contribution "onDate"))))))
+          (get contribution "onDate")))
+       (catch Exception e (report/append-to-report r "\n\n*E-404: Interpretation evaluation date format not valid") (get contribution "onDate") "*E-404")))))

   (defn get-interpretation
    "Returns a map of all interpretation related fields needed for the
@@ -75,49 +77,56 @@

  (defn variant-identifier
    "Return variant identifier, typically the ClinGen AlleleReg id."
-   [v]
-   (csv-colval (get v "CanonicalAllele") "ERROR-variant-identifier"))
+   [v r]
+   (if (nil? v) (report/append-to-report r "\n\n*E-202: Variant identifier not provided."))
+   (csv-colval (get v "CanonicalAllele") "*E-202"))

   (defn variant-alt-designations
   "Return variant hgvs representations"
-  [v]
-  (csv-colval (get v "alleleName name") "ERROR-variant-alt-designations"))
+  [v r]
+  (if (nil? v) (report/append-to-report r "\n\n*W-251: Preferred variant alternate designation not provided"))
+  (csv-colval (get v "alleleName name") "*W-251"))

  (defn variant-refseq
   "Return the variant reference sequence."
-  [t v]
+  [t v r]
   (let [refseq (ld-> t v "referenceCoordinate" "referenceSequence")]
-    (csv-colval (get refseq "display") "ERROR-variant-refseq")))
+  (if (nil? refseq) (report/append-to-report r "\n\n*E-204: Preferred variant reference sequence not provided."))
+    (csv-colval (get refseq "display") "*E-204")))

 (defn variant-start
   "Return the variant reference sequence start pos (0-to-1-based transform)."
-  [t v]
+  [t v r]
    ;if ref is not null add 1 to start otherwise as-is
   (let [ref (ld-> t v "referenceCoordinate" "refAllele")
         alt (get v "allele")
-        start (ld-> t v "referenceCoordinate" "start")]
-    (csv-colval (if (str/blank? ref) (get start "index") (+ 1 (get start "index"))) "ERROR-variant-start")))
+        start (ld-> t v "referenceCoordinate" "start")]
+    (if (nil? start) (report/append-to-report r "\n\n*E-205: Preferred variant start coordinate not provided."))
+    (csv-colval (if (str/blank? ref) (get start "index") (+ 1 (get start "index"))) "*E-205")))

 (defn variant-stop
   "Return the variant reference sequence stop pos (0-to-1-based transform)."
-  [t v]
+  [t v r]
    ;if ref is blank and alt is not add 1 to stop otherwise as-is
   (let [ref (ld-> t v "referenceCoordinate" "refAllele")
         alt (get v "allele")
-        stop (ld-> t v "referenceCoordinate" "end")]
-    (csv-colval (if (and (str/blank? ref) (not (str/blank? alt))) (+ 1 (get stop "index")) (get stop "index")) "ERROR-variant-stop")))
+        stop (ld-> t v "referenceCoordinate" "end")]
+    (if (nil? stop) (report/append-to-report r "\n\n*E-206: Preferred variant stop coordinate not provided."))
+    (csv-colval (if (and (str/blank? ref) (not (str/blank? alt))) (+ 1 (get stop "index")) (get stop "index")) "*E-206")))

  (defn variant-ref
   "Return the variant ref allele sequence."
-  [t v]
+  [t v r]
   (let [refcoord (ld-> t v "referenceCoordinate")]
-    (csv-colval (get refcoord "refAllele") "ERROR-variant-ref")))
+    (if (nil? v) (report/append-to-report r "\n\n*E-207: Preferred variant reference allele not provided."))
+    (csv-colval (get refcoord "refAllele") "*E-207")))

  (defn variant-alt
    "Return the variant alt allele sequence."
-   [v]
-   (csv-colval (get v "allele") "ERROR-variant-alt"))
+   [v r]
+   (if (nil? v) (report/append-to-report r "\n\n*E-208: Preferred variant alternate allele not provided."))
+   (csv-colval (get v "allele") "*E-208"))

  (defn get-variant
   "Returns a map of all variant related fields needed for the clinvar
@@ -132,13 +141,13 @@
   [t i r]
   (let [v (ld1-> t i "variant" "relatedContextualAllele" (prop= t true "preferred"))]
   (if (nil? v ) (log/error (str "Exception in get-variant: relatedContextualAllele not found")))
-    {:variantIdentifier (variant-identifier v),
-     :altDesignations (variant-alt-designations v),
-     :refseq (variant-refseq t v),
-     :start (variant-start t v),
-     :stop  (variant-stop t v),
-     :ref (variant-ref t v),
-     :alt (variant-alt v)}))
+    {:variantIdentifier (variant-identifier v r),
+     :altDesignations (variant-alt-designations v r),
+     :refseq (variant-refseq t v r),
+     :start (variant-start t v r),
+     :stop  (variant-stop t v r),
+     :ref (variant-ref t v r),
+     :alt (variant-alt v r)}))

 ;*** Condition related transformations


make audiotagger logging shut up

make audiotagger logging shut up

add process-dir! function to do the scanning

--- src/clj/cljspazzer/scanner.clj
+++ src/clj/cljspazzer/scanner.clj
@@ -5,6 +5,9 @@
             [cljspazzer.db.schema :as db]
             [pantomime.mime :refer [mime-type-of]])
   (:import org.jaudiotagger.audio.AudioFileFilter))
+
+(.setLevel (java.util.logging.Logger/getLogger "org.jaudiotagger")
+           java.util.logging.Level/OFF)

 (def file-filter (new org.jaudiotagger.audio.AudioFileFilter false))

@@ -64,3 +67,8 @@
          audio-files (filter active-predicate? files)]
      (pmap get-info audio-files)))
   ([d] (file-tag-seq d (fn [f] true))))
+
+
+(defn process-dir! [d]
+  (map (partial db/upsert-track! db/the-db)
+       (file-tag-seq d (mk-need-info))))


Add a convenience function for getting comic-url's

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -95,9 +95,12 @@
   (-> (get-site site)
       fn-key))

-(defn chapter-list-data [site comic-url]
+(defn get-comic-url [site comic-id]
+  ((get-data-fn site :comic->url) comic-id))
+
+(defn chapter-list-data [site comic-id]
   ((get-data-fn site :chapter-list-data-for-comic)
-   comic-url))
+   (get-comic-url site comic-id)))

 (defn page-list-data [site chapter-url]
   ((get-data-fn site :page-list-data-for-comic-chapter)


Untangling domains-info.

Untangling domains-info.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -123,10 +123,11 @@
   (load-and-sync-status domains-info
                         rw-lock
                         (fn [domain]
-                          (use-cache-or-update domain
-                                               (domain/host-shards (domains-info domain))
-                                               global-config
-                                               local-config))))
+                          (let [host-shards (domain/host-shards (domains-info domain))]
+                            (use-cache-or-update domain
+                                                 host-shards
+                                                 global-config
+                                                 local-config)))))

 (defn cleanup-domain!
   [domain-path]
@@ -200,58 +201,45 @@
             (not (.isDone @download-supervisor))))))

 (defn- update-domains
-  [service-handler download-supervisor all-domains domains-info global-config local-config rw-lock]
-  (if (service-updating? service-handler download-supervisor)
-    (log-message "UPDATER - Not updating as update process still in progress.")
-    (let [max-kbs (:max-online-download-rate-kb-s local-config)
-          all-shards (domain/all-shards domains-info)
-          ^DownloadState state (->> all-domains
-                                    (map (juxt identity all-shards))
-                                    (into {})
-                                    (mk-loader-state))
-          shard-amount (flattened-count (vals (:shard-states state)))]
-      (log-message "UPDATER - Updating domains: " (s/join ", " all-domains))
-      (reset! download-supervisor
-              (start-download-supervisor shard-amount max-kbs state))
-      (future
-        (try (load-and-sync-status (select-keys domains-info all-domains)
-                                   rw-lock
-                                   (fn [domain]
+  [download-supervisor domains-info global-config local-config rw-lock]
+  (let [{max-kbs :max-online-download-rate-kb-s
+         local-dir :local-dir} local-config
+         ^DownloadState state (-> domains-info
+                                  (domain/all-shards)
+                                  (mk-loader-state))
+         shard-amount (flattened-count (vals (:shard-states state)))]
+    (log-message "UPDATER - Updating domains: " (s/join ", " (keys domains-info)))
+    (reset! download-supervisor (start-download-supervisor shard-amount max-kbs state))
+    (future
+      (try (load-and-sync-status domains-info
+                                 rw-lock
+                                 (fn [domain]
+                                   (let [host-shards (domain/host-shards (domains-info domain))]
                                      (use-cache-or-update domain
-                                                          (domain/host-shards (domains-info domain))
+                                                          host-shards
                                                           global-config
                                                           local-config
                                                           true
-                                                          state))
-                                   :update? true)
-             (log-message "Finished updating all domains from remote")
-
-             ;; Cleaning up old versions seems to happen after each
-             ;; load. TODO: Move this shit together.
-             (try (log-message "Removing all old versions of domains (CLEANUP)")
-                  (cleanup-domains! (keys domains-info)
-                                    (:local-dir local-config))
-                  (catch Throwable t (log-error t "Error when cleaning old versions")))
-             (catch Throwable t
-               (log-error t "Error when syncing data")
-               (throw t)))))))
-
-;; TODO: Update this to remove  token references.
-;;
-;; TODO: Take a purge flag, that'll trigger a data wipe.
-;;
-;; 5. (What does this mean?) Create Hadoop FS on demand... need retry
-;; logic if loaders fail?
-
-;;  Example of domains-info local:
-;;
-;; {test {:elephantdb.domain/shard-index {:elephantdb.shard/hosts-to-shards {192.168.1.3 #{0 1 2 3}}
-;;                                        :elephantdb.shard/shards-to-hosts {3 #{192.168.1.3}
-;;                                                                           2 #{192.168.1.3}
-;;                                                                           1 #{192.168.1.3}
-;;                                                                           0 #{192.168.1.3}}}
-;;        :elephantdb.domain/domain-status #<Atom@3643b5bb: #<DomainStatus <DomainStatus loading:LoadingStatus()>>>
-;;        :elephantdb.domain/domain-data #<Atom@4feaefc5: nil>}}
+                                                          state)))
+                                 :update? true)
+           (log-message "Finished updating all domains from remote.")
+           (log-message "Removing all old versions of updated domains!")
+           (try (cleanup-domains! (keys domains-info) local-dir)
+                (catch Throwable t
+                  (log-error t "Error when cleaning old versions")))
+           (catch Throwable t
+             (log-error t "Error when syncing data")
+             (throw t))))))
+
+(defn- trigger-update
+  [service-handler download-supervisor domains-info global-config local-config rw-lock]
+  (with-ret true
+    (if (service-updating? service-handler download-supervisor)
+      (log-message "UPDATER - Not updating as update process still in progress.")
+      (update-domains download-supervisor domains-info global-config local-config rw-lock))))
+
+;; 5. TODO: (What does this mean?) Create Hadoop FS on demand... need
+;; retry logic if loaders fail?

 (defn edb-proxy
   "See `src/elephantdb.thrift` for more information on the methods we
@@ -326,24 +314,20 @@
         (service-updating? this download-supervisor))

       (updateAll []
-        (with-ret true
-          (update-domains this
-                          download-supervisor
-                          (keys domains-info)
-                          domains-info
-                          global-config
-                          local-config
-                          rw-lock)))
+        (trigger-update this
+                        download-supervisor
+                        domains-info
+                        global-config
+                        local-config
+                        rw-lock))

       (update [^String domain]
-        (with-ret true
-          (update-domains this
-                          download-supervisor
-                          [domain]
-                          domains-info
-                          global-config
-                          local-config
-                          rw-lock))))))
+        (trigger-update this
+                        download-supervisor
+                        (select-keys domains-info [domain])
+                        global-config
+                        local-config
+                        rw-lock)))))

 (defn service-handler
   "Entry point to edb. `service-handler` returns a proxied


fix Rebranding Team, change QPM message, add clarity to ABT prompt

--- src/clj/game/cards-agendas.clj
+++ src/clj/game/cards-agendas.clj
@@ -2,7 +2,7 @@

 (def cards-agendas
   {"Accelerated Beta Test"
-   (let [abthelper (fn abt [n i] {:prompt "Select a piece of ICE to install"
+   (let [abthelper (fn abt [n i] {:prompt "Select a piece of ICE from the top of the play area to install"
                                   :choices {:req #(and (:side % "Corp") (= (:type %) "ICE") (= (:zone %) [:play-area]))}
                                   :effect (req (corp-install state side target nil {:no-install-cost true :install-state :rezzed})
                                                (trigger-event state side :rez target)
@@ -340,30 +340,26 @@
    {:steal-req (req (not tagged))
     :access {:req (req tagged)
              :effect (effect (as-agenda card 1))
-             :msg "score because the runner is tagged"}}
-
-   "Research Grant"
-   {:req (req (not (empty? (filter #(= (:title %) "Research Grant") (all-installed state :corp)))))
-    :prompt "You may choose another installed copy of Research Grant to score."
-    :choices {:req #(= (:title %) "Research Grant")}
-    :effect (effect (score (assoc target :advance-counter (:advancementcost target))))
-    :msg (msg "score another copy of Research Grant")
-   }
+             :msg "add it to their score area and gain 1 agenda point"}}

    "Rebranding Team"
-   {:effect (req (doseq [c (filter #(= (:type %) "Asset") (all-installed state :corp))]
+   {:effect (req (doseq [c (filter #(= (:type %) "Asset") (concat (all-installed state :corp)
+                                                                  (:deck corp)
+                                                                  (:hand corp)
+                                                                  (:discard corp)))]
                    (update! state side (assoc c :subtype
-                                                (->> (vec (.split (:subtype c) " - "))
+                                                (->> (vec (.split (or (:subtype c) "") " - "))
                                                      (cons "Advertisement")
                                                      distinct
                                                      (join " - "))))))
-    :msg "make all assets gain Advertisement"
-    :events {:corp-install
-             {:req (req (and (= (:type target) "Asset") (not (has? target :subtype "Advertisement"))))
-              :effect (effect (update! (assoc target :subtype
-                                                     (->> (vec (.split (:subtype target) " - "))
-                                                          (cons "Advertisement")
-                                                          (join " - ")))))}}}
+    :msg "make all assets gain Advertisement"}
+
+   "Research Grant"
+   {:req (req (not (empty? (filter #(= (:title %) "Research Grant") (all-installed state :corp)))))
+    :prompt "Choose another installed copy of Research Grant to score"
+    :choices {:req #(= (:title %) "Research Grant")}
+    :effect (effect (score (assoc target :advance-counter (:advancementcost target))))
+    :msg (msg "score another copy of Research Grant")}

    "Restructured Datapool"
    {:abilities [{:cost [:click 1]


:horse:

:horse:

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -30,7 +30,7 @@
                     (apply str))]
     (str front middle back)))

-(def ^:private coffee-train (partial train :coffee))
+(def ^:private train-coffee (partial train :coffee))

 (defn- train-custom [& wagons]
   (->> (cons :steam_locomotive wagons)
@@ -39,28 +39,28 @@

 (defn rand-train []
   (rand-sexp
-   (coffee-train)
-   (coffee-train)
-   (coffee-train :heart)
-   (coffee-train :heart)
-   (coffee-train :heart)
-   (coffee-train :syringe)
-   (coffee-train :mushroom)
-   (coffee-train :coffeepot)
-   (coffee-train :coffeealarm)
-   (coffee-train :hocho)
-   (coffee-train :wrench)
-   (coffee-train :tada)
-   (coffee-train :bacon)
-   (coffee-train :nuclear)
-   (coffee-train :timwendelboe)
-   (coffee-train :jan-richter)
-   (coffee-train :scream)
-   (coffee-train :smoking)
-   (coffee-train :heavy_heart_exclamation_mark_ornament)
-   (coffee-train :badger :mushroom)
-   (coffee-train :coffeepot :heart)
-   (coffee-train :simply_overcaffeinated :coffeespin)
+   (train-coffee)
+   (train-coffee)
+   (train-coffee :heart)
+   (train-coffee :heart)
+   (train-coffee :heart)
+   (train-coffee :syringe)
+   (train-coffee :mushroom)
+   (train-coffee :coffeepot)
+   (train-coffee :coffeealarm)
+   (train-coffee :hocho)
+   (train-coffee :wrench)
+   (train-coffee :tada)
+   (train-coffee :bacon)
+   (train-coffee :nuclear)
+   (train-coffee :timwendelboe)
+   (train-coffee :jan-richter)
+   (train-coffee :scream)
+   (train-coffee :smoking)
+   (train-coffee :heavy_heart_exclamation_mark_ornament)
+   (train-coffee :badger :mushroom)
+   (train-coffee :coffeepot :heart)
+   (train-coffee :simply_overcaffeinated :coffeespin)
    (train :coffeealarm)
    (train :nespresso :ali)
    (train :ali :gruff)


coffee-train partial

coffee-train partial

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -24,32 +24,34 @@
         middle (apply str (take num-wagons (cycle wagons)))]
     (str front middle back)))

+(def ^:private coffee-train (partial train ":coffee:"))
+
 (defn rand-train []
   (rand-sexp
-   (train ":coffee:" ":coffee:")
-   (train ":coffee:" ":coffee:")
-   (train ":coffee:" ":heart:")
-   (train ":coffee:" ":heart:")
-   (train ":coffee:" ":heart:")
+   (coffee-train)
+   (coffee-train)
+   (coffee-train ":heart:")
+   (coffee-train ":heart:")
+   (coffee-train ":heart:")
+   (coffee-train ":syringe:")
+   (coffee-train ":mushroom:")
+   (coffee-train ":coffeepot:")
+   (coffee-train ":coffeealarm:")
+   (coffee-train ":hocho:")
+   (coffee-train ":wrench:")
+   (coffee-train ":tada:")
+   (coffee-train ":bacon:")
+   (coffee-train ":nuclear:")
+   (coffee-train ":timwendelboe:")
+   (coffee-train ":jan-richter:")
+   (coffee-train ":scream:")
+   (coffee-train ":heavy_heart_exclamation_mark_ornament:")
+   (coffee-train ":badger:" ":mushroom:")
+   (coffee-train ":coffeepot:" ":heart:")
    (train ":coffeealarm:" ":coffeealarm:")
    (train ":nespresso:" ":ali:")
    (train ":ali:" ":gruff:")
-   (train ":coffee:" ":syringe:")
-   (train ":coffee:" ":mushroom:")
-   (train ":coffee:" ":coffeepot:")
-   (train ":coffee:" ":coffeealarm:")
-   (train ":coffee:" ":hocho:")
-   (train ":coffee:" ":wrench:")
-   (train ":coffee:" ":tada:")
-   (train ":coffee:" ":bacon:")
-   (train ":coffee:" ":nuclear:")
-   (train ":coffee:" ":timwendelboe:")
-   (train ":coffee:" ":jan-richter:")
-   (train ":coffee:" ":scream:")
    (train ":syringe:" ":hocho:")
-   (train ":coffee:" ":heavy_heart_exclamation_mark_ornament:")
-   (train ":coffee:" ":badger:" ":mushroom:")
-   (train ":coffee:" ":coffeepot:" ":heart:")
    ":steam_locomotive::coffee::coffee::running::running::running::dash:"
    "All aboard the coffee train\n:steam_locomotive::coffee::coffee::running::running::running::dash:"
    "Det er kaffi å få på kjøken!"


Use pos? instead of > 0 (more idiomatic)

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -79,7 +79,7 @@
           (when (< user-id number-of-requests)
             (run-requests (:requests scenario) timeout user-id c))
           (>! results (response->result scenario result))
-          (when (> requests-left 0)
+          (when (pos? requests-left)
             (recur (dec requests-left) (inc user-id)))))
       results))
   (runner-info [_] (str "requests " number-of-requests)))


ensure we pass an integer to budget-monitors

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -19,7 +19,7 @@
 (defmacro with-accounts-layout
   [page-title entity-id options & content]
   `(with-layout
-     ~page-title (assoc ~options :side-bar (budget-monitors ~entity-id))
+     ~page-title (assoc ~options :side-bar (budget-monitors (Integer. ~entity-id)))
      ~@content))

 (defn- account-row


Form field size adjustments

Form field size adjustments

--- src/cljs/modern_cljs/core.cljs
+++ src/cljs/modern_cljs/core.cljs
@@ -122,9 +122,9 @@
 ; View
 ;

-(defn text [id value]
+(defn text [id value size]
   (m "input[type=text]"
-     {:value value :placeholder id
+     {:value value :placeholder id :size size
       :onchange #(update_field id (-> % .-target .-value))}
      nil))

@@ -136,11 +136,11 @@
         time (get data "time" "")]
     (m "form.pure-form" nil
        [(m "fieldset" nil
-           [(text "title" title)
-            (text "url" url)
-            (text "referer" referer)
-            (text "time" time)
-            (text "comment" comment)
+           [(text "title" title 35)
+            (text "url" url 15)
+            (text "referer" referer 15)
+            (text "time" time 15)
+            (text "comment" comment 50)
             (m "button.pure-button.pure-button-primary"
                {:onclick #(save)} "Update")
             (m "button.pure-button" {:onclick #(clear)} "Clear")])])))


Catch error when reading project.clj

Catch error when reading project.clj

--- src/clojure/nightcode/lein.clj
+++ src/clojure/nightcode/lein.clj
@@ -44,7 +44,8 @@
     (let [project-clj-path (get-project-clj-path path)]
       (if-not (.exists (java.io/file project-clj-path))
         (println (utils/get-string :no_project_clj))
-        (leiningen.core.project/read project-clj-path)))))
+        (try (leiningen.core.project/read project-clj-path)
+          (catch Exception e {}))))))

 (defn add-sdk-path
   [project-map]


Allow master sg to ping all in master sg

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -303,7 +303,7 @@
                                       :source_security_group_id (cluster-id-of "aws_security_group" "lb-security-group")}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "public-slave-security-group")}
                                      {:allow-all-sg (cluster-id-of "aws_security_group" "slave-security-group")}
-                                     )
+                                     {:allow-all-sg (cluster-id-of "aws_security_group" "master-security-group")})

              (apply (partial cluster-security-group "public-slave-elb" {}) public-slave-elb-sg)


rearrange defn order

rearrange defn order

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

--- clojure/sequence_generator.clj
+++ clojure/sequence_generator.clj
@@ -5,6 +5,9 @@
 (defstruct acq-settings :frames :positions :channels :slices :slices-first
   :time-first :keep-shutter-open-slices :keep-shutter-open-channels
   :use-autofocus :autofocus-skip :relative-slices :exposure :interval-ms)
+
+(defn pairs [x]
+  (partition 2 1 (concat x [nil])))

 (defn first-not-nil [& args]
   (first (filter (comp not nil?) args)))
@@ -15,15 +18,6 @@
 (defn get-use-z-stack [channel]
   (first-not-nil (:use-z-stack channel) (.doZStack_ channel)))

-(defn pairs [x]
-  (partition 2 1 (concat x [nil])))
-
-(defn nest-loop [events dim-vals dim]
-  (if (and dim-vals (pos? (count dim-vals)))
-    (for [dim-val dim-vals event events]
-      (assoc event dim dim-val))
-    events))
-
 (defn make-dimensions [settings]
   (let [{:keys [slices channels frames positions
                 slices-first time-first]} settings
@@ -32,6 +26,12 @@
         b [[frames :frame] [positions :position]]
         b (if time-first b (reverse b))]
     (concat a b)))
+
+(defn nest-loop [events dim-vals dim]
+  (if (and dim-vals (pos? (count dim-vals)))
+    (for [dim-val dim-vals event events]
+      (assoc event dim dim-val))
+    events))

 (defn create-loops [dimensions]
   (reduce #(apply (partial nest-loop %1) %2) [{:task :snap}] dimensions))


Add tutorial link

Add tutorial link

--- src/cljs/elevent_client/components/navbar.cljs
+++ src/cljs/elevent_client/components/navbar.cljs
@@ -41,6 +41,10 @@
                   :active)}
         [:i.bar.chart.icon]
         "Statistics"])
+     [:a.blue.item
+      {:href "https://github.com/OscarMarshall/elevent-client/wiki"}
+      [:i.book.icon]
+      "Tutorial"]
      ; Check if logged in
      (if (:token @state/session)
        [:div.right.menu


Note issues re: from-parent buffering (WIP)

Along with possible fixes

Nothing but comments here, along with a more-obvious "Start here" exception.

--- src/clojure/frereth_cp/message/from_parent.clj
+++ src/clojure/frereth_cp/message/from_parent.clj
@@ -108,6 +108,7 @@
   ;; We're back to the "DJB thought it was safe" appeal to
   ;; authority.
   ;; So stick with the current approach for now.
+  (throw (RuntimeException. "What's up with starting-point?"))
   (let [starting-point (.readerIndex incoming-buf)
         ;; For from-parent-test/check-start-stop-calculation:
         ;; This is starting at position 112.
@@ -143,11 +144,31 @@
         ;; At least, that's the case in the reference implementation.
         ;; In this scenario where I've ditched that circular buffer,
         ;; it simply does not apply.
+        ;; That does not make the decision to do that ditching correct.
+        ;; However, I can probably move forward successfully with this
+        ;; approach using a sorted-map (or possibly sorted-map-by)
+        ;; in place of the priority queue that seems like it would
+        ;; make sense.
+        ;; Or the buddy queue that DJB recommended initially.
+        ;; The key to this approach would be
+        ;; 1) receive message from parent
+        ;; 2) reduce of the buffer of received messages
+        ;; 3) forwarding the completed stream blocks to the child
+        ;; 4) finding a balance between
+        ;;    a) calling that over and over
+        ;;    b) memory copy churn
+        ;; 5) Consolidating new incoming blocks
+        ;; There's actually plenty of ripe fruit to pluck here.
         (comment) (throw (RuntimeException. "And there's my bug"))
         ;; i.e. I was planning on replacing that circular buffer with
         ;; something like a vector of byte arrays, but I must have
         ;; gotten interrupted in mid-though and haven't actually
         ;; gotten around to it.
+        ;; Actually, *is* this the/a problem?
+        ;; I shouldn't be doing any buffering here. Just deciding
+        ;; how much to read now.
+        ;; I'm 99% positive the existing implementation is broken
+        ;; in this way, but I definitely need to double check.
         (log/debug "receive-written:" receive-written
                    "\nstop-byte:" stop-byte
                    ;; We aren't using this.


Remove old authentication code

Remove old authentication code

--- src/yada/interceptors.clj
+++ src/yada/interceptors.clj
@@ -168,16 +168,6 @@
       ;; else
       ctx)))

-#_(defn authentication
-  "Authentication"
-  [ctx]
-  (cond-> ctx
-    (not-empty (filter (comp (partial = :basic) :type) (-> ctx :handler :security)))
-    (assoc :authentication
-           (:basic-authentication (ring.middleware.basic-authentication/basic-authentication-request
-                                   (:request ctx)
-                                   (fn [user password] {:user user :password password}))))))
-
 (defn select-representation
   "Proactively negotatiate the best representation for the payload
   body of the response. This does not mean that the


Rename nrepl :host option to :interface.

--- wildfly/src/immutant/wildfly/repl.clj
+++ wildfly/src/immutant/wildfly/repl.clj
@@ -36,7 +36,7 @@
     (spit f port)
     (.deleteOnExit f)))

-(defn ^:private nrepl-host-port [server]
+(defn ^:private nrepl-interface-port [server]
   (let [ss (-> server deref :ss)]
     [(-> ss .getInetAddress .getHostAddress) (.getLocalPort ss)]))

@@ -47,8 +47,8 @@
   (.close server))

 (defn start
-  "Fire up a repl bound to host/port"
-  [{:keys [host port port-file] :or {host "localhost", port 0}}]
+  "Fire up a repl bound to interface/port"
+  [{:keys [interface port port-file] :or {interface "localhost", port 0}}]
   (let [{:keys [nrepl-middleware nrepl-handler]}
         (-> (wu/options) (get "repl-options" "{}") read-string)]
     (when (and nrepl-middleware nrepl-handler)
@@ -61,8 +61,8 @@
                               (symbol? %) (iu/require-resolve %)
                               (list? %) (eval %)))
                       (apply nrepl/default-handler)))
-          server (nrepl/start-server :port port :bind host :handler handler)]
+          server (nrepl/start-server :port port :bind interface :handler handler)]
       (u/at-exit (partial stop server))
-      (let [[host bound-port] (nrepl-host-port server)]
-        (iu/info "nREPL bound to" (format "%s:%s" host bound-port))
+      (let [[interface bound-port] (nrepl-interface-port server)]
+        (iu/info (format "nREPL bound to %s:%s" interface bound-port))
         (spit-nrepl-files bound-port port-file)))))


Building blocks for day 11

Building blocks for day 11

--- src/adventofcode/solutions.clj
+++ src/adventofcode/solutions.clj
@@ -301,3 +301,19 @@
         input)
       iterations)))

+;day 11
+;just building blocks
+;string into number
+(let [init (BigInteger. (clojure.string/join (map #(format "%03d" %) (map int "vzbxkghb"))))
+      ok? (fn [num]
+            (map #(s->int (apply str %)) (partition 3 (.toString num))))]
+  (ok? (.add init BigInteger/ONE)))
+
+;looking for increasing subsequence
+((fn [input]
+   (reduce #(let [prev (first %)
+                  lnum (last prev)]
+             (if (> %2 lnum)
+               (conj (rest %) (conj prev %2))
+               (conj % [%2]))) [[(first input)]] (rest input)))  '(118 122 98 120 107 103 104 105))
+


Update namespace that was changed

Update namespace that was changed

--- common/clojure/nightweb/db.clj
+++ common/clojure/nightweb/db.clj
@@ -1,6 +1,6 @@
 (ns nightweb.db
   (:require [clojure.java.io :as java.io]
-            [clojure.java.jdbc :as jdbc]
+            [clojure.java.jdbc.deprecated :as jdbc]
             [nightweb.constants :as c]
             [nightweb.formats :as f]))


do not exclude async

do not exclude async

--- src/leiningen/new/reagent_liveedit/project.clj
+++ src/leiningen/new/reagent_liveedit/project.clj
@@ -37,11 +37,11 @@
             [lein-garden "0.2.5"]
             [lein-environ "1.0.0"]
             [lein-ring "0.9.1"]
-            [lein-asset-minifier "0.2.2" :exclusions [org.clojure/clojure org.clojure/core.async]]
+            [lein-asset-minifier "0.2.2"]
             [lein-exec "0.3.4"]
             [lein-pdo "0.1.1"]
             [com.cemerick/clojurescript.test "0.3.3"]
-            [lein-figwheel "0.2.2-SNAPSHOT" :exclusions [org.clojure/clojure org.clojure/core.async]]
+            [lein-figwheel "0.2.2-SNAPSHOT"]
             [cider/cider-nrepl "0.9.0-SNAPSHOT"]]

   :ring {:handler {{ns-name}}.server.handler/app}


Add fixed weighted summary

Add fixed weighted summary

--- src/angelic/search/summary.clj
+++ src/angelic/search/summary.clj
@@ -243,30 +243,29 @@
   (children         [s] o-children)
   (re-source        [s new-src bound stat-bound] (throw (RuntimeException.)))
   (eq               [s other]
-    (let [rel-keys [:p-val :w-val :o-val :stat]]
+    (let [rel-keys [#_ :p-val #_ :w-val :o-val :stat]]
       (= (map #(% s) rel-keys) (map #(% other) rel-keys))))
   (>=               [s other bound]  ;; TODO: bound ???
-    (or (> o-val (:o-val other))
-        (and (= o-val (:o-val other))
+    (or (> (min bound o-val) (min bound (:o-val other)))
+        (and (= (min bound o-val) (min bound (:o-val other)))
              (clojure.core/>= (status-val stat) (status-val (status other))))))
-  (+                [s other new-src bound]
+  (+                [s other new-src bound]
    (let [p-sum (clojure.core/+ p-val (:p-val other))
          w-sum (clojure.core/+ w-val (:w-val other))
          o-sum (min (clojure.core/+ o-val (:o-val other)) bound)]
      (assert (<= p-sum o-sum))
      (make-bw-summary*
-      wt p-sum
-      (max p-sum w-sum (* (:wt s) o-sum))
-      o-sum
+      wt p-sum w-sum o-sum
       (max max-gap (:max-gap other))
       (min-key status-val stat (status other))
       new-src [s other] [s other] [s other]))))

 (defn- make-bw-summary* [wt p-val f-val o-val max-gap status source
                          p-children w-children o-children]
-  (util/assert-is (<= p-val f-val o-val) "%s" [source children])
-  (BoundedWeightedSummary. wt p-val f-val o-val (min max-gap (- o-val p-val))
-                           status source p-children w-children o-children))
+  (let [final-f (min (max p-val f-val (* wt o-val)) o-val)]
+    (util/assert-is (<= p-val final-f o-val) "%s" [source children])
+    (BoundedWeightedSummary. wt p-val final-f o-val (min max-gap (- o-val p-val))
+                             status source p-children w-children o-children)))

 (defn make-bw-summary [wt p-val o-val status source]
   (util/assert-is (contains? statuses-set status))
@@ -292,24 +291,26 @@
       (recur (if (ge (first s) best) (first s) best) (next s))
       best)))

-(defn better-bws [k]
-  (fn [b1 b2]
-    (cond (and (not (= :blocked (status b1))) (= :blocked (status b2)))
-          true
-
-          (and (= :blocked (status b1)) (not (= :blocked (status b2))))
-          false
-
-          (> (k b1) (k b2))
-          true
-
-          (< (k b1) (k b2))
-          false
-
-          :else
-          (clojure.core/>= (status-val (status b1)) (status-val (status b2))))))
-
-(defn or-combine-bws [summaries new-src _]
+(defn better-bws
+  ([k] (better-bws k Double/POSITIVE_INFINITY))
+  ([k b]
+     (fn [b1 b2]
+       (cond #_ (and (not (= :blocked (status b1))) (= :blocked (status b2)))
+             #_ true
+
+             #_ (and (= :blocked (status b1)) (not (= :blocked (status b2))))
+             #_ false
+
+             (> (min (k b1) b) (min (k b2) b))
+             true
+
+             (< (min (k b1) b) (min (k b2) b))
+             false
+
+             :else
+             (clojure.core/>= (status-val (status b1)) (status-val (status b2)))))))
+
+(defn or-combine-bws [summaries new-src bound]
   (if (empty? summaries)
     worst-bws
    (let [best-p (apply-max-ge (better-bws :p-val) summaries)
@@ -317,7 +318,7 @@
          best-o (apply-max-ge (better-bws :o-val) summaries)]
      (make-bw-summary*
       (:wt (first summaries))
-      (:p-val best-p) (:w-val best-w) (:o-val best-o)
+      (:p-val best-p) (:w-val best-w) (min (:o-val best-o) bound)
       (:max-gap best-o) (:stat best-o) new-src
       [best-p] [best-w] [best-o]))))


remove subcategorization/sem constraints for verb; encyclopedia should provide these

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -45,25 +45,16 @@

    "abandon" [{:synsem {:cat :verb
                         :sem {:pred :abandon}
-                        :subcat {:1 {:cat :noun
-                                     :sem {:human true}}
-                                 :2 {:cat :noun
-                                     :sem {:physical-object true}}}}}
-              {:synsem {:cat :verb
-                        :sem {:pred :abandon}
-                        :subcat {:1 {:cat :noun
-                                     :sem {:human true}}
-                                 :2 '()}}}]
+                        :subcat {:1 {:cat :noun}
+                                 :2 {:cat :noun}}}}]

    "accept"  {:synsem {:cat :verb
                        :sem {:pred :accept}}}

    "accompany" {:synsem {:cat :verb
                          :sem {:pred :accompany}
-                         :subcat {:1 {:cat :noun
-                                      :sem {:animate true}}
-                                  :2 {:cat :noun
-                                      :sem {:human true}}
+                         :subcat {:1 {:cat :noun}
+                                  :2 {:cat :noun}
                                   :3 '()}}
                 :english {:past "accompanied"}}

@@ -77,8 +68,7 @@
                         :sem {:pred :announce}}}

    "answer" {:synsem {:cat :verb
-                      :sem {:pred :answer
-                            :subj {:human true}}}}
+                      :sem {:pred :answer}}}

    "approve" {:synsem {:cat :verb
                 :sem {:pred :approve}}}
@@ -87,13 +77,11 @@
                       :sem {:pred :arrive}}}

    "ask" {:synsem {:cat :verb
-                   :sem {:pred :chiedere
-                         :subj {:human true}}}}
+                   :sem {:pred :chiedere}}}

    "assume" {:synsem {:cat :verb
                       :sem {:pred :assume}
-                      :subcat {:1 {:cat :noun
-                                   :sem {:human true}}
+                      :subcat {:1 {:cat :noun}
                                :2 {:cat :comp
                                    :comp-type :that
                                    :subcat '()}}}}
@@ -112,17 +100,12 @@

    "attend" {:synsem {:cat :verb
                       :sem {:pred :attend}
-                      :subcat {:1 {:cat :noun
-                                   :sem {:human true}}
-                               :2 {:cat :noun
-                                   :pronoun false
-                                   :sem {:event true
-                                         :human false}}}}}
+                      :subcat {:1 {:cat :noun}
+                               :2 {:cat :noun}}}}

    "avoid" {:synsem {:cat :verb
                      :sem {:pred :avoid}
-                     :subcat {:1 {:cat :noun
-                                  :sem {:animate true}}
+                     :subcat {:1 {:cat :noun}
                               :2 {:cat :noun}}}}

    "backpack" {:synsem {:cat :noun


remove redundant "it (♂)" and "it (♀)"

remove redundant "it (♂)" and "it (♀)"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1199,34 +1199,6 @@
                     :gender :fem
                     :human false}
               :subcat '()}}]
-
-   "it (♂)"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :top ;; we could just omit this kv, but we explicitly
-             ;; set it to :top to show how it's different than other
-             ;; pronouns: like 'you' the nominative and accusative
-             ;; are the same (compare versus 'I'/'me', 'she'/'her', etc)
-             :agr {:person :3rd
-                   :number :sing}
-             :reflexive false
-             :sem {:pred :lui
-                   :gender :masc
-                   :human false}
-             :subcat '()}}
-
-   "it (♀)"
-   {:synsem {:cat :noun
-             :pronoun true
-              :case :top ;; see above comment
-             :agr {:person :3rd
-                   :number :sing}
-             :reflexive false
-              :sem {:pred :lei
-                    :gender :fem
-                    :human false}
-             :subcat '()}}
-
    "itself"
    [{:synsem {:cat :noun
               :pronoun true


Get dbname from config, and sanitise html

--- src/tesq/core.clj
+++ src/tesq/core.clj
@@ -8,6 +8,7 @@
 			[compojure.route :refer [resources not-found]]
 			[compojure.handler :refer [site]]
 			[hiccup.core :as h]
+			[hiccup.util :refer [escape-html]]
 			[ring.middleware.gzip :refer [wrap-gzip]]
 			[net.cgrand.enlive-html :as e]
 			[net.cgrand.reload :refer [auto-reload]]
@@ -42,10 +43,10 @@

 (defn build-query
-  "Given db & table, return query string that retrieves table data and
+  "Given table name, return query string that retrieves table data and
   looks up display fields from related tables."
-  [dbname table]
-  (let [constraints (filter #(= table (:table_name %)) (fk-constraints DB dbname))
+  [table]
+  (let [constraints (filter #(= table (:table_name %)) (fk-constraints DB (:database DB)))
 		all-columns (map :field (jdbc/query DB [(str "DESC " table)]))
 		non-lookup-columns (difference (set all-columns) (set (map :column_name constraints)))
 		related-tables (for [{:keys [referenced_table_name column_name]} constraints]
@@ -66,16 +67,15 @@
 (defn table->html
   "Given table name, fetch all rows from database and return
   as HTML table."
-  [dbname table]
-  (let [_ (pprint (build-query dbname table))
-		rows (jdbc/query DB [(build-query dbname table)])]
+  [table]
+  (let [rows (jdbc/query DB [(build-query table)])]
 	(h/html
 	 [:p {:class "count"} (str (count rows) " rows found")]
 	 [:table
-	  [:thead (for [[k v] (first rows)] [:td k])]
+	  [:thead (for [[k v] (first rows)] [:td (escape-html k)])]
 	  (for [row rows]
 		[:tr
-		 (for [[k v] row] [:td (truncate (str v))])
+		 (for [[k v] row] [:td (escape-html (truncate (str v)))])
 		 ]
 		)
 	  ])))
@@ -101,7 +101,7 @@
 				  [:li :a] (e/set-attr :href (str "/table/" item))
 				  [:li] (e/add-class (if (= table item)"active"))
 				  )
-  [:#content] (e/html-content (table->html "acfe" table)))
+  [:#content] (e/html-content (table->html table)))


entered preterito tener manually

entered preterito tener manually

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -792,6 +792,12 @@
                                     :1plur "tendrìamos"
                                     :2plur "tendrìais"
                                     :3plur "tendrìan"}
+                      :preterito {:1sing "tuve"
+                                    :2sing "tuviste"
+                                    :3sing "tuvo"
+                                    :1plur "tuvimos"
+                                    :2plur "tuvisteis"
+                                    :3plur "tuvieron"}
                       :present {:1sing "tengo"
                                 :2sing "tienes"
                                 :3sing "tiene"


Change function name rpr -> run-properties in wpml

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -293,7 +293,7 @@
                                     :w:header 0
                                     :w:footer 0})))))

-(defn- rpr
+(defn- run-properties
   "Creates w:rPr tag node. Called by paragaph-style."
   [{:as options
     :keys [font font-size font-color bold? italics? underline? strike?]}]
@@ -347,7 +347,7 @@
                   :w:customStyle "true"} ; User-Defined Style
         (node :w:name {:w:val font-style-name}) ; Primary Style Name
         (node :w:basedOn {:w:val "a0"}) ; Parent Style ID
-        (rpr options)))
+        (run-properties options)))

 (defn- ppr
   "Creates w:pPr tag node. Called by paragaph-style."
@@ -416,7 +416,7 @@
                      indent-left indent-right indent-first-line mirror-indents?)
              (ppr options))
            (when (or font font-size font-color bold? italics? underline?)
-             (rpr options)))
+             (run-properties options)))
            (when font
              (character-style character-style-name options))]))

@@ -489,7 +489,7 @@
                      indent-left indent-right indent-first-line mirror-indents?)
              (ppr options))
            (when (or font font-size font-color bold? italics? underline?)
-             (rpr options))
+             (run-properties options))
            ;; Style Table Properties
            (node :w:tblPr {}
                  ;; Number of Rows in Row Band


More untangling of domains-info map.

More untangling of domains-info map.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -74,11 +74,10 @@

 ;; TODO: examine this... can we remove this use-cache deal?
 (defn use-cache-or-update
-  ([domain domains-info global-config local-config]
-     (->> {domain (domain/host-shards (domains-info domain))}
-          (mk-loader-state)
-          (use-cache-or-update domain domains-info global-config local-config false)))
-  ([domain domains-info global-config local-config update? ^DownloadState state]
+  ([domain host-shards global-config local-config]
+     (->> (mk-loader-state {domain host-shards})
+          (use-cache-or-update domain host-shards global-config local-config false)))
+  ([domain host-shards global-config local-config update? ^DownloadState state]
      (let [fs (filesystem (:hdfs-conf local-config))
            lfs (local-filesystem)
            local-dir (:local-dir local-config)
@@ -92,7 +91,7 @@
                       local-config
                       local-domain-root
                       remote-path
-                      (domain/host-shards (domains-info domain))
+                      host-shards
                       state)
          ;; use cached domain from local-dir (no update needed)
          (do
@@ -102,17 +101,19 @@
              :no-update
              (open-domain local-config
                           (str (path local-dir domain))
-                          (domain/host-shards (domains-info domain)))))))))
+                          host-shards)))))))

 (defn purge-unused-domains!
   "Walks through the supplied local directory, recursively deleting
   all directories with names that aren't present in the supplied
-  `domain-set`."
-  [domain-set local-dir]
-  (let [lfs (local-filesystem)]
+  `domains`."
+  [domain-seq local-dir]
+  (let [lfs (local-filesystem)
+        domain-set (set domain-seq)]
     (dofor [domain-path (-> local-dir mk-local-path .listFiles)
             :when (and (.isDirectory domain-path)
-                       (not (contains? domain-set (.getName domain-path))))]
+                       (not (contains? domain-set
+                                       (.getName domain-path))))]
            (log-message "Deleting local path of deleted domain: " domain-path)
            (delete lfs (.getPath domain-path) true))))

@@ -123,7 +124,7 @@
                         rw-lock
                         (fn [domain]
                           (use-cache-or-update domain
-                                               domains-info
+                                               (domain/host-shards (domains-info domain))
                                                global-config
                                                local-config))))

@@ -161,7 +162,7 @@
         domains (keys domains-info)]
     (log-message "Domains info: " domains-info)
     (future
-      (try (purge-unused-domains! (set domains) local-dir)
+      (try (purge-unused-domains! domains local-dir)
            (sync-remote-data domains-info global-config local-config rw-lock)
            (cleanup-domains! domains local-dir)
            (log-message "Finished loading all updated domains from remote")
@@ -217,7 +218,7 @@
                                    rw-lock
                                    (fn [domain]
                                      (use-cache-or-update domain
-                                                          domains-info
+                                                          (domain/host-shards (domains-info domain))
                                                           global-config
                                                           local-config
                                                           true


removing trash line

removing trash line

--- src/clj_hypergraph_db/core.clj
+++ src/clj_hypergraph_db/core.clj
@@ -9,7 +9,7 @@
   [path]
   (let [dbinstance (HGEnvironment/get path)]
         (reset! db dbinstance)))
-def Service (create-cless args)
+
 (defn create-class
   "
   Creates a type


More work on attr re-binding.

More work on attr re-binding.

--- src/clojure/freactive/dom.cljs
+++ src/clojure/freactive/dom.cljs
@@ -261,7 +261,8 @@
                ;  (set-fn element attr-name @ref))
                ))]
       ;;(set! (.-invalidate attr-state) f)
-      (register-with-parent-state node-state (str "-" state-prefix attr-name) attr-state)
+      (register-with-parent-state node-state (str "-" state-prefix "."
+                                                  attr-name) attr-state)
       ;(set! (.-child-states node-state)
       ;      (assoc (.-child-states node-state)
       ;                                        attr-state))
@@ -271,7 +272,7 @@

 (defn bind-style-prop! [element attr-name attr-value node-state]
   (if (satisfies? cljs.core/IDeref attr-value)
-    (on-value-ref-invalidated* set-style-prop! element "style." attr-name attr-value node-state)
+    (on-value-ref-invalidated* set-style-prop! element "style" attr-name attr-value node-state)
     (set-style-prop! element attr-name attr-value)))

 (defn listen! [element evt-name handler]
@@ -301,11 +302,11 @@

 (defn- bind-prop-attr! [set-fn element attr-name attr-value node-state]
   (if (satisfies? cljs.core/IDeref attr-value)
-        (on-value-ref-invalidated* set-fn element "attr." attr-name
+        (on-value-ref-invalidated* set-fn element "attr" attr-name
                                    attr-value node-state)
         (set-fn element attr-name attr-value)))

-(defn bind-attr! [element attr-name attr-value node-state]
+(defn- bind-attr! [element attr-name attr-value node-state]
   (let [attr-name (name attr-name)]
     (cond
       (identical? "style" attr-name)
@@ -324,11 +325,19 @@
       (bind-prop-attr! set-attr! element attr-name attr-value node-state))))

 (defn- unbind-attr!* [node-state prefix attr-name]
-  (let [attr-key (str "-" prefix attr-name)]
+  (let [attr-key (str "-" prefix "." attr-name)]
     (when-let [child-states (.-child-states node-state)]
       (when-let [state (aget child-states attr-key)]
         (set! (.-disposed state) true)
         (js-delete child-states attr-key)))))
+
+(defn- rebind-style! [element attr-name styles node-state]
+  (doseq [[p v] styles]
+    (unbind-attr!* node-state "style" attr-name)
+    (bind-style-prop! element p v node-state)))
+
+(defn- rebind-attr! [element attr-name attr-value node-state]
+  )

 (defn set-attrs! [node attrs]
   (let [node-state (get-element-state node)]
@@ -345,18 +354,35 @@
               (unbind-attr!* node-state "attr" k))
             (bind-attr! node k v node-state)))))))

-(defn- replace-attr!* [node node-state attr-name old-val new-val prefix
-                       binder remover]
-  (if old-val
-    (if new-val
-      (if (not (identical? old-val new-val))
-        (unbind-attr!* node-state prefix attr-name)
-        (binder node attr-name new-val node-state))
-      (remover node attr-name))
-    (binder node attr-name new-val node-state)))
+;(defn- replace-attr!* [node node-state attr-name old-val new-val prefix binder]
+;  (if (not (identical? old-val new-val))
+;    (unbind-attr!* node-state prefix attr-name)
+;    (binder node attr-name new-val node-state)))
+;
+;(defn- replace-attr! [node node-state attr-name old-val new-val]
+;  (replace-attr!* node node-state attr-name old-val new-val "attr"))
+
+(defn- replace-attrs!* [node node-state old-attrs new-attrs rebinder binder
+                        remover]
+  (loop [[[k new-val] & new-attrs] (seq new-attrs)
+         old-attrs old-attrs]
+    (if k
+      (let [attr-name (name k)]
+        (if-let [existing (get old-attrs k)]
+          (do
+            (rebinder node node-state attr-name existing new-val)
+            (recur new-attrs (dissoc old-attrs k)))
+          (do
+            (binder node node-state attr-name new-val)
+            (recur new-attrs old-attrs))))
+      (loop [[[k v] & old-attrs] old-attrs]
+        (when k
+          (remover node node-state (name k))
+          (recur old-attrs))))))

 (defn- replace-attrs! [node old-attrs new-attrs]
   (let [node-state (get-element-state node)]
+    ;;(replace-attrs!* node node-state old-attrs new-attrs nil nil )
     ))

 ;; From hiccup.compiler:


Remove jb-exclusive fields usage from RelativeLayout params

--- src/clojure/neko/ui/traits.clj
+++ src/clojure/neko/ui/traits.clj
@@ -221,11 +221,13 @@
 ;; #### Relative layout

 (def ^:private relative-layout-attributes
+  ;; Hard-coded number values are attributes that appeared since
+  ;; Android Jellybean.
   {:standalone {:layout-align-parent-bottom  RelativeLayout/ALIGN_PARENT_BOTTOM
-                :layout-align-parent-end     RelativeLayout/ALIGN_PARENT_END
+                :layout-align-parent-end     21 ; RelativeLayout/ALIGN_PARENT_END
                 :layout-align-parent-left    RelativeLayout/ALIGN_PARENT_LEFT
                 :layout-align-parent-right   RelativeLayout/ALIGN_PARENT_RIGHT
-                :layout-align-parent-start   RelativeLayout/ALIGN_PARENT_START
+                :layout-align-parent-start   20 ; RelativeLayout/ALIGN_PARENT_START
                 :layout-align-parent-top     RelativeLayout/ALIGN_PARENT_TOP
                 :layout-center-horizontal    RelativeLayout/CENTER_HORIZONTAL
                 :layout-center-vertical      RelativeLayout/CENTER_VERTICAL
@@ -233,16 +235,17 @@
    :with-id    {:layout-above                RelativeLayout/ABOVE
                 :layout-align-baseline       RelativeLayout/ALIGN_BASELINE
                 :layout-align-bottom         RelativeLayout/ALIGN_BOTTOM
-                :layout-align-end            RelativeLayout/ALIGN_END
+                :layout-align-end            19 ; RelativeLayout/ALIGN_END
                 :layout-align-left           RelativeLayout/ALIGN_LEFT
                 :layout-align-right          RelativeLayout/ALIGN_RIGHT
-                :layout-align-start          RelativeLayout/ALIGN_START
+                :layout-align-start          18 ; RelativeLayout/ALIGN_START
                 :layout-align-top            RelativeLayout/ALIGN_TOP
                 :layout-below                RelativeLayout/BELOW
-                :layout-to-end-of            RelativeLayout/END_OF
+                :layout-to-end-of            17 ; RelativeLayout/END_OF
                 :layout-to-left-of           RelativeLayout/LEFT_OF
                 :layout-to-right-of          RelativeLayout/RIGHT_OF
-                :layout-to-start-of          RelativeLayout/START_OF}})
+                :layout-to-start-of          16 ; RelativeLayout/START_OF
+                }})

 (def ^:private all-relative-attributes
   (apply concat [:layout-width :layout-height