Magic defaults are localized to shared map

--- src/swanson/routes/transactions.clj
+++ src/swanson/routes/transactions.clj
@@ -6,9 +6,6 @@
             [swanson.views.layout :as layout]
             [swanson.views.tables :as tables]
             [hiccup.element :refer [javascript-tag]]))
-
-(defn by-week []
-  (utils/json-response (db/get-transactions-by-week)))

 (defresource post-transaction []
   :allowed-methods [:post]
@@ -46,14 +43,19 @@
                       (utils/json-response
                         {:error (str "Transaction not found for id " id)})))

+(def default-params
+  {:months 6
+   :transactions 25})
+
+(defn by-week []
+  (utils/json-response (db/get-transactions-by-week)))
+
 (defn transactions []
-  (let [default "25"
-        l (get-in ctx [:request :params :limit] default)
-        limit (utils/parse-number l)]
+  (let [limit (:transactions default-params)]
     (utils/json-response (db/get-all-transactions limit))))

 (defn category [category-id]
-  (let [result (db/category-monhly (Integer/parseInt category-id))]
+  (let [result (db/category-monthly (Integer/parseInt category-id))]
     (utils/json-response result)))

 (defn categories-ytd []
@@ -61,7 +63,7 @@
     (utils/json-response result)))

 (defn months []
-  (let [result (db/last-n-months 6)]
+  (let [result (db/last-n-months (:months default-params))]
     (utils/json-response result)))

 (defn categories-last-month []
@@ -87,5 +89,5 @@
   (GET "/months" [] (months))
   (GET "/summary" [] (tables/summary
                       (db/get-transactions-by-week)
-                      (db/recent-transactions 12)
-                      (db/last-n-months 6))))
+                      (db/recent-transactions (:transactions default-params))
+                      (db/last-n-months (:months default-params)))))


working on range lookup

working on range lookup

--- sample/src/sample/btree.clj
+++ sample/src/sample/btree.clj
@@ -175,7 +175,7 @@
   (insert [this k v]))

 (defprotocol B+TreeLookupable
-  (lookup [this k]))
+  (lookup [this k leaf-neighbours]))

 (defprotocol B+TreeLeafNodeIterable
   (iterate-leafnodes [this]))
@@ -224,7 +224,7 @@
                 (let [nvs (-> vs butlast (concat [v]))]
                   (->B+TreeInternalNode b size ks nvs))))]

