cleaning up some function signatures

cleaning up some function signatures

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -143,11 +143,16 @@
       (.register c selector (poll-ops-mask [:write]))
     selector)))

-
-(defn backend [serversocket host port finished-ch]
+(defn parse-address [a]
+  (let [[address port] (str/split a #":")]
+    {:address address :port (Integer/parseInt port)}))
+
+(defn backend [serversocket address finished-ch]
   (let [bytebuffer (ByteBuffer/allocate 8192)
+        {:keys [host port]} (parse-address address)
         selector (new-selector serversocket [:accept])
         write-selector (Selector/open)]
+    (info (str "started backend for " address))
     (loop [pending-write false
            downstreams-for-upstreams {}]
       ;; BACKPRESSURE - we do things in a very specific order.  This is
@@ -260,22 +265,15 @@

             :default
             (recur pending-write downstreams-for-upstreams)
-            ))))))
-
-
+            ))))
+    (info (str "backend " address " quit"))))

 (defn backend-chan
-  [host port listener]
-  (info (str "started backend for " host ":" port))
+  [address listener]
   (let [ch (chan)]
     (future
-      (backend listener host port ch)
-      (info (str "backend " host  ":" port " quit")))
+      (backend listener address ch))
     ch))
-
-(defn parse-address [a]
-  (let [[address port] (str/split a #":")]
-    {:address address :port (Integer/parseInt port)}))

 (defn update-backends [backends config listener]
   (let [existing (keys backends)
@@ -284,19 +282,18 @@
     (log/spy :trace unwanted)
     (run! #(async/put! % :quit) (map #(:chan (get backends %)) unwanted))
     (reduce (fn [m [n v]]
-              (let [a (parse-address (:listen-address v))]
-                (assoc m
-                       [n listener]
-                       (or (get backends [n listener])
-                           (assoc v
-                                  :name n
-                                  :chan
-                                  (backend-chan (:address a) (:port a) listener)
-                                  :last-seen-at-ms
-                                  (if-let [ls (:last-seen-at v)]
-                                    (s->millepoch-time ls)
-                                    0)
-                                  )))))
+              (assoc m
+                     [n listener]
+                     (assoc v
+                            :name n
+                            :chan
+                            (or (get-in backends [[n listener] :chan])
+                                (backend-chan (:listen-address v) listener))
+                            :last-seen-at-ms
+                            (if-let [ls (:last-seen-at v)]
+                              (s->millepoch-time ls)
+                              0)
+                            )))
             {}
             (:backends config))))


Fix arguments to display! event (must be a vector)

--- src/braid/core/client/core/events.cljs
+++ src/braid/core/client/core/events.cljs
@@ -616,9 +616,9 @@
   (fn [{state :db} [_ {:keys [group-id group-name]}]]
     {:dispatch-n
      [[:braid.notices/display!
-       (keyword "left-group" group-id)
-       (str "You have been removed from " group-name)
-       :info]
+       [(keyword "left-group" group-id)
+        (str "You have been removed from " group-name)
+        :info]]
       (when (= group-id (state :open-group-id))
         [:redirect-from-root])]
      :db


bring Heartbeat and Monolith prevention prompt to the front

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -290,7 +290,7 @@
     :prevent {:damage [:meat :net :brain]}
     :abilities [{:msg "prevent 1 damage"
                  :choices {:req #(and (= (:side %) "Runner") (:installed %))}
-                 :priority true
+                 :priority 50
                  :effect (effect (trash target {:cause :ability-cost})
                                  (damage-prevent :brain 1)
                                  (damage-prevent :meat 1)
@@ -358,12 +358,13 @@
       :in-play [:memory 3]
       :effect (effect (resolve-ability (mhelper 1) card nil))
       :abilities [{:msg (msg "prevent 1 brain or net damage by trashing " (:title target))
-                   :priority true
+                   :priority 50
                    :choices {:req #(and (is-type? % "Program")
                                         (in-hand? %))}
-                   :prompt "Choose a program to trash from your grip" :effect (effect (trash target)
-                                                                       (damage-prevent :brain 1)
-                                                                       (damage-prevent :net 1))}]})
+                   :prompt "Choose a program to trash from your Grip"
+                   :effect (effect (trash target)
+                                   (damage-prevent :brain 1)
+                                   (damage-prevent :net 1))}]})

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


fully implement Paintbrush

fully implement Paintbrush

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -295,13 +295,23 @@
    "Paintbrush"
    {:abilities [{:cost [:click 1]
                  :choices {:req #(and (= (first (:zone %)) :servers) (has? % :type "ICE") (:rezzed %))}
-                 :effect (req (let [ice target]
+                 :effect (req (let [ice target
+                                    stypes (:subtype ice)]
                            (resolve-ability
                               state :runner
-                              {:prompt (msg "Choose a type")
-                               :choices ["sentry" "code gate" "barrier"]
-                               :msg (msg "give " (:title ice) " " target " until the end of next run this turn")}
-                              card nil)))}]}
+                              {:prompt (msg "Choose a subtype")
+                               :choices ["Sentry" "Code Gate" "Barrier"]
+                               :msg (msg "give " (:title ice) " " (.toLowerCase target) " until the end of the next run this turn")
+                               :effect (effect (update! (assoc ice :subtype
+                                                                   (->> (vec (.split (:subtype ice) " - "))
+                                                                        (cons target)
+                                                                        distinct
+                                                                        (join " - "))))
+                                               (register-events {:run-ends
+                                                                 {:effect (effect (update! (assoc ice :subtype stypes))
+                                                                                (unregister-events card))}} card))}
+                              card nil)))}]
+    :events {:run-ends nil}}

    "Parasite"
    {:hosting {:req #(and (= (:type %) "ICE") (:rezzed %))}


Try messagepack to avoid memory footprint.

--- src/clj/geschichte/platform.clj
+++ src/clj/geschichte/platform.clj
@@ -74,7 +74,7 @@
                                                         (.write out (:value m))
                                                         (.toByteArray out)))
                                    (let [baos (ByteArrayOutputStream. (* 100 1024 1024))
-                                         writer (transit/writer baos :json)]
+                                         writer (transit/writer baos :msgpack)]
                                      (.write baos (byte-array 1 (byte 1)))
                                      (transit/write writer m)
                                      (cli/send ws :byte (.toByteArray baos)))
@@ -98,7 +98,7 @@

                                  1
                                  (let [bais (ByteArrayInputStream. blob)
-                                       reader (transit/reader bais :json)
+                                       reader (transit/reader bais :msgpack)
                                        m (transit/read reader)]
                                    (debug "client received transit blob from:"
                                           url (take 10 (map byte blob)))
@@ -152,7 +152,7 @@
                                                          (.write out (:value m))
                                                          (.toByteArray out)))
                                  (let [baos (ByteArrayOutputStream. (* 100 1024 1024))
-                                       writer (transit/writer baos :json)]
+                                       writer (transit/writer baos :msgpack)]
                                    (.write baos (byte-array 1 (byte 1)))
                                    (transit/write writer m)
                                    (send! channel (.toByteArray baos) #_(str " " (pr-str m))))))
@@ -182,7 +182,7 @@

                                                    1
                                                    (let [bais (ByteArrayInputStream. blob)
-                                                         reader (transit/reader bais :json)
+                                                         reader (transit/reader bais :msgpack)
                                                          m (transit/read reader)]
                                                      (debug "client received transit blob from:"
                                                             url (take 10 (map byte blob)))


clean code

clean code

--- src/clj/salava/badge/routes.clj
+++ src/clj/salava/badge/routes.clj
@@ -276,7 +276,6 @@
                    :summary "Save badge evidence"
                    :auth-rules access/authenticated
                    :current-user current-user
-                   (prn evidence)
                    (ok (b/save-badge-evidence ctx (:id current-user) user-badge-id evidence)))

              (DELETE "/evidence/:evidenceid" [user_badge_id resource_type resource_id]


Get values from the REPL rather than strings

--- src/cljs/cljs_webrepl/repl.cljs
+++ src/cljs/cljs_webrepl/repl.cljs
@@ -14,7 +14,7 @@
   (merge (replumb/options :browser
                           ["/src/cljs" "/js/compiled/out"]
                           replumb-io/fetch-file!)
-         {:no-pr-str-on-value false
+         {:no-pr-str-on-value true
           :warning-as-error   true
           :verbose            false}))


messages sub returns only the useful vals

--- src/cljs/minimal_chat/core.cljs
+++ src/cljs/minimal_chat/core.cljs
@@ -52,7 +52,7 @@
 (register-sub
   :chat-room-messages
   (fn [db _]
-    (reaction (:messages @db))))
+    (reaction (vals (:messages @db)))))

 ;; -- Event Handlers --------

@@ -75,10 +75,12 @@
   :join-chat-room
   (fn [db [_ room-id]]
     ;; listen to chat room on firebase
-    (let [id          (-> room-id (str/lower-case) (keyword))
-          fb-messages (m/get-in fb-root [id :messages])]
-      (m/listen-to fb-messages :value
-                     (fn [[_ v]] (println v) (dispatch [:room-update v]))))
+    (let [id  (-> room-id (str/lower-case) (keyword))]
+      (-> fb-root
+          (m/get-in [id :messages])
+          (m/take-last 30)
+          (m/listen-to :value
+                       (fn [[_ v]] (println v) (dispatch [:room-update v])))))

     ;; update current room id
     (assoc db :chat-room room-id)))
@@ -117,10 +119,9 @@
 (defn show-messages []
   (let [messages (subscribe [:chat-room-messages])]
     [:div#messages
-     (for [[[k v] index] (map vector @messages (range))]
-       (let [{:keys [username message]} v]
-         ^{:key (str "message-" index)}
-         [:div [:span.username username] ": " [:span.message message]]))]))
+     (for [[{:keys [username message]} index] (map vector @messages (range))]
+       ^{:key (str "message-" index)}
+       [:div [:span.username username] ": " [:span.message message]])]))

 ;; -- Views -----------------


Update copyright year on keys ns.

Update copyright year on keys ns.

--- src/clojure/buddy/core/keys.clj
+++ src/clojure/buddy/core/keys.clj
@@ -1,4 +1,4 @@
-;; Copyright 2013 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.be>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


Bug fix for lens cursors whose parents don't necessarily report their new value (i.e. invalidation watches).

--- src/clojure/freactive/core.cljc
+++ src/clojure/freactive/core.cljc
@@ -567,12 +567,13 @@
   ([parent getter setter]
    #? (:cljs
        (let [binding-info (get-binding-fns parent)
-             id (new-reactive-id)]
+             id (new-reactive-id)
+             getter (fn [this] (getter ((.-raw-deref binding-info) parent)))]
          (Cursor.
           id
           parent
           nil
-          (fn [this] (getter ((.-raw-deref binding-info) parent)))
+          getter
           (if setter
             (fn [this f & args]
               (swap! parent
@@ -580,7 +581,7 @@
             (fn [] (throw (ex-info "Cursor is read-only" {}))))
           (fn [this]
             ((.-add-watch binding-info) parent id
-             (fn [k r o n] (.updateCursor this (getter n) *change-ks*))))
+             (fn [] (.updateCursor this (getter this) nil))))
           (fn [this] ((.-remove-watch binding-info) parent id))
           nil
           nil


Fixing regression bug when searching without any parameters.

--- src/cmr/search/models/query.clj
+++ src/cmr/search/models/query.clj
@@ -124,7 +124,7 @@
   (let [{:keys [concept-type page-size page-num condition]} params
         page-size (or page-size default-page-size)
         page-num (or page-num default-page-num)
-        condition (or condition ->MatchAllCondition)]
+        condition (or condition (->MatchAllCondition))]
     (->Query concept-type condition page-size page-num)))


