add repl special form parsing

add repl special form parsing

--- src/core.clj
+++ src/core.clj
@@ -117,11 +117,13 @@
   (sh "script/checkout.sh" v))

 (defn get-github-file-link
-  [repo path [start-line end-line]]
-  (let [version (get *repo-version* repo)
-        strip-path (subs path (inc (count repo)))]
-    (str "https://github.com/clojure/" repo "/blob/" version "/" strip-path
-         "#L" start-line "-L" end-line)))
+  ([repo path] (get-github-file-link repo path nil))
+  ([repo path [start-line end-line]]
+   (let [version (get *repo-version* repo)
+         strip-path (subs path (inc (count repo)))]
+     (cond-> (str "https://github.com/clojure/" repo "/blob/" version "/" strip-path)
+       start-line (str "#L" start-line)
+       (and start-line end-line) (str "-L" end-line)))))

 (defn clj-tag->version
   [v]
@@ -463,6 +465,38 @@
           final (merge special location extras)]
       final)))

+(defn parse-repl-specials*
+  "Parse cljs repl special forms of the form:
+  (def default-special-fns (let [...] { #_keys_are_special_form_names }))"
+  [form]
+  (if (and (#{"r927" "r971"} (*repo-version* "clojurescript"))
+           (list? form)
+           (= 'defn (first form))
+           (= 'repl (second form)))
+    ;; old version, just manually setting when detected
+    ['in-ns 'load-file 'load-namespace]
+
+    ;; everything >= r993
+    (when (and (list? form)
+               (= 'def (first form))
+               (= 'default-special-fns (second form)))
+      (let [[_let _bindings form-map] (nth form 2)]
+        (->> (keys form-map)
+             (map second) ;; (quote x) => x
+             (remove namespace)) ;; we'll ignore namespace-qualified special forms
+        ))))
+
+(defn parse-repl-specials
+  [form ns- repo]
+  (when-let [specials (parse-repl-specials* form)]
+    (let [location (parse-location form ns- repo)
+          make-map (fn [name-]
+                     (merge location
+                       {:name name-
+                        :full-name (str ns- "/" name-)
+                        :type "special form (repl)"}))]
+     (map make-map specials))))
+
 (defn parse-api
   "Parse the functions and macros from the given repo file"
   [ns- repo file]
@@ -530,8 +564,13 @@
           (parse-api ns- "clojurescript" "test.clj")))

 (defmethod parse-ns-api "cljs.repl" [ns-]
-  (concat (parse-api ns- "clojurescript" "repl.clj")
-          (parse-api ns- "clojurescript" "repl.cljs")))
+  (let [repo "clojurescript"
+        forms (get-forms ns- repo "repl.clj")
+        special-ns "specialrepl"
+        specials (first (keep #(parse-repl-specials % special-ns repo) forms))]
+    (concat (parse-api ns- "clojurescript" "repl.clj")
+            (parse-api ns- "clojurescript" "repl.cljs")
+            specials)))

 (defmethod parse-ns-api "cljs.reader" [ns-]
   (parse-api ns- "clojurescript" "reader.cljs"))


Undo logging of job peers. This is seriously cluttering up the logs.

--- src/onyx/scheduling/common_job_scheduler.clj
+++ src/onyx/scheduling/common_job_scheduler.clj
@@ -189,8 +189,5 @@
         max-utilization (claim-spare-peers replica job-claims spare-peers)
         current-allocations (current-job-allocations replica)
         peers-to-displace (find-displaced-peers replica current-allocations max-utilization)
-        deallocated (deallocate-starved-jobs replica)
-        rets (choose-ackers (reallocate-peers deallocated peers-to-displace max-utilization))]
-    (info (format "Peer Scheduler finished allocations (job id -> number of peers): %s"
-                  (into {} (map (fn [[k v]] {k (apply + (map count (vals v)))}) (:allocations rets)))))
-    rets))
+        deallocated (deallocate-starved-jobs replica)]
+    (choose-ackers (reallocate-peers deallocated peers-to-displace max-utilization))))


Allow users to reset their passwords. Still buggy if supplied passwords don't match

--- src/foreclojure/login.clj
+++ src/foreclojure/login.clj
@@ -1,6 +1,7 @@
 (ns foreclojure.login
   (:import [org.jasypt.util.password StrongPasswordEncryptor])
   (:use hiccup.form-helpers
+        hiccup.page-helpers
         foreclojure.utils
         compojure.core
         somnium.congomongo)
@@ -28,10 +29,41 @@
           (response/redirect "/problems"))
       (flash-error "Error logging in." "/login"))))

+(def-page reset-password-page []
+  (with-user [{:keys [user]}]
+    [:div#reset-pwd
+     [:h2 "Reset password for " user]
+     [:span.error (session/flash-get :error)]
+     [:table
+      (form-to [:post "/login/reset"]
+        (map form-row
+             [[password-field :old-pwd "Current password"]
+              [password-field :pwd "New password"]
+              [password-field :repeat-pwd "Repeat password"]])
+        [:tr
+         [:td (submit-button "Reset now")]])]]))
+
+(def-page do-reset-password! [old-pwd new-pwd repeat-pwd]
+  (with-user [{:keys [user pwd]}]
+    (let [encryptor (StrongPasswordEncryptor.)]
+      (assuming [(= new-pwd repeat-pwd)
+                 "New password was not entered identically twice"
+                 (.checkPassword encryptor old-pwd pwd)
+                 "Old password incorrect"]
+        (let [new-pwd-hash (.encryptPassword encryptor new-pwd)]
+          (update! :users {:user user}
+                   {:$set {:pwd new-pwd-hash}}
+                   :upsert false)
+          [:div#reset-succeeded "Password for " user " reset successfully"])
+        (flash-error why "/login/reset")))))
+
 (defroutes login-routes
   (GET  "/login" [] (my-login-page))
   (POST "/login" {{:strs [user pwd]} :form-params}
-        (do-login user pwd))
+    (do-login user pwd))
+  (GET  "/login/reset" [] (reset-password-page))
+  (POST "/login/reset" {{:strs [old-pwd pwd repeat-pwd]} :form-params}
+    (do-reset-password! old-pwd pwd repeat-pwd))
   (GET "/logout" []
-       (do (session/session-delete-key! :user)
-           (response/redirect "/"))))
+    (do (session/session-delete-key! :user)
+        (response/redirect "/"))))


upload slots enforced

upload slots enforced

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -32,25 +32,38 @@
 (defn drop-last-upload [uploads]
   (subvec uploads 0 (dec (count uploads))))

-(defn upload-slots-watch-fn [_ _ old-state new-state]
+(defn handle-upload-slots-change [old-state new-state]
   (let [old-upload-slots (:upload-slots old-state)
         new-upload-slots (:upload-slots new-state)
         active-uploads   (:active-uploads new-state)
         inactive-uploads (:inactive-uploads new-state)
         uploads (:uploads new-state)]
     (cond
-      (< old-upload-slots new-upload-slots) {:active-uploads (append-upload active-uploads
-                                                                            (first inactive-uploads))
-                                             :inactive-uploads (drop-first-upload inactive-uploads)
-                                             :uploads (merge uploads {(first inactive-uploads)
-                                                                      (start-upload (first inactive-uploads))})}
-      (> old-upload-slots new-upload-slots) {:active-uploads (drop-last-upload active-uploads)
-                                             :inactive-uploads (prepend-upload inactive-uploads
-                                                                               (last active-uploads))
-                                             :uploads (merge uploads {(last active-uploads)
-                                                                      (stop-upload (last active-uploads))})})))
+      (< old-upload-slots new-upload-slots)
+        (if-not (empty? inactive-uploads)
+          {:active-uploads (append-upload active-uploads
+                                          (first inactive-uploads))
+           :inactive-uploads (drop-first-upload inactive-uploads)
+           :uploads (merge uploads {(first inactive-uploads)
+                                    (start-upload (first inactive-uploads))})})
+      (> old-upload-slots new-upload-slots)
+        (if-not (empty? active-uploads)
+          {:active-uploads (drop-last-upload active-uploads)
+           :inactive-uploads (prepend-upload inactive-uploads
+                                             (last active-uploads))
+           :uploads (merge uploads {(last active-uploads)
+                                    (stop-upload (last active-uploads))})}))))

-(add-watch app-state/app-state :upload-slots upload-slots-watch-fn)
+(defn upload-slots-watch-fn! [_ _ old-state new-state]
+  (let [new-uploads-info (handle-upload-slots-change old-state new-state)]
+    (if-not (nil? new-uploads-info)
+      (do
+
+        (println "NEW UPLOADS INFO:" new-uploads-info)
+        (swap! app-state/app-state (merge @app-state/app-state
+                                          new-uploads-info))))))
+
+(add-watch app-state/app-state :upload-slots  upload-slots-watch-fn!)

 (defn get-action [old-state new-state upload-id]
   "returns the action applied to the given upload-id.
@@ -81,60 +94,29 @@
         upload-id (.v4 js/uuid)
         stream (.createStream js/ss)
         blob-stream (.createBlobReadStream js/ss file)
-        upload-watch-fn (fn [_ _ old-state new-state]
-                          (let [action (get-action old-state new-state upload-id)]
-                            (cond
-                              (= action :paused)
-                                (.unpipe blob-stream)
-                              (= action :unpaused)
-                                (.pipe blob-stream stream)
-                              (= action :stopped)
-                                (do
-                                  (swap! app-state/app-state
-                                         assoc
-                                         :active-uploads
-                                         (remove #{upload-id}
-                                                 (:active-uploads @app-state/app-state)))
-                                  (swap! app-state/app-state
-                                         assoc
-                                         :inactive-uploads
-                                         (prepend-upload (:inactive-uploads @app-state/app-state)
-                                                         upload-id))
-                                  (.unpipe blob-stream))
-                              (= action :started)
-                                (do
-                                  (swap! app-state/app-state
-                                         assoc
-                                         :inactive-uploads
-                                         (remove #{upload-id}
-                                                 (:inactive-uploads @app-state/app-state)))
-                                  (swap! app-state/app-state
-                                         assoc
-                                         :active-uploads
-                                         (append-upload (:active-uploads @app-state/app-state)
-                                                        upload-id))
-                                  (.pipe blob-stream stream)))))]
+        upload-watch-fn! (fn [_ _ old-state new-state]
+                           (let [action (get-action old-state new-state upload-id)]
+                             (cond
+                               (= action :paused)
+                                 (.unpipe blob-stream)
+                               (= action :unpaused)
+                                 (.pipe blob-stream stream)
+                               (= action :stopped)
+                                 (.unpipe blob-stream)
+                               (= action :started)
+                                 (.pipe blob-stream stream))))]
     (.on blob-stream "end"
       (fn []
-        (swap! app-state/app-state
-               assoc
-               :num-of-uploads
-               (dec (:num-of-uploads @app-state/app-state)))
+        (remove-watch app-state/app-state upload-id)
         (swap! app-state/app-state
                assoc
                :uploads
                (dissoc (:uploads @app-state/app-state)
-                       upload-id))
-        (remove-watch app-state/app-state upload-id)))
+                       upload-id))))
+
     (add-watch app-state/app-state
                upload-id
-               upload-watch-fn)
-
-    (swap! app-state/app-state
-           assoc
-           :inactive-uploads
-           (append-upload (:inactive-uploads @app-state/app-state)
-                          upload-id))
+               upload-watch-fn!)

     (.emit (js/ss app-state/socket)
            "file-upload"
@@ -144,12 +126,17 @@
            upload-id)

     (swap! app-state/app-state
-           assoc
-           :uploads
-           (merge (:uploads @app-state/app-state)
-                  (if (< (:num-of-uploads @app-state/app-state)
+           merge
+           @app-state/app-state
+           (if (< (count (:active-uploads @app-state/app-state))
                          (:upload-slots   @app-state/app-state))
-                    {upload-id (start-upload new-upload)}
-                    {upload-id new-upload})))))
+             {:uploads (merge (:uploads @app-state/app-state)
+                              {upload-id (start-upload new-upload)})
+              :active-uploads (prepend-upload (:active-uploads @app-state/app-state)
+                                              upload-id)}
+             {:uploads (merge (:uploads @app-state/app-state)
+                              {upload-id new-upload})
+              :inactive-uploads (prepend-upload (:inactive-uploads @app-state/app-state)
+                                                upload-id)}))))