-      (let [[childk childv] (lookup this k)
+      (let [[childk childv] (lookup this k {})
             [n1 nk n2]      (insert childv k v)
             nn              (if (nil? n2)
                               (ins this childk n1)
@@ -236,7 +236,7 @@

   B+TreeLookupable

-  (lookup [this k]
+  (lookup [this k leaf-neighbours]
     (loop [[k* & ks*] ks
            [v* & vs*] vs]
       (cond
@@ -278,7 +278,7 @@

   B+TreeLookupable

-  (lookup [this k]
+  (lookup [this k leaf-neighbours]
     (letfn [(range-lookup [{:keys [m] :as this} klen]
               (println "RANGE LOOKUP" k klen (keys m))
               (when (<= (cmp-keys (-> m keys first) k) 0)
@@ -329,9 +329,9 @@
   t/TreeLookupable

   (lookup [this k]
-    (loop [[_ v] (lookup root k)]
-      (if (satisfies? TreeLookup v)
-        (recur (lookup v k))
+    (loop [[_ v] (lookup root k leaf-neighbours)]
+      (if (satisfies? B+TreeLookupable v)
+        (recur (lookup v k leaf-neighbours))
         v)))

   B+TreeLeafNodeIterable


No longer require fressian.

No longer require fressian.

--- test/onyx/plugin/tx_output_test.clj
+++ test/onyx/plugin/tx_output_test.clj
@@ -3,7 +3,6 @@
             [datomic.api :as d]
             [onyx.plugin.datomic]
             [onyx.queue.hornetq-utils :as hq-utils]
-            [clojure.data.fressian :as fressian]
             [onyx.api]))

 (def id (java.util.UUID/randomUUID))


Remove redundant logging

Remove redundant logging

--- src/trak/ui/components/profile.cljs
+++ src/trak/ui/components/profile.cljs
@@ -34,6 +34,5 @@
   )

 (rum/defc profile [db]
-  (utils/info (profile-playlists db))
   [:ul.sidebar-nav.nav
    [:li.nav-item.active "Playlists" [:ul.nav (profile-playlists db)]]])


Start refactoring hello's cookie callback (WIP)

In the previous commit, this was still a Deferred.

Converted it into its own function that tries to do what that Deferred's
on-realized handlers do.

This is the can'o'worms mentioned in the previous commit.

--- src/clojure/frereth_cp/client/hello.clj
+++ src/clojure/frereth_cp/client/hello.clj
@@ -18,6 +18,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Specs

+;; TODO: Fix this spec. s/keys just doesn't cut it.
+;; If we have any of the "optional" keys, we must have all 3.
+;; And, realistically, I don't want anything more. There's
+;; to much potential to smuggle in extra crap that shouldn't
+;; be involved here.
 (s/def ::cookie-response (s/keys :req [::log/state]
                                  :opt [::state/security
                                        ::state/shared-secrets
@@ -138,6 +143,70 @@
     {::shared/packet result
      ::log/state log-state}))

+(declare do-polling-loop)
+(defn cookie-result-callback
+  [{:keys [::log/logger]
+    log-state ::log/state
+    :as this}
+   cookie-sent-callback
+   cookie-response
+   timeout
+   start-time
+   completion
+   srvr-ips
+   srvr-ip
+   raw-packet
+   actual-success]
+  (throw (RuntimeException. "This is a mess. Start back here."))
+  (let [now (System/nanoTime)]
+    ;; I don't think send-packet-success matters much
+    ;; Although...actually, ::send-response-timed-out would be a big
+    ;; deal.
+    ;; FIXME: Add error handling for that.
+    ;; And convert this to a log message
+    ;; (although, admittedly, it's really helpful for debugging)
+    (println
+     "Received network packet:\n"
+     (::shared/network-packet actual-success))
+    (if (and (not (instance? Throwable actual-success))
+             (not (#{::sending-hello-timed-out
+                     ::awaiting-cookie-timed-out
+                     ::send-response-timed-out} actual-success)))
+      (do
+        (when-let [problem (s/explain-data ::cookie-response actual-success)]
+          (println "Bad cookie:" problem)
+          (dfrd/error! cookie-response
+                       (ex-info "Bad cookie response"
+                                {::error problem})))
+        (println "Cookie response was OK")
+        (let [log-state (try
+                          (log/info (::log/state actual-success)
+                                    ::do-polling-loop
+                                    "Might have found a responsive server"
+                                    {::specs/srvr-ip srvr-ip})
+                          (catch Exception ex
+                            (println "client: Failed trying to log about potentially responsive server\n"
+                                     (log/exception-details ex))
+                            (throw (ex-info "Logging failure re: server response" {::actual-success actual-success} ex))))]
+          (dfrd/success! cookie-response actual-success)))
+      (let [this (assoc this (log/warn log-state
+                                       ::do-polling-loop
+                                       "Failed to connect"
+                                       {::specs/srvr-ip srvr-ip
+                                        ;; Actually, if this is a Throwable,
+                                        ;; we probably don't have a way
+                                        ;; to recover
+                                        ::outcome actual-success}))]
+        (if-let [remaining-ips (next srvr-ips)]
+          ;; Another place where we should be doing trampoline.
+          ;; Or "just" set the cookie-response deferred to something that signals
+          ;; it to recur in this manner.
+          (do-polling-loop completion this raw-packet cookie-sent-callback now (* 1.5 timeout) remaining-ips)
+          (do
+            (dfrd/error! completion (ex-info "Giving up" this))
+            ;; FIXME: Need to do something about this return value
+            (::log/state this)))))))
+
 (s/fdef do-polling-loop
         :args (s/cat :completion ::specs/deferrable
                      :this ::state/state
@@ -163,13 +232,26 @@
                             ::do-polling-loop
                             "Polling server"
                             {::specs/srvr-ip ip})
-        cookie-response (dfrd/deferred executor)
         this (-> this
                  (assoc ::log/state log-state)
                  (assoc-in [::state/server-security ::specs/srvr-ip] ip))
+        cookie-response (dfrd/deferred executor)
+        ;; Note that cookie-sent-callback is actually cookie/wait-for-cookie!
         cookie-waiter (partial cookie-sent-callback
                                this
-                               cookie-response
+                               (partial cookie-result-callback
+                                        this
+                                        ;; This seems like a giant red-flag
+                                        ;; that we're setting this up to recurse
+                                        ;; Q: Have I really been doing this all along?
+                                        ;; Or was this a refactoring bug?
+                                        cookie-sent-callback
+                                        cookie-response
+                                        timeout
+                                        start-time
+                                        completion
+                                        ips
+                                        ip)
                                timeout)
         {log-state ::log/state
          dfrd-send-success ::specs/deferrable} (state/do-send-packet this
@@ -179,6 +261,7 @@
                                                                      timeout
                                                                      ::sending-hello-timed-out
                                                                      raw-packet)
+        ;; Give do-send-packet a chance to do its thing
         send-packet-success (deref dfrd-send-success 1000 ::send-response-timed-out)
         ;; Note that this timeout actually can grow to be quite long.
         ;; In the original, they add up to a ballpark of 46 seconds.
@@ -203,115 +286,76 @@
                                                            {::wrapper cookie-response}))
                            (throw ex)))
         now (System/nanoTime)]
-    ;; I don't think send-packet-success matters much
-    ;; Although...actually, ::send-response-timed-out would be a big
-    ;; deal.
-    ;; FIXME: Add error handling for that.
-    ;; And convert this to a log message
-    ;; (although, admittedly, it's really helpful for debugging)
     (println "hello/do-polling-loop Sending HELLO returned:"
              send-packet-success
              "\nQ: Does that value matter?"
              "\nactual-success:\n"
              (dissoc actual-success ::log/state)
              "\nTop-level keys:\n"
-             (keys actual-success)
-             "\nReceived network packet:\n"
-             (::shared/network-packet actual-success))
-    (if (and (not (instance? Throwable actual-success))
-             (not (#{::sending-hello-timed-out
-                     ::awaiting-cookie-timed-out
-                     ::send-response-timed-out} actual-success)))
-      (do
-        (when-let [problem (s/explain-data ::cookie-response actual-success)]
-          (println "Bad cookie:" problem)
-          (throw (ex-info "Bad cookie response"
-                          {::error problem})))
-        (println "Cookie response was OK")
-        (let [log-state (try
-                          (log/info (::log/state actual-success)
-                                    ::do-polling-loop
-                                    "Might have found a responsive server"
-                                    {::specs/srvr-ip ip})
-                          (catch Exception ex
-                            (println "client: Failed trying to log about potentially responsive server\n"
-                                     (log/exception-details ex))
-                            (throw (ex-info "Logging failure re: server response" {::actual-success actual-success} ex))))]
-          (println "client: Should have a log message about possibly responsive server")
-          ;; I'm definitely getting here
-          (if-let [network-packet (::shared/network-packet actual-success)]
-            (let [{:keys [::state/server-security ::state/shared-secrets]} actual-success]
-              (println "Do we have both security and shared-secrets?")
-              (when-not (and server-security shared-secrets)
-                ;; A: We do not.
-                ;; TODO: Fix the ::cookie-response spec. s/keys just doesn't cut it.
-                ;; If we have any of the "optional" keys, we must have all 3
-                (log/flush-logs! logger (log/error log-state
-                                                   ::do-polling-loop
-                                                   "Got back a network-packet but missing something else"
-                                                   {::cookie-response actual-success}))
-                (assert false))
-              (println "We do!")
-              (let [log-state (log/debug log-state
-                                         ::do-polling-loop
-                                         "Got back a usable cookie"
-                                         (dissoc actual-success ::log/state))]
-                ;; Need to move on to Vouch. But there's already far
-                ;; too much happening here.
-                ;; So the deferred in completion should trigger client/servers-polled
-                (as-> (into this actual-success) this
-                  (dfrd/success! completion this))
-                log-state))
-            (let [elapsed (- now start-time)
-                  remaining (- timeout elapsed)
-                  log-state (log/info log-state
-                                      ::do-polling-loop
-                                      "Discarding garbage cooke")]
-              (if (< 0 remaining)
-                (recur completion
-                       (assoc this ::log/state (log/flush-logs! logger (log/info log-state
-                                                                                ::do-polling-loop
-                                                                                "Still waiting on server"
-                                                                                {::shared/host ip
-                                                                                ::millis-remaining remaining})))
-                       raw-packet
-                       cookie-sent-callback
-                       start-time
-                       ;; Note that this jacks up the orderly timeout progression
-                       ;; Not that the progression is quite as orderly as it looked
-                       ;; at first glance:
-                       ;; there's a modulo against a random 32-byte number involved
-                       ;; (line 289)
-                       remaining
-                       ips)
-                (if-let [remaining-ips (next ips)]
-                  (recur completion
-                         (assoc this ::log/state (log/flush-logs! logger (log/info log-state
-                                                                                ::do-polling-loop
-                                                                                "Moving on to next ip")))
-                         raw-packet
-                         cookie-sent-callback
-                         now
-                         ;; TODO: I'm missing that module against a random 32-byte number
-                         ;; mentioned above.
-                         (* 1.5 timeout)
-                         remaining-ips)
-                  (do
-                    (dfrd/error! completion (ex-info "Giving up" this))
-                    log-state)))))))
-      (let [this (assoc this (log/warn log-state
-                                       ::do-polling-loop
-                                       "Failed to connect"
-                                       {::specs/srvr-ip ip
-                                        ;; Actually, if this is a Throwable,
-                                        ;; we probably don't have a way
-                                        ;; to recover
-                                        ::outcome actual-success}))]
-        (if-let [remaining-ips (next ips)]
-          (recur completion this raw-packet cookie-sent-callback now (* 1.5 timeout) remaining-ips)
-          (do
-            (dfrd/error! completion (ex-info "Giving up" this))
-            (::log/state this)))))))
+             (keys actual-success))
+    (if-let [network-packet (::shared/network-packet actual-success)]
+      (let [{:keys [::state/server-security ::state/shared-secrets]} actual-success]
+        (when-not (and server-security shared-secrets)
+          (log/flush-logs! logger (log/error log-state
+                                             ::do-polling-loop
+                                             "Got back a network-packet but missing something else"
+                                             {::cookie-response actual-success}))
+          (assert (and server-security shared-secrets)
+                  (str "Network-packet missing either security or shared-secrets:\n"
+                       (util/pretty actual-success))))
+        (let [log-state (log/debug log-state
+                                   ::do-polling-loop
+                                   "Got back a usable cookie"
+                                   (dissoc actual-success ::log/state))]
+          ;; Need to move on to Vouch. But there's already far
+          ;; too much happening here.
+          ;; So the deferred in completion should trigger client/servers-polled
+          (as-> (into this actual-success) this
+            ;; FIXME: Untangle this chain.
+            ;; We can't really call this synchronously because of the way
+            ;; aleph and state/do-send-packet work.
+            ;; But this spooky action at a distance stinks.
+            (dfrd/success! completion this))
+          log-state))
+      (let [elapsed (- now start-time)
+            remaining (- timeout elapsed)
+            log-state (log/info log-state
+                                ::do-polling-loop
+                                "Discarding garbage cooke")]
+        (if (< 0 remaining)
+          ;; FIXME: This needs to trampoline instead
+          (do-polling-loop completion
+                           (assoc this ::log/state (log/flush-logs! logger (log/info log-state
+                                                                                ::do-polling-loop
+                                                                                "Still waiting on server"
+                                                                                {::shared/host ip
+                                                                                ::millis-remaining remaining})))
+                           raw-packet
+                           cookie-sent-callback
+                           start-time
+                           ;; Note that this jacks up the orderly timeout progression
+                           ;; Not that the progression is quite as orderly as it looked
+                           ;; at first glance:
+                           ;; there's a modulo against a random 32-byte number involved
+                           ;; (line 289)
+                           remaining
+                           ips)
+          (if-let [remaining-ips (next ips)]
+            ;; FIXME: Honestly, need to use trampoline for this
+            (do-polling-loop completion
+                             (assoc this ::log/state (log/flush-logs! logger (log/info log-state
+                                                                                ::do-polling-loop
+                                                                                "Moving on to next ip")))
+                             raw-packet
+                             cookie-sent-callback
+                             now
+                             ;; TODO: I'm missing that module against a random 32-byte number
+                             ;; mentioned above.
+                             (* 1.5 timeout)
+                             remaining-ips)
+            (do
+              (dfrd/error! completion (ex-info "Giving up" this))
+              log-state)))))))

 (s/fdef poll-servers!
         :args (s/cat :this ::state/state
@@ -343,6 +387,8 @@
                              ::poll-servers!
                              "Putting hello(s) onto ->server channel"
                              {::raw-packet raw-packet})]
+    ;; FIXME: Make completion go away. This level of indirection makes
+    ;; my head spin.
     (let [completion (dfrd/deferred)]
       (dfrd/on-realized completion
                         (partial send-succeeded! logger)
@@ -357,6 +403,7 @@
                                cookie-waiter
                                (System/nanoTime)
                                ;; FIXME: The initial timeout needs to be customizable
+                               ;; Q: Why aren't I using timeout?!
                                (util/seconds->nanos 1)
                                ;; Q: Do we really want to max out at 8?
                                ;; 8 means over 46 seconds waiting for a response,


Moved predicates to their own namespace and fixed missing reference to str-utils.

Signed-off-by: James Reeves <9dadf8ecafa226c8f7c16002bdcb090267879343@weavejester.com>

--- src/compojure/validation/predicates.clj
+++ src/compojure/validation/predicates.clj
@@ -1,4 +1,5 @@
-(ns compojure.validation)
+(ns compojure.validation.predicates
+    (:use compojure.str-utils))

 (defn present?
   "True if x is not nil and not an empty string."


Have a more liberal keyword regex.

Have a more liberal keyword regex.

--- etc/build-helper/src/build_helper/docs/util.clj
+++ etc/build-helper/src/build_helper/docs/util.clj
@@ -84,7 +84,7 @@
    state])

 (defn keyword->code [text state]
-  [(str/replace text #"(\s+|>|^)(:[:0-9a-zA-Z?+_?-]+)"
+  [(str/replace text #"([^a-zA-Z0-9])(:[:0-9a-zA-Z?+_?-]+)"
      (fn [[_ prefix kw]]
        (format "%s<code>%s</code>" prefix kw))) state])


Added more tests for off-the-wall variants of state wrappers.

--- test/behaviors/t_setup_teardown.clj
+++ test/behaviors/t_setup_teardown.clj
@@ -133,6 +133,8 @@

   (fact x => 1))

+					; ========
+

 (def immediate-atom (atom 0))
 (against-background [ (before :contents (swap! immediate-atom (constantly 33))
@@ -157,7 +159,7 @@

     (+ (f ...arg...) x) => 301)

-  (fact
+  (fact "the other"
     @immediate-atom => 34	;; immediate wrapper doesn't apply.
     @per-fact-atom => 18	;; per-fact wrapper resets.
     @per-check-atom => 888	;; old per-check atom applied once, applies no more
@@ -175,16 +177,30 @@
   (swap! per-check-atom inc) => 890
   @per-check-atom => 890)

+					; ========
 (pending-fact "behavior of (background :contents)")

+					; ========
+
 (background (around :facts (let [one 111] ?form)))
-(fact (+ one 222) => 333)
+(fact  "Background facts are visible even when they don't wrap a fact (old bug)"
+  (+ one 222) => 333)

 (against-background [(around :facts (let [two 222] ?form))]
   (fact (+ one two) => 333))

-
-; ----
+					; ========
+
+
 (against-background [ (around :facts (let [x 1] ?form) )]
   (let [y 2]
-    (fact (+ x y) => 3)))
+    (fact "a let in background plays well with let in regular code"
+      (+ x y) => 3)
+
+    (fact "including things like scoping"
+      (against-background (around :checks (let [z (* 3 x)
+						a (* 4 y)] ?form)))
+      (do       (println (+ x y z a))
+(+ x y z a)) => 14)))
+
+


Three new tests: test-format-time[1-3]

Three new tests: test-format-time[1-3]

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -347,3 +347,24 @@
                 "2000-01-15" (get-last-day-of-week calendar2)
                 "2000-01-22" (get-last-day-of-week calendar3)))))

+(deftest test-format-time-1
+    "Check the function clj-calendar.calendar/format-time"
+    (testing "the function clj-calendar.calendar/format-time"
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 01 10 20 30)
+            (is (= "10:20:30" (format-time calendar))))))
+
+(deftest test-format-time-2
+    "Check the function clj-calendar.calendar/format-time"
+    (testing "the function clj-calendar.calendar/format-time"
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 01 10 20 60)
+            (is (= "10:21:00" (format-time calendar))))))
+
+(deftest test-format-time-3
+    "Check the function clj-calendar.calendar/format-time"
+    (testing "the function clj-calendar.calendar/format-time"
+        (let [calendar (get-calendar)]
+            (.set calendar 2000 01 01 10 60 60)
+            (is (= "11:01:00" (format-time calendar))))))
+


[#92] Improved the time macro and used erlang functions for number conversion

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -3432,17 +3432,17 @@

 (defn long
   "Coerce to long"
-  {:inline (fn  [x] `(. clojure.lang.RT (longCast ~x)))
+  {:inline (fn  [x] `(erlang/trunc.e ~x))
    :added "1.0"}
-  [^Number x]
-  (clj_core/to_integer.e x))
+  [x]
+  (erlang/trunc.e x))

 (defn float
   "Coerce to float"
-  {:inline (fn  [x] `(. clojure.lang.RT (~(if *unchecked-math* 'uncheckedFloatCast 'floatCast) ~x)))
+  {:inline (fn  [x] `(erlang/float.e ~x))
    :added "1.0"}
-  [^Number x]
-  (clj_core/to_float.e x))
+  [x]
+  (erlang/float.e x))

 (defn double
   "Coerce to double"
@@ -3856,9 +3856,10 @@
   {:added "1.0"}
   [expr]
   `(let [start# (erlang/monotonic_time.e :nano_seconds)
-         ret# ~expr]
+         ret#   ~expr
+         stop#  (erlang/monotonic_time.e :nano_seconds)]
      (prn (str "Elapsed time: "
-               (/ (- (erlang/monotonic_time.e :nano_seconds) start#) 1000000.0)
+               (/ (- stop# start#) 1000000.0)
                " msecs"))
      ret#))


slow tests

slow tests

--- test/euler/euler011_test.clj
+++ test/euler/euler011_test.clj
@@ -9,8 +9,8 @@
   (fact "Problem 11"
     (p011) => 70600674)

-  (fact "Problem 12"
-    (p012) => 76576500) ;; too slow - makes cloverage abort
+  ; (fact "Problem 12"
+  ;   (p012) => 76576500) ;; too slow - makes cloverage abort

   (fact "Problem 13"
     (p013) => 5537376230342)


p021: moving tests form midje back to clj.test


Rename functions

Rename functions

--- test/hundred_pushups/core_test.cljc
+++ test/hundred_pushups/core_test.cljc
@@ -7,7 +7,7 @@

 (use-fixtures :once instrument-all check-asserts)

-(defn successful-day-log [test-log ts log]
+(defn complete-next-day [ts test-log log]
   (let [next-day (suggested-day test-log log)]
     (complete-day log next-day ts)))

@@ -40,7 +40,7 @@
              (let [test-log [{:exr.pushup/reps 10 :exr.plank/reps 15}]
                    circuit-log []]
                (->> circuit-log
-                    (successful-day-log test-log ts)
+                    (complete-next-day ts test-log)
                     (suggested-day test-log)))))))

   (testing "suggests 4 x 50% + 2 after two day"
@@ -51,8 +51,8 @@
              (let [test-log [{:exr.pushup/reps 10 :exr.plank/reps 15}]
                    circuit-log []]
                (->> circuit-log
-                    (successful-day-log test-log ts)
-                    (successful-day-log test-log ts)
+                    (complete-next-day ts test-log)
+                    (complete-next-day ts test-log)
                     (suggested-day test-log)))))))

   (let [{args-sp :args ret-sp :ret} (s/get-spec #'suggested-day)]


Fix initial values for filter and ordering on images page.

That causes unexpected exceptions on first views of page.

--- src/uxbox/main/ui/dashboard/images.cljs
+++ src/uxbox/main/ui/dashboard/images.cljs
@@ -345,8 +345,8 @@
   {:mixins [mx/static mx/reactive]}
   [{:keys [id type selected] :as state}]
   (let [editable? (or (= type :own) (nil? id))
-        filtering (:filter state)
-        ordering (:order state)
+        ordering (:order state :name)
+        filtering (:filter state "")
         images (mx/react images-ref)
         images (->> (vals images)
                     (filter #(= id (:collection %)))


Fix assert in `containium.systems/forward-protocol`.

--- systems/core/src/containium/systems.clj
+++ systems/core/src/containium/systems.clj
@@ -86,7 +86,7 @@
   class already implements or satisfies the protocol, this is a noop."
   [object-or-class protocol]
   (assert object-or-class "object or class cannot be nil")
-  (assert (#'clojure.core/protocol? protocol "protocol argument must point to a protocol"))
+  (assert (#'clojure.core/protocol? protocol) "protocol argument must point to a protocol")
   (let [class (if (class? object-or-class) object-or-class (class object-or-class))]
     (try
       (extend class protocol


Handle rollback in NPR.

Handle rollback in NPR.

--- src/cbfg/npr.cljs
+++ src/cbfg/npr.cljs
@@ -8,6 +8,7 @@
 (defn npr-snapshot-item-msg [stream-request snapshot item])
 (defn npr-rollback-msg [stream-request rollback])
 (defn server-take-snapshot [actx server stream-request prev-snapshot])
+(defn client-rollback [actx client stream-request rollback-msg])
 (defn client-snapshot-beg [actx client stream-request snapshot-beg])
 (defn client-snapshot-end [actx client stream-request snapshot-beg snapshot-end])
 (defn client-snapshot-item [actx client stream-request snapshot-beg snapshot-item])
@@ -69,7 +70,11 @@
                                                        (recur stream-request r
                                                               (atake npr-client-loop from-server-ch)
                                                               num-snapshots num-items))
-              :else (aput-close npr-client-loop out {:status :unexpected-msg}))))
+             (and (nil? snapshot-beg)
+                  (= (:status :rollback))) (aput-close npr-client-loop out
+                                                       (client-rollback npr-client-loop client
+                                                                        stream-request r))
+             :else (aput-close npr-client-loop out {:status :unexpected-msg}))))

 (defn make-npr-client-session [actx client token to-server-ch from-server-ch]
   (let [out (achan-buf actx 1)


Indentation.

Indentation.

--- src/cbfg/vis.cljs
+++ src/cbfg/vis.cljs
@@ -161,13 +161,13 @@
      " </button>"
      " " actx-id " "
      "
" (vis-html-loop-state vis (:loop-state actx-info)) "
"
-     "

"
+     "

"
      (mapv (fn [ch-info]
              (let [ch-id (:id ch-info)]
                ["
" ch-id ": "
                 "" (keys (:msgs ch-info)) "
"]))
            (sort-by :id (vals (get actx-ch-ch-infos actx))))
-     "

"
+     "

"
      (when (not (:closed actx-info))
        ["
"
         (mapv (fn [child-actx]


Adds member*

Adds member*

--- src/the_little_clojurian/chapter5.clj
+++ src/the_little_clojurian/chapter5.clj
@@ -86,3 +86,18 @@
   (is (= (insertL* 'new 'old '(old)) '(new old)))
   (is (= (insertL* 'new 'old '((old))) '((new old))))
   (is (= (insertL* 'new 'old '((these) old ((shoes old) perfume))) '((these) new old ((shoes new old) perfume)))))
+
+(with-test
+  (def member*
+    (fn [a l]
+      (cond (null? l) false
+            (atom? (car l)) (cond (eq? (car l) a) true
+                                  :else (member* a (cdr l)))
+            :else (or (member* a (car l))
+                      (member* a (cdr l))))))
+
+  (is (= (member* 'foo '()) false))
+  (is (= (member* 'foo '(foo)) true))
+  (is (= (member* 'foo '(bar)) false))
+  (is (= (member* 'foo '((foo))) true))
+  (is (= (member* 'foo '((the quick) ((((brown (springy foo)) jumps over)) the dog))))))


Add some grouping comments to the clojure namespace.

--- src/frmr/dstt.clj
+++ src/frmr/dstt.clj
@@ -7,6 +7,7 @@
             [clojure.data.json :as json])
   (:gen-class))

+;;; Helper functions.
 (defn- basic-handler
   "This is the default handler function that will just return a single category: the time taken to
   run the entire request in ms. You should probably provide your own handler function, but if this
@@ -34,6 +35,7 @@
              (- total 1))
           (Math/sqrt)))))

+;;; Load testing implementation.
 (defn- issue-timed-request
   "Issue a timed request by invoking request-invoker within a future after sleeping the future for a
   specified amount of time. Then pass the elapsed time and the content of the request through the
@@ -90,6 +92,7 @@
   (let [client-request-method (select-function-for-http-method http-method)]
     (fn [] (client-request-method url request-options))))

+;;; CLI Functions
 (defn- parse-header
   "Parse a header string from the command line into a map for the http library."
   [header]


added test to examine data, which will ultimately be irrelevant

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -145,3 +145,18 @@
          (logistic-beta-wrap [1e-6 1e-8 250] ?hansen ?val ?neighbor-val :> ?beta)
          (:distinct false))))

+(defbufferop num-distinct [tuples]
+  [(reduce +
+           (map (partial thresh-make-binary -1)
+                (apply concat tuples)))])
+
+(defn examine-data
+  "path to partfile that comes from s3://formaresults/prebetatemp;
+  test to make sure that the betas are produced"
+  [path]
+  (let [src (hfs-seqfile path)]
+    (?<- (stdout)
+         [?eco ?num]
+         (src ?mod-h ?mod-v ?s ?l ?eco ?hansen ?val ?neighbor-val)
+         (num-distinct ?hansen :> ?num))))
+


Retract larger groups when retracting uncommitted jobs.

Each transaction is going to have a cost, so lets fewer transactions.

Jobs inserted at the same time as part of an uncommitted group are likely
closely colocated in storage, so this is likely going to be a lot fewer
random reads than you might otherwise expect; an interval of the
datomic storage tree to be retracted.

--- scheduler/src/cook/mesos/util.clj
+++ scheduler/src/cook/mesos/util.clj
@@ -691,7 +691,7 @@
                       {:count-committed (count committed-jobs)
                        :count-uncommitted (count uncommitted-jobs)})))
     (when-not dry-run?
-      (doseq [batch (partition-all 10 uncommitted-before)]
+      (doseq [batch (partition-all 100 uncommitted-before)]
         @(d/transact conn (mapv #(vector :db.fn/retractEntity (:db/id %))
                                 batch))))
     uncommitted-before))


Set theme colors on UI elements.

Set theme colors on UI elements.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -27,8 +27,13 @@
                :base3 "#fdf6e3"})

 (def theme {:background (:base03 pallette)
-            :foreground (:base0 pallette)
-            :cursorColor (:base1 pallette)})
+            :foreground (:base1 pallette)
+            :cursorOn (:red pallette)
+            :cursorOff (:base02 pallette)
+            :on (:green pallette)
+            :off (:base02 pallette)
+            :link (:blue pallette)
+            :bar (:base02 pallette)})

 (defonce app-state (atom {:grids {}
                           :samples []
@@ -56,13 +61,22 @@
   (reify
     om/IRenderState
     (render-state [_ state]
-      (dom/td #js {:onClick #(do
-                               (om/update! cursor [(mod (inc (first cursor)) 2)])
-                               (go (>! (:set-state-ch state) id)))
-                   :style #js {:width "20px"
-                               :fontSize "20px"
-                               :color (if on "#F00" (:foreground theme))}}
-             (str " " (first cursor))))))
+      (let [cell-on (not (= 0 (first cursor)))
+            color (if (not on) ; cursor is not on this cell
+                    (if cell-on
+                      (:on theme)
+                      (:off theme))
+                    (if cell-on
+                      (:cursorOn theme)
+                      (:cursorOff theme)))]
+        (dom/td #js {:onClick #(do
+                                 (om/update! cursor [(mod (inc (first cursor)) 2)])
+                                 (go (>! (:set-state-ch state) id)))
+                     :style #js {:width "20px"
+                                 :fontSize "20px"
+                                 :fontWeight (if on "bold" "normal")
+                                 :color color}}
+                (str " " (first cursor)))))))

 (def style-grey #js {:style #js {:color (:foreground theme)}})

@@ -85,10 +99,13 @@
                           (om/update-state! owner (fn [s] (merge s {:state :open})))
                           (om/transact! cursor (fn [c] (assoc c (:field state) (:text state))))
                           (go (>! set-state-ch id)))
-                closer #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :init})))}
-                canceller #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))}]
+                closer #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :init})))
+                            :style #js {:color (:link theme)}}
+                canceller #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))
+                               :style #js {:color (:link theme)}}]
             (condp = (:state state)
-              :init (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))} "{..}")
+              :init (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))
+                                   :style #js {:color (:link theme)}} "{..}")
               :open (dom/table nil
                                (apply dom/tbody nil
                                       (concat
@@ -102,7 +119,8 @@
                                                               (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :editing
                                                                                :text v
-                                                                                :field k})))}
+                                                                                :field k})))
+                                                                           :style #js {:color (:link theme)}}
                                                                       v)))
                                             (keys cursor)
                                             (vals cursor))
@@ -111,7 +129,8 @@
                                                 (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :adding-field
                                                                                :text nil
-                                                                                :field ""})))}
+                                                                                :field ""})))
+                                                             :style #js {:color (:link theme)}}
                                                         "[+]")
                                                 (dom/td nil nil))
                                         (dom/tr nil
@@ -136,7 +155,8 @@
                                                                    (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :editing
                                                                                :text v
-                                                                                :field k})))}
+                                                                                :field k})))
+                                                                                :style #js {:color (:link theme)}}
                                                                            v))))
                                                (keys cursor)
                                                (vals cursor))
@@ -145,7 +165,8 @@
                                                    (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :adding-field
                                                                                :text nil
-                                                                                :field ""})))}
+                                                                                :field ""})))
+                                                                :style #js {:color (:link theme)}}
                                                            "[+]")
                                                    (dom/td nil nil))
                                            (dom/tr nil
@@ -164,7 +185,8 @@
                                                                (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :editing
                                                                                :text v
-                                                                                :field k})))}
+                                                                                :field k})))
+                                                                            :style #js {:color (:link theme)}}
                                                                        v)))
                                              (keys cursor)
                                              (vals cursor))
@@ -195,7 +217,8 @@
                                                                (dom/td #js {:onClick #(om/update-state! owner
                                                                                (fn [s] (merge s {:state :editing
                                                                                :text v
-                                                                                :field k})))}
+                                                                                :field k})))
+                                                                            :style #js {:color (:link theme)}}
                                                                        v)))
                                              (keys cursor)
                                              (vals cursor))
@@ -238,6 +261,7 @@
         :selecting (dom/select #js {:value (:type state)
                                     :onChange #(handle-change % owner state :type)
                                     :onClick #(handle-change % owner state :type)
+                                    :style #js {:color (:link theme)}
                                     :onKeyDown #(when (= 13 (.-which %))
                                                   (om/update-state! owner (fn [s] (merge s {:state :immutable})))
                                                   (condp = (:type state)
@@ -279,10 +303,13 @@
       (render-state [_ state]
         (if (and (= :init (:state state))
                  (contains? cursor key))
-          (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :selecting})))} (get cursor key))
+          (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :selecting})))
+                         :style #js {:color (:link theme)}}
+                    (get cursor key))
           (apply dom/select #js {:value ((keyword key) state)
                                  :onChange #(handle-change % owner state (keyword key))
                                  :onClick #(handle-change % owner state (keyword key))
+                                 :style #js {:color (:link theme)}
                                  :onKeyDown #(when (= 13 (.-which %))
                                                (om/update-state! owner (fn [s] (merge s {:state :init})))
                                                (om/transact! cursor (fn [c] (assoc c key ((keyword key) state))))
@@ -307,7 +334,8 @@
     (render-state [_ state]
       (let [transition #(om/update-state! owner (fn [s] (merge {:state %})))
             closing-row #(dom/tr nil
-                                 (dom/td #js {:onClick (fn [] (transition :init))} %)
+                                 (dom/td #js {:onClick (fn [] (transition :init))
+                                              :style #js {:color (:link theme)}} %)
                                  (dom/td nil nil)
                                  (dom/td nil nil))
             remove #(do
@@ -315,7 +343,8 @@
                                                               (subvec c (+ 1 %))))))
                       (go (>! set-state-ch id)))
             body-rows (map #(dom/tr nil
-                                    (dom/td #js {:onClick (fn [] (remove %2))} "X")
+                                    (dom/td #js {:onClick (fn [] (remove %2))
+                                                 :style #js {:color (:link theme)}} "X")
                                     (dom/td nil (get %1 "fx"))
                                     (dom/td nil (om/build param-editor
                                                           {:cursor %1
@@ -329,7 +358,8 @@
                       (om/transact! cursor (fn [c] (clj->js (into c [new-fx]))))
                       (go (>! set-state-ch id)))]
         (condp = (:state state)
-          :init (dom/span #js {:onClick #(transition :open)}
+          :init (dom/span #js {:onClick #(transition :open)
+                               :style #js {:color (:link theme)}}
                           "{..}")
           :open (dom/table nil
                            (apply dom/tbody nil
@@ -338,7 +368,8 @@
                                    body-rows
                                    [(dom/tr nil
                                             (dom/td nil nil)
-                                            (dom/td #js {:onClick #(transition :adding)} "[+]")
+                                            (dom/td #js {:onClick #(transition :adding)
+                                                         :style #js {:color (:link theme)}} "[+]")
                                             (dom/td nil nil))
                                     (closing-row "}")])))
           :adding (dom/table nil
@@ -363,10 +394,12 @@
       {:state :init})
     om/IRenderState
     (render-state [this state]
-      (let [closer #js {:onClick  #(om/update-state! owner (fn [s] (merge s {:state :init})))}]
+      (let [closer #js {:onClick  #(om/update-state! owner (fn [s] (merge s {:state :init})))
+                        :style #js {:color (:link theme)}}]
         (condp = (:state state)
           :init (dom/p style-grey
-                       (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))} "{..}"))
+                       (dom/span #js {:onClick #(om/update-state! owner (fn [s] (merge s {:state :open})))
+                                      :style #js {:color (:link theme)}} "{..}"))
           :open (let [fx-row (dom/tr nil
                                      (dom/td nil nil)
                                      (dom/td nil "fx:")
@@ -381,7 +414,8 @@
                                                      (dom/td nil nil)
                                                      (dom/td nil nil)
                                                      (dom/td nil (dom/span #js {:onClick #(go (>! delete-ch cursor))
-                                                                                :style #js {:float "right"}} "X")))
+                                                                                :style #js {:color (:link theme)
+                                                                                :float "right"}} "X")))
                                              (dom/tr nil
                                                      (dom/td closer "{")
                                                      (dom/td nil nil)
@@ -471,18 +505,22 @@
                                              #(do
                                                 (set-width w)
                                                 (transition {:state :init})
-                                                (go (>! set-state-ch id)))} s))]
+                                                (go (>! set-state-ch id)))
+                                             :style #js {:color (:link theme)}} s))]
         (condp = (:state state)
           :init (let [width (apply max (map #(count (get % "beats")) cursor))]
                   (if (= 0 (count cursor))
                     (dom/p style-grey
-                           (dom/span #js {:onClick #(transition {:state :open})} "[+]"))
+                           (dom/span #js {:onClick #(transition {:state :open})
+                                          :style #js {:color (:link theme)}} "[+]"))
                     (dom/p style-grey
-                           (dom/span #js {:onClick #(transition {:state :open})} "[+")
+                           (dom/span #js {:onClick #(transition {:state :open})
+                                          :style #js {:color (:link theme)}} "[+")
                            (width-selection width (str " " width))
                            (dom/span nil "]"))))
           :open (dom/p style-grey
-                       (dom/span #js {:onClick #(transition {:state :init})} "[- ")
+                       (dom/span #js {:onClick #(transition {:state :init})
+                                      :style #js {:color (:link theme)}} "[- ")
                        (width-selection 1 " 1")
                        (width-selection 2 " 2")
                        (width-selection 4 " 4")
@@ -503,7 +541,7 @@
     (render-state [_ state]
       (if-not (:track-expanded state)
         (dom/tr nil (dom/td #js {:onClick #(om/set-state! owner :track-expanded true)
-                                 :style #js {:color "#999"}} ">"))
+                                 :style #js {:color (:link theme)}} ">"))
         (dom/tr nil
                 (dom/td nil
                  (dom/table nil
@@ -533,7 +571,8 @@
     om/IRenderState
     (render-state [_ state]
       (let [transition #(om/update-state! owner (fn [s] (merge s %)))
-            closer #(dom/span #js {:onClick (fn [] (transition {:state :init}))} %)
+            closer #(dom/span #js {:onClick (fn [] (transition {:state :init}))
+                                   :style #js {:color (:link theme)}} %)
             double-width #(let [tracks (get cursor "tracks")
                                 doubled-tracks (map (fn [t]
                                                       (let [beats (get t "beats")]
@@ -554,19 +593,23 @@
                           (om/transact! cursor (fn [c] (assoc cursor "tracks" (clj->js halved-tracks))))
                           (go (>! set-state-ch id)))]
         (condp = (:state state)
-          :init (dom/span #js {:onClick #(transition {:state :open})}
+          :init (dom/span #js {:onClick #(transition {:state :open})
+                               :style #js {:color (:link theme)}}
                           "{..}")
           :open (dom/span nil
                           (closer "{")
                           (dom/span nil
                                     (dom/span nil " bpc: ")
-                                    (dom/span #js {:onClick #(transition {:state :editing-bpc})}
+                                    (dom/span #js {:onClick #(transition {:state :editing-bpc})
+                                                   :style #js {:color (:link theme)}}
                                               (str (get cursor "bpc"))))
                           (dom/span nil
                                     (dom/span nil " width: ")
-                                    (dom/span #js {:onClick double-width} "+")
+                                    (dom/span #js {:onClick double-width
+                                                   :style #js {:color (:link theme)}} "+")
                                     (dom/span nil "/")
-                                    (dom/span #js {:onClick half-width} "-"))
+                                    (dom/span #js {:onClick half-width
+                                                   :style #js {:color (:link theme)}} "-"))
                           (dom/span nil " }"))
           :editing-bpc (dom/span nil
                                  (closer "{ ")
@@ -601,15 +644,17 @@
     (render-state [_ state]
       (let [cursor (get (om/observe owner (grids)) id)
             name (get cursor "name")]
-        (dom/div #js {:style #js {:borderLeft "solid 3px #ccc"
+        (dom/div #js {:style #js {:borderLeft (str "solid 12px " (:bar theme))
                                   :paddingLeft "10px"}}
                  (if-not (:grid-expanded state)
                    (dom/div nil
                             (dom/p style-grey
-                                   (dom/span #js {:onClick #(om/set-state! owner :grid-expanded true)} "+")))
+                                   (dom/span #js {:onClick #(om/set-state! owner :grid-expanded true)
+                                                  :style #js {:color (:link theme)}} "+")))
                    (dom/div nil
                             (dom/p style-grey
-                                   (dom/span #js {:onClick #(om/set-state! owner :grid-expanded false)}
+                                   (dom/span #js {:onClick #(om/set-state! owner :grid-expanded false)
+                                                  :style #js {:color (:link theme)}}
                                              (str "- "))
                                    (dom/span nil (str name " "))
                                    (om/build grid-editor {:id id
@@ -681,7 +726,8 @@
                 (when message
                   (recur))))))
         {:set-state-ch set-state-ch
-         :get-state-ch get-state-ch}))
+         :get-state-ch get-state-ch
+         :grid-expanded true}))
     om/IRenderState
     (render-state [_ state]
       (dom/div #js {:style #js {:fontFamily "monospace"


fix symbol

fix symbol

--- src/meta/boot.clj
+++ src/meta/boot.clj
@@ -146,7 +146,7 @@
                      impl/info              {:message "Running Workflow...: develop"}
                      ver/version            {:develop true :pre-release 'snapshot}
                      cljs/cljs              {:optimizations :none}
-                     shadow/compile         {:build :app})
+                     shadow/compiler        {:build :app})
       build      (boot/task-options!
                      impl/info              {:message "Running Workflow...: build"})
       generate     (boot/task-options!


Add a very basic step debugger

Add a very basic step debugger

--- cmma-clj/src/cmma/dev.clj
+++ cmma-clj/src/cmma/dev.clj
@@ -1,4 +1,5 @@
-(ns cmma.dev)
+(ns cmma.dev
+  (:require [clojure.walk :as walk]))

 ;; Simpler debug-repl :: https://github.com/stuarthalloway/circumspec/blob/master/src/clojure/contrib/debug.clj
 (defmacro local-bindings
@@ -50,16 +51,20 @@
   ([]
    `(debug-repl nil ~(meta &form)))
   ([retform]
-   `(debug-repl retform ~(meta &form)))
+   `(debug-repl ~retform ~(meta &form)))
   ([retform form-meta]
+   `(debug-repl ~retform ~(meta &form) ~{}))
+  ([retform form-meta injected-locals]
    `(let [debug-meta# ~(assoc form-meta
                               :ns *ns*
                               :file *file*)
           eval-fn# (fn [e-form#]
                      (eval-with-locals (merge {(symbol "debug-meta") debug-meta#
                                                (symbol "in-debug-ns") (fn [] (in-ns (ns-name (:ns debug-meta#))))}
+                                              ~injected-locals
                                               (local-bindings)
-                                              {(symbol "quit-dr") ~quit-dr}) e-form#))]
+                                              {(symbol "quit-dr") ~quit-dr})
+                                       e-form#))]
       (try
         (binding [level (unchecked-inc level)]
           (clojure.main/repl
@@ -75,7 +80,8 @@
             (if-let [new-form# (.nextElement ^java.util.Enumeration quit-dr-exception)]
               (eval-fn# new-form#)
               (eval-fn# ~retform))
-            (throw e#)))))))
+            (throw e#))))))
+  )

 (defmacro assert-repl [assertion-form]
   `(when *assert*
@@ -134,3 +140,50 @@
 ;; (construct [inc dec] [10 10]) => (11 9)
 (def construct (partial map deliver))

+
+(defn- formize-progress [prog-vec]
+  (let [processed-form (loop [skip-elem 0
+                              token (first prog-vec)
+                              new-form []
+                              progress (next prog-vec)]
+                         (cond
+                           (and (nil? progress)
+                                (zero? skip-elem)) (conj new-form token)
+                           (nil? progress) new-form
+                           (and (zero? skip-elem)
+                                (coll? token)) (recur (count token) (first progress) (conj new-form token) (next progress))
+                           (pos? skip-elem) (recur (dec skip-elem) (first progress) new-form (next progress))
+                           (zero? skip-elem) (recur skip-elem (first progress) (conj new-form token) (next progress))))]
+    `(~@processed-form)))
+
+(defn step-debug [form]
+  "Step through an expression with a debug-repl.
+  Empty list is next step/continue: ()
+  Other locals:
+   * form - the whole form you're stepping through
+   * current-form - the current form/token you're on
+   * progress - an atom'd vector of all forms/tokens you've seen so far - CURRENTLY REMOVED
+   * *locals* - a map of all locals in scope"
+  (let [progress (atom [])]
+    (eval
+      (walk/prewalk (fn [current-form]
+                      (when (not= current-form form)
+                        (swap! progress conj current-form)
+                        (try
+                          (let [step (eval current-form)
+                                sdbg `(~@(formize-progress @progress) (debug-repl nil {} {(symbol "form") ~form
+                                                                                (symbol "current-form") ~current-form
+                                                                                ;(symbol "progress") ~progress
+                                                                                (symbol "step") ~step}))]
+                            (println "Form:" form
+                                     "\ncurrent-form:" current-form
+                                     "\nprogress:" (formize-progress @progress)
+                                     "\nstep:" step)
+                            (eval sdbg)
+                            #_(debug-repl))
+                          (catch Throwable t
+                            nil)))
+                      current-form)
+                    form))))
+
+


fix begin point

fix begin point

--- src/neuseg/db.clj
+++ src/neuseg/db.clj
@@ -32,7 +32,7 @@
         (matrix (map (partial reg-wd-neglect name)
              (partition-by #(if (number? %1) (reset! last %1) (+ @last 1))
                (interleave (map splited-line (rest (line-seq rdr)))
-                           (iterate inc 1)))))))))
+                           (iterate inc 0)))))))))

 (def unigram  (load-db "unigram"))
 (def bigram   (load-db "bigram"))


added search

added search

--- src/ofdb/core.clj
+++ src/ofdb/core.clj
@@ -9,20 +9,27 @@
             [compojure.handler :as handler]
             [org.httpkit.server :refer :all]
             [ring.middleware.file :refer :all]
-            [ring.middleware.file-info :refer :all])
+            [ring.middleware.file-info :refer :all]
+            [ofdb.service :as s]
+            [cheshire.core :as c])
   (:gen-class))

 (defroutes sync_routes
   (u/wrap-utf8
-   (u/wrap-template
-    (routes
-     (GET  "/" [] (u/erender "templates/hello" {}))
-     (GET  "/secret" [] (friend/authorize #{::users/admin} (u/erender "templates/secret" {})))
-     (GET  "/login" request (u/erender "templates/login" request))
-     (u/routes-by-convention '("/welcome"))
-     (friend/logout (ANY "/logout" request (ring.util.response/redirect "/")))
-     (ANY  "*" [] {:status 404 :body "sorry, 404"}))
-    "templates/master")))
+   (routes
+    (GET  "/product/:name" [name]
+          (u/jresp
+           (filter #(re-matches (re-pattern (str ".*" name ".*")) (:name %)) (s/getproducts))))
+    (GET  "/products" [] (u/jresp (s/getproducts)))
+    (u/wrap-template
+     (routes
+      (GET  "/" [] (u/erender "templates/hello" {}))
+      (GET  "/secret" [] (friend/authorize #{::users/admin} (u/erender "templates/secret" {})))
+      (GET  "/login" request (u/erender "templates/login" request))
+      (u/routes-by-convention '("/welcome"))
+      (friend/logout (ANY "/logout" request (ring.util.response/redirect "/")))
+      (ANY  "*" [] {:status 404 :body "sorry, 404"}))
+     "templates/master"))))

 (def siteconfig
   (-> sync_routes


Extract map-layout

Extract map-layout

--- devcards/frontend/devcards/map.cljs
+++ devcards/frontend/devcards/map.cljs
@@ -143,10 +143,10 @@

     (pr-str (alg/shortest-path g 1 6))))

-(defn show-columns [things-in-columns]
+(defn show-columns [columns]
   (html
    [:div {:style {:display "flex"}}
-    (for [things things-in-columns]
+    (for [things columns]
       [:div
        (for [thing things]
          (if thing
@@ -157,16 +157,6 @@
            [:div {:style {:margin "0.5em"
                           :padding "0.5em"
                           :height "calc(1em + 23px)"}}]))])]))
-
-(defn coords [columns]
-  (into {}
-        (map-indexed
-         (fn [x column]
-           (map-indexed
-            (fn [y thing]
-              [thing [x y]])
-            column))
-         columns)))

 (defn move-to [x y]
   (str "M" x "," y))
@@ -218,37 +208,58 @@
  [(box-x-position config x)
   (+ (/ box-height 2) (box-y-position config y))])

-(defn strut-offset [{:keys [strut-spacing]} things-in-columns tx ty]
- (* strut-spacing (- (count (nth things-in-columns tx)) ty)))
-
-(defn strut-position [config things-in-columns tx ty]
- (- (first (arrow-end config tx ty)) (strut-offset config things-in-columns tx ty)))
-
-(defn map-svg [{:keys [box-width box-height arrow-radius] :as config} things-in-columns edges]
-  (let [cs (coords things-in-columns)]
+(defn strut-offset [{:keys [strut-spacing]} columns tx ty]
+ (* strut-spacing (- (count (nth columns tx)) ty)))
+
+(defn strut-position [config columns tx ty]
+ (- (first (arrow-end config tx ty)) (strut-offset config columns tx ty)))
+
+(defn map-layout [{:keys [box-width box-height arrow-radius] :as config} columns edges]
+  (let [coords (into {}
+                     (map-indexed
+                      (fn [x column]
+                        (map-indexed
+                         (fn [y thing]
+                           [thing [x y]])
+                         column))
+                      columns))]
+    {:arrows
+     (for [[from to] edges
+           :let [[fx fy] (get coords from)
+                 [tx ty] (get coords to)]]
+       {:start (arrow-start config fx fy)
+        :end (arrow-end config tx ty)
+        :strut-position (strut-position config columns tx ty)
+        :radius arrow-radius})
+
+     :boxes
+     (for [[x things] (map-indexed vector columns)
+           [y thing] (map-indexed vector things)
+           :when thing]
+       {:x (box-x-position config x)
+        :y (box-y-position config y)
+        :width box-width
+        :height box-height
+        :content thing})}))
+
+(defn map-svg [{:keys [box-width box-height arrow-radius] :as config} columns edges]
+  (let [{:keys [arrows boxes]} (map-layout config columns edges)]
     (html
      [:div {:style {:background "white"}}
       [:svg {:width "2000"
              :height "300"
              :style {:background "white"}}
        [:g {:transform "translate(3,3)"}
-        (for [[from to] edges
-              :let [[fx fy] (get cs from)
-                    [tx ty] (get cs to)]]
-          (arrow (arrow-start config fx fy)
-                 (arrow-end config tx ty)
-                 (strut-position config things-in-columns tx ty)
-                 arrow-radius))
-        (for [[x things] (map-indexed vector things-in-columns)]
-          (for [[y thing] (map-indexed vector things)]
-            (when thing
-              [:g {:transform (str "translate(" (box-x-position config x) "," (box-y-position config y) ")")}
-               [:rect.job {:fill "none"
-                           :width box-width
-                           :height box-height}]
-               [:text {:x 10
-                       :y 25}
-                thing]])))]]])))
+        (for [{:keys [start end strut-position radius]} arrows]
+          (arrow start end strut-position radius))
+        (for [{:keys [x y width height content]} boxes]
+          [:g {:transform (str "translate(" x "," y ")")}
+           [:rect.job {:fill "none"
+                       :width width
+                       :height height}]
+           [:text {:x 10
+                   :y 25}
+            content]])]]])))

 (defn has-far-arrows? [graph columns node]
   (zero? (g/out-degree (g/subgraph graph (conj (apply concat (rest columns)) node))


Fortress handler handles errors :)

Fortress handler handles errors :)

--- src/clj/fortress/ring/handler.clj
+++ src/clj/fortress/ring/handler.clj
@@ -28,6 +28,11 @@
 (defn fhandler-init [zero-copy? handler]
   [[] (atom {:zero-copy? zero-copy?
              :handler handler})])
+
+(defn fhandler-exceptionCaught [this ctx cause]
+  (log/error cause "Error occurred in Http I/O thread")
+  (when (-> ctx (.channel) (.isOpen))
+    (response/write-ring-response ctx {:status 500})))

 (defn fhandler-channelRead0 [this ctx request]
   (let [{:keys [zero-copy? handler]} @(.state this)]


Use the protocol functions, not methods

Use the protocol functions, not methods

--- src/clojure/staircase/handler.clj
+++ src/clojure/staircase/handler.clj
@@ -89,10 +89,10 @@
     NOT_FOUND))

 (defn add-step-to [histories steps id doc]
-  (if (.exists? histories id)
+  (if (exists? histories id)
     (let [to-insert (assoc doc "history_id" id)
-          step-id (.create steps to-insert)]
-      (response (.get-one steps step-id)))
+          step-id (create steps to-insert)]
+      (response (get-one steps step-id)))
     NOT_FOUND))

 (defn- issue-session [config secrets ident]


Print category ids in show-fns.

Print category ids in show-fns.

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -4260,20 +4260,20 @@
   [q]
   (letfn [(show-fns-by-cat-idx [cat-idx]
             (let [res (get (all-category-map) (str cat-idx))]
-              (println (:name res))
+              (println cat-idx (:name res))
               (dorun
                (map #(println "  -" %) (:fns res)))))
           (show-fns-by-name-regex [re]
-            (doseq [[_ c] (all-category-map)]
+            (doseq [[cid c] (sort-by key (all-category-map))]
               (let [in-cat-name? (or (re-find re (.toLowerCase (:name c)))
                                      (re-find re (:name c)))
                     in-fn-names? (some #(re-find re (str %)) (:fns c))]
                 (cond
                  in-cat-name? (do   ;; print an entire category
-                                (println (:name c))
+                                (println cid (:name c))
                                 (doseq [f (:fns c)] (println "  -" f)))
                  in-fn-names? (do   ;; print only matching fns
-                                (println (:name c))
+                                (println cid (:name c))
                                 (doseq [f (:fns c)]
                                   (if (re-find re (str f))
                                     (println "  -" f))))))))]


include totaldocuments in paging

include totaldocuments in paging

--- src/rrms/core.clj
+++ src/rrms/core.clj
@@ -32,10 +32,11 @@

   (GET "/documents/paging/:index/:pagesize" [index pagesize]
        (rr/content-type
-        (rr/response (db/get-all-documents-by-index-pagesize
-                      {:index (parse-int index)
-                       :pagesize (parse-int pagesize)
-                       }))
+        (rr/response {:totaldocuments (db/get-total-documents)
+                      :data (db/get-all-documents-by-index-pagesize
+                             {:index (parse-int index)
+                              :pagesize (parse-int pagesize)
+                              })})
         content-type))

   (GET "/documents/all" []


also here

also here

--- src/runtime/q.clj
+++ src/runtime/q.clj
@@ -57,7 +57,7 @@
   `'~(-> &form meta :line)
   )

-
+;inspired from (source assert)
 (defmacro assumedTrue1
 "will throw if the passed expressions evaluates to false or nil"
   [x]


use getters on JSError

use getters on JSError

closure made all fields private

https://github.com/google/closure-compiler/commit/52010f41b7b5de46ba8f4cf2d4a8185044285159

--- src/main/shadow/build/closure.clj
+++ src/main/shadow/build/closure.clj
@@ -532,7 +532,7 @@
 (defn js-error-xf [state ^com.google.javascript.jscomp.Compiler cc]
   (map (fn [^JSError err]
          (let [source-name
-               (.-sourceName err)
+               (.getSourceName err)

                line
                (.getLineNumber err)
@@ -559,7 +559,7 @@
               :source-name source-name
               :line line
               :column column
-              :msg (.-description err)}
+              :msg (.getDescription err)}

              (let [{:keys [resource-id resource-name file url]} src

@@ -586,7 +586,7 @@
                 :file file
                 :line line
                 :column column
-                :msg (.-description err)
+                :msg (.getDescription err)
                 :source-excerpt source-excerpt}
                ))))))


Add whitespace to bump CI

Add whitespace to bump CI

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -607,3 +607,4 @@
      (doseq [[tree movements] benches]
        (apply-to-iterator (iterator tree) movements))))
  )
+


use (map), not (pmap) for finding candidate-parents: the latter seems to cause long delays potentially

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -98,16 +98,15 @@

         depth (if depth depth 0)
         ;; TODO: unifyc is expensive: factor out into a let.
-        candidate-parents (lazy-shuffle (filter #(not (fail? %))
-                                                #?(:clj (pmap (fn [rule]
-                                                                (unifyc spec rule))
-                                                              (if parent (get-head-phrases-of parent index)
-                                                                  grammar)))
-                                                #?(:cljs (map (fn [rule]
-                                                                (unifyc spec rule))
-                                                              (if parent (get-head-phrases-of parent index)
-                                                                  grammar)))))
-
+        debug (log/debug (str "looking for candidate parents.."))
+        candidate-parents (filter #(not (fail? %))
+                                  (map (fn [rule]
+                                         (unifyc spec rule))
+                                       (if parent (get-head-phrases-of parent index)
+                                           grammar)))
+
+        debug (log/debug (str "done looking for candidate parents:" candidate-parents))
+
         debug (if (not (empty? candidate-parents))
                 (log/debug (str "candidate-parents: " (string/join "," (map #(get-in % [:rule])
                                                                             candidate-parents)))))]


fix typo

fix typo

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -98,8 +98,6 @@
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (< depth maxdepth)
             (mapcat (fn [parent]
-                      (if (nil? (get-in parent [:head] nil))
-                        (exception "get-in(parent,:head) was nil before looking for phrasal heads."))
                       (over/overh parent (lightning-bolt grammar lexicon (get-in parent [:head])
                                                          (+ 1 depth) index morph (+ 1 total-depth))
                                   morph))
@@ -137,12 +135,12 @@
                                     ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
                                     "'" (morph complement) "'"))

-                    true)
+                    false)
                   (do
                     (log/debug (str "add-complement(depth=" depth ",total-depth=" total-depth
                                     ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                     "'" (morph complement) "'"))
-                    false)))
+                    true)))
               (map (fn [complement]
                      (unify (copy bolt)
                             (path-to-map path


Renaming a tab group from the UI

Renaming a tab group from the UI

--- src/booklet/core.cljs
+++ src/booklet/core.cljs
@@ -31,17 +31,29 @@
 ;;;; Functions
 ;;;;----------------------------

+(defn dispatch-on-press-enter [e d]
+  (if (= 13 (.-which e))
+    (dispatch d)))
+
+
+
 (defn filter-tabs
   "Filters out the tabs we will not show or manipulate, for instance, chrome extensions"
   [tabs]
   (remove #(.startsWith (:url %) "chrome") tabs))
-

 (defn group-from-tabs
   "Takes a tabset and returns a new group containing them and some extra data"
   [tabs]
   {:date (.now js/Date)
    :tabs tabs})
+
+(defn group-label [group]
+  (or (:name group) (:date group)))
+
+(def initial-focus-wrapper
+  (with-meta identity
+             {:component-did-mount #(.focus (reagent/dom-node %))}))

 ;;;;----------------------------
@@ -60,21 +72,42 @@
   :group-delete-set
   (fn [app-state [_ group]]
     (dispatch [:modal-info-set {:header       "Please confirm"
-                                :body         (str "Do you want to delete tab group " (:date group) "?")
+                                :body         (str "Do you want to delete tab group " (group-label group) "?")
                                 :action-label "Kill it"
                                 :action       #(do
                                                 (dispatch [:modal-info-set nil])
                                                 (dispatch [:group-delete group]))}])
-    app-state
-    ))
+    app-state))

 (register-handler
   :group-delete
   (fn [app-state [_ group]]
     (let [original (get-in app-state [:data :groups])
-          groups (remove #(= group %) original)]
+          groups   (remove #(= group %) original)]
       (dispatch [:groups-set groups])
       app-state)))
+
+
+(register-handler
+  :group-edit-set
+  (fn [app-state [_ group]]
+    (dispatch [:group-label-set (group-label group)])
+    (assoc-in app-state [:ui-state :group-edit] group)))
+
+
+(register-handler
+  :group-label-set
+  (fn [app-state [_ label]]
+    (assoc-in app-state [:ui-state :group-label] label)))
+
+(register-handler
+  :group-update
+  (fn [app-state [_ old-group new-group]]
+    (dispatch [:groups-set (->> (get-in app-state [:data :groups])
+                                (remove #(= % old-group))
+                                (cons new-group))])
+    app-state))
+

 (register-handler
   :groups-set
@@ -217,33 +250,44 @@
        [:button {:on-click #(storage/clear)} "Clear"]
        ])))

-(defn list-groups [groups]
-  (console/log "list-groups" groups)
-  (for [group groups]
-    ^{:key (:date group)}
-    [:div
-     [:div
-      [:h3 {:on-click #(dispatch [:group-edit-set group])} (or (:date group) (:name group))]
-      [:input {:type "text" :class "form-control" :on-blur #(console/log "Blurring" group)}]
-      [:small [:a {:on-click #(dispatch [:group-delete-set group])} "Delete"]]
-      ]
-
-     [:table {:class "table table-striped table-hover"}
-      [:thead
-       [:tr
-        [:th "#"]
-        [:th "Title"]
-        [:th "URL"]]]
-      [:tbody
-       (list-tabs (filter-tabs (:tabs group)))]
-      ]]))

 (defn tab-groups []
-  (let [tab-groups (subscribe [:data :groups])]
+  (let [tab-groups (subscribe [:data :groups])
+        group-edit (subscribe [:ui-state :group-edit])
+        label      (subscribe [:ui-state :group-label])
+        to-list    (reaction (sort-by #(* -1 (:date %)) @tab-groups))]
     (fn []
       [:div
        [:div {:class "page-header"} [:h2 "Previous groups"]]
-       (list-groups (sort-by #(* -1 (:date %)) @tab-groups))
+       (doall
+         (for [group @to-list]
+           ^{:key (:date group)}
+           [:div
+            [:div
+             (if (= group @group-edit)
+               [initial-focus-wrapper
+                [:input {:type      "text"
+                         :class     "form-control"
+                         :value     @label
+                         :on-change #(dispatch-sync [:group-label-set (-> % .-target .-value)])
+                         :on-blur   #(do
+                                      (dispatch [:group-update group (assoc group :name @label)])
+                                      (dispatch [:group-edit-set nil]))
+                         }]]
+               [:h3 {:on-click #(dispatch [:group-edit-set group])} (group-label group)]
+               )
+             [:small [:a {:on-click #(dispatch [:group-delete-set group])} "Delete"]]
+             ]
+
+            [:table {:class "table table-striped table-hover"}
+             [:thead
+              [:tr
+               [:th "#"]
+               [:th "Title"]
+               [:th "URL"]]]
+             [:tbody
+              (list-tabs (filter-tabs (:tabs group)))]
+             ]]))
        ]
       )
     ))


set default active panel

set default active panel

--- src/cljs/cs95/db.cljs
+++ src/cljs/cs95/db.cljs
@@ -1,4 +1,5 @@
 (ns cs95.db)

 (def default-db
-  {:name "re-frame"})
+  {:name "re-frame"
+   :active-panel :home})


init on load

init on load

--- src/cljs/ts/core.cljs
+++ src/cljs/ts/core.cljs
@@ -35,7 +35,7 @@
               (swap! tweets add-tweet t)))))))

 (defn make-receiver []
-  (h/log "make recevier")
+  (h/log "make recevier" ws)
   (set! (.-onmessage ws) #(put! receive %))
   (recive-tweet))

@@ -109,7 +109,11 @@
 (defn mount-root []
   (reagent/render [current-page] (.getElementById js/document "app")))

+(defn init-ws! []
+  (h/log "we have js/window")
+  (make-receiver))
+
 (defn init! []
   (hook-browser-navigation!)
-  (make-receiver)
+  (set! (.-onload js/window) init-ws!)
   (mount-root))


Misc hk

Misc hk

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -184,7 +184,8 @@

       \* (let [bulk-count (Integer/parseInt (.readLine in))]
            (if (== bulk-count -1) nil ; Nb was [] with < Carmine v3
-             (encore/repeatedly* bulk-count (get-unparsed-reply in req-opts))))
+             (encore/repeatedly-into* [] bulk-count
+               (get-unparsed-reply in req-opts))))

       (throw (ex-info (format "Server returned unknown reply type: %s"
                         (str reply-type))


ocd commit

ocd commit

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -10,7 +10,6 @@
             [clj-http.cookies :as cookies]
             (org.bovinegenius [exploding-fish :as uri]))
   (:use [clojure.pprint :only [pprint]]))
-

 (defn write
   [content filename]


added an inspection routine

added an inspection routine

--- src/crawler/model.clj
+++ src/crawler/model.clj
@@ -52,3 +52,12 @@
     {:action     pagination-trimmed
      :pagination pagination}))

+(defn inspect-action-seq
+  [action-seq corpus]
+  (map
+   first
+   (filter
+    (fn [[u x]]
+      (= (:src-xpath x)
+         action-seq))
+    corpus)))


Introduce serialization/serialize-attribute for use in init-model expansion.

--- clj_record/test/serialization_test.clj
+++ clj_record/test/serialization_test.clj
@@ -24,8 +24,7 @@

 (defdbtest serialized-attributes-support-common-clojure-types
   (restoring-ref (manufacturer/model-metadata)
-    (callbacks/add-callback "manufacturer" :before-save (callb/transform-value :name serialization/serialize))
-    (callbacks/add-callback "manufacturer" :after-load (callb/transform-value :name serialization/deserialize))
+    (serialization/serialize-attribute "manufacturer" :name)
     (let [record (manufacturer/create valid-manufacturer)]
       (are (=
         (do (manufacturer/update (assoc record :name _1)) _1)


Complete vectors koans test

Complete vectors koans test

--- clojure/koans/src/koans/03_vectors.clj
+++ clojure/koans/src/koans/03_vectors.clj
@@ -1,33 +1,33 @@
 (meditations
   "You can use vectors in clojure to create an 'Array' like structure"
-  (= __ (count [42]))
+  (= 1 (count [42]))

   "You can create a vector in several ways"
-  (= __ (vec nil))
+  (= [] (vec nil))

   "And populate it in either of these ways"
-  (= __ (vec '(1)))
+  (= [1] (vec '(1)))

   "There is another way as well"
-  (= __ (vector nil))
+  (= [nil] (vector nil))

   "But you can populate it with any number of elements at once"
-  (= [1 __] (vec '(1 2)))
+  (= [1 2] (vec '(1 2)))

   "And add to it as well"
-  (= __ (conj (vec nil) 333))
+  (= [333] (conj (vec nil) 333))

   "You can get the first element of a vector like so"
-  (= __ (first [:peanut :butter :and :jelly]))
+  (= :peanut (first [:peanut :butter :and :jelly]))

   "And the last in a similar fashion"
-  (= __ (last [:peanut :butter :and :jelly]))
+  (= :jelly (last [:peanut :butter :and :jelly]))

   "Or any index if you wish"
-  (= __ (nth [:peanut :butter :and :jelly] 3))
+  (= :jelly (nth [:peanut :butter :and :jelly] 3))

   "You can also slice a vector"
-  (= __ (subvec [:peanut :butter :and :jelly] 1 3))
+  (= [:butter :and] (subvec [:peanut :butter :and :jelly] 1 3))

   "Equality with collections is in terms of values"
-  (= (list 1 2 3) (vector 1 2 __)))
+  (= (list 1 2 3) (vector 1 2 3)))


delaney.clj: added some more test cases

delaney.clj: added some more test cases


add support of nested bq row

add support of nested bq row

--- src/datasplash/bq.clj
+++ src/datasplash/bq.clj
@@ -44,9 +44,13 @@
       (reduce
        (fn [acc k]
          (assoc! acc (keyword k)
-                 (if auto-parse
-                   (auto-parse-val (.get row k))
-                   (.get row k))))
+                 (let [raw-v (.get row k)]
+                   (cond
+                     (sequential? raw-v) (if (instance? java.util.AbstractMap (first raw-v))
+                                           (map #(table-row->clj {:auto-parse auto-parse} %) raw-v)
+                                           (map #(if auto-parse (auto-parse-val %) %) raw-v))
+                     (instance? java.util.AbstractMap raw-v) (table-row->clj {:auto-parse auto-parse} raw-v)
+                     :else (if auto-parse (auto-parse-val raw-v) raw-v)))))
        (transient {}) keyset))))
   ([row] (table-row->clj {} row)))


Catch exceptions when twittering. Sometimes fails

--- src/demogorgon/nh.clj
+++ src/demogorgon/nh.clj
@@ -263,7 +263,10 @@
                                              (:endtime data)))
             final-tweet (str tweet-prefix ", " url)]
         (announce irc out)
-        (twitter/tweet final-tweet)))))
+        (try
+         (twitter/tweet final-tweet)
+         (catch Exception e
+           (.error logger "tweet failed" e)))))))

 (defn make-game-action-out [data]
   (condp = (:game_action data)


Added db configurations and datomic-specific data.

--- src/dragon/config.clj
+++ src/dragon/config.clj
@@ -1,12 +1,13 @@
 (ns dragon.config
-  (:require [dragon.components.core :as components]
+  (:require [datomic.client :as datomic]
+            [dragon.components.core :as components]
             [dragon.util :as util]
             [leiningen.core.project :as project]
             [taoensso.timbre :as log])
   (:refer-clojure :exclude [name read]))

 (def defaults
-  {:dev-port 5097
+  {:port 5097
    :domain "dragon.github.io"
    :name "Dragon Blog Generator"
    :description "A fire-breathing blog generator"
@@ -35,7 +36,17 @@
      :log-nss '[dragon]}
    :cli {
      :log-level :error
-     :log-nss '[dragon]}})
+     :log-nss '[dragon]}
+   :db {
+     :type :datomic
+     :datomic {
+       :account-id datomic/PRO_ACCOUNT
+       :region datomic/PRO_ACCOUNT
+       :service "peer-server"
+       :endpoint "localhost:8998"
+       :db-name "dragon"
+       :secret "dragon"
+       :access-key "dragon"}}})

 (defn build
   ""
@@ -170,3 +181,16 @@
 (defn period-ellipsis
   [system]
   (components/get-config system :parsing :period-ellipsis))
+
+(defn db
+  [system]
+  (components/get-config system :db))
+
+(defn db-type
+  [system]
+  (components/get-config system :db :type))
+
+(defn db-config
+  [system]
+  (let [db-type (db-type system)]
+    (db-type (db system))))


use 4 instances

use 4 instances

--- src/evalback/core.clj
+++ src/evalback/core.clj
@@ -22,7 +22,7 @@

 (def varname [(TIdentifierLiteral. "_lambda_result_")])

-(def instances 2)
+(def instances 4)
 (def prob-timeout 3000)
 (def request-timeout 6500)
 (defonce worker (atom nil))


Small UI improvements

Small UI improvements

--- src/greenyet/view.clj
+++ src/greenyet/view.clj
@@ -28,9 +28,9 @@
    (when (:message host)
      [:span.message (escape-html (:message host))])
    (when (:components host)
-     [:div.components
+     [:ol.components
       (for [comp (:components host)]
-       [:div {:class (str/join " " ["component" (some-> comp
+       [:li {:class (str/join " " ["component" (some-> comp
                                                         :color
                                                         name)])
               :title (:message comp)}
@@ -46,13 +46,14 @@
                                  ".components { background: white; margin: 10px; }"
                                  ".component.green::before { background-color: green; }"
                                  ".component.yellow::before { background-color: yellow; }"
-                                 ".component::before { content: ''; display: inline-block; background-color: red; width: 20px; height: 20px; vertical-align: middle; margin-right: 5px; }"
-                                 ".component { display: inline-block; height: 20px; line-height: 20px; margin: 10px; }"
+                                 ".component::before { content: ''; display: inline-block; background-color: red; width: 1.2rem; height: 1.2rem; vertical-align: middle; margin-right: 5px; }"
+                                 ".component { display: inline-block; height: 1.2rem; line-height: 1.2rem; margin: 6px; }"
                                  ".message { display: block; padding-top: 4px; font-style: italic; font-size: 0.9rem; overflow: hidden; text-overflow: ellipsis; width: 400px; max-height: 8em; margin: auto; }"
                                  "body { font-family: sans-serif; }"
-                                 "table { border-collapse: separate; border-spacing: 0; width: 100%; }"
+                                 "table { border-collapse: separate; border-spacing: 0; width: 100%; table-layout: fixed; }"
                                  "td { text-align: center; padding: 5px; border: solid white 0; border-width: 2px 4px 2px 0; }"
-                                 "td:first-child { text-align: left; padding: 5px 5px 5px 0; width: 200px; }"
+                                 "td:first-child { text-align: left; padding: 5px 5px 5px 0; width: 200px; word-wrap: break-word; }"
+                                 "ol { padding: 0; list-style: none; }"
                                  ".project-link { font-size: 0.8rem; text-decoration: none; color: gray; letter-spacing: 0.2rem; }"])]]
         [:body
          [:a.project-link {:href "https://github.com/cburgmer/greenyet"} "Green yet?"]


Improve CLI behavior

Improve CLI behavior

`lein run <files>` now does a bit more of what you expect it to. You can
pass it as many files as you like and all .llcoolj files will be
compiled into a single lambdaman.gcc output file. The same output is
also printed to stdout so that we can still just pipe to pbcopy.

If you pass it one or more .gfk files, they will each be compiled to a
different file with the .ghc suffix. A short message gets printed to
stdout just to show the input -> output pairs.

--- src/icfp2014/core.clj
+++ src/icfp2014/core.clj
@@ -1,7 +1,22 @@
 (ns icfp2014.core
-  (:require [icfp2014.compiler :as compiler]))
+  (:require [icfp2014.compiler :as compiler]
+            [icfp2014.ghc :as ghc]))

 (defn -main
-  "I do a whole lot."
+  "I do a whole lot.
+
+  For every .llcoolj file: print compiled code to stdout AND write it to lambdaman.gcc.
+
+  For every .gfk file: compile and output a corresponding .ghc file."
   [& files]
-  (println (apply compiler/compile-files files)))
+  (let [llcoolj-files (filter #(.endsWith ^String % "llcoolj") files)
+        ghostface-files (filter #(.endsWith ^String % "gfk") files)]
+    (when (seq llcoolj-files)
+      (let [output (apply compiler/compile-files files)]
+        (println output)
+        (spit "lambdaman.gcc" output)))
+    (when (seq ghostface-files)
+      (doseq [file ghostface-files]
+        (let [out-name (clojure.string/replace file "gfk" "ghc")]
+          (ghc/tag-file file out-name)
+          (println (format "%s -> %s" file out-name)))))))


revert heartbeat back to 2 seconds

revert heartbeat back to 2 seconds

--- src/jepsen/voltdb.clj
+++ src/jepsen/voltdb.clj
@@ -74,7 +74,7 @@
        ; isolated nodes with requests *before* they kill themselves
        ; but low enough that a new majority is elected and performs
        ; some operations.
-       [:heartbeat {:timeout 10}] ; seconds
+       [:heartbeat {:timeout 2}] ; seconds
        [:commandlog {:enabled true, :synchronous true, :logsize 128}
         [:frequency {:time 2}]]]))) ; milliseconds


Fixed URL following transfer

Fixed URL following transfer

--- src/leiningen/amp.clj
+++ src/leiningen/amp.clj
@@ -24,7 +24,7 @@
    for details on how to deploy AMP files to an Alfresco installation.

    To create an empty project compatible with this plugin, please use
-   the 'amp' lein-new template (see https://github.com/mstang/alfresco-amp-template).
+   the 'amp' lein-new template (see https://github.com/lambdalf/amp-template).

    Usage:


Adjust .gitignore creation.

Adjust .gitignore creation.

Should only ignore a new project's "lib" or "classes" if they are
directories in the root.

--- src/leiningen/new.clj
+++ src/leiningen/new.clj
@@ -59,7 +59,7 @@
              test-ns (str prefix ".test.core")
              project-clj (ns->path project-ns)]
          (spit (file project-dir ".gitignore")
-               (apply str (interleave ["pom.xml" "*jar" "lib" "classes"
+               (apply str (interleave ["pom.xml" "*jar" "/lib/" "/classes/"
                                        ".lein-deps-sum"]
                                       (repeat "\n"))))
          (write-implementation project-dir project-clj project-ns)


update protocol

update protocol

--- src/meta/promise.cljs
+++ src/meta/promise.cljs
@@ -18,11 +18,10 @@

 ;; Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn- promise-serial [current next]
-  (.then current
+  (then current
     (fn [data]
-      (.then (next)
-        (fn [result]
-          (cljs.core/conj data result))))))
+      (then (next)
+        (fn [result] (cljs.core/conj data result))))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; Promise API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -61,6 +60,14 @@
    (then (reduce promise-serial (resolve promise []) factories) into-array)))

 (extend-protocol IPromise
+  default
+  (then    [promise callback]   (then  (resolve promise) callback))
+  (catch   [promise callback]   (catch (resolve promise) callback))
+  (log     [promise]            (log   (resolve promise)))
+  (err     [promise]            (err   (resolve promise)))
+  (map     [promise func]       (map   (resolve promise) func))
+  (conj    [promise data]       (conj  (resolve promise) data))
+
   js/Promise
   (then    [promise callback]   (.then  promise callback))
   (catch   [promise callback]   (.catch promise callback))


Rename draw to draw-instrument

Rename draw to draw-instrument

--- src/musicbox/one.cljs
+++ src/musicbox/one.cljs
@@ -16,8 +16,6 @@
              {:light "#E18C43" :dark "#6B401C"}
              {:light "#E1B040" :dark "#69511A"}])

-
-(defn draw [draw-ctx instrument]
 (defn draw-start-screen [draw-ctx]
   (let [{w-window :w h-window :h} (util/get-window-size)
         w-text 200
@@ -29,6 +27,8 @@
                text
                (center-dimension w-window w-text)
                (center-dimension h-window h-text))))
+
+(defn draw-instrument [draw-ctx instrument]
   (let [{w :w h :h} instrument
         freqs (keys (:piano-keys instrument))
         note-count (count freqs)


fix updating asx prices

fix updating asx prices

--- src/notifier/core.clj
+++ src/notifier/core.clj
@@ -90,7 +90,7 @@
             (publish-event (str "ASX-" stock "-" pct) (str price)
                            (format "%+.1f%%" change)))
           (if-not (empty? changes)
-            (swap! asx-prices assoc stock (apply assoc event-prices (for[[pct _] changes] [pct price]))))
+            (swap! asx-prices assoc stock (reduce #(assoc %1 (first %2) price) event-prices  changes)))
           (if (empty? event-prices)
             (swap! asx-prices assoc stock (into {} (for [l percents] [l price])))))))))


a release

a release

--- src/ontrail/pages.clj
+++ src/ontrail/pages.clj
@@ -321,7 +321,7 @@
          (form-group "password" "Salasana" {:type "password"})
          [:button.btn.btn-default {:type "submit"} "Kirjaudu"]]]]]]])

-(def host "http://localhost:3000")
+(def host "http://ontrail.net")

 (defmacro require-auth [cookies form]
   `(if (and (auth/valid-auth-token? (:value (~cookies "authToken"))) (not= "nobody" (auth/user-from-cookie ~cookies)))


Revert "Add :x and :y to screen map when necessary"

This reverts commit 1c85268b955d4dce59274220a130af1ab5097f79.

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -61,19 +61,13 @@
   [screen screen-fn]
   (screen-fn))

-(defn ^:private add-coords
-  [{:keys [input-x input-y] :as screen}]
-  (if (and input-x input-y)
-    (merge screen (input->screen screen input-x input-y))
-    screen))
-
 (defn defscreen*
   [{:keys [screen entities
            on-show on-render on-hide on-pause on-resize on-resume on-timer]
     :as options}]
   (let [execute-fn! (fn [func & {:keys [] :as options}]
                       (when func
-                        (let [screen-map (add-coords (merge @screen options))
+                        (let [screen-map (merge @screen options)
                               old-entities @entities]
                           (some->> (with-meta
                                      #(normalize (func screen-map old-entities))


Fix local storage issue

Fix local storage issue

--- src/re_demo/core.cljs
+++ src/re_demo/core.cljs
@@ -107,7 +107,9 @@
 (defn main
   []
   (let [id-store        (local-storage (atom nil) ::id-store)
-        selected-tab-id (reagent/atom (if (nil? @id-store) (:id (first tabs-definition)) @id-store))   ;; id of the selected tab
+        selected-tab-id (reagent/atom (if (or (nil? @id-store) (nil? (util/item-for-id @id-store tabs-definition)))
+                                        (:id (first tabs-definition))
+                                        @id-store))   ;; id of the selected tab
         on-select-tab   #(do (reset! selected-tab-id %1)
                              (reset! id-store %1))]
     (fn ;; _main


Slash could be used in blacklist

Slash could be used in blacklist

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -135,7 +135,11 @@
         (->> (clojure.string/split input #"[\s,\n]")
              (filter seq))))

-(defn proper-word?
+(defn proper-word-for-blacklist?
+    [word]
+    (re-matches #"[A-Za-z0-9.'\-\s_/]+" word))
+
+(defn proper-word-for-whitelist?
     [word]
     (re-matches #"[A-Za-z0-9.'\-\s_]+" word))

@@ -144,7 +148,7 @@
     [request title emender-page mode]
     (let [word        (-> (:params request) (get "new-word") clojure.string/trim)
           description (-> (:params request) (get "description") clojure.string/trim)
-          proper-word (proper-word? word)
+          proper-word (proper-word-for-blacklist? word)
           user-name (get-user-name request)
           message   (add-word-message word proper-word)]
           (if (and proper-word (seq word))
@@ -155,7 +159,7 @@
     [request title emender-page mode]
     (let [input        (-> (:params request) (get "new-words"))
           words        (split-words input)
-          proper-words (filter proper-word? words)
+          proper-words (filter proper-word-for-whitelist? words)
           user-name    (get-user-name request)
           message      (add-words-message proper-words)]
           (if (seq proper-words)