matches set instead of vector

matches set instead of vector

--- Clojure-Websockets/src/clj/birdwatch/main.clj
+++ Clojure-Websockets/src/clj/birdwatch/main.clj
@@ -91,9 +91,8 @@
            (do
              (log/info "Received query:" params)
              (let [res (query params)]
-                ;(doseq [t res]
-                ;   (chsk-send! (:uid params) [:some/tweet (:_source t)]))
-                (chsk-send! (:uid params) [:tweet/prev-chunk res])))
+               ;(doseq [t res] (chsk-send! (:uid params) [:some/tweet (:_source t)]))
+               (chsk-send! (:uid params) [:tweet/prev-chunk res])))

            :else
            (do (log/info "Unmatched event:" ev)
@@ -182,9 +181,8 @@
 (go
  (while true
    (let [t (<! tweets-chan)]
-
      (let [response (perc/percolate conn "percolator" "tweet" :doc t)
-           matches (vec (map #(:_id %1) (esrsp/matches-from response)))]
+           matches (into #{} (map #(:_id %1) (esrsp/matches-from response)))]
        (log/info "esrsp/matches-from" matches))

      (doseq [uid (:any @connected-uids)]


Fns to fetch book by title or title plus author

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -108,3 +108,46 @@
          second
          :content
          (map extract-book-data))))
+
+(defn find-book-by-title
+  "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"
+        params {:q title
+                :format "xml"
+                :field "title"}
+        resp (make-auth-request-GET consumer
+                                    access-token
+                                    search-url
+                                    params)]
+    (->> resp
+         :content
+         second
+         :content
+         (filter #(= :results (:tag %)))
+         first
+         :content
+         (map element->map)
+         (map (comp (juxt :title :id :author) :best_book :work)))))
+
+(defn find-book-by-title-and-author
+  "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"
+        params {:q (str title " " author)
+                :format "xml"}
+        resp (make-auth-request-GET consumer
+                                    access-token
+                                    search-url
+                                    params)]
+    (->> resp
+         :content
+         second
+         :content
+         (filter #(= :results (:tag %)))
+         first
+         :content
+         (map element->map)
+         (map (comp (juxt :title :id :author) :best_book :work)))))


add insert into database

add insert into database

--- src/clj/reader_web_app/models/book.clj
+++ src/clj/reader_web_app/models/book.clj
@@ -22,5 +22,6 @@

 (defn create-book [book]
   (let [id (utils/uuid)
-        meta (fb2/parse-book book)]
-    {:title (get (get meta :meta) :book-title) :id id}))
+        meta ((fb2/parse-book book id) :meta)]
+    (insert e/books)
+      (values (merge meta {:id id}))))


.off on ref and event alone

.off on ref and event alone

Seems like passing the callback used for .on into .off isn’t working.
Events are still being pulled from the channel.

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -64,8 +64,7 @@
                                (js->clj (.val snapshot))]))]
      (.on fbref (clojure.core/name event) handle-event)
      (go (<! close-chan)
-         (.off fbref (clojure.core/name event)
-               handle-event))
+         (.off fbref (clojure.core/name event)))
      event-chan)))

 (defn- id->fb-chan


more logging

more logging

--- src/clojure/zensols/nlparse/config.clj
+++ src/clojure/zensols/nlparse/config.clj
@@ -353,7 +353,7 @@
                        (re-find #"\[([^/]+)\/(.*)\]")
                        rest
                        (map symbol))]
-    (log/tracef "fv: %s: %s / %s" fn-object ns name)
+    (log/tracef "fv: %s (%s): %s / %s" fn-object (pr-str fn-object) ns name)
     {:fn-namespace ns
      :fn-name name
      :fn-var (ns-resolve ns name)}))


Added c.c.retracts/pprint-retracts

Added c.c.retracts/pprint-retracts

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

--- src/conexp/contrib/retracts.clj
+++ src/conexp/contrib/retracts.clj
@@ -1,4 +1,5 @@
-(ns #^{:doc "Package for computing retracts from formal contexts."}
+(ns
+    #^{:doc "Package for computing retracts from formal contexts."}
   conexp.contrib.retracts
   (:use [conexp :only (concepts,
 		       objects, object-derivation,
@@ -6,7 +7,8 @@
 		       compatible-subcontexts,
 		       restrict-concept,
 		       make-context,
-		       set-of)]))
+		       set-of)])
+  (:use [clojure.contrib.pprint :only (cl-format)]))

 (defn- homomorphism-by-csc
   "Returns the homomorphisms obtained by resticting every concept to the
@@ -84,4 +86,23 @@
 	    :when (retract? context ret)]
 	ret))))

