refactor events with chsk-send! to be declarative

--- src/braid/client/events.cljs
+++ src/braid/client/events.cljs
@@ -10,7 +10,10 @@
             [braid.client.state.helpers :as helpers]
             [braid.client.quests.helpers :as quest-helpers]))

+; TODO: handle callbacks declaratively too?
 (reg-fx :websocket-send (fn [args] (apply sync/chsk-send! args)))
+
+(reg-fx :redirect-to (fn [route] (router/go-to route)))

 (defn name->open-tag-id
   "Lookup tag by name in the open group"
@@ -125,7 +128,6 @@
          (list
            [:braid.server/new-message message]
            2000
-           ; TODO: handle callbacks declaratively too?
            (fn [reply]
              (when (not= :braid/ok reply)
                ; TODO
@@ -142,175 +144,176 @@
   (fn [state [_ err-key]]
     (helpers/clear-error state err-key)))

-(reg-event-db
+(reg-event-fx
   :resend-message
-  (fn [state [_ message]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/new-message message]
-      2000
-      (fn [reply]
-        (when (not= :braid/ok reply)
-          (dispatch [:display-error [(str :failed-to-send (message :id)) "Message failed to send!"]])
-          (dispatch [:set-message-failed message]))))
-
-    (-> state
-        (helpers/clear-error (str :failed-to-send (message :id)))
-        (helpers/clear-message-failed message))
-    ))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ message]]
+    {:websocket-send (list
+                       [:braid.server/new-message message]
+                       2000
+                       (fn [reply]
+                         (when (not= :braid/ok reply)
+                           (dispatch [:display-error
+                                      [(str :failed-to-send (message :id))
+                                       "Message failed to send!"]])
+                           (dispatch [:set-message-failed message]))))
+
+     :db (-> state
+             (helpers/clear-error (str :failed-to-send (message :id)))
+             (helpers/clear-message-failed message))}))
+
+(reg-event-fx
   :hide-thread
-  (fn [state [_ {:keys [thread-id local-only?]} ]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/hide-thread thread-id]))
-    (helpers/hide-thread state thread-id)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [thread-id local-only?]}]]
+    (merge
+      {:db (helpers/hide-thread state thread-id)}
+      (when-not local-only?
+        {:websocket-send (list [:braid.server/hide-thread thread-id])}))))
+
+(reg-event-fx
   :reopen-thread
-  (fn [state [_ thread-id]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/show-thread thread-id])
-    (helpers/show-thread state thread-id)))
+  (fn [{state :db :as cofx} [_ thread-id]]
+    {:websocket-send (list [:braid.server/show-thread thread-id])
+     :db (helpers/show-thread state thread-id)}))

 (reg-event-fx
   :unsub-thread
   (fn [cofx [_ data]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/unsub-thread (data :thread-id)])
-    {:dispatch [:hide-thread {:thread-id (data :thread-id) :local-only? true}]}))
-
-(reg-event-db
+    {:websocket-send (list [:braid.server/unsub-thread (data :thread-id)])
+     :dispatch [:hide-thread {:thread-id (data :thread-id) :local-only? true}]}))
+
+(reg-event-fx
   :create-tag
-  (fn [state [_ {:keys [tag local-only?]}]]
+  (fn [{state :db :as cofx} [_ {:keys [tag local-only?]}]]
     (let [tag (merge (schema/make-tag) tag)]
-      ; TODO
+      (merge
+        {:db (-> state
+                 (helpers/add-tag tag)
+                 (helpers/subscribe-to-tag (tag :id)))}
+        (when-not local-only?
+          {:websocket-send
+           (list
+             [:braid.server/create-tag tag]
+             1000
+             (fn [reply]
+               (if-let [msg (:error reply)]
+                 (do
+                   (dispatch [:remove-tag {:tag-id (tag :id) :local-only? true}])
+                   (dispatch [:display-error [(str :bad-tag (tag :id)) msg]])))))})))))
+
+(reg-event-fx
+  :unsubscribe-from-tag
+  (fn [{state :db :as cofx} [_ tag-id]]
+    {:websocket-send (list [:braid.server/unsubscribe-from-tag tag-id])
+     :db (helpers/unsubscribe-from-tag state tag-id)}))
+
+(reg-event-fx
+  :subscribe-to-tag
+  (fn [{state :db :as cofx} [_ {:keys [tag-id local-only?]}]]
+    (merge
+      {:db (helpers/subscribe-to-tag state tag-id)}
       (when-not local-only?
-        (sync/chsk-send!
-          [:braid.server/create-tag tag]
-          1000
-          (fn [reply]
-            (if-let [msg (:error reply)]
-              (do
-                (dispatch [:remove-tag {:tag-id (tag :id) :local-only? true}])
-                (dispatch [:display-error [(str :bad-tag (tag :id)) msg]]))))))
-      (-> state
-          (helpers/add-tag tag)
-          (helpers/subscribe-to-tag (tag :id))))))
-
-(reg-event-db
-  :unsubscribe-from-tag
-  (fn [state [_ tag-id]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/unsubscribe-from-tag tag-id])
-    (helpers/unsubscribe-from-tag state tag-id)))
-
-(reg-event-db
-  :subscribe-to-tag
-  (fn [state [_ {:keys [tag-id local-only?]}]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/subscribe-to-tag tag-id]))
-    (helpers/subscribe-to-tag state tag-id)))
-
-(reg-event-db
+        {:websocket-send (list [:braid.server/subscribe-to-tag tag-id])}))))
+
+(reg-event-fx
   :set-tag-description
-  (fn [state [_ {:keys [tag-id description local-only?]}]]
-    ; TODO
-    (when local-only?
-      (sync/chsk-send!
-        [:braid.server/set-tag-description {:tag-id tag-id :description description}]))
-    (helpers/set-tag-description state tag-id description)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [tag-id description local-only?]}]]
+    (merge
+      {:db (helpers/set-tag-description state tag-id description)}
+      (when-not local-only?
+        {:websocket-send
+         (list
+           [:braid.server/set-tag-description {:tag-id tag-id
+                                               :description description}])}))))
+
+(reg-event-fx
   :retract-tag
-  (fn [state [_ {:keys [tag-id local-only?]}]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/retract-tag tag-id]))
-    (helpers/remove-tag state tag-id)))
+  (fn [{state :db :as cofx} [_ {:keys [tag-id local-only?]}]]
+    (merge
+      {:db (helpers/remove-tag state tag-id)}
+      (when-not local-only?
+        {:websocket-send (list [:braid.server/retract-tag tag-id])}))))

 (reg-event-db
   :remove-group
   (fn [state [_ group-id]]
     (helpers/remove-group state group-id)))

-(reg-event-db
+(reg-event-fx
   :create-group
-  (fn [state [_ group]]
+  (fn [{state :db :as cofx} [_ group]]
     (let [group (schema/make-group group)]
-      ; TODO
-      (sync/chsk-send!
-        [:braid.server/create-group group]
-        1000
-        (fn [reply]
-          (when-let [msg (reply :error)]
-            (.error js/console msg)
-            (dispatch [:display-error [(str :bad-group (group :id)) msg]])
-            (dispatch [:remove-group (group :id)]))))
-      (-> state
-          (helpers/add-group group)
-          (helpers/become-group-admin (:id group))))))
+      {:websocket-send
+       (list
+         [:braid.server/create-group group]
+         1000
+         (fn [reply]
+           (when-let [msg (reply :error)]
+             (.error js/console msg)
+             (dispatch [:display-error [(str :bad-group (group :id)) msg]])
+             (dispatch [:remove-group (group :id)]))))
+       :db (-> state
+               (helpers/add-group group)
+               (helpers/become-group-admin (:id group)))})))

 (reg-event-db
   :update-user-nickname
   (fn [state [_ {:keys [nickname user-id]}]]
     (helpers/update-user-nickname state user-id nickname)))

-(reg-event-db
+(reg-event-fx
   :set-user-nickname
-  (fn [state [_ {:keys [nickname on-error]}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/set-nickname {:nickname nickname}]
-      1000
-      (fn [reply]
-        (if-let [msg (reply :error)]
-          (on-error msg)
-          (dispatch [:update-user-nickname
-                     {:nickname nickname
-                      :user-id (helpers/current-user-id state)}]))))
-    state))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [nickname on-error]}]]
+    {:websocket-send
+     (list
+       [:braid.server/set-nickname {:nickname nickname}]
+       1000
+       (fn [reply]
+         (if-let [msg (reply :error)]
+           (on-error msg)
+           (dispatch [:update-user-nickname
+                      {:nickname nickname
+                       :user-id (helpers/current-user-id state)}]))))}))
+
+(reg-event-fx
   :set-user-avatar
-  (fn [state [_ avatar-url]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/set-user-avatar avatar-url])
-    (helpers/update-user-avatar state (helpers/current-user-id state) avatar-url)))
+  (fn [{state :db :as cofx} [_ avatar-url]]
+    {:websocket-send (list [:braid.server/set-user-avatar avatar-url])
+     :db (helpers/update-user-avatar
+           state (helpers/current-user-id state) avatar-url)}))

 (reg-event-db
   :update-user-avatar
   (fn [state [_ {:keys [user-id avatar-url]}]]
     (helpers/update-user-avatar state user-id avatar-url)))

