CMR-4211: More descriptive names in tests

--- system-int-test/test/cmr/system_int_test/search/humanizer/humanizer_test.clj
+++ system-int-test/test/cmr/system_int_test/search/humanizer/humanizer_test.clj
@@ -160,8 +160,8 @@
           expected-report1 (str "provider,concept_id,short_name,version,original_value,"
                                 "humanized_value\n"
                                 "PROV1,C1-PROV1,Short,V5,Bioosphere,Biosphere\n")
-          report1 (search/get-humanizers-report)]
-      (is (= expected-report1 report1))
+          initial-report (search/get-humanizers-report)]
+      (is (= expected-report1 initial-report))

       (testing "Humanizer report can be force regenerated by an admin"
         (let [humanizers (conj (hu/make-humanizers)
@@ -190,16 +190,16 @@

               _ (index/wait-until-indexed)
               _ (search/refresh-collection-metadata-cache)
-              expected-report3 (str "provider,concept_id,short_name,version,original_value,"
+              expected-report2 (str "provider,concept_id,short_name,version,original_value,"
                                     "humanized_value\n"
                                     "PROV1,C1-PROV1,Short,V5,Bioosphere,Biosphere\n"
                                     "PROV1,C2-PROV1,NewSN,V5,Bioosphere,Biosphere\n"
                                     "PROV1,C2-PROV1,NewSN,V5,Term2,Best Term Ever\n")
-              report2 (search/get-humanizers-report)
-              report3 (search/get-humanizers-report {:regenerate true
-                                                     :token transmit-config/mock-echo-system-token})]
-          (is (= report1 report2))
-          (is (= expected-report3 report3)))))))
+              report-unchanged-by-recent-ingest (search/get-humanizers-report)
+              regenerated-report (search/get-humanizers-report
+                                  {:regenerate true :token transmit-config/mock-echo-system-token})]
+          (is (= initial-report report-unchanged-by-recent-ingest))
+          (is (= expected-report2 regenerated-report)))))))

 (deftest humanizer-report-permissions
   (testing "Anyone can request the humanizer report"


(PE-2650) tests for add-context-handler function

This commit adds tests for the add-context-handler function.
While at it, the structure of an existing test is changed
to be in line with all the other tests.

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
@@ -1,11 +1,11 @@
 (ns puppetlabs.trapperkeeper.services.webserver.jetty9-service-test
   (:import  (java.net ConnectException)
             (javax.net.ssl SSLPeerUnverifiedException)
+            (javax.servlet ServletContextListener)
             [servlet SimpleServlet])
   (:require [clojure.test :refer :all]
             [clj-http.client :as http-client]
             [puppetlabs.trapperkeeper.app :refer [get-service]]
-            [puppetlabs.trapperkeeper.core :refer [defservice]]
             [puppetlabs.trapperkeeper.services :refer [stop service-context]]
             [puppetlabs.trapperkeeper.services.webserver.jetty9-service
                :refer :all]
@@ -18,7 +18,8 @@

 (use-fixtures :once with-no-jvm-shutdown-hooks)

-(def test-resources-config-dir "./test-resources/config/jetty/")
+(def test-resources-dir        "./test-resources/")
+(def test-resources-config-dir (str test-resources-dir "config/jetty/"))

 (def default-keystore-pass     "Kq8lG9LkISky9cDIYysiadxRx")

@@ -60,15 +61,52 @@
          (finally
            (shutdown))))))

-(defservice hello-test-service
-  [[:WebserverService add-war-handler]]
-  (init [this context]
-        (add-war-handler "test-resources/helloWorld.war" "/test")
-        context)
-  (stop [this context]
-        context))
-
 (deftest jetty-jetty9-service
+  (testing "static content context"
+    (let [app                 (bootstrap-services-with-cli-data [jetty9-service]
+                                {:config
+                                  (str
+                                    test-resources-config-dir
+                                    "jetty-plaintext-http.ini")})
+          s                   (get-service app :WebserverService)
+          add-context-handler (partial add-context-handler s)
+          shutdown            (partial stop s (service-context s))
+          path                "/resources"
+          resource            "logback.xml"]
+      (try
+        (add-context-handler test-resources-dir path)
+        (let [response (http-client/get (str "http://localhost:8080" path "/" resource))]
+          (is (= (:status response) 200))
+          (is (= (:body response) (slurp (str test-resources-dir resource)))))
+        (finally
+          (shutdown)))))
+
+  (testing "customization of static content context"
+    (let [app                 (bootstrap-services-with-cli-data [jetty9-service]
+                                {:config
+                                  (str
+                                    test-resources-config-dir
+                                    "jetty-plaintext-http.ini")})
+          s                   (get-service app :WebserverService)
+          add-context-handler (partial add-context-handler s)
+          shutdown            (partial stop s (service-context s))
+          path                "/resources"
+          body                "Hey there"
+          servlet-path        "/hey"
+          servlet             (SimpleServlet. body)]
+      (try
+        (add-context-handler test-resources-dir path
+                             [(reify ServletContextListener
+                                (contextInitialized [this event]
+                                  (doto (.addServlet (.getServletContext event) "simple" servlet)
+                                    (.addMapping (into-array [servlet-path]))))
+                                (contextDestroyed [this event]))])
+        (let [response (http-client/get (str "http://localhost:8080" path servlet-path))]
+          (is (= (:status response) 200))
+          (is (= (:body response) body)))
+        (finally
+          (shutdown)))))
+
   (testing "ring request over http succeeds")
     (bootstrap-and-validate-ring-handler
       "http://localhost:8080"
@@ -148,18 +186,24 @@
           (shutdown)))))

   (testing "WAR support"
-    (let [app (bootstrap-services-with-cli-data [jetty9-service hello-test-service]
-                {:config
-                  (str
-                    test-resources-config-dir
-                    "jetty-plaintext-http.ini")})]
-      (try
-        (let [response (http-client/get "http://localhost:8080/test/hello")]
+    (let [app             (bootstrap-services-with-cli-data [jetty9-service]
+                            {:config
+                              (str
+                                test-resources-config-dir
+                                "jetty-plaintext-http.ini")})
+          s               (get-service app :WebserverService)
+          add-war-handler (partial add-war-handler s)
+          shutdown        (partial stop s (service-context s))
+          path            "/test"
+          war             "helloWorld.war"]
+      (try
+        (add-war-handler (str test-resources-dir war) path)
+        (let [response (http-client/get (str "http://localhost:8080" path "/hello"))]
           (is (= (:status response) 200))
           (is (= (:body response)
                  "\n<title>Hello World Servlet</title>\nHello World!!\n\n")))
         (finally
-          (app/stop app)))))
+          (shutdown)))))

   (testing "webserver bootstrap throws IllegalArgumentException when neither
             port nor ssl-port specified in the config"
@@ -297,4 +341,4 @@
       "https://localhost:8081"
       "jetty-ssl-pem-client-auth-none.ini"
       (assoc default-options-for-https
-        :keystore nil))))+        :keystore nil))))


clean up old code as comments

clean up old code as comments

--- src-cljs/frontend/components/build_config.cljs
+++ src-cljs/frontend/components/build_config.cljs
@@ -147,74 +147,4 @@
             [:ol
              (for [error errors]
                (om/build config-error {:error error
-                                       :config-string config-string}))]
-
-            ;; [:div.build-tests-list-container
-            ;;  [:ol.list-unstyled.build-tests-list
-            ;;   (let [file-failures (->> (group-by :file failures)
-            ;;                            (map (fn [[k v]] [k (sort-by test-model/format-test-name v)]))
-            ;;                            (into (sorted-map)))
-            ;;         [top-map bottom-map] (utils/split-map-values-at file-failures initial-test-render-count)]
-            ;;     (list
-            ;;      (om/build-all build-tests-file-block top-map)
-            ;;      (when-not (empty? bottom-map)
-            ;;        (list
-            ;;         [:hr]
-            ;;         [:li
-            ;;          [:a.build-tests-toggle {:on-click #(om/update-state! owner [:is-open?] not)}
-            ;;           [:span
-            ;;            [:i.fa.build-tests-toggle-icon {:class (if (om/get-state owner :is-open?) "expanded")}]
-            ;;            (if (om/get-state owner :is-open?)
-            ;;              "Less"
-            ;;              "More")]]]
-            ;;         (when (om/get-state owner :is-open?)
-            ;;           (om/build-all build-tests-file-block bottom-map))))))]]
-            ]
-           ]
-
-
-
-          ;; [:div
-          ;;  "Dang! We spotted something wrong with your "
-          ;;  [:span.circle-yml-highlight
-          ;;   "circle.yml"]
-          ;;  ". "
-          ;;  "These may be causing your builds to fail. "
-          ;;  "We recommend that you fix them as soon as possible. "
-          ;;  "You may want to look at our docs or contact us if you’re having trouble."
-          ;;  ;; "Your build ran "
-          ;;  ;; [:strong (count tests)]
-          ;;  ;; " tests in " (string/join ", " (map test-model/pretty-source (keys source-hash))) " with "
-          ;;  ;; [:strong "0 failures"]
-          ;;  ;; (when slowest
-          ;;  ;;   [:div.build-tests-summary
-          ;;  ;;    [:p
-          ;;  ;;     [:strong "Slowest test:"]
-          ;;  ;;     (gstring/format
-          ;;  ;;      " %s %s (took %.2f seconds)."
-          ;;  ;;      (:classname slowest)
-          ;;  ;;      (:name slowest)
-          ;;  ;;      (:run_time slowest))]])
-          ;;  ]
-
-
-          ;; [:header
-          ;;  [:div.head-left
-          ;;   (if (:lethal config)
-          ;;     (common/icon {:name "fail" :type "status"})
-          ;;     [:i.error.fa.fa-exclamation-triangle])]
-          ;;  [:div.head-right
-          ;;   [:h2 "Dang."]
-          ;;   [:p
-          ;;    "We spotted some issues with your " [:code "circle.yml"] "."
-
-          ;;    (when-not (:lethal config)
-          ;;      (if (:failed build)
-          ;;        " These may be causing your build to fail! We recommend that you fix them as soon as possible."
-          ;;        " These may lead to unexpected behavior and may cause your build to fail soon. We recommend that you fix them as soon as possible."))]
-          ;;   [:p
-          ;;    "You may want to look at "
-          ;;    [:a {:href "/docs/configuration"} "our docs"]
-          ;;    " or " (common/contact-us-inner owner) " if you're having trouble."]]]
-          ;; (om/build diagnostics config)
-          ])))))
+                                       :config-string config-string}))]]]])))))


RS & GG | 99 | Remove weird unicode character on the end of user-list controller namespace declaration