Remove call to problem51 function

Remove call to problem51 function

--- euler_clojure/src/euler/problem51.clj
+++ euler_clojure/src/euler/problem51.clj
@@ -62,5 +62,3 @@

 (defn problem51 []
   (first (filter smallest-member? (get-primes 56995))))
-
-(problem51)


Adding require for tag json results handler.

--- search-app/src/cmr/search/api/routes.clj
+++ search-app/src/cmr/search/api/routes.clj
@@ -44,6 +44,7 @@
             [cmr.search.results-handlers.timeline-results-handler]
             [cmr.search.results-handlers.opendata-results-handler]
             [cmr.search.results-handlers.umm-json-results-handler]
+            [cmr.search.results-handlers.tags-json-results-handler]

             ;; ACL support. Required here to avoid circular dependencies
             [cmr.search.services.acls.collection-acls]


figwheel.core: protect against nil values when finding hooks

--- figwheel-core/src/figwheel/core.cljc
+++ figwheel-core/src/figwheel/core.cljc
@@ -259,7 +259,10 @@
                         [n f]))
                     (:figwheel.core/metadata @state))]
     (doseq [[n f] hooks]
-      (if-let [hook (reduce #(gobj/get %1 %2) goog.global (map str (concat (string/split n #"\.") [f])))]
+      (if-let [hook (reduce #(when %1
+                               (gobj/get %1 %2))
+                            goog.global
+                            (map str (concat (string/split n #"\.") [f])))]
         (do
           (glog/info logger (str "Calling " (pr-str hook-key) " hook - " n "." f))
           (apply hook args))


figwheel.main: get rid of duplicate error logging

--- figwheel-main/src/figwheel/main.cljc
+++ figwheel-main/src/figwheel/main.cljc
@@ -131,7 +131,6 @@
                          (log/debug "Detected changed cljs files: " (pr-str (map str files)))
                          (fig-core-build id inputs opts cenv files)
                          (catch Throwable t
-                           (log/syntax-exception t)
                            (figwheel.core/notify-on-exception cenv t {})
                            false))))))}))))


Add Heroku and Sauce Labs titles

Add Heroku and Sauce Labs titles

--- frontend/controllers/navigation.cljs
+++ frontend/controllers/navigation.cljs
@@ -441,5 +441,7 @@

 (defmethod post-navigated-to! :integrations
   [history-imp navigation-point {:keys [integration] :as args} previous-state current-state]
-  (let [titles {:docker "CircleCI and Docker"}]
+  (let [titles {:docker "CircleCI and Docker"
+                :heroku "Deploy to Heroku from CircleCI"
+                :saucelabs "Test with Sauce Labs on CircleCI"}]
     (set-page-title! (get titles integration))))


Isn't capitalized

Isn't capitalized

--- test/cljs/go_test.clj
+++ test/cljs/go_test.clj
@@ -167,7 +167,7 @@
                   ;;   IFoo
                   ;;   (-bar [this _] this))

-                  ;; (def my-foo-with-this (MyFooWithThis.))
+                  ;; (def foo-with-this (MyFooWithThis.))

                   ;; (deftype MyFooWithField [field]
                   ;;   IFoo
@@ -180,7 +180,7 @@
           "`IFoo`" '(js* "reflect.TypeOf((*IFoo)(nil)).Elem().Name()")
           1 '(js* "reflect.TypeOf((*IFoo)(nil)).Elem().NumMethod()")
           ;; "`foo`" '(-bar (MyFooWithArg.) "foo")
-          ;; "My_Foo_With_This" '(-bar (MyFooWithThis.) "foo")
+          ;; "Foo_with_this" '(-bar (MyFooWithThis.) "foo")
           ;; 0 '(-bar (MyFooWithField. 0) "foo")
           )
     (test "Var"


removed duplication in the result maps

removed duplication in the result maps

--- src/midje/unprocessed.clj
+++ src/midje/unprocessed.clj
@@ -13,18 +13,27 @@
 (immigrate 'midje.checkers)

-(defmulti ^{:private true} check-result (fn [actual call]
-                         (:desired-check call)))
+(defmulti ^{:private true} check-result (fn [actual call]
+                                          (:desired-check call)))
+
+(letfn [(base-result [type actual call]
+          {:type type
+           :binding-note (:binding-note call)
+           :position (:position call)
+           :actual actual })]
+
+  (defn- failure-result [type actual call]
+    (assoc (base-result type actual call) :expected (:expected-result-text-for-failures call)))
+
+  (defn- success-result [type actual call]
+    (assoc (base-result type actual call) :expected (:expected-result call) )))

 (defmethod check-result :check-match [actual call]
   (cond (extended-= actual (:expected-result call))
         (report {:type :pass})

-        (fn? (call :expected-result))
-        (report (merge {:type :mock-expected-result-functional-failure
-                        :binding-note (:binding-note call)
-                        :position (:position call)
-                        :expected (:expected-result-text-for-failures call) }
+        (fn? (:expected-result call))
+        (report (merge (failure-result :mock-expected-result-functional-failure actual call)
                        (if (chatty-checker? (:expected-result call))
                          (do
                            (let [chatty-result ((:expected-result call) actual)]
@@ -37,29 +46,17 @@
                                              " instead of a map.")]})))
                          {:actual actual})))
         :else
-        (report {:type :mock-expected-result-failure
-                 :position (:position call)
-                 :binding-note (:binding-note call)
-                 :actual actual
-                 :expected (:expected-result call) })))
+        (report (success-result :mock-expected-result-failure actual call))))

 (defmethod check-result :check-negated-match [actual call]
    (cond (not (extended-= actual (:expected-result call)))
          (report {:type :pass})

-        (fn? (call :expected-result))
-        (report {:type :mock-actual-inappropriately-matches-checker
-                 :binding-note (:binding-note call)
-                 :position (:position call)
-                 :expected (:expected-result-text-for-failures call)
-                 :actual actual})
+        (fn? (:expected-result call))
+        (report (failure-result :mock-actual-inappropriately-matches-checker actual call))

         :else
-        (report {:type :mock-expected-result-inappropriately-matched
-                 :binding-note (:binding-note call)
-                 :position (:position call)
-                 :expected (:expected-result-text-for-failures call)
-                 :actual actual})))
+        (report (failure-result :mock-expected-result-inappropriately-matched actual call))))

 (defn expect*
   "The core function in unprocessed Midje. Takes a map describing a
@@ -77,4 +74,4 @@
                                      ((:function-under-test unprocessed-check))))]
         (check-call-counts local-fakes)
         (check-result code-under-test-result unprocessed-check)
-        :irrelevant-return-value))))
+        :irrelevant-return-value))))


fix like creation

fix like creation