-(reg-event-db
+(reg-event-fx
   :set-password
-  (fn [state [_ [password on-success on-error]]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/set-password {:password password}]
-      3000
-      (fn [reply]
-        (cond
-          (reply :error) (on-error reply)
-          (= reply :chsk/timeout) (on-error
-                                    {:error "Couldn't connect to server, please try again"})
-          true (on-success))))
-    state))
+  (fn [cofx [_ [password on-success on-error]]]
+    {:websocket-send
+     (list
+       [:braid.server/set-password {:password password}]
+       3000
+       (fn [reply]
+         (cond
+           (reply :error) (on-error reply)
+           (= reply :chsk/timeout)
+           (on-error
+             {:error "Couldn't connect to server, please try again"})
+           true (on-success))))}))

 (reg-event-fx
   :add-notification-rule
   (fn [{state :db :as cofx} [_ rule]]
-    (let [current-rules (get (helpers/get-user-preferences state) :notification-rules [])]
+    (let [current-rules (get (helpers/get-user-preferences state)
+                          :notification-rules [])]
       {:dispatch [:set-preference [:notification-rules (conj current-rules rule)]]})))

 (reg-event-fx
   :remove-notification-rule
   (fn [{state :db :as cofx} [_ rule]]
-    (let [new-rules (->> (get (helpers/get-user-preferences state) :notification-rules [])
-                         (into [] (remove (partial = rule))))]
+    (let [new-rules (into [] (remove (partial = rule))
+                          (get (helpers/get-user-preferences state)
+                            :notification-rules []))]
       {:dispatch [:set-preference [:notification-rules new-rules]]})))

 (reg-event-db
@@ -323,57 +326,55 @@
   (fn [state [_ query]]
     (helpers/set-search-query state query)))

-(reg-event-db
+(reg-event-fx
   :search-history
-  (fn [state [_ [query group-id]]]
+  (fn [{state :db :as cofx} [_ [query group-id]]]
     (if query
-      ; TODO
-      (do (sync/chsk-send!
-            [:braid.server/search [query group-id]]
-            15000
-            (fn [reply]
-              (dispatch [:set-page-loading false])
-              (if (:thread-ids reply)
-                (dispatch [:set-search-results [query reply]])
-                (dispatch [:set-page-error true]))))
-          (helpers/set-page-error state false))
-      state)))
+      {:websocket-send
+       (list
+         [:braid.server/search [query group-id]]
+         15000
+         (fn [reply]
+           (dispatch [:set-page-loading false])
+           (if (:thread-ids reply)
+             (dispatch [:set-search-results [query reply]])
+             (dispatch [:set-page-error true]))))
+       :db (helpers/set-page-error state false)}
+      {})))

 (reg-event-db
   :add-threads
   (fn [state [_ threads]]
     (helpers/add-threads state threads)))

-(reg-event-db
+(reg-event-fx
   :load-recent-threads
-  (fn [state [_ {:keys [group-id on-error on-complete]}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/load-recent-threads group-id]
-      5000
-      (fn [reply]
-        (if-let [threads (:braid/ok reply)]
-          (dispatch [:add-threads threads])
-          (cond
-            (= reply :chsk/timeout) (on-error "Timed out")
-            (:braid/error reply) (on-error (:braid/error reply))
-            :else (on-error "Something went wrong")))
-        (on-complete (some? (:braid/ok reply)))))
-    state))
-
-(reg-event-db
+  (fn [cofx [_ {:keys [group-id on-error on-complete]}]]
+    {:websocket-send
+     (list
+       [:braid.server/load-recent-threads group-id]
+       5000
+       (fn [reply]
+         (if-let [threads (:braid/ok reply)]
+           (dispatch [:add-threads threads])
+           (cond
+             (= reply :chsk/timeout) (on-error "Timed out")
+             (:braid/error reply) (on-error (:braid/error reply))
+             :else (on-error "Something went wrong")))
+         (on-complete (some? (:braid/ok reply)))))}))
+
+(reg-event-fx
   :load-threads
-  (fn [state [_ {:keys [thread-ids on-complete]}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/load-threads thread-ids]
-      5000
-      (fn [reply]
-        (when-let [threads (:threads reply)]
-          (dispatch [:add-threads threads]))
-        (when on-complete
-          (on-complete))))
-    state))
+  (fn [cofx [_ {:keys [thread-ids on-complete]}]]
+    {:websocket-send
+     (list
+       [:braid.server/load-threads thread-ids]
+       5000
+       (fn [reply]
+         (when-let [threads (:threads reply)]
+           (dispatch [:add-threads threads]))
+         (when on-complete
+           (on-complete))))}))

 (reg-event-db
   :set-channel-results
@@ -390,31 +391,29 @@
   (fn [state [_ threads-count]]
     (helpers/set-pagination-remaining state threads-count)))

-(reg-event-db
+(reg-event-fx
   :threads-for-tag
-  (fn [state [_ {:keys [tag-id offset limit on-complete]
+  (fn [cofx [_ {:keys [tag-id offset limit on-complete]
                  :or {offset 0 limit 25}}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/threads-for-tag {:tag-id tag-id :offset offset :limit limit}]
-      2500
-      (fn [reply]
-        (when-let [results (:threads reply)]
-          (if (zero? offset)
-            ; initial load of threads
-            (dispatch [:set-channel-results results])
-            ; paging more results in
-            (dispatch [:add-channel-results results]))
-          (dispatch [:set-pagination-remaining (:remaining reply)])
-          (when on-complete (on-complete)))))
-    state))
-
-(reg-event-db
+    {:websocket-send
+     (list
+       [:braid.server/threads-for-tag {:tag-id tag-id :offset offset :limit limit}]
+       2500
+       (fn [reply]
+         (when-let [results (:threads reply)]
+           (if (zero? offset)
+             ; initial load of threads
+             (dispatch [:set-channel-results results])
+             ; paging more results in
+             (dispatch [:add-channel-results results]))
+           (dispatch [:set-pagination-remaining (:remaining reply)])
+           (when on-complete (on-complete)))))}))
+
+(reg-event-fx
   :mark-thread-read
-  (fn [state [_ thread-id]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/mark-thread-read thread-id])
-    (helpers/update-thread-last-open-at state thread-id)))
+  (fn [{state :db :as cofx} [_ thread-id]]
+    {:websocket-send (list [:braid.server/mark-thread-read thread-id])
+     :db (helpers/update-thread-last-open-at state thread-id)}))

 (reg-event-db
   :focus-thread
@@ -430,135 +429,120 @@
                  (map (fn [id] [:hide-thread {:thread-id id :local-only? false}])))
            (helpers/get-open-threads state))}))

-(reg-event-db
+(reg-event-fx
   :invite
-  (fn [state [_ data]]
+  (fn [cofx [_ data]]
     (let [invite (schema/make-invitation data)]
-      ; TODO
-      (sync/chsk-send! [:braid.server/invite-to-group invite])
-      state)))
-
-(reg-event-db
+      {:websocket-send (list [:braid.server/invite-to-group invite])})))
+
+(reg-event-fx
   :generate-link
-  (fn [state [_ {:keys [group-id expires complete]}]]
-    (sync/chsk-send!
-      ; TODO
-      [:braid.server/generate-invite-link {:group-id group-id :expires expires}]
-      5000
-      (fn [reply]
-        ; indicate error if it fails?
-        (when-let [link (:link reply)]
-          (complete link))))
-    state))
-
-(reg-event-db
+  (fn [cofx [_ {:keys [group-id expires complete]}]]
+    {:websocket-send
+     (list
+       [:braid.server/generate-invite-link {:group-id group-id :expires expires}]
+       5000
+       (fn [reply]
+         ; indicate error if it fails?
+         (when-let [link (:link reply)]
+           (complete link))))}))
+
+(reg-event-fx
   :accept-invite
-  (fn [state [_ invite]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/invitation-accept invite])
-    (helpers/remove-invite state invite)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ invite]]
+    {:websocket-send (list [:braid.server/invitation-accept invite])
+     :db (helpers/remove-invite state invite)}))
+
+(reg-event-fx
   :decline-invite
-  (fn [state [_ invite]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/invitation-decline invite])
-    (helpers/remove-invite state invite)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ invite]]
+    {:websocket-send (list [:braid.server/invitation-decline invite])
+     :db (helpers/remove-invite state invite)}))
+
+(reg-event-fx
   :make-admin
-  (fn [state [_ {:keys [group-id user-id local-only?] :as args}]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/make-user-admin args]))
-    (helpers/make-user-admin state user-id group-id)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [group-id user-id local-only?] :as args}]]
+    (merge
+      {:db (helpers/make-user-admin state user-id group-id)}
+      (when-not local-only?
+        {:websocket-send (list [:braid.server/make-user-admin args])}))))
+
+(reg-event-fx
   :remove-from-group
-  (fn [state [ _ {:keys [group-id user-id] :as args}]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/remove-from-group args])
-    state))
-
-(reg-event-db
+  (fn [cofx [ _ {:keys [group-id user-id] :as args}]]
+    {:websocket-send (list [:braid.server/remove-from-group args])}))
+
+(reg-event-fx
   :set-group-intro
-  (fn [state [_ {:keys [group-id intro local-only?] :as args}]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/set-group-intro args]))
-    (helpers/set-group-intro state group-id intro)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [group-id intro local-only?] :as args}]]
+    (merge
+      {:db (helpers/set-group-intro state group-id intro)}
+      (when-not local-only?
+        {:websocket-send (list [:braid.server/set-group-intro args])}))))
+
+(reg-event-fx
   :set-group-avatar
-  (fn [state [_ {:keys [group-id avatar local-only?] :as args}]]
-    ; TODO
-    (when-not local-only?
-      (sync/chsk-send! [:braid.server/set-group-avatar args]))
-    (helpers/set-group-avatar state group-id avatar)))
-
-(reg-event-db
+  (fn [{state :db :as cofx} [_ {:keys [group-id avatar local-only?] :as args}]]
+    (merge
+      {:db (helpers/set-group-avatar state group-id avatar)}
+      (when-not local-only?
+        {:websocket-send (list [:braid.server/set-group-avatar args])}))))
+
+(reg-event-fx
   :make-group-public!
-  (fn [state [_ group-id]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/set-group-publicity [group-id true]])
-    state))
-
-(reg-event-db
+  (fn [cofx [_ group-id]]
+    {:websocket-send (list [:braid.server/set-group-publicity [group-id true]])}))
+
+(reg-event-fx
   :make-group-private!
-  (fn [state [_ group-id]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/set-group-publicity [group-id false]])
-    state))
-
-(reg-event-db
+  (fn [cofx [_ group-id]]
+    {:websocket-send (list [:braid.server/set-group-publicity [group-id false]])}))
+
+(reg-event-fx
   :new-bot
-  (fn [state [_ {:keys [bot on-complete]}]]
+  (fn [cofx [_ {:keys [bot on-complete]}]]
     (let [bot (schema/make-bot bot)]
-      ; TODO
-      (sync/chsk-send!
-        [:braid.server/create-bot bot]
-        5000
-        (fn [reply]
-          (when (nil? (:braid/ok reply))
-            (dispatch [:display-error
-                       [(str "bot-" (bot :id) (rand))
-                        (get reply :braid/error
-                          "Something when wrong creating bot")]]))
-          (on-complete (:braid/ok reply)))))
-    state))
-
-(reg-event-db
+      {:websocket-send
+       (list
+         [:braid.server/create-bot bot]
+         5000
+         (fn [reply]
+           (when (nil? (:braid/ok reply))
+             (dispatch [:display-error
+                        [(str "bot-" (bot :id) (rand))
+                         (get reply :braid/error
+                           "Something when wrong creating bot")]]))
+           (on-complete (:braid/ok reply))))})))
+
+(reg-event-fx
   :get-bot-info
-  (fn [state [_ {:keys [bot-id on-complete]}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/get-bot-info bot-id]
-      2000
-      (fn [reply]
-        (when-let [bot (:braid/ok reply)]
-          (on-complete bot))))
-    state))
+  (fn [cofx [_ {:keys [bot-id on-complete]}]]
+    {:websocket-send
+     (list
+       [:braid.server/get-bot-info bot-id]
+       2000
+       (fn [reply]
+         (when-let [bot (:braid/ok reply)]
+           (on-complete bot))))}))

 (reg-event-fx
   :create-upload
   (fn [{state :db :as cofx} [_ {:keys [url thread-id group-id]}]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/create-upload
-                      (schema/make-upload {:url url :thread-id thread-id})])
-    {:dispatch [:new-message {:content url :thread-id thread-id :group-id group-id}]}))
-
-(reg-event-db
+    {:websocket-send (list [:braid.server/create-upload
+                            (schema/make-upload {:url url :thread-id thread-id})])
+     :dispatch [:new-message {:content url :thread-id thread-id :group-id group-id}]}))
+
+(reg-event-fx
   :get-group-uploads
-  (fn [state [_ {:keys [group-id on-success on-error]}]]
-    ; TODO
-    (sync/chsk-send!
-      [:braid.server/uploads-in-group group-id]
-      5000
-      (fn [reply]
-        (if-let [uploads (:braid/ok reply)]
-          (on-success uploads)
-          (on-error (get reply :braid/error "Couldn't get uploads in group")))))
-    state))
+  (fn [cofx [_ {:keys [group-id on-success on-error]}]]
+    {:websocket-send
+     (list
+       [:braid.server/uploads-in-group group-id]
+       5000
+       (fn [reply]
+         (if-let [uploads (:braid/ok reply)]
+           (on-success uploads)
+           (on-error (get reply :braid/error "Couldn't get uploads in group")))))}))

 (reg-event-db
   :check-auth
@@ -642,12 +626,11 @@
   (fn [state [_ bool]]
     (helpers/set-page-error state bool)))

-(reg-event-db
+(reg-event-fx
   :set-preference
-  (fn [state [_ [k v]]]
-    ; TODO
-    (sync/chsk-send! [:braid.server/set-preferences {k v}])
-    (helpers/set-preferences state {k v})))
+  (fn [{state :db :as cofx} [_ [k v]]]
+    {:websocket-send (list [:braid.server/set-preferences {k v}])
+     :db (helpers/set-preferences state {k v})}))

 (reg-event-db
   :add-users
@@ -689,27 +672,26 @@
         (helpers/set-open-threads (data :user-threads))
         (quest-helpers/set-quest-records (data :quest-records)))))

-(reg-event-db
+(reg-event-fx
   :leave-group
-  (fn [state [_ {:keys [group-id group-name]}]]
-    ; TODO
-    ; need to :remove-group before router is dispatched below)
-    (dispatch [:remove-group group-id])
-    (when (= group-id (helpers/get-open-group-id state))
-      (router/go-to "/"))
-    (-> state
-        (helpers/display-error (str "left-" group-id)
-                               (str "You have been removed from " group-name)
-                               :info)
-        ; need this here also so the state gets changed when this dispatcher returns
-        (helpers/remove-group group-id)
-        ((fn [state]
-           (if-let [sidebar-order (:groups-order (helpers/get-user-preferences state))]
-             (helpers/set-preferences
-               state
-               {:groups-order (into [] (remove (partial = group-id))
-                                    sidebar-order)})
-             state))))))
+  (fn [{state :db :as cofx} [_ {:keys [group-id group-name]}]]
+    (merge
+      {:db
+       (-> state
+           (helpers/display-error (str "left-" group-id)
+                                  (str "You have been removed from " group-name)
+                                  :info)
+           (helpers/remove-group group-id)
+           ((fn [state]
+              (if-let [sidebar-order (:groups-order
+                                       (helpers/get-user-preferences state))]
+                (helpers/set-preferences
+                  state
+                  {:groups-order (into [] (remove (partial = group-id))
+                                       sidebar-order)})
+                state))))}
+      (when (= group-id (helpers/get-open-group-id state))
+        {:redirect-to "/"}))))

 (reg-event-db
   :add-open-thread


added comments, improved function names

added comments, improved function names

--- src/distillery/view/video.clj
+++ src/distillery/view/video.clj
@@ -36,6 +36,7 @@
              (TODO "Videoübersicht")))

 (defn- format-time
+  "Creates a pretty time string from total seconds."
   [seconds]
   (let [h (int (/ seconds (* 60 60)))
         m (int (mod (/ seconds 60) 60))
@@ -45,32 +46,35 @@
       (format "%02d:%02d" m s))))

 (defn- confidence-color
+  "Creates a CSS compatible color definition string for a given confidence value."
   [confidence]
   (let [v (int (* (- 1 confidence) 192))]
     (format "#%02X%02X%02X" v v v)))

-(defn- format-word
+(defn- render-word
+  "Creates the HTML for a recognized word."
   [{:keys [text confidence pronunciation]}]
   {:tag :span
    :attrs {:style (str "color:" (confidence-color (* confidence confidence)))
           :title pronunciation}
    :content (str text " ")})

-(defn- format-phrase
+(defn- render-phrase
+  "Creates the HTML for the words of a recognized phrase."
   [{:keys [words]}]
-  (map format-word words))
+  (map render-word words))

-(defn- format-result
+(defn- render-result
   "Creates the HTML for a single phrase."
   [result]
   (div "phrase" [(span "tc" (jslink (format "video_jump(%f)" (double (:start result))) (format-time (:start result))))
-                 (span "pt" (format-phrase result))]))
+                 (span "pt" (render-phrase result))]))

 (defn- render-transcript
   "Creates the HTML for the transcript with all phrases."
   [{{:keys [results] :as video} :video :as args}]
   (innerpage "transcript" "Transkript" false
-              (div "transcript" (map format-result results))))
+              (div "transcript" (map render-result results))))

 (defn- render-glossary-word
   "Creates the HTML for a glossary entry."


Homomorphism

Homomorphism

--- test/clojureplayground/monads_learn_test.clj
+++ test/clojureplayground/monads_learn_test.clj
@@ -36,10 +36,41 @@

     ;Again, applicative functors must obey to the particular laws

+    ;Identity
     ;Feeding a function f to pure and applying the resulting
     ; Applicative to the Functor v should be the same as
     ; directly mapping f over the Functor v

     ;Haskell way: pure f <*> v = fmap f v
     (testing "Identity"
-      (is (= (<*> (pure List inc) xs) (fmap xs inc))))))
+      (is (= (<*> (pure List inc) xs) (fmap xs inc))))
+
+    ;Composition
+    ;The result of applying an Applicative Functor
+    ; that yields the function composition operator to the Applicative u,
+    ; then apply the resulting Functor to v and finally applying that result
+    ; to the final Applicative w should be the same as applying v to w and
+    ; then applying u to the resulting Applicative.
+
+    ;Haskell way: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
+    (testing "Composition"
+      (let [u (->List [#(* 2 %)])
+            v (->List [#(+ 10 %)])
+            w xs]                                           ;just re-using same functor with other name to match haskell way above
+        (is (= (-> (pure List #(partial comp %))
+                   (<*> u)
+                   (<*> v)
+                   (<*> w))
+               (<*> u (<*> v w))))))
+
+    ;Homomorphism
+    ;The result of applying the pure value of f to the pure value of x
+    ; should be the same as applying f directly to x and then feeding that into pure.
+
+    ;Haskell way: pure f <*> pure x = pure (f x)
+    (testing "Homomorphism"
+      (let [f #(* 2 %) x 10]
+        ;Original example favors thread first macro -> but I think that
+        ;in this case this explicit version makes more clear what is going on
+        (is (= (<*> (pure List f) (pure List x))
+               (pure List (f x))))))))


Functor laws tests added for host vectors and matrices.

--- test/uncomplicate/neanderthal/block_test.clj
+++ test/uncomplicate/neanderthal/block_test.clj
@@ -8,8 +8,10 @@

 (ns uncomplicate.neanderthal.block-test
   (:require [midje.sweet :refer [facts throws => roughly]]
-            [uncomplicate.commons.core :refer [release with-release]]
-            [uncomplicate.fluokitten.core :refer [fmap! fold foldmap op]]
+            [uncomplicate.commons.core :refer [release with-release double-fn]]
+            [uncomplicate.fluokitten
+             [core :refer [fmap! fold foldmap op]]
+             [test :refer :all]]
             [uncomplicate.neanderthal.core :refer :all])
   (:import  [clojure.lang IFn$LLD IFn$LD IFn$DD ExceptionInfo]))

@@ -399,6 +401,37 @@
          (seq (tr factory 3 (range 1 7) {:layout :row :uplo :lower :diag :unit}))
          => (list (list) (list 1.0) (list 2.0 3.0))))

+(defn test-vctr-functor-laws [factory]
+  (let [pinc (double-fn (partial + 1))
+        p*100 (double-fn (partial * 100))
+        p+ (double-fn +)]
+    (facts "Monadic laws for vector."
+           (functor-law2 pinc p*100 (vctr factory [1 -199 9]))
+           (functor-law2 pinc p*100 (vctr factory [1 -199 9] (vctr factory [1 -66 9])))
+           (fmap-keeps-type pinc (vctr factory [100 0 -999]))
+           (fmap-keeps-type p+ (vctr factory [100 0 -999]) (vctr factory (list 44 0 -54))))))
+
+(defn test-ge-functor-laws [factory creator]
+  (let [pinc (double-fn (partial + 1))
+        p*100 (double-fn (partial * 100))
+        p+ (double-fn +)]
+    (facts "Monadic laws for GE matrices."
+           (functor-law2 pinc p*100 (creator factory 3 2 [1 -199 9 7 8 19]))
+           (functor-law2 pinc p*100 (creator factory 2 3 [1 -199 9 8 -7 -1])
+                         (creator factory 2 3 [9 8 -7 1 -66 9]))
+           (fmap-keeps-type pinc (creator factory 1 9 [1 2 3 4 5 6 100 0 -999]))
+           (fmap-keeps-type p+ (creator factory 0 0) (ge factory 0 0)))))
+
+(defn test-sspar-mat-functor-laws [factory creator]
+  (let [pinc (double-fn (partial + 1))
+        p*100 (double-fn (partial * 100))
+        p+ (double-fn +)]
+    (facts "Monadic laws for UPLO and packed matrices."
+           (functor-law2 pinc p*100 (creator factory 3 [1 -199 9 7 8 19]))
+           (functor-law2 pinc p*100 (creator factory 2 [1 -199 9] (creator factory 2 [9 8 -7])))
+           (fmap-keeps-type pinc (creator factory 5 [1 2 3 4 5 6 100 0 -999]))
+           (fmap-keeps-type p+ (creator factory 0) (creator factory 0)))))
+
 (defn test-all [factory]
   (test-create factory)
   (test-equality factory)
@@ -425,4 +458,15 @@
   (test-tr-functor factory)
   (test-tr-fold factory)
   (test-tr-reducible factory)
-  (test-tr-seq factory))
+  (test-tr-seq factory)
+  (test-vctr-functor-laws factory)
+  (test-ge-functor-laws factory ge)
+  (test-ge-functor-laws factory gb)
+  (test-sspar-mat-functor-laws factory tr)
+  (test-sspar-mat-functor-laws factory sy)
+  (test-sspar-mat-functor-laws factory sb)
+  (test-sspar-mat-functor-laws factory sp)
+  (test-sspar-mat-functor-laws factory tp)
+  (test-sspar-mat-functor-laws factory gd)
+  (test-sspar-mat-functor-laws factory gt)
+  (test-sspar-mat-functor-laws factory st))


Update tools-deps to 1.11.1.1139

Update tools-deps to 1.11.1.1139


resource path

resource path

--- bot/dl.clj
+++ bot/dl.clj
@@ -25,8 +25,9 @@
                                                     genus (str/lower-case species)]))
                                 (catch Exception e
                                   (println "caught exception: " (.getMessage e))
-                                  {:vn_name (str genus (str/lower-case species))}))]
-    [vn_name (str genus (str/lower-case species) " - " score) url]))
+                                  {:vn_name (str genus " " (str/lower-case species))
+                                   :url "http://www.vncreatures.net/hinhanh.php?nhom=1&loai=3"}))]
+    [vn_name (str genus " " (str/lower-case species) " - " score) url]))

 (defn- label-image [image-url]
   (let [{:keys [status body]} @(http/get dl-server


finished first-round documentation for the core fn feajures

--- src/fogus/me/trammel/impl.clj
+++ src/fogus/me/trammel/impl.clj
@@ -58,17 +58,53 @@
     (build-constraints-map expectations)
     (list* 'f sig)))

-(defn collect-bodies [forms]
+(defn collect-bodies
+  "Where the magic happens.  Takes a list representing the idependent constraints for
+   an unspecified function of the form:
+
+    ([x] :requires (foo x) :ensures (bar %)
+     [x y] :requires (baz x) (quux y) :ensures (blip %))
+
+   Taking this form `collect-bodies` then partitions it in such a way as to identify
+   the arity-based canstraints and pass each on to `build-contract` which then
+   returns the HOF body for each arity.
+  "
+  [forms]
   (for [body (->> (partition-by vector? forms)
                   (partition 2))]
     (build-contract body)))

 (defn build-forms-map
+  "Works similarly to the `collect-bodies` function *except* for two differences:
+   1. Recognizes and processes a `:body` element
+   2. Requires that multi-arity functions *must* be enclosed in sublists similar to
+      Clojure's default `fn` form.
+
+   The reason for the former is that the `:body` element refers to the body of the
+   generated function.  Without arity-sepcific body sublists there would be no way to
+   determine when a body ends and another arity constraint specification begins.  This
+   should be no problem since Clojurist are already accustomed to the multi-arity `fn`
+   form.
+
+   This function expects a list of the form:
+
+    ([x] :requires (foo x) (bar n) :ensures (baz %) :body (println x) (frob x))
+
+   or
+
+    (([x] :requires (foo x) :ensures (baz %) :body (frob x))
+     ([x y] :requires (foo x y) :ensures (baz %) :body (frob x y)))
+
+   And will return a map keyed by arity vector of the form:
+
+    {[x] {(:requires) ((foo x)), (:body) ((frob x)), (:ensures) ((baz %))}}
+
+   Which can then be used to build a real function definition by looking up the
+   constraints and body for each arity.
+  "
   [forms]
   (for [[[e] & c] (map #(partition-by keyword? %)
                        (if (vector? (first forms))
                          (list forms)
                          forms))]
     {e (apply hash-map c)}))
-
-


Move org settings to card and revise copy

* Move org settings to card and revise copy

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -44,26 +44,23 @@
   (reify
     om/IRender
     (render [_]
-      (html [:div.row-fluid.plans
-             [:div.span12
-              [:h3
-               "Do you want to create a plan for an organization that you don't admin?"]
-              [:ol
-               [:li
-                "Sign up for a plan from your "
+      (html
+        [:div
+         (card/titled {:title "Organization Admin Permission Needed"}
+           (html
+             [:div.body
+               [:p "To view/edit this page, you must be an organization admin on your VCS-provider (e.g., Github)."]
+               [:p "As a non-admin, you may still create a plan for this organization by signing up for a plan under your "
                 [:a {:href (routes/v1-org-settings-path {:org login
                                                          :vcs_type vcs_type
                                                          :_fragment "containers"})}
-                 "\"personal organization\" page"]]
-               [:li
-                "Add " org-name
-                " to the list of organizations you pay for or transfer the plan to "
-                org-name " from the "
+                 "personal organization"]
+                " and then "
                 [:a {:href (routes/v1-org-settings-path {:org login
                                                          :vcs_type vcs_type
                                                          :_fragment "organizations"})}
-                 "plan's organization page"]
-                "."]]]]))))
+                 "paying for/transfering"]
+                " your personal plan to " org-name "."]]))]))))

 (defn users [app owner]
   (reify


You can't actually get to this page without being an admin.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -899,20 +899,19 @@
         (when (pm/paid? plan)
           [:p
            (str (pm/paid-containers plan) " of these are paid, at $" (pm/stripe-cost plan) "/month. ")
-           (when (pm/admin? plan)
-             (if (pm/grandfathered? plan)
-               (list "We've changed our pricing model since this plan began, so its current price "
-                     "is grandfathered in. "
-                     "It would be $" (pm/cost plan (pm/usable-containers plan)) " at current prices. "
-                     "We'll switch it to the new model if you upgrade or downgrade. ")
-               (list
-                "You can "
-                ;; make sure to link to the add-containers page of the plan's org,
-                ;; in case of piggiebacking.
-                [:a {:href (routes/v1-org-settings-subpage {:org (:org_name plan)
-                                                            :subpage "add-containers"})}
-                 "add more"]
-                " at $" container-cost " per container for more parallelism and shorter queue times.")))])
+           (if (pm/grandfathered? plan)
+             (list "We've changed our pricing model since this plan began, so its current price "
+                   "is grandfathered in. "
+                   "It would be $" (pm/cost plan (pm/usable-containers plan)) " at current prices. "
+                   "We'll switch it to the new model if you upgrade or downgrade. ")
+             (list
+              "You can "
+              ;; make sure to link to the add-containers page of the plan's org,
+              ;; in case of piggiebacking.
+              [:a {:href (routes/v1-org-settings-subpage {:org (:org_name plan)
+                                                          :subpage "add-containers"})}
+               "add more"]
+              " at $" container-cost " per container for more parallelism and shorter queue times."))])
         (when  (pm/freemium? plan)
           [:p (str (pm/freemium-containers plan) " container is free, forever.")])
         [:p "Additionally, projects that are public on GitHub will build with " pm/oss-containers " extra containers -- our gift to free and open source software."]]]))))


Remove debug print

Remove debug print

--- src/circle/backend/build.clj
+++ src/circle/backend/build.clj
@@ -62,7 +62,6 @@
      ~@body))

 (defn build-log [message & args]
-  (println "build-log:" message)
   (throw-if-not *log-ns* "Log NS is not set")
   (log *log-ns* :info nil (apply format message args)))


sizes

sizes

--- src/clj/just_married/css.clj
+++ src/clj/just_married/css.clj
@@ -46,7 +46,6 @@
   {:desktop {:background-color (:dark-red COLOR-PALLETTE)
              :font-weight "bolder"
              :display "grid"
-             :font-size "1.5em"
              :grid-template-columns menu-size
              :grid-auto-rows "auto"
              :grid-gap "1em"
@@ -63,7 +62,6 @@
    :mobile {:background-color (:dark-red COLOR-PALLETTE)
             :font-weight "bolder"
             :display "grid"
-            :font-size "2em"
             :grid-template-columns "auto"
             :grid-template-rows menu-size
             :grid-auto-rows "auto"


Lowered time to guess

Lowered time to guess

--- src/cljs/db_quiz/config.cljs
+++ src/cljs/db_quiz/config.cljs
@@ -8,7 +8,8 @@
              :hover "#dedede"
              :missed "#333333"
              :player-1 "#fc4349"
-             :player-2 "#2c3e50"}
+             :player-2 "#354d65" ;"#2c3e50"
+             }
    :data {:sparql {; Maximum number of results per query
                    :page-size 5000}}
    :guess-similarity-threshold 0.94
@@ -27,6 +28,6 @@
    ; Maximum number of characters in a question
    :max-question-length 500
    ; Available time for making a guess (in seconds)
-   :time-to-guess 60
+   :time-to-guess 45
    ; Time to display the correct answer (in seconds)
    :verdict-display-time 5})


Simplify header-types

Simplify header-types

--- src/clojure_fabric/proto.clj
+++ src/clojure_fabric/proto.clj
@@ -137,20 +137,20 @@
   ([ts]
    (map->ProtoTimestamp {:seconds (quot ts 1000) :nanos (-> (rem ts 1000) (* 1000000))})))

-(defonce header-types {:message                 Common$HeaderType/MESSAGE
-                       :config                  Common$HeaderType/CONFIG
-                       :config-update           Common$HeaderType/CONFIG_UPDATE
-                       :endorser-transaction    Common$HeaderType/ENDORSER_TRANSACTION
-                       :orderer-transaction     Common$HeaderType/ORDERER_TRANSACTION
-                       :deliver-seek-info       Common$HeaderType/DELIVER_SEEK_INFO
-                       :chaincode-package       Common$HeaderType/CHAINCODE_PACKAGE})
+(defonce header-types {:message                 Common$HeaderType/MESSAGE_VALUE
+                       :config                  Common$HeaderType/CONFIG_VALUE
+                       :config-update           Common$HeaderType/CONFIG_UPDATE_VALUE
+                       :endorser-transaction    Common$HeaderType/ENDORSER_TRANSACTION_VALUE
+                       :orderer-transaction     Common$HeaderType/ORDERER_TRANSACTION_VALUE
+                       :deliver-seek-info       Common$HeaderType/DELIVER_SEEK_INFO_VALUE
+                       :chaincode-package       Common$HeaderType/CHAINCODE_PACKAGE_VALUE})

 (defrecord ChannelHeader [^Long type ^Long version ^Long timestamp ^String channel-id
                           ^String tx-id ^Long epoch extension]
   ICljToProto
   (clj->proto [this]
     (cond-> (Common$ChannelHeader/newBuilder)
-      type (.setType (.getNumber ^Common$HeaderType (header-types type)))
+      type (.setType (header-types type))
       version (.setVersion version)
       timestamp (.setTimestamp ^Timestamp (clj->proto (make-timestamp timestamp)))
       channel-id (.setChannelId channel-id)


Use v2 API

Use v2 API

--- src/grimoire/api/web/read.clj
+++ src/grimoire/api/web/read.clj
@@ -25,7 +25,7 @@

 ;; Interacting with the datastore - reading
 ;;--------------------------------------------------------------------
-(def baseurl "/api/v1/")
+(def baseurl "/api/v2/")

 (defn grim-succeed?
   "λ [t] → Bool


Added scrollbars to make-lattice-editor

Added scrollbars to make-lattice-editor

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

--- src/conexp/graphics/draw.clj
+++ src/conexp/graphics/draw.clj
@@ -18,7 +18,7 @@
 	[clojure.contrib.swing-utils :only (do-swing)])
   (:import [javax.swing JFrame JPanel JButton JTextField JLabel
 	                JOptionPane JSeparator SwingConstants
-	                BoxLayout Box]
+	                BoxLayout Box JScrollBar]
 	   [java.awt Canvas Color Dimension BorderLayout GridLayout Component Graphics]
 	   [java.awt.event ActionListener]))

@@ -194,7 +194,11 @@
 	scn (draw-on-scene (layout-function lattice)),
 	canvas (.. scn getWindow getCanvas),

-	buttons (JPanel.),
+	#^JPanel canvas-panel (JPanel. (BorderLayout.)),
+	hscrollbar (JScrollBar. JScrollBar/HORIZONTAL),
+	vscrollbar (JScrollBar. JScrollBar/VERTICAL),
+
+	#^JPanel buttons (JPanel.),
 	box-layout (BoxLayout. buttons BoxLayout/Y_AXIS)]
     (.setLayout buttons box-layout)
     (.setPreferredSize buttons (Dimension. 110 0))
@@ -203,8 +207,13 @@
       change-parameters
       improve-layout-by-force
       export-as-file)
+    (doto canvas-panel
+      (.add canvas BorderLayout/CENTER)
+      (.add hscrollbar BorderLayout/SOUTH)
+      (.add vscrollbar BorderLayout/EAST))
+    (.installScrollHandler scn hscrollbar vscrollbar)
     (doto main-panel
-      (.add canvas BorderLayout/CENTER)
+      (.add canvas-panel BorderLayout/CENTER)
       (.add buttons BorderLayout/WEST))
     main-panel))


Clean up `assortment-pre-wrap` options

Clean up `assortment-pre-wrap` options

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -813,8 +813,7 @@
   `assortment` for more info)

   Returns a boot `with-pre-wrap` result"
-  [{{:keys [comparator filterer sortby meta renderer] :as options*} :options
-    :keys [task-name tracer grouper]}]
+  [{:keys [task-name comparator filterer sortby grouper meta renderer tracer] :as options*}]
   (cond (not (fn? comparator))
         (u/fail (str task-name " task :comparator option should implement Fn\n"))
         (not (ifn? filterer))
@@ -871,12 +870,12 @@
    s sortby     SORTBY     code  "sort entries by function"
    c comparator COMPARATOR code  "sort by comparator function"
    m meta       META       edn   "metadata to set on each collection entry"]
-  (let [grouper (or grouper #(-> {"index.html" {:entries %}}))
-        options (merge +assortment-defaults+ (dissoc *opts* :grouper))]
-    (assortment-pre-wrap {:task-name "assortment"
-                          :tracer :io.perun/assortment
-                          :grouper grouper
-                          :options options})))
+  (let [options (merge +assortment-defaults+
+                       *opts*
+                       {:task-name "assortment"
+                        :tracer :io.perun/assortment
+                        :grouper (or grouper #(-> {"index.html" {:entries %}}))})]
+    (assortment-pre-wrap options)))

 (def ^:private +collection-defaults+
   {:out-dir "public"
@@ -906,11 +905,13 @@
    c comparator COMPARATOR code  "sort by comparator function"
    p page       PAGE       str   "collection result page path"
    m meta       META       edn   "metadata to set on each collection entry"]
-  (let [p (or page "index.html")]
-    (assortment-pre-wrap {:task-name "collection"
-                          :tracer :io.perun/collection
-                          :grouper #(-> {p {:entries %}})
-                          :options (merge +collection-defaults+ (dissoc *opts* :page))})))
+  (let [p (or page "index.html")
+        options (merge +collection-defaults+
+                       (dissoc *opts* :page)
+                       {:task-name "collection"
+                        :tracer :io.perun/collection
+                        :grouper #(-> {p {:entries %}})})]
+    (assortment-pre-wrap options)))

 (def ^:private +tags-defaults+
   {:out-dir "public"
@@ -947,11 +948,13 @@
                                    (-> result
                                        (update-in [path :entries] conj entry)
                                        (assoc-in [path :entry :tag] tag))))
-                               {})))]
-    (assortment-pre-wrap {:task-name "tags"
-                          :tracer :io.perun/tags
-                          :grouper grouper
-                          :options (merge +tags-defaults+ *opts*)})))
+                               {})))
+        options (merge +tags-defaults+
+                       *opts*
+                       {:task-name "tags"
+                        :tracer :io.perun/tags
+                        :grouper grouper})]
+    (assortment-pre-wrap options)))

 (def ^:private +paginate-defaults+
   {:out-dir "public"
@@ -983,7 +986,7 @@
    s sortby     SORTBY     code  "sort entries by function"
    c comparator COMPARATOR code  "sort by comparator function"
    m meta       META       edn   "metadata to set on each collection entry"]
-  (let [{:keys [sortby comparator page-size prefix] :as options} (merge +paginate-defaults+ *opts*)
+  (let [{:keys [sortby comparator page-size prefix] :as options*} (merge +paginate-defaults+ *opts*)
         grouper (fn [entries]
                   (->> entries
                        (sort-by sortby comparator)
@@ -991,11 +994,12 @@
                        (map-indexed #(-> [(str prefix (inc %1) ".html")
                                           {:entry {:page (inc %1)}
                                            :entries %2}]))
-                       (into {})))]
-    (assortment-pre-wrap {:task-name "paginate"
-                          :tracer :io.perun/paginate
-                          :grouper grouper
-                          :options options})))
+                       (into {})))
+        options (assoc options*
+                       :task-name "paginate"
+                       :tracer :io.perun/paginate
+                       :grouper grouper)]
+    (assortment-pre-wrap options)))

 (def +inject-scripts-defaults+
   {:extensions [".html"]})


more work on command-line interface

more work on command-line interface

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -12,14 +12,6 @@
 (defn fail [& msg]
   (if msg (println (apply str msg)))
   (System/exit 1))
-
-(defn nmlget [tree nml key]
-  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
-        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
-        values   (last nvsubseq)
-        value    (if (nil? values) "" (nmlstr values))]
-    (println (str nml ":" key " " value))
-    tree))

 (defn nmlname [x]
   (nmlstr (second x)))
@@ -71,6 +63,14 @@
                  :ws       ""
                  :wsopt    ""))))

+(defn nmlget [tree nml key]
+  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
+        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
+        values   (last nvsubseq)
+        value    (if (nil? values) "" (nmlstr values))]
+    (println (str nml ":" key "=" value))
+    tree))
+
 (defn nmlset [tree nml key val & sub]
   (let [child (if sub :nvsubseq :stmt)
         match (if sub key nml)
@@ -78,24 +78,30 @@
         f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
     (insta/transform {child f} tree)))

-(defn nmltree [f]
-  (try (parse (slurp f))
-       (catch Exception e (fail "Could not open namelist file '" f "'"))))
+(defn nmltree [fname]
+  (try (parse (slurp fname))
+       (catch Exception e (fail "Could not open namelist file '" fname "'"))))

-(defn process [tree commands]
+(defn nk [x]
+  (string/split x #":" 2))
+
+(defn nkv [x]
+  (let [[nmlkey val] (string/split x #"=" 2)]
+    (concat (nk nmlkey) (list val))))
+
+(defn exe [tree commands]
   (if (empty? commands)
     tree
     (let [cmd (first commands)
           arg (second commands)
           rst (drop 2 commands)]
       (case cmd
-        "--get" (let [[nml key] (string/split arg #":")]
-                  (process (nmlget tree nml key) rst))
-        "--set" (println "### set!")))))
+        "--get" (let [[nml key    ] (nk  arg)] (exe (nmlget tree nml key)     rst))
+        "--set" (let [[nml key val] (nkv arg)] (exe (nmlset tree nml key val) rst))))))

 (defn -main [& args]
   (alter-var-root #'*read-eval* (constantly false))
   (let [commands (butlast args)
         filename (last args)
         tree (nmltree filename)]
-    (println (nmlstr (process tree commands)))))
+    (println (nmlstr (exe tree commands)))))


Support ABT v.20 and deprecate anything less than v.17

Fixes #97 and #100. Shout-out to @worrel for writing the original pull request.

--- src/leiningen/droid/utils.clj
+++ src/leiningen/droid/utils.clj
@@ -39,7 +39,6 @@
   Unix and Windows platforms."
   [sdk-path build-tools-version]
   (ensure-paths sdk-path)
-  ;; for now just try to infer whether we're having build-tools 17
   (let [bt-root-dir (file sdk-path "build-tools")
         ;; build-tools directory contains a subdir which name we don't
         ;; know that has all the tools. Let's grab the first directory
@@ -47,31 +46,23 @@
         bt-dir (or build-tools-version
                    (->> (.list bt-root-dir)
                         (filter #(.isDirectory (file bt-root-dir %)))
-                        sort last))]
-    ;; if bt-dir exists (i.e. non-nil) then, probably, it is not empty
-    ;; and therefore we can assume that we're running build-tools 17+ revision
-    (if bt-dir
-      {:dx {:unix ["build-tools" bt-dir "dx"]
-            :win ["build-tools" bt-dir "dx.bat"]}
-       :adb {:unix ["platform-tools" "adb"]
-             :win ["platform-tools" "adb.exe"]}
-       :aapt {:unix ["build-tools" bt-dir "aapt"]
-              :win ["build-tools" bt-dir "aapt.exe"]}
-       :zipalign {:unix ["tools" "zipalign"]
-                  :win ["tools" "zipalign.exe"]}
-       :proguard {:unix ["tools" "proguard" "lib" "proguard.jar"]
-                  :win ["tools" "proguard" "lib" "proguard.jar"]}}
-
-      {:dx {:unix ["platform-tools" "dx"]
-            :win ["platform-tools" "dx.bat"]}
-       :adb {:unix ["platform-tools" "adb"]
-             :win ["platform-tools" "adb.exe"]}
-       :aapt {:unix ["platform-tools" "aapt"]
-              :win ["platform-tools" "aapt.exe"]}
-       :zipalign {:unix ["tools" "zipalign"]
-                  :win ["tools" "zipalign.exe"]}
-       :proguard {:unix ["tools" "proguard" "lib" "proguard.jar"]
-                  :win ["tools" "proguard" "lib" "proguard.jar"]}})))
+                        sort last))
+        bt-ver (Integer/parseInt (get (re-find #"(\d+)\..*" bt-dir) 1 "-1"))]
+    ;; if bt-ver is non-negative we have a definite numeric version number
+    ;; assume the latest build-tools dir is not empty
+    {:dx {:unix ["build-tools" bt-dir "dx"]
+          :win ["build-tools" bt-dir "dx.bat"]}
+     :adb {:unix ["platform-tools" "adb"]
+           :win ["platform-tools" "adb.exe"]}
+     :aapt {:unix ["build-tools" bt-dir "aapt"]
+            :win ["build-tools" bt-dir "aapt.exe"]}
+     :zipalign (if (>= bt-ver 20)
+                 {:unix ["build-tools" bt-dir "zipalign"]
+                  :win ["build-tools" bt-dir "zipalign.exe"]}
+                 {:unix ["tools" "zipalign"]
+                  :win ["tools" "zipalign.exe"]})
+     :proguard {:unix ["tools" "proguard" "lib" "proguard.jar"]
+                :win ["tools" "proguard" "lib" "proguard.jar"]}}))

 (defn sdk-binary
   "Given the project map and the binary keyword, returns either a full
@@ -107,10 +98,10 @@
   (assoc project :android
          (into {} (for [[key val] android]
                     [key (cond (re-find #"-path$" (name key))
-                                      (absolutize root val)
+                               (absolutize root val)

                                (re-find #"-paths$" (name key))
-                                      (map (partial absolutize root) val)
+                               (map (partial absolutize root) val)

                                :else val)]))))

@@ -255,7 +246,7 @@
                    (do (when warn? (info message))
                        (disj versions "v4"))
                    versions)]
-   (map #(get-sdk-support-jar sdk-root %) (seq versions))))
+    (map #(get-sdk-support-jar sdk-root %) (seq versions))))

 (defn get-resource-jars
   "Get the list of dependency libraries that has `:use-resources true`


Reload paths automatically taken from classpath

--- src/leiningen/ring/server.clj
+++ src/leiningen/ring/server.clj
@@ -1,7 +1,16 @@
 (ns leiningen.ring.server
-  (:require [leinjacker.deps :as deps])
+  (:require [leinjacker.deps :as deps]
+            [leiningen.core.classpath :as classpath]
+            [clojure.java.io :as io])
   (:use [leinjacker.eval :only (eval-in-project)]
         [leiningen.ring.util :only (ensure-handler-set! update-project)]))
+
+(defn classpath-dirs
+  "list of all dirs on the leiningen classpath"
+  [project]
+  (filter
+   #(.isDirectory (io/file %))
+   (classpath/get-classpath project)))

 (defn load-namespaces
   "Create require forms for each of the supplied symbols. This exists because
@@ -13,14 +22,20 @@
              (symbol ns)
              s))))

+(defn reload-paths [project]
+  (or (get-in project [:ring :reload-paths])
+      (classpath-dirs project)))
+
 (defn add-server-dep [project]
-  (update-project project deps/add-if-missing '[ring-server "0.2.7"]))
+  (update-project project deps/add-if-missing '[ring-server "0.2.8"]))

 (defn server-task
   "Shared logic for server and server-headless tasks."
   [project options]
   (ensure-handler-set! project)
-  (let [project (update-in project [:ring] merge options)]
+  (let [project (-> project
+                    (assoc-in [:ring :reload-paths] (reload-paths project))
+                    (update-in [:ring] merge options))]
     (eval-in-project
      (add-server-dep project)
      `(ring.server.leiningen/serve


Add vcs-type to api path param

Add vcs-type to api path param

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -458,12 +458,14 @@
         vcs-url (:vcs_url repo)
         project (vcs-url/project-name vcs-url)
         org-name (vcs-url/org-name vcs-url)
-        repo-name (vcs-url/repo-name vcs-url)]
+        repo-name (vcs-url/repo-name vcs-url)
+        vcs-type (vcs-url/vcs-type vcs-url)]
+
     (button-ajax :post
-                 (api-path/project-follow (:vcs_type repo) project)
+                 (api-path/project-follow vcs-type project)
                  :follow-repo
                  api-ch
-                 :params {:vcs-type (:vcs_type repo)}
+                 :params {:vcs-type vcs-type}
                  :context repo
                  :events {:success #(analytics/track {:event-type :project-followed
                                                       :current-state current-state
@@ -501,12 +503,13 @@
         vcs-url (:vcs_url repo)
         project (vcs-url/project-name vcs-url)
         org-name (vcs-url/org-name vcs-url)
-        repo-name (vcs-url/repo-name vcs-url)]
+        repo-name (vcs-url/repo-name vcs-url)
+        vcs-type (vcs-url/vcs-type vcs-url)]
     (button-ajax :post
-                 (api-path/project-unfollow (:vcs_type repo) project)
+                 (api-path/project-unfollow vcs-type project)
                  :unfollow-repo
                  api-ch
-                 :params {:vcs-type (:vcs_type repo)}
+                 :params {:vcs-type vcs-type}
                  :context repo
                  :events {:success #(analytics/track {:event-type :project-unfollowed
                                                       :current-state current-state
@@ -520,12 +523,13 @@
         login (get-in current-state state/user-login-path)
         project (vcs-url/project-name vcs-url)
         org-name (vcs-url/org-name vcs-url)
-        repo-name (vcs-url/repo-name vcs-url)]
+        repo-name (vcs-url/repo-name vcs-url)
+        vcs-type (vcs-url/vcs-type vcs-url)]
     (button-ajax :post
-                 (api-path/project-unfollow (:vcs_type repo) project)
+                 (api-path/project-unfollow vcs-type project)
                  :unfollow-project
                  api-ch
-                 :params {:vcs-type (:vcs_type repo)}
+                 :params {:vcs-type vcs-type}
                  :context {:project-id project-id}
                  :events {:success #(analytics/track {:event-type :project-unfollowed
                                                       :current-state current-state


mapv's to hopefully fix the the can't assoc bug

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -218,7 +218,7 @@
   (let [[rx ry] (cameras/screen->point (:camera state) x y)
         ;; TODO: better way to get selected layers
         db @(:db state)
-        layers (map #(ds/touch+ (d/entity db %)) layer-eids)
+        layers (mapv #(ds/touch+ (d/entity db %)) layer-eids)
         [group-id & entity-ids :as used-ids] (take (inc (count layers)) (:entity-ids state))
         group-layer (assoc (ds/touch+ (d/entity db group-eid))
                       :layer/child (set entity-ids)
@@ -226,15 +226,15 @@
     (-> state
         (assoc :selected-eid group-id)
         (assoc-in [:drawing :original-layers] (conj layers group-layer))
-        (assoc-in [:drawing :layers] (conj (map (fn [layer entity-id]
-                                                  (assoc layer
-                                                    :points (when (:layer/path layer) (parse-points-from-path (:layer/path layer)))
-                                                    :db/id entity-id
-                                                    :layer/start-x (:layer/start-x layer)
-                                                    :layer/end-x (:layer/end-x layer)
-                                                    :layer/current-x (:layer/end-x layer)
-                                                    :layer/current-y (:layer/end-y layer)))
-                                                layers entity-ids)
+        (assoc-in [:drawing :layers] (conj (mapv (fn [layer entity-id]
+                                                   (assoc layer
+                                                     :points (when (:layer/path layer) (parse-points-from-path (:layer/path layer)))
+                                                     :db/id entity-id
+                                                     :layer/start-x (:layer/start-x layer)
+                                                     :layer/end-x (:layer/end-x layer)
+                                                     :layer/current-x (:layer/end-x layer)
+                                                     :layer/current-y (:layer/end-y layer)))
+                                                 layers entity-ids)
                                            group-layer))
         (assoc-in [:drawing :moving?] true)
         (assoc-in [:drawing :starting-mouse-position] [rx ry])
@@ -322,10 +322,10 @@
         [snap-move-x snap-move-y] (cameras/snap-to-grid (:camera state) move-x move-y)
         layers (get-in state [:drawing :layers])
         snap-paths? (first (filter #(not= :layer.type/path (:layer/type %)) layers))
-        layers (map (fn [layer original]
-                      (move-layer layer original {:snap-x snap-move-x :snap-y snap-move-y :x move-x :y move-y :snap-paths? snap-paths?}))
-                    layers
-                    (get-in state [:drawing :original-layers]))]
+        layers (mapv (fn [layer original]
+                       (move-layer layer original {:snap-x snap-move-x :snap-y snap-move-y :x move-x :y move-y :snap-paths? snap-paths?}))
+                     layers
+                     (get-in state [:drawing :original-layers]))]
     (assoc-in state [:drawing :layers] layers)))

 (defmethod control-event :mouse-moved
@@ -410,7 +410,7 @@
   "Finalizes layer translation"
   [state]
   (-> state
-      (update-in [:drawing :layers] (fn [layers] (map #(dissoc % :layer/current-x :layer/current-y) layers)))
+      (update-in [:drawing :layers] (fn [layers] (mapv #(dissoc % :layer/current-x :layer/current-y) layers)))
       (assoc-in [:drawing :moving?] false)
       (assoc-in [:mouse :down] false)))

@@ -470,7 +470,7 @@
         was-drawing? (or (get-in previous-state [:drawing :in-progress?])
                          (get-in previous-state [:drawing :moving?]))
         original-layers (get-in previous-state [:drawing :original-layers])
-        layers        (map #(dissoc % :points) (get-in current-state [:drawing :layers]))]
+        layers        (mapv #(dissoc % :points) (get-in current-state [:drawing :layers]))]
     (cond
      (and (not= type "touchend")
           (not= button 2)
@@ -534,16 +534,16 @@
   [browser-state message {:keys [group-eid layer-eids x y]} state]
   (let [[rx ry] (cameras/screen->point (:camera state) x y)
         db @(:db state)
-        layers (map #(ds/touch+ (d/entity db %)) layer-eids)]
+        layers (mapv #(ds/touch+ (d/entity db %)) layer-eids)]
     (-> state
         (assoc :selected-eid group-eid)
         ;; TODO: maybe we should always deal with layers?
-        (assoc-in [:drawing :layers] (map (fn [layer]
-                                            (assoc layer
-                                              :layer/current-x (:layer/end-x layer)
-                                              :layer/current-y (:layer/end-y layer)
-                                              :points (when (:layer/path layer) (parse-points-from-path (:layer/path layer)))))
-                                          layers))
+        (assoc-in [:drawing :layers] (mapv (fn [layer]
+                                             (assoc layer
+                                               :layer/current-x (:layer/end-x layer)
+                                               :layer/current-y (:layer/end-y layer)
+                                               :points (when (:layer/path layer) (parse-points-from-path (:layer/path layer)))))
+                                           layers))
         (assoc-in [:drawing :original-layers] layers)
         (assoc-in [:drawing :moving?] true)
         (assoc-in [:drawing :starting-mouse-position] [rx ry]))))


update search field entry when location hash changes

--- iwaswhere-web/src/cljs/iwaswhere_web/store.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/store.cljs
@@ -15,14 +15,16 @@
   a map with temporary entries that are being edited but not saved yet, and sets that
   contain information for which entries to show the map, or the edit mode."
   [put-fn]
-  (let [current-query (h/query-from-search-hash)]
-    (aset js/window "onhashchange" #(put-fn [:state/get (h/query-from-search-hash)]))
-    (put-fn [:state/get current-query])
-    {:state (atom {:entries       []
-                   :show-maps-for #{}
-                   :show-edit-for #{}
-                   :current-query current-query
-                   :temp-entries  {}})}))
+  (let [initial-state {:state (atom {:entries       []
+                                     :show-maps-for #{}
+                                     :show-edit-for #{}
+                                     :temp-entries  {}})}
+        hash-change-fn #(let [current-query (h/query-from-search-hash)]
+                         (swap! (:state initial-state) assoc-in [:current-query] current-query)
+                         (put-fn [:state/get current-query]))]
+    (aset js/window "onhashchange" hash-change-fn)
+    (hash-change-fn)
+    initial-state))

 (defn toggle-set
   "Toggles for example the visibility of a map or the edit mode for an individual


Improve tile view re-use

Improve tile view re-use

--- android/src/clojure/net/nightweb/views.clj
+++ android/src/clojure/net/nightweb/views.clj
@@ -98,6 +98,7 @@
                 text-count (.getChildAt bottom-layout 1)]
             (when not-initialized
               (.setScaleType img android.widget.ImageView$ScaleType/CENTER_CROP)
+              (.setTypeface text-bottom android.graphics.Typeface/DEFAULT_BOLD)
               (set-text-size text-top default-text-size)
               (set-text-size text-bottom default-text-size)
               (set-text-size text-count default-text-size)
@@ -114,7 +115,6 @@
             (when-not (get item :add-emphasis?)
               (.setTypeface text-top android.graphics.Typeface/DEFAULT)
               (.setGravity text-top android.view.Gravity/LEFT))
-            (.setTypeface text-bottom android.graphics.Typeface/DEFAULT_BOLD)
             (when-let [background (get item :background)]
               (.setBackgroundResource img background))
             (if (nil? (get item :tag))
@@ -126,10 +126,12 @@
             (.setText text-top (or (get item :title)
                                    (get item :body)
                                    (get item :tag)))
-            (when-let [subtitle (get item :subtitle)]
-              (.setText text-bottom subtitle))
-            (when (and (get item :count) (> (get item :count) 0))
-              (.setText text-count (str (get item :count))))
+            (if-let [subtitle (get item :subtitle)]
+              (.setText text-bottom subtitle)
+              (.setText text-bottom nil))
+            (if (and (get item :count) (> (get item :count) 0))
+              (.setText text-count (str (get item :count)))
+              (.setText text-count nil))
             tile-view))))
     (.setOnItemClickListener
       view


Problem added - "Perfect Numbers"

Problem added - "Perfect Numbers"

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -902,9 +902,22 @@
             :tags ["hard"]
             :tests ["(= (__ [   [1]\n          [2 4]\n         [5 1 4]\n        [2 3 4 5]])\n   (+ 1 2 1 3)\n   7)"
 		    "(= (__ [     [3]\n            [2 4]\n           [1 9 3]\n          [9 9 2 4]\n         [4 6 6 7 8]\n        [5 7 3 5 1 4]])\n   (+ 3 4 3 2 7 1)\n   20)"]})
+
+      (insert! :problems
+           {:_id 80
+            :title "Perfect Numbers"
+            :times-solved 0
+            :description "A number is \"perfect\" if the sum of its divisors equal the number itself.  6 is a perfect number because 1+2+3=6.  Write a function which returns true for perfect numbers and false otherwise."
+            :approved true
+            :tags ["medium"]
+            :tests ["(= (__ 6) true)"
+		    "(= (__ 7) false)"
+		    "(= (__ 496) true)"
+		    "(= (__ 500) false)"
+		    "(= (__ 8128) true)"]})

       (insert! :problems
-          {:_id 80
+          {:_id 81
            :title "Create an Equation"
            :times-solved 0
            :description "Write a function which takes three or more integers.  Using these integers, your function should generate clojure code representing an equation.  The following rules for the equation must be satisfied:\n\n    1. All integers must be used once and only once.\n    2. The order of the integers must be maintained when reading the equation left-to-right.\n    3. The only functions you may use are +, *, or =.\n    4. The equation must use the minimum number of parentheses.\n    5. If no satisfying equation exists, return nil."
@@ -923,7 +936,7 @@

       (insert! :problems
-           {:_id 81
+           {:_id 82
             :title "Power Set"
             :times-solved 0
             :description "A power set is the set of all subsets of a given set. Given a list, produce a set of sublists while preserving the order of elements."


improve logs to support destructuring

improve logs to support destructuring

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -384,13 +384,24 @@
   [fct-name arg-list arg-values]
   (str
     "Entering the function " fct-name " with args "
-    (vec (mapcat vector arg-list arg-values))))
+    (zipmap arg-list arg-values)))
+
+(defn bindings->bound-vars
+  [bindings]
+  (->>
+    (flatten bindings)
+    (remove #{'&})
+    (remove keyword?)
+    (vec)))

 (defn compile-log-message
-  [form bindings]
-  (let [fct-name (-> form second str)]
-    `(log-enter-message ~fct-name (quote ~bindings) ~bindings)
-    ))
+  [form binding-vec]
+  (let [fct-name (-> form second str)
+        bindings (bindings->bound-vars binding-vec)]
+    `(log-enter-message
+       ~fct-name
+       (quote ~bindings)
+       ~bindings)))

 (defmacro defn-log
   [name bindings body]
@@ -629,11 +640,10 @@
     :else node))

 (defn optimize-op
-  [[op & args :as expr]] ;; TODO - def-log does not work here
+  [[op & args :as expr]]
   (let [variables (filter (complement number?) args)
         constants (filter number? args)
         reduced (reduce op constants)]
-    (println reduced)
     (if-not (empty? constants)
       (into [op reduced] variables)
       expr)))


Don't split attributes until we implement tooltips

--- src/cljs/cglossa/result_views/cwb/core.cljs
+++ src/cljs/cglossa/result_views/cwb/core.cljs
@@ -34,11 +34,11 @@
         (str/replace $ #"</who_name>" "")
         (str/replace $ #"span class=" "span_class=")
         (str/split $ #"\s+")
-        (map (fn [token]
+        ;; TODO: Handle Opentip jQuery attributes, or use something else?
+        #_(map (fn [token]
                (if (re-find #"span_class=" token)
                  token                                      ; Don't touch HTML spans
                  (str/split token #"/")                     ; The slash separates CWB attributes
-                 ;; TODO: Handle Opentip jQuery attributes, or use something else?
                  ))
              $)
         (str/join \space $)


Fix startsWith usage

Fix startsWith usage

Looks like closure "advanced compiles" away String.prototype.startsWith. Maybe its because
its an ES6 function and it isn't whitelisted during compilation...

--- src/cljs/gc_api_browser/schema_example.cljs
+++ src/cljs/gc_api_browser/schema_example.cljs
@@ -2,12 +2,17 @@
   (:require [clojure.string :as string])
   (:import [goog.format JsonPrettyPrinter]))

+(defn- starts-with? [s prefix]
+  (= 0 (.indexOf s prefix)))
+
+(defn- extract-first-json-part [example-str]
+  (string/join (->> (string/split example-str #"\n")
+                    (drop-while #(not (starts-with? % "{")))
+                    (take-while #(not (starts-with? % "H"))))))
+
 (defn prettify [schema-example-str]
-  (let [example-json-str (string/join (take-while #(not (.startsWith % "H"))
-                                                  (drop-while #(not (.startsWith % "{"))
-                                                              (string/split schema-example-str #"\n"))))]
+  (let [example-json-str (extract-first-json-part schema-example-str)]
     (try
       (.format (JsonPrettyPrinter.) example-json-str)
       (catch js/Error _
-        (js/console.error "Bad example:" schema-example-str)
         example-json-str))))


Fix docstrings

Fix docstrings

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -48,10 +48,11 @@

   Example:

-  (create-keyspace conn :new_cql_keyspace
-  (with {:replication
-  {:class \"SimpleStrategy\"
-  :replication_factor 1}}))"
+      (create-keyspace session \"new_cql_keyspace\"
+                       (with {:replication
+                              {\"class\"              \"SimpleStrategy\"
+                               \"replication_factor\" 1 }}))
+  "
   [^Session session keyspace & query-params]
   (cc/execute session
               (apply query/create-keyspace (cons keyspace query-params))))
@@ -62,11 +63,13 @@
   of this statement. After the index is created, new data for the column is indexed automatically at
   insertion time.

-  Example, creates an index on `users` table, `city` column:
-
-  (create-index conn :users :city
-  (index-name :users_city)
-  (if-not-exists))"
+  Example, creates an index named `users_city_idx' on `users` table, `city` column:
+
+  (create-index *session* :users_city_idx
+                (on-table :users
+                (and-column :city)
+                (if-not-exists)
+  "
   [^Session session & query-params]
   (cc/execute session
               (apply query/create-index query-params)))
@@ -91,11 +94,11 @@

   Example:

-  (create-table :users
-  (column-definitions {:name :varchar
-  :age  :int
-  :city :varchar
-  :primary-key [:name]}))"
+  (create-table *session* :userstmp
+                (column-definitions {:name        :varchar
+                                     :title       :varchar
+                                     :primary-key [:name]}))
+  "
   [^Session session & query-params]
   (cc/execute session
               (apply query/create-table query-params)))
@@ -119,14 +122,30 @@

 (defn alter-table
   "Alters a table definition. Use it to add new
-  columns, drop existing ones, change the type of existing columns, or update the table options."
+   columns, drop existing ones, change the type of existing columns, or update the table options.
+
+   Example:
+
+   (alter-table *session* :people
+                (rename-column :naome :name)
+                (add-column :age :int))
+  "
   [^Session session & query-params]
   (cc/execute session
               (apply query/alter-table query-params)))

 (defn alter-keyspace
   "Alters properties of an existing keyspace. The
-  supported properties are the same that for `create-keyspace`"
+  supported properties are the same that for `create-keyspace`
+
+   Example:
+
+  (alter-keyspace *session* \"new_cql_keyspace\"
+                  (with {:durable-writes false
+                         :replication    {\"class\" \"NetworkTopologyStrategy\"
+                                          \"dc1\"   1
+                                          \"dc2\"   2}}))
+  "
   [^Session session & query-params]
   (cc/execute session
               (apply query/alter-keyspace query-params)))
@@ -140,7 +159,14 @@

   Note that since a row is identified by its primary key, the columns that compose it must be
   specified. Also, since a row only exists when it contains one value for a column not part of
-  the primary key, one such value must be specified too."
+  the primary key, one such value must be specified too.
+
+   Example:
+
+   (insert *session* :users
+           {:name \"name1\"
+            :age  (int 19)})
+  "
   [^Session session & query-params]
   (cc/execute session
               (apply query/insert query-params)))


Number-IO updated for input/output stack

--- src/clojush/problems/software/number_IO.clj
+++ src/clojush/problems/software/number_IO.clj
@@ -72,41 +72,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-; Define new instructions
-(define-registered
-  in1
-  (fn [state] (push-item (stack-ref :auxiliary 1 state) :float state)))
-
-(define-registered
-  in2
-  (fn [state] (push-item (stack-ref :auxiliary 2 state) :integer state)))
-
-(define-registered
-  print_integer
-  (fn [state]
-    (if (empty? (:integer state))
-      state
-      (let [top-int (top-item :integer state)]
-        (if (< max-string-length (count (str (stack-ref :auxiliary 0 state) top-int)))
-          state
-          (stack-assoc (str (stack-ref :auxiliary 0 state) top-int)
-                       :auxiliary
-                       0
-                       (pop-item :integer state)))))))
-
-(define-registered
-  print_float
-  (fn [state]
-    (if (empty? (:float state))
-      state
-      (let [top-float (top-item :float state)]
-        (if (< max-string-length (count (str (stack-ref :auxiliary 0 state) top-float)))
-          state
-          (stack-assoc (str (stack-ref :auxiliary 0 state) top-float)
-                       :auxiliary
-                       0
-                       (pop-item :float state)))))))
-
 ; Atom generators
 (def num-io-atom-generators
   (list
@@ -119,7 +84,7 @@
     'in2
     'print_float
     'print_integer
-    ;;; end problem-specific instructions
+    ;;; end IO instructions
     'float_rot
     'float_yank
     'float_sin
@@ -245,10 +210,10 @@
                                                                           [])]
                            (let [final-state (run-push program
                                                        (->> (make-push-state)
-                                                         (push-item in-int :auxiliary)
-                                                         (push-item in-float :auxiliary)
-                                                         (push-item "" :auxiliary)))
-                                 printed-result (stack-ref :auxiliary 0 final-state)]
+                                                         (push-item in-int :input)
+                                                         (push-item in-float :input)
+                                                         (push-item "" :output)))
+                                 printed-result (stack-ref :output 0 final-state)]
                              (when print-outputs
                                (println (format "Correct output: %-19s | Program output: %-19s" (str out-float) printed-result)))
                              ; Record the behavior


Fix driver creation

Fix driver creation

--- src/export_server/browser/etaoin/common.clj
+++ src/export_server/browser/etaoin/common.clj
@@ -61,12 +61,26 @@

 (defn create-driver-firefox [] (firefox-headless))

-(defn create-driverr []
+(defn create-driverr-raw []
   (case (:engine @state/options)
     :phantom (create-driver-phantom)
     :chrome (create-driver-chrome)
     :firefox (create-driver-firefox)))

+
+(defn create-driverr
+  ([retry]
+   (timbre/info "CREATE DRIVER SAFE:" retry)
+   (if (pos? retry)
+     (try
+       (create-driverr-raw)
+       (catch Exception e
+         (timbre/error "CREATE DRIVER SAFE ERROR:" e)
+         (create-driverr (dec retry))))
+     (do
+       (timbre/info "CREATE DRIVER SAFE retry exceeded")
+       (throw (Exception. (str "CREATE DRIVER SAFE ERROR"))))))
+  ([] (create-driverr 3)))

 ;=======================================================================================================================
 ; Initialization


[PDOK-2008] [PDOK-2011] flushing extract-data when result-channel is empty

--- src/main/clojure/pdok/featured/extracts.clj
+++ src/main/clojure/pdok/featured/extracts.clj
@@ -8,6 +8,7 @@
             [pdok.featured.timeline :as timeline]
             [pdok.postgres :as pg]
             [pdok.cache :as cache]
+            [clojure.tools.logging :as log]
             [clojure.core.async :as a
              :refer [>! <! >!! <!! go chan]]))

@@ -27,8 +28,7 @@
   "Returns the rendered representation of the collection of features for a given feature-type inclusive tiles-set"
   (if (empty? features)
     [nil nil]
-    (let [template-key (template-key dataset extract-type feature-type)
-          _ (println (first features))]
+    (let [template-key (template-key dataset extract-type feature-type)]
       [nil (map #(vector feature-type (:_tiles %) (m/render template-key %)
                            (:_valid_from %) (:_valid_to %) (:lv-publicatiedatum %)) features)])))

@@ -90,18 +90,23 @@
         {:status "ok" :count (add-extract-records config/data-db dataset feature-type extract-type extract-version features-for-extract)})
       {:status "error" :msg error :count 0})))

-
-(defn fill-extract [dataset collection extract-type extract-version]
+ (defn fill-extract [dataset collection extract-type extract-version]
   (let [chunk (ref (clojure.lang.PersistentQueue/EMPTY))
         batched-fn (partial transform-and-add-extract dataset collection extract-type extract-version)
-        cached-fn (cache/with-batch chunk 100000 batched-fn)
-        rc (chan)]
+        cached-fn (cache/with-batch chunk 10000 batched-fn)
+        rc (chan)
+        cc (chan)]
     (go (loop [feature (<! rc)]
-          (when feature
-            (cached-fn feature)
-            (recur (<! rc)))))
+          (if feature
+            (do
+              (cached-fn feature)
+              (recur (<! rc)))
+            (do
+              (cache/flush-batch chunk batched-fn)
+              (Thread/sleep 5000)
+              (>! cc :done)))))
     (timeline/all (config/timeline) dataset collection rc)
-    (cache/flush-batch chunk batched-fn)
+    (<!! cc)
     {:status "ok" :count 777}))

 (defn file-to-features [path dataset]


better loop fusion

better loop fusion

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -326,7 +326,6 @@
   (let [[op fct] (first transforms)
         remaining (rest transforms)]
     (case op
-      ;;TODO - Multimethod here for extensibility
       :map
       `(let [h2# (~fct ~h)]
          (inline-reducer ~reducer ~remaining ~r h2#))
@@ -335,20 +334,21 @@
          (inline-reducer ~reducer ~remaining ~r ~h)
          ~r)
       :mapcat
-      `(let [h2# (~fct ~h)]
-         (inline-reduce ~reducer ~r ~remaining h2#))
+      (let [h2 (with-meta (gensym "h2") {:tag 'java.lang.Iterable})]
+        `(let [~h2 (~fct ~h)]
+           (inline-reduce ~reducer ~r ~remaining ~h2)))
       `(~reducer ~r ~h))))

 (defmacro inline-reduce
   [reducer initial transforms coll]
-  `(loop [h# (first ~coll)
-          t# (rest ~coll)
-          r# ~initial]
-     (if h#
-       (recur
-         (first t#) (rest t#)
-         (inline-reducer ~reducer ~transforms r# h#))
-       r#)))
+  (let [iter (with-meta (gensym "iter") {:tag 'java.util.Iterator})]
+    `(let [~iter (.iterator ~coll)]
+       (loop [r# ~initial]
+         (if (.hasNext ~iter)
+           (let [h# (.next ~iter)
+                 r2# (inline-reducer ~reducer ~transforms r# h#)]
+             (recur r2#))
+           r#)))))

 (defn test-inline-reduce
   []


Added temporal keyword, instrument, sensor to boosted keyword fields.

--- src/cmr/search/data/keywords_to_elastic.clj
+++ src/cmr/search/data/keywords_to_elastic.clj
@@ -136,13 +136,14 @@
    (keywords->name-filter :project-ln.lowercase :project-sn.lowercase keywords project-boost)
    ;; platform
    (keywords->name-filter :platform-ln.lowercase :platform-sn.lowercase keywords platform-boost)
-   ;; TODO - instrument
-   ;; need to add long name
-   ;; TODO - sensor
-   ;; need to add long name
+   ;; instrument
+   (keywords->name-filter :instrument-ln.lowercase :instrument-sn.lowercase keywords instrument-boost)
+   ;; sensor
+   (keywords->name-filter :sensor-ln.lowercase :sensor-sn.lowercase keywords sensor-boost)
    ;; science keywords
    (keywords->sk-filter keywords science-keywords-boost)
    ;; spatial-keyword
-   (keywords->boosted-exact-match-filter :spatial-keywords.lowercase keywords spatial-keyword-boost)
-   ;; TODO - temporal-keyword
-   ])+   (keywords->boosted-exact-match-filter :spatial-keyword.lowercase keywords spatial-keyword-boost)
+   ;; temporal-keyword
+   (keywords->boosted-exact-match-filter :temporal-keyword.lowercase keywords temporal-keyword-boost)])
+


nrepl -- catch exceptions during eval

nrepl -- catch exceptions during eval

--- src/com/billpiel/sayid/nrepl_middleware.clj
+++ src/com/billpiel/sayid/nrepl_middleware.clj
@@ -636,7 +636,7 @@
                       (query-tree->trio (sd/ws-view!)))))

 (defn magic-recusive-eval
-  "Let's us send vars to nrepl client and back. Madness."
+  "Lets us send vars to nrepl client and back. Madness."
   [frm]
   (cond (vector? frm) (mapv magic-recusive-eval frm)
         (seq? frm) (eval frm)
@@ -663,7 +663,13 @@
 (defn wrap-sayid
   [handler]
   (fn [{:keys [op] :as msg}]
-    ((get sayid-nrepl-ops op handler) msg)))
+    (try
+      ((get sayid-nrepl-ops op handler) msg)
+      (catch Throwable e
+          (println (.getMessage e))
+          (clojure.stacktrace/print-stack-trace e)
+          (reply:clj->nrepl msg (.getMessage e))))))
+

 (set-descriptor! #'wrap-sayid
                  {:handles (zipmap (keys sayid-nrepl-ops)


test hook

test hook

--- src/main/cawala/api/read.clj
+++ src/main/cawala/api/read.clj
@@ -6,7 +6,7 @@
                      :person/relation :friend}
                  2  {:db/id 2 :person/name "Sally" :person/age 22
                      :person/relation :friend}
-                 3  {:db/id 3 :person/name "Allie" :person/age 71
+                 3  {:db/id 3 :person/name "Allie" :person/age 70
                      :person/relation :enemy}
                  4  {:db/id 4 :person/name "Zoe" :person/age 32
                      :person/relation :friend}


Don't mangle project names with dashes. Fixes #11

--- lein-template/src/main/leiningen/new/aviary.clj
+++ lein-template/src/main/leiningen/new/aviary.clj
@@ -54,7 +54,7 @@
              ["src/main/clj/{{path}}/style.clj" (render "src/main/clj/aviary/style.clj" data)]
              ["src/main/clj/{{path}}/markup.clj" (render "src/main/clj/aviary/markup.clj" data)]
              ["src/main/cljs/{{path}}/site.cljs" (render "src/main/cljs/aviary/site.cljs" data)])
-    (mapv #(apply unpack (:path data) %)
+    (mapv #(apply unpack (:name data) %)
           [["resources/assets/favicon.ico" "resources/assets/favicon.ico"]
            ["resources/assets/aviary-tile.jpg" "resources/assets/aviary-tile.jpg"]
            ["resources/assets/aviary-white.svg" "resources/assets/aviary-white.svg"]])))


use loop/recur for mark-json-field!

use loop/recur for mark-json-field!

--- src/metabase/driver/sync.clj
+++ src/metabase/driver/sync.clj
@@ -423,20 +423,20 @@
   (when (and (not (:special_type field))
              (contains? #{:CharField :TextField} (:base_type field)))
     (try
-      (let [valid-json-values-balance (atom 0)]
-        (doseq [val (->> (field-values-lazy-seq driver field)
-                         (take max-sync-lazy-seq-results))]
-          (if (s/blank? val)
-            (swap! valid-json-values-balance dec)
-            ;; If val is non-nil, check that it's a JSON dictionary or array. We don't want to mark Fields containing other types of valid JSON values as :json
-            ;; (e.g. a string representation of a number or boolean)
-            (let [val (json/parse-string val)]
-              (when (not (or (map? val)
-                             (sequential? val)))
-                (throw (Exception.)))
-              (swap! valid-json-values-balance inc))))
-
-        (when (> @valid-json-values-balance 0)
+      (let [values                    (->> (field-values-lazy-seq driver field)
+                                           (take max-sync-lazy-seq-results))
+            valid-json-values-balance (loop [[val & more] values, balance 0]
+                                        (cond
+                                          (and (not val) (not (seq more))) balance
+                                          (s/blank? val)                   (recur more (dec balance))
+                                          ;; If val is non-nil, check that it's a JSON dictionary or array. We don't want to mark Fields containing other
+                                          ;; types of valid JSON values as :json (e.g. a string representation of a number or boolean)
+                                          :else                            (let [val (json/parse-string val)]
+                                                                             (when (not (or (map? val)
+                                                                                (sequential? val)))
+                                                                               (throw (Exception.)))
+                                                                             (recur more (inc balance)))))]
+        (when (> valid-json-values-balance 0)
           (log/info (u/format-color 'green "Field '%s' looks like it contains valid JSON objects. Setting special_type to :json." @(:qualified-name field)))
           (upd Field (:id field) :special_type :json, :preview_display false)
           (assoc field :special_type :json, :preview_display false)))