--- src-cljs/stonecutter/controller/user_list.cljs
+++ src-cljs/stonecutter/controller/user_list.cljs
@@ -1,5 +1,4 @@
-(ns stonecutter.controller.user-list
-
+(ns stonecutter.controller.user-list
   (:require [ajax.core :refer [POST]]
             [dommy.core :as d])
   (:require-macros [dommy.core :as dm]))


Docstring editing

Docstring editing

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -1,7 +1,11 @@
 (ns clojurewerkz.cassaforte.client
-  "Base namespace for connecting to Cassandra clusters, configuring your cluster connection, tuning
-   things like Load Balancing, Retries, consistency and reconnection, rendering queries generated
-   using the DSL, preparing them, working with asyncronous results."
+  "Provides fundamental functions for
+
+   * connecting to Cassandra nodes and clusters
+   * configuring connections
+   * tuning load balancing, retries, reconnection strategies and consistency settings
+   * preparing and executing queries constructed via DSL
+   * working with executing results"
   (:require [clojurewerkz.cassaforte.debug-utils :as debug-utils]
             [clojurewerkz.cassaforte.conversion :as conv]
             [qbits.hayt.cql :as cql]


cassandra: add schema-helper fns create-table and drop-table

--- src/er_cassandra/migrations/schema_helpers.clj
+++ src/er_cassandra/migrations/schema_helpers.clj
@@ -18,11 +18,47 @@
   [{v-name :name}]
   (string/join " " ["drop materialized view if exists" (name v-name)]))

+(defn drop-table
+  [{v-name :name}]
+  (string/join " " ["drop table if exists" (name v-name)]))
+
 (def leveled-compaction-clause
   "compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy', 'tombstone_compaction_interval': '86400'}")

 (def size-tiered-compaction-clause
   "compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'}")
+
+(defn create-table
+  [{v-name :name
+    v-primary-key :primary-key
+    v-columns :columns
+    v-compaction :compaction
+    :as table-definition}]
+  (assert (every? some? [v-name v-primary-key v-columns])
+          (str "invalid table definition"
+               "\n\n"
+               (pr-str table-definition)))
+  (assert (every? #(contains? (set (map first v-columns)) %) (flatten v-primary-key))
+          (str "not all primary key columns are defined!"
+               "\n\n"
+               (pr-str table-definition)))
+  (assert (or (nil? v-compaction) (#{:leveled :size-tiered} v-compaction)))
+  (let [v-name (name v-name)
+        v-columns (map (fn [[n t]] (str n " " t)) v-columns)
+        primary-key-str (str "primary key " (index-str v-primary-key))]
+    (string/join
+     " "
+     ["create table if not exists" v-name "("
+      (string/join
+       ", "
+       (conj
+        v-columns
+        primary-key-str))
+      ")"
+      (case v-compaction
+        nil nil
+        :leveled (str "WITH " leveled-compaction-clause)
+        :size-tiered (str "WITH " size-tiered-compaction-clause))])))

 (defn create-view
   [{v-name :name


Adjustment of the calcul of the heuristic dictionary.

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -5,7 +5,7 @@
             [clojure.math.combinatorics :as combo])
   (:gen-class))

-(def width-heuristic-calculation 6)
+(def width-heuristic-calculation 5)

 (defn gen-heuristic-dictionary
   "Generate the dictionnary of heuristics values"
@@ -18,12 +18,13 @@
 (defn calc-positive-heuristic
   ""
   [list-to-check player opponent]
+  (let [list-to-check (conj list-to-check :empty)]
   (if (and (= (.indexOf (rest list-to-check) opponent) -1) (= (.indexOf (rest list-to-check) :wall) -1))
     (let [count-in-list (reduce #(+ %1 (if (= %2 player) 1 0)) 0 list-to-check)]
       (if (< count-in-list 4)
         count-in-list
         1000))
-    0))
+    0)))

 (defn calc-heuristic
   ""


Add adding new vertices.

Add adding new vertices.

--- src/constraint/edit.cljs
+++ src/constraint/edit.cljs
@@ -2,7 +2,6 @@
   (:require [constraint.common :refer [edge-id
                                        vert-id]]))

-(def edge-id-len (count edge-id))
 (def vertex-regex (re-pattern (str vert-id ".*")))
 (def edge-regex (re-pattern (str edge-id ".*")))

@@ -24,24 +23,31 @@

-(defn get-key [edge-str]
+(defn get-key [len edge-str]
   (->> edge-str
-       (drop edge-id-len)
+       (drop len)
        (apply str)
        (js/parseInt)))

-(defn largest-key [{:keys [edges]}]
-  (-> (map get-key (keys edges))
-      (sort)
-      (reverse)
-      (first)))
+(defn largest-key [id coll]
+  (let [get-number-part (partial get-key (count id))]
+    (-> (map get-number-part (keys coll))
+        (sort)
+        (reverse)
+        (first))))

-(defn next-key [key-num]
-  (str edge-id (inc key-num)))
+(defn inc-key [id key-num]
+  (str id (inc key-num)))
+
+
+
+(defn next-key [id coll]
+  (inc-key id (largest-key id coll)))
+

@@ -53,9 +59,9 @@

-(defn make-new-edge [from to world-state]
-  (let [next-to-largest-key (next-key (largest-key world-state))]
-    [next-to-largest-key [from to :red]]))
+(defn make-new-edge [from to {:keys [edges]}]
+  (let [new-key (next-key edge-id edges)]
+    [new-key [from to :red]]))

@@ -105,13 +111,26 @@

-(defn handle-unslected [clicked-what world-state]
+(defn make-new-vertex [where {:keys [vertices]}]
+  (let [new-key (next-key vert-id vertices)]
+    [new-key [1 where]]))
+
+
+
+(defn add-vertex [event world-state]
+  (let [where (where-svg-was-clicked event)
+        new-vertex (make-new-vertex where world-state)]
+    (update-in world-state [:vertices] #(conj % new-vertex))))
+
+
+
+(defn handle-unslected [clicked-what event world-state]
   (let [clicked-edge? (re-matches edge-regex clicked-what)
         clicked-vertex? (re-matches vertex-regex clicked-what)]
     (cond
         clicked-edge? (toggle-edge-value world-state clicked-what)
         clicked-vertex? (select-vertex world-state clicked-what)
-        :else world-state)))
+        :else (add-vertex event world-state))))

@@ -119,4 +138,4 @@
   (let [unselect #(merge % {:selected nil})]
     (if (:selected world-state)
       (unselect (handle-selected clicked-what event world-state))
-      (handle-unslected clicked-what world-state))))
+      (handle-unslected clicked-what event world-state))))


Get stacktraces for debugging. This probably needs an option to disable it before we start using it for real.

--- src/foreclojure/core.clj
+++ src/foreclojure/core.clj
@@ -7,7 +7,8 @@
         [foreclojure.users]
         [ring.adapter jetty]
         [somnium.congomongo]
-        [ring.middleware.reload :only [wrap-reload]])
+        (ring.middleware (reload :only [wrap-reload])
+                         (stacktrace :only [wrap-stacktrace])))
   (:require [compojure.route :as route]
             [compojure.handler :as handler]
             [sandbar.stateful-session :as session]
@@ -41,9 +42,11 @@
   (route/not-found "Page not found"))

 (def app
-  (handler/site
-   (session/wrap-stateful-session
-    (wrap-reload #'main-routes '(foreclojure.core)))))
+  (-> #'main-routes
+      (wrap-reload '(foreclojure.core))
+      (wrap-stacktrace)
+      (session/wrap-stateful-session)
+      (handler/site)))

 (defn run []
   (run-jetty (var app) {:join? false :ssl? true :port 8080 :ssl-port 8443


Show an input example in the place holder for :library_signature

Fixes #28

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -167,7 +167,7 @@
                          [:div.form-group
                           (form/label {:class "sr-only"} :library_signature "Signature")
                           (form/text-field
-                           {:class "form-control" :placeholder "Enter Signature"}
+                           {:class "form-control" :placeholder "dsxxxxx"}
                            :library_signature)
                           [:button.btn.btn-default
                            (layout/glyphicon "transfer")]])]])]])))


Remove emailer

Remove emailer

--- src/gin/system/email.clj
+++ src/gin/system/email.clj
@@ -1,25 +0,0 @@
-(ns gin.system.email
-  (:require [clojure.tools.logging :refer [info debug spy error]]
-            [com.stuartsierra.component :as component]))
-
-(def testing-last-sent-email (atom nil))
-
-(defprotocol Emailer
-  (send-email [this email content]))
-
-(defrecord LogEmailer []
-  component/Lifecycle
-  (start [component]
-    (info ";; Starting emailer")
-    component)
-
-  (stop [component]
-    (info ";; Stopping emailer")
-    component)
-  Emailer
-  (send-email [this email content]
-    (debug "Pretending to send email to: " email "with content:" content)
-    (reset! testing-last-sent-email {:email email :content content})))
-
-(defn log-emailer []
-  (map->LogEmailer {}))


Keep :rotation as a field in Page.

Keep :rotation as a field in Page.

--- src-cljs/pepa/data.cljs
+++ src-cljs/pepa/data.cljs
@@ -3,7 +3,7 @@
             [clojure.set :as set]
             [clojure.string :as s]))

-(defrecord Page [id])
+(defrecord Page [id rotation])
 (defrecord Document [id title pages tags created modified notes])

 (defrecord State [documents navigation upload])


hiding "update-meta!" and, and calling it via var (thx @DomKM)

--- src/mount/core.clj
+++ src/mount/core.clj
@@ -59,9 +59,7 @@
     (reset! inst value)
     (alter-var-root var (constantly value))))