-nil+(defn- retract-to-pprint-str
+  "Pretty prints a retract of context."
+  [retract]
+  (let [key-value-pairs (sort (fn [[[A_1, _] _] [[A_2, _] _]]
+				(< 0 (compare (vec A_1) (vec A_2))))
+			      (seq retract)),
+	string-pairs (map #(map str %) key-value-pairs),
+	max-key (reduce max 0 (map (comp count first) string-pairs)),
+	max-val (reduce max 0 (map (comp count second) string-pairs))]
+    (map (fn [[k v]]
+	   (cl-format nil (str "~" max-key "@A  +->  ~" max-val "@A") k v))
+	 string-pairs)))
+
+(defn pprint-retracts
+  "Pretty prints retracts of context"
+  [context]
+  (doseq [r (retracts context)]
+    (cl-format true "~&~{~a~^~%~}~%~%" (retract-to-pprint-str r))))
+
+nil


Don't show planned time when we have real time

--- src/nextbus/core.cljs
+++ src/nextbus/core.cljs
@@ -49,8 +49,8 @@
         [:li.departure
          {:title planned-str}
          [:span.mh (mh planned-ts)]
-         (if real-str [:span.real (seconds->ms seconds-to-planned)])
-         [:span.planned (int (divide seconds-to-planned 60))]
+         (if real-str [:span.real (seconds->ms seconds-to-planned)]
+         [:span.planned (int (divide seconds-to-planned 60))])
          ]))))

 (defn render-monitor [m]


Checkpoint

Checkpoint

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/golang.clj
+++ src/obcc/build/golang.clj
@@ -56,7 +56,8 @@
 ;;-----------------------------------------------------------------

 (defn buildfunction [ast]
-  (let [[index {:keys [rettype functionName param]}] (->> ast zip/down zip/right getattrs)]
+  (let [attrs (->> ast zip/down zip/right getattrs)
+        {:keys [rettype functionName param index]} attrs]
     (->Function rettype functionName param index)))

 (defn buildfunctions [name view aliases]
@@ -67,7 +68,8 @@
       functions

       :else
-      (let [function (buildfunction (zip/node loc))]
+      (let [node (zip/node loc)
+            function (buildfunction loc)]
         (recur (->> loc zip/right) (assoc functions (.index function) function))))))

 (defn buildinterface [name view aliases]


Start sentry in debug mod on staging too.

--- src/oc/storage/config.clj
+++ src/oc/storage/config.clj
@@ -21,7 +21,7 @@
 (defonce sentry-release (or (env :release) ""))
 (defonce sentry-env (or (env :environment) "local"))
 (defonce sentry-config {:dsn dsn
-                        :debug (not prod?)
+                        :debug (not (#{"production" "prod"} sentry-env))
                         :release sentry-release
                         :environment sentry-env})


show account wallet only when logged in

show account wallet only when logged in

--- src/freecoin/handlers/participants.clj
+++ src/freecoin/handlers/participants.clj
@@ -41,6 +41,7 @@
 (lc/defresource account [wallet-store blockchain]
   :allowed-methods [:get]
   :available-media-types ["text/html"]
+  :authorized? (fn [ctx] (when (ch/context->signed-in-uid ctx) true))
   :exists? (fn [ctx]
              (if-let [uid (:uid (ch/context->params ctx))]
                (let [wallet (wallet/fetch wallet-store uid)]


Force realization of mset map before returning.

/cc @loganlinn

--- src/poky/kv/jdbc/util.clj
+++ src/poky/kv/jdbc/util.clj
@@ -213,7 +213,8 @@
   [conn data]
   ; doing these individually may not be an efficient use of the connection, but
   ; it should avoid deadlock by doing each set individually
-  (map (fn [{b :bucket k :key v :data t :modified_at}]
-         (if t
-           (jdbc-set conn b k v t)
-           (jdbc-set conn b k v))) data))
+  (doall
+    (map (fn [{b :bucket k :key v :data t :modified_at}]
+           (if t
+             (jdbc-set conn b k v t)
+             (jdbc-set conn b k v))) data)))


Added n-agree to best-agree comments for easier UI rendering

--- src/polismath/repness.clj
+++ src/polismath/repness.clj
@@ -220,9 +220,9 @@
         (let [best-agree (when best-agree
                            ; finalize, and assoc in a :best-agree attribute, so the client can render
                            ; accordingly
-                           (assoc
-                             (finalize-cmt-stats (:tid best-agree) best-agree)
-                             :best-agree true))
+                           (assoc (finalize-cmt-stats (:tid best-agree) best-agree)
+                                  :n-agree    (:na best-agree)
+                                  :best-agree true))
               ; Use best agree if that's what we have; otherwise best (possibly disagree); otherwise nothing
               best-head (cond
                           best-agree [best-agree]


mostly finished selection and deselection, required reorganizing the app state TODO movement of pieces

--- src/quick_chess/core.cljs
+++ src/quick_chess/core.cljs
@@ -5,6 +5,12 @@
 (enable-console-print!)

 (println (str "Reloaded: " (.toLocaleTimeString (js/Date.))))
+
+;;-----------------------------------
+;;--INIT STATE AND GLOBAL DEFINITIONS
+(defonce highlight-color "#538ab5")
+
+(defonce default-keybindings (map char (range 97 123)))

 (defonce init-pieces
   [[\u265C \u265E \u265D \u265B \u265A \u265D \u265E \u265C]
@@ -21,7 +27,17 @@
    (take 8 (cycle [(vec (take 8 (cycle '("#a3854b" "#d3d2cf"))))
                    (vec (take 8 (cycle '("#d3d2cf" "#a3854b"))))]))))

-(defonce highlight-color "#538ab5")
+(defonce init-selection-text
+  (let [keys (take 16 default-keybindings)
+        default-mapping (map vec
+                             (split-at
+                              (/ (count keys) 2) keys))]
+    (vec
+     (concat
+      (reverse
+       default-mapping)
+      (take 4 (cycle [(vec (take 8 (cycle '(""))))]))
+      default-mapping))))

 (defn string-mapping
   "given a list of rows and cols and a string list
@@ -38,31 +54,29 @@
         (string-mapping
          (range 6 8)
          (range 8)
-         (map char (range 97 113)))
+         default-keybindings)
         init-black-bindings
         (string-mapping
          (reverse (range 2))
          (range 8)
-         (map char (range 97 113)))]
+         default-keybindings)]
       {:width 500
        :height 500
        :board
        (mapv
-        (fn [row-pieces row-colors]
+        (fn [row-pieces row-colors row-text]
           (mapv
-           (fn [piece color]
-             {:piece piece :color color})
-           row-pieces row-colors))
-        init-pieces init-colors)
+           (fn [piece color text]
+             {:piece piece
+              :color color
+              :text text})
+           row-pieces row-colors row-text))
+        init-pieces
+        init-colors
+        init-selection-text)
        :string-map
-       {:white {:str->pos
-                init-white-bindings
-                :pos->str
-                (s/map-invert init-white-bindings)}
-        :black {:str->pos
-                init-black-bindings
-                :pos->str
-                (s/map-invert init-black-bindings)}}
+       {:white init-white-bindings
+        :black init-black-bindings}
        :turn :white}))

 (defonce black #{\u265F \u265C \u265E \u265D \u265B \u265A})
@@ -75,6 +89,8 @@
 #_(reset! app-state init-state)
 #_(swap! app-state assoc :turn :black)

+;;-------------
+;;--DYNAMIC CSS
 (defn board-style
   [data]
   {:border "1px solid black"
@@ -109,6 +125,8 @@
                (min (:height data) (:width data))
                0.03)})

+;;--------------------------------------------------------
+;;--REAGENT/REACT COMPONENTS AND HELPER FUNCTIONS TO THOSE
 (defn slider-view
   "adjusts the size of the board"
   [state]
@@ -117,24 +135,6 @@
            :on-change (fn [e]
                         (let [val (js/parseInt (.-target.value e))]
                           (swap! app-state assoc :width val :height val)))}])
-
-(defn deselect-piece
-  "changes the board it its normal no-piece selected
-  state were the board colors are default"
-  [state old]
-  (let [[row col] (get-in
-                   state
-                   [:string-map (:turn state) :str->pos old])
-        color (get-in init-colors [row col])]
-    (swap! app-state assoc-in [:board row col :color] color)))
-
-(defn deselected?
-  "returns true if the input signifies the user deselected a piece"
-  [state old new]
-  (and
-   (get-in state
-           [:string-map (:turn state) :str->pos old])
-   (> (count old) (count new))))

 (defn out-of-board?
   "returns all possible locations for a given piece
@@ -153,37 +153,82 @@
     (filter #(not (out-of-board? %)) [[(+ row 2) col]])
     (filter #(not (out-of-board? %)) [[(- row 2) col]])))

-(defn highlight-piece
+(defn change-color
   [[row col] color]
   (fn [state]
     (assoc-in state [:board row col :color] color)))

-(defn highlight-possible-positions
+(defn change-positions-to-color
   [positions color]
   (fn [state]
     (let [pos->str
           (map #(vector %1 %2)
                positions
-               (map char
-                    (range 97 123)))]
+               default-keybindings)]
       (reduce
        (fn [hmap [[row col] char]]
-         (assoc-in hmap [:board row col]
-                   {:piece char :color color}))
+         (update-in hmap [:board row col] assoc :color color :text char))
        state
        pos->str))))

+(defn positions-to-default-color
+  [positions]
+  (fn [state]
+    (reduce
+     (fn [hmap [row col]]
+       (let [color (get-in init-colors [row col])]
+         (update-in hmap [:board row col] assoc :color color :text "")))
+     state
+     positions)))
+
+(defn handle-deselection
+  [[row col :as pos] positions]
+  (comp
+   (change-color pos (get-in init-colors [row col]))
+   (positions-to-default-color positions)))
+
+;;can almost certainly be abstracted more
+;;so highlighting and unhighling can use
+;;majority of the same functions
 (defn handle-selection
   [pos turn]
   (comp
-   (highlight-possible-positions
+   (change-positions-to-color
     (possible-placements pos turn) highlight-color)
-   (highlight-piece pos highlight-color)))
+   (change-color pos highlight-color)))
+
+(defn deselect-piece
+  "changes the board it its normal no-piece selected
+  state were the board colors are default"
+  [state text-state old positions]
+  (let [[row col :as pos]
+        (get-in
+         state
+         [:string-map (:turn state) old])
+        color (get-in init-colors [row col])
+        pos-colors (map
+                    (fn [[row col]]
+                      (get-in
+                       state
+                       [:board row col :color]))
+                    positions)]
+    (swap! app-state (handle-deselection pos positions))
+    (swap! text-state assoc :move-to {})))
+
+(defn deselected?
+  "returns true if the input signifies the user deselected a piece"
+  [state old new]
+  (and
+   (get-in state
+           [:string-map (:turn state) old])
+   (> (count old) (count new))))

 (defn select-piece
   [state text-state [row col :as pos]]
   (swap! text-state
-         assoc :move-to (vec (possible-placements pos (:turn state))))
+         assoc :move-to (zipmap
+                         default-keybindings
+                         (vec (possible-placements pos (:turn state)))))
   (swap! app-state (handle-selection pos (:turn state))))

 (defn handle-text-input
@@ -194,17 +239,21 @@
           old (:text @text-state)
           piece (get-in
                  state
-                 [:string-map (:turn state) :str->pos str])]
+                 [:string-map (:turn state) str])]
       (swap! text-state assoc :text str)
       (cond
         piece (select-piece state text-state piece)
-        (deselected? state old str) (deselect-piece state old)))))
+        (deselected? state old str) (deselect-piece
+                                     state
+                                     text-state
+                                     old
+                                     (vals (:move-to @text-state)))))))

 (defn input-view
   "input of commands through strings"
   []
   (let [text-state (r/atom {:text ""
-                            :move-to []})]
+                            :move-to {}})]
     (fn [state]
       [:input {:type "text"
                :value (:text @text-state)
@@ -215,14 +264,8 @@
   (fn [col-idx elem]
     ^{:key col-idx}
     [:td {:style (td-style state (:color elem))}
-     ;;merge implementation isnt that great create our own
-     ;;or reorganize init-state.
      [:div {:style (piece-style state)} (:piece elem)]
-     (let [binding (get (merge
-                         (get-in state [:string-map :white :pos->str])
-                         (get-in state [:string-map :black :pos->str]))
-                        [row-idx col-idx] "")]
-       [:div {:style (selection-char-style state)} binding])]))
+     [:div {:style (selection-char-style state)} (:text elem)]]))

 (defn row-view
   [state]


[scamp] def 'comm-test-world as basis for comm regression tests

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -41,6 +41,13 @@
       (is (= result
            [[:message-envelope "stuffy-node" :forwarded-subscription "allergen-free-node"]])))))

+(def comm-test-world
+  (-> core/new-world
+      (core/add-new-node (core/node-contact-address->node "node-id0"))
+      (core/subscribe-new-node "node-id1" "node-id0")
+      (core/subscribe-new-node "node-id2" "node-id1")
+      (core/subscribe-new-node "node-id3" "node-id2")))
+
 (deftest do-comm-test
   (is (= (-> core/new-world
              (core/add-new-node (core/node-contact-address->node "node-id0"))


removed unused require

removed unused require

--- main/src/dda/pallet/dda_managed_vm/domain/bookmark.clj
+++ main/src/dda/pallet/dda_managed_vm/domain/bookmark.clj
@@ -13,9 +13,7 @@
 ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 ; See the License for the specific language governing permissions and
 ; limitations under the License.
-(ns dda.pallet.dda-managed-vm.domain.bookmark
-  (:require
-    [schema.core :as s]))
+(ns dda.pallet.dda-managed-vm.domain.bookmark)

 (def default-bookmarks
   [{:name "Bookmarks Toolbar"


allow comparison of bools & check-types fix

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -247,16 +247,9 @@

 (defn check-types
   [exp-type actual-type res location]
-  (m/domonad util/phase-m
-    [exp-type exp-type
-     actual-type actual-type
-     res (if (= actual-type exp-type)
-           (util/succ res)
-           (util/err (str "return type invalid; expected " (print-type exp-type) ", found " (print-type actual-type) " in " location)))
-     ]
-    res)
-
-  )
+  (if (= actual-type exp-type)
+             (util/succ res)
+             (util/err (str "return type invalid; expected " (print-type exp-type) ", found " (print-type actual-type) " in " location))))

 (defn with-type
   [obj type]
@@ -319,7 +312,7 @@
                          (= (get-type lexpr) [:bool])
                          (= (get-type rexpr) [:bool]))
                      (util/succ [vars2 (with-type [:eand lexpr rexpr] [:bool])])
-                     (util/err (str "expr invalid; expected bool, bool, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
+                     (util/err (str "expr invalid; expected bool,bool, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
                      )
                ]
               res)
@@ -331,7 +324,16 @@
                          (= (get-type lexpr) [:int])
                          (= (get-type rexpr) [:int]))
                      (util/succ [vars2 (with-type [:erel lexpr op rexpr] [:bool])])
-                     (util/err (str "expr invalid; expected int,int, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location))
+                     (if (and
+                           (= (get-type lexpr) [:bool])
+                           (= (get-type rexpr) [:bool])
+                           (or
+                             (= (third expr) [:eq])
+                             (= (third expr) [:ieq])
+                             )
+                           )
+                       (util/succ [vars2 (with-type [:erel lexpr op rexpr] [:bool])])
+                       (util/err (str "expr invalid; expected int,int or bool,bool, found " (print-type (get-type lexpr)) ", " (print-type (get-type rexpr)) " in: " location)))
                      )
                ]
               res)
@@ -434,20 +436,23 @@
                                          ) (m-result [(new-scope vars) [:block]]) (rest code))]
                [(rm-scope avars) result]
                )
-      :vret (check-types (util/succ [:void]) (lookup-var vars "_return_" location) [vars [:vret]] location)
+      :vret (m/domonad util/phase-m
+              [[type _] (lookup-var vars "_return_" location)
+               res (check-types [:void] type [vars [:vret]] location)]
+              res)
       :ret (m/domonad util/phase-m
              [[nvars expr] (annotate-expr glob-state vars (second code))
               [type _] (lookup-var nvars "_return_" location)
-              res (check-types (m-result type) (m-result (get-type expr)) [nvars (with-type [:ret expr] (get-type expr))] location)
+              res (check-types type (get-type expr) [nvars (with-type [:ret expr] (get-type expr))] location)
               ]
              res)
       :incr (m/domonad util/phase-m
               [[type num] (lookup-var vars (second code) location)
-               res (check-types (util/succ [:int]) (m-result type) [vars (with-type [:incr [:ident num]] [:int])] location)]
+               res (check-types [:int] type [vars (with-type [:incr [:ident num]] [:int])] location)]
               res)
       :decr (m/domonad util/phase-m
               [[type num] (lookup-var vars (second code) location)
-               res (check-types (util/succ [:int]) (m-result type) [vars (with-type [:decr [:ident num]] [:int])] location)]
+               res (check-types [:int] type [vars (with-type [:decr [:ident num]] [:int])] location)]
               res)
       :decl (m/domonad util/phase-m
               [type (m-result (second code))
@@ -459,26 +464,26 @@
              [name (m-result (second code))
               [nvars expr] (annotate-expr glob-state vars (third code))
               [type num] (lookup-var vars name location)
-              res (check-types (m-result type) (m-result (get-type expr)) [nvars (with-type [:ass [:ident num] expr] (get-type expr))] location)]
+              res (check-types type (get-type expr) [nvars (with-type [:ass [:ident num] expr] (get-type expr))] location)]
              res)
       :cond (m/domonad util/phase-m
               [
                [vars1 expr] (annotate-expr glob-state vars (second code))
                [vars2 nblock] (annotate-code glob-state vars1 (third code))
-               res (check-types (m-result [:bool]) (m-result (get-type expr)) [vars2 [:cond expr nblock]] location)]
+               res (check-types [:bool] (get-type expr) [vars2 [:cond expr nblock]] location)]
               res)
       :condelse (m/domonad util/phase-m
                   [
                    [vars1 expr] (annotate-expr glob-state vars (second code))
                    [vars2 nblock1] (annotate-code glob-state vars1 (third code))
                    [vars3 nblock2] (annotate-code glob-state vars2 (fourth code))
-                   res (check-types (m-result [:bool]) (m-result (get-type expr)) [vars3 [:condelse expr nblock1 nblock2]] location)]
+                   res (check-types [:bool] (get-type expr) [vars3 [:condelse expr nblock1 nblock2]] location)]
                   res)
       :while (m/domonad util/phase-m
                [
                 [vars1 expr] (annotate-expr glob-state vars (second code))
                 [vars2 nblock] (annotate-code glob-state vars1 (third code))
-                res (check-types (m-result [:bool]) (m-result (get-type expr)) [vars2 [:while expr nblock]] location)]
+                res (check-types [:bool] (get-type expr) [vars2 [:while expr nblock]] location)]
                res
                )
       :sexp (m/domonad util/phase-m


Add secret loading to config ns.

Add secret loading to config ns.

--- src/uxbox/config.clj
+++ src/uxbox/config.clj
@@ -8,10 +8,13 @@
   "A configuration management."
   (:require [mount.core :refer [defstate]]
             [environ.core :refer (env)]
+            [buddy.core.hash :as hash]
             [clojure.java.io :as io]
             [clojure.edn :as edn]
+            [uxbox.util.exceptions :as ex]
             [uxbox.util.data :refer [deep-merge]]))

