Doc note to self; still need to write writers


Improve exception message when native-scsynth isn't available. Now prints out OS description.

--- src/overtone/sc/machinery/server/native.clj
+++ src/overtone/sc/machinery/server/native.clj
@@ -3,7 +3,7 @@
   (:require [overtone.jna-path]
             [overtone.at-at :as at-at])
   (:use [overtone.helpers.file :only [get-current-directory home-dir]]
-        [overtone.helpers.system :only [get-os get-cpu-bits windows-os?]]
+        [overtone.helpers.system :only [get-os get-cpu-bits windows-os? os-description]]
         [overtone.sc.machinery.server args]
         [overtone.sc.defaults :only [INTERNAL-POOL]]
         [overtone.nativescsynth.availability :only [native-scsynth-lib-availability]]
@@ -216,7 +216,7 @@
   ([recv-fn] (scsynth recv-fn {}))
   ([recv-fn options-map]
      (when (not (native-scsynth-available?))
-       (throw (Exception. "Can't connect to native server - no compatible libraries for your system are available.")))
+       (throw (Exception. (str "Can't connect to a native server - this version of Overtone does not yet have any compatible libraries for your system: " (os-description) ". Please consider contributing a build to the project."))))
      (let [options (byref world-options)
            cb      (callback reply-callback
                              (fn [addr msg-buf msg-size]


Review comments: lift (schema db) in a few places.

--- src/datomish/db.cljc
+++ src/datomish/db.cljc
@@ -120,12 +120,12 @@
   ;; TODO: use q for searching?  Have q use this for searching for a single pattern?
   (<eavt [db pattern]
     (let [[e a v] pattern
-          v (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
+          v       (and v (ds/->SQLite schema a v))] ;; We assume e and a are always given.
       (go-pair
         (->>
           {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
-           :from [:all_datoms]
-           :where (cons :and (map #(vector := %1 %2) [:e :a :v] (take-while (comp not nil?) [e a v])))} ;; Must drop nils.
+           :from   [:all_datoms]
+           :where  (cons :and (map #(vector := %1 %2) [:e :a :v] (take-while (comp not nil?) [e a v])))} ;; Must drop nils.
           (sql/format)

           (s/all-rows (:sqlite-connection db))
@@ -135,12 +135,12 @@

   (<avet [db pattern]
     (let [[a v] pattern
-          v (ds/->SQLite schema a v)]
+          v     (ds/->SQLite schema a v)]
       (go-pair
         (->>
           {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
-           :from [:all_datoms]
-           :where [:and [:= :a a] [:= :v v] [:= :index_avet 1]]}
+           :from   [:all_datoms]
+           :where  [:and [:= :a a] [:= :v v] [:= :index_avet 1]]}
           (sql/format)

           (s/all-rows (:sqlite-connection db))
@@ -150,13 +150,13 @@

   (<apply-datoms [db datoms]
     (go-pair
-      (let [exec (partial s/execute! (:sqlite-connection db))]
+      (let [exec   (partial s/execute! (:sqlite-connection db))
+            schema (.-schema db)] ;; TODO: understand why (schema db) fails.
         ;; TODO: batch insert, batch delete.
         (doseq [datom datoms]
           (let [[e a v tx added] datom
-                schema (.-schema db) ;; TODO: understand why (schema db) fails.
-                v (ds/->SQLite schema a v)
-                fulltext? (ds/fulltext? schema a)]
+                v                (ds/->SQLite schema a v)
+                fulltext?        (ds/fulltext? schema a)]
             ;; Append to transaction log.
             (<? (exec
                   ["INSERT INTO transactions VALUES (?, ?, ?, ?, ?)" e a v tx (if added 1 0)]))
@@ -798,8 +798,9 @@
   ;; TODO: constrain entities; constrain attributes.

   (go-pair
-    (doseq [[op e a v] (:entities report)]
-      (ds/ensure-valid-value (schema db) a v))
+    (let [schema (schema db)]
+      (doseq [[op e a v] (:entities report)]
+        (ds/ensure-valid-value schema a v)))
     report))

 (defn- <ensure-unique-constraints
@@ -813,12 +814,13 @@

   (go-pair
     ;; TODO: comment on applying datoms that violate uniqueness.
-    (let [unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
+    (let [schema (schema db)
+          unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
       (doseq [[e a v tx added :as datom] (:tx-data report)]

         (when added
           ;; Check for violated :db/unique constraint between datom and existing store.
-          (when (ds/unique? (schema db) a)
+          (when (ds/unique? schema a)
             (when-let [found (first (<? (<avet db [a v])))]
               (raise "Cannot add " datom " because of unique constraint: " found
                      {:error :transact/unique
@@ -826,7 +828,7 @@
                       :entity datom})))

           ;; Check for violated :db/unique constraint between datoms.
-          (when (ds/unique? (schema db) a)
+          (when (ds/unique? schema a)
             (let [key [nil a v]]
               (when-let [other (get unique-datoms key)]
                 (raise "Cannot add " datom " and " other " because together they violate unique constraint"
@@ -836,7 +838,7 @@
               (assoc! unique-datoms key datom)))

           ;; Check for violated :db/cardinality :db.cardinality/one constraint between datoms.
-          (when-not (ds/multival? (schema db) a)
+          (when-not (ds/multival? schema a)
             (let [key [e a nil]]
               (when-let [other (get unique-datoms key)]
                 (raise "Cannot add " datom " and " other " because together they violate cardinality constraint"
@@ -858,7 +860,8 @@
   {:pre [(db? db) (report? report)]}
   (go-pair
     (let [initial-report report
-          {tx :tx}       report]
+          {tx :tx}       report
+          schema         (schema db)]
       (loop [report initial-report
              es (:entities initial-report)]
         (let [[[op e a v :as entity] & entities] es]
@@ -867,7 +870,7 @@
             report

             (= op :db/add)
-            (if (ds/multival? (schema db) a)
+            (if (ds/multival? schema a)
               (if (empty? (<? (<eavt db [e a v])))
                 (recur (transact-report report (datom e a v tx true)) entities)
                 (recur report entities))


first cut of source mapping support for all REPLs

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -9,16 +9,19 @@
 (ns cljs.repl
   (:refer-clojure :exclude [load-file])
   (:require [clojure.java.io :as io]
+            [clojure.string :as string]
+            [clojure.data.json :as json]
+            [clojure.tools.reader :as reader]
+            [clojure.tools.reader.reader-types :as readers]
+            [clojure.stacktrace :as trace]
+            [clojure.repl :as cljrepl]
+            [cljs.util :as util]
             [cljs.compiler :as comp]
             [cljs.analyzer :as ana]
             [cljs.env :as env]
             [cljs.tagged-literals :as tags]
             [cljs.closure :as cljsc]
-            [cljs.source-map :as sm]
-            [clojure.tools.reader :as reader]
-            [clojure.tools.reader.reader-types :as readers]
-            [cljs.util :as util]
-            [clojure.stacktrace :as trace])
+            [cljs.source-map :as sm])
   (:import [java.io File PushbackReader]
            [javax.xml.bind DatatypeConverter]))

@@ -147,6 +150,66 @@
    (doseq [ns (distinct requires)]
      (load-namespace repl-env ns opts))))

+(defn read-source-map [f]
+  (sm/decode (json/read-str (slurp (io/file (str f ".map"))) :key-fn keyword)))
+
+(defn js-src->cljs-src [f]
+  (let [f (io/file f)
+        dir (.getParentFile f)
+        name (.getName f)]
+    (io/file dir (string/replace name ".js" ".cljs"))))
+
+(defn ns-info [f]
+  (ana/parse-ns (js-src->cljs-src f)))
+
+(defn mapped-line-and-column [source-map line column]
+  (let [default [line column]]
+    ;; source maps are 0 indexed for lines
+    (if-let [columns (get source-map (dec line))]
+      (vec
+        (map
+          ;; source maps are 0 indexed for columns
+          ;; multiple segments may exist at column
+          ;; just take first
+          (first
+            (if-let [mapping (get columns (dec column))]
+              mapping
+              (second (first columns))))
+          [:line :col]))
+      default)))
+
+(defn print-mapped-stacktrace [stacktrace]
+  (let [read-source-map' (memoize read-source-map)
+        ns-info' (memoize ns-info)]
+    (doseq [{:keys [function file line column] :as frame} stacktrace]
+      (let [[sm {:keys [ns source-file]}] ((juxt read-source-map' ns-info') file)
+            [line' column'] (mapped-line-and-column sm line column)
+            name' (if function
+                    (symbol (name ns) (cljrepl/demunge function))
+                    ns)]
+        (println (str name' " (" source-file ":" line' ":" column' ")"))))))
+
+(comment
+  (cljsc/build "samples/hello/src"
+    {:optimizations :none
+     :output-dir "samples/hello/out"
+     :output-to "samples/hello/out/hello.js"
+     :source-map true})
+
+  ;; line 2 column 1
+  (mapped-line-and-column
+    (read-source-map "samples/hello/out/hello/core.js") 2 1)
+
+  ;; hello.core
+  (:ns (ns-info "samples/hello/out/hello/core.js"))
+
+  (print-mapped-stacktrace
+    [{:file "samples/hello/out/hello/core.js"
+      :function "first"
+      :line 2
+      :column 1}])
+  )
+
 (defn- display-error
   ([ret form opts]
     (display-error ret form (constantly nil) opts))
@@ -156,7 +219,7 @@
     (when-let [st (:stacktrace ret)]
       (if (and (true? (:source-map opts))
                (vector? st))
-        (println st)
+        (print-mapped-stacktrace st)
         (println st))
       (flush))))


fix Parasite install from Personal Workshop

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -864,7 +864,15 @@
                (get-in @state [:runner :rig (to-keyword (:type card))]))]
     (some #(= (:title %) (:title card)) dest)))

-(defn host [state side card {:keys [zone cid] :as target}]
+(defn host [state side card {:keys [zone cid host] :as target}]
+  (doseq [s [:runner :corp]]
+    (if host
+      (when-let [host-card (some #(when (= (:cid host) (:cid %)) %)
+                                 (get-in @state (cons s (vec (map to-keyword (:zone host))))))]
+        (update! state side (update-in host-card [:hosted]
+                                       (fn [coll] (remove-once #(not= (:cid %) cid) coll)))))
+      (swap! state update-in (cons s (vec zone))
+             (fn [coll] (remove-once #(not= (:cid %) cid) coll)))))
   (swap! state update-in (cons side (vec zone)) (fn [coll] (remove-once #(not= (:cid %) cid) coll)))
   (let [c (assoc target :host (update-in card [:zone] #(map to-keyword %)))]
     (update! state side (update-in card [:hosted] #(conj % c)))


fix footer

fix footer

--- src/clj/hsm/views.clj
+++ src/clj/hsm/views.clj
@@ -162,24 +162,25 @@
          ]
          [:footer.container-fluid.footer
           [:div.col-lg-10.col-lg-offset-1
-          [:p "Designed, built and made in Amsterdam with all the love by " [:a {:href "http://twitter.com/bahadircambel"} "@bcambel"]]
-          [:p
-            "Running version  " [:a {:href (str "https://github.com/bcambel/hackersome/commit/" VERSION)} (str "@" SHORTVERSION)]]
-          [:p "Code licensed under " [:a {:href "https://github.com/bcambel/hackersome/blob/development/LICENSE"} :MIT]]
-          [:hr]
-          (when-not is-dev?
-          [:p
-            [:a.twitter-share-button {:href "https://twitter.com/share"
-              :data-text "Top Projects on"
-              :data-via "pythonhackers" :data-size :normal
-              } "Tell your friends"]
-            [:a.twitter-follow-button {:href "https://twitter.com/pythonhackers" :data-show-count true :data-size :normal }]]
-          [:hr]
-          [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=pythonhackers&type=watch&count=true&size=normal"
-                    :allowtransparency true :frameborder 0 :scroling 0 :width "120px" :height "30px"}]
-          [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=hackersome&type=watch&count=true&size=normal"
-                    :allowtransparency true :frameborder 0 :scroling 0 :width "260px" :height "30px"}])
-            ]
+            [:p "Designed, built and made in Amsterdam with all the love by " [:a {:href "http://twitter.com/bahadircambel"} "@bcambel"]]
+            [:p
+              "Running version  " [:a {:href (str "https://github.com/bcambel/hackersome/commit/" VERSION)} (str "@" SHORTVERSION)]]
+            [:p "Code licensed under " [:a {:href "https://github.com/bcambel/hackersome/blob/development/LICENSE"} :MIT]]
+            [:hr]
+            (when-not is-dev?
+              [:div
+                [:p
+                  [:a.twitter-share-button {:href "https://twitter.com/share"
+                    :data-text "Top Projects on"
+                    :data-via "pythonhackers" :data-size :normal
+                    } "Tell your friends"]
+                  [:a.twitter-follow-button {:href "https://twitter.com/pythonhackers" :data-show-count true :data-size :normal }]]
+                [:hr]
+                [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=pythonhackers&type=watch&count=true&size=normal"
+                          :allowtransparency true :frameborder 0 :scroling 0 :width "120px" :height "30px"}]
+                [:iframe {:src "http://ghbtns.com/github-btn.html?user=bcambel&repo=hackersome&type=watch&count=true&size=normal"
+                          :allowtransparency true :frameborder 0 :scroling 0 :width "260px" :height "30px"}]
+            ])]
          ]
         [:div#mc_embed_signup.modal.fade
           [:div.modal-dialog


Update core.cljs

Update core.cljs

--- src/cljs/ls/core.cljs
+++ src/cljs/ls/core.cljs
@@ -2,7 +2,7 @@
   (:require [reagent.core :as r]
             [soda-ash.core :as sa]))

-(enable-console-print!
+(enable-console-print!)

 ;; Let's see if we can trigger a proper deploy


Docstring tweak

Docstring tweak

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -567,7 +567,7 @@

 (defn resolve-short-string
   "Succeeds with a result Thing, mapping a short string as generated by
-  things/thing->short-string back to a thing via a datastore search."
+  grimoire.things/thing->short-string back to a thing via grimoire.api/search."
   [config s]
   {:pre [(string? s)]}
   (if-let [res (t/parse-short-string s)]


specify content-type of response message

--- src/herring/core.clj
+++ src/herring/core.clj
@@ -53,7 +53,8 @@
         (lb/publish ch
                     response-exchange
                     response-key
-                    response-payload)
+                    response-payload
+                    :content-type "application/json")
         (lb/ack ch delivery-tag))
     (do
       (comment "send back response specifying application/json")))))


Changed period outputs from sequential grouped lines to grouped timelines.

--- src/laskuri/core.clj
+++ src/laskuri/core.clj
@@ -22,9 +22,15 @@
   (format "%s\t%s" (string/join "\t" ks) (str v)))

 (defn format-kvs
-  "Format a Key, Value line into a tab separated string."
+  "Format a Key, Values line into a tab separated string."
   [[k vs]]
   (format "%s\t%s" k (string/join "\t" (flatten vs))))
+
+(defn format-ksvs
+  "Format a Keys, Value line into a tab separated string."
+  [[ks vs]]
+  (format "%s\t%s" (string/join "\t" (flatten ks)) (string/join "\t" (flatten vs))))
+

 (defn get-parsed-lines [ctx location redact?]
   "Get a new input stream of parsed lines."
@@ -144,33 +150,42 @@
         ;; outputs
         ;; these are sorted by their respective targets to make importing in bulk easier.

-        ; doi -> count per period
+        ; [doi period] -> count
         doi-period-count (count-by-key doi-period-date)
+
         ; sort by domain. Due to an unresolve scoping issue, this can't be extracted into a function yet.
-        doi-period-count (f/map (f/sort-by-key (f/map doi-period-count (f/fn [kv] [((fn [[[doi date] date]] doi) kv) kv]))) (f/fn [[_ v]] v))
-
+        doi-period-count (f/map doi-period-count (f/fn [[[doi date] cnt]]
+                                                       [doi [date cnt]]))
+
+        ; group by DOI. This gives a timeline per DOI.
+        doi-periods-count (f/group-by-key doi-period-count)

         ; domain -> count per period
         domain-period-count (count-by-key domain-period-date)
-        ; sort by host
-        domain-period-count (f/map (f/sort-by-key (f/map domain-period-count (f/fn [kv] [((fn [[[host domain date] date2]] host) kv) kv]))) (f/fn [[_ v]] v))
+        domain-period-count (f/map domain-period-count (f/fn [[[host domain date] cnt]]
+                                                           [host [date cnt]]))
+
+        ; group by domain. This gives a timeline per domain.
+        domain-periods-count (f/group-by-key domain-period-count)

         ; subdomain -> count per period
         subdomain-period-count (count-by-key subdomain-period-date)
-        ; sort by host
-        subdomain-period-count (f/map (f/sort-by-key (f/map subdomain-period-count (f/fn [kv] [((fn [[[host domain] date2]] host) kv) kv]))) (f/fn [[_ v]] v))
-
+        subdomain-period-count (f/map subdomain-period-count (f/fn [[[host domain date] cnt]]
+                                                                     [[host domain] [date cnt]]))
+        subdomain-periods-count (f/group-by-key subdomain-period-count)
+
+
         ; period -> [[host, count]]
-        period-domains-count (f/group-by-key (f/map domain-period-count (f/fn [[[host domain date] cnt]] [date [host cnt]])))
-
-        ; sort domains in memory
-        ; period -> [[host, count]] sorted and limited
-        period-domains-sorted (f/map period-domains-count (f/fn [[date items]] [date (take 100 (reverse (sort-by second items)))]))]
+        period-domain-count (f/map domain-period-count (f/fn [[host [date cnt]]] [date [host cnt]]))
+
+        ; group by period
+        period-domains-count (f/group-by-key period-domain-count)
+        period-domains-count-sorted (f/map period-domains-count (f/fn [[date items]] [date (take 100 (reverse (sort-by second items)))]))]

-    (.saveAsTextFile (f/map period-domains-sorted format-kvs) (str output-location "/" (name period) "-top-domains"))
-    (.saveAsTextFile (f/map doi-period-count format-ksv) (str output-location "/" (name period) "-doi-period-count"))
-    (.saveAsTextFile (f/map domain-period-count format-ksv) (str output-location "/" (name period) "-domain-period-count"))
-    (.saveAsTextFile (f/map subdomain-period-count format-ksv) (str output-location "/" (name period) "-subdomain-period-count"))))
+      (.saveAsTextFile (f/map doi-periods-count format-kvs) (str output-location "/" (name period) "-doi-periods-count"))
+      (.saveAsTextFile (f/map domain-periods-count format-kvs) (str output-location "/" (name period) "-domain-periods-count"))
+      (.saveAsTextFile (f/map subdomain-periods-count format-ksvs) (str output-location "/" (name period) "-subdomain-periods-count"))
+      (.saveAsTextFile (f/map period-domains-count-sorted format-kvs) (str output-location "/" (name period) "-top-domains"))))

 (defn -main
   [& args]


Patch in a sync version of run-async!

Patch in a sync version of run-async!

This avoids blowing out the stack when
loading deps.

Fixes #410

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -1071,28 +1071,27 @@
         (-> (r/read {:read-cond :allow :features #{:cljs}} rdr)
           meta :source)))))

-(defn- run-async!
-  "Like cljs.core/run!, but for an async procedure, and with the
-  ability to break prior to processing the entire collection.
-
-  Chains successive calls to the supplied procedure for items in
-  the collection. The procedure should accept an item from the
-  collection and a callback of one argument. If the break? predicate,
-  when applied to the procedure callback value, yields a truthy
-  result, terminates early calling the supplied cb with the callback
-  value. Otherwise, when complete, calls cb with nil."
+(defn- run-sync!
+  "Like cljs.js/run-async!, but with the expectation that cb will be called
+  synchronously within proc. When callbacks are done synchronously, run-async!
+  ends up growing the stack as coll is processed, while this implementation
+  employs recur."
   [proc coll break? cb]
-  (if (seq coll)
-    (proc (first coll)
-      (fn [res]
-        (if (break? res)
-          (cb res)
-          (run-async! proc (rest coll) break? cb))))
-    (cb nil)))
+  (loop [coll coll]
+    (if (seq coll)
+      (let [cb-val (atom nil)]
+        (proc (first coll) #(reset! cb-val %))
+        (if (break? @cb-val)
+          (cb @cb-val)
+          (recur (rest coll))))
+      (cb nil))))
+
+; Monkey-patch cljs.js/run-async! to instead be our more stack-efficient run-sync!
+(set! cljs/run-async! run-sync!)

 (defn- process-deps
   [names opts cb]
-  (run-async! (fn [name cb]
+  (run-sync! (fn [name cb]
                 (cljs/require name opts cb))
     names
     :error


Pass the name of the manifest member to the audio encoder

not the path to the file set directory

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -92,8 +92,10 @@
 (defn encode-production
   "Encode a production, i.e. convert the wav files to mp3"
   [{:keys [path] :as production}]
-  (let [tmp-path (.getPath (fs/temp-dir "mdr2"))]
-    (pipeline/audio-encoder {:input path :output tmp-path})
+  (let [tmp-path (.getPath (fs/temp-dir "mdr2"))
+        ;; FIXME: it might be better to allow for different manifest names
+        manifest (.getPath (file path "package.opf"))]
+    (pipeline/audio-encoder {:input manifest :output tmp-path})
     (assoc production :encoded-path tmp-path)))

 (defn create-iso


first cut at scoring and ranking books

first cut at scoring and ranking books

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -311,5 +311,58 @@
                                   user-id)]
     (->> friends
          (map #(get-book-rating consumer access-token
-                                (:id %) book-id))
-         (filter identity))))
+                                (:id %) book-id)))))
+
+(defn compute-book-score
+  [book-info friend-ratings]
+  (let [avg-rating (Float/parseFloat (:average_rating book-info))
+        pub-date (Integer/parseInt (:publication_year book-info))
+        pub-distance (/ 1 (- 2017 pub-date))
+        num-ratings (Integer/parseInt (:ratings_count book-info))
+        num-text-ratings (Integer/parseInt (:text_reviews_count
+                                            book-info))
+        text-to-num-ratio (/ num-text-ratings num-ratings)
+        filtered-ratings (->> friend-ratings
+                              (filter identity)
+                              (map #(Integer/parseInt %))
+                              (filter #(> % 0)))
+        num-friend-ratings (count filtered-ratings)]
+    (if (> num-friend-ratings 0)
+      (* avg-rating
+         pub-distance
+         text-to-num-ratio
+         (/ (apply + filtered-ratings)
+            num-friend-ratings))
+      (* avg-rating pub-distance text-to-num-ratio))))
+
+(defn find-book-and-score
+  [consumer access-token user-id title]
+  (let [book (first (find-book-on-shelves consumer
+                                          access-token
+                                          user-id
+                                          title))
+        friend-ratings (get-friend-ratings-for-book consumer
+                                                    access-token
+                                                    user-id
+                                                    (:id book))]
+    (compute-book-score book friend-ratings)))
+
+(defn score-books-on-shelf
+  [consumer access-token user-id shelf]
+  (let [books (get-books-on-shelf consumer access-token
+                                   user-id shelf)]
+    (for [book books]
+      (let [ratings (get-friend-ratings-for-book consumer
+                                                 access-token
+                                                 user-id
+                                                 (:id book))]
+        (merge book
+               {:score (compute-book-score book ratings)})))))
+
+(defn rank-books-on-shelf
+  [consumer access-token user-id shelf]
+  (let [scored-books (score-books-on-shelf consumer access-token
+                                           user-id shelf)]
+    (->> scored-books
+         (sort-by :score >)
+         (map (juxt :id :title (comp :name :author :authors))))))


[Issue-10] Use new auth functions. Add build-url fn.

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -1,106 +1,21 @@
 (ns myshelf.core
-  (:require [clj-http.client :as http]
-            [clj-time.core :as t]
-            [clojure.data.xml :as xml]
-            [clojure.java.io :refer [input-stream]]
-            [oauth.client :as oauth]))
-
-(def goodreads-request-token-url
-  "http://www.goodreads.com/oauth/request_token")
-(def goodreads-authorize-url
-  "http://www.goodreads.com/oauth/authorize")
-(def goodreads-access-token-url
-  "http://www.goodreads.com/oauth/access_token")
-(def goodreads-base-url "http://goodreads.com/")
+  (:require [clj-time.core :as t]
+            [clojure.string :as str]
+            [myshelf.auth :refer [make-auth-request-GET
+                                  make-auth-request-POST
+                                  make-auth-request-PUT]]))
+
+(def goodreads-base-url "https://www.goodreads.com")
 (def goodreads-crypto-default :hmac-sha1)

-(defn get-consumer
-  "Get an API consumer for Goodreads"
-  [key secret]
-  (oauth/make-consumer key
-                       secret
-                       goodreads-request-token-url
-                       goodreads-access-token-url
-                       goodreads-authorize-url
-                       :hmac-sha1))
-
-(defn get-request-token
-  "Get a Goodreads request token for a particular application"
-  [consumer]
-  (oauth/request-token consumer))
-
-(defn find-approval-uri
-  "Fetch the uri to be opened in a browser for the user to grant approval
-  to this application"
-  [consumer request-token]
-  (oauth/user-approval-uri consumer
-                           (:oauth_token request-token)))
-
-(defn get-access-token
-  "Once access has been granted, fetch an access token for using the API"
-  [consumer request-token]
-  (oauth/access-token consumer request-token))
-
-(defn make-auth-request-GET
-  [consumer access-token url params]
-    (let [{:keys [oauth_token oauth_token_secret]} access-token
-        credentials (oauth/credentials consumer
-                                       oauth_token
-                                       oauth_token_secret
-                                       :GET
-                                       url
-                                       params)]
-      (xml/parse-str
-       (:body
-        (http/get url
-                  {:query-params (merge credentials
-                                        params)})))))
-
-(defn make-auth-request-POST
-  [consumer access-token url params]
-    (let [{:keys [oauth_token oauth_token_secret]} access-token
-        credentials (oauth/credentials consumer
-                                       oauth_token
-                                       oauth_token_secret
-                                       :POST
-                                       url
-                                       params)
-          resp (http/post url
-                          {:query-params (merge credentials
-                                                params)})]
-      (when (= 201 (:status resp))
-        (xml/parse-str (:body resp)))))
-
-(defn make-auth-request-PUT
-  [consumer access-token url params]
-    (let [{:keys [oauth_token oauth_token_secret]} access-token
-        credentials (oauth/credentials consumer
-                                       oauth_token
-                                       oauth_token_secret
-                                       :PUT
-                                       url
-                                       params)]
-      (http/put url
-                {:query-params (merge credentials
-                                      params)})))
-
-(defn make-auth-request-DELETE
-  [consumer access-token url params]
-    (let [{:keys [oauth_token oauth_token_secret]} access-token
-        credentials (oauth/credentials consumer
-                                       oauth_token
-                                       oauth_token_secret
-                                       :DELETE
-                                       url
-                                       params)]
-      (http/delete url
-                   {:query-params (merge credentials
-                                         params)})))
+(defn build-url
+  [& parts]
+  (str/join "/" (apply conj [goodreads-base-url] parts)))

 (defn get-user-id
   "Fetch the Goodreads user id for the user that has granted access"
   [consumer access-token]
-  (let [user-id-url "https://www.goodreads.com/api/auth_user"
+  (let [user-id-url (build-url "api" "auth_user")
         resp (make-auth-request-GET consumer
                                     access-token
                                     user-id-url
@@ -137,8 +52,7 @@
   "Returns list of hashmaps representing the books on a given
   user's bookshelf"
   [consumer access-token user-id shelf & {:keys [query page per-page]}]
-  (let [shelf-url (str "https://www.goodreads.com/review/list/"
-                       user-id)
+  (let [shelf-url (build-url "review" "list" user-id)
         params (merge {:shelf shelf :format "xml" :v 2}
                       (when query
                         {(keyword "search[query]")
@@ -176,7 +90,7 @@
   "Runs a query for a book by title. Returns only the last
   20 results."
   [consumer access-token title]
-  (let [search-url "https://www.goodreads.com/search/index"
+  (let [search-url (build-url "search" "index")
         params {:q title
                 :format "xml"
                 :field "title"}
@@ -198,7 +112,7 @@
   "Runs a query for a book by title and author.
   Returns only the last 20 results."
   [consumer access-token title author]
-  (let [search-url "https://www.goodreads.com/search/index"
+  (let [search-url (build-url "search" "index")
         params {:q (str title " " author)
                 :format "xml"}
         resp (make-auth-request-GET consumer
@@ -218,8 +132,7 @@
 (defn find-book-on-shelves
   "Try to find a book on a user's shelves, given book title"
   [consumer access-token user-id title]
-  (let [shelf-url (str "https://www.goodreads.com/review/list/"
-                       user-id)
+  (let [shelf-url (build-url "review" "list" user-id)
         params {:format "xml" :v 2 (keyword "search[query]") title}
         resp (make-auth-request-GET consumer
                                     access-token
@@ -233,8 +146,8 @@

 (defn get-book-review
   [consumer access-token user-id book-id]
-  (let [review-url (str "https://www.goodreads.com/"
-                        "review/show_by_user_and_book.xml")
+  (let [review-url (build-url "review"
+                              "show_by_user_and_book.xml")
         params {:user_id user-id
                 :book_id book-id}
         resp (make-auth-request-GET consumer
@@ -260,7 +173,7 @@
 (defn add-book-review
   "Add a book review. Automatically adds book to read shelf."
   [consumer access-token book-id rating & [review-text]]
-  (let [review-url "https://www.goodreads.com/review"
+  (let [review-url (build-url "review")
         params (merge {:format "xml"
                        :book_id book-id
                        (keyword "review[rating") rating
@@ -286,9 +199,7 @@
   "Edit a book review. Automatically sets book to finished
   and adds it to the read shelf, if it wasn't already there."
   [consumer access-token review-id new-rating & [review-text]]
-  (let [review-url (str "https://www.goodreads.com/review/"
-                        review-id
-                        ".xml")
+  (let [review-url (build-url "review" (str review-id ".xml"))
         params (merge {:id review-id
                        (keyword "review[rating]") new-rating
                        :finished true
@@ -302,7 +213,7 @@

 (defn add-book-to-shelf
   [consumer access-token book-id shelf]
-  (let [add-url "https://www.goodreads.com/shelf/add_to_shelf.xml"
+  (let [add-url (build-url "shelf" "add_to_shelf.xml")
         params {:name shelf
                 :book_id book-id}]
     (make-auth-request-POST consumer
@@ -312,7 +223,7 @@

 (defn get-user-friends
   [consumer access-token user-id]
-  (let [friends-url "https://www.goodreads.com/friend/user.xml"
+  (let [friends-url (build-url "friend" "user.xml")
         params {:id user-id}
         resp (make-auth-request-GET consumer
                                     access-token


snapshot

snapshot

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -72,7 +72,6 @@
   []
   (com.aldebaran.qimessaging.Application.))

-; java function to wait on the future?
 (defn make-session
   "Create a session connected to a robot"
   [hostname port]
@@ -107,10 +106,7 @@
   [robot proxy-sym operation params]
   (.call (get-proxy robot proxy-sym) operation (into-array params)))

-;; (defn make-variant
-;;   "Make instance of Aldebaran ALValue (Variant in java)"
-;;   [val]
-;;   (new com.aldebaran.proxy.Variant val))
+; event handling

 ; behaviour management
 (defn get-installed-behaviours


a release

a release

--- src/ontrail/keen.clj
+++ src/ontrail/keen.clj
@@ -48,7 +48,6 @@
           json/read-str
           walk/keywordize-keys))
     (catch Exception ex
-      (prn ex)
       {:result 0})))

 (defn group-by-eid []
@@ -69,12 +68,13 @@
   (System/currentTimeMillis))

 (defn get-agent [id]
-  (dosync
-   (if-let [c (@agents id)]
-     c
-     (do
-       (alter expires assoc id 0)
-       ((alter agents assoc id (agent (count-by-id id))) id)))))
+  (let [initial-value (count-by-id id)]
+    (dosync
+     (if-let [c (@agents id)]
+       c
+       (do
+         (alter expires assoc id 0)
+         ((alter agents assoc id (agent initial-value)) id))))))

 (defn update [state blocking-fn]
   (blocking-fn))


Remove unused vars

Remove unused vars

--- src/expenses/card.clj
+++ src/expenses/card.clj
@@ -1,7 +1,9 @@
 (ns expenses.card
   (:require [expenses.financial-record :refer :all]
             [ofx-clj.core :as ofx]
-            [clj-time.coerce :as c]) (:import [net.sf.ofx4j.domain.data.creditcard CreditCardResponseMessageSet CreditCardStatementResponseTransaction
+            [clj-time.coerce :as c])
+  (:import [net.sf.ofx4j.domain.data.creditcard CreditCardResponseMessageSet
+                                                CreditCardStatementResponseTransaction
                                                 CreditCardStatementResponse]))

 (defmethod ofx/parse-data CreditCardResponseMessageSet
@@ -28,8 +30,6 @@
                   :response-message-name .getResponseMessageName
                   :transaction-list [.getTransactionList ofx/parse-data]))

-(def the-file "resources/card/faturaCartao.ofx")
-
 (defn parse-file [file]
   (ofx/parse file))


[#phase-2] Don't run if no file is passed.

This was probably a problem in phase-1 and would need to be cherry
picked onto that branch to make it work. Always run a full test suite
before merging a PR. Where is safebot when I need him...

--- src/paceout/main.clj
+++ src/paceout/main.clj
@@ -57,15 +57,17 @@
 (defn -main [& args]
   ;; options are parsed :in-order so we handle help first
   (let [{:keys [options arguments errors summary]}
-        (cli/parse-opts args cli-options :in-order true)]
+        (cli/parse-opts args cli-options :in-order true)
+        input-filename (first arguments)]
     (cond
      (:help options) (exit 0 (usage summary))
      errors (exit 1 (error-msg errors))
      (= 0 (count arguments)) (exit 1 (usage summary)))

-    (with-open [in (get-reader (first arguments))
-                out (get-writer)]
-      (try
-        (parser/parse-account-numbers in out)
-        (catch Exception ex
-          (println "Error when parsing: "(.getMessage ex)))))))
+    (when input-filename
+          (with-open [in (get-reader input-filename)
+                      out (get-writer)]
+            (try
+              (parser/parse-account-numbers in out)
+              (catch Exception ex
+                (println "Error when parsing: " (.getMessage ex))))))))


Bring back the old munge function

Bring back the old munge function

--- src/grimoire/util.clj
+++ src/grimoire/util.clj
@@ -10,14 +10,11 @@
   symbols. Namespaces, packages, groups and soforth need not be name munged."
   [s]
   (-> s
-      (str/replace "_"     "_USCORE")
-      (str/replace "DOT"   "\\DOT")
-      (str/replace "SLASH" "\\SLASH")
-      (str/replace "QMARK" "\\QMARK")
-      (str/replace "?"     "_QMARK")
-      (str/replace "."     "_DOT")
-      (str/replace "/"     "_SLASH")
-      (str/replace #"_*$"  "")))
+    (str/replace "?" "_QMARK_")
+    (str/replace "." "_DOT_")
+    (str/replace "/" "_SLASH_")
+    (str/replace #"^_*" "")
+    (str/replace #"_*$" "")))

 (defn update-munge
   "This function attempts to transform the legacy (Grimoire 0.2.X, 0.1.X)
@@ -25,24 +22,9 @@
   _not_ and unmunge operation."
   [s]
   (-> s
-      (str/replace #"_?DASH_?" "-")
-      (str/replace #"_?BANG_?" "!")
-      (str/replace #"_?STAR_?" "*")
-      (str/replace #"_?EQ_?"   "=")
-      (str/replace #"_?LT_?"   "<")
-      (str/replace #"_?GT_?"   ">")))
-
-(defn demunge
-  "This function attempts to transform both modern and legacy Grimoire
-  munged strings back to their original form. As the transformation is
-  entirely regular, this should be a safe round trip operation but be
-  careful."
-  [s]
-  (-> s
-      (str/replace "\\DOT"    "DOT")
-      (str/replace "\\SLASH"  "SLASH")
-      (str/replace "\\QMARK"  "QMARK")
-      (str/replace #"_USCORE" "_")
-      (str/replace #"_QMARK"  "?")
-      (str/replace #"_DOT"    ".")
-      (str/replace #"_SLASH"  "/")))
+    (str/replace #"_?DASH_?" "-")
+    (str/replace #"_?BANG_?" "!")
+    (str/replace #"_?STAR_?" "*")
+    (str/replace #"_?EQ_?" "=")
+    (str/replace #"_?LT_?" "<")
+    (str/replace #"_?GT_?" ">")))


Don't dismiss keyboard on command input appear

Former-commit-id: 49b08e51181249addc5f50f0d0d866836f8e1944

--- src/status_im/chat/views/plain_input.cljs
+++ src/status_im/chat/views/plain_input.cljs
@@ -4,7 +4,8 @@
             [status-im.components.react :refer [view
                                                 icon
                                                 touchable-highlight
-                                                text-input]]
+                                                text-input
+                                                dismiss-keyboard!]]
             [status-im.chat.views.suggestions :refer [suggestions-view]]
             [status-im.chat.views.content-suggestions :refer [content-suggestions-view]]
             [status-im.chat.views.command :as command]
@@ -14,7 +15,9 @@
 (defn set-input-message [message]
   (dispatch [:set-chat-input-text message]))

-(defn send []
+(defn send [dismiss-keyboard]
+  (when dismiss-keyboard
+    (dismiss-keyboard!))
   (dispatch [:send-chat-msg]))

 (defn message-valid? [staged-commands message]
@@ -22,9 +25,9 @@
            (not= "!" message))
       (pos? (count staged-commands))))

-(defn try-send [staged-commands message]
+(defn try-send [staged-commands message dismiss-keyboard]
   (when (message-valid? staged-commands message)
-    (send)))
+    (send dismiss-keyboard)))

 (defn plain-message-input-view [{:keys [command input-options validator]}]
   (let [input-message (subscribe [:get-chat-input-text])
@@ -32,46 +35,51 @@
         staged-commands (subscribe [:get-chat-staged-commands])
         typing-command? (subscribe [:typing-command?])]
     (fn [{:keys [command input-options validator]}]
-      [view st/input-container
-       (if command
-         [content-suggestions-view]
-         [suggestions-view])
-       [view st/input-view
-        (if command
-          [command/command-icon command]
-          [touchable-highlight {:on-press #(dispatch [:switch-command-suggestions])
-                                :style    st/switch-commands-touchable}
-           [view nil
-            (if @typing-command?
-              [icon :close-gray st/close-icon]
-              [icon :list st/list-icon])]])
-        [text-input (merge {:style           (if command st-command/command-input st/message-input) ;; st-command/command-input
-                            :autoFocus       false
-                            :onChangeText    (fn [text]
-                                               ((if command
-                                                  command/set-input-message
-                                                  set-input-message)
-                                                 text))
-                            :onSubmitEditing (fn []
-                                               (if command
-                                                 (command/try-send @input-command validator)
-                                                 (try-send @staged-commands
-                                                           @input-message)))}
-                           input-options)
+      (let [dismiss-keyboard (not (or command @typing-command?))]
+        [view st/input-container
          (if command
-           @input-command
-           @input-message)]
-        ;; TODO emoticons: not implemented
-        (when (not command)
-          [icon :smile st/smile-icon])
-        (if command
-          (if (command/valid? @input-command validator)
-            [touchable-highlight {:on-press command/send-command}
-             [view st/send-container [icon :send st/send-icon]]]
-            [touchable-highlight {:on-press command/cancel-command-input}
-             [view st-command/cancel-container
-              [icon :close-gray st-command/cancel-icon]]])
-          (when (message-valid? @staged-commands @input-message)
-            [touchable-highlight {:on-press send}
-             [view st/send-container
-              [icon :send st/send-icon]]]))]])))
+           [content-suggestions-view]
+           [suggestions-view])
+         [view st/input-view
+          (if command
+            [command/command-icon command]
+            [touchable-highlight {:on-press #(dispatch [:switch-command-suggestions])
+                                  :style    st/switch-commands-touchable}
+             [view nil
+              (if @typing-command?
+                [icon :close-gray st/close-icon]
+                [icon :list st/list-icon])]])
+          [text-input (merge {:style           (if command st-command/command-input st/message-input) ;; st-command/command-input
+                              :autoFocus       false
+                              :blurOnSubmit    dismiss-keyboard
+                              :onChangeText    (fn [text]
+                                                 ((if command
+                                                    command/set-input-message
+                                                    set-input-message)
+                                                   text))
+                              :onSubmitEditing (fn []
+                                                 (if command
+                                                   (command/try-send @input-command validator)
+                                                   (try-send @staged-commands
+                                                             @input-message
+                                                             dismiss-keyboard)))}
+                             input-options)
+           (if command
+             @input-command
+             @input-message)]
+          ;; TODO emoticons: not implemented
+          (when (not command)
+            [icon :smile st/smile-icon])
+          (if command
+            (if (command/valid? @input-command validator)
+              [touchable-highlight {:on-press command/send-command}
+               [view st/send-container [icon :send st/send-icon]]]
+              [touchable-highlight {:on-press command/cancel-command-input}
+               [view st-command/cancel-container
+                [icon :close-gray st-command/cancel-icon]]])
+            (when (message-valid? @staged-commands @input-message)
+              [touchable-highlight {:on-press #(try-send @staged-commands
+                                                         @input-message
+                                                         dismiss-keyboard)}
+               [view st/send-container
+                [icon :send st/send-icon]]]))]]))))


Disable spinner when generating multiaccount

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/ui/screens/intro/views.cljs
+++ src/status_im/ui/screens/intro/views.cljs
@@ -529,8 +529,9 @@
      [toolbar/toolbar
       {:style {:border-bottom-width 0
                :margin-top 16}}
-      (toolbar/nav-button
-       (actions/back #(re-frame/dispatch [:intro-wizard/navigate-back])))
+      (when-not (:processing? wizard-state)
+        (toolbar/nav-button
+         (actions/back #(re-frame/dispatch [:intro-wizard/navigate-back]))))
       nil]
      [react/view {:style {:flex 1
                           :justify-content :space-between}}


WIP - typo

WIP
- typo

--- src/re_com/list.cljs
+++ src/re_com/list.cljs
@@ -100,7 +100,7 @@
     :label-fn      ; optional function to call on element to get label string, default :label
     :width         ; optional CSS style value e.g. "250px"
     :height        ; optional CSS style value e.g. "150px"
-    :max-height    ; optional CSS style value e.g. "150px" Height will shring/grow based on elements up to this, then scroll
+    :max-height    ; optional CSS style value e.g. "150px" Height will shrink/grow based on elements up to this, then scroll
     })

 (defn inline-list


added debug to test travis

added debug to test travis

--- src/test/clojure/czlab/test/twisty/test.clj
+++ src/test/clojure/czlab/test/twisty/test.clj
@@ -72,6 +72,9 @@
 ;;
 (deftest czlabtesttwisty-test

+(println
+    "related to: checking content-type")
+
   (testing
     "related to: checking content-type"
     (is (t/isSigned? "application/x-pkcs7-mime; signed-data"))
@@ -94,6 +97,9 @@

   (is (not= (t/alias<>)(t/alias<>)))
   (is (string? (t/alias<>)))
+
+(println
+    "related to: crypto stores")

   (testing
     "related to: crypto stores"
@@ -133,6 +139,9 @@

   (is (some? (t/easyPolicy<>)))

+(println
+    "related to: mac & hash")
+
   (testing
     "related to: mac & hash"
     (is (= (t/genMac b-key "hello world")
@@ -146,6 +155,9 @@

     (is (not= (t/genDigest "hello maria")
               (t/genDigest "hello world"))))
+
+(println
+    "related to: keypairs")

   (testing
     "related to: keypairs"
@@ -159,6 +171,9 @@
                (s/hgl? (c/strit b1))
                (s/hgl? (c/strit b2))))))

+(println
+    "related to: cert service request")
+
   (testing
     "related to: cert service request"
     (is (let [[a b]
@@ -183,6 +198,9 @@

   (is (some? (t/getCharset "text/plain; charset=utf-16")))

+(println
+    "related to: msg digest")
+
   (testing
     "related to: msg digest"
     (is (not= (t/fingerprint (c/bytesit "hello world") :sha-1)
@@ -201,6 +219,9 @@
         (and c g ok?)))

   (is (some? (ss/simpleTrustMgr<>)))
+
+(println
+    "related to: caesar crypto")

   (testing
     "related to: caesar crypto"
@@ -226,6 +247,8 @@
                        13
                        (.encrypt c
                                  13 "heeloo, how are you?"))))))
+(println
+    "related to: jasypt crypto")

   (testing
     "related to: jasypt crypto"
@@ -241,6 +264,8 @@
              (.decrypt c
                        pkey
                        (.encrypt c pkey "heeloo"))))))
+(println
+    "related to: java crypto")

   (testing
     "related to: java crypto"
@@ -255,6 +280,9 @@
                  pkey (c/bytesit (String. test-pwd))]
              (c/strit (.decrypt c
                                 pkey (.encrypt c pkey "heeloo")))))))
+
+(println
+    "related to: bouncycastle crypto")

   (testing
     "related to: bouncycastle crypto"
@@ -278,6 +306,8 @@
                                 pv
                                 (.encrypt cc
                                           pu (c/bytesit "heeloo"))))))))
+(println
+    "related to: passwords")

   (testing
     "related to: passwords"
@@ -291,6 +321,9 @@

     (is (= "hello joe!"
            (cc/stringify (cc/pwd<> (cc/p-encoded (cc/pwd<> "hello joe!")))))))
+
+(println
+    "related to: keystores")

   (testing
     "related to: keystores"


riemann.core: index wrapper does pubsub in index/update now.

Deprecates update-index; since that's now handled by the index protocol
directly.

--- src/riemann/core.clj
+++ src/riemann/core.clj
@@ -1,7 +1,7 @@
 (ns riemann.core
   "Binds together an index, servers, and streams."
   (:use [riemann.time :only [unix-time]]
-        [riemann.common :only [localhost event]]
+        [riemann.common :only [deprecated localhost event]]
         clojure.tools.logging
         [riemann.instrumentation :only [Instrumented]])
   (:require riemann.streams
@@ -173,12 +173,11 @@
   (info "Hyperspace core shut down"))

 (defn update-index
-  "Updates this core's index with an event. Also publishes to the index pubsub
-  channel."
+  "Updates this core's index with an event."
   [core event]
-  (when ((:index core) event)
-    (when-let [registry (:pubsub core)]
-      (ps/publish! registry "index" event))))
+  (deprecated "update-index is redundant; wrap-index provides pubsub
+              integration now."
+              ((:index core) event)))

 (defn wrap-index
   "Yield a wrapper to an index, exposing the same protocols as well
@@ -204,7 +203,9 @@
        (search [this query-ast]
          (index/search source query-ast))
        (update [this event]
-         (index/update source event))
+         (index/update source event)
+         (when registry
+           (ps/publish! registry "index" event)))
        (lookup [this host service]
          (index/lookup source host service))

@@ -228,9 +229,7 @@

        clojure.lang.IFn
        (invoke [this event]
-         (index/update source event)
-         (when registry
-           (ps/publish! registry "index" event))))))
+         (index/update this event)))))

 (defn delete-from-index


reverted a hardcoded made up env in core

--- src/frontend/core.clj
+++ src/frontend/core.clj
@@ -63,7 +63,7 @@
 (defn wrap-hosted-scripts
   "Redirects to the canonical url for a hosted script if we're using stefon in development mode."
   [handler stefon-options hosted-scripts]
-  (if (not= (:mode stefon-options) :REMEBER-TO-REVERT-THIS-TO-development)
+  (if (not= (:mode stefon-options) :development)
     handler
     (stefon.settings/with-options stefon-options
       (let [paths (set (map :path hosted-scripts))]


Suggested refactor.

Suggested refactor.

--- src/cljs/wombats_web_client/components/countdown_timer.cljs
+++ src/cljs/wombats_web_client/components/countdown_timer.cljs
@@ -2,17 +2,29 @@
   (:require [cljs-time.core :as t]
             [reagent.core :as reagent]))

+(defn- before-now?
+  "Returns a boolean whether time is in the past"
+  [time]
+  (or (nil? time)
+      (t/after? (t/now)
+                time)))
+
+(defn- interval-from-now
+  [time]
+  (t/interval (t/now)
+              time))
+
 (defn- seconds-until
   [time]
-  (if (or (nil? time) (t/after? (t/now) time))
+  (if (before-now? time)
     0
-    (t/in-seconds (t/interval (t/now) time))))
+    (t/in-seconds (interval-from-now time))))

 (defn- millis-until
   [time]
-  (if (or (nil? time) (t/after? (t/now) time))
+  (if (before-now? time)
     0
-    (mod (t/in-millis (t/interval (t/now) time))
+    (mod (t/in-millis (interval-from-now time))
          1000)))

 (defn- format-time


Add method argument if request key is specified

--- src/googlica/core.clj
+++ src/googlica/core.clj
@@ -69,13 +69,20 @@

 (defn generate-args
   "Given a list of parameter maps and the parameterOrder vector,
-  generates the arguments vector."
-  [parameters parameterOrder]
+  generates the arguments vector.
+  If the request is not nil, then the method also takes a request object,
+  that gets specified as the first parameter."
+  [parameters parameterOrder request]
   (let [[required optional] (->> parameters
                                  split-required-params
                                  (mapv (comp (partial mapv ->kebab-case-symbol) keys)))
         ;; parameterOrder also contains the required params, so we get them from there
-        required (mapv ->kebab-case-symbol parameterOrder)]
+        required (mapv ->kebab-case-symbol parameterOrder)
+        request-sym (when request
+                      (->kebab-case-symbol (get request :$ref)))
+        required (if request-sym
+                   (cons request-sym required)
+                   required)]
     `[~@required ~(hash-map :keys optional :as 'optional-params)]))

 (defn template->path-vector
@@ -132,10 +139,10 @@

 (defn generate-function-from-method
-  [{:keys [id httpMethod parameters path parameterOrder] :as method}]
+  [{:keys [id httpMethod parameters path parameterOrder request] :as method}]
   `(~'defn ~(generate-function-name id)
      ~(generate-docs method)
-     ~(generate-args parameters parameterOrder)
+     ~(generate-args parameters parameterOrder request)
      (http/request ~(generate-request httpMethod path parameters))))

 (defn generate-ns-file


Add succeed/fail to util

Add succeed/fail to util

--- src/grimoire/util.clj
+++ src/grimoire/util.clj
@@ -28,3 +28,17 @@
     (str/replace #"_?EQ_?" "=")
     (str/replace #"_?LT_?" "<")
     (str/replace #"_?GT_?" ">")))
+
+(defn succeed [x]
+  [:succeed x])
+
+(defn succeed? [x]
+  {:pre [(seq? x)]}
+  (= :succeed (first x)))
+
+(defn fail [x]
+  [:fail x])
+
+(defn fail? [x]
+  {:pre [(seq? x)]}
+  (= :fail (first x)))


FIX: coerce integers and keywords should force to native color representation FIX: IColor implementation for nil

--- src/inkspot/color.clj
+++ src/inkspot/color.clj
@@ -68,15 +68,16 @@
         (cons (mod n 256) ret)
         (quot n 256)))))

-(defn string->color [s]
+(defn string->color
+  "Construct a tuple of RGB elements from a string."
+  [s]
   (condp re-matches s
     #"#(.*)" :>> color-vec
     #"rgb\((.*),(.*),(.*)\)" :>> color-vec
     #"rgba\((.*),(.*),(.*),(.*)\)" :>> color-vec))

 (defn keyword->color [k]
-  (when-let [v (lindsay/swatch k)]
-    (coerce v)))
+  (lindsay/swatch k))

 (extend-type ^{:cljs cljs.core.PersistentVector} clojure.lang.PersistentVector
   IColor
@@ -92,7 +93,7 @@
   (green  [n] (green (int->color n)))
   (blue   [n] (blue (int->color n)))
   (alpha  [n] (alpha (int->color n)))
-  (coerce [n] (int->color n)))
+  (coerce [n] (to-color (int->color n))))

 (extend-type java.lang.String
   IColor
@@ -102,13 +103,21 @@
   (alpha  [s] (alpha (string->color s)))
   (coerce [s] (to-color (string->color s))))

+(extend-type nil
+  IColor
+  (red    [s] nil)
+  (green  [s] nil)
+  (blue   [s] nil)
+  (alpha  [s] nil)
+  (coerce [s] nil))
+
 (extend-type clojure.lang.Keyword
   IColor
   (red    [s] (red (keyword->color s)))
   (green  [s] (green (keyword->color s)))
   (blue   [s] (blue (keyword->color s)))
   (alpha  [s] (alpha (keyword->color s)))
-  (coerce [s] (keyword->color s)))
+  (coerce [s] (to-color (keyword->color s))))

 ^:clj
 (extend-type java.awt.Color


Remove windowsVerbatimArguments option (fixes #1413)

--- src/lt/objs/proc.cljs
+++ src/lt/objs/proc.cljs
@@ -48,8 +48,7 @@
   (let [proc (spawn command
                     (when (seq args) (clj->js args))
                     (js-obj "cwd" cwd?
-                            "env" (merge-env env)
-                            "windowsVerbatimArguments" (when (= js/process.platform "win32") true)))]
+                            "env" (merge-env env)))]
     (add! proc)
     (.on proc "exit" (partial rem! proc))
     (.on proc "error" #(when @obj


Enabled real time again

Enabled real time again

Oops, disabled it by mistake before

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -1380,7 +1380,7 @@
 ; :realtime        true}

 (log (str "Checking server for data updates ..."))
-(comment js/setInterval
+(js/setInterval
  #(go

    ;(log (pr-str (count (keys @client-query-cache))))


Fix defn docstring syntax mistake

Fix defn docstring syntax mistake

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -56,9 +56,10 @@
 (defmethod execute :kill [_ _ _]
   nil)

-(defn start-rendering [{:keys [command-chan displayer] :as renderer}]
+(defn start-rendering
   "Starts a rendering loop that will listen for commands on `command-chan` and display frames using
   `displayer`"
+  [{:keys [command-chan displayer] :as renderer}]
   (thread
     (loop [state (->RenderState {} nil)
            status :stopped]


Define and use create-app since routes cannot be defined before config is loaded.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -1,6 +1,6 @@
 (ns incise.server
   (:require (compojure [route :refer [files not-found]]
-                       [core :refer [defroutes]])
+                       [core :refer [routes]])
             (hiccup [page :refer [html5]])
             (incise [config :as conf]
                     [load :refer [load-parsers-and-layouts]])
@@ -11,10 +11,6 @@
             [taoensso.timbre :refer [info error fatal]]
             [clojure.stacktrace :refer [print-cause-trace]]
             [org.httpkit.server :refer [run-server]]))
-
-(defroutes routes
-  (files "/" {:root (conf/get :out-dir)})
-  (not-found (html5 [:h1 "404"])))

 (defn wrap-static-index [handler]
   (fn [{:keys [uri] :as request}]
@@ -34,24 +30,29 @@
            (fatal cause-trace)))
         (when bubble (throw e))))))

-(def app (-> routes
-             (wrap-static-index)
-             (wrap-reload :dirs ["src" "spec"])
-             (wrap-incise)
-             (wrap-log-exceptions)
-             (wrap-stacktrace-web)
-             (asset-pipeline)))
+(defn create-app
+  "Create a ring application that is a deverlopment friendly server."
+  []
+  (-> (routes (files "/" {:root (conf/get :out-dir)})
+              (not-found (html5 [:h1 "404"])))
+      (wrap-static-index)
+      (wrap-reload :dirs ["src" "spec"])
+      (wrap-incise)
+      (wrap-log-exceptions)
+      (wrap-stacktrace-web)
+      (asset-pipeline)))

-(defn getenv
+(defn- getenv
   "A nice wrapper around System/getenv that allows a second argument to be
   passed in as the default."
   [variable & [default]]
   (or (System/getenv variable) default))

 (defn serve
-  "Start the development server"
+  "Start a development server."
   []
-  (let [port (Integer. (conf/get :port (getenv "PORT" 5000)))]
+  (let [port (Integer. (conf/get :port (getenv "PORT" 5000)))
+        app (create-app)]
     (info "Serving at"
           (str "http://" (.getCanonicalHostName
                            (java.net.InetAddress/getLocalHost)) \: port \/))
@@ -60,14 +61,15 @@
                                (conf/get :thread-count
                                          (getenv "THREAD_COUNT" 4)))})))

+;; ## Functions for manipulating the server atom.
 (defonce server (atom nil))

-(defn defserver
+(defn start
   "Start a server and bind the result to a var, 'server'."
   [& args]
   (reset! server (apply serve args)))

-(defn stop-server []
+(defn stop []
   (when @server
     (@server)
     (reset! server nil)))


Update ioframes.clj

Update ioframes.clj

--- src/iyye/ioframes.clj
+++ src/iyye/ioframes.clj
@@ -14,7 +14,6 @@
 ; You should have received a copy of the GNU Affero General Public License
 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.

-
 (ns iyye.ioframes
   (:require
     [clojure.tools.logging :as log]))
@@ -27,7 +26,6 @@

 (defn create-IO [name start-fumction inputs-list outputs-list] (IO. name start-fumction inputs-list outputs-list))
 ; list of IOs
-(def AvatarsIOList (ref ()))

 ;(defrecord InputOutput [InOutStream Period Stream unprocessed Streams ProcessFunction])
 ; actuators
@@ -36,16 +34,9 @@
 ;  (dosync (alter outputs-list conj output)))

 ; start all input threads
-(defn init-bios []
-  (letfn [(start-all [l]
-            (for [func (map :start-function l)
-                  :when func] (func)))]
-    (do
-      (start-all AvatarsIOList)
-      (start-all (:inputs-list AvatarsIOList))
-      (start-all (:outputs-list AvatarsIOList)))))

 (defn process-input [IO input]
+  (log/info (str (:name IO) input))
   (for [func (map :input-listeners-list IO)
         :when func] (func input)))
-
+


Delete query request once a client has updated it in realtime

Before whenever a realtime query changed we would constantly tell the
client that the query had changed when in fact it had only changed once

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -713,7 +713,7 @@
               ""))
         ]
     (do
-      (println "SQL::: " sql "," id)
+      ;(println "SQL::: " sql "," id)
       (sql-1  sql [id])
       )))

@@ -828,11 +828,12 @@
           ]
       (do
         (create-cache-for-table   db-table)
-        (println (str "Value before: "  (get-record-from-server-cache-for-id  db-table  id )))
+        ;(println (str "Value before: "  (get-record-from-server-cache-for-id  db-table  id )))
         (if table
           (swap!  table assoc id (atom {:value record :timestamp query-time :clients clients}))
           nil)
-        (println (str "Value after: "  (get-record-from-server-cache-for-id  db-table  id )))))))
+        ;(println (str "Value after: "  (get-record-from-server-cache-for-id  db-table  id )))
+        ))))

@@ -844,19 +845,19 @@

 (defn inform-clients-about-record  [db-table   id]
-  (println "inform-clients-about-record ")
+  ;(println "inform-clients-about-record ")
   (let [the-record        (get-record-from-server-cache-for-id  db-table  id )
         clients-atom      (:clients the-record)
         ]
-    (println (str "    the-record: " the-record))
-    (println (str "    Record Clients: " @clients-atom))
+    ;(println (str "    the-record: " the-record))
+    ;(println (str "    Record Clients: " @clients-atom))

     (doall (for [client @clients-atom]
              (do
-               (println (str "    Client: " client))
+               ;(println (str "    Client: " client))
                (let [the-client       (get @server-side-realtime-clients  client)
                      response-atom    (:update-request @the-client)
-                             ]
+                     ]
                  (if (not response-atom) (swap! response-atom assoc  :update-request (atom {})))
                  (swap! (:update-request @the-client) assoc-in [:records db-table id] {:timestamp (get the-record :timestamp)})
                  ;(println (str "    responses: " (if response-atom @response-atom)))
@@ -1004,9 +1005,9 @@
         db-table         (get realtime-log-entry :record_table_name)
         ]
     ;(println (str "**** Processing realtime record change: "))
-    (println (str "      "  "realtime-log-entry"))
-    (println (str "      "  realtime-log-entry))
-    (println (str "      "))
+    ;(println (str "      "  "realtime-log-entry"))
+    ;(println (str "      "  realtime-log-entry))
+    ;(println (str "      "))
     ;(println (str "      "  "@server-side-cached-queries"))
     ;(println (str "      "  @server-side-cached-queries))
     ;(println (str "      "))
@@ -1095,9 +1096,32 @@

-
-
-
+(defn dissoc-in
+  "Dissociates an entry from a nested associative structure returning a new
+  nested structure. keys is a sequence of keys. Any empty maps that result
+  will not be present in the new structure."
+  [m [k & ks :as keys]]
+  (if ks
+    (if-let [nextmap (get m k)]
+      (let [newmap (dissoc-in nextmap ks)]
+        (if (seq newmap)
+          (assoc m k newmap)
+          (dissoc m k)))
+      m)
+    (dissoc m k)))
+
+
+
+
+(defn delete-from-realtime-update  [ query-key     data-session-id ]
+  (let [client-data-atom         (if server-side-realtime-clients  (get @server-side-realtime-clients  data-session-id))
+        response-atom            (if client-data-atom  client-data-atom )
+        update-request-atom      (if response-atom  (get @response-atom :update-request ))
+        update-request           (if update-request-atom  @update-request-atom)
+        ]
+    (println (str "      update-request: " update-request))
+    (swap! update-request-atom dissoc-in [:queries query-key])
+  ))

@@ -1141,6 +1165,7 @@

+
   (cond
    ; ----------------------------------------------------------------
    ; if this is a realtime query
@@ -1157,6 +1182,7 @@
                       :order     order)
          ]
      (create-client-cache  data-session-id)
+     (delete-from-realtime-update  query-key data-session-id)

      (if (get @server-side-cached-queries  query-key)
        nil
@@ -1326,11 +1352,11 @@
   (let [client-data-atom    (if server-side-realtime-clients  (get @server-side-realtime-clients  client-data-session-id))
         response-atom       (if client-data-atom  client-data-atom )
         ]
-    ;(println (str "      " ))
-    ;(println "SERVER: check-for-server-updates for client: " client-data-session-id)
+    (println (str "      " ))
+    (println "SERVER: check-for-server-updates for client: " client-data-session-id)
     ;(println (str "      " (keys @server-side-realtime-clients)))
     ;(println (str "      " (if client-data-atom  @client-data-atom)))
-    ;(println (str "      response: " (if response-atom  @(get @response-atom :update-request )  )))
+    (println (str "      response: " (if response-atom  @(get @response-atom :update-request )  )))
     (if response-atom  @(get @response-atom :update-request )  {})))


convert class-paths to display now that table handles 1d vecs

--- user.clj
+++ user.clj
@@ -73,7 +73,7 @@
        options)))

 (defn class-paths "Prints list of class paths" []
-  (clojure.pprint/pprint (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))
+  (display (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader)))))

 (defn properties "List properties and their values" []
   (display


correctly sync uncompscribe test

correctly sync uncompscribe test

--- test/cljc/commos/delta/compscribe_test.cljc
+++ test/cljc/commos/delta/compscribe_test.cljc
@@ -96,13 +96,16 @@
                   {:bar {0 {:baz 42}}}))))))))

 (deftest uncompscribe
-  (let [[subs-fn unsubs-fn [subscriptions unsubscribable]] (simulate-api
+  (let [foo-complete (chan)
+        bar-block (chan)
+        [subs-fn unsubs-fn [subscriptions unsubscribable]] (simulate-api
                                            {"/foo/"
                                             {:deltas {0 [[:in 0]
-                                                         (timeout 100)
-                                                         [:ex 0]]}}
+                                                         [:ex 0]
+                                                         foo-complete]}}
                                             "/bar/"
-                                            {:deltas {0 [[:is :bar 42]]}}})
+                                            {:deltas {0 [bar-block
+                                                         [:is :bar 42]]}}})
         target (chan)
         end-subscription (compscribe target subs-fn unsubs-fn
                                      ["/foo/" ["/bar/"]]
@@ -110,4 +113,6 @@
     (test-async
      (test-within 1000
        (go
+         (>! foo-complete true)
+         (close! bar-block)
          (is (empty? (reduce delta/add nil (<! (a/into [] target))))))))))


fixed timing

fixed timing

--- one/src/one/d.clj
+++ one/src/one/d.clj
@@ -19,47 +19,41 @@
 (defn sol1a [lim]
   (->> (range lim)
        (filter #(or (zero? (rem % 3)) (zero? (rem % 5))))
-       (reduce +)
-       time))
+       (reduce +)))

 (defn sol1f [lim]
   (->> (range lim)
        (keep #(when (or (zero? (rem % 3)) (zero? (rem % 5))) %))
-       (reduce +)
-       time))
+       (reduce +)))

 (defn sol1b [lim]
-  (time (- (+ (reduce + (range 3 lim 3))
-              (apply + (range 5 lim 5)))
-           (reduce + (range 15 lim 15)))))
+  (- (+ (reduce + (range 3 lim 3))
+        (apply + (range 5 lim 5)))
+     (reduce + (range 15 lim 15))))

 (defn sol1c [lim]
   (->> (for [i (range lim)
              :when (or (zero? (rem i 3)) (zero? (rem i 5)))] i)
-       (reduce +)
-       time))
+       (reduce +)))

 (defn sol1d [lim]
-  (time (let [sum (atom 0)]
-          (dotimes [i lim]
-            (if (or (zero? (rem i 3)) (zero? (rem i 5)))
-              (reset! sum (+ @sum i))))
-          @sum)))
+  (let [sum (atom 0)]
+    (dotimes [i lim]
+      (if (or (zero? (rem i 3)) (zero? (rem i 5)))
+        (reset! sum (+ @sum i))))
+    @sum))

 (defn sol1e [lim]
-  (time (loop [i 1 sum 0]
-          (if (>= i lim)
-            sum
-            (if (or (zero? (rem i 3)) (zero? (rem i 5)))
-              (recur (+ i 1) (+ sum i))
-              (recur (+ i 1) sum))))))
+  (loop [i 1 sum 0]
+    (if (>= i lim)
+      sum
+      (if (or (zero? (rem i 3)) (zero? (rem i 5)))
+        (recur (+ i 1) (+ sum i))
+        (recur (+ i 1) sum)))))

-(defn fibo [n]
-  (if (<= n 1) 1 (+ (fibo (dec n)) (fibo (- n 2)))))
+(defn fibo [n] (if (<= n 1) 1 (+ (fibo (dec n)) (fibo (- n 2)))))

-(def mfibo
-  (memoize
-   (fn [n] (if (<= n 1) 1 (+ (mfibo (dec n)) (mfibo (- n 2)))))))
+(def mfibo (memoize (fn [n] (if (<= n 1) 1 (+ (mfibo (dec n)) (mfibo (- n 2)))))))

 (defn sol2a [lim]
   (->> (range)
@@ -74,8 +68,7 @@
        (map mfibo)
        (take-while (partial > lim))
        (filter even?)
-       (reduce +)
-       time))
+       (reduce +)))

 (defn lfibo [n]
   (->> (iterate #(let [[a b] %] [b (+' a b)]) [1 1])
@@ -95,8 +88,7 @@
 (defn sol14 [lim]
   (->> (range 1 lim)
        (map (juxt collatz identity))
-       (apply max-key first)
-       time))
+       (apply max-key first)))

 ;; sort-by group-by partition-by max-key merge-with
 ;; take-while drop-while reduce


Feedback exception on test.

Feedback exception on test.

--- test/onyx/peer/lifecycle_exception_test.clj
+++ test/onyx/peer/lifecycle_exception_test.clj
@@ -2,7 +2,7 @@
   (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
             [clojure.test :refer [deftest is testing]]
             [onyx.plugin.core-async :refer [take-segments!]]
-            [onyx.test-helper :refer [load-config with-test-env]]
+            [onyx.test-helper :refer [load-config with-test-env feedback-exception!]]
             [onyx.api]))

 (def n-messages 100)
@@ -129,6 +129,6 @@
         (doseq [n (range n-messages)]
           (>!! @in-chan {:n n}))

-        (onyx.api/await-job-completion peer-config job-id)
+        (feedback-exception! peer-config job-id (:log (:env test-env)))
         ;; Made it to the end with a successful job completion.
-        (is (= true true))))))
+        (is true)))))


typo fix in stop

typo fix in stop

--- src/pairwell/main.clj
+++ src/pairwell/main.clj
@@ -14,7 +14,7 @@

 (defn stop []
   {:pre [(:stop system)]}
-  ((:stop system)stop)
+  ((:stop system))
   (println "Server stopped.")
   (alter-var-root #'system dissoc :stop))


make sure errors are getting sent to the right client

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -409,20 +409,21 @@

 (defn handle-req [req]
   (utils/with-report-exceptions
-    (try+
-     (ws-handler (assoc req
-                        :db (pcd/default-db)
-                        ;; TODO: Have to kill sente
-                        :client-id (user-id-fn (:ring-req req))))
-     (catch :status t
-       (let [send-fn (:send-fn @sente-state)]
-         (log/error t)
-         ;; TODO: should this use the send-fn? We can do that too, I guess, inside of the defmethod.
-         ;; TODO: rip out sente and write a sensible library
-         (send-fn (:client-id req) [:frontend/error {:status-code (:status t)
-                                                     :error-msg (:error-msg t)
-                                                     :event (:event req)
-                                                     :event-data (:?data req)}]))))))
+    (let [client-id (user-id-fn (:ring-req req))]
+      (try+
+       (ws-handler (assoc req
+                          :db (pcd/default-db)
+                          ;; TODO: Have to kill sente
+                          :client-id client-id))
+       (catch :status t
+         (let [send-fn (:send-fn @sente-state)]
+           (log/error t)
+           ;; TODO: should this use the send-fn? We can do that too, I guess, inside of the defmethod.
+           ;; TODO: rip out sente and write a sensible library
+           (send-fn client-id [:frontend/error {:status-code (:status t)
+                                                :error-msg (:error-msg t)
+                                                :event (:event req)
+                                                :event-data (:?data req)}])))))))

 (defn setup-ws-handlers [sente-state]
   (let [tap (async/chan (async/sliding-buffer 100))


only send customer permissions to the frontend

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -206,8 +206,9 @@
     (send-fn client-id [:frontend/db-entities
                         {:document/id document-id
                          :entities (map (partial permission-model/read-api (:db req))
-                                        (permission-model/find-by-document (:db req)
-                                                                           {:db/id document-id}))
+                                        (filter :permission/cust
+                                                (permission-model/find-by-document (:db req)
+                                                                                {:db/id document-id})))
                          :entity-type :permission}])
     (send-fn client-id [:frontend/db-entities
                         {:document/id document-id


Use consistent naming.

Use consistent naming.

--- src/pubhouse/core.clj
+++ src/pubhouse/core.clj
@@ -10,8 +10,6 @@
 (def ^:dynamic site nil)

 (def ^:dynamic *meta-sep*  "===")
-
-(def ^:dynamic *block-sep* "$$$")

 (defn relative-path
   [path]
@@ -36,9 +34,9 @@
   {:path (relative-path (.getPath file))
    :mod-time (fs/mod-time file)})

-(defn meta-section
+(defn get-page-info
   [lines]
-  (->> lines (take-while #(not= % *meta-sep*))))
+  (->> lines (take-while #(not= % *meta-sep*)) (join "\n") (read-string)))

 (defn content-section
   [lines]
@@ -51,10 +49,7 @@
             (doall
              (for [file (->> (fs/file ".") (file-seq) (filter content-file?))]
                (with-open [reader (clojure.java.io/reader file)]
-                 [(get-file-info file)
-                  (->> (meta-section (line-seq reader))
-                       (join "\n")
-                       (read-string))]))))))
+                 [(get-file-info file) (get-page-info (line-seq reader))]))))))

 (defn strip-extension
   [s]


Also filters docker bridge network interfaces.

--- resources/leiningen/new/exponent/env/dev/user.clj
+++ resources/leiningen/new/exponent/env/dev/user.clj
@@ -38,7 +38,8 @@
     :else
     (->> (java.net.NetworkInterface/getNetworkInterfaces)
          (enumeration-seq)
-         (filter #(not (str/starts-with? (.getName %) "docker")))
+         (filter #(not (or (str/starts-with? (.getName %) "docker")
+                           (str/starts-with? (.getName %) "br-"))))
          (map #(.getInterfaceAddresses %))
          (map
            (fn [ip]


add listener for deploy server

add listener for deploy server

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -421,6 +421,7 @@
                                          :target "HTTP:80/"
                                          :timeout 5
                                          :interval 30}
+                          :listeners [(elb-listener {:port 9501 :protocol "HTTP"})]
                           :subnets public-subnets
                           :sgs (mapv cluster-unique ["public-slave-security-group"])}]})


Fix form-clean event.

Fix form-clean event.

--- src/uxbox/data/forms.cljs
+++ src/uxbox/data/forms.cljs
@@ -57,7 +57,7 @@
 (defrecord CleanForm [type]
   rs/UpdateEvent
   (-apply-update [_ state]
-    (assoc-in state [:form type] nil)))
+    (assoc-in state [:forms type] nil)))

 (defn clean-form
   [type]


Fix error message when unable to load mutable config on init

--- src/yetibot/core/init.clj
+++ src/yetibot/core/init.clj
@@ -29,5 +29,5 @@
       (ai/start)
       (load-commands-and-observers))
     (do
-      (error "Yetibot failed to start: please ensure config is in place at" mconfig/config-path " and that it is well-formed (see the log above for details)")
+      (error "Yetibot failed to start: please ensure config is in place at" (mconfig/config-path) " and that it is well-formed (see the log above for details)")
       (shutdown-agents))))


Fix connect tests

Fix connect tests

--- test/com/wsscode/pathom/connect_test.cljc
+++ test/com/wsscode/pathom/connect_test.cljc
@@ -979,8 +979,7 @@
          res))))

 (defn comparable-trace [trace]
-  (mapv (comp (fn [x] (cond-> x
-                        (::p/error x) (update ::p/error p/error-str))) #(dissoc % ::pt/timestamp ::pt/id)) trace))
+  (mapv #(dissoc % ::pt/timestamp ::pt/id) trace))

 (deftest test-path-cost
   (is (= (pc/path-cost {} ['a 'b 'c])


Add guard to prevent zero intervals

Add guard to prevent zero intervals

--- src/tick/interval.clj
+++ src/tick/interval.clj
@@ -40,9 +40,11 @@
           (s/or :local (s/tuple t/local? t/local?)
                 :non-local (s/tuple (comp not t/local?) (comp not t/local?)))
           [v1 v2])]
-   ;; Post condition must hold, and it is intentional that is cannot be disabled.
+   ;; Post condition must hold, and it is intentional that it cannot be disabled.
    ;; Intervals must be non-zero as an axiom of Allen's Interval Algebra.
    :post [(neg? (compare (t/beginning %) (t/end %)))]}
+  (when (= v1 v2)
+    (throw (ex-info "Zero length interval!" {:v1 v1 :v2 v2})))
   (if (neg? (compare v1 v2))
     (->Interval v1 v2)
     (->Interval v2 v1)))
@@ -251,6 +253,8 @@
 ;; intervals using the normal <, >, <=, >= operators.

 (defn as-interval [t]
+  (when (= (t/beginning t) (t/end t))
+    (throw (ex-info "t is a zero length interval!" {:t t})))
   (interval (t/beginning t) (t/end t)))

 (extend-protocol t/ITimeComparison


Fix shapes resizing

Fix shapes resizing

--- src/uxbox/shapes.cljs
+++ src/uxbox/shapes.cljs
@@ -174,17 +174,51 @@
       (assoc shape :rx rx :ry rx)
       (assoc shape :rx rx :ry ry))))

+(defn correct-shape
+  [shape]
+    (let [x1 (min (:x1 shape) (:x2 shape))
+          y1 (min (:y1 shape) (:y2 shape))
+          x2 (max (:x1 shape) (:x2 shape))
+          y2 (max (:y1 shape) (:y2 shape))]
+      (assoc shape :x1 x1 :x2 x2 :y1 y1 :y2 y2)))
+
+(defn equalize-sides
+  [shape]
+    (let [{:keys [x1 x2 y1 y2]} shape
+          x-side (mth/abs (- x2 x1))
+          y-side (mth/abs (- y2 y1))
+          max-side (max x-side y-side)]
+      (cond
+        (and (> x1 x2) (> y1 y2))
+          (assoc shape :x2 (- x1 max-side) :y2 (- y1 max-side))
+
+        (and (< x1 x2) (< y1 y2))
+          (assoc shape :x2 (+ x1 max-side) :y2 (+ y1 max-side))
+
+        (and (> x1 x2) (< y1 y2))
+          (assoc shape :x2 (- x1 max-side) :y2 (+ y1 max-side))
+
+        (and (< x1 x2) (> y1 y2))
+          (assoc shape :x2 (+ x1 max-side) :y2 (- y1 max-side)))))
+
+
 (defmethod resize :builtin/rect
   [shape {:keys [x y lock] :as pos}]
   (if lock
-    (assoc shape :x2 x :y2 x)
-    (assoc shape :x2 x :y2 y)))
+    (-> shape
+        (assoc :x2 x :y2 y)
+        equalize-sides
+        correct-shape)
+    (correct-shape (assoc shape :x2 x :y2 y))))

 (defmethod resize :builtin/text
   [shape {:keys [x y lock] :as pos}]
   (if lock
-    (assoc shape :x2 x :y2 x)
-    (assoc shape :x2 x :y2 y)))
+    (-> shape
+        (assoc :x2 x :y2 y)
+        equalize-sides
+        correct-shape)
+    (correct-shape (assoc shape :x2 x :y2 y))))

 (defmethod resize :default
   [shape _]


Rolled back reagent version to 0.5.0

Rolled back reagent version to 0.5.0

--- examples/simple/project.clj
+++ examples/simple/project.clj
@@ -2,7 +2,7 @@
 (defproject simple-re-frame "0.4.0"
   :dependencies [[org.clojure/clojure "1.6.0"]
                  [org.clojure/clojurescript "0.0-3208"]
-                 [reagent "0.5.1-SNAPSHOT"]
+                 [reagent "0.5.0"]
                  [re-frame "0.4.0"]
                  [figwheel "0.2.6"]]


removing test code

removing test code

--- moebius/test/moebius/kv_test.clj
+++ moebius/test/moebius/kv_test.clj
@@ -237,17 +237,3 @@
                      (kv/restore (kv/tx-log kv1)))]

          (kv/tx-log kv2) => []))
-
-
-(def  kv0 (kv/make-in-memory-kvstore))
-(def  kv1 (-> kv0
-              (kv/set "s1" "key1" "v1")
-              (kv/set "s2" "key1" "vB")
-              (kv/set "s1" "key1" "v2")
-              (kv/del "s1" "key1")
-              (kv/set "s2" "key2" "vC")))
-
-(def  kv2 (-> (kv/make-in-memory-kvstore)
-              (kv/restore (kv/tx-log kv1))))
-
-kv2


(PDB-3302) Fix ns form in fact-storage test

--- test/puppetlabs/puppetdb/integration/apply/fact_storage.clj
+++ test/puppetlabs/puppetdb/integration/apply/fact_storage.clj
@@ -1,4 +1,4 @@
-(ns puppetlabs.puppetdb.apply.fact-storage
+(ns puppetlabs.puppetdb.integration.apply.fact-storage
   (:require [clojure.test :refer :all]
             [puppetlabs.puppetdb.integration.fixtures :as int]
             [puppetlabs.puppetdb.cheshire :as json]


Fix formatting of minutes for format-nanoseconds :ghost:

--- src/metabase/util.clj
+++ src/metabase/util.clj
@@ -238,7 +238,7 @@
   "Format a time interval in nanoseconds to something more readable (µs/ms/etc.)
    Useful for logging elapsed time when using `(System/nanotime)`"
   [nanoseconds]
-  (loop [n nanoseconds, [[unit divisor] & more] [[:ns 1000] [:µs 1000] [:ms 1000] [:s 1000] [:mins 60] [:hours 60]]]
+  (loop [n nanoseconds, [[unit divisor] & more] [[:ns 1000] [:µs 1000] [:ms 1000] [:s 60] [:mins 60] [:hours Integer/MAX_VALUE]]]
     (if (and (> n divisor)
              (seq more))
       (recur (/ n divisor) more)


[80cols]

--- src/ombs/validate.clj
+++ src/ombs/validate.clj
@@ -58,9 +58,10 @@
   )

 (defmacro create-validator
-  "Create validation block, start with clearing errors, followed by create-rule calls for each ve-pairs.
-  ve-pairs is validator-error-pairs(vector) where first is function(rule that returns boolean), and second is error message, that was appends
-  in vld errors vector, when rule fails."
+  "Create validation block, start with clearing errors, followed by create-rule
+  calls for each ve-pairs.  ve-pairs is validator-error-pairs(vector) where
+  first is function(rule that returns boolean), and second is error message,
+  that was appends in vld errors vector, when rule fails."
   [tag ve-pairs]
   `(do
      ;(vld/clear-errors!)


cleanup cargoculted code

cleanup cargoculted code

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -306,16 +306,8 @@
       (notify-invite "Please sign up to send an invite."))))

 (defmethod ws-handler :frontend/send-permission-grant [{:keys [client-uuid ?data ?reply-fn] :as req}]
-  ;; This may turn out to be a bad idea, but error handling is done through creating chats
-  (check-document-access (-> ?data :document/id) req)
-  (let [[chat-id] (pcd/generate-eids (pcd/conn) 1)
-        doc-id (-> ?data :document/id)
-        invite-loc (-> ?data :invite-loc)
-        notify-grant (fn [body]
-                       (if (= :overlay invite-loc)
-                         ((:send-fn @sente-state) (str (client-uuid->uuid client-uuid))
-                          [:frontend/permission-grant-response {:document/id doc-id
-                                                                :response body}])))]
+  (check-document-access (-> ?data :document/id) req)
+  (let [doc-id (-> ?data :document/id)]
     (if-let [cust (-> req :ring-req :auth :cust)]
       (let [email (-> ?data :email)
             cid (client-uuid->uuid client-uuid)
@@ -332,6 +324,22 @@
                                            cust
                                            annotations)))
       (comment (notify-invite "Please sign up to send an invite.")))))
+    (if-let [cust (-> req :ring-req :auth :cust)]
+      (let [email (-> ?data :email)
+            cid (client-uuid->uuid client-uuid)
+            annotations {:document/id doc-id
+                         :cust/uuid (:cust/uuid cust)
+                         :transaction/broadcast true}]
+        (if-let [grantee (cust/find-by-email (:db req) email)]
+          (permission-model/grant-permit {:db/id doc-id}
+                                         grantee
+                                         :permission.permits/admin
+                                         annotations)
+          (access-grant-model/grant-access {:db/id doc-id}
+                                           email
+                                           cust
+                                           annotations)))
+      (comment (notify-invite "Please sign up to send an invite.")))))

 (defmethod ws-handler :chsk/ws-ping [req]
   ;; don't log


remove the placeholder posts

remove the placeholder posts

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -58,32 +58,7 @@
        [:p (:blurb content)]
        [:p
         [:a.blogroll-post-author {:href "#"}
-         (:author content)]]])
-    [:div.blogroll-post
-     [:a.blogroll-post-title {:href "#"}
-      [:h3 "Building a radial menu"]]
-     [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nisl erat, ullamcorper nec enim suscipit, accumsan pharetra lorem..."]
-     [:p "by Daniel"]]
-    [:div.blogroll-post
-     [:a.blogroll-post-title {:href "#"}
-      [:h3 "Precursor announces 1 billion seed round"]]
-     [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nisl erat, ullamcorper nec enim suscipit, accumsan pharetra lorem..."]
-     [:p "by Danny"]]
-    [:div.blogroll-post
-     [:a.blogroll-post-title {:href "#"}
-      [:h3 "Photoshop is dead, long live Precursor"]]
-     [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nisl erat, ullamcorper nec enim suscipit, accumsan pharetra lorem..."]
-     [:p "by Daniel"]]
-    [:div.blogroll-post
-     [:a.blogroll-post-title {:href "#"}
-      [:h3 "Importing your Precursor prototypes into Photoshop"]]
-     [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nisl erat, ullamcorper nec enim suscipit, accumsan pharetra lorem..."]
-     [:p "by Danny"]]
-    [:div.blogroll-post
-     [:a.blogroll-post-title {:href "#"}
-      [:h3 "Introduction to creating gifs of interactive prototypes"]]
-     [:p "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nisl erat, ullamcorper nec enim suscipit, accumsan pharetra lorem..."]
-     [:p "by Daniel"]]]])
+         (:author content)]]])]])

 (defn single-post [slug]
   (let [post ((post-fn slug))]


s/DEBUG/TRACE/

s/DEBUG/TRACE/

--- src/babel/italiano/morphology.cljc
+++ src/babel/italiano/morphology.cljc
@@ -1414,8 +1414,8 @@
                                            merge-fn (:merge-fn path-and-merge-fn)]
                                        ;; a lexeme-kv is a pair of a key and value. The key is a string (the word's surface form)
                                        ;; and the value is a list of lexemes for that string.
-                                       (log/debug (str "lexeme key:" k))
-                                       (log/debug (str (first lexeme-kv) " generating exception for path: " path))
+                                       (log/trace (str "lexeme key:" k))
+                                       (log/trace (str (first lexeme-kv) " generating exception for path: " path))
                                        (mapcat (fn [lexeme]
                                                  ;; this is where a unify/dissoc that supported
                                                  ;; non-maps like :top and :fail, would be useful:


src/riemann/xymon.clj: * send-line: renamed as send-single-message * send-message: taking send-line place in all implementations. Has ability to send a message to multiple xymon servers * xymon-max-line: renamed as message-max-length * everywhere: the 'line' word is replaced by 'message', for a better understanding

--- src/riemann/xymon.clj
+++ src/riemann/xymon.clj
@@ -70,31 +70,31 @@
     (format "disable %s.%s %s %s"
             host service (int (ceil (/ ttl 60))) description)))

-(defn *send-line-error-handler*
+(defn *send-message-error-handler*
   "
   Logs given exception as an error message.

-  *send-line-error-handler* is the default error handler invoked by
-  send-line if none is provided.
+  *send-message-error-handler* is the default error handler invoked by
+  send-single-message if none is provided.
   "
   [opts exception]
   (error exception (format "cannot reach xymon host (%s:%s)"
                            (:host opts) (:port opts))))

-(defn send-line
+(defn send-single-message
   "
-  Connects to Xymon server, sends line, then closes the connection.
-  This is a blocking operation and should happen on a dedicated
-  thread.
+  Connects to a Xymon server, sends message, then closes the
+  connection. This is a blocking operation and should happen on a
+  dedicated thread.

   If any exception is raised during the connect/send process, the
-  result of (:error-handler opts *send-line-error-handler*) is invoked
-  as a function with the exception as its parameter.
+  result of (:error-handler opts *send-message-error-handler*) is
+  invoked as a function with opts and the exception as its parameter.
   "
-  [opts line]
+  [opts message]
   (let [opts (merge
               {:host "127.0.0.1" :port 1984 :timeout 5
-               :error-handler *send-line-error-handler*}
+               :error-handler *send-message-error-handler*}
               opts)]
     (try
       (let [addr (InetSocketAddress. (:host opts) (:port opts))
@@ -102,10 +102,29 @@
         (.setSoTimeout sock (:timeout opts))
         (.connect sock addr (:timeout opts))
         (with-open [writer (io/writer sock)]
-          (.write writer line)
+          (.write writer message)
           (.flush writer)))
       (catch Exception e
         ((:error-handler opts) opts e)))))
+
+(defn send-message
+  "
+  Sends given message to Xymon host(s).
+
+  If (:hosts opts) is a sequence _and_ (:host opts) is false, sends
+  the message to all hosts described in (:hosts opts). When
+  provided (:host opts) should be a list of map and
+  send-single-message will invoked with (merge opts <item in :hosts>).
+
+  If (:host opts) is not false, sends the message to opts.
+  "
+  [opts message]
+  (if (and (seq (:hosts opts))
+           (not (:host opts)))
+    (let [hosts (:hosts opts)
+          opts (discard opts :hosts)]
+      (map (fn [host] (send-message (merge opts host) message)) hosts))
+    (send-single-message opts message)))

 (defn xymon
   "
@@ -120,9 +139,9 @@
     (fn [{:keys [state service] :as event}]
       (when (and state service)
         (let [statusmessage (formatter event)]
-          (send-line opts statusmessage))))))
+          (send-message opts statusmessage))))))

-(def xymon-max-line 4096)
+(def message-max-length 4096)

 (def- combo-header "combo\n")
 (def- combo-header-len (count combo-header))
@@ -130,7 +149,7 @@
 (defn events->combo
   "
   Returns a lazy sequence of combo messages. Each message is at most
-  xymon-max-line long.
+  message-max-length long.
   "
   ([formatter events]
    (events->combo formatter events combo-header combo-header-len))
@@ -141,7 +160,7 @@
            next-length (count next)
            length (+ len next-length 2)
            events (rest events)]
-       (if (< length xymon-max-line)
+       (if (< length message-max-length)
          (recur formatter events (str message next "\n\n") length)
          (cons message (lazy-seq (events->combo formatter events))))))))

@@ -153,7 +172,7 @@
   [opts events]
   (let [formatter (or (:formatter opts) event->status)]
     (doseq [combo-message (events->combo formatter events)]
-      (send-line opts combo-message))))
+      (send-message opts combo-message))))

 (defn xymon-batch
   "


Break-and-enter set.

Break-and-enter set.

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -88,6 +88,17 @@
                                  :msg (str "break up to 2 " (lower-case type) " subroutines")}
                                 (strength-pump 1 1)]}))

+(defn- break-and-enter
+  "Breakers from the Break and Entry set"
+  [type]
+  (cloud-icebreaker {:abilities [{:msg (str "break up to 3 " (lower-case type) " subroutines")
+                                  :effect (effect (trash card {:cause :ability-cost}))}]
+                      :events (let [cloud {:req (req (has-subtype? target "Icebreaker"))
+                                           :effect (effect (update-breaker-strength card))}]
+                                {:runner-install cloud :trash cloud :card-moved cloud})
+                      :strength-bonus (req (count (filter #(has-subtype? % "Icebreaker")
+                                                          (all-installed state :runner))))}))
+
 ;;; Icebreaker definitions
 (def cards-icebreakers
   {"Alpha"
@@ -169,13 +180,7 @@
                                    (strength-pump 1 1)]}))

    "Crowbar"
-   (cloud-icebreaker {:abilities [{:msg "break up to 3 code gate subroutines"
-                                   :effect (effect (trash card {:cause :ability-cost}))}]
-                      :events (let [cloud {:req (req (has-subtype? target "Icebreaker"))
-                                           :effect (effect (update-breaker-strength card))}]
-                                {:runner-install cloud :trash cloud :card-moved cloud})
-                      :strength-bonus (req (count (filter #(has-subtype? % "Icebreaker")
-                                                          (all-installed state :runner))))})
+   (break-and-enter "Code Gate")

    "Crypsis"
    (auto-icebreaker ["All"]
@@ -400,20 +405,10 @@
                                  (strength-pump 1 2)]})

    "Shiv"
-   (cloud-icebreaker {:abilities [{:msg "break up to 3 sentry subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
-                      :events (let [cloud {:req (req (has-subtype? target "Icebreaker"))
-                                           :effect (effect (update-breaker-strength card))}]
-                                {:runner-install cloud :trash cloud :card-moved cloud})
-                      :strength-bonus (req (count (filter #(has-subtype? % "Icebreaker")
-                                                          (all-installed state :runner))))})
+   (break-and-enter "Sentry")

    "Spike"
-   (cloud-icebreaker {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]
-                      :events (let [cloud {:req (req (has-subtype? target "Icebreaker"))
-                                           :effect (effect (update-breaker-strength card))}]
-                                {:runner-install cloud :trash cloud :card-moved cloud})
-                      :strength-bonus (req (count (filter #(has-subtype? % "Icebreaker")
-                                                          (all-installed state :runner))))})
+   (break-and-enter "Barrier")

    "Study Guide"
    {:abilities [(break-sub 1 1 "code gate")


Change text length to 160 for posts.

Change text length to 160 for posts.

--- src/cljs/link_collective/core.cljs
+++ src/cljs/link_collective/core.cljs
@@ -82,7 +82,7 @@
                          #uuid "b09d8708-352b-4a71-a845-5f838af04116"
                          "master"]
                         (concat [{:db/id post-id
-                                  :title (str (apply str (take 40 text)) "...")
+                                  :title (str (apply str (take 160 text)) "...")
                                   :detail-url (first urls)
                                   :detail-text  text
                                   :author author