-;; (!) TODO: this should be private (needs thinking)
-;;           it is public now, can be called by "defstate" on macro expansion
-(defn update-meta! [path v]
+(defn- update-meta! [path v]
   (swap! meta-state assoc-in path v))

 (defn- record! [state-name f done]
@@ -134,8 +132,8 @@
                    resume (assoc :resume `(fn [] ~resume)))]
       `(do
          (def ~state (DerefableState. ~state-name))
-         (update-meta! [~state-name] (assoc ~s-meta :inst (atom (NotStartedState. ~state-name))
-                                                    :var (var ~state)))
+         ((var update-meta!) [~state-name] (assoc ~s-meta :inst (atom (NotStartedState. ~state-name))
+                                                          :var (var ~state)))
          (var ~state)))))

 (defn in-cljc-mode []


switch prod domain to precursorapp.com

switch prod domain to precursorapp.com

--- src/pc/profile.clj
+++ src/pc/profile.clj
@@ -27,7 +27,7 @@
   (prod?))

 (defn prod-domain []
-  "prcrsr.com")
+  "precursorapp.com")

 (defn hostname []
   (if (prod?)


stray reference to options

stray reference to options

--- src/advtrack/system.clj
+++ src/advtrack/system.clj
@@ -19,7 +19,7 @@
          :defaults   site-defaults}})

 (defn new-system [options]
-  (let [config (meta-merge base-options options)]
+  (let [options (meta-merge base-options options)]
     (-> (component/system-map
          :app  (handler-component (:app options))
          :http (jetty-server (:http options))


avoid calling (unify) if either argument is :fail

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -75,7 +75,10 @@
                         (log/debug (str "generate-all vals: " (clojure.string/join "," (map #((:morph model) %) (vals paths-and-comps)))))
                         (let [result
                               (reduce (fn [a b]
-                                        (let [result (unify a b)]
+                                        (let [result
+                                              (cond (or (= :fail a)
+                                                        (= :fail b)) :fail
+                                                    true (unify a b))]
                                           (when (and (not (= :fail a)) (not (= :fail b)))
                                             (if (= :fail result)
                                               ;; warn because fails are expensive and should be filtered out before hitting this.


fix bug in (lexemes-before-phrases)

fix bug in (lexemes-before-phrases)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -278,8 +278,8 @@
   ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
   (if (> max-total-depth 0)
     (let [prob (- 1.0 (/ (- max-total-depth depth) max-total-depth))]
-      (> (* 10 prob) (rand-int 10))))
-  1)
+      (> (* 10 prob) (rand-int 10)))
+    false))

 (defn show-bolt [bolt path morph]
   (if (not (empty? path))


contrast between lightning-bolts and nugget: the latter is 4 times as slow

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -23,10 +23,10 @@
 (def ^:const deterministic false)

 ;; deterministic generation:
-;;(def ^:const shufflefn (fn [x] x))
+(def ^:const shufflefn (fn [x] x))

 ;; nondeterministic generation
-(def ^:const shufflefn shuffle)
+;;(def ^:const shufflefn shuffle)

 (def ^:const randomize-lexemes-before-phrases
   false)
@@ -68,24 +68,24 @@
            (lazy-seq [lb])}))
        (lightning-bolts model spec depth max-depth)))

-(declare nugent)
 (declare nugents)

 (defn comp-path-to-bolts
   "return a lazy sequence of bolts for all possible complements that can be added to the end of the _path_ within _bolt_."
   [bolt path model depth max-depth]
   (let [spec (get-in bolt path)
-        lexemes (lazy-seq (shufflefn (get-lexemes model spec)))
+        lexemes (shufflefn (get-lexemes model spec))
         bolts-at (if (< depth max-depth)
-                   (nugents
+                   ((if false nugents
+                        lightning-bolts)
                     model
                     (get-in bolt path)
                     depth max-depth))
         lexemes-before-phrases
         (lexemes-before-phrases depth max-depth)]
     (if lexemes-before-phrases
-      (lazy-seq (concat lexemes bolts-at))
-      (lazy-seq (concat bolts-at lexemes)))))
+      (lazy-seq (lazy-cat lexemes bolts-at))
+      (lazy-seq (lazy-cat bolts-at lexemes)))))

 (declare add-bolt-at)

@@ -100,23 +100,23 @@
      (rest paths)
      (rest val-at-paths))))

-(defn nugents [model spec & [max-depth take-n]]
+(defn nugents [model spec & [max-depth]]
+  (log/debug (str "nugents:" (strip-refs spec)))
   (let [max-depth (or max-depth babel.generate/max-total-depth)
         mapping1 (mapping spec model 0 max-depth)
-        take-n (or take-n 100)
         all-of-them
         (mapcat (fn [each-mapping]
                   (let [trellis (apply combo/cartesian-product (vals each-mapping))]
-                    (pmap (fn [each-path-through-trellis]
-                            (zipmap (keys each-mapping)
-                                    each-path-through-trellis))
-                          trellis)))
+                    (map (fn [each-path-through-trellis]
+                           (zipmap (keys each-mapping)
+                                   each-path-through-trellis))
+                         trellis)))
                 mapping1)]
     (map (fn [good-one]
            (do-assocs (get good-one [])
                       (keys good-one)
                       (vals good-one)))
-         (take take-n all-of-them))))
+         all-of-them)))

 (defn add-bolts-to-path [path bolts-at bolt top-bolt model depth max-depth truncate? take-n]
   (mapfn #(let [bolt (assoc-in bolt path %)]


raise (get-in parent [:head :phrasal]) higher to decrease amount of work done

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -101,33 +101,34 @@
           (when (= false (get-in spec [:head :phrasal] false))
             (lazy-mapcat
              (fn [parent]
-               (let [pred (get-in spec [:synsem :sem :pred])
-                     cat (get-in spec [:synsem :cat])
-                     pred-set (if (:pred2lex language-model) (get (:pred2lex language-model) pred))
-                     cat-set (if (:cat2lex language-model) (get (:cat2lex language-model) cat))
-                     non-empty-index-sets (filter #(not (empty? %))
-                                                  [cat-set pred-set])
-                     subset
-                     (cond
-                       (= true (get-in parent [:head :phrasal]))
-                       []
-
-                       (not (empty? non-empty-index-sets))
-                       (reduce intersection-with-identity non-empty-index-sets)
-
-                       true
-                       (do
-                         (log/warn (str "no index found for spec: " (strip-refs spec)))
-                         (get-lex parent :head (:index language-model))))]
-                 (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (:rule parent)))
-                 (let [result (over/overh parent (lazy-shuffle subset))]
-                   (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
-                   (if (and (not (empty? subset)) (empty? result))
-                     ;; log/warn because it's very expensive to run
-                     ;; over/overh: for every candidate, both parent
-                     ;; and candidate head must be copied.
-                     (log/warn (str "tried: " (count subset) " lexical candidates with spec:" ( strip-refs spec) " and all of them failed as heads of parent:" (:rule parent))))
-                   result)))
+               (when (= false (get-in parent [:head :phrasal] false))
+                 (let [pred (get-in spec [:synsem :sem :pred])
+                       cat (get-in spec [:synsem :cat])
+                       pred-set (if (:pred2lex language-model) (get (:pred2lex language-model) pred))
+                       cat-set (if (:cat2lex language-model) (get (:cat2lex language-model) cat))
+                       non-empty-index-sets (filter #(not (empty? %))
+                                                    [cat-set pred-set])
+                       subset
+                       (cond
+                         (= true (get-in parent [:head :phrasal]))
+                         []
+
+                         (not (empty? non-empty-index-sets))
+                         (reduce intersection-with-identity non-empty-index-sets)
+
+                         true
+                         (do
+                           (log/warn (str "no index found for spec: " (strip-refs spec)))
+                           (get-lex parent :head (:index language-model))))]
+                   (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (:rule parent)))
+                   (let [result (over/overh parent (lazy-shuffle subset))]
+                     (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
+                     (if (and (not (empty? subset)) (empty? result))
+                       ;; log/warn because it's very expensive to run
+                       ;; over/overh: for every candidate, both parent
+                       ;; and candidate head must be copied.
+                       (log/warn (str "tried: " (count subset) " lexical candidates with spec:" ( strip-refs spec) " and all of them failed as heads of parent:" (:rule parent))))
+                     result))))
              parents))
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (and (< total-depth max-total-depth)


italiano/generate: add variant with no required arguments

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -51,19 +51,27 @@
    (morph/analyze surface-form lexicon)))

 (defn generate
-  [spec & {:keys [model do-enrich max-total-depth truncate]
-           :or {do-enrich true
-                max-total-depth generate/max-total-depth
-                model (medium)
-                truncate true}}]
-  (log/debug (str "generating with spec: " (strip-refs spec) " with max-total-depth: " max-total-depth))
-  (let [result (generate/generate spec model
-                                  :do-enrich do-enrich
-                                  :max-total-depth max-total-depth
-                                  :truncate-children truncate)]
-    (if result
-      (conj {:surface (fo result)}
-            result))))
+  ([]
+   (let [max-total-depth generate/max-total-depth
+         truncate-children true
+         model (medium)]
+     (generate {:modified false}
+               :max-total-depth max-total-depth
+               :truncate-children true
+               :model model)))
+  ([spec & {:keys [model do-enrich max-total-depth truncate]
+            :or {do-enrich true
+                 max-total-depth generate/max-total-depth
+                 model (medium)
+                 truncate true}}]
+   (log/debug (str "generating with spec: " (strip-refs spec) " with max-total-depth: " max-total-depth))
+   (let [result (generate/generate spec model
+                                   :do-enrich do-enrich
+                                   :max-total-depth max-total-depth
+                                   :truncate-children truncate)]
+     (if result
+       (conj {:surface (fo result)}
+             result)))))

 (defn lightning-bolts [spec]
   (let [medium medium]


Updating flood benchmark to new project syntax.

--- src/benchmark/flood.clj
+++ src/benchmark/flood.clj
@@ -1,13 +1,15 @@
 (ns benchmark.flood
-  (:use [plasma util core connection peer viz]
+  (:use [plasma util url core connection peer viz]
         [clojure test stacktrace]
         test-utils)
   (:require [logjam.core :as log]
             [plasma.query :as q]))

+; Shows a two tier flood query where the path expression crosses two proxy nodes
+
 (defn- link-proxy
   [local remote]
-  (let [net (first (query local (q/path [:net])))
+  (let [net (:id (first (query local (q/path [:net]))))
         p-root (get-node remote ROOT-ID)
         p-id (:id p-root)
         p-port (:port remote)]
@@ -39,16 +41,16 @@
     (try
       (println "peers: " (query base (q/path [:net :peer])))
       (println "proxies: " (query base (-> (q/path [p [:net :peer]])
-                                (q/project 'p :proxy))))
+                                (q/project [p :proxy]))))
       (println "peer values: " (query base (-> (q/path [p [:net :peer]
                                            d [p :data]])
-                                (q/project 'd :value))))
-      (println "tier two: "
-        (sort (map :value
-             (query base
-                    (->
+                                (q/project [d :value]))))
+      (println "tier two: "
+        (sort (map :value
+             (query base
+                    (->
                       (q/path [d [:net :peer :net :peer :data]])
-                      (q/project 'd :value))))))
+                      (q/project [d :value]))))))
       (finally
         (close-peers peers)))))


upparse rpc help

upparse rpc help

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -245,7 +245,6 @@
 (def-rpc settxfee amount)
 (def-rpc signmessage address message)

-
 ;;--------------------------------

@@ -279,9 +278,16 @@
   (insta/parser
     "BTC = (<'=='> SPACE TITLE SPACE <'=='> NEW-LINE FUNCTIONS)*
      FUNCTIONS = (FUNCTION NEW-LINE)*
-     FUNCTION = SYMBOL SPACE ARGS
+     FUNCTION = SYMBOL | (SYMBOL SPACE ARGS)
      ARGS = ((ARG SPACE)* ARG)*
-     ARG = (<'\"'> SYMBOL <'\"'>) | SYMBOL | (<'('> OPTIONAL-SPACE SYMBOL OPTIONAL-SPACE <')'>)
+     <ARG> = MAP-ARG | LIST-ARG | STRING-SYMBOL | SYMBOL | OPTIONAL-ARG
+     OPTIONAL-ARG = (<'('> OPTIONAL-SPACE ARG OPTIONAL-SPACE <')'>)
+     LIST-ARG = <'['> ARGS <',...'> <']'>
+     MAP-ARG = (<'{'>) ((KEY-VALUE <','>)* KEY-VALUE) (<'}'>)
+     KEY-VALUE = ARG <':'> ARG
+     OPEN-KEY-VALUE = (KEY-VALUE <',...'>)
+     STRING-SYMBOL = ('\"' SYMBOL '\"')
+
      <TITLE> = SYMBOL
      NEW-LINE = '\n' | Epsilon
      SYMBOL = #'[a-zA-Z_]'  #'\\w'*
@@ -289,8 +295,43 @@
      <OPTIONAL-SPACE> = <#'[ \t\n]*'>
 "))

-
-
+(defn opt-arg-index-of [[i a]]
+  (if (and (vector? a) (= (first a) :OPTIONAL-ARG))
+    i
+    nil))
+
+(defn arg-index-of [args]
+  (reduce
+    (fn [acc v]
+      (if acc acc (opt-arg-index-of v))) nil args))
+
+(defn function ([name arg-list]
+  (let [args (map-indexed (fn [i a] [i a]) arg-list)
+        arg-ix (arg-index-of args)
+        arg-names (map (comp #(if (vector? %) (second %) %) second) args)]
+    (if arg-ix
+      `(def-rpc-opt ~name ~arg-ix ~@arg-names)
+      `(def-rpc ~name ~@arg-names))))
+  ([name] (function name [])))
+
+
+(def ast->clj-map
+  {
+   :FUNCTION function
+   :SYMBOL (comp symbol str)
+   :STRING-SYMBOL (fn [_ a _] a)
+   :ARGS (fn [& args] args)
+   })
+
+(defn ast->clj [ast]
+  (insta/transform
+    ast->clj-map
+    ast))
+
+(defn def-rpcs []
+  (map #(ast->clj (help-parser % :start :FUNCTION)) (split-help)))
+
+;;--------------------------------------------------------

 (defn repl-init []
   (sock-repl/repl-init)


Remove accidentally copied-over code

Remove accidentally copied-over code

--- src/braid/core/api.cljc
+++ src/braid/core/api.cljc
@@ -239,18 +239,3 @@
        [route]
        {:pre [(braid.core.server.routes.api.modules/valid-route? route)]}
        (swap! braid.core.server.routes.api.modules/module-private-http-routes conj route))))
-
-(defn init! []
-  #?(:cljs
-     (do
-       (register-autocomplete-engine!
-         braid.core.client.ui.views.autocomplete/bot-autocomplete-engine)
-
-       (register-autocomplete-engine!
-         braid.core.client.ui.views.autocomplete/user-autocomplete-engine)
-
-       (register-autocomplete-engine!
-         braid.core.client.ui.views.autocomplete/tag-autocomplete-engine)
-
-       (register-state! braid.core.client.store/initial-state
-                        braid.core.client.store/AppState))))


implement IReduce on more ISeq types

implement IReduce on more ISeq types

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -732,7 +732,7 @@
   (-reduce [col f] (array-reduce col f))
   (-reduce [col f start] (array-reduce col f start)))

-(declare with-meta)
+(declare with-meta seq-reduce)

 (deftype RSeq [ci i meta]
   Object
@@ -771,7 +771,11 @@
   (-empty [coll] (with-meta cljs.core.List/EMPTY meta))

   IHash
-  (-hash [coll] (hash-coll coll)))
+  (-hash [coll] (hash-coll coll))
+
+  IReduce
+  (-reduce [col f] (seq-reduce f col))
+  (-reduce [col f start] (seq-reduce f start col)))

 (defn second
   "Same as (first (next x))"
@@ -1891,8 +1895,8 @@
   (-count [coll] count)

   IReduce
-  (-reduce [col f] (seq-reduce f col))
-  (-reduce [col f start] (seq-reduce f start col)))
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (deftype EmptyList [meta]
   Object
@@ -1935,7 +1939,11 @@
   (-seq [coll] nil)

   ICounted
-  (-count [coll] 0))
+  (-count [coll] 0)
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (set! cljs.core.List/EMPTY (EmptyList. nil))

@@ -2002,7 +2010,11 @@
   (-hash [coll] (caching-hash coll hash-coll __hash))

   ISeqable
-  (-seq [coll] coll))
+  (-seq [coll] coll)
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn cons
   "Returns a new seq where x is the first element and seq is the rest."
@@ -2092,7 +2104,11 @@

   ISeqable
   (-seq [coll]
-    (seq (lazy-seq-value coll))))
+    (seq (lazy-seq-value coll)))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (declare ArrayChunk)

@@ -4045,7 +4061,11 @@
   INext
   (-next [coll]
     (when (< i (- (alength arr) 2))
-      (PersistentArrayMapSeq. arr (+ i 2) _meta))))
+      (PersistentArrayMapSeq. arr (+ i 2) _meta)))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn persistent-array-map-seq [arr i _meta]
   (when (<= i (- (alength arr) 2))
@@ -4785,7 +4805,11 @@
   (-equiv [coll other] (equiv-sequential coll other))

   IHash
-  (-hash [coll] (caching-hash coll hash-coll __hash)))
+  (-hash [coll] (caching-hash coll hash-coll __hash))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn- create-inode-seq
   ([nodes]
@@ -4839,7 +4863,11 @@
   (-equiv [coll other] (equiv-sequential coll other))

   IHash
-  (-hash [coll] (caching-hash coll hash-coll __hash)))
+  (-hash [coll] (caching-hash coll hash-coll __hash))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn- create-array-node-seq
   ([nodes] (create-array-node-seq nil nodes 0 nil))
@@ -5122,7 +5150,11 @@

   IWithMeta
   (-with-meta [coll meta]
-    (PersistentTreeMapSeq. meta stack ascending? cnt __hash)))
+    (PersistentTreeMapSeq. meta stack ascending? cnt __hash))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn- create-tree-map-seq [tree ascending? cnt]
   (PersistentTreeMapSeq. nil (tree-map-seq-push tree nil ascending?) ascending? cnt nil))
@@ -5798,7 +5830,11 @@
                  (-next mseq)
                  (next mseq))]
       (when-not (nil? nseq)
-        (KeySeq. nseq _meta)))))
+        (KeySeq. nseq _meta))))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn keys
   "Returns a sequence of the map's keys."