+;; --- Configuration Loading & Parsing

 (def ^:dynamic *default-config-path* "config/default.edn")
 (def ^:dynamic *local-config-path* "config/local.edn")
@@ -33,3 +36,17 @@

 (defstate config
   :start (read-config))
+
+;; --- Secret Loading & Parsing
+
+(defn- initialize-secret
+  [config]
+  (let [secret (:secret config)]
+    (when-not secret
+      (ex/raise :code ::missing-secret-key
+                :message "Missing `:secret` key in config."))
+    (hash/blake2b-256 secret)))
+
+(defstate secret
+  :start (initialize-secret config))
+


Add proper nil/empty-string handling for thumbnails generation functions.

--- src/uxbox/images.clj
+++ src/uxbox/images.clj
@@ -33,9 +33,11 @@
 (defn populate-thumbnail
   [entry {:keys [src dst] :as cfg}]
   (let [src (if (vector? src) src [src])
-        dst (if (vector? dst) dst [dst])]
-    (assoc-in entry dst
-              (make-thumbnail (get-in entry src) cfg))))
+        dst (if (vector? dst) dst [dst])
+        src (get-in entry src)]
+     (if (empty? src)
+       entry
+       (assoc-in entry dst (make-thumbnail src cfg)))))

 (defn populate-thumbnails
   [entry & settings]
@@ -45,8 +47,10 @@
   [entry storage src dst]
   (let [src (if (vector? src) src [src])
         dst (if (vector? dst) dst [dst])
-        value (get-in entry src)
-        url (str (st/public-url storage value))]
-    (-> entry
-        (dissoc-in src)
-        (assoc-in dst url))))
+        value (get-in entry src)]
+    (if (empty? value)
+      entry
+      (let [url (str (st/public-url storage value))]
+        (-> entry
+            (dissoc-in src)
+            (assoc-in dst url))))))


do not drop duplicated classes

do not drop duplicated classes

--- src/rum/server_render.clj
+++ src/rum/server_render.clj
@@ -182,7 +182,7 @@
   (when (or (string? cs)
             (not-empty cs))
     (when-let [cs (not-empty (normalize-classes* cs))]
-      (str/join " " (distinct cs)))))
+      (str/join " " (dedupe cs)))))

 (defn render-attr [[name value]]


display ph post without a link to review

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -17,9 +17,12 @@
       (swap! requires conj ns))))

 (defn post-fn [slug]
-  (maybe-require slug)
-  (ns-resolve (post-ns slug)
-              (symbol slug)))
+  (try
+    (maybe-require slug)
+    (ns-resolve (post-ns slug)
+                (symbol slug))
+    (catch Exception e
+      nil)))

 (defn post-url [slug]
   (str "/blog/" slug))