--- server/src/gratefulplace/db/maprules.clj
+++ server/src/gratefulplace/db/maprules.clj
@@ -102,6 +102,6 @@
   (attr :post/content :content))

 (defmaprules like->txdata
-  (attr :db/id dbid)
+  (attr :db/id (fn [_] #db/id[:db.part/user]))
   (attr :like/user :user-id)
   (attr :like/post #(str->int (:post-id %))))


Minor dispatcher refactoring

Minor dispatcher refactoring

--- frontend/src/faceboard/dispatcher.cljs
+++ frontend/src/faceboard/dispatcher.cljs
@@ -1,13 +1,13 @@
 (ns faceboard.dispatcher
-  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
-  (:require [cljs.core.async :as async :refer [<! >!]]
-            [faceboard.commands :as commands]
-            [faceboard.controller :as controller :refer [perform!]]
-            [faceboard.logging :refer [log, log-err, log-warn]]))
+  (:require [cljs.core.async :refer [<! >!]]
+            [faceboard.commands :refer [handle-command]]
+            [faceboard.controller :refer [perform! command-chan]]
+            [faceboard.logging :refer [log, log-err, log-warn]])
+  (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

 (defn start-processing-commands []
   (go-loop []
-    (let [command (<! controller/command-chan)]
+    (let [command (<! command-chan)]
       (log "handle command:" command)
-      (apply commands/handle-command command))
+      (apply handle-command command))
     (recur)))


Add page-metadata defaults to constants namespace.

--- frontend/src/uxbox/main/constants.cljs
+++ frontend/src/uxbox/main/constants.cljs
@@ -5,9 +5,6 @@
 ;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>

 (ns uxbox.main.constants)
-
-(def grid-x-axis 10)
-(def grid-y-axis 10)

 (def viewport-width 4000)
 (def viewport-height 4000)
@@ -17,3 +14,14 @@
 (def canvas-scroll-padding 50)
 (def canvas-start-scroll-x (- canvas-start-x canvas-scroll-padding))
 (def canvas-start-scroll-y (- canvas-start-y canvas-scroll-padding))
+
+(def grid-x-axis 10)
+(def grid-y-axis 10)
+
+(def page-metadata
+  "Default data for page metadata."
+  {:grid-x-axis grid-x-axis
+   :grid-y-axis grid-y-axis
+   :grid-color "#cccccc"
+   :grid-alignment true
+   :background "#ffffff"})


Respect :onyx/batch-timeout.

Respect :onyx/batch-timeout.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -1,5 +1,5 @@
 (ns onyx.plugin.kafka
-  (:require [clojure.core.async :refer [chan >!! <!! close!]]
+  (:require [clojure.core.async :refer [chan >!! <!! close! timeout alts!!]]
             [clojure.data.fressian :as fressian]
             [clj-kafka.consumer.zk :as zk]
             [clj-kafka.producer :as kp]
@@ -29,10 +29,13 @@

 (defmethod p-ext/read-batch [:input :kafka]
   [{:keys [kafka/ch onyx.core/task-map] :as event}]
-  {:onyx.core/batch (->> (range (:onyx/batch-size task-map))
-                         (map (fn [_] (<!! ch)))
-                         (filter identity)
-                         (map (fn [x] {:input :kafka :message x})))})
+  (let [ms (or (:onyx/batch-timeout task-map) 1000)]
+    {:onyx.core/batch
+     (->> (range (:onyx/batch-size task-map))
+          (map (fn [_]
+                 {:input :kafka
+                  :message (first (alts!! [ch (timeout ms)]))}))
+          (filter (comp not nil? :message)))}))

 (defmethod p-ext/decompress-batch [:input :kafka]
   [{:keys [onyx.core/batch] :as event}]


Fixed click callbacks to properly bind the current selected character.

--- src-browser/simplestrat/renderstate.cljs
+++ src-browser/simplestrat/renderstate.cljs
@@ -407,11 +407,12 @@
     ;; lookup the clicked tile to see if there is a clickable there
     (js/console.log (clj->js [tilex tiley]))
     (js/console.log clickedon)
-    (clickedon)
+    (if clickedon (clickedon))
     ))

 (defn- movecallback
   [gamestate character action [targetx targety]]
+  (js/console.log (clj->js [character action]))
   (*submitplayeraction* #(action/invokemoveaction gamestate character action [targetx targety])))

 (defn- attackcallback
@@ -421,8 +422,8 @@
 (defn- buildclickcallbacks
   [renderstate actiondata]
   (let [{:keys [moves attacks]} actiondata
-        {:keys [gamestate characterid]} renderstate
-        character (world/get-character gamestate characterid)
+        {:keys [gamestate selectedcharacterid selectedaction]} renderstate
+        character (world/get-character gamestate selectedcharacterid)
         addmovecallback (fn [callbacks [action location]]
                           (assoc callbacks location #(movecallback gamestate character action location)))
         addattackcallback (fn [callbacks [action target]]


Copy tweaks

Copy tweaks

--- src-cljs/frontend/components/mobile.cljs
+++ src-cljs/frontend/components/mobile.cljs
@@ -71,7 +71,7 @@
           [:div.feature
            icons/app-store
            [:h3 "Improve App Store Rating"]
-           [:p "Use Continuous Integration to reduce bugs so that you ship "
+           [:p "Use Continuous Integration to reduce bugs so you ship "
             "great apps that your customers love."]]
           [:div.feature
            icons/testing
@@ -84,7 +84,7 @@
            [:h3 "Inferred Project Setup"]
            [:p "Easily set up projects. Just like CircleCI for web apps, we infer "
             "your project settings without the developer having to do the setup. "
-            "You can still setup your environment using the yml."]]
+            "You can still set up your environment using the yml."]]
           [:div.feature
            icons/build-env
            [:h3 "Full Control"]


Clarified fire preprocessing argument docs

--- src/clj/forma/hadoop/jobs/preprocess.clj
+++ src/clj/forma/hadoop/jobs/preprocess.clj
@@ -111,8 +111,8 @@

 (defmain PreprocessFire
   "Path for running FORMA fires processing. See the forma-clj wiki for
-more details. m-res is the resolution of the other MODIS data we are
-using, likely \"500\""
+   more details. m-res is the desired output resolution, likely the
+   resolution of the other MODIS data we are using (i.e. \"500\")"
   ([path out-path m-res out-t-res start-date est-start est-end tiles-or-isos]
      (let [tiles (parse-locations tiles-or-isos)
            fire-src (f/fire-source (hfs-textline path) tiles m-res)


extract previous-balance function

extract previous-balance function

--- src/clj_money/models/reconciliations.clj
+++ src/clj_money/models/reconciliations.clj
@@ -47,16 +47,22 @@
       (update-in [:end-of-period] tc/to-local-date)
       (update-in [:status] keyword)))

+(defn previous-balance
+  "Returns the last reconciled balance for an account"
+  [storage-spec account-id]
+  (with-storage [s storage-spec]
+    (or  (->> account-id
+              (select-reconciliations-by-account-id s)
+              (sort-by :end-of-balance)
+              last
+              :balance)
+        0M)))
+
 (defn- is-in-balance?
   [storage reconciliation]
   (or (= :new (:status reconciliation))
       (let [account (accounts/find-by-id storage (:account-id reconciliation))
-            starting-balance (or  (->> (:account-id reconciliation)
-                                       (select-reconciliations-by-account-id storage)
-                                       (sort-by :end-of-balance)
-                                       last
-                                       :balance)
-                                 0M)
+            starting-balance (previous-balance storage (:account-id reconciliation))
             delta (->> (transactions/find-items-by-ids storage
                                                        (:item-ids reconciliation))
                        (map #(accounts/polarize-amount % account))


Comments on IUserInteractions

Comments on IUserInteractions

--- src/cljs/triboard/view/interactions.cljs
+++ src/cljs/triboard/view/interactions.cljs
@@ -7,4 +7,4 @@
   (on-toogle-help [this] "Send a toggle help command")
   (on-restart [this] "Send a restart command")
   (on-undo [this] "Send an undo command")
-  (on-player-move [this x y] "Send a command to player at [x y]"))
+  (on-player-move [this x y] "Send a play command at [x y]"))


Add :gecco2016-plus2 diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -847,6 +847,18 @@
       (and (> (reduce min diffs) 0) ;; diversification threshold set here
            (> (count (distinct diffs)) 2)))))

+(defn gecco2016-plus2-diversifying?
+  [ind argmap]
+  (let [g (:genome ind)
+        delta #(expressed-difference
+                 g
+                 (produce-child-genome-by-autoconstruction g g argmap)
+                 argmap)
+        diffs (repeatedly 4 delta)]
+    (assoc ind :diversifying
+      (and (> (reduce min diffs) 0) ;; diversification threshold set here
+           (> (count (distinct diffs)) 3)))))
+
 (defn doesnt-clone-diversifying?
   [ind argmap]
   (let [g (:genome ind)]
@@ -1195,6 +1207,7 @@
       (recur ((case (first tests)
                 :gecco2016 gecco2016-diversifying?
                 :gecco2016-plus1 gecco2016-plus1-diversifying?
+                :gecco2016-plus2 gecco2016-plus2-diversifying?
                 :three-gens-diff-diffs three-gens-diff-diffs-diversifying?
                 :three-gens-same-inputs-diff-diffs three-gens-same-inputs-diff-diffs-diversifying?
                 :four-gens-same-inputs-diff-diffs four-gens-same-inputs-diff-diffs-diversifying?


threshold doesn't get updated each step, it just carries over

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -38,7 +38,7 @@
     {:pos-x (+ x-step (get rocket :pos-x))
      :pos-y (+ y-step (get rocket :pos-y))
      :dir-vector dir-vector
-     :remaining-steps (- steps 1)}))
+     :threshold (get rocket :threshold)}))

 (defn update [game-world]
   (let [rockets (map update-rocket-step


CMR-6175: As a CMR Ingest Client, I Want a More Meaningful Error Status in the Event of Multiple, Overlapping Ingests.

--- metadata-db-app/src/cmr/metadata_db/data/oracle/concepts.clj
+++ metadata-db-app/src/cmr/metadata_db/data/oracle/concepts.clj
@@ -421,14 +421,8 @@
          nil)))
     (catch Exception e
       (let [error-message (.getMessage e)
-            error-code (cond
-                         (re-find #"unique constraint.*_CID_REV" error-message)
+            error-code (if (re-find #"unique constraint.* violated" error-message)
                          :revision-id-conflict
-
-                         (re-find #"unique constraint.*_CON_REV" error-message)
-                         :revision-id-conflict
-
-                         :else
                          :unknown-error)]
         {:error error-code :error-message error-message :throwable e}))))


improve typeahead + demo

improve typeahead + demo

:suggestion-to-string arg added
so the input-text value can be set when a choice is made

--- src/re_com/typeahead.cljs
+++ src/re_com/typeahead.cljs
@@ -21,6 +21,7 @@
    {:name :on-change         :required true                   :type "string -> nil"    :validate-fn fn?                :description [:span [:code ":change-on-blur?"] " controls when it is called. Passed a suggestion object (which come from ." [:code ":data-source"] ")"] }
    {:name :data-source       :required true                   :type "fn"               :validate-fn fn?                :description [:span [:code ":data-source"] " supplies suggestion objects. This can either accept a single string argument (the search term), or a string and a callback. For the first case, the fn should return a 2-element vector containing the search term and a collection of suggestion objects (which can be anything). For the second case, the fn should return nil, and eventually result in a call to the callback passing two arguments: the search query and a vector of suggestion objects."]}
    {:name :render-suggestion :required false                  :type "render fn"        :validate-fn fn?                :description "override the rendering of the suggestion items by passing a fn that returns hiccup forms. The fn will receive two arguments: the search term, and the suggestion object."}
+   {:name :suggestion-to-string :required false               :type "suggestion -> string" :validate-fn fn?            :description "When a suggestion is chosen, the input-text value will be set to the result of calling this fn with the suggestion object."}
    {:name :rigid?            :required false :default true    :type "boolean | atom"                                   :description [:span "If "[:code "false"]" the user will be allowed to choose arbitrary text input rather than a suggestion from " [:code ":data-source"]". In this case, a String will be supplied in lieu of a suggestion object." ]}
    {:name :status            :required false                  :type "keyword"          :validate-fn input-status-type? :description [:span "validation status. " [:code "nil/omitted"] " for normal status or one of: " input-status-types-list]}
    {:name :status-icon?      :required false :default false   :type "boolean"                                          :description [:span "when true, display an icon to match " [:code ":status"] " (no icon for nil)"]}
@@ -34,22 +35,11 @@
    {:name :style             :required false                  :type "CSS style map"    :validate-fn css-style?         :description "CSS styles to add or override"}
    {:name :attr              :required false                  :type "HTML attr map"    :validate-fn html-attr?         :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}])

-;; TODO
-;; fix docs/demo
 ;; respect change-on-blur? (if false, typeahead model should change as user moves through suggestions with kbd/mouse)
 ;;   if rigid? is also false, then model should change as the user types as well
-;; escape key should reset
-;; deleting the text should reset
-;; ability to focus the input-text would be nice...
-
-;; rigid? is good-to-go but not change-on-blur?
-
-;; :data-source (case @something :v1 one-fn  :v2 two-fn)
-;; doesn't work, and it'd be nice to support that...
-;; so on render, test if data-source is identical? to last time
-;; if not, reset-typeahead and use new data-source
-
-
+
+;; TODO
+;; ability to focus the input-text would be nice... this is also missing from input-text

 (defn debounce [in ms]
   (let [out (chan)]
@@ -70,28 +60,13 @@
 (defn- wrap [index count]
   (mod (+ count index) count))

-(defn- select-prev
-  [{:as state :keys [suggestions]}]
-  (cond-> state
-    (not-empty suggestions)
-    (update :selected-index #(-> % (or 0) dec (wrap (count suggestions))))))
-
-(defn- select-next
-  [{:as state :keys [suggestions]}]
-  (cond-> state
-    (not-empty suggestions)
-    (update :selected-index #(-> % (or -1) inc (wrap (count suggestions))))))
-
-(defn- select-set
-  [state i]
-  (assoc state :selected-index i))
-
 (defn- choice-made
-  [{:as state :keys [on-change]} choice]
+  [{:as state :keys [on-change change-on-blur?]} choice]
   (when on-change (on-change choice))
-  (-> state
-      (assoc :model choice :input-text "")
-      (dissoc :suggestions)))
+  (cond-> state
+    :always (assoc :model choice :input-text "")
+    ;; the trouble with this is that if change-on-blur? is false then clicking doesn't get rid of the suggestions either
+    (deref-or-value change-on-blur?) (dissoc :suggestions)))

 (defn- select-choose
   [{:as state :keys [suggestions selected-index on-change rigid? input-text]}]
@@ -102,6 +77,32 @@

     selected-index
     (choice-made (let [[_ suggestion] (nth suggestions selected-index)] suggestion))))
+
+(defn- select-prev
+  [{:as state :keys [suggestions change-on-blur?]}]
+  (cond-> state
+    (not-empty suggestions) (update :selected-index #(-> % (or 0) dec (wrap (count suggestions))))
+    (not (deref-or-value change-on-blur?)) select-choose))
+
+(defn- select-next
+  [{:as state :keys [suggestions change-on-blur?]}]
+  (cond-> state
+    (not-empty suggestions) (update :selected-index #(-> % (or -1) inc (wrap (count suggestions))))
+    (not (deref-or-value change-on-blur?)) select-choose))
+
+(defn- select-by-index
+  "Called when the mouse hovers over a suggestion."
+  [{:as state :keys [change-on-blur?]} index]
+  (cond-> state
+    :always (assoc :selected-index index)
+    (not (deref-or-value change-on-blur?)) select-choose))
+
+(defn- choose-by-index
+  "Called when the mouse clicks a suggestion."
+  [{:as state :keys [change-on-blur?]} index]
+  (-> state
+      (select-by-index index)
+      (dissoc :suggestions)))

 (defn- select-reset
   [state]
@@ -112,6 +113,17 @@
   (-> state
       (assoc :waiting? false :suggestions [] :input-text "")
       select-reset))
+
+(defn- change-text-input
+  "Called when the text in the wrapped input-text is changed."
+  [{:as state :keys [change-on-blur? rigid?]} new-text]
+  (cond-> state
+    :always
+    (assoc :input-text new-text)
+
+    (and (not (deref-or-value change-on-blur?))
+         (not (deref-or-value rigid?)))
+    (choice-made new-text)))

 (defn- search-data-source
   "Call the user-supplied `data-source` fn and put the result on `c-sugg`.
@@ -122,9 +134,10 @@
   (swap! state-atom assoc :waiting? true))

 (defn- handle-search
-  [state-atom c-sugg data-source c-search]
+  [state-atom c-sugg c-search]
   (go-loop []
-    (let [new-text (<! c-search)]
+    (let [new-text (<! c-search)
+          data-source (:data-source @state-atom)]
       (if (= "" new-text)
         (swap! state-atom reset-typeahead)
         (search-data-source data-source state-atom c-sugg new-text))
@@ -141,10 +154,11 @@
     (recur)))

 (defn- make-typeahead-state
-  [{:as args :keys [on-change rigid? data-source]}]
+  [{:as args :keys [on-change rigid? change-on-blur? data-source]}]
   (let [c-input (chan)]
     (assoc typeahead-state-initial
-           :data-source data-source     ;; FIXME does not work yet ... need to make it test in render if this value has changed since last render
+           :data-source data-source
+           :change-on-blur? change-on-blur?
            :on-change  on-change
            :rigid?     rigid?
            :c-input    c-input
@@ -186,24 +200,36 @@
                  (swap! state-atom typeahead-blur)))
       true)))

+(defn- change-data-source
+  "Return new state after changing data-source. The typeahead render fn checks to see if it
+  has changed since the last render, and calls this."
+  [state data-source]
+  (-> state
+      reset-typeahead
+      (assoc :data-source data-source)))
+
 (defn- typeahead
   "Returns markup for a typeahead text input"
-  [& {:keys [data-source on-change rigid?] :as args}]
+  [& {:keys [data-source on-change rigid? change-on-blur?] :as args}]
   {:pre [(validate-args-macro typeahead-args-desc args "typeahead")]}
   (let [{:as state :keys [ c-search c-sugg c-input c-keypress ]} (make-typeahead-state args)
         state-atom (reagent/atom state)
         input-text-model (reagent/cursor state-atom [:input-text])]
     (handle-search-results state-atom c-sugg)
-    (handle-search state-atom c-sugg data-source c-search)
+    (handle-search state-atom c-sugg c-search)
     (fn
-      [& {:keys [render-suggestion on-change model
-                 placeholder width height status-icon?
-                 status status-tooltip disabled? rigid?
-                 class style]
+      [& {:keys [data-source on-change rigid?
+                 model placeholder width height
+                 status-icon? status status-tooltip
+                 disabled? class style render-suggestion
+                 suggestion-to-string]
           :as   args}]
       {:pre [(validate-args-macro typeahead-args-desc args "typeahead")]}
-      (let [{:keys [suggestions waiting? model selected-index]} @state-atom
+      (let [{:as state :keys [suggestions waiting? model selected-index]} @state-atom
+            last-data-source (:data-source state)
             width (or width "250px")]
+        (when (not= last-data-source data-source)
+          (swap! state-atom change-data-source data-source))
         [v-box
          :width width
          :children
@@ -218,9 +244,7 @@
            :width          width
            :height         height
            :placeholder    placeholder
-           :on-change #(do (swap! state-atom assoc :input-text %)
-                           (when-not (clojure.string/blank? %)
-                             (put! c-input %)))
+           :on-change      #(do (swap! state-atom change-text-input %) (put! c-input %))
            :change-on-blur? false
            :attr {:on-key-down #(on-key-down state-atom %)}]
           (if (or (not-empty suggestions) waiting?)
@@ -237,5 +261,5 @@
                                     s)
                            :class (str "rc-typeahead-suggestion"
                                        (when selected? " active"))
-                           :attr {:on-mouse-over #(swap! state-atom select-set i)
-                                  :on-mouse-down #(do (.preventDefault %) (swap! state-atom select-choose))}])]])]]))))
+                           :attr {:on-mouse-over #(swap! state-atom select-by-index i)
+                                  :on-mouse-down #(do (.preventDefault %) (swap! state-atom choose-by-index i))}])]])]]))))


[#2127] Add endpoints tests

[#2127] Add endpoints tests

--- backend/test/akvo/lumen/endpoints_test.clj
+++ backend/test/akvo/lumen/endpoints_test.clj
@@ -172,7 +172,26 @@
                       :status "OK"
                       :transformations []
                       :columns commons/dataset-link-columns}
-                     (select-keys meta-dataset [:id :name :status :transformations :columns])))))
+                     (select-keys meta-dataset [:id :name :status :transformations :columns]))))
+
+            (let [meta-group-dataset (-> (h (get* (api-url "/datasets" dataset-id "groups")))
+                                   body-kw)]
+              (is (= {:id dataset-id
+                      :name title
+                      :status "OK"
+                      :transformations []
+                      :groups {:transformations []
+                               :main (map #(assoc % :groupName "main" :groupId "main") commons/dataset-link-columns)}}
+                     (select-keys meta-group-dataset [:id :name :status :transformations :groups]))))
+
+            (let [meta-group-dataset (-> (h (get* (api-url "/datasets" dataset-id "group" "main")))
+                                   body-kw)]
+              (is (= {:id dataset-id
+                      :name title
+                      :status "OK"
+                      :transformations []
+                      :columns (map #(assoc % :groupName "main" :groupId "main") commons/dataset-link-columns)}
+                     (select-keys meta-group-dataset [:id :name :status :transformations :columns])))))

           (testing "sort"
             (let [dataset-sort (-> (h (get* (api-url "/datasets" dataset-id "sort" "c6" "text") {"limit" "1"}))


Oops!

Oops!

--- web/src/immutant/web/internal/servlet.clj
+++ web/src/immutant/web/internal/servlet.clj
@@ -135,7 +135,7 @@

   `ws-callbacks` is a map of callbacks for handling the WebSocket, and are
   the same as the callbacks provided to [[immutant.web.async/as-channel]]."
-  [^HttpServlet servlet ^ServletConfig servlet-config ws-callbacks]
+  [^Servlet servlet ^ServletConfig servlet-config ws-callbacks]
   (add-endpoint-with-handler servlet servlet-config
     (fn [req]
       (async/as-channel req ws-callbacks))))


Fix adding first component

Fix adding first component

--- src/warehouse/events.cljs
+++ src/warehouse/events.cljs
@@ -84,7 +84,9 @@
   (fn
     [cofx [_ item]]
     (let [old-components (get-in cofx [:db :components])
-          k (or (inc (apply max (keys old-components))) 1)
+          k (if (empty? old-components)
+              1
+              (inc (apply max (keys old-components))))
           new-components (assoc old-components
                                 k (-> item
                                       (normalize-item)


completing work on new kernels

completing work on new kernels

--- core/src/samsara_core/kernel2.clj
+++ core/src/samsara_core/kernel2.clj
@@ -33,11 +33,9 @@

 (defn process
-  "Returns a function which takes a collection of values
-   and it applies the given handler to the values as a whole"
-  [handler]
-  (fn [values]
-    (handler values)))
+  "Apply the handler to the given values"
+  [handler values]
+  (handler values))

@@ -228,21 +226,21 @@
     component/Lifecycle

-  (start [{done :route config :config :as this}]
+  (start [{done :routes config :config :as this}]
     (if-not done
-      (-> this
-          (assoc :route (build-routes this))
-          (assoc :global-stores    (atom {}))
-          (assoc :output-collector (atom nil)))
+      (as-> this $
+          (assoc $ :global-stores    (atom {}))
+          (assoc $ :output-collector (atom nil))
+          (assoc $ :routes (dispatch-group-by (build-routes $))))
       this))

-  (stop [{done :route :as this}]
+  (stop [{done :routes :as this}]
     (if done
       (-> this
-          (assoc :route            nil)
-          (assoc :global-stores    nil)
-          (assoc :output-collector nil))
+          (assoc :routes            nil)
+          (assoc :global-stores     nil)
+          (assoc :output-collector  nil))
       this)))

@@ -268,6 +266,13 @@

+(defn stream-config
+  "Return the configuration for the given stream"
+  [component stream-id]
+  (get-in component [:config :streams stream-id]))
+
+
+
 (defn local-kv-restore
   "Takes a bunch of tx-log events and restores them in the stream local-stores"
   ([{:keys [component stream-id events]}]
@@ -284,14 +289,17 @@

-(def ^:const DEFAULT-STREAM-CFG
+(def DEFAULT-STREAM-CFG
   {:input-partitions          :all
    :state                     :none
    :format                    :json
    :processor                 "samsara-core.core/make-samsara-processor"
    :processor-type            :samsara-factory
    :bootstrap                 false
-   :output-topic-partition-fn :sourceId})
+   :output-topic-partition-fn :sourceId
+   ;; TODO: handle state :none in topic-wrapper
+   :local-store (thread-local (kv/make-in-memory-kvstore))
+   })

@@ -325,7 +333,7 @@

-(defn- normalize-streams-with-defaults
+(defn normalize-streams-with-defaults
   "apply streams defaults"
   [config]
   (-> config
@@ -340,15 +348,7 @@

 (defn make-samsara-core [config]
-  (let [cfg (normalize-streams-with-defaults config)]
-    (map->SamsaraCore {:config cfg})))
-
-
-
-(defn stream-config
-  "Return the configuration for the given stream"
-  [component stream-id]
-  (get-in component [:config :streams stream-id]))
+  (map->SamsaraCore {:config config}))

@@ -496,6 +496,12 @@
 ;;                                                                            ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(def ^:dynamic *print-streams*  false)
+
+(defmacro printf-stream [& args]
+  `(when *print-streams*
+     (printf ~@args)))
+

 (def all-events-counter
   "return a function which is a counter
@@ -522,6 +528,46 @@
            (trk/get-metric "events.all.counter"))
          :unknown)))))

+;; TODO: remove this
+(defn events-counter-stats []
+  (all-events-counter :current-value))
+
+
+(def ^:dynamic *pipelines* nil)
+
+
+(defn init-pipeline! [config]
+  (log/info "Initialize processors...")
+  (let [cmp (component/start (make-samsara-core config))]
+    (alter-var-root #'*pipelines*
+                    (constantly
+                     (fn [output-collector stream partition key message]
+                       (reset! (:output-collector cmp) output-collector)
+                       (process (:routes cmp) [{:topic stream
+                                                :partition partition
+                                                :key key
+                                                :message message}]))))
+    cmp))
+
+
+(defn process-dispatch
+  "Takes an event as a JSON encoded String and depending on the stream
+   name dispatches the function to the appropriate handler.
+   One handler is the normal pipeline processing, the second handler
+   is for the kv-store"
+  [output-collector stream partition key message]
+
+  (all-events-counter)
+  (try
+    (*pipelines* output-collector stream partition key message)
+
+    ;;
+    ;; ERROR Handling
+    ;;
+    (catch Exception x
+      (log/warn x "Error processing message from [" stream "]:" message)
+      #_(track-rate (str "pipeline." (-> *config* :job :job-name) "." stream ".errors"))
+      (output-collector [[(str stream "-errors") key message]]))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -655,3 +701,44 @@

   )
+
+
+(comment
+
+  (require '[clj-kafka.producer :as kp])
+  (let [brokers "localhost:9092"
+        topic  "ingestion"
+        prodx  (kp/producer
+                {"metadata.broker.list" brokers
+                 "request.required.acks"  "-1"
+                 "producer.type" "sync"
+                 "serializer.class" "kafka.serializer.StringEncoder"
+                 "partitioner.class" "kafka.producer.DefaultPartitioner"})
+        now     (System/currentTimeMillis)
+        event   (fn [i] {:timestamp (+ now i) :eventName "test" :sourceId (str "d" i)})
+        events  (partition-all 1000 (take (* 5 1000 1000) (map event (range))))
+        ->msg   (fn [{:keys [sourceId] :as e}]
+                 (kp/message topic sourceId (to-json e)))]
+    (doseq [batch events]
+      (kp/send-messages prodx (map ->msg batch)))
+    :all-done)
+
+
+  (let [brokers "localhost:9092"
+        topic  "vod-programme"
+        prodx  (kp/producer
+                {"metadata.broker.list" brokers
+                 "request.required.acks"  "-1"
+                 "producer.type" "sync"
+                 "serializer.class" "kafka.serializer.StringEncoder"
+                 "partitioner.class" "kafka.producer.DefaultPartitioner"})
+        now     (System/currentTimeMillis)
+        kv      (kv/make-in-memory-kvstore)
+        kvx   (fn [kv i] (kv/set kv (str "d" (mod i 100)) :key i))
+        events  (partition-all 1000
+                               (kv/tx-log (reduce kvx kv (take (* 5 1000 1000) (range)))))
+        ->msg   (fn [[key :as tx]] (kp/message topic (str key) (to-json tx)))]
+    (doseq [batch events]
+      (kp/send-messages prodx (map ->msg batch)))
+    :all-done)
+  )


Add batch enumerator.

Add batch enumerator.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -202,14 +202,6 @@
     "Removes a block from the store. Returns true if the block was stored."))

-; TODO: BlockEnumerator
-; Protocol which returns a lazy sequence of every block in the store, along with
-; an opaque marker which can be used to resume the stream in the same position.
-; Blocks are explicitly **not** returned in any defined order; it is assumed the
-; store will enumerate them in the most efficient order available. For example,
-; a file store could iterate them in on-disk order.
-
-
 (defn list
   "Enumerates the stored blocks, returning a lazy sequence of block stats sorted
   by id. Iterating over the list may result in additional operations to read
@@ -275,3 +267,64 @@
    (put! store (if (instance? File source)
                  (from-file source algorithm)
                  (read! source algorithm)))))
+
+
+
+;; ## Batch Storage Functions
+
+(defprotocol BatchingStore
+  "Protocol for stores which can perform batch operations on blocks."
+
+  (-get-batch
+    [store ids]
+    "Retrieves blocks identified by a collection of multihashes. Returns a
+    sequence of the requested blocks in no particular order.")
+
+  (-put-batch!
+    [store blocks]
+    "Saves a collection of blocks in the store. Returns a sequence of the
+    stored blocks.")
+
+  (-delete-batch!
+    [store ids]
+    "Removes multiple blocks from the store identified by a collection of
+    multihashes. Returns a sequence of multihashes for the deleted blocks."))
+
+
+(defn get-batch
+  "Retrieves blocks identified by a collection of multihashes. Returns a
+  sequence of the requested blocks in no particular order."
+  [store ids]
+  ; TODO: validate ids
+  (if (satisfies? BatchingStore store)
+    (-get-batch store ids)
+    (doall (map (partial get store) ids))))
+
+
+(defn put-batch!
+  "Saves a collection of blocks in the store. Returns a sequence of the
+  stored blocks."
+  [store blocks]
+  ; TODO: validate blocks
+  (if (satisfies? BatchingStore store)
+    (-put-batch! store blocks)
+    (doall (map (partial put! store) blocks))))
+
+
+(defn delete-batch!
+  [store ids]
+  ; TODO: validate ids
+  (if (satisfies? BatchingStore store)
+    (-delete-batch! store ids)
+    (doall (filter (partial delete! store) ids))))
+
+
+
+;; ## Block Enumerator
+
+; TODO:
+; Protocol which returns a lazy sequence of every block in the store, along with
+; an opaque marker which can be used to resume the stream in the same position.
+; Blocks are explicitly **not** returned in any defined order; it is assumed the
+; store will enumerate them in the most efficient order available. For example,
+; a file store could iterate them in on-disk order.


Доработка отображения diff

Доработка отображения diff

--- radiolamp-6P3S/src/r6p3s/ui/diff_panel.cljs
+++ radiolamp-6P3S/src/r6p3s/ui/diff_panel.cljs
@@ -23,6 +23,7 @@
     (let [[b a _] diff-state]
       (->> (set (into (keys a) (keys b)))
            (filter filter-pred-fn)
+           sort
            (map (fn [k]
                   (let [a? (not (empty? a))
                         b? (not (empty? b))
@@ -44,6 +45,7 @@

                      (dom/td nil
                              (glyphicon/render icon))
+
                      (when b?
                        (dom/td nil
                                (show-value meta (get b k))))))))


Fixed subtle error with starting system

Fixed subtle error with starting system

--- src/cfpb/qu/app.clj
+++ src/cfpb/qu/app.clj
@@ -40,9 +40,9 @@
   component/Lifecycle

   (start [system]
-    (component/start-system system [:log :db :api :cache-worker])
-    (log/info "Started with settings" (str options))
-    system)
+    (let [system (component/start-system system [:log :db :api :cache-worker])]
+      (log/info "Started with settings" (str options))
+      system))

   (stop [system]
     (component/stop-system system [:api :cache-worker :db :log])))


Separate buffer assignment from refresh!

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -14,7 +14,7 @@
     (org.lwjgl BufferUtils)
     (java.nio FloatBuffer ByteBuffer)
     (java.nio.charset Charset)
-    (org.lwjgl.opengl GL GLUtil GL11 GL12 GL13 GL15 GL20 GL30 GL32)
+    (org.lwjgl.opengl GL GLUtil GL11 GL12 GL13 GL14 GL15 GL20 GL30 GL32)
     (org.lwjgl.glfw GLFW GLFWVidMode GLFWErrorCallback GLFWCharCallback GLFWKeyCallback GLFWMouseButtonCallback GLFWCursorPosCallback)
     (org.lwjgl.system Platform)
     (org.joml Matrix4f Vector3f)
@@ -395,6 +395,77 @@
      :texture-coords-vbo-id texture-coords-vbo-id
      :texture-coords-count texture-coords-count
      :vao-id vao-id}))
+
+(defn- fill-glyph-fg-bg-buffers [layer-id->character-map character->col-row character->transparent texture-columns texture-rows rows layer-size cursor-xy glyph-image-data fg-image-data bg-image-data]
+  (.clear glyph-image-data)
+  (.clear fg-image-data)
+  (.clear bg-image-data)
+  (loop-with-index layer [[layer-id character-map] layer-id->character-map]
+    ;;(doseq [[layer-id character-map] layers-character-map]
+    ;;  (doseq [[row line] (map-indexed vector (reverse @character-map))
+    ;;          [col c]    (map-indexed vector line)]
+        ;;(log/info "row" row "col" col "c" c)
+    ;(log/info layer-id)
+    ;; Set buffer positions to beginning
+    (loop-with-index row [line (reverse @character-map)]
+      (loop-with-index col [c line]
+        (let [chr        (or (get c :fx-character) (get c :character))
+              highlight  (= @cursor-xy [col (- rows row 1)])
+              [fg-r fg-g fg-b] (if highlight
+                                 (or (get c :fx-bg-color)  (get c :bg-color))
+                                 (or (get c :fx-fg-color)  (get c :fg-color)))
+              [bg-r bg-g bg-b] (if highlight
+                                 (or (get c :fx-fg-color)  (get c :fg-color))
+                                 (or (get c :fx-bg-color)  (get c :bg-color)))
+              ;s         (str (get c :character))
+              style     (get c :style)
+              i         (+ (* 4 (+ (* texture-columns row) col)) (* layer-size layer))
+              [x y]     (get character->col-row chr)
+              transparent (get character->transparent chr)]
+          (log/info "Drawing " layer-id "at col row" col row "character from atlas col row" x y c "(index=" i ") transparent" transparent )
+          (when (zero? col)
+            ;(log/info "glyph texture" glyph-texture-width glyph-texture-height)
+            ;(log/info "resetting position to start of line" layer row col i)
+            (.position glyph-image-data i)
+            (.position fg-image-data i)
+            (.position bg-image-data i))
+          (if (not= chr (char 0))
+            (do
+              (assert (or (not (nil? x)) (not (nil? y)))
+                      (format "X/Y nil - glyph not found for character %s %s"
+                        (or (str chr) "nil")
+                        (or (cond
+                              (nil? chr) "nil"
+                              (char? chr) (format "%x" (int chr))
+                              :else (str chr)))))
+              (.put glyph-image-data (unchecked-byte x))
+              (.put glyph-image-data (unchecked-byte y))
+              ;; TODO fill with appropriate type
+              (.put glyph-image-data (unchecked-byte (cond
+                                                       transparent 2
+                                                       :else 1)))
+              (.put glyph-image-data (unchecked-byte 0))
+              (.put fg-image-data    (unchecked-byte fg-r))
+              (.put fg-image-data    (unchecked-byte fg-g))
+              (.put fg-image-data    (unchecked-byte fg-b))
+              (.put fg-image-data    (unchecked-byte 0))
+              (.put bg-image-data    (unchecked-byte bg-r))
+              (.put bg-image-data    (unchecked-byte bg-g))
+              (.put bg-image-data    (unchecked-byte bg-b))
+              (.put bg-image-data    (unchecked-byte 0)))
+            ;; space ie empty, skip forward
+            (do
+              (.put glyph-image-data (byte-array 4))
+              (.put fg-image-data (byte-array 4))
+              (.put bg-image-data (byte-array 4)))))))
+      #_(log/info "At pos" (.position glyph-image-data))
+      #_(log/info "Setting layer" layer "new pos" (* texture-columns texture-height 4 (inc layer)))
+      (.position glyph-image-data (* texture-columns texture-rows 4 (inc layer)))
+      (.position fg-image-data    (* texture-columns texture-rows 4 (inc layer)))
+      (.position bg-image-data    (* texture-columns texture-rows 4 (inc layer))))
+    (.flip glyph-image-data)
+    (.flip fg-image-data)
+    (.flip bg-image-data))

 ;; Normally this would be a record, but until http://dev.clojure.org/jira/browse/CLJ-1224 is fixed
 ;; it is not performant to memoize records because hashCode values are not cached and are recalculated
@@ -546,7 +617,43 @@
         (assert (not (nil? font-texture-width)) "font-texture-width nil")
         (assert (not (nil? font-texture-height)) "font-texture-height")
         (assert (not (nil? font-texture)) "font-texture nil")
-        (doseq [[{:keys [columns rows layers]}
+        (log/info "drawing with" (mapv vec [glyph-textures fg-textures bg-textures glyph-image-data fg-image-data bg-image-data]))
+        ;; Setup render to FBO
+        (try
+          (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER, fbo-id)
+          (GL30/glEnablei GL11/GL_BLEND fbo-id)
+          (GL14/glBlendFuncSeparate GL11/GL_SRC_ALPHA GL11/GL_ONE_MINUS_SRC_ALPHA GL11/GL_ONE GL11/GL_ONE_MINUS_SRC_ALPHA)
+          (GL11/glViewport 0 0 framebuffer-width framebuffer-height)
+          (except-gl-errors (str "glViewport " framebuffer-width framebuffer-height))
+          (GL11/glClearColor 0.0 0.0 1.0 1.0)
+          (except-gl-errors (str "glClearColor  " 0.0 0.0 1.0 1.0))
+          (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
+          (except-gl-errors (str "glClear  " (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT)))
+          (GL20/glUseProgram program-id)
+          (GL20/glUniformMatrix4fv u-PMatrix false (ortho-matrix-buffer framebuffer-width framebuffer-height p-matrix-buffer))
+          (except-gl-errors (str "u-PMatrix - glUniformMatrix4  " u-PMatrix))
+          ; Bind VAO
+          (GL30/glBindVertexArray vao-id)
+          (except-gl-errors (str "vao bind - glBindVertexArray " vao-id))
+          ; Setup vertex buffer
+          (except-gl-errors (str "vbo bind - glBindBuffer " vertices-vbo-id))
+          (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute
+          (except-gl-errors "vbo bind - glEnableVertexAttribArray")
+          (except-gl-errors "vbo bind - glVertexAttribPointer")
+          ; Setup uv buffer
+          (GL20/glEnableVertexAttribArray 1);texture-coords-vertex-attribute
+          (except-gl-errors "texture coords bind")
+          ; Setup font texture
+          (GL13/glActiveTexture GL13/GL_TEXTURE0)
+          (except-gl-errors "font texture glActiveTexture")
+          (GL11/glBindTexture GL11/GL_TEXTURE_2D font-texture)
+          (except-gl-errors "font texture glBindTexture")
+          (GL20/glUniform1i u-font 0)
+          (except-gl-errors "font texture glUniform1i")
+          (catch Error e
+           (log/error "OpenGL error:" e)))
+        ;; Render each layer to FBO
+        (doseq [[{:keys [columns rows layers] [x-pos y-pos] :pos}
                  glyph-texture
                  fg-texture
                  bg-texture
@@ -568,119 +675,22 @@
                       texture-rows    (int (zutil/next-pow-2 rows))
                       layer-count     (count layers)
                       layer-size      (* 4 texture-columns texture-rows)]]
-          ;; Update glyph texture in buffers
-          (.clear glyph-image-data)
-          (.clear fg-image-data)
-          (.clear bg-image-data)
-
           ;(log/info "rendering layers")
           ;(log/info character->transparent)
-          (loop-with-index layer [[layer-id character-map] layer-character-map]
-            ;;(doseq [[layer-id character-map] layers-character-map]
-            ;;  (doseq [[row line] (map-indexed vector (reverse @character-map))
-            ;;          [col c]    (map-indexed vector line)]
-                ;;(log/info "row" row "col" col "c" c)
-            ;(log/info layer-id)
-            (loop-with-index row [line (reverse @character-map)]
-              (loop-with-index col [c line]
-                (let [chr        (or (get c :fx-character) (get c :character))
-                      highlight  (= @cursor-xy [col (- rows row 1)])
-                      [fg-r fg-g fg-b] (if highlight
-                                         (or (get c :fx-bg-color)  (get c :bg-color))
-                                         (or (get c :fx-fg-color)  (get c :fg-color)))
-                      [bg-r bg-g bg-b] (if highlight
-                                         (or (get c :fx-fg-color)  (get c :fg-color))
-                                         (or (get c :fx-bg-color)  (get c :bg-color)))
-                      ;s         (str (get c :character))
-                      style     (get c :style)
-                      i         (+ (* 4 (+ (* texture-columns row) col)) (* layer-size layer))
-                      [x y]     (get character->col-row chr)
-                      transparent (get character->transparent chr)]
-                  ;(log/info "Drawing at col row" col row "character from atlas col row" x y c "(index=" i ")")
-                  (when (zero? col)
-                    ;(log/info "glyph texture" glyph-texture-width glyph-texture-height)
-                    ;(log/info "resetting position to start of line" layer row col i)
-                    (.position glyph-image-data i)
-                    (.position fg-image-data i)
-                    (.position bg-image-data i))
-                  (if (not= chr (char 0))
-                    (do
-                      (assert (or (not (nil? x)) (not (nil? y)))
-                              (format "X/Y nil - glyph not found for character %s %s"
-                                (or (str chr) "nil")
-                                (or (cond
-                                      (nil? chr) "nil"
-                                      (char? chr) (format "%x" (int chr))
-                                      :else (str chr)))))
-                      (.put glyph-image-data (unchecked-byte x))
-                      (.put glyph-image-data (unchecked-byte y))
-                      ;; TODO fill with appropriate type
-                      (.put glyph-image-data (unchecked-byte (cond
-                                                               transparent 2
-                                                               :else 1)))
-                      (.put glyph-image-data (unchecked-byte 0))
-                      (.put fg-image-data    (unchecked-byte fg-r))
-                      (.put fg-image-data    (unchecked-byte fg-g))
-                      (.put fg-image-data    (unchecked-byte fg-b))
-                      (.put fg-image-data    (unchecked-byte 0))
-                      (.put bg-image-data    (unchecked-byte bg-r))
-                      (.put bg-image-data    (unchecked-byte bg-g))
-                      (.put bg-image-data    (unchecked-byte bg-b))
-                      (.put bg-image-data    (unchecked-byte 0)))
-                    ;; not base layer and space ie empty, skip forward
-                    (do
-                      (.put glyph-image-data (byte-array 4))
-                      (.put fg-image-data (byte-array 4))
-                      (.put bg-image-data (byte-array 4)))))))
-              #_(log/info "At pos" (.position glyph-image-data))
-              #_(log/info "Setting layer" layer "new pos" (* texture-columns texture-height 4 (inc layer)))
-              (.position glyph-image-data (* texture-columns texture-rows 4 (inc layer)))
-              (.position fg-image-data    (* texture-columns texture-rows 4 (inc layer)))
-              (.position bg-image-data    (* texture-columns texture-rows 4 (inc layer))))
-            (.flip glyph-image-data)
-            (.flip fg-image-data)
-            (.flip bg-image-data)
+          (fill-glyph-fg-bg-buffers (select-keys layer-character-map layers) character->col-row character->transparent texture-columns texture-rows rows layer-size cursor-xy glyph-image-data fg-image-data bg-image-data)
           #_(doseq [layer (partition layer-size (vec (nio/buffer-seq glyph-image-data)))]
             (log/info "layer")
             (doseq [line (partition (* 4 texture-columns) layer)]
               (log/info (vec line))))
           (try
-            (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER, fbo-id)
-            (GL11/glViewport 0 0 framebuffer-width framebuffer-height)
-            (except-gl-errors (str "glViewport " framebuffer-width framebuffer-height))
-            (GL11/glClearColor 0.0 0.0 1.0 1.0)
-            (except-gl-errors (str "glClearColor  " 0.0 0.0 1.0 1.0))
-            (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
-            (except-gl-errors (str "glClear  " (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT)))
-            (GL20/glUseProgram program-id)
-            (GL20/glUniformMatrix4fv u-PMatrix false (ortho-matrix-buffer framebuffer-width framebuffer-height p-matrix-buffer))
-            (except-gl-errors (str "u-PMatrix - glUniformMatrix4  " u-PMatrix))
             (GL20/glUniformMatrix4fv
               u-MVMatrix
               false
               (position-matrix-buffer
-                [(- (/ framebuffer-width 2)) (- (/ framebuffer-height 2)) -1.0 0.0]
+                [(+ x-pos (- (/ framebuffer-width 2))) (+ y-pos (- (/ framebuffer-height 2))) -1.0 0.0]
                 [framebuffer-width framebuffer-height 1.0]
                 mv-matrix-buffer))
             (except-gl-errors (str "u-MVMatrix - glUniformMatrix4  " u-MVMatrix))
-            ; Bind VAO
-            (GL30/glBindVertexArray vao-id)
-            (except-gl-errors (str "vao bind - glBindVertexArray " vao-id))
-            ; Setup vertex buffer
-            (except-gl-errors (str "vbo bind - glBindBuffer " vertices-vbo-id))
-            (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute
-            (except-gl-errors "vbo bind - glEnableVertexAttribArray")
-            (except-gl-errors "vbo bind - glVertexAttribPointer")
-            ; Setup uv buffer
-            (GL20/glEnableVertexAttribArray 1);texture-coords-vertex-attribute
-            (except-gl-errors "texture coords bind")
-            ; Setup font texture
-            (GL13/glActiveTexture GL13/GL_TEXTURE0)
-            (except-gl-errors "font texture glActiveTexture")
-            (GL11/glBindTexture GL11/GL_TEXTURE_2D font-texture)
-            (except-gl-errors "font texture glBindTexture")
-            (GL20/glUniform1i u-font 0)
-            (except-gl-errors "font texture glUniform1i")
             ; Setup uniforms for glyph, fg, bg, textures
             (GL20/glUniform1i u-glyphs 1)
             (GL20/glUniform1i u-fg 2)
@@ -724,6 +734,7 @@
           (GL11/glViewport 0 0 framebuffer-width framebuffer-height)
           (GL11/glClearColor 0.0 1.0 0.0 1.0)
           (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
+          (GL11/glBlendFunc GL11/GL_ONE GL11/GL_ONE_MINUS_SRC_ALPHA)
           (GL20/glUseProgram fb-program-id)
           (GL20/glUniformMatrix4fv u-fb-PMatrix false (ortho-matrix-buffer framebuffer-width framebuffer-height p-matrix-buffer))
           (except-gl-errors (str "u-fb-PMatrix - glUniformMatrix4  " u-fb-PMatrix))


Added conexp.main/test-conexp

Added conexp.main/test-conexp

for my personal convenience.

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

--- src/conexp/main.clj
+++ src/conexp/main.clj
@@ -50,6 +50,13 @@
 	     (= my-minor minor)
 	     (< my-patch patch)))))

+(defn test-conexp
+  "Runs tests for conexp."
+  []
+  (require 'conexp.tests :reload-all)
+  (require 'clojure.test)
+  (clojure.test/run-tests 'conexp.tests))
+
 ;;;

 nil


Use conexp.main when --load-ing files

Use conexp.main when --load-ing files

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

--- stuff/libs/conexp-clj.clj
+++ stuff/libs/conexp-clj.clj
@@ -24,6 +24,7 @@
                                 (@(ns-resolve 'conexp.contrib.gui 'gui)
                                  :default-close-operation javax.swing.JFrame/EXIT_ON_CLOSE))))
   (when load
+    (use 'conexp.main)
     (load-file load))
   (when-not (or load gui?)
     (clojure.main/repl :init #(use 'conexp.main))))


read all responses off of nrepl/client-session instead of nrepl/message; fixes receipt of *out* and *err* from futures, agent sends

--- ccw.core/src/clj/ccw/repl/view_helpers.clj
+++ ccw.core/src/clj/ccw/repl/view_helpers.clj
@@ -1,7 +1,8 @@
 (ns ccw.repl.view-helpers
   (:require [clojure.tools.nrepl :as repl]
     [ccw.repl.cmdhistory :as history])
-  (:use [clojure.core.incubator :only [-?>]])
+  (:use [clojure.core.incubator :only (-?>)]
+        [clojure.tools.nrepl.misc :only (uuid)])
   (:import ccw.CCWPlugin
     org.eclipse.ui.PlatformUI
     org.eclipse.swt.SWT
@@ -75,28 +76,31 @@
       (str (when (> (count s) 30) "..."))
       (.replaceAll "\\n|\\r" " "))))

-(defn eval-expression
+(defn- echo-responses
+  [repl-view log-component responses]
+  (doseq [{:keys [out err value ns status] :as resp} @responses]
+    (ui-sync
+      (when ns (.setCurrentNamespace repl-view ns))
+      (doseq [[k v] (dissoc resp :id :ns :status :session)]
+        (if (log-styles k)
+          (log log-component v k)
+          (CCWPlugin/log (str "Cannot handle REPL response: " k (pr-str resp)))))
+      (doseq [status status]
+        (case status
+          "interrupted" (log log-component (eval-failure-msg status "") :err)
+          "need-input" (ui-sync (.getStdIn repl-view))
+          nil)))))
+
+(defn- eval-expression
   [repl-view log-component client expr]
-  (let [responses (repl/message client (if (map? expr)
-                                         expr
-                                         {:op :eval :code expr :ns (.getCurrentNamespace repl-view)}))]
-    (future (try
-              (doseq [{:keys [out err value ns status] :as resp} responses]
-                (ui-sync
-                  (when ns (.setCurrentNamespace repl-view ns))
-                  (doseq [[k v] (dissoc resp :id :ns :status :session)]
-                    (if (log-styles k)
-                      (log log-component v k)
-                      (CCWPlugin/log (str "Cannot handle REPL response: " k (pr-str resp)))))
-                  ;(CCWPlugin/log (str resp))
-                  (doseq [status status]
-                    (case status
-                      "interrupted" (log log-component (eval-failure-msg status expr) :err)
-                      "need-input" (ui-sync (.getStdIn repl-view))
-                      nil))))
-              (catch Throwable t
-                (CCWPlugin/logError (eval-failure-msg nil expr) t)
-                (log log-component (eval-failure-msg nil expr) :err))))))
+  (try
+    (client (update-in (if (map? expr)
+                        expr
+                        {:op :eval :code expr :ns (.getCurrentNamespace repl-view)})
+              [:id] #(or % (uuid))))
+    (catch Throwable t
+      (CCWPlugin/logError (eval-failure-msg nil expr) t)
+      (log log-component (eval-failure-msg nil expr) :err))))

 (defn configure-repl-view
   [repl-view log-panel repl-client]
@@ -124,9 +128,15 @@
                       (reset! retained-input (.getText input-widget)))
                     (doto input-widget
                       (.setText (@history (dec (- (count @history) @current-step))))
-                      cursor-at-end))))]
+                      cursor-at-end))))
+        session (repl/client-session repl-client)
+        responses-promise (promise)]
     (.setHistoryActionFn repl-view history-action-fn)
-    (comp (partial eval-expression repl-view log-panel (repl/client-session repl-client))
+    (future (echo-responses repl-view log-panel responses-promise))
+    (comp
+      #(when-not (realized? responses-promise)
+         (deliver responses-promise %))
+      (partial eval-expression repl-view log-panel session)
       (fn [expr add-to-log?]
         (reset! retained-input nil)
         (reset! current-step -1)


autogenerated

autogenerated

--- src-cljs/tic_tac_toe/game.cljs
+++ src-cljs/tic_tac_toe/game.cljs
@@ -1,97 +0,0 @@
-(ns tic-tac-toe.game)
-
-(def blank-board
-  [:e :e :e
-   :e :e :e
-   :e :e :e])
-
-;(def winning-board
-;  [:x :x :o
-;   :e :x :e
-;   :o :o :e])
-
-(def poses (range 9))
-
-
-(defn available-squares [board]
-  (filter #(= :e (board %)) poses))
-
-(defn zip [rest]
-  (apply map vector rest))
-
-(defn place-piece [board piece pos]
-  (assoc board pos piece))
-
-(defn winning-partitions [board]
- ;(println board)
-  (let [rows (partition 3 board)
-        cols (zip rows)
-        diagonals [(apply concat (partition 1 4 board))
-                   (->> board
-                        (drop 2)
-                        (partition 1 2)
-                        (take 3)
-                        (apply concat))]]
-    (concat rows cols diagonals)))
-
-(defn player-has-won [player partitions]
-  (some (fn [partition] (every? #(= player %) partition)) partitions))
-
-(defn get-game-state
-  "Return one of :x, :o, :ongoing, :draw"
-  ([board]
-     (let [partitions (winning-partitions board)]
-       (cond
-        (player-has-won :x partitions) :x
-        (player-has-won :o partitions) :o
-        (empty? (available-squares board)) :draw
-        :else :ongoing))))
-
-;; who is the opposite player?
-(defn other-player [who]
-  (if (= who :x) :o :x))
-
-(declare choose-move)
-
-(defn score-board [board who]
-  (condp = (get-game-state board)
-    who 100
-    (other-player who) -100
-    :draw 0
-    :ongoing (let [other-players-move (choose-move board (other-player who))
-                   score (second other-players-move)]
-                  (* -1 score))))
-
-(defn score-move [board who place]
-  (let [new-board (place-piece board who place)
-        score (score-board new-board who)]
-  [place score]))
-
-
-(defn choose-move [board who]
-  (let [open-spaces (available-squares board)
-        weighted-moves          (map #(score-move board who %)  open-spaces)
-        best-move (first (sort-by second > weighted-moves))  ]
-  ; (println weighted-moves)
-   best-move))
-
-(def choose-move (memoize choose-move))
-
-
-;(choose-move winning-board :x)
-
-(defn choose-really-good-move [board who]
-  (let [best-score (choose-move board who)]
-         (if-let [score (= 100 (second best-score))]
-            (first best-score)
-            (first (choose-move board (other-player who))))))
-
-(def upgraded-rgm (memoize choose-really-good-move))
-
-
-(comment
-  (clojure.core.typed/check-ns )
-
-  )
-
-;;;;;;;;;;;; This file autogenerated from src-cljx/tic_tac_toe/game.cljx


Fix compilation error with util/debug

Fix compilation error with util/debug

--- src/main/hbase_region_inspector/util.clj
+++ src/main/hbase_region_inspector/util.clj
@@ -38,9 +38,9 @@
 (defn- log [type message]
   (println (format "%s: %s: %s" (java.util.Date.) type message)))
 (defn info [message] (log "INFO" message))
-(if (System/getenv "DEBUG")
-  (defn debug [message] (log "DEBUG" message))
-  (defn debug [&]))
+(defn debug [message]
+  (if (System/getenv "DEBUG")
+    (log "DEBUG" message)))
 (defn error [message] (log "ERROR" message))

 (defmacro elapsed-time


get available slots using available-slots

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -443,6 +443,13 @@
                         (map (fn [[sid port]] {sid #{port}}))
                         (apply (partial merge-with set/union)))
         dead-slots (if (nil? dead-slots) {} dead-slots)
+        available-slots (->> topologies
+                             .getTopologies
+                             (available-slots nimbus nil)
+                             (map (fn [[nodeId port]] {nodeId #{port}}))
+                             (apply merge-with set/union))
+        assigned-slots (assigned-slots storm-cluster-state)
+        all-slots (merge-with set/union available-slots assigned-slots)
         supervisor-infos (all-supervisor-info storm-cluster-state)
         supervisors (into {} (for [[sid supervisor-info] supervisor-infos
                                    :let [hostname (:hostname supervisor-info)
@@ -450,9 +457,8 @@
                                          dead-ports (dead-slots sid)
                                          ;; hide the dead-ports from the all-ports
                                          ;; these dead-ports can be reused in next round of assignments
-                                         all-ports (-> supervisor-info
-                                                       :meta
-                                                       set
+                                         all-ports (-> sid
+                                                       all-slots
                                                        (set/difference dead-ports)
                                                        ((fn [ports] (map int ports))))
                                          supervisor-details (SupervisorDetails. sid hostname scheduler-meta all-ports)]]


fix mongolab connection | fs / cb | #3

fix mongolab connection | fs / cb | #3

--- src/clj/conference_rating/db_handler.clj
+++ src/clj/conference_rating/db_handler.clj
@@ -7,7 +7,7 @@

 (defn- connect []
   (if mongolab-uri
-    (second (mg/connect-via-uri mongolab-uri))
+    (:db (mg/connect-via-uri mongolab-uri))
     (mg/get-db (mg/connect {:host "127.0.0.1" :port 27017}) "crdb")))

 (defn add-conference []


set db limit to 200 as quick fix to be able to load all conferences

--- src/clj/conference_rating/db_handler.clj
+++ src/clj/conference_rating/db_handler.clj
@@ -47,7 +47,7 @@
 (defn get-attendances [conference-id db]
   (let [attendance-list (mq/with-collection db "attendances"
                                             (mq/find {:conference-id conference-id})
-                                            (mq/limit 100))
+                                            (mq/limit 200))
         cleared-attandances (->> attendance-list
                              (map clear-id-in-doc)
                              (map schemas/coerce-attendance)
@@ -57,7 +57,7 @@
 (defn get-conferences-list [db]
   (let [list (mq/with-collection db "conferences"
                                  (mq/find {:deleted {$ne true}})
-                                 (mq/limit 100))]
+                                 (mq/limit 200))]
     (map clear-id-in-doc list)))

 (defn get-conference [id db]
@@ -77,7 +77,7 @@
 (s/defn ^:always-validate get-ratings :- [schemas/Rating] [conference-id db]
   (let [rating-list (mq/with-collection db "ratings"
                                         (mq/find {:conference-id conference-id})
-                                        (mq/limit 100))
+                                        (mq/limit 200))
         cleared-ratings (->> rating-list
                              (map clear-id-in-doc)
                              (map schemas/coerce-rating)


Bump the z-index on devtools

Bump the z-index on devtools

--- src/cljs/dato/debug/components/core.cljs
+++ src/cljs/dato/debug/components/core.cljs
@@ -150,7 +150,8 @@
                           :left     (px 0)
                           :bottom   (px 0)
                           :width    "100%"
-                          :height   "50%"}
+                          :height   "50%"
+                          :z-index  1501}
     [:.dato-debugger {:background-color "#eee"
                       :height "100%"}
      [:.selected-item {:font-weight "bolder"}]


Changed string novelties from Levenshtein distance to combination of hamming distance and difference in length, to improve speed.

--- src/clojush/pushgp/selection/novelty.clj
+++ src/clojush/pushgp/selection/novelty.clj
@@ -28,7 +28,8 @@
                                         (or (= b1 [])
                                             (= b2 [])) (count (concat b1 b2))
                                         :else (case (recognize-literal b1)
-                                                :string (levenshtein-distance b1 b2)
+                                                :string (+ (hamming-distance b1 b2)
+                                                           (math/abs (- (count b1) (count b2)))) ;(levenshtein-distance b1 b2)
                                                 (:integer :float) (math/abs (-' b1 b2))
                                                 (:boolean :char) (if (= b1 b2) 0 1)
                                                 (:vector_integer :vector_float :vector_string :vector_boolean) (hamming-distance b1 b2)


trim-keys

trim-keys

--- src/gamma/test.cljs
+++ src/gamma/test.cljs
@@ -5,7 +5,7 @@
             [gamma.compiler.print :as prn]
             [clojure.walk :as walk])
   (:use
-    [gamma.tools :only [stages-map print-dag compile-stages stages]]
+    [gamma.tools :only [stages-map print-dag print-tree compile-stages stages]]
     [gamma.compiler.flatten-ast :only [->tree]]))

@@ -22,6 +22,13 @@
        (stages-map :flatten-ast))
       p)))

+(defn trim-keys [x]
+  (walk/postwalk
+    (fn [x]
+      (if (map? x)
+        (dissoc x :env :shared)
+        x))
+    x))

 (comment

@@ -55,13 +62,26 @@

   (require '[clojure.walk :as walk])

-  (defn trim-keys [x]
-    (walk/postwalk
-      (fn [x]
-        (if (map? x)
-          (dissoc x :env :shared)
-          x))
-      x))
+
+  (print-tree
+    (trim-keys
+     (->tree
+       (get-in
+         (compile-stages (g/+ 1 2))
+         [:stages :move-assignments]) :root)))
+
+  (print-tree
+    (trim-keys
+      (->tree
+        (get-in
+          (compile-stages (let [x (g/sin 1)]
+                            (g/if true x 1)))
+          [:stages :move-assignments]) :root)))
+
+
+
+
+

   ;; get compiler stages to work


nrepl req

nrepl req

--- clojure/lein.symlink/profiles.clj
+++ clojure/lein.symlink/profiles.clj
@@ -2,4 +2,5 @@
  {:datomic {:install-location "/Users/daniel/src/datomic"}
   :plugins [[lein-midje "3.0.0"]
             [lein-ancient "0.5.4"]
-            [lein-environ "0.4.0"]]}}+            [lein-environ "0.4.0"]
+            [cider/cider-nrepl "0.7.0-SNAPSHOT"]]}}


azulenoids.clj: small changes

azulenoids.clj: small changes

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -1,6 +1,6 @@
 (ns org.gavrog.clojure.azulenoids
   (:use (org.gavrog.clojure [util :only [iterate-cycle unique]]
-                            [delaney :only [walk chain-end curvature]]))
+                            [delaney :only [s v chain-end curvature]]))
   (:import (org.gavrog.jane.numbers Whole)
            (org.gavrog.joss.dsyms.basic DSymbol DynamicDSymbol IndexList)
            (org.gavrog.joss.dsyms.generators CombineTiles DefineBranching2d))
@@ -22,7 +22,7 @@
   (DSymbol. "1.1:16 1:2 4 6 8 10 12 14 16,16 3 5 7 9 11 13 15:8"))

 (defn boundary-chambers [ds D i j k]
-  (iterate-cycle [#(walk ds %1 i) #(chain-end ds %1 j k)] D))
+  (iterate-cycle [#(s ds i %1) #(chain-end ds %1 j k)] D))

 (def boundary-mappings
   (let [template-boundary (boundary-chambers template (Integer. 1) 0 1 2)
@@ -33,10 +33,10 @@

 (defn on-template [ds oct2tmp]
   (let [result (DynamicDSymbol. template)]
-    (doseq [[D D*] oct2tmp :when (not (.definesOp result 2 D*))]
-      (.redefineOp result 2 D* (oct2tmp (.op ds 2 D))))
-    (doseq [[D D*] oct2tmp :when (not (.definesV result 1 2 D*))]
-      (.redefineV result 1 2 D* (.v ds 1 2 D)))
+    (doseq [[D D*] oct2tmp :when (not (s result 2 D*))]
+      (.redefineOp result 2 D* (oct2tmp (s ds 2 D))))
+    (doseq [[D D*] oct2tmp :when (not (v result 1 2 D*))]
+      (.redefineV result 1 2 D* (v ds 1 2 D)))
     result))

 (def octa-sets (filter #(-> % (curvature 1) (>= 0))


Add a hash to store agent sensor definitions.

--- metlog-agent/src/metlog_agent/core.clj
+++ metlog-agent/src/metlog_agent/core.clj
@@ -16,26 +16,35 @@
                   :series_name series-name
                   :val val}]
     (log/info "enquing sensor reading" reading)
-    (.add sensor-result-queue  reading)))
+    (.add sensor-result-queue reading)))

-(defn poll-sensor-1 []
-  (enqueue-sensor-reading "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0))))
+(def sensor-defs (atom {}))

-(defn poll-sensor-2 []
-  (enqueue-sensor-reading "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0))))
+(defn add-sensor-def [ sensor-name sensor-fn ]
+  (swap! sensor-defs assoc sensor-name sensor-fn))

-(defn poll-w1-sensor [ path ]
-  (with-open [rdr (clojure.java.io/reader path)]
+(defmacro defsensor [ name & body ]
+  `(add-sensor-def ~name (fn [] ~@body)))
+
+(defsensor "sine" (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0)))
+(defsensor "cosine" (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0)))
+
+(defn read-w1-sensor-at-path [ sensor-path ]
+  (with-open [rdr (clojure.java.io/reader sensor-path)]
     (let [ line (second (line-seq rdr)) ]
-      (if (not (nil? line))
-        (enqueue-sensor-reading "basement-temp" (/ (Double/valueOf (.substring line 29)) 1000.0))))))
+      (and (not (nil? line))
+           (/ (Double/valueOf (.substring line 29)) 1000.0)))))
+
+(if-let [ sensor-path (config-property "sensor.path") ]
+  (defsensor "basement-temp"
+    (read-w1-sensor-at-path sensor-path)))

 (defn poll-sensors []
   (log/debug "poll-sensors")
-  (poll-sensor-1)
-  (poll-sensor-2)
-  (if-let [ sensor-path (config-property "sensor.path") ]
-    (poll-w1-sensor sensor-path)))
+  (let [ current-sensor-defs @sensor-defs ]
+    (doseq [ sensor-name (keys current-sensor-defs) ]
+      (if-let [ sensor-value ((get current-sensor-defs sensor-name)) ]
+        (enqueue-sensor-reading sensor-name sensor-value)))))

 (defn take-result-queue-snapshot []
   (let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]


fixed '. 4 hours later'

fixed '. 4 hours later'

--- resources/duckling/rules/en.duration.clj
+++ resources/duckling/rules/en.duration.clj
@@ -51,8 +51,10 @@
   {:dim :duration
    :value (duration (:grain %2) (:value %1))}

-  "number.number hours" ; in 1. 5 hour but also 1.75
-  [#"(\d*)\.\s?(\d+)" #"(?i)hours?"] ;duration can't be negative...
+  ; TODO handle cases where ASR outputs "1. 5 hours"
+  ; but allowing a space creates many false positive
+  "number.number hours" ; in 1.5 hour but also 1.75
+  [#"(\d+)\.(\d+)" #"(?i)hours?"] ;duration can't be negative...
   {:dim :duration
    :value (duration :minute (int (+ (quot (* 6 (Long/parseLong (second (:groups %1)))) (java.lang.Math/pow 10 (- (count (second (:groups %1))) 1))) (* 60 (Long/parseLong (first (:groups %1)))))))}


Add unit tests or batch store methods.

Add unit tests or batch store methods.

--- test/blocks/core_test.clj
+++ test/blocks/core_test.clj
@@ -158,6 +158,99 @@
             "should be read into memory")))))

+(deftest batch-operations
+  (let [a (block/read! "foo")
+        b (block/read! "bar")
+        c (block/read! "baz")
+        test-blocks {(:id a) a
+                     (:id b) b
+                     (:id c) c}]
+    (testing "get-batch"
+      (testing "validation"
+        (is (thrown? IllegalArgumentException
+                     (block/get-batch nil :foo))
+            "with non-collection throws error")
+        (is (thrown? IllegalArgumentException
+                     (block/get-batch nil [(multihash/sha1 "foo") :foo]))
+            "with non-multihash entry throws error"))
+      (let [store (reify
+                    block/BlockStore
+                    (-get
+                      [_ id]
+                      [:get id])
+                    block/BatchingStore
+                    (-get-batch
+                      [_ ids]
+                      [:batch ids]))
+            ids [(:id a) (:id b) (:id c)]]
+        (is (= [:batch ids] (block/get-batch store ids))
+            "should use optimized method where available"))
+      (let [store (reify
+                    block/BlockStore
+                    (-get
+                      [_ id]
+                      (get test-blocks id)))
+            ids [(:id a) (:id b) (:id c) (multihash/sha1 "frobble")]]
+        (is (= [a b c] (block/get-batch store ids))
+            "should fall back to normal get method")))
+    (testing "put-batch!"
+      (testing "validation"
+        (is (thrown? IllegalArgumentException
+                     (block/put-batch! nil :foo))
+            "with non-collection throws error")
+        (is (thrown? IllegalArgumentException
+                     (block/put-batch! nil [(block/read! "foo") :foo]))
+            "with non-block entry throws error"))
+      (let [store (reify
+                    block/BlockStore
+                    (put!
+                      [_ block]
+                      [:put block])
+                    block/BatchingStore
+                    (-put-batch!
+                      [_ blocks]
+                      [:batch blocks]))]
+        (is (= [:batch [a b c]]
+               (block/put-batch! store [a b c]))
+            "should use optimized method where available"))
+      (let [store (reify
+                    block/BlockStore
+                    (put!
+                      [_ block]
+                      [:put block]))]
+        (is (= [[:put a] [:put b] [:put c]]
+               (block/put-batch! store [a b c]))
+            "should fall back to normal put method")))
+    (testing "delete-batch!"
+      (testing "validation"
+        (is (thrown? IllegalArgumentException
+                     (block/delete-batch! nil :foo))
+            "with non-collection throws error")
+        (is (thrown? IllegalArgumentException
+                     (block/delete-batch! nil [(multihash/sha1 "foo") :foo]))
+            "with non-multihash entry throws error"))
+      (let [store (reify
+                    block/BlockStore
+                    (delete!
+                      [_ id]
+                      [:delete id])
+                    block/BatchingStore
+                    (-delete-batch!
+                      [_ ids]
+                      [:batch ids]))]
+        (is (= [:batch (map :id [a b c])]
+               (block/delete-batch! store (map :id [a b c])))
+            "should use optimized method where available"))
+      (let [store (reify
+                    block/BlockStore
+                    (delete!
+                      [_ id]
+                      (contains? test-blocks id)))]
+        (is (= [(:id a) (:id b)]
+               (block/delete-batch! store [(:id a) (multihash/sha1 "qux") (:id b)]))
+            "should fall back to normal delete method")))))
+
+

 ;; ## Utility Tests


added datafy test to test suit

added datafy test to test suit

--- test/datascript/test.cljc
+++ test/datascript/test.cljc
@@ -39,7 +39,8 @@
     datascript.test.tuples
     datascript.test.validation
     datascript.test.upsert
-    datascript.test.issues))
+    datascript.test.issues
+    datascript.test.datafy))

 (defn ^:export test-clj []
   (datascript.test.core/wrap-res #(t/run-all-tests #"datascript\..*")))


Add a docstring

Add a docstring

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -16,6 +16,7 @@
     (rest/build-site components)))

 (defn create-cap-req
+  "A request for creating a cap, given a plan."
   [plan]
   (-> (mock/request :post "/v0/caps")
       (mock/body (str plan))))


Added layzee.adapters.twitter.firehose/filter overload

--- src/layzee/adapters/twitter/firehose.clj
+++ src/layzee/adapters/twitter/firehose.clj
@@ -73,9 +73,10 @@
 (defn filter
   ([oauth-credential callback]
      (filter oauth-credential callback ["lazyweb" "kanye", "xero"]))
-
-  ([oauth-credential callback track] ;; https://dev.twitter.com/streaming/reference/post/statuses/filter
-     (let [url "https://stream.twitter.com/1.1/statuses/filter.json" body { "track" (clojure.string/join "," track) }]
+
+  "Returns tweets that match one or more of <tracks>."
+  ([oauth-credential callback tracks] ;; https://dev.twitter.com/streaming/reference/post/statuses/filter
+     (let [url "https://stream.twitter.com/1.1/statuses/filter.json" body { "track" (clojure.string/join "," tracks) }]
        (println (format "Connecting to <%s> with body <%s> (See https://dev.twitter.com/streaming/reference/post/statuses/filter)" url body))
        (listen
         url


Fix clara.rules.engine/flush-rhs-insertions! to remove duplicate calls to clara.rules.listener/retract-facts!

--- src/main/clojure/clara/rules/engine.cljc
+++ src/main/clojure/clara/rules/engine.cljc
@@ -233,11 +233,12 @@
     ;; Update the count so the rule engine will know when we have normalized.
     (swap! insertions + (count facts))

+    (when listener
+      (l/retract-facts! listener facts))
+
     (doseq [[alpha-roots fact-group] (get-alphas-fn facts)
             root alpha-roots]
-
-      (when listener
-        (l/retract-facts! listener fact-group))
+
       (alpha-retract root fact-group transient-memory transport listener))))

 (defn ^:private flush-insertions!


Return a boolean value from the unseen-comments? check fn.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -193,11 +193,13 @@

 (defn- unseen-comments? [entry user-id container-seen-at]
   (let [all-comments (filterv :body (:interactions entry))
-        filtered-comments (filterv #(not= (-> % :author :user-id) user-id) all-comments)]
-    (if (and filtered-comments
-             (seq container-seen-at))
-      (count (filter #(pos? (compare (:created-at %) container-seen-at)) filtered-comments))
-      (count filtered-comments))))
+        filtered-comments (filterv #(not= (-> % :author :user-id) user-id) all-comments)
+        all-unseens (if (and filtered-comments
+                             (seq container-seen-at))
+                      (filter #(pos? (compare (:created-at %) container-seen-at)) filtered-comments)
+                      filtered-comments)]
+
+    (pos? (count filtered-comments))))

 (defn- entry-last-activity-at
   "Return the most recent created-at of the comments, exclude comments from current user if needed."


Return the total number of comments if the entry is unread for current user.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -257,9 +257,8 @@
                            :bookmarked-at (:bookmarked-at bookmark)
                            :last-read-at (:read-at entry-read)
                            :new-comments-count (when enrich-entry?
-                                                 (if entry-read
-                                                   (new-comments-count entry-with-comments user-id entry-read)
-                                                   0))
+                                                 (new-comments-count entry-with-comments user-id entry-read)
+                                                   0)
                            :new-at (when enrich-entry?
                                      (entry-new-at user-id entry-with-comments))}
                           entry)


CMR-1707: Reordered search-app middleware to address the CI error involving url-encoded POST request

--- search-app/src/cmr/search/api/routes.clj
+++ search-app/src/cmr/search/api/routes.clj
@@ -363,7 +363,7 @@
       nested-params/wrap-nested-params
       errors/invalid-url-encoding-handler
       mixed-arity-param-handler
-      copy-of-body-handler
       (errors/exception-handler default-error-format-fn)
       common-routes/pretty-print-response-handler
-      params/wrap-params))+      params/wrap-params
+      copy-of-body-handler))