@@ -5858,7 +5894,11 @@
                  (-next mseq)
                  (next mseq))]
       (when-not (nil? nseq)
-        (ValSeq. nseq _meta)))))
+        (ValSeq. nseq _meta))))
+
+  IReduce
+  (-reduce [coll f] (seq-reduce f coll))
+  (-reduce [coll f start] (seq-reduce f start coll)))

 (defn vals
   "Returns a sequence of the map's values."


reduce based on IReduce

reduce based on IReduce

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -181,7 +181,12 @@
   (-meta [_] nil)

   IWithMeta
-  (-with-meta [_ meta] nil))
+  (-with-meta [_ meta] nil)
+
+  IReduce
+  (-reduce
+    ([_ f] (f))
+    ([_ f start] start)))

 (extend-type goog.global.Date
   IEquiv
@@ -201,6 +206,27 @@

 (defn- lt- [x y]
   (js* "(~{x} < ~{y})"))
+
+(defn- ci-reduce
+  "Accepts any collection which satisfies the ICount and IIndexed protocols and
+reduces them without incurring seq initialization"
+  ([cicoll f]
+     (if (= 0 (-count cicoll))
+       (f)
+       (loop [val (-nth cicoll 0), n 1]
+         (if (lt- n (-count cicoll))
+           (recur (f val (-nth cicoll n)) (inc n))
+           val))))
+  ([cicoll f val]
+     (loop [val val, n 0]
+         (if (lt- n (-count cicoll))
+           (recur (f val (-nth cicoll n)) (inc n))
+           val)))
+  ([cicoll f val idx]
+     (loop [val val, n idx]
+         (if (lt- n (-count cicoll))
+           (recur (f val (-nth cicoll n)) (inc n))
+           val))))

 (deftype IndexedSeq [a i]
   ISeqable
@@ -212,7 +238,13 @@

   ISequential
   IEquiv
-  (-equiv [coll other] (equiv-sequential coll other)))
+  (-equiv [coll other] (equiv-sequential coll other))
+
+  IReduce
+  (-reduce [_ f]
+    (ci-reduce a f (aget a i) (inc i)))
+  (-reduce [_ f start]
+    (ci-reduce a f start i)))

 (defn prim-seq [prim i]
   (when-not (= 0 (-count prim))
@@ -220,15 +252,6 @@

 (defn array-seq [array i]
   (prim-seq array i))
-
-(defn- ci-reduce
-  "Accepts any collection which satisfies the ICount and IIndexed protocols and
-reduces them without incurring seq initialization"
-  ([cicoll f val n]
-     (loop [val val, n n]
-         (if (lt- n (-count cicoll))
-           (recur (f val (-nth cicoll n)) (inc n))
-           val))))

 (extend-type array
   ISeqable
@@ -255,9 +278,9 @@
   IReduce
   (-reduce
     ([array f]
-       (ci-reduce array f (aget array 0) 1))
+       (ci-reduce array f))
     ([array f start]
-       (ci-reduce array f start 0)))
+       (ci-reduce array f start)))
   )

 (defn seq
@@ -516,7 +539,7 @@
   [coll]
   (next (next coll)))

-#_(defn reduce
+(defn reduce
   "f should be a function of 2 arguments. If val is not supplied,
   returns the result of applying f to the first 2 items in coll, then
   applying f to that result and the 3rd item, etc. If coll contains no
@@ -527,15 +550,12 @@
   applying f to that result and the 2nd item, etc. If coll contains no
   items, returns val and f is not called."
   ([f coll]
-     (if-let [s (seq coll)]
-       (reduce f (first s) (next s))
-       (f)))
+     (-reduce coll f))
   ([f val coll]
-     (let [s (seq coll)]
-       (-reduce s f val))))
-
-; simple reduce, to be removed when IReduce is working
-(defn reduce
+     (-reduce coll f val)))
+
+; simple reduce based on seqs, used as default
+(defn- seq-reduce
   ([f coll]
     (if-let [s (seq coll)]
       (reduce f (first s) (next s))
@@ -545,6 +565,14 @@
       (if coll
         (recur (f val (first coll)) (next coll))
         val))))
+
+(extend-type default
+  IReduce
+  (-reduce
+    ([coll f]
+       (seq-reduce f coll))
+    ([coll f start]
+       (seq-reduce f start coll))))

 ;;; Math - variadic forms will not work until the following implemented:
 ;;; first, next, reduce
@@ -908,9 +936,9 @@
   IReduce
   (-reduce
     ([string f]
-       (ci-reduce string f (-nth string 0) 1))
+       (ci-reduce string f))
     ([string f start]
-       (ci-reduce string f start 0))))
+       (ci-reduce string f start))))

 ; could use reify
 ;;; LazySeq ;;;
@@ -1503,6 +1531,11 @@
   IVector
   (-assoc-n [coll n val] (-assoc coll n val))

+  IReduce
+  (-reduce [v f]
+    (ci-reduce array f))
+  (-reduce [v f start]
+    (ci-reduce array start))
   )

 (set! cljs.core.Vector/EMPTY (Vector. nil (array)))


Remove newline characters from @doc output

--- src/clojurebot/core.clj
+++ src/clojurebot/core.clj
@@ -40,6 +40,11 @@
   message containing a string the same as the command name."
   [name handler]
   (swap! commands assoc name handler))
+
+(defn replace-nl
+  "Replace occurences of \n from s with whitespace, so it doesn't trim the IRC output."
+  [s]
+  (clojure.string/replace s "\n " " "))

 (defn handle-message [chan msg]
   (let [[cmd msg] (parse-message msg)
@@ -87,9 +92,10 @@
   (fn [sym-name]
     (if (not (empty? sym-name))
       (->> (symbol sym-name)
-           (resolve)
+           (resolve)
            (meta)
-           (:doc))
+           (#(format "::: %s ::: \"%s\" " (:arglists %1) (:doc %1)))
+           (replace-nl))
       "ERROR: No arguments provided")))

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


minor: remove unused logs

minor: remove unused logs

--- jar-async/src/slipstream/async/collector.clj
+++ jar-async/src/slipstream/async/collector.clj
@@ -227,9 +227,7 @@
   [users connectors chan time-to-spread context]
   (show-current-channel-usage context users)
   (if (every? (comp pos? count) [connectors users])
-    (let [_     (log-initial-workspace (count users) (count connectors))
-          ucs   (for [u users c connectors] [u c])
-          _     (log-final-workspace (count ucs))
+    (let [ucs   (for [u users c connectors] [u c])
           ucts  (add-increasing-space ucs (int (/ time-to-spread (count ucs))))
           _     (log-spread (count ucts) time-to-spread)]
       (doseq [[u c t] ucts]


Revert filtering of UC pairs

Revert filtering of UC pairs

After a while, the filtering of UC pairs (keep only those for which
connector is set) hangs the online users loop.

--- jar-async/src/slipstream/async/collector.clj
+++ jar-async/src/slipstream/async/collector.clj
@@ -190,9 +190,11 @@
   (log/log-debug context ": no users to collect."))

 (defn show-current-channel-usage
-  [context]
+  [context users]
   (let [[current total ratio] (current-working-usage)]
-    (log/log-info "indirect channel usage before inserting collect requests for " context ": " current " / " total " => " ratio " %")))
+    (log/log-info (str "Channel usage before inserting collect requests for "
+                       context ": " current " / " total " => " ratio " %, "
+                       "(" (count users) " users)"))))

 (defn log-initial-workspace
   [nu nc]
@@ -223,18 +225,18 @@

 (defn insert-collection-requests
   [users connectors chan time-to-spread context]
-  (show-current-channel-usage context)
+  (show-current-channel-usage context users)
   (if (every? (comp pos? count) [connectors users])
-    (let [_ (log-initial-workspace (count users) (count connectors))
-          ucs (compose-uc-pairs users connectors)
-          _ (log-final-workspace (count ucs))
-          ucts (add-increasing-space ucs (int (/ time-to-spread (count ucs))))
-          _ (log-spread (count ucts) time-to-spread)]
+    (let [_     (log-initial-workspace (count users) (count connectors))
+          ucs   (for [u users c connectors] [u c])
+          _     (log-final-workspace (count ucs))
+          ucts  (add-increasing-space ucs (int (/ time-to-spread (count ucs))))
+          _     (log-spread (count ucts) time-to-spread)]
       (doseq [[u c t] ucts]
         (cond
-          (full?) (warn-channel-full context u c)
+          (full?)     (warn-channel-full context u c)
           (busy? u c) (inform-avoiding context u c)
-          :else (insert-collection-request-cond-spaced chan u c t context)))
+          :else       (insert-collection-request-cond-spaced chan u c t context)))
       (inform-nothing-to-do context))))

 ; Start collector writers


[#2925] Add try catch on data-group aggregation && Refactor

--- backend/src/akvo/lumen/lib/aggregation.clj
+++ backend/src/akvo/lumen/lib/aggregation.clj
@@ -29,24 +29,22 @@
                     "query" query}))

 (defn query [tenant-conn dataset-id visualisation-type query]
-  (if (and (-> (env/all tenant-conn) (get "data-groups"))
-           (= visualisation-type "bar"))
-    (jdbc/with-db-transaction [tenant-tx-conn tenant-conn]
-      (let [data-groups (db.dataset/data-groups-by-dataset-id tenant-conn {:dataset-id dataset-id})
-           data-groups (map (fn [data-group]
-                              (update data-group :columns (comp walk/keywordize-keys vec)))
-                            data-groups)]
-       (bar/query-with-data-groups tenant-conn data-groups query)))
-    (jdbc/with-db-transaction [tenant-tx-conn tenant-conn {:read-only? true}]
-      (if-let [dataset (db.dataset/table-name-and-columns-by-dataset-id tenant-tx-conn {:id dataset-id})]
-        (try
+  (try
+    (if (and (-> (env/all tenant-conn) (get "data-groups"))
+             (= visualisation-type "bar"))
+      (jdbc/with-db-transaction [tenant-tx-conn tenant-conn]
+        (if-let [data-groups (seq (->> (db.dataset/data-groups-by-dataset-id tenant-conn {:dataset-id dataset-id})
+                                       (map #(update % :columns (comp walk/keywordize-keys vec)))))]
+          (bar/query-with-data-groups tenant-conn data-groups query)
+          (lib/not-found {"datasetId" dataset-id})))
+      (jdbc/with-db-transaction [tenant-tx-conn tenant-conn {:read-only? true}]
+        (if-let [dataset (db.dataset/table-name-and-columns-by-dataset-id tenant-tx-conn {:id dataset-id})]
           (query* tenant-tx-conn (update dataset :columns (comp walk/keywordize-keys vec)) visualisation-type query)
-          (catch clojure.lang.ExceptionInfo e
-            (log/warn e :query query :visualisation-type visualisation-type)
-            (lib/bad-request (merge {:message (.getMessage e)}
-                                    (ex-data e)))))
-        (lib/not-found {"datasetId" dataset-id})))))
-
+          (lib/not-found {"datasetId" dataset-id}))))
+    (catch clojure.lang.ExceptionInfo e
+      (log/warn e :query query :visualisation-type visualisation-type)
+      (lib/bad-request (merge {:message (.getMessage e)}
+                              (ex-data e))))))

 (def vis-aggregation-mapper {"pivot table" "pivot"
                             "line"      "line"


[#2127] Fix tests

[#2127] Fix tests

--- backend/test/akvo/lumen/endpoints_test.clj
+++ backend/test/akvo/lumen/endpoints_test.clj
@@ -186,12 +186,9 @@

             (let [meta-group-dataset (-> (h (get* (api-url "/datasets" dataset-id "group" "main")))
                                    body-kw)]
-              (is (= {:id dataset-id
-                      :name title
-                      :status "OK"
-                      :transformations []
+              (is (= {:status "OK"
                       :columns (map #(assoc % :groupName "main" :groupId "main") commons/dataset-link-columns)}
-                     (select-keys meta-group-dataset [:id :name :status :transformations :columns])))))
+                     (select-keys meta-group-dataset [:status :columns])))))

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


Update core.clj

Update core.clj

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -31,7 +31,7 @@
 (defn page [name]
   (str ""
        (if name
-  (str "Nice to meet you, " name "! \n" "

")
+  (str "Nice to meet you, " name "! \n" "

")
         (str "<form>"
               "Name: <input name='name' type='text'>"
               "<input type='submit'>"
@@ -41,7 +41,7 @@

 (defn handler [{{name "name"} {empfaenger "empfaenger"} :params}]
-  (-> (r/response (page name empfaenger))
+  (-> (r/response (page [name empfaenger]))
       (r/content-type "text/html")))

 (def app


Fix the resolution bound.

Fix the resolution bound.

engine/resolution requires an upper bound for request.

--- src/io/cyanite/query.clj
+++ src/io/cyanite/query.clj
@@ -36,7 +36,7 @@
         by-path (path-leaves index paths)
         leaves  (->> (mapcat val by-path)
                      (map :path)
-                     (map (partial engine/resolution engine from))
+                     (map (partial engine/resolution engine to))
                      (remove nil?)
                      (set))
         series  (store/query! store from to (seq leaves))


Define `evaluate` fn that can produce :value values for literals, and scalar/object variables.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -6,7 +6,7 @@
   (:require [mrc.utils :as utils]))

 (declare run-sequence resolve- nreturn
-         friendly-class friendly-symbol assign)
+         friendly-class friendly-symbol assign evaluate)

 (defmulti interpret (fn [& args] (:tag (first args))))

@@ -67,11 +67,27 @@

 (defmethod interpret :literal [node env]
   (interpret (utils/extract node [:c 0]) env))
+(defmulti evaluate (fn [node _] (:tag node)))

 (defmethod interpret :identifier [node _]
   (utils/extract node [:c 0]))
+(defmethod evaluate :literal [node env]
+  {:val (interpret (utils/extract node [:c 0]) env)})
+
+(defmethod evaluate :variable [node env]
+  (evaluate (utils/extract node [:c 0]) env))

 (defmethod interpret :assignee [node _]
+(defmethod evaluate :scalar [node env]
+  (let [ref (interpret (utils/extract node [:c 0]) env)]
+    {:ref ref :val (resolve- {:ref ref} env)}))
+
+(defmethod evaluate :object [node env]
+  (let [object-identifier (utils/extract node [:c 0 :c 0])
+        attribute-identifier (keyword (utils/extract node [:c 1 :c 0]))]
+    {:ref [object-identifier attribute-identifier] ;; not used now, but won't work if used
+     :val (get (resolve- {:ref object-identifier} env)
+               attribute-identifier)}))
   (utils/extract node [:c 0]))

 (defmethod interpret :integer [node _]


[#2156] Use `core/with-meta` to update clj-data-importer dev/test

--- backend/test/akvo/lumen/test_utils.clj
+++ backend/test/akvo/lumen/test_utils.clj
@@ -75,9 +75,9 @@
 (defn update-file
   "Update a file and return the dataset-id, or the job-execution-id in case of FAIL status"
   [tenant-conn error-tracker dataset-id data-source-id {:keys [data has-column-headers? kind]}]
-  (let [spec {"source" {"kind" kind
-                        "hasColumnHeaders" (boolean has-column-headers?)
-                        "data" data}}
+  (let [spec {"source" (with-meta {"kind" kind
+                                   "hasColumnHeaders" (boolean has-column-headers?)}
+                         {:data data})}
         [tag {:strs [updateId] :as res}] (update/update-dataset tenant-conn {} error-tracker dataset-id data-source-id spec)]
     (t/is (= tag :akvo.lumen.lib/ok))
     (dh/with-retry {:retry-if (fn [v e] (not v))


Add TODO reminder to rename

Add TODO reminder to rename

--- modules/bidi/src/modular/bidi.clj
+++ modules/bidi/src/modular/bidi.clj
@@ -54,6 +54,7 @@
   (fn [req]
     (h (assoc req ::routes routes))))

+;; TODO Rename to Router
 (defrecord BidiRingHandlerProvider []
   component/Lifecycle
   (start [this]


fundamental.clj: started work on fundamental group construction

--- clojure/org/gavrog/clojure/fundamental.clj
+++ clojure/org/gavrog/clojure/fundamental.clj
@@ -52,3 +52,28 @@
                  (glue-boundary ds boundary D i)
                  (conj result [D i]))
           (recur todo boundary result))))))
+
+(defn- glue-generator [ds [on-bnd opposite] edge2word gen2edge D i]
+  )
+
+(defn- find-generators [ds]
+  (let [boundary (reduce (fn [bnd [D i]] (glue-boundary ds bnd D i))
+                         (initial-boundary ds)
+                         (inner-edges ds))]
+    (loop [[on-bnd _ :as boundary] boundary
+           edge2word {}
+           gen2edge []
+           todo (for [D (elements ds), i (indices ds)] [D i])]
+      (cond
+        (empty? todo)
+        [edge2word gen2edge]
+        (not (on-bnd (first todo)))
+        (recur boundary edge2word gen2edge (rest todo))
+        :else
+        (let [[D i] (first todo)
+              [bnd e2w g2w] (glue-generator ds boundary edge2word gen2edge D i)]
+          (recur bnd e2w g2w (rest todo)))))))
+
+(defn fundamental-group [ds]
+  (let [[edge2word, gen2edge] (find-generators ds)]
+    ))


Remove unnecessary wrap-head middleware

Remove unnecessary wrap-head middleware

--- src/compojure/route.clj
+++ src/compojure/route.clj
@@ -19,8 +19,7 @@
   (-> (GET (add-wildcard path) {{file-path :*} :route-params}
         (let [options (merge {:root "public"} options)]
           (file-response file-path options)))
-      (wrap-content-type options)
-      (wrap-head)))
+      (wrap-content-type options)))

 (defn resources
   "A route for serving resources on the classpath. Accepts the following
@@ -30,8 +29,7 @@
   (-> (GET (add-wildcard path) {{resource-path :*} :route-params}
         (let [root (:root options "public")]
           (resource-response (str root "/" resource-path))))
-      (wrap-content-type options)
-      (wrap-head)))
+      (wrap-content-type options)))

 (defn not-found
   "A route that returns a 404 not found response, with its argument as the


Fix namespace error.

Fix namespace error.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -310,7 +310,7 @@
   ([entry] (post-block entry (:url entry)))
   ([entry entry-url]
   (let [publisher (:publisher entry)
-        avatar-url (user-avatar/fix-avatar-url c/filestack-api-key (:avatar-url publisher))
+        avatar-url (user-avatar/fix-avatar-url config/filestack-api-key (:avatar-url publisher))
         headline (post-headline entry)
         vid (:video-id entry)
         cleaned-body (text/truncated-body (:body entry))


use optional-keys with properties

use optional-keys with properties

--- src/ctia/properties.clj
+++ src/ctia/properties.clj
@@ -8,7 +8,8 @@
             [clojure.string :as str]
             [ctia.lib.map :as map]
             [schema.coerce :as c]
-            [schema.core :as s])
+            [schema.core :as s]
+            [schema-tools.core :as st])
   (:import java.util.Properties))

 (def files
@@ -26,31 +27,35 @@
    properties must be present.  Only the following properties may be
    set.  This is also used for selecting system properties to merge
    with the properties file."
-  {(s/required-key "ctia.auth.type") s/Keyword
-   (s/optional-key "ctia.auth.threatgrid.cache") s/Bool
-   (s/optional-key "ctia.auth.threatgrid.whoami-url") s/Str
-   (s/required-key "ctia.http.port") s/Int
-   (s/required-key "ctia.http.min-threads") s/Int
-   (s/required-key "ctia.http.max-threads") s/Int
-   (s/optional-key "ctia.http.dev-reload") s/Bool
-   (s/required-key "ctia.nrepl.enabled") s/Bool
-   (s/optional-key "ctia.nrepl.port") s/Int
-   (s/optional-key "ctia.store.type") s/Keyword
-   (s/optional-key "ctia.store.sql.db.classname") s/Str
-   (s/optional-key "ctia.store.sql.db.subprotocol") s/Str
-   (s/optional-key "ctia.store.sql.db.subname") s/Str
-   (s/optional-key "ctia.store.sql.db.delimiters") s/Str
-   (s/optional-key "ctia.store.es.uri") s/Str
-   (s/optional-key "ctia.store.es.host") s/Str
-   (s/optional-key "ctia.store.es.port") s/Int
-   (s/optional-key "ctia.store.es.clustername") s/Str
-   (s/optional-key "ctia.store.es.indexname") s/Str
-   (s/optional-key "ctia.producer.type") s/Keyword
-   (s/optional-key "ctia.producer.es.uri") s/Str
-   (s/optional-key "ctia.producer.es.host") s/Str
-   (s/optional-key "ctia.producer.es.port") s/Int
-   (s/optional-key "ctia.producer.es.clustername") s/Str
-   (s/optional-key "ctia.producer.es.indexname") s/Str})
+  (st/merge
+   (st/required-keys {"ctia.auth.type" s/Keyword})
+   (st/optional-keys {"ctia.auth.threatgrid.cache" s/Bool
+                      "ctia.auth.threatgrid.whoami-url" s/Str})
+
+   (st/required-keys {"ctia.http.port" s/Int
+                      "ctia.http.min-threads" s/Int
+                      "ctia.http.max-threads" s/Int})
+   (st/optional-keys {"ctia.http.dev-reload" s/Bool})
+
+   (st/required-keys {"ctia.nrepl.enabled" s/Bool})
+   (st/optional-keys {"ctia.nrepl.port" s/Int})
+
+   (st/optional-keys {"ctia.store.type" s/Keyword
+                      "ctia.store.sql.db.classname" s/Str
+                      "ctia.store.sql.db.subprotocol" s/Str
+                      "ctia.store.sql.db.subname" s/Str
+                      "ctia.store.sql.db.delimiters" s/Str
+                      "ctia.store.es.uri" s/Str
+                      "ctia.store.es.host" s/Str
+                      "ctia.store.es.port" s/Int
+                      "ctia.store.es.clustername" s/Str
+                      "ctia.store.es.indexname" s/Str
+                      "ctia.producer.type" s/Keyword
+                      "ctia.producer.es.uri" s/Str
+                      "ctia.producer.es.host" s/Str
+                      "ctia.producer.es.port" s/Int
+                      "ctia.producer.es.clustername" s/Str
+                      "ctia.producer.es.indexname" s/Str})))

 (def configurable-properties
   "String keys from PropertiesSchema, used to select system properties."


Change highlighting mark to fix bug on Nashorn

--- src/pinpointer/core.cljc
+++ src/pinpointer/core.cljc
@@ -46,7 +46,7 @@

 (defn- format-line [line hiliting?]
   (let [[_ indent line'] (re-matches #"(\s*)(.*)" line)
-        parts (str/split line' #"\000")]
+        parts (str/split line' #"\u0000")]
     (if (= (count parts) 1)
       (if hiliting?
         [line (str (space (count indent)) (wavy-line (count line))) true]
@@ -64,7 +64,7 @@
                      (conj wavy (space (count part)))))))))))

 (defn- format-data [value trace opts]
-  (let [lines (binding [formatter/*highlighting-mark* "\000"]
+  (let [lines (binding [formatter/*highlighting-mark* "\u0000"]
                 (str/split (formatter/format value trace opts) #"\n"))]
     (loop [[line & more] lines, hiliting? false, ret []]
       (if-not line


Now communicate via temporary file instead of stdin

--- jar-async/src/slipstream/async/metric_updator.clj
+++ jar-async/src/slipstream/async/metric_updator.clj
@@ -8,9 +8,9 @@
   [user]
   (let [begin (System/currentTimeMillis)
         measurements (Measurements.)
-        measures (.populateAsString measurements user)]
+        xml-str (.populateAsString measurements user)]
     (log/log-info (str "update took: " (- (System/currentTimeMillis) begin)))
-    measures))
+    xml-str))

 (defn print-sh
   [exit out err]
@@ -20,23 +20,26 @@
   (when (not-empty err)
     (log/log-error err)))

-(defn- persist
-  [measures]
+(defn- report-metrics
+  [path]
   (let [{:keys [exit out err]}
-        (sh/sh "python" "ss-report-metrics.py" "-" :in measures
+        (sh/sh "python" "ss-report-metrics.py" path
                :dir "/opt/slipstream/server/bin")]
     (print-sh exit out err)
     exit))

 (defn update
   [user]
-  (let [measures (get-measurements user)]
-    (if (empty? measures)
-      0
-      (try
-        (persist measures)
-        (catch Exception e
-          (do
-            (log/log-warn "caught exception executing update: " (.getMessage e))
-            -1))))))
+  (let [xml-str (get-measurements user)
+        tmp-file (java.io.File/createTempFile (.getName user) ".xml")]
+    (try
+      (do
+        (with-open [w (clojure.java.io/writer tmp-file)]
+          (.write w xml-str))
+        (report-metrics (.getAbsolutePath tmp-file)))
+      (catch Exception e
+        (do
+          (log/log-warn "caught exception executing update: " (.getMessage e))
+          -1))
+      (finally (.delete tmp-file)))))


Fix typo: 'eat' not 'ec2', 'util' not 'uril'

--- src/circle/backend/nodes/circle_artifact.clj
+++ src/circle/backend/nodes/circle_artifact.clj
@@ -14,7 +14,7 @@
    [pallet.thread-expr :as thread-expr])
   (:require circle.dns)
   (:require [circle.backend.ec2 :as ec2])
-  (:use [circle.uril.except :only (ec2)]))
+  (:use [circle.util.except :only (eat)]))

 (def circle-artifact-group
   (pallet.core/group-spec


make fix for #82 work on windows as well

--- src/clj/backtype/storm/daemon/supervisor.clj
+++ src/clj/backtype/storm/daemon/supervisor.clj
@@ -386,7 +386,7 @@
 ;; local implementation

 (defn resources-jar []
-  (->> (.split (current-classpath) ":")
+  (->> (.split (current-classpath) File/pathSeparator)
        (filter #(.endsWith  % ".jar"))
        (filter #(zip-contains-dir? % RESOURCES-SUBDIR))
        first ))


Cycle users better to fix overlap assign

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -239,6 +239,23 @@
                                                                     :plot_id))))))
       nil)))

+(defn- start-list-at
+  "Creates a new collection removing the item that matches pred, starting the list at item + 1,
+   and appending the beginning of the list on to the end."
+  [pred coll]
+  (loop [head coll
+         tail []]
+    (cond
+      (empty? head)
+      tail
+
+      (pred (first head))
+      (concat (rest head) tail)
+
+      :else
+      (recur (rest head)
+             (conj tail (first head))))))
+
 (defn- assign-qaqc
   "Assigns additional plots to users based on QA/QC method.  The two options are:
    {:qaqcMethod    \"overlap\"
@@ -265,7 +282,7 @@
                                            user-plots)]))
                      (reduce (fn [acc [user-id user-plots]]
                                (let [other-users (case qaqc-method
-                                                   "overlap" (remove #(= user-id %) users)
+                                                   "overlap" (start-list-at #(= % user-id) users)
                                                    "sme"     smes
                                                    nil)]
                                  (loop [to-users     other-users


allow transaction description to be updated

--- src/clj_money/models/storage/sql_storage.clj
+++ src/clj_money/models/storage/sql_storage.clj
@@ -208,6 +208,7 @@
     (let [sql (sql/format (-> (h/update :transactions)
                               (h/sset (->update-set
                                         transaction
+                                        :description
                                         :transaction-date))
                               (h/where [:= :id (:id transaction)])))]
       (jdbc/execute! db-spec sql)))


yada/resource supports direct invocation

Can be useful for testing.

For example :-

```clojure
((yada/resource :body "Hello")
 (request :get "/"))
```

--- src/yada/bidi.clj
+++ src/yada/bidi.clj
@@ -70,7 +70,10 @@
     (when (= this (:handler m)) ""))
   Compilable
   (compile-matched [m]
-    (->CompiledResource (yada* resource-map))))
+    (->CompiledResource (yada* resource-map)))
+  clojure.lang.IFn
+  (invoke [this req]
+    ((yada* resource-map) req)))

 (defn resource* [{:as resource-map}]
   (->Resource resource-map))


Reduce console clutter

Reduce console clutter

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -508,7 +508,6 @@

      (d/catch
          (fn [e]
-           (infof "error: %s" e)
            (error-handler e)
            (let [data (when (instance? clojure.lang.ExceptionInfo e) (ex-data e))]
              (do


~(def init-db): use environment's DATABASE_URL, if set

--- test/babel/test/test.clj
+++ test/babel/test/test.clj
@@ -4,13 +4,17 @@
    [clojure.pprint :refer [pprint]]
    [clojure.string :as string]
    [clojure.test :refer [deftest is]]
-   [clojure.tools.logging :as log]))
+   [clojure.tools.logging :as log]
+   [environ.core :refer [env]]))

 (defn init-db []
-  (->
-   "postgres://localhost/babel"
-   babel.korma/init-db
-   babel.korma/create-tables))
+  (let [database-url
+        (or (env :database-url) "postgres://localhost/babel")]
+    (log/info (str "init-db with database-url: " database-url))
+    (->
+     database-url
+     babel.korma/init-db
+     babel.korma/create-tables)))

 (defn generate-speed-test [spec model & [times]]
   "generate an expression according to the given _spec_ and _model_."


implemented simple analytics by squared confidence of selected phrase words

--- src/destillery/core.clj
+++ src/destillery/core.clj
@@ -1,4 +1,58 @@
 (ns destillery.core
-  (:require [clojure.edn :as edn]))
+  (:import [java.lang.Character])
+  (:import [java.io.PushbackReader])
+  (:require [clojure.java.io :refer (reader)])
+  (:require [clojure.edn :as edn])
+  (:require [clojure.pprint :refer (pprint)]))

+(defn load-data
+  "Loads the content of a file as EDN formatted data structure."
+  [path]
+  (with-open
+    [r (java.io.PushbackReader. (reader path))]
+    (edn/read r)))
+
+(defn best-alternate
+  "Return the best alternate phrase of a recgnition result."
+  [result]
+  (apply max-key :confidence (:alternates result)))
+
+(defn noun?
+  "Checks wheter the given word is a noun.
+  The given word can be the word map from a recognition result with key :text
+  or can be a plain string."
+  [word]
+  (let [word (if (map? word) (:text word) word)]
+    (if (or (nil? word) (< (count word) 3))
+      false
+      (Character/isUpperCase (first word)))))
+
+(defn map-group-items [f [k xs]] [k (map f xs)])
+
+(defn map-pair-value [f [k v]] [k (f v)])
+
+(defn sum [xs] (apply + xs))
+
+(defn squared-sum [xs] (apply + (map #(* % %) xs)))
+
+
+;----------------------------
+
+(def path "D:\\Daten\\FH\\OLL\\Media\\Audio\\de-DE\\11.01 Theoretische, technische, praktische, angewandte Informatik.clj")
+
+(def results (load-data path))
+(def phrases (map best-alternate results))
+;(def phrases (mapcat :alternates results))
+(def words (mapcat :words phrases))
+(def nouns (filter noun? words))
+
+(def grouped-nouns
+  (let
+    [groups (group-by :text nouns)
+     confidences (map (partial map-group-items :confidence) groups)
+     squaresums (map (partial map-pair-value squared-sum) confidences)
+     ordered (reverse (sort-by #(get % 1) squaresums))]
+    ordered))
+
+(pprint (take 20 grouped-nouns))


Add delete test for anchor circle.

Add delete test for anchor circle.

--- spec/freefrog/rest_spec.clj
+++ spec/freefrog/rest_spec.clj
@@ -103,22 +103,11 @@
           (should= "{}" (:body @response))))

       (should-return-4xx "with creating a role"
-                       (fn [] "/")
-                       (json/generate-string {:command "addRole"
-                                              :params {:name "Test Role"}})
-                       400
-                       "IllegalArgumentException")
-
-      (context "with creating a role"
-        (context "with valid parameters"
-          (with response (http-post-request
-                           "/"
-                           (json/generate-string
-                             {:command "addRole",
-                              :params {:name "Test Circle!"
-                                       :lead-link-name "Bill"
-                                       :lead-link-email "bfinn@example.com"}})))
-          (it "should return the location of the newly created resource"))))
+                         (fn [] "/")
+                         (json/generate-string {:command "addRole"
+                                                :params {:name "Test Role"}})
+                         400
+                         "IllegalArgumentException"))

     (context "with creating the anchor circle"
       (should-return-4xx "with no paramaters"
@@ -156,6 +145,12 @@
             (should-contain "Bill" (:body @get-response))
             (should-contain "bfinn@example.com" (:body @get-response))))

+        (context "with deleting the anchor circle"
+          (with delete-response (http-client/delete "http://localhost:3000/"
+                                                    {:throw-exceptions false}))
+          (it "should return method-not-allowed."
+            (should= 405 (:status @delete-response))))
+
         (context "with creating a role"
           (context "with valid parameters"
             (with response (http-post-request
@@ -166,8 +161,8 @@
                                          :lead-link-name "Bill"
                                          :lead-link-email "bfinn@example.com"}})))
             (it "should return the location of the newly created resource"))))
-              ;(should= 201 (:status @response))
-              ;(should= (str "/circles/" (url-encode "Test Circle!")) (get-location @response))))))
+      ;(should= 201 (:status @response))
+      ;(should= (str "/circles/" (url-encode "Test Circle!")) (get-location @response))))))

       (should-return-4xx "with invalid paramaters"
                          (fn [] "circles")
@@ -185,130 +180,130 @@
                          400
                          "IOException"))

-    (context "with a created circle"
-      (with location (get-location (http-post-request
-                                     "circles"
-                                     (json/generate-string
-                                       {:name "Test Circle!"
-                                        :lead-link-name "Bill"
-                                        :lead-link-email "bfinn@example.com"}))))
-      (context "and its specified location"
-        (with get-response (http-get-request @location))
-        (it "should return the content that was created"
-          (should= 200 (:status @get-response))
-          (should-contain "Test Circle!" (:body @get-response))
-          (should-contain "Bill" (:body @get-response))
-          (should-contain "bfinn@example.com" (:body @get-response))))
-
-      (context "and its implicit location"
-        (with get-response (http-get-request (url-encode "Test Circle!")))
-        (it "should return the content that was created"
-          (should-not= nil @location)
-          (should= 200 (:status @get-response))
-          (should-contain "Test Circle!" (:body @get-response))
-          (should-contain "Bill" (:body @get-response))
-          (should-contain "bfinn@example.com" (:body @get-response)))))
-
-    (context "when creating multiple circles"
-      (before (http-post-request "circles"
+(context "with a created circle"
+  (with location (get-location (http-post-request
+                                 "circles"
                                  (json/generate-string
                                    {:name "Test Circle!"
                                     :lead-link-name "Bill"
-                                    :lead-link-email "bfinn@example.com"})
-                                 {:throw-exceptions true}))
-
-      (before (http-post-request "circles"
-                                 (json/generate-string
-                                   {:name "Test Circle 2"
-                                    :lead-link-name "Bill"
-                                    :lead-link-email "bfinn@example.com"})
-                                 {:throw-exceptions true}))
-
-      (with get-response (http-get-request "circles"))
-
-      (it "should return an array of created circles"
+                                    :lead-link-email "bfinn@example.com"}))))
+  (context "and its specified location"
+    (with get-response (http-get-request @location))
+    (it "should return the content that was created"
+      (should= 200 (:status @get-response))
+      (should-contain "Test Circle!" (:body @get-response))
+      (should-contain "Bill" (:body @get-response))
+      (should-contain "bfinn@example.com" (:body @get-response))))
+
+  (context "and its implicit location"
+    (with get-response (http-get-request (url-encode "Test Circle!")))
+    (it "should return the content that was created"
+      (should-not= nil @location)
+      (should= 200 (:status @get-response))
+      (should-contain "Test Circle!" (:body @get-response))
+      (should-contain "Bill" (:body @get-response))
+      (should-contain "bfinn@example.com" (:body @get-response)))))
+
+(context "when creating multiple circles"
+  (before (http-post-request "circles"
+                             (json/generate-string
+                               {:name "Test Circle!"
+                                :lead-link-name "Bill"
+                                :lead-link-email "bfinn@example.com"})
+                             {:throw-exceptions true}))
+
+  (before (http-post-request "circles"
+                             (json/generate-string
+                               {:name "Test Circle 2"
+                                :lead-link-name "Bill"
+                                :lead-link-email "bfinn@example.com"})
+                             {:throw-exceptions true}))
+
+  (with get-response (http-get-request "circles"))
+
+  (it "should return an array of created circles"
+    (should= 200 (:status @get-response))
+    (should-contain "application/json" (get-in @get-response
+                                               [:headers "Content-Type"]))
+    (should= 2 (count (json/parse-string (:body @get-response)))))))
+
+(context "roles"
+  (context "when requesting the list of roles for a non-existent circle"
+    (with roles-response (http-get-request "circles/New%20Circle/roles"))
+    (it "should 404"
+      (should= 404 (:status @roles-response))))
+
+  (context "when posting a new role to a non-existent circle"
+    (with roles-response (http-post-request
+                           "circles/New%20Circle/roles"
+                           (json/generate-string {:name "My Role!"})))
+    (it "should 422 with a helpful error message"
+      (should= 404 (:status @roles-response))
+      (should-contain "Circle 'New Circle' does not exist." (:body @roles-response))))
+
+  (context "with a circle"
+    (with circle-location (get-location (http-post-request
+                                          "circles"
+                                          (json/generate-string
+                                            {:name "Test Circle!"
+                                             :lead-link-name "Bill"
+                                             :lead-link-email "bfinn@example.com"}))))
+
+    (context "when requesting the list of roles"
+      (with roles-response (http-get-request (str @circle-location "/roles")))
+
+      (it "should return an empty array"
+        (should= 200 (:status @roles-response))
+        (should= "[]" (:body @roles-response))))
+
+    (context "when creating a role"
+      (context "with valid parameters"
+        (with roles-response (http-post-request
+                               (str @circle-location "/roles")
+                               (json/generate-string {:name "My Role!"})))
+
+        (it "should return the location of the newly created resource"
+          (should= 201 (:status @roles-response))
+          (should= (str "/circles/" (url-encode "Test Circle!") "/roles/"
+                        (url-encode "My Role!"))
+                   (get-location @roles-response))))
+
+      (should-return-4xx "with invalid paramaters"
+                         #(str @circle-location "/roles")
+                         (json/generate-string {:foo "Test Role"})
+                         400
+                         "IllegalArgumentException")
+      (should-return-4xx "with missing paramaters"
+                         #(str @circle-location "/roles")
+                         (json/generate-string {})
+                         400
+                         "IllegalArgumentException")
+      (should-return-4xx "with malformed JSON"
+                         #(str @circle-location "/roles")
+                         "{\"name\" :: \"Bill\""
+                         400
+                         "IOException"))
+
+    (context "with a created role and its location"
+      (with role-location (get-location (http-post-request
+                                          (str @circle-location "/roles")
+                                          (json/generate-string
+                                            {:name "Test Role"})
+                                          {:throw-exceptions true} )))
+      (with get-response (http-get-request @role-location))
+      (it "should return the content that was created"
         (should= 200 (:status @get-response))
-        (should-contain "application/json" (get-in @get-response
-                                                   [:headers "Content-Type"]))
-        (should= 2 (count (json/parse-string (:body @get-response)))))))
-
-  (context "roles"
-    (context "when requesting the list of roles for a non-existent circle"
-      (with roles-response (http-get-request "circles/New%20Circle/roles"))
-      (it "should 404"
-        (should= 404 (:status @roles-response))))
-
-    (context "when posting a new role to a non-existent circle"
-      (with roles-response (http-post-request
-                             "circles/New%20Circle/roles"
-                             (json/generate-string {:name "My Role!"})))
-      (it "should 422 with a helpful error message"
-        (should= 404 (:status @roles-response))
-        (should-contain "Circle 'New Circle' does not exist." (:body @roles-response))))
-
-    (context "with a circle"
-      (with circle-location (get-location (http-post-request
-                                            "circles"
-                                            (json/generate-string
-                                              {:name "Test Circle!"
-                                               :lead-link-name "Bill"
-                                               :lead-link-email "bfinn@example.com"}))))
-
-      (context "when requesting the list of roles"
-        (with roles-response (http-get-request (str @circle-location "/roles")))
-
-        (it "should return an empty array"
-          (should= 200 (:status @roles-response))
-          (should= "[]" (:body @roles-response))))
-
-      (context "when creating a role"
-        (context "with valid parameters"
-          (with roles-response (http-post-request
-                                 (str @circle-location "/roles")
-                                 (json/generate-string {:name "My Role!"})))
-
-          (it "should return the location of the newly created resource"
-            (should= 201 (:status @roles-response))
-            (should= (str "/circles/" (url-encode "Test Circle!") "/roles/"
-                          (url-encode "My Role!"))
-                     (get-location @roles-response))))
-
-        (should-return-4xx "with invalid paramaters"
-                           #(str @circle-location "/roles")
-                           (json/generate-string {:foo "Test Role"})
-                           400
-                           "IllegalArgumentException")
-        (should-return-4xx "with missing paramaters"
-                           #(str @circle-location "/roles")
-                           (json/generate-string {})
-                           400
-                           "IllegalArgumentException")
-        (should-return-4xx "with malformed JSON"
-                           #(str @circle-location "/roles")
-                           "{\"name\" :: \"Bill\""
-                           400
-                           "IOException"))
-
-      (context "with a created role and its location"
-        (with role-location (get-location (http-post-request
-                                            (str @circle-location "/roles")
-                                            (json/generate-string
-                                              {:name "Test Role"})
-                                            {:throw-exceptions true} )))
-        (with get-response (http-get-request @role-location))
-        (it "should return the content that was created"
-          (should= 200 (:status @get-response))
-          (should-contain "Test Role" (:body @get-response))))
-
-      (context "with a created role with accountabilities and its location"
-        (with role-location (get-location (http-post-request
-                                            (str @circle-location "/roles")
-                                            (json/generate-string
-                                              {:name "Test Role"
-                                               :purpose "End world hunger"})
-                                            {:throw-exceptions true} )))
-        (with get-response (http-get-request @role-location))
-        (it "should return the content that was created"
-          (should= 200 (:status @get-response))
-          (should-contain "Test Role" (:body @get-response))
-          (should-contain "End world hunger" (:body @get-response)))))))
+        (should-contain "Test Role" (:body @get-response))))
+
+    (context "with a created role with accountabilities and its location"
+      (with role-location (get-location (http-post-request
+                                          (str @circle-location "/roles")
+                                          (json/generate-string
+                                            {:name "Test Role"
+                                             :purpose "End world hunger"})
+                                          {:throw-exceptions true} )))
+      (with get-response (http-get-request @role-location))
+      (it "should return the content that was created"
+        (should= 200 (:status @get-response))
+        (should-contain "Test Role" (:body @get-response))
+        (should-contain "End world hunger" (:body @get-response)))))))


deref async actions in migrations to reveal errors

--- src/er_cassandra/drift/migration_helpers.clj
+++ src/er_cassandra/drift/migration_helpers.clj
@@ -9,4 +9,5 @@

 (defmacro execute
   [& body]
-  `(er-cassandra.session/execute (session) ~@body))
+  `(deref
+    (er-cassandra.session/execute (session) ~@body)))


Adapt to PR: Use proper connection-manager threads

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -384,7 +384,7 @@
   (log/info "Starting keycloak")
   (let [{:keys [issuer openid-config api-root] :as this} (init-keycloak (assoc data :credentials credentials :max-user-ids-cache max-user-ids-cache))
         http-timeout 10000
-        connection-manager (http.conn-mgr/make-reusable-conn-manager {:timeout 2 :threads 3 :insecure? false :default-per-route 10})
+        connection-manager (http.conn-mgr/make-reusable-conn-manager {:timeout 30 :threads 10 :insecure? false :default-per-route 10})
         openid-config (fetch-openid-configuration issuer {:timeout http-timeout :connection-manager connection-manager})]
     (log/info "Successfully got openid-config from provider.")
     (assoc this


Add test for `look` at room.

Add test for `look` at room.

--- test/isla/test/story.clj
+++ test/isla/test/story.clj
@@ -27,3 +27,13 @@
     (is (= (first (:rooms story))
            (assoc (isla.interpreter/instantiate-type (get types "room"))
              :name "palace" :description description)))))
+
+;; story telling
+
+(deftest test-look-general
+  (let [description "The floors are made of marble."
+        story-str (str "palace is a room
+                        palace description is '" description "'")
+        story (init-story story-str)]
+    (is (= (run-command story "look")
+           description))))


same line map literal

same line map literal

--- src-cljs/flatride/core.cljs
+++ src-cljs/flatride/core.cljs
@@ -61,10 +61,8 @@
 (defn parse-route [route]
   ;; route.legs[0].distance // .duration
   (let [route-info (nth (.-legs route) 0)]
-    {
-     :distance (->> route-info .-distance .-text)
-     :duration (->> route-info .-duration .-text)
-     }))
+    {:distance (->> route-info .-distance .-text)
+     :duration (->> route-info .-duration .-text)}))

 (defn process-routes [display-route-fn display-elev-fn routes status]
   (doseq [idx (range (->> routes .-routes .-length))]


Upgrading think.image dependency

Upgrading think.image dependency

--- suite/project.clj
+++ suite/project.clj
@@ -5,5 +5,5 @@
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [thinktopic/gpu-compute "0.1.0-8.0-SNAPSHOT"]
-                 [thinktopic/think.image "0.4.1-SNAPSHOT"]
+                 [thinktopic/think.image "0.4.2"]
                  [com.taoensso/nippy "2.12.2"]])


Try another way to get it to work with heroku

--- src/poetshelper/core.clj
+++ src/poetshelper/core.clj
@@ -110,4 +110,5 @@
     (println "Starting server on port " port)
     (httpkit/run-server poetshelper-server {:port port})))

-(start-server 8008)+(defn -main
+  (start-server 5000))


Runner defaults to poller

Runner defaults to poller

--- src/polismath/runner.clj
+++ src/polismath/runner.clj
@@ -83,10 +83,19 @@
   (let [{:keys [arguments options errors summary]} (cli/parse-opts args cli-options)]
     (log/info "Runner main function executed")
     (cond
-      (:help options)   (utils/exit 0 (usage summary))
-      (:errors options) (utils/exit 1 (str "Found the following errors:" \newline (:errors options)))
-      :else
-      (let [subcommand (first arguments)
+      ;; Help message
+      (:help options)
+      (utils/exit 0 (usage summary))
+      ;; Error in parsing (this should really catch the below condition as well
+      (:errors options)
+      (utils/exit 1 (str "Found the following errors:" \newline (:errors options)))
+      ;; Example:
+      ;;; Specifically catch the first argument here needing to be
+      ;(nil? (first arguments))
+      ;(utils/exit 1 "Must specify a subcommand!")
+      :else
+      ;; For now, we'll set the default to be the "poller"
+      (let [subcommand (or (first arguments) "poller")
             system-map-generator (subcommands subcommand)
             _ (log/info "Running subcommand:" subcommand)
             system (system/create-and-run-system! system-map-generator options)]


Remove build-function

Remove build-function

--- src/javascript_externs_generator/extern.cljs
+++ src/javascript_externs_generator/extern.cljs
@@ -30,11 +30,6 @@
    :prototype (for [k (js-keys (.-prototype obj))]
                 {:name k :type :function})})

-(defn build-function
-  "Return string representation of a function"
-  [name]
-  (str (quote-string name) ": function(){}"))
-
 (defn build-props-extern
   "Return recursive string representation of an object's properties"
   [obj]
@@ -52,7 +47,7 @@
   [namespace prototype]
   (when (seq prototype)
     (str namespace ".prototype = {" (string/join "," (for [p prototype]
-                                                       (build-function (:name p)))) "};")))
+                                                       (str (quote-string (:name p)) ": function(){}"))) "};")))

 (defn build-prototype-extern
   "Return recursive string representation of an object's prototype chain"


add asyn client impl

add asyn client impl

--- dada-jms/src/main/clojure/org/dada/jms.clj
+++ dada-jms/src/main/clojure/org/dada/jms.clj
@@ -106,13 +106,15 @@
 	       (.send producer message)))
   )

+(defn ^AsyncMessageClient init-jms-async-message-client-2
+  [^MessageStrategy strategy ^Translator translator ^Session session ^MessageProducer producer]
+  (doto (JMSAsyncMessageClient. strategy translator session producer) (.open)))
+
 (defn ^AsyncMessageClient init-jms-async-message-client
-  ([^MessageStrategy strategy ^Translator translator ^Session session ^MessageProducer producer ^Topic send-to]
-   (doto (JMSAsyncMessageClient. strategy translator session producer) (.open)))
-  ([^MessageStrategy strategy ^Translator translator ^Session session ^String send-to]
-   (let [send-to (.createTopic session send-to)
-	 producer (.createProducer session send-to)]
-     (init-jms-async-message-client strategy translator session producer))))
+  [^MessageStrategy strategy ^Translator translator ^Session session ^String send-to-name]
+  (let [send-to (.createTopic session send-to-name)
+	producer (.createProducer session send-to)]
+    (init-jms-async-message-client-2 strategy translator session producer)))

 ;;------------------------------------------------------------------------------

@@ -202,6 +204,9 @@
   (syncClient [this send-to]
 	      (init-jms-sync-message-client strategy translator timeout threads session send-to))

+  (asyncClient [this send-to]
+	       (init-jms-async-message-client strategy translator session send-to))
+
   (endPoint [this name]
 	    (.createQueue session name))


Deleted old-fashioned test utilities

Deleted old-fashioned test utilities

--- test/midje/test_util.clj
+++ test/midje/test_util.clj
@@ -28,56 +28,10 @@
      (run-without-reporting (fn [] ~run-form))
      ~@check-forms))

-(defmacro one-case
-  ([description]
-   `(println "PENDING:"  ~description))
-  ([description expect-form & check-forms]
-   (let [form-is-expect? (fn [form] (and (seq? form)
-                                         (= (first form) 'expect)))]
-     (assert (form-is-expect? expect-form))
-     (assert (every? #(not (form-is-expect? %)) check-forms))
-     (run-and-check expect-form check-forms))))
-
-
 (defmacro after-silently
   [example-form & check-forms]
   (run-and-check example-form check-forms))

-
-(defn reported?
-  ([expected-count]
-     (reported? expected-count {}))
-  ([expected-count expected-maps]
-     (if (= expected-count (count @reported))
-       (let [one-expected-matches-one-reported?
-             (fn [expected reported] (subset? (set expected) (set reported)))
-
-             one-expected-matches-any-reported?
-             (fn [expected reported-seq]
-               (some #(one-expected-matches-one-reported? expected %) reported-seq))
-
-             all-expected-match-some-reported?
-             (fn [expected-seq reported-seq]
-               (every? (fn [expected]
-                         (one-expected-matches-any-reported? expected reported-seq))
-                       expected-seq))]
-         (if (all-expected-match-some-reported? expected-maps @reported)
-           true
-           (do
-             (println "Expected not a subset of actual.")
-             (println "Expected" expected-maps)
-             (println "Actual" @reported)
-             false)))
-       (do
-         (println "Count" (count @reported) "when" expected-count "expected")
-         (println @reported)
-         false))))
-
-
-(defn only-one-result? []
-  (reported? 1))
-(defn no-failures? []
-  (every? #(= (:type %) :pass) @reported))

 (defn only-passes? [expected-count]
   (cond (not (= (count @reported) expected-count))


delaney.clj: simplified the (traversal) function

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -65,32 +65,17 @@
 (defn traversal [ds indices seeds]
   (let [stacks (map #(vector % ()) (take 2 indices))
         queues (map #(vector % empty-queue) (drop 2 indices))
-        as-root #(vector % :root %)
-        unseen (fn [i seen bag] (pop-while #(seen [% i]) bag))
-        pop-seen #(for [[i ys] %1] (vector i (unseen i %2 ys)))
-        push-neighbors #(for [[i ys] %1] (vector i (conj ys %2)))]
-    ((fn collect [seeds-left todo seen]
-       (let [seeds-left (drop-while (comp seen as-root) seeds-left)
-             todo (pop-seen todo seen)
-             [i todo-for-i] (first (filter (comp seq second) todo))]
-         (cond
-           (seq todo-for-i)
-           (let [D (first todo-for-i)
-                 Di (s ds i D)
-                 head [D i Di]
-                 todo (if Di (vec (push-neighbors todo Di)) todo)
-                 seen (conj seen (as-root Di) [D i] [Di i])]
-             (lazy-seq (cons head (collect seeds-left todo seen))))
-           (seq seeds-left)
-           (let [D (first seeds-left)
-                 head (as-root D)
-                 seeds-left (rest seeds-left)
-                 todo (vec (push-neighbors todo D))
-                 seen (conj seen (as-root D))]
-             (lazy-seq (cons head (collect seeds-left todo seen))))
-           :else
-           ())))
-      (seq seeds) (vec (concat stacks queues)) #{})))
+        push-neighbors #(for [[i ys] %1] [i (if (= :root i) ys (conj ys %2))])
+        step (fn step [todo seen]
+               (let [todo (for [[i ys] todo] [i (pop-while #(seen [% i]) ys)])
+                     [i todo-for-i] (first (filter (comp seq second) todo))]
+                 (if-let [D (first todo-for-i)]
+                   (let [Di (if (= i :root) D (s ds i D))
+                         todo (if Di (vec (push-neighbors todo Di)) todo)
+                         seen (conj seen [Di :root] [D i] [Di i])]
+                     (lazy-seq (cons [D i Di] (step todo seen))))
+                   ())))]
+    (step (vec (concat stacks queues [[:root (into empty-queue seeds)]])) #{})))

 (defn orbit-reps
   ([ds indices seeds]


Use multimethod for filling 0 and 1 groups

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -17,11 +17,16 @@
 (defn fill-column [ts l]
   [(first ts) (rest ts)])

-(defn fill-group [[result tokens] group]
-    (if (== (first group) 0)
-      [(conj result (string/join (repeat (count group) "_"))) tokens]
+(defmulti fill-group
+  (fn [[result tokens] group]
+    (first group)))
+
+(defmethod fill-group 0 [[result tokens] group]
+  [(conj result (string/join (repeat (count group) "_"))) tokens])
+
+(defmethod fill-group 1 [[result tokens] group]
       (let [[column rest-ts] (fill-column tokens (count group))]
-        [(conj result column) rest-ts])))
+        [(conj result column) rest-ts]))

 (defn arrange-tokens-line [ts line]
   (let [groups (partition-by identity line)]


Fix formatting

Fix formatting


fix typo in events.clj

fix typo in events.clj

--- src/metabase/events.clj
+++ src/metabase/events.clj
@@ -76,7 +76,7 @@
   channel)

 (defn subscribe-to-topics
-  "Convenience method for subscribing to series of topics against a single channel."
+  "Convenience method for subscribing to a series of topics against a single channel."
   [topics channel]
   {:pre [(coll? topics)]}
   (loop [[topic & rest] (vec topics)]