@@ -27,14 +30,15 @@
 (def slugs
   "Sorted array of slugs, assumes the post content can be found in the
    function returned by post-fn"
-  [;"instrumenting-om-components"
-   "product-hunt-wake-up-call"
-   "interactive-layers"
-   ;"lets-replace-pen-and-paper"
+  ["interactive-layers"
+   ;; "product-hunt-wake-up-call"
+   ;; "instrumenting-om-components"
+   ;; "lets-replace-pen-and-paper"
    ])

 (defn post-exists? [slug]
-  (not= -1 (.indexOf slugs slug)))
+  (not= -1 (.indexOf slugs slug))
+  (post-fn slug))

 (def logomark
   [:i {:class "icon-logomark"}


[#1879] Don't diff nils

[#1879] Don't diff nils

So we will not get this response anymore
https://github.com/akvo/akvo-lumen/issues/1879#issue-392969010

--- backend/src/akvo/lumen/lib/transformation/merge_datasets.clj
+++ backend/src/akvo/lumen/lib/transformation/merge_datasets.clj
@@ -171,7 +171,7 @@
   (let [dataset-ids (mapv :datasetId merged-dataset-sources)
         diff        (set/difference (set dataset-ids)
                                     (set (map :id (select-datasets-by-id tenant-conn {:ids dataset-ids}))))]
-    (when (not-empty diff)
+    (when (not-empty (filter some? diff))
       {:diff diff})))

 (defn distinct-columns


Fix defscreen to allow adding new screen functions in a REPL session

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -41,11 +41,10 @@

 (defn defscreen*
   "Internal use only"
-  [{:keys [on-show on-render on-hide on-pause on-resize on-resume on-timer]
+  [{:keys [screen entities
+           on-show on-render on-hide on-pause on-resize on-resume on-timer]
     :as options}]
-  (let [screen (atom {})
-        entities (atom [])
-        execute-fn! (fn [func & {:keys [] :as options}]
+  (let [execute-fn! (fn [func & {:keys [] :as options}]
                       (when func
                         (let [old-entities @entities]
                           (some->> (func (merge @screen options) old-entities)
@@ -85,11 +84,20 @@
 replaced by simply reloading the namespace, and creates a var for the symbol `n`
 bound to a map containing various important values related to the screen"
   [n & {:keys [] :as options}]
-  `(let [fns# (->> (for [[k# v#] ~options]
-                     [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
-                   flatten
-                   (apply hash-map))]
-     (defonce ~n (defscreen* fns#))))
+  `(let [fn-syms# (->> (for [[k# v#] ~options]
+                         [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
+                       flatten
+                       (apply hash-map))
+         map-sym# (symbol (str '~n "-map"))
+         entities-sym# (symbol (str '~n "-entities"))
+         syms# (assoc fn-syms#
+                      :screen (deref
+                                (or (resolve map-sym#)
+                                    (intern *ns* map-sym# (atom {}))))
+                      :entities (deref
+                                  (or (resolve entities-sym#)
+                                      (intern *ns* entities-sym# (atom [])))))]
+     (def ~n (defscreen* syms#))))

 (defn defgame*
   "Internal use only"


CMR-5659: Changed variables/services bulk indexing to be queued on provider level.

--- bootstrap-app/src/cmr/bootstrap/services/dispatch/impl/message_queue.clj
+++ bootstrap-app/src/cmr/bootstrap/services/dispatch/impl/message_queue.clj
@@ -22,32 +22,40 @@
   "Bulk index all the collections and granules for a provider."
   [this context provider-id start-index]
   (message-queue/publish-bootstrap-provider-event
-    context
-    (message-queue/bootstrap-provider-event provider-id start-index)))
+   context
+   (message-queue/bootstrap-provider-event provider-id start-index)))

 (defn- index-variables
   "Bulk index all the variables. If a provider is passed, only index the variables
   for that provider."
   ([this context]
-   (message-queue/publish-bootstrap-concepts-event
-     context
-     (message-queue/bootstrap-variables-event)))
+   (info "Publishing events to index all variables.")
+   (doseq [provider (helper/get-providers (:system context))
+           :let [provider-id (:provider-id provider)]]
+     (message-queue/publish-bootstrap-concepts-event
+      context
+      (message-queue/bootstrap-variables-event provider-id)))
+   (info "Publishing events to index all variables completed."))
   ([this context provider-id]
    (message-queue/publish-bootstrap-concepts-event
-     context
-     (message-queue/bootstrap-variables-event provider-id))))
+    context
+    (message-queue/bootstrap-variables-event provider-id))))

 (defn- index-services
   "Bulk index all the services. If a provider is passed, only index the services
   for that provider."
   ([this context]
-   (message-queue/publish-bootstrap-concepts-event
-     context
-     (message-queue/bootstrap-services-event)))
+   (info "Publishing events to index all services.")
+   (doseq [provider (helper/get-providers (:system context))
+           :let [provider-id (:provider-id provider)]]
+     (message-queue/publish-bootstrap-concepts-event
+      context
+      (message-queue/bootstrap-services-event provider-id)))
+   (info "Publishing events to index all services completed."))
   ([this context provider-id]
    (message-queue/publish-bootstrap-concepts-event
-     context
-     (message-queue/bootstrap-services-event provider-id))))
+    context
+    (message-queue/bootstrap-services-event provider-id))))

 (defn- fingerprint-variables
   "Update fingerprints of variables. If a provider is passed, only update fingerprints of the


Add missing `handle` public api function.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -219,10 +219,9 @@
   "A short alias for `error` function."
   error)

-;; TODO: implement via protocols
-;; .whenCompleteAsync cf
-;; (f/biconsumer f)
-;; ^Executor executor)))
+(defn handle
+  ([p f] (pt/-handle p f exec/current-thread-executor))
+  ([p f executor] (pt/-handle p f executor)))

 (defn finally
   "Attach handler to promise that will be


Give the LHS nav a faint background, and adjust the size so it goes to the bottom.

--- src/re_demo/core.cljs
+++ src/re_demo/core.cljs
@@ -131,6 +131,8 @@
   [selected-tab-id on-select-tab]
     [v-box
      :class    "noselect"
+     :style    {:background-color "#fefefe"}
+     :size    "1 0 auto"
      :children (for [tab tabs-definition]
                  [nav-item tab selected-tab-id on-select-tab])])


Fix indent in worksheet.clj.

Fix indent in worksheet.clj.

--- src/sqls/ui/worksheet.clj
+++ src/sqls/ui/worksheet.clj
@@ -67,8 +67,8 @@
                                               :items [(seesaw.core/scrollable log-text
                                                                               :id :log-scrollable)])
         tabs-panel (seesaw.core/tabbed-panel :id :tabs
-                                       :tabs [{:title "Results" :content results-panel}
-                                              {:title "Log" :content log-panel}])
+                                             :tabs [{:title "Results" :content results-panel}
+                                                    {:title "Log" :content log-panel}])
         menu-panel (seesaw.core/horizontal-panel :id :menu-panel
                                                  :items [
                                                          (seesaw.core/button :id :new


Avoiding cycles

Avoiding cycles

--- src/staplo/generator.cljs
+++ src/staplo/generator.cljs
@@ -40,16 +40,18 @@
      generate-string
      generate-number) length))

-; too many parameters
-(defn generate-op [operations operation-names text history]
+; way too many parameters
+(defn generate-op [operations operation-names start-text text history]
   (let [rand-op
         #(let [op-name (rand-nth operation-names)]
             {:op-name op-name
              :op (operations op-name)})]
     (loop [candidate-op (rand-op)]
-      (if ((:precondition (:op candidate-op)) text history)
-        candidate-op
-        (recur (rand-op))))))
+      (let [{{precondition :precondition operation :operation} :op} candidate-op
+            result (operation text)]
+        (if (and (precondition text history) (not= start-text result))
+          candidate-op
+          (recur (rand-op)))))))

 (defn generate-ops [start-text steps operations-config]
   (letfn [
@@ -58,6 +60,7 @@
             {op-name :op-name op :op} (generate-op
                                         (operations/operations op-sort)
                                         (:list operations-config)
+                                        start-text
                                         text
                                         history)]
         {:text ((:operation op) text)


Remove get-possibly-unbound-var; just use bound?

--- src/main/clojure/lazytest/testable.clj
+++ src/main/clojure/lazytest/testable.clj
@@ -16,10 +16,6 @@
   [s]
   (or (seq (filter focused? s)) s))

-(defn- get-possibly-unbound-var [v]
-  (when (bound? v)
-    (var-get v)))
-
 (extend-protocol Testable
   clojure.lang.Namespace
   (get-tests [this-ns]
@@ -30,10 +26,11 @@

   clojure.lang.Var
   (get-tests [this-var]
-    (let [value (get-possibly-unbound-var this-var)]
-      (when (extends? Testable (type value))
-	(filter-focused
-	 (get-tests value)))))
+    (when (bound? this-var)
+      (let [value (var-get this-var)]
+	(when (extends? Testable (type value))
+	  (filter-focused
+	   (get-tests value))))))

   java.util.Collection
   (get-tests [coll]


xymon.clj: removed bogus work-in-progress send-line-with-to function

--- src/riemann/xymon.clj
+++ src/riemann/xymon.clj
@@ -93,20 +93,6 @@
     (catch Exception e
       ((:error-handler opts) e))))

-(defn send-line-with-to
-  [opts line]
-  (try
-    (let [addr (InetSocketAddress. (:host opts) (:port opts))
-          sock (Socket.)]
-      (.connect sock addr (:timeout opts))
-      (.setSoTimeout sock (:timeout opts))
-      (with-open [writer (io/writer sock)]
-        (.write writer line)
-        (.flush writer))
-      (.close sock))
-    (catch Exception e
-      (error e "cannot not reach xymon host"))))
-
 (defn xymon
   "Returns a function which accepts an event and sends it to Xymon.
    Silently drops events when xymon is down. Attempts to reconnect


make fetch-asana-info fn useful for other methods

--- src/chat/server/extensions/asana.clj
+++ src/chat/server/extensions/asana.clj
@@ -98,21 +98,25 @@

 ;; Fetching information
 (defn fetch-asana-info
-  [ext-id path]
-  (let [ext (db/with-conn (db/extension-by-id ext-id))
-        resp @(http/get (str api-url path)
-                        {:oauth-token (ext :token)})]
-      (condp = (:status resp)
-        200
-        (-> resp :body json/read-str)
-
-        401
-        (do (timbre/warnf "token expired %s %s" (:status resp) (:body resp))
-            (if (refresh-token ext)
-              (fetch-asana-info ext-id path)
-              (timbre/warnf "Failed to refresh token")))
-
-        (timbre/warnf "Asana api request failed: %s %s" (:status resp) (:body resp)))))
+  ([ext-id path] (fetch-asana-info ext-id :get path {}))
+  ([ext-id method path] (fetch-asana-info ext-id method path {}))
+  ([ext-id method path opts]
+   (let [ext (db/with-conn (db/extension-by-id ext-id))
+         resp @(http/request (merge {:method method
+                                     :url (str api-url path)
+                                     :oauth-token (ext :token)}
+                                    opts))]
+     (condp = (:status resp)
+       200
+       (-> resp :body json/read-str)
+
+       401
+       (do (timbre/warnf "token expired %s %s" (:status resp) (:body resp))
+           (if (refresh-token ext)
+             (fetch-asana-info ext-id path)
+             (timbre/warnf "Failed to refresh token")))
+
+       (timbre/warnf "Asana api request failed: %s %s" (:status resp) (:body resp))))))

 (defn available-workspaces
   [ext-id]
@@ -127,11 +131,9 @@
 ;; Webhooks
 (defn register-webhook
   [extension-id resource-id]
-  (let [ext (db/with-conn (db/extension-by-id extension-id))]
-    (http/post (str api-url "/webhooks")
-               {:oauth-token (:token ext)
-                :form-params {"resource" resource-id
-                              "target" (str webhook-uri "/" (:id ext))}})))
+  (fetch-asana-info extension-id :post "/webhooks"
+                    {:form-params {"resource" resource-id
+                                   "target" (str webhook-uri "/" (:id ext))}}))

 (defn update-threads-from-event
   [extension data]


Rename `$html-timetable-get-td-from-day-row-startTimeIdx`

to `html-timetable-get-td`

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -381,7 +381,7 @@
     [(str "h" (if (< hour 10) "0" "") hour)
      (str "m" (if (not= minute 0) "30" "00"))]))

-(defn- $html-timetable-get-td-from-day-row-startTimeIdx
+(defn- html-timetable-get-td
   "Given a day, row and start time index of a lesson, retrieves the
    jQuery object for the <td> element in the HTML representation of the
    Timetable."
@@ -641,8 +641,7 @@
                             :endTime endTime}
                            $divElem)

-    (let [$td ($html-timetable-get-td-from-day-row-startTimeIdx
-                day rowNum startTime)]
+    (let [$td (html-timetable-get-td day rowNum startTime)]
       (.append $td $divElem)
       ; Increase colspan and delete the <td> after it that occupy the timeslot
       ; of the lesson
@@ -1231,13 +1230,8 @@
         endTime                 (:endTime augTTLessonInfo)
         slotsOccupied           (- endTime startTime)

-        $sourceTd
-        ($html-timetable-get-td-from-day-row-startTimeIdx day sourceRowNum
-                                                          startTime)
-
-        $destTd
-        ($html-timetable-get-td-from-day-row-startTimeIdx day destinationRowNum
-                                                          startTime)
+        $sourceTd     (html-timetable-get-td day sourceRowNum startTime)
+        $destTd       (html-timetable-get-td day destinationRowNum startTime)

         ttLessonInfo            (dissoc augTTLessonInfo :day :rowNum)]
     (.log js/console (str "day = " day ", sourceRowNum = " sourceRowNum ", destinationRowNum = " destinationRowNum))


Remove parse.clj (empty) file.

Remove parse.clj (empty) file.

--- src/clojure/catacumba/impl/parse.clj
+++ src/clojure/catacumba/impl/parse.clj
@@ -1,24 +0,0 @@
-;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; * Redistributions of source code must retain the above copyright notice, this
-;;   list of conditions and the following disclaimer.
-;;
-;; * Redistributions in binary form must reproduce the above copyright notice,
-;;   this list of conditions and the following disclaimer in the documentation
-;;   and/or other materials provided with the distribution.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-


Add delay between tests so frame can be cleaned up before new test starts.

--- test/quil/snippet.clj
+++ test/quil/snippet.clj
@@ -7,6 +7,7 @@

 (defmacro snippet-as-test [name opts & draw-fn-body]
   `(let [result# (promise)]
+     (Thread/sleep 100)
      (q/sketch
       :title (str '~name)
       :size default-size
@@ -21,9 +22,7 @@
                   (println "Error" e#)
                   (.printStackTrace e#)
                   (deliver result# e#))
-                (finally
-                  (delay 100)
-                  (q/exit))))
+                (finally (q/exit))))
       :on-close #(deliver result# nil))
      (is (nil? @result#))))


fix bug in z position in acq eng

fix bug in z position in acq eng

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -179,14 +179,16 @@
              (not (core isContinuousFocusEnabled)))
     (core enableContinuousFocus true))
   (let [target-time (+ (@state :last-wake-time) interval-ms)
-        delta (- target-time (clock-ms))]
+        delta (- target-time (clock-ms))
+        old-z (get-z-stage-position (core getFocusDevice))]
     (when (pos? delta)
       (interruptible-sleep delta))
     (await-resume)
     (let [now (clock-ms)
           wake-time (if (> now (+ target-time 10)) now target-time)]
       (state-assoc! :last-wake-time wake-time
-                    :reference-z-position (get-z-stage-position (core getFocusDevice))))))
+                    :reference-z-position (- (get-z-stage-position (core getFocusDevice))
+                                             old-z)))))

 ;; image metadata


Rename metadata sub-key just added in r12188.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -843,7 +843,7 @@
           (JSONObject. {"Label" label
                         "GridRowIndex" grid-row
                         "GridColumnIndex" grid-col
-                        "CoordinatesUm" json-positions}))))))
+                        "DeviceCoordinatesUm" json-positions}))))))

 (defn make-summary-metadata [settings position-list]
   (let [depth (core getBytesPerPixel)


make sure timeout is a minimum of 20 s.

make sure timeout is a minimum of 20 s.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -352,41 +352,42 @@
    (Thread/sleep 5)))

 (defn collect-burst-images [event out-queue]
-  (when (first-trigger-missing?)
-    (pop-burst-image (* 10 (:exposure event)))) ; drop first image if first trigger doesn't happen
-  (swap! state assoc :burst-time-offset nil)
-  (let [burst-events (assign-z-offsets (event :burst-data))
-        camera-index (str (core getCameraDevice) "-CameraChannelIndex")
-        camera-channel-count (core getNumberOfCameraChannels)
-        bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))
-        camera-channel-names (get-camera-channel-names)]
-    (doall
-      (loop [burst-seqs bursts-per-camera-channel i 0]
-        (check-for-serious-error)
-        (when (core isBufferOverflowed)
-          (swap! state assoc :circular-buffer-overflow true))
-        (when (and (not (@state :stop))
-                   (not (apply = nil burst-seqs))
-                   (or (pos? (core getRemainingImageCount))
-                       (and (core isSequenceRunning)
-                            (not (@state :circular-buffer-overflow)))))
-          (let [image (pop-burst-image (* 10 (:exposure event)))
-                cam-chan (if-let [cam-chan-str (get-in image [:tags camera-index])]
-                           (Long/parseLong cam-chan-str)
-                           0)
-                camera-channel-name (nth camera-channel-names cam-chan)
-                event (-> (first (burst-seqs cam-chan))
-                          (update-in [:channel-index] make-multicamera-channel cam-chan)
-                          (update-in [:channel :name] super-channel-name camera-channel-name)
-                          (assoc :camera-channel-index cam-chan))]
-            (when (zero? i)
-              (swap! state assoc
-                     :burst-time-offset (- (elapsed-time @state)
-                                           (core-time-from-tags (image :tags)))))
-            (.put out-queue (make-TaggedImage (annotate-image image event @state
-                                                              (burst-time (:tags image) @state))))
-            (recur (update-in burst-seqs [cam-chan] next) (inc i)))))))
-  (burst-cleanup)) ;; burst is done!
+  (let [pop-timeout-ms (+ 20000 (* 10 (:exposure event)))]
+    (when (first-trigger-missing?)
+      (pop-burst-image pop-timeout-ms)) ; drop first image if first trigger doesn't happen
+    (swap! state assoc :burst-time-offset nil)
+    (let [burst-events (assign-z-offsets (event :burst-data))
+          camera-index (str (core getCameraDevice) "-CameraChannelIndex")
+          camera-channel-count (core getNumberOfCameraChannels)
+          bursts-per-camera-channel (vec (repeat camera-channel-count burst-events))
+          camera-channel-names (get-camera-channel-names)]
+      (doall
+        (loop [burst-seqs bursts-per-camera-channel i 0]
+          (check-for-serious-error)
+          (when (core isBufferOverflowed)
+            (swap! state assoc :circular-buffer-overflow true))
+          (when (and (not (@state :stop))
+                     (not (apply = nil burst-seqs))
+                     (or (pos? (core getRemainingImageCount))
+                         (and (core isSequenceRunning)
+                              (not (@state :circular-buffer-overflow)))))
+            (let [image (pop-burst-image pop-timeout-ms)
+                  cam-chan (if-let [cam-chan-str (get-in image [:tags camera-index])]
+                             (Long/parseLong cam-chan-str)
+                             0)
+                  camera-channel-name (nth camera-channel-names cam-chan)
+                  event (-> (first (burst-seqs cam-chan))
+                            (update-in [:channel-index] make-multicamera-channel cam-chan)
+                            (update-in [:channel :name] super-channel-name camera-channel-name)
+                            (assoc :camera-channel-index cam-chan))]
+              (when (zero? i)
+                (swap! state assoc
+                       :burst-time-offset (- (elapsed-time @state)
+                                             (core-time-from-tags (image :tags)))))
+              (.put out-queue (make-TaggedImage (annotate-image image event @state
+                                                                (burst-time (:tags image) @state))))
+              (recur (update-in burst-seqs [cam-chan] next) (inc i)))))))
+    (burst-cleanup))) ;; burst is done!

 (defn collect-snap-image [event out-queue]
   (let [image


Improved trigger errors. [ci skip]

Improved trigger errors. [ci skip]

--- src/onyx/static/helpful_job_errors.clj
+++ src/onyx/static/helpful_job_errors.clj
@@ -9,7 +9,8 @@
    :catalog :catalog-entry
    :lifecycles :lifecycle-entry
    :flow-conditions :flow-conditions-entry
-   :windows :window-entry})
+   :windows :window-entry
+   :triggers :trigger-entry})

 (defn matches-faulty-key? [k v elements faulty-key]
   (some #{k v} #{faulty-key}))
@@ -492,3 +493,23 @@
 (defmethod print-helpful-job-error [:windows :conditional-failed]
   [job error-data context structure-type]
   (conditional-failed* job error-data structure-type))
+
+(defmethod print-helpful-job-error [:triggers :missing-required-key]
+  [job error-data context structure-type]
+  (missing-required-key* job context error-data structure-type))
+
+(defmethod print-helpful-job-error [:triggers :type-error]
+  [job error-data context structure-type]
+  (type-error* job error-data structure-type))
+
+(defmethod print-helpful-job-error [:triggers :invalid-key]
+  [job error-data context structure-type]
+  (invalid-key* job error-data structure-type))
+
+(defmethod print-helpful-job-error [:triggers :value-choice-error]
+  [job error-data context structure-type]
+  (value-choice-error* job error-data structure-type))
+
+(defmethod print-helpful-job-error [:triggers :conditional-failed]
+  [job error-data context structure-type]
+  (conditional-failed* job error-data structure-type))


Update services.clj

Update services.clj

Services list numbers positioning fine tuning. Like this: https://monosnap.com/file/ckiBGnEfIZC3lPE1TESapqvUAi7P3t

--- src/site/services.clj
+++ src/site/services.clj
@@ -17,6 +17,8 @@
                   :overflow "hidden"
                   :width "30em"}
       [:.list-item {:float "left"
+                    :position "relative"
+                    :top "6px"
                     :width (s/vh* 3)
                     :color (s/s-var :color :main :muted :color)
                     :line-height (s/vh* 3)


parinfer formatting

parinfer formatting

--- src-cljs/cuttle/util.cljs
+++ src-cljs/cuttle/util.cljs
@@ -25,7 +25,7 @@
   (try
     (read-string contents)
     (catch :default e
-         {:error (str e ". Failed to read project.clj." )})))
+         {:error (str e ". Failed to read project.clj.")})))

 (defn path-join
   "Create a path string from given args with OS-specific path separators"


add empty handler for ping

add empty handler for ping

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -34,6 +34,11 @@
     (debugf "Unhandled event: %s" event)
     (when ?reply-fn
       (?reply-fn {:umatched-event-as-echoed-from-from-server event}))))
+
+(defmethod event-msg-handler :chsk/ws-ping
+  [ev-msg]
+  ; Do nothing, just avoid unhandled event message
+  )

 (defn broadcast-thread
   "broadcasts thread to all subscribed users, except those in ids-to-skip"


Forbid reversed intervals

Forbid reversed intervals

This is a source of potential bugs

--- src/tick/interval.clj
+++ src/tick/interval.clj
@@ -34,11 +34,8 @@
 ;; Construction

 (defn- make-interval [v1 v2]
-  (when (= v1 v2)
-    (throw (ex-info "Zero length interval!" {:v1 v1 :v2 v2})))
-  (if (neg? (compare v1 v2))
-    (->Interval v1 v2)
-    (->Interval v2 v1)))
+  (assert (t/< v1 v2))
+  (->Interval v1 v2))

 (defprotocol IIntervalConstructors
   (absolute-interval [t0 t1] "Create an interval between t0 and t1")


Fix test case for TravisCI execution.

Fix test case for TravisCI execution.

--- test/dsbdp/test/local_data_processing_pipeline_tests.clj
+++ test/dsbdp/test/local_data_processing_pipeline_tests.clj
@@ -199,6 +199,7 @@
     (await-flag tmp-flag)
     (.put in-queue (LocalTransferContainer. "in-1" "out-1"))
     (await-flag flag-1)
+    (sleep 100)
     (is (= "in-1" (.getIn @out)))
     (is (= "foo" (.getOut @out)))
     (let [cntr (get-counts proc-element)]
@@ -207,6 +208,7 @@
     (set-proc-fn proc-element proc-fn-2)
     (.put in-queue (LocalTransferContainer. "in-2" "out-2"))
     (await-flag flag-2)
+    (sleep 100)
     (is (= "in-2" (.getIn @out)))
     (is (= "bar" (.getOut @out)))
     (let [cntr (get-counts proc-element)]
@@ -214,7 +216,8 @@
       (is (= 0 (:dropped cntr))))
     (set-proc-fn proc-element proc-fn-3)
     (.put in-queue (LocalTransferContainer. "in-3" "out-3"))
-    (await-flag flag-1)
+    (await-flag flag-3)
+    (sleep 100)
     (is (= "in-3" (.getIn @out)))
     (is (= "baz" (.getOut @out)))
     (let [cntr (get-counts proc-element)]


Switch back to timestamp-str.

Switch back to timestamp-str.

--- src/dsbdp/experiment_helper.clj
+++ src/dsbdp/experiment_helper.clj
@@ -79,7 +79,7 @@
      n))

 (def sample-pcap-processing-definition-rules
-  [['timestamp '(timestamp-be 0) :qm]
+  [['timestamp '(timestamp-str-be 0) :qm]
    ['capture-length '(int32be 8)]
    ['eth-src '(eth-mac-addr-str 22) :qm]
    ['eth-dst '(eth-mac-addr-str 16) :qm]


Finished Hackerrank - Sherlock and Array

--- src/hackerrank/algorithms/search.clj
+++ src/hackerrank/algorithms/search.clj
@@ -20,7 +20,7 @@
   "https://www.hackerrank.com/challenges/maximum-subarray-sum?utm_campaign=challenge-recommendation&utm_medium=email&utm_source=3-day-campaign"
   [n m xs]
   (reduce max
-          (reduce concat (for [i (range 1 (inc n))]
+          (reduce into [] (for [i (range 1 (inc n))]
                           (map #(mod (reduce + %) m) (partition i 1 xs))))))

 (defn max-subarray-sum-hr []


better printing logic with stringbuilder

--- src/bolth.clj
+++ src/bolth.clj
@@ -127,35 +127,38 @@
         (.printStackTrace e))
       (finally (deliver (nth finished worker-id) 1)))))

-(defn format-progress-result [^String r full-failures]
+(defn format-progress-result [^String r ^StringBuilder full-failures]
   (if (= r ".")
-    "."
+    r
     (do
-      (swap! full-failures conj r)
+      (.append full-failures r)
+      (.append full-failures "\n")
       (if (.contains r "ERROR")
         (redify "E")
         (redify "F")))))
+
+(defn start-printer [full-failures results]
+  (future
+    (loop [r (.poll results)]
+      (when (not= r :finished)
+        (if (nil? r)
+          (Thread/sleep 10)
+          (print (format-progress-result r full-failures)))
+        (recur (.poll results))))))

 (defn run-gathered-tests [^AbstractQueue tests-to-run pharrallelism]
   (let [results (LinkedBlockingQueue.)
         finished (into [] (map (fn [_] (promise)) (range pharrallelism)))
         workers (map #(run-worker results tests-to-run % finished) (range pharrallelism))
-        full-failures (atom [])
-        printer (future
-                  (loop [r (.poll results)]
-                    (when (not= r :finished)
-                      (if (nil? r)
-                        (Thread/sleep 10)
-                        (print (format-progress-result r full-failures)))
-                      (recur (.poll results)))))]
+        full-failures (StringBuilder.)
+        printer (start-printer full-failures results)]
     (try
       (dorun workers)
       (doseq [n finished]
         (deref n))
       (.put results :finished)
       @printer
-      (doseq [failure @full-failures]
-        (print failure))
+      (print (str full-failures))
       (apply merge-with + (map (comp deref deref) finished))
       (finally
         (future-cancel printer)


parse goog-defines (since cljs.core/*target* uses it now)

--- src/main/cljs_api_gen/parse.clj
+++ src/main/cljs_api_gen/parse.clj
@@ -281,6 +281,8 @@
       deftype       "deftype"
       defmulti      "defmulti"
       defmethod     "defmethod"
+      goog-define   "var"
+
       (def defonce) (if (and (list? (nth form 2 nil))
                                (= 'fn (first (nth form 2 nil)))
                                (not (:dynamic (meta (second form)))))


more macro foo -> core/foo. Exclude cljs macros under :cljs since we will redef

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -35,7 +35,11 @@
                             cond-> cond->> as-> some-> some->>

                             if-some when-some test ns-interns ns-unmap var vswap! macroexpand-1 macroexpand
-                            #?(:cljs alias)])
+                            #?@(:cljs [alias assert-args coercive-not coercive-not= coercive-= coercive-boolean
+                                       truth_ js-arguments js-delete js-in js-debugger exists? divide js-mod
+                                       unsafe-bit-and bit-shift-right-zero-fill mask bitpos caching-hash
+                                       defcurried rfn specify! js-this this-as implements? array js-obj
+                                       simple-benchmark gen-apply-to js-str es6-iterable load-file*])])
   #?(:cljs (:require-macros [cljs.core :as core]))
   (:require clojure.walk
             clojure.set
@@ -194,7 +198,7 @@
               (core/let [pvec
                      (core/fn [bvec b val]
                        (core/let [gvec (gensym "vec__")]
-                         (core/loop [ret (-> bvec (conj gvec) (conj val))
+                         (core/loop [ret (core/-> bvec (conj gvec) (conj val))
                                      n 0
                                      bs b
                                      seen-rest? false]
@@ -219,7 +223,7 @@
                      (core/fn [bvec b v]
                        (core/let [gmap (gensym "map__")
                                   defaults (:or b)]
-                         (core/loop [ret (-> bvec (conj gmap) (conj v)
+                         (core/loop [ret (core/-> bvec (conj gmap) (conj v)
                                              (conj gmap) (conj `(if (seq? ~gmap) (apply core/hash-map ~gmap) ~gmap))
                                              ((core/fn [ret]
                                                 (if (:as b)
@@ -243,8 +247,8 @@
                                       (next bes)))
                              ret))))]
                     (core/cond
-                      (core/symbol? b) (-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
-                      (core/keyword? b) (-> bvec (conj (symbol (name b))) (conj v))
+                      (core/symbol? b) (core/-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
+                      (core/keyword? b) (core/-> bvec (conj (symbol (name b))) (conj v))
                       (vector? b) (pvec bvec b v)
                       (map? b) (pmap bvec b v)
                       :else (throw
@@ -253,7 +257,7 @@
          process-entry (core/fn [bvec b] (pb bvec (first b) (second b)))]
         (if (every? core/symbol? (map first bents))
           bindings
-          (if-let [kwbs (seq (filter #(core/keyword? (first %)) bents))]
+          (core/if-let [kwbs (seq (filter #(core/keyword? (first %)) bents))]
             (throw
               #?(:clj (new Exception (core/str "Unsupported binding key: " (ffirst kwbs)))
                  :cljs (new js/Error (core/str "Unsupported binding key: " (ffirst kwbs)))))
@@ -321,7 +325,7 @@
       (core/inc (core/quot c 32)))))

 (core/defmacro str [& xs]
-  (core/let [strs (->> (repeat (count xs) "cljs.core.str(~{})")
+  (core/let [strs (core/->> (repeat (count xs) "cljs.core.str(~{})")
                     (interpose ",")
                     (apply core/str))]
     (list* 'js* (core/str "[" strs "].join('')") xs)))
@@ -345,7 +349,7 @@
    (core/let [forms (concat [x] next)]
      (if (every? #(simple-test-expr? &env %)
            (map #(cljs.analyzer/analyze &env %) forms))
-       (core/let [and-str (->> (repeat (count forms) "(~{})")
+       (core/let [and-str (core/->> (repeat (count forms) "(~{})")
                             (interpose " && ")
                             (apply core/str))]
          (bool-expr `(~'js* ~and-str ~@forms)))
@@ -363,7 +367,7 @@
    (core/let [forms (concat [x] next)]
      (if (every? #(simple-test-expr? &env %)
            (map #(cljs.analyzer/analyze &env %) forms))
-       (core/let [or-str (->> (repeat (count forms) "(~{})")
+       (core/let [or-str (core/->> (repeat (count forms) "(~{})")
                            (interpose " || ")
                            (apply core/str))]
          (bool-expr `(~'js* ~or-str ~@forms)))
@@ -707,7 +711,7 @@
 ;;; end of reducers macros

 (core/defn- protocol-prefix [psym]
-  (core/str (-> (core/str psym) (.replace \. \$) (.replace \/ \$)) "$"))
+  (core/str (core/-> (core/str psym) (.replace \. \$) (.replace \/ \$)) "$"))

 (def #^:private base-type
      {nil "null"
@@ -770,7 +774,7 @@
              meta-sym (gensym "meta")
              this-sym (gensym "_")
              locals   (keys (:locals &env))
-             ns       (-> &env :ns :name)
+             ns       (core/-> &env :ns :name)
              munge    cljs.compiler/munge]
     `(do
        (when-not (exists? ~(symbol (core/str ns) (core/str t)))
@@ -812,13 +816,13 @@

 (core/defn- warn-and-update-protocol [p type env]
   (core/when-not (= 'Object p)
-    (if-let [var (cljs.analyzer/resolve-existing-var (dissoc env :locals) p)]
+    (core/if-let [var (cljs.analyzer/resolve-existing-var (dissoc env :locals) p)]
       (do
         (core/when-not (:protocol-symbol var)
           (cljs.analyzer/warning :invalid-protocol-symbol env {:protocol p}))
         (core/when (core/and (:protocol-deprecated cljs.analyzer/*cljs-warnings*)
-                (-> var :deprecated)
-                (not (-> p meta :deprecation-nowarn)))
+                (core/-> var :deprecated)
+                (not (core/-> p meta :deprecation-nowarn)))
           (cljs.analyzer/warning :protocol-deprecated env {:protocol p}))
         (core/when (:protocol-symbol var)
           (swap! env/*compiler* update-in [:cljs.analyzer/namespaces]
@@ -829,7 +833,7 @@
         (cljs.analyzer/warning :undeclared-protocol-symbol env {:protocol p})))))

 (core/defn- resolve-var [env sym]
-  (core/let [ret (-> (dissoc env :locals)
+  (core/let [ret (core/-> (dissoc env :locals)
                    (cljs.analyzer/resolve-var sym)
                    :name)]
     (assert ret (core/str "Can't resolve: " sym))
@@ -853,7 +857,7 @@
                 ~type ~(with-meta `(fn ~@meths) (meta form))))
         sigs))))

-(core/defmulti extend-prefix (core/fn [tsym sym] (-> tsym meta :extend)))
+(core/defmulti extend-prefix (core/fn [tsym sym] (core/-> tsym meta :extend)))

 (core/defmethod extend-prefix :instance
   [tsym sym] `(.. ~tsym ~(to-property sym)))
@@ -931,7 +935,7 @@
   (warn-and-update-protocol p type env)
   (core/let [psym      (resolve p)
              pprefix   (protocol-prefix psym)
-             skip-flag (set (-> type-sym meta :skip-protocol-flag))]
+             skip-flag (set (core/-> type-sym meta :skip-protocol-flag))]
     (if (= p 'Object)
       (add-obj-methods type type-sym sigs)
       (concat
@@ -947,7 +951,7 @@
 (core/defn- validate-impl-sigs [env p method]
   (core/when-not (= p 'Object)
     (core/let [var (ana/resolve-var (dissoc env :locals) p)
-               minfo (-> var :protocol-info :methods)
+               minfo (core/-> var :protocol-info :methods)
                [fname sigs] (if (core/vector? (second method))
                               [(first method) [(second method)]]
                               [(first method) (map first (rest method))])
@@ -998,7 +1002,7 @@
              _ (validate-impls env impls)
              resolve (partial resolve-var env)
              impl-map (->impl-map impls)
-             [type assign-impls] (if-let [type (base-type type-sym)]
+             [type assign-impls] (core/if-let [type (base-type type-sym)]
                                    [type base-assign-impls]
                                    [(resolve type-sym) proto-assign-impls])]
     (core/when (core/and (:extending-base-js-type cljs.analyzer/*cljs-warnings*)
@@ -1044,7 +1048,7 @@
      (core/loop [ret [] specs specs]
        (if (seq specs)
          (core/let [p     (first specs)
-                    ret   (-> (conj ret p)
+                    ret   (core/-> (conj ret p)
                             (into (reduce (partial annotate-specs annots) []
                                     (group-by first (take-while seq? (next specs))))))
                     specs (drop-while seq? (next specs))]
@@ -1052,7 +1056,7 @@
          ret)))))

 (core/defn- collect-protocols [impls env]
-  (->> impls
+  (core/->> impls
       (filter core/symbol?)
       (map #(:name (cljs.analyzer/resolve-var (dissoc env :locals) %)))
       (into #{})))
@@ -1061,7 +1065,7 @@
   [rsym rname fields]
   (let [fn-name (with-meta (symbol (core/str '-> rsym))
                   (assoc (meta rsym) :factory :positional))
-        field-values (if (-> rsym meta :internal-ctor) (conj fields nil nil nil) fields)]
+        field-values (if (core/-> rsym meta :internal-ctor) (conj fields nil nil nil) fields)]
     `(defn ~fn-name
        [~@fields]
        (new ~rname ~@field-values))))
@@ -1347,7 +1351,7 @@
              psym (vary-meta psym assoc
                     :doc doc
                     :protocol-symbol true)
-             ns-name (-> &env :ns :name)
+             ns-name (core/-> &env :ns :name)
              fqn (core/fn [n] (symbol (core/str ns-name "." n)))
              prefix (protocol-prefix p)
              _ (core/doseq [[mname & arities] methods]
@@ -1605,7 +1609,7 @@
                      {} (partition 2 clauses))
              esym    (gensym)
              tests   (keys pairs)]
-    (cond
+    (core/cond
       (every? (some-fn core/number? core/string? core/char? #(const? env %)) tests)
       (core/let [no-default (if (odd? (count clauses)) (butlast clauses) clauses)
                  tests      (mapv #(if (seq? %) (vec %) [%]) (take-nth 2 no-default))
@@ -1613,7 +1617,7 @@
         `(let [~esym ~e] (case* ~esym ~tests ~thens ~default)))

       (every? core/keyword? tests)
-      (core/let [tests (->> tests
+      (core/let [tests (core/->> tests
                          (map #(.substring (core/str %) 1))
                          vec
                          (mapv #(if (seq? %) (vec %) [%])))
@@ -1786,7 +1790,7 @@
     (nth (step nil (seq seq-exprs)) 1)))

 (core/defmacro array [& rest]
-  (core/let [xs-str (->> (repeat "~{}")
+  (core/let [xs-str (core/->> (repeat "~{}")
                       (take (count rest))
                       (interpose ",")
                       (apply core/str))]
@@ -1853,7 +1857,7 @@
         assoc :tag 'cljs.core/PersistentHashSet))))

 (core/defn- js-obj* [kvs]
-  (core/let [kvs-str (->> (repeat "~{}:~{}")
+  (core/let [kvs-str (core/->> (repeat "~{}:~{}")
                        (take (count kvs))
                        (interpose ",")
                        (apply core/str))]
@@ -1864,7 +1868,7 @@
 (core/defmacro js-obj [& rest]
   (core/let [sym-or-str? (core/fn [x] (core/or (core/symbol? x) (core/string? x)))
              filter-on-keys (core/fn [f coll]
-                              (->> coll
+                              (core/->> coll
                                 (filter (core/fn [[k _]] (f k)))
                                 (into {})))
              kvs (into {} (map vec (partition 2 rest)))
@@ -1963,7 +1967,7 @@
              m           (if (meta mm-name)
                            (conj (meta mm-name) m)
                            m)
-             mm-ns (-> &env :ns :name core/str)]
+             mm-ns (core/-> &env :ns :name core/str)]
     (core/when (= (count options) 1)
       (throw
         #?(:clj (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")
@@ -2185,7 +2189,7 @@
                  (~'cljs$core$IFn$_invoke$arity$variadic ~@(dest-args c-1) argseq#)))))
          ~(variadic-fn* rname method)))))

-(comment
+(core/comment
   (require '[clojure.pprint :as pp])
   (pp/pprint (variadic-fn 'foo {} '(([& xs]))))
   (pp/pprint (variadic-fn 'foo {} '(([a & xs] xs))))
@@ -2292,20 +2296,24 @@
                             (butlast fdecl)
                             fdecl)
                     m (conj {:arglists (core/list 'quote (sigs fdecl))} m)
-                    m (core/let [inline (:inline m)
-                                 ifn (first inline)
-                                 iname (second inline)]
-                        ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
-                        (if (if #?(:clj (clojure.lang.Util/equiv 'fn ifn)
-                                   :cljs (= 'fn ifn))
-                              (if #?(:clj (core/instance? clojure.lang.Symbol iname)
-                                     :cljs (core/instance? Symbol iname)) false true))
-                          ;; inserts the same fn name to the inline fn if it does not have one
-                          (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName ^clojure.lang.Symbol name) "__inliner"))
-                                                       (next inline))))
-                          m))
+                    ;; no support for :inline
+                    ;m (core/let [inline (:inline m)
+                    ;             ifn (first inline)
+                    ;             iname (second inline)]
+                    ;    ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
+                    ;    (if (if #?(:clj (clojure.lang.Util/equiv 'fn ifn)
+                    ;               :cljs (= 'fn ifn))
+                    ;          (if #?(:clj (core/instance? clojure.lang.Symbol iname)
+                    ;                 :cljs (core/instance? Symbol iname)) false true))
+                    ;      ;; inserts the same fn name to the inline fn if it does not have one
+                    ;      (assoc m
+                    ;        :inline (cons ifn
+                    ;                  (cons (clojure.lang.Symbol/intern
+                    ;                          (.concat (.getName ^clojure.lang.Symbol name) "__inliner"))
+                    ;                    (next inline))))
+                    ;      m))
                     m (conj (if (meta name) (meta name) {}) m)]
-           (cond
+           (core/cond
              (multi-arity-fn? fdecl)
              (multi-arity-fn name m fdecl)


cache-bust the release url

cache-bust the release url

--- src-cljs/cuttle/main_page.cljs
+++ src-cljs/cuttle/main_page.cljs
@@ -62,7 +62,9 @@
 ;; Check for Updates
 ;;------------------------------------------------------------------------------

-(def latest-version-url "http://cljs.info/latest-cuttle-version.txt")
+(def latest-version-url (str
+  "http://cljs.info/latest-cuttle-version.txt?_="
+  (uuid)))

 ;; NOTE: I was sick while writing this function; please don't judge ;)
 ;; TODO: should do some simple checking that the version number is in a valid


core/== to == in macro

core/== to == in macro

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -2447,7 +2447,7 @@
      (if (core/<= n 20)
        `(let [~(cs (core/dec n)) (-first ~'args)
               ~'args (-rest ~'args)]
-          (if (core/== ~'argc ~n)
+          (if (== ~'argc ~n)
             (if (. ~'f ~prop)
               (. ~'f (~f ~@(take n cs)))
               (~'f ~@(take n cs)))


Clojure: fixes to project.clj

Clojure: fixes to project.clj

--- scaffolds/clojure/project.clj
+++ scaffolds/clojure/project.clj
@@ -1,4 +1,4 @@
 (defproject code-retreat-scaffold-clj "0.1.0-SNAPSHOT"
   :description "Clojure code retreat scaffold"
-  :dependencies [[org.clojure/clojure "1.6.0"]]
-  :main "scaffold.core")
+  :dependencies [[org.clojure/clojure "1.8.0"]]
+  :main scaffold.core)


allow :eval-fn to be marked as async

allow :eval-fn to be marked as async

--- support/src/figwheel/client/utils.cljs
+++ support/src/figwheel/client/utils.cljs
@@ -41,10 +41,22 @@
             #(.log js/console %))]
      (f arg))))

-(defn eval-helper [code {:keys [eval-fn] :as opts}]
-  (if eval-fn
-    (eval-fn code opts)
-    (js* "eval(~{code})")))
+(defn async-eval-fn? [eval-fn]
+  (boolean (:async (meta eval-fn))))
+
+(defn eval-helper
+  "Evaluates javascript code in way specified by figwheel config (opts).
+   If there is custom eval-fn defined use it, otherwise call javascript eval on passed code.
+   Custom eval-fn can be marked as async. This can be used by Dirac DevTools."
+  ([code opts]
+   (eval-helper code opts identity))
+  ([code opts result-callback]
+    (let [{:keys [eval-fn]} opts]
+      (if eval-fn
+        (if (async-eval-fn? eval-fn)
+          (eval-fn code opts result-callback)
+          (result-callback (eval-fn code opts)))
+        (result-callback (js* "eval(~{code})"))))))

 (defn truncate-stack-trace [stack-str]
   (take-while #(not (re-matches #".*eval_javascript_STAR__STAR_.*" %))
@@ -64,10 +76,11 @@
   (try
     (binding [*print-fn* repl-print-fn
               *print-newline* false]
-      (result-handler
-        {:status     :success,
-         :ua-product (get-ua-product)
-         :value      (eval-helper code opts)}))
+      (eval-helper code opts (fn [result]
+                               (result-handler
+                                 {:status     :success,
+                                  :ua-product (get-ua-product)
+                                  :value      result}))))
     (catch js/Error e
       (result-handler
         {:status     :exception


added better feature detection for localStorage (#639)

--- support/src/figwheel/client/utils.cljs
+++ support/src/figwheel/client/utils.cljs
@@ -56,19 +56,19 @@
 (defn debug-prn [o]
   (when *print-debug*
     (let [o (if (or (map? o)
-                  (seq? o))
-            (prn-str o)
-            o)]
+                    (seq? o))
+              (prn-str o)
+              o)]
       (.log js/console o))))

 (defn log
   ([x] (log :info x))
   ([level arg]
    (let [f (condp = (if (html-or-react-native-env?) level :info)
-            :warn  #(.warn js/console %)
-            :debug #(.debug js/console %)
-            :error #(.error js/console %)
-            #(.log js/console %))]
+             :warn  #(.warn js/console %)
+             :debug #(.debug js/console %)
+             :error #(.error js/console %)
+             #(.log js/console %))]
      (f arg))))

 (defn eval-helper [code {:keys [eval-fn] :as opts}]
@@ -111,16 +111,21 @@
      (fn [_] (.succeed Deferred @results)))))

+(defn- feature? [obj feature]
+  (and (exists? obj)
+       (exists? (aget obj feature))))
+
+
 ;; persistent storage of configuration keys

 (defonce local-persistent-config
   (let [a (atom {})]
-    (when (exists? js/localStorage)
+    (when (feature? js/localStorage "setItem")
       (add-watch a :sync-local-storage
                  (fn [_ _ _ n]
-                    (mapv (fn [[ky v]]
-                            (.setItem js/localStorage (name ky) (pr-str v)))
-                          n))))
+                   (mapv (fn [[ky v]]
+                           (.setItem js/localStorage (name ky) (pr-str v)))
+                         n))))
     a))

 (defn persistent-config-set!
@@ -135,7 +140,7 @@
      (cond
        (contains? @local-persistent-config ky)
        (get @local-persistent-config ky)
-       (and (exists? js/localStorage)
+       (and (feature? js/localStorage "getItem")
             (.getItem js/localStorage (name ky)))
        (let [v (read-string (.getItem js/localStorage (name ky)))]
          (persistent-config-set! ky v)


Add hiccup.

Add hiccup.

--- src/beebster_clj/core.clj
+++ src/beebster_clj/core.clj
@@ -1,10 +1,10 @@
 (ns beebster-clj.core
-  (:require [compojure.route :as route])
+  (:require [compojure.route :as route]
+            [compojure.handler :as handler])
   (:use [ring.adapter.jetty :only [run-jetty]]
-        [net.cgrand.enlive-html :as html]
         [clojure.java.shell :only [sh]]
-        [compojure.core]
-        [clojure.string :as str :only [split-lines ]]))
+        [clojure.string :as str :only [split-lines ]]
+        hiccup.core hiccup.util hiccup.page compojure.core))

 (def iplayer-command
@@ -46,5 +46,14 @@
    [index mode]
   (apply str  "get_iplayer " mode "1" " -g  --nocopyright --output=\"$HOME/Videos\"" " " index))

+(defn search-page
+  "start html-page of beebster-clj"
+  []
+  (html
+   [:h3 "Search yourself"]))

+(defroutes app-routes
+  (GET "/" [] (search-page)))

+(def app
+  (handler/site app-routes))


Change old-recordings? arg to lst .

Change old-recordings? arg to lst .

--- src/beebster_clj/core.clj
+++ src/beebster_clj/core.clj
@@ -45,10 +45,9 @@

 (defn old-recordings?
   "Does get-iplayer complain about recorded programmes > 30 days?"
-  [str]
+  [lst]
   (seq (remove nil?
-               (map #(re-find #"These programmes should be deleted:" %) str))))
-
+               (map #(re-find #"These programmes should be deleted:" %) lst))))

 (defn iplayer-download-command


[:synsem :propernoun] is shared by parent and child

--- src/babel/english/grammar.clj
+++ src/babel/english/grammar.clj
@@ -157,25 +157,30 @@

                    (unifyc c10
                            comp-specs-head
-                           (let [number-agreement (ref :top)]
+                           (let [number-agreement (ref :top)
+                                 propernoun (ref :top)]
                              {:rule "noun-phrase1"
                               :aliases (list "np1")
                               :synsem {:agr {:number number-agreement}
                                        :cat :noun
+                                       :propernoun propernoun
                                        :sem {:number number-agreement
                                              :mod '()}}
-                              :head {:phrasal false}
+                              :head {:phrasal false
+                                     :propernoun propernoun}
                               :comp {:phrasal false}})) ;; rathole prevention ;; TODO: see if this can be removed.

                    (unifyc c10
                            comp-specs-head
-                           (let [number-agreement (ref :top)]
+                           (let [number-agreement (ref :top)
+                                 propernoun (ref :top)]
                              {:rule "noun-phrase2"
                               :aliases (list "np2")
                               :synsem {:agr {:number number-agreement}
                                        :cat :noun
                                        :sem {:number number-agreement}}
-                              :head {:phrasal true}
+                              :head {:phrasal true
+                                     :propernoun propernoun}
                               :comp {:phrasal false}})) ;; rathole prevention ;; TODO: see if this can be removed.

                    (unifyc h10