one more test

one more test

--- test/pathfinder/redis/storage_test.clj
+++ test/pathfinder/redis/storage_test.clj
@@ -23,7 +23,7 @@
   (testing "simple redis ping"
     (is (= ["PONG" "OK" {:a 1}] (rs/ping)))))

-(deftest one-track-test
+(deftest one-path-test
   (testing "eval trace in let, should be in redis; after timeout it should be removed"
     (let [x 1 y {:a 2}]
       (let [{:keys [id]} (p/trace-env-ttl "PT1S")
@@ -35,6 +35,15 @@
         ;; wait for 1s ttl
         (Thread/sleep (* 1000 2))
         (is (= -2 (rs/wcar* (car/ttl id))))
-        (is (= [] (rs/wcar* (car/lrange id 0 -1))))))))
+        (is (= [] (rs/wcar* (car/lrange id 0 -1)))))))
+  (testing "second track should prolongate path expiration"
+    (let [x 2 y {:a 3}]
+      (p/trace-env-ttl "PT2S")
+      (Thread/sleep 1000)
+      (let [z (+ x (:a y))
+            {:keys [id]} (p/trace-env)
+            stored (rs/wcar* (car/lrange id 0 -1))]
+        (println "Stored data from" id)
+        (is (= 2 (count stored)))))))


(PDB-4832) Add util helpers for index info lookup

--- test/puppetlabs/puppetdb/testutils.clj
+++ test/puppetlabs/puppetdb/testutils.clj
@@ -428,3 +428,25 @@

 (def default-timeout-ms
   (* 1000 60 5))
+
+(defn partition-names
+  "Return all partition names given the parent table name"
+  [table]
+  (let [inhparent (str "public." table)]
+    (->> ["SELECT inhrelid::regclass AS child
+            FROM pg_catalog.pg_inherits
+            WHERE inhparent = ?::regclass;"
+          inhparent]
+         jdbc/query-to-vec
+         (map :child)
+         (map #(.toString %)))))
+
+(defn table-indexes
+  "Return the index definitions for the given table name"
+  [table]
+  (->> ["SELECT tablename, indexdef
+          FROM pg_indexes
+          WHERE schemaname = 'public' AND tablename = ?;"
+        table]
+       jdbc/query-to-vec
+       (map :indexdef)))


Fix broken tests

Fix broken tests

--- test/tourbillon/workflow/jobs_test.clj
+++ test/tourbillon/workflow/jobs_test.clj
@@ -32,17 +32,17 @@

 (deftest test-local-jobstore
   (testing "Assigns id to job on create"
-    (let [job (create-job nil [] nil)
+    (let [job (create-job nil nil [] nil)
           saved-job (create! *jobstore* job)]
       (is (not (nil? (:id saved-job))))))

   (testing "Can retrieve saved job"
-    (let [saved-job (create! *jobstore* (create-job nil [] nil))
+    (let [saved-job (create! *jobstore* (create-job nil nil [] nil))
           retrieved-job (find-by-id *jobstore* (:id saved-job))]
       (is (= saved-job retrieved-job))))

   (testing "Updates existing job with function"
-    (let [saved-job (create! *jobstore* (create-job nil [] nil))
+    (let [saved-job (create! *jobstore* (create-job nil nil [] nil))
           updated-job (update! *jobstore* saved-job
                                               #(update-in % [:states] conj :foo))
           retrieved-job (find-by-id *jobstore* (:id saved-job))]
@@ -52,7 +52,7 @@

 (deftest test-creating-jobs-from-workflows
   (testing "Creates job using workflow as blueprint"
-    (let [workflow (create! *workflowstore* (create-workflow nil [] :a-state))
+    (let [workflow (create! *workflowstore* (create-workflow nil nil [] :a-state))
           job (Workflow->Job workflow)]
       (is (nil? (:id job)))
       (is (= :a-state (:current-state job))))))
@@ -60,7 +60,7 @@
 (deftest test-state-transitioning
   (let [transitions [(create-transition :foo :bar "foo->bar")
                      (create-transition :bar :baz "bar->baz")]
-        job (create! *jobstore* (create-job nil transitions :foo))]
+        job (create! *jobstore* (create-job nil nil transitions :foo))]

     (testing "does not change state when event does not match transition"
       (let [new-job (emit! *jobstore* (mk-test-event "bar->baz" job))]


Reformat day8.re-frame-10x.utils.animated ns

--- src/day8/re_frame_10x/utils/animated.cljs
+++ src/day8/re_frame_10x/utils/animated.cljs
@@ -25,7 +25,7 @@
   (reagent/adapt-react-class react-flip-move))

 (def ^{:constant true
-       :doc "mimic v-box style properties for standard :div
+       :doc      "mimic v-box style properties for standard :div
              note1: typicaly you should also set :class \"rc-v-box display-flex\"
              note2: re-com.box/justify-style & align-style for others"}
   rc-v-box-style
@@ -42,7 +42,7 @@
   [options]
   (-> options
       (update :style #(merge rc-v-box-style %))
-      (assoc  :class "rc-v-box display-flex")))
+      (assoc :class "rc-v-box display-flex")))

 (def ^{:constant true
        :doc      "mimic h-box style properties for standard :div
@@ -61,4 +61,4 @@
   [options]
   (-> options
       (update :style #(merge rc-h-box-style %))
-      (assoc  :class "rc-h-box display-flex")))
+      (assoc :class "rc-h-box display-flex")))


Adding docstring to git-version.

Adding docstring to git-version.

--- src/leiningen/git_version.clj
+++ src/leiningen/git_version.clj
@@ -38,6 +38,19 @@
       {:ctime ctime :sha sha})))

 (defn git-version
+  "Usage:
+    lein git-version [flags] [lein command ...]
+      Runs lein command with a project version augmented with git
+      version of the most recent change of this project directory.
+      Flags include:
+        :insanely-allow-dirty-working-copy - by default git-version
+          refuses to handle a dirty working copy
+        :no-upstream - by default git-version wants to see the current
+          version reachable via an upstream repo
+        :long-sha - uses a full length sha instead of the default
+          short form
+    lein git-version [:long-sha] :print
+    lein git-version :parse <version-str>"
   [project & args]
   (let [[kstrs sargs] (split-with #(.startsWith % ":") args)
         kargs (map #(keyword (.substring % 1)) kstrs)


Minor coordinator cleanup and defensive checks.

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -85,26 +85,25 @@
    new-replica]
   (let [curr-version (get-in curr-replica [:allocation-version job-id])
         new-version (get-in new-replica [:allocation-version job-id])
-        reallocated? (not= curr-version new-version)]
-    (cond reallocated?
-          (let [new-messenger (-> messenger
-                                  (m/update-publishers (input-publications new-replica peer-id job-id))
-                                  (m/set-replica-version! new-version)
-                                  (m/set-epoch! 0))
-                coordinates (read-checkpoint-coordinate log tenancy-id job-id)]
-            (-> state
-                (update :job merge {:completed? false
-                                    :sealing? false})
-                (update :barrier merge {:scheduled? false
-                                        :offering? true
-                                        :remaining (m/publishers new-messenger)
-                                        :opts {:recover-coordinates coordinates}})
-                (update :checkpoint merge {:epoch 0})
-                (assoc :messenger new-messenger)
-                (assoc :curr-replica new-replica)))
-
-          :else
-          (assoc state :curr-replica new-replica))))
+        job-reallocated? (not= curr-version new-version)]
+    (if job-reallocated?
+      (let [new-messenger (-> messenger
+                              (m/update-publishers (input-publications new-replica peer-id job-id))
+                              (m/set-replica-version! new-version)
+                              (m/set-epoch! 0))
+            coordinates (read-checkpoint-coordinate log tenancy-id job-id)]
+        (-> state
+            (update :job merge {:completed? false
+                                :sealing? false})
+            (update :barrier merge {:scheduled? false
+                                    :offering? true
+                                    :remaining (m/publishers new-messenger)
+                                    :opts {:recover-coordinates coordinates}})
+            (update :checkpoint merge {:initiated? false
+                                       :epoch 0})
+            (assoc :messenger new-messenger)
+            (assoc :curr-replica new-replica)))
+      (assoc state :curr-replica new-replica))))

 (defn complete-job
   [{:keys [tenancy-id log job-id messenger checkpoint group-ch] :as state}]
@@ -173,8 +172,6 @@
         next-write-version (if write-coordinate?
                              (write-coordinate write-version log tenancy-id job-id coordinates)
                              write-version)]
-
-
     (-> state
         (update :barrier    merge {:scheduled? false})
         (update :checkpoint merge {:initiated? false


Add favorite vent to the default dataset

--- tutorial.vent/src/tutorial/vent/db.clj
+++ tutorial.vent/src/tutorial/vent/db.clj
@@ -35,7 +35,8 @@
              :vents [{:username "m0nr03"
                       :text "Vim rules! jjjjjjjjjk<ESC><Enter>"}
                      {:username "sparks0id"
-                      :text "Vim is not a lisp editor!!!!1"}]}))
+                      :text "Vim is not a lisp editor!!!!1"
+                      :favorite? true}]}))
     (vent.reload/frontend)))

 (locking file-lock


Fix itunes owner

Fix itunes owner

--- src/qcast/feed/ext/itunes.clj
+++ src/qcast/feed/ext/itunes.clj
@@ -20,7 +20,7 @@
 ;; Channel

 (defn owner [name email]
-  [:itunes:owner [[:itunes:name name] [:itunes:email email]]])
+  [:itunes:owner '([:itunes:name name] [:itunes:email email])])

 (defn categories [& cats]
   (map #(vector :itunes:category {:text (escape-html %)}) cats))


Use partition to get sequential pairs instead of `(map vector ...)`

--- src/fatlip/plot.cljs
+++ src/fatlip/plot.cljs
@@ -616,7 +616,7 @@
   representation of transistions between layers. Also adds information about
   the direction this segment goes."
   [infos]
-  (->> (map vector infos (drop 1 infos))
+  (->> (partition 2 1 infos)
        (reduce (fn [segments [src dest]]
                  (let [src-y (:y src)
                        dest-y (:y dest)]
@@ -842,7 +842,7 @@
                                     (get characters (first (:endpoints item)))))
                                 (:items layer)))
                          layers)]
-    (map vector char-layers (drop 1 char-layers))))
+    (partition 2 1 char-layers)))

 (defn order-group


move another private method out of prometheus wrapper

--- src/vignette/perfmonitoring/core.clj
+++ src/vignette/perfmonitoring/core.clj
@@ -82,5 +82,12 @@
             response-status (get response :status 404)
             response-path (get (meta response) :path "unspecified")
             request-time (/ (double (- finish-time start-time)) 1000.0)]
-        (prometheus/record-request-metric metrics-store app-name request-method response-status request-time response-path)
+        (record-request-metric metrics-store app-name request-method response-status request-time response-path)
         response))))
+
+(defn record-request-metric [metrics-store app-name request-method response-status request-time response-path]
+  (let [status-class (str (int (/ response-status 100)) "XX")
+        method-label (string/upper-case (name request-method))
+        labels [method-label (str response-status) status-class response-path]]
+    (prometheus/track-observation metrics-store app-name "http_request_latency_seconds" request-time labels)
+    (prometheus/increase-counter metrics-store app-name "http_requests_total" labels)))


Move Content-Disposition header to separate fn

--- src/vignette/util/image_response.clj
+++ src/vignette/util/image_response.clj
@@ -8,6 +8,7 @@
             [vignette.util.thumbnail :refer :all]))

 (declare create-image-response
+         add-content-disposition-header
          add-surrogate-header
          surrogate-key)

@@ -38,14 +39,18 @@
        (header "Content-Length" (content-length image))
        (header "X-Thumbnailer" "Vignette")
        (cond->
-         (original image-map) (header "Content-Disposition"
-                                       (format "inline; filename=\"%s\""
-                                               (:original image-map)))
+         (original image-map) (add-content-disposition-header image-map)
          (and (wikia image-map)
               (original image-map)
               (image-type image-map)) (add-surrogate-header image-map))))
   ([image]
     (create-image-response image nil)))
+
+(defn add-content-disposition-header
+  [response-map image-map]
+  (header response-map "Content-Disposition"
+          (format "inline; filename=\"%s\""
+                  (original image-map))))

 (defn add-surrogate-header
   [response-map image-map]


More 'honest' dry mode

More 'honest' dry mode

--- src/whisper2cyanite/metric_store.clj
+++ src/whisper2cyanite/metric_store.clj
@@ -65,15 +65,15 @@
                       (if data
                         (let [{:keys [values rollup period path file]} data]
                           (try
-                            (when run
-                              (async/take!
-                               (alia/execute-chan session
-                                                  (batch statement values)
-                                                  {:consistency :any})
-                               (fn [rows-or-e]
-                                 (if (instance? Throwable rows-or-e)
-                                   (log-error stats-error-files file rows-or-e
-                                              rollup period path)))))
+                            (let [query (batch statement values)]
+                              (when run
+                                (async/take!
+                                 (alia/execute-chan session
+                                                    {:consistency :any})
+                                 (fn [rows-or-e]
+                                   (if (instance? Throwable rows-or-e)
+                                     (log-error stats-error-files file rows-or-e
+                                                rollup period path))))))
                             (catch Exception e
                               (log-error stats-error-files file e rollup period
                                          path))))


variable rename for clarity

variable rename for clarity

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -3,7 +3,7 @@
    [dag_unify.core :refer [unify]]
    [babel.morphology :refer [expand-replace-patterns group-by-two]]))

-(def replace-patterns-imperfect-tense
+(def replace-patterns-imperfect-past-tense
   (expand-replace-patterns
    {:synsem {:infl :imperfect}}
    [
@@ -565,7 +565,7 @@
        (concat
         replace-patterns-conditional-tense
         replace-patterns-future-tense
-        replace-patterns-imperfect-tense
+        replace-patterns-imperfect-past-tense
         replace-patterns-past-tense
         replace-patterns-present-tense)))


and frame-channel

and frame-channel

--- src/cljs/infinitelives/utils/events.cljs
+++ src/cljs/infinitelives/utils/events.cljs
@@ -254,3 +254,30 @@
   []
   (.addEventListener js/window "resize" resize-event-chan-handler))

+
+;;
+;; Frame Channel
+;; -------------
+;; frame channel receives a true every frame paint
+;;
+(def *frame-chans* (atom #{}))
+
+(defn new-frame-chan []
+  (let [c (chan)]
+    (swap! *frame-chans* conj c)
+    c))
+
+(defn del-frame-chan! [c]
+  (swap! *frame-chans* disj c))
+
+(defn clear-frame-chans! []
+  (swap! *frame-chans* #{}))
+
+(defn frame-event-chan-handler [ev]
+  (request-animation-frame frame-event-chan-handler)
+  (doseq [c @*frame-chans*] (put! c true)))
+
+(defn install-frame-handler
+  "install the frame callback to send frame chan messages"
+  []
+  (request-animation-frame frame-event-chan-handler))


fix badge url

fix badge url

--- src/cljs/salava/admin/ui/reporttool.cljs
+++ src/cljs/salava/admin/ui/reporttool.cljs
@@ -43,11 +43,11 @@
                     (reset! status (if (= "true" @status) "false" "true")))}  (if closed? (t :admin/Reportproblem) (t :core/Close))])

 (defn reportform [state status]
-  (let [description-atom (cursor state [:description])
+  (let [description-atom (cursor state [:description])
         report-type-atom (cursor state [:report-type])]
     [:div  {:class "row report-form"}
      (open-reportform-button false status)
-
+
      [:div {:class "col-xs-12" :id "reportform"}
       [:h4 (t :admin/Reportproblem)]
       [:div.form-group
@@ -77,7 +77,7 @@
                    :name     "visibility"
                    :checked  (= @report-type-atom "bug")
                    :onChange #(reset! report-type-atom "bug")}]
-          (t :admin/bug)]]
+          (t :admin/bug)]]
         [:div.radio
          [:label
           [:input {:type     "radio"
@@ -95,12 +95,12 @@
                    }]
           (t :admin/other)]]]
        [:div.form-group
-        [:label
+        [:label
          (str (t :admin/Description) ":")]
         [:textarea {:class    "form-control"
                     :rows     "5"
                     :value    @description-atom
-                    :onChange #(reset! description-atom (.-target.value %))}]]
+                    :onChange #(reset! description-atom (.-target.value %))}]]
        [:div.form-group
         [:button {:class    "btn btn-primary"
                   :on-click #(do
@@ -116,9 +116,10 @@

 (defn url-creator [item-type id]
   (cond
-    (= item-type "badges") (path-for (str "/gallery/badgeview/" id))
+    (= item-type "badges") (path-for (str "/gallery/badgeview/" id))
     (= item-type "page") (path-for (str "/page/view/" id))
-     (= item-type "user") (path-for (str "/user/profile/" id))
+    (= item-type "user") (path-for (str "/user/profile/" id))
+    (= item-type "badge") (path-for (str "/badge/info/" id))
     :else (current-path)))

@@ -134,14 +135,14 @@
                      :status "false"})
         status (cursor state [:status])
         reporter-id (:reporter-id @state)]
-
+
     (fn []
-
+
       (if reporter-id
         [:div
          (cond
            (= @status "false") (open-reportform-button true status)
            (= @status "true")  (reportform state status)
-           (= @status "sent")  (confirmedtext)
+           (= @status "sent")  (confirmedtext)
          :else               "")]
         ""))))


Add use-mate diversification test

Add use-mate diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1044,6 +1044,14 @@
            (not (zero? c2-diff))
            (not= c1-diff c2-diff)))))

+(defn use-mate-diversifying?
+  [ind argmap]
+  (let [g (:genome ind)
+        mate (vec (repeat (count g) {:instruction :from-mate :close 0}))
+        c (produce-child-genome-by-autoconstruction g mate argmap)]
+    (assoc ind :diversifying
+      (some #(= (:instruction %) :from-mate) c))))
+
 (defn use-mate-differently-diversifying?
   [ind argmap]
   (let [g (:genome ind)
@@ -1158,6 +1166,7 @@
                 :three-gens-size-and-instruction three-gens-size-and-instruction-diversifying?
                 :diffmeans diffmeans-diversifying?
                 :minimal-reproductive-difference minimal-reproductive-difference-diversifying?
+                :use-mate use-mate-diversifying?
                 :use-mate-differently use-mate-differently-diversifying?
                 :si-and-mate-use si-and-mate-use-diversifying?
                 :doesnt-clone doesnt-clone-diversifying?


각 요소 LF단위로 끊고, 텍스트가 LF로 끊나지 않는 경우에 덧붙임

각 요소 LF단위로 끊고, 텍스트가 LF로 끊나지 않는 경우에 덧붙임


Changed reference to use cmr-elastic-utils-lib.

--- src/cmr/index_set/data/elasticsearch.clj
+++ src/cmr/index_set/data/elasticsearch.clj
@@ -9,7 +9,7 @@
             [cmr.index-set.services.messages :as m]
             [cheshire.core :as cheshire]
             [cmr.index-set.config.elasticsearch-config :as es-config]
-            [cmr.transmit.elasticsearch :as es]
+            [cmr.elastic-utils.elasticsearch :as es]
             [cmr.system-trace.core :refer [deftracefn]]))

 (defn create-index


Weaken specs for some state fields to suppress spec errors

--- src/spectrace/specs/core.cljc
+++ src/spectrace/specs/core.cljc
@@ -3,9 +3,9 @@
             [spectrace.core :as strace]))

 (s/def ::spec any?)
-(s/def ::path (s/coll-of any?))
+(s/def ::path (s/nilable (s/coll-of any?)))
 (s/def ::val any?)
-(s/def ::in (s/coll-of any?))
+(s/def ::in (s/nilable (s/coll-of any?)))
 (s/def ::pred any?)
 (s/def ::reason string?)
 (s/def ::trail (s/coll-of any?))


Whitespace

Whitespace

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -3,6 +3,7 @@
   up examples, symbols, namespaces and artifacts as values without
   regard to the implementation of the datastore. Ports of Grimoire to
   different datastores should only need to tweak this namespace."
+
   (:refer-clojure :exclude [isa?])
   (:require [grimoire.util :as util]
             [clojure.java.io :as io]


fixed link to home

fixed link to home

--- src/statuses/views/common.clj
+++ src/statuses/views/common.clj
@@ -23,7 +23,7 @@
                    [:div.nav-collapse
                     [:ul.nav
                      [:li.active
-                      [:a {"href" "/statuses"} "Statuses"]]
+                      [:a {"href" "/statuses/updates"} "Statuses"]]
                      [:li
                       [:a {"href" "https://internal.innoq.com/blogging/"} "PPP"]]]]]]]
                 [:div.container


Define utils/remove-prefix-from-path.

Define utils/remove-prefix-from-path.

--- src/incise/utils.clj
+++ src/incise/utils.clj
@@ -1,5 +1,14 @@
 (ns incise.utils
+  (:require [clojure.java.io :refer [file]])
   (:import [java.io File]))
+
+(defn remove-prefix-from-path
+  "Remove the given prefix from the given path."
+  [prefix-file afile]
+  (-> afile
+      (file)
+      (.getCanonicalPath)
+      (subs (count (.getCanonicalPath prefix-file)))))

 (defn- gitignore-file? [^File file]
   (= (.getName file) ".gitignore"))


Implimentation of Rest from Update documents

--- src/rrms/core.clj
+++ src/rrms/core.clj
@@ -47,6 +47,21 @@
                                 :isactive ia})
           (rr/content-type (rr/response "") content-type)))

+  (POST "/documents/update"  {body :body}
+        (let [{id "id"
+               dn "documentname" title "title"
+               en "employeename" d "date"
+               lc "location" ia "isactive"}
+              body]
+          (db/update-documents {:id id
+                                :documentname dn
+                                :title title
+                                :employeename en
+                                :date d
+                                :location lc
+                                :isactive ia})
+          (rr/content-type (rr/response "") content-type)))
+
   (GET "/documents/delete/:id" [id]
        (rr/content-type
         (rr/response (db/delete-documents-by-id


break friction out into its own function

--- src/voke/system/movement.cljs
+++ src/voke/system/movement.cljs
@@ -49,6 +49,7 @@

 (sm/defn update-velocity :- Entity
   [entity :- Entity]
+  ; TODO - acceleration will be computed differently for AI-controlled monsters
   (let [acceleration (if (not-empty (human-controlled-entity-movement-directions entity))
                        (get-in entity [:motion :max-acceleration])
                        0)]
@@ -58,10 +59,9 @@
       (let [orientation (get-in entity [:shape :orientation])
             update-axis-velocity (fn [trig-fn axis-velocity]
                                    (let [new-velocity (min (get-in entity [:motion :max-speed])
-                                                        (* (+ axis-velocity
+                                                           (+ axis-velocity
                                                               (* acceleration
-                                                                 (trig-fn orientation)))
-                                                           friction-value))]
+                                                                 (trig-fn orientation))))]
                                      (if (> (Math/abs new-velocity) min-velocity)
                                        new-velocity
                                        0)))]
@@ -71,6 +71,14 @@
             (update-in [:motion :velocity :y]
                        (partial update-axis-velocity Math/sin))))
       entity)))
+
+(sm/defn apply-friction :- Entity
+  [entity :- Entity]
+  (reduce
+    (fn [entity axis]
+      (update-in entity [:motion :velocity axis] #(* % friction-value)))
+    entity
+    [:x :y]))

 (sm/defn update-position :- Entity
   [entity :- Entity]
@@ -90,6 +98,7 @@
                         (let [moved-entity (-> entity
                                                update-orientation
                                                update-velocity
+                                               apply-friction
                                                update-position)]

                           (doseq [axis [:x :y]]


Add more tests to distribution function

Add more tests to distribution function

--- test/clj_gatling/simulation_test.clj
+++ test/clj_gatling/simulation_test.clj
@@ -458,7 +458,8 @@

 (deftest with-concurrency-function
   (let [concurrency-function-called? (atom false)
-        context-to-fn (atom {})]
+        context-to-fn (atom {})
+        progress-distribution (atom [])]
     (run-single-scenario {:name "scenario"
                           :steps [(step "step" true)]}
                          :concurrency 10
@@ -467,13 +468,17 @@
                          :concurrency-distribution (fn [progress context]
                                                      (reset! context-to-fn context)
                                                      (reset! concurrency-function-called? true)
+                                                     (swap! progress-distribution conj progress)
                                                      (if (< progress 0.5)
                                                        0.1
                                                        1.0)))
     (testing "concurrency-function is called"
       (is (= true @concurrency-function-called?)))
     (testing "context is passed to concurrency-function"
-      (is (= {:value 1} @context-to-fn)))))
+      (is (= {:value 1} @context-to-fn)))
+    (testing "Progress goes from 0 to 1"
+      (is (every? #(and (>= % 0.0) (<= % 1.0)) @progress-distribution))
+      (is (= (sort @progress-distribution) @progress-distribution)))))

 (deftest scenario-weight
   (let [main-scenario {:name "Main"


[CS] Fix bug in table name for unknown SQL errors

--- src/vip/data_processor/validation/csv.clj
+++ src/vip/data_processor/validation/csv.clj
@@ -90,7 +90,7 @@
                                 (let [message (.getMessage e)]
                                   (if (re-find #"UNIQUE constraint failed: (\w+).id" message)
                                     (db.util/retry-chunk-without-dupe-ids ctx sql-table chunk-values)
-                                    (assoc-in ctx [:fatal (:name table) @line-number :unknown-sql-error]
+                                    (assoc-in ctx [:fatal (:name sql-table) @line-number :unknown-sql-error]
                                               [message]))))))
                           ctx))
                       ctx (db.util/chunk-rows (csv/read-csv in-file)


set Access-Control-Allow-Headers to Access-Control-Request-Headers
(fixes #14)

The Access-Control-Allow-Headers header does not allow wildcards. It
must be an exact match:
http://www.w3.org/TR/cors/#access-control-allow-headers-response-header

--- src/io/sarnowski/swagger1st/util/api.clj
+++ src/io/sarnowski/swagger1st/util/api.clj
@@ -35,12 +35,13 @@
     (let [response (if (and override-options
                             (= :options (:request-method request)))
                      (r/response nil)
-                     (handler request))]
+                     (handler request))
+          request-headers (get-in request [:headers "access-control-request-headers"])]
       (-> response
           (r/header "Access-Control-Allow-Origin" "*")
           (r/header "Access-Control-Max-Age" "3600")
           (r/header "Access-Control-Allow-Methods" "GET, POST, DELETE, PUT, PATCH, OPTIONS")
-          (r/header "Access-Control-Allow-Headers" "*")))))
+          (r/header "Access-Control-Allow-Headers" request-headers)))))

 (defn surpress-favicon-requests
   "Returns a 404 for /favicon.ico requests."


Added "interfaces" to appshare applications

This means that different parts of appshare can be plug and plug. So for
example, if you do not like the default database editor in appshare then
you can use one from a third party, or build your own.

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -896,6 +896,122 @@

+(defn make-interfaces-table []
+  (let [sql-to-create-interfaces-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE public.appshare_interfaces
+          (
+          id                                     serial NOT NULL,
+          interface_name                         character varying,
+          fk_default_interface_application_id    integer,
+          CONSTRAINT appshare_interfaces_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_interfaces
+          (
+          id                                     NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          interface_name                         VARCHAR2(200 BYTE),
+          fk_default_interface_application_id    NUMBER,
+          CONSTRAINT  APPSHARE_INTERFACES_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_interfaces"))
+      (korma.core/exec-raw   [sql-to-create-interfaces-table []]   [])
+      nil)))
+
+
+
+
+
+
+
+(defn make-application-implements-interface-table []
+  (let [sql-to-create-application-implements-interface-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE public.appshare_application_implements_interface
+          (
+          id                                     serial NOT NULL,
+          fk_application_id                      integer,
+          interface_name                         character varying,
+          CONSTRAINT appshare_application_implements_interface_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_application_implements_interface
+          (
+          id                                     NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          fk_application_id                      NUMBER,
+          interface_name                         VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_APPLICATION_IMPLEMENTS_INTERFACE_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_application_implements_interface"))
+      (korma.core/exec-raw   [sql-to-create-application-implements-interface-table []]   [])
+      nil)))
+
+
+
+
+
+
+
+
+
+(defn make-application-can-call-interface-table []
+  (let [sql-to-create-application-can-call-interface-table
+        (cond
+          (= *database-type* "postgres" )
+          "
+          CREATE TABLE public.appshare_application_can_call_interface
+          (
+          id                                     serial NOT NULL,
+          fk_application_id                      integer,
+          interface_name                         character varying,
+          CONSTRAINT appshare_application_can_call_interface_pkey PRIMARY KEY (id)
+          );
+          "
+
+          (= *database-type* "oracle" )
+          "
+          CREATE TABLE appshare_application_can_call_interface
+          (
+          id                                     NUMBER GENERATED BY DEFAULT ON NULL AS IDENTITY,
+          fk_application_id                      NUMBER,
+          interface_name                         VARCHAR2(200 BYTE),
+          CONSTRAINT  APPSHARE_APPLICATION_CAN_CALL_INTERFACE_PK PRIMARY KEY (ID)
+          )")
+        ]
+
+    (if (not (does-table-exist  "appshare_application_can_call_interface"))
+      (korma.core/exec-raw   [sql-to-create-application-can-call-interface-table []]   [])
+      nil)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

@@ -1172,6 +1288,9 @@
 (make-users-publisers-table)
 (make-logins-table)
 (make-applications-table)
+(make-interfaces-table)
+(make-application-implements-interface-table)
+(make-application-can-call-interface-table)
 (make-app-schemas-table)
 (make-schemas-table)
 (make-triggers-table)


Can dynamically create tables now from blockly

Although it is putting them in the wrong schema

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -162,10 +162,25 @@

+(defn create-table [session-id   table-details]
+  (let [table-name    (:table-name   table-details)]
+    (do
+      (println (str "***************    Making table: " table-details))
+      (if (not (does-table-exist  table-name))
+        (sql (str "create table " table-name " (id       serial NOT NULL,tfield    character varying,  CONSTRAINT  " table-name "_PK    PRIMARY KEY (id))") [])
+        ))))
+
+

 (defn !update-tables [{session-id    :session-id
                        table-defns   :table-defns}]
   (do
+      (println (str ""))
+      (println (str "******Table count: " (count table-defns)))
+    (doall (map
+         (fn [x] (create-table session-id  x))
+         table-defns
+      ))
       {:value (pr-str table-defns )}))


A little clean-up

A little clean-up

--- pixel-ship-play-clj/desktop/src-common/pixel_ship_play_clj/core.clj
+++ pixel-ship-play-clj/desktop/src-common/pixel_ship_play_clj/core.clj
@@ -18,7 +18,6 @@
    (let [ship-map (psc/color-pixel-ship (psc/create-pixel-ship (assoc bollinger/model :seed seed)))
          tags (keys (:pixels ship-map))
          pixels (:pixels ship-map)
-         hull ((comp :hull :pixels) ship-map)
          shape-builder (fn[s] (reduce (fn[acc n] (conj acc (custom-shape n))) [] s))]
      (reduce (fn[acc tag](concat (shape-builder (tag pixels)) acc)) [] tags))))


Test for function non-api-call-handler

Test for function non-api-call-handler

--- test/emender_jenkins/server_test.clj
+++ test/emender_jenkins/server_test.clj
@@ -177,3 +177,14 @@
             (let [request  {:uri "http://test" :remote-addr "10.20.30.40" :configuration {:config {:verbose true :pretty-print true}}}]
                 (is (log-request request))))))

+(deftest test-non-api-call-handler
+    "Check the function emender-jenkins.server/non-api-call-handler."
+    (testing "the function emender-jenkins.server/non-api-call-handler."
+        (with-redefs [render-front-page (fn [request] :front-page)
+                      render-error-page (fn [request] :error-page)]
+            (are [x y] (= x (non-api-call-handler :request y))
+                :front-page "/"
+                :error-page ""
+                :error-page "/info"
+                :error-page "something/else"))))
+


Better xargs cmd-runner fn selection logging

--- src/yetibot/core/commands/collections.clj
+++ src/yetibot/core/commands/collections.clj
@@ -116,9 +116,9 @@
     (let [itms (ensure-items-collection opts)
           cat (-> (str args " " (first opts))
                   command-execution-info :matched-sub-cmd meta :yb/cat)
-          cmd-runner (if (contains? cat :async) map pmap)]
+          cmd-runner (if (contains? cat :async) 'map 'pmap)]
       (debug "xargs using cmd-runner:" cmd-runner "for command" (pr-str args))
-      (cmd-runner
+      ((resolve cmd-runner)
         (fn [item]
           (try
             (apply handle-cmd
@@ -129,7 +129,7 @@
                      [args (merge cmd-params {:raw item :opts item})]
                      [(psuedo-format args item) (merge cmd-params {:raw item :opts nil})]))
             (catch Exception ex
-              (error "Exception in xargs cmd-runner"
+              (error "Exception in xargs cmd-runner:" cmd-runner
                      (format-exception-log ex))
               ex)))
         itms))))


Claraify comments for issue #132.

Claraify comments for issue #132.

--- src/main/clojure/clara/rules/engine.cljc
+++ src/main/clojure/clara/rules/engine.cljc
@@ -601,9 +601,11 @@
                               { result-binding
                                converted-result}))

-        ;; If any other rule used the binding resulting from
-        ;; this accumulator, we must ensure it matches the produced
-        ;; result so the rule activation is consistent.
+        ;; This is to check that the produced accumulator result is
+        ;; consistent with any variable from another rule condition
+        ;; that has the same binding. If another condition binds something
+        ;; to ?x, only the accumulator results that match that would propagate.
+        ;; We can do this safely because previous states get retracted.
         previous-result (get (:bindings token) result-binding ::no-previous-result)]

     (when (or (= previous-result ::no-previous-result)


Fix chameleon/llds interaction

Fix chameleon/llds interaction

fixes #1475

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -175,7 +175,7 @@
    {:prompt "Choose one subtype"
     :choices ["Barrier" "Code Gate" "Sentry"]
     :msg (msg "choose " target)
-    :effect (effect (set-prop card :ice-type target))
+    :effect (effect (set-prop (get-card state card) :ice-type target))
     :events {:runner-turn-ends {:msg "add itself to Grip" :effect (effect (move card :hand))}}
     :abilities [{:cost [:credit 1] :msg (msg "break 1 " (:ice-type card) " subroutine")}]}


Support slurp url w/o explicit require planck.http

Fixes #279

--- planck-cljs/src/planck/io.cljs
+++ planck-cljs/src/planck/io.cljs
@@ -160,3 +160,6 @@
 (set! planck.core/*reader-fn* reader)
 (set! planck.core/*writer-fn* writer)
 (set! planck.core/*as-file-fn* as-file)
+
+;; Ensure planck.http is loaded so that HTTP Uri facilities are available
+(js/goog.require "planck.http")


Fix type error, use Strings where possible instead of (platform specific) java.io.File

--- src/sqls/util.clj
+++ src/sqls/util.clj
@@ -55,7 +55,7 @@
   [d]
   (let [^java.io.File df (if (instance? java.io.File d) d (java.io.File. d))
         filenames (seq (.list df))
-        join-df-and-filename (fn [f] (path-join [df f]))
+        join-df-and-filename (fn [^String f] (path-join [(.getAbsolutePath df) f]))
         absolute-filenames (map join-df-and-filename filenames)]
     absolute-filenames))

@@ -64,14 +64,11 @@
   "Return a list of absolute paths to driver jar files."
   []
   (let [home (java.lang.System/getProperty "user.home")
-        _ (println "home:" home)
         home-sqls (path-join [home ".sqls"])
         home-sqls-lib (path-join [home ".sqls" "lib"])
         dirs ["." "lib" home-sqls home-sqls-lib]
-        _ (println "dirs to search for jar files:" dirs)
         is-jar? (fn [s] (endswith s ".jar"))
         list-jars (fn [d] (filter is-jar? (list-dir d)))
         lists-of-jars (map list-jars dirs)
         jars (apply concat lists-of-jars)]
-    (println "jar files:" jars)
     jars))


Add a note about the wrap-routes issue

Add a note about the wrap-routes issue

--- src/mdr2/handler.clj
+++ src/mdr2/handler.clj
@@ -87,6 +87,14 @@
 (def rest-api
   "REST API for ABACUS handler"
   (-> api-routes
+      ;; FIXME: Serving app and api routes with different middleware
+      ;; using Ring and Compojure is not without complications, see
+      ;; http://stackoverflow.com/q/28016968. Both set of routes
+      ;; should use wrap-routes. However this seems to cause problems
+      ;; with friend. So we're just using wrap-routes for the
+      ;; api-routes and leave the app-routes as is. This seems to work
+      ;; but feels hackish. Maybe the api-routes should be split into
+      ;; a separate application.
       (wrap-routes wrap-defaults (assoc-in api-defaults [:params  :multipart] true))))

 (def app (routes rest-api site))


Allow playing state when board full, but move is still available

--- src/tfe/core.cljs
+++ src/tfe/core.cljs
@@ -32,11 +32,9 @@

 (defn place [board]
   (let [index (first (shuffle (filter #(not (get-in board %)) (coordinates))))]
-    (print index)
     (assoc-in board index 2)))

 (defn update [board]
-  (print board)
   (let [new-board (pack board)]
     (cond
       (= board new-board) new-board
@@ -59,10 +57,17 @@
 (defmethod next-board nil [_ board]
   board)

+(defn move-available? [board]
+  (> (count #{(next-board :left board)
+              (next-board :right board)
+              (next-board :up board)
+              (next-board :down board)}) 1))
+
 (defn next-state [board]
   (let [cells (vec (apply concat board))]
     (cond
       (contains? cells 2048) :won
+      (move-available? board) :playing
       (every? number? cells) :lost
       :else :playing)))


Suppress log output during failure testing

Signed-off-by: Deepak Giridharagopal <d11186354d1ef01ca06ae37d7e23e827da13e85f@puppetlabs.com>

--- test/com/puppetlabs/cmdb/test/command.clj
+++ test/com/puppetlabs/cmdb/test/command.clj
@@ -4,6 +4,7 @@
         [com.puppetlabs.utils]
         [com.puppetlabs.cmdb.testutils]
         [clojure.test]
+        [clojure.tools.logging :only [*logger-factory*]]
         [cheshire.core :as json]
         [slingshot.slingshot :only [try+ throw+]]))

@@ -194,12 +195,14 @@

 (defmacro test-msg-handler
   [command publish-var discard-var & body]
-  `(let [publish#        (call-counter)
+  `(let [log-output#     (atom [])
+         publish#        (call-counter)
          discard-dir#    (fs/temp-dir)
          handle-message# (produce-message-handler publish# discard-dir# {})
          msg#            (json/generate-string ~command)]
      (try
-       (handle-message# msg#)
+       (binding [*logger-factory* (atom-logger log-output#)]
+         (handle-message# msg#))
        (let [~publish-var publish#
              ~discard-var discard-dir#]
          ~@body)


snapshot: code to make application and session objects

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -6,7 +6,7 @@
                     :battery "com.aldebaran.proxy.ALBatteryProxy"
                     :behaviour-manager "com.aldebaran.proxy.ALBehaviorManagerProxy"
                     :darkness-detection "com.aldebaran.proxy.ALDarknessDetectionProxy"
-                    :leds "com.aldebaran.proxy.ALLedsProxy"
+                    :leds "com.aldebaran.proxy.ALLedsProxy"
                     :memory "com.aldebaran.proxy.ALMemoryProxy"
                     :motion "com.aldebaran.proxy.ALMotionProxy"
                     :navigation "com.aldebaran.proxy.ALNavigationProxy"
@@ -20,14 +20,14 @@
                     :tts "com.aldebaran.proxy.ALTextToSpeechProxy"
                     })

-(def joint-names '("HeadYaw", "HeadPitch",
-                   "LShoulderPitch", "LShoulderRoll", "LElbowYaw", "LElbowRoll",
+(def joint-names '("HeadYaw", "HeadPitch",
+                   "LShoulderPitch", "LShoulderRoll", "LElbowYaw", "LElbowRoll",
                    "LWristYaw", "LHand",
-                   "LHipYawPitch", "LHipRoll", "LHipPitch",
+                   "LHipYawPitch", "LHipRoll", "LHipPitch",
                    "LKneePitch", "LAnklePitch", "LAnkleRoll",
-                   "RHipYawPitch", "RHipRoll", "RHipPitch",
+                   "RHipYawPitch", "RHipRoll", "RHipPitch",
                    "RKneePitch",  "RAnklePitch", "RAnkleRoll",
-                   "RShoulderPitch", "RShoulderRoll", "RElbowYaw", "RElbowRoll",
+                   "RShoulderPitch", "RShoulderRoll", "RElbowYaw", "RElbowRoll",
                    "RWristYaw", "RHand"))

 (def postures {:crouch "Crouch"
@@ -65,9 +65,22 @@
 (defn make-robot
   "Constructs a map representing a robot including any requested proxies. Most functions will construct the proxies they need on-the-fly if they are not already defined but since these are not stored it is more efficient to ask for any needed proxies in the call to make-robot."
   ([hostname] {:hostname hostname :port 9559})
-  ([hostname port] {:hostname hostname :port port})
+  ([hostname port] ( {:hostname hostname :port port}))
   ([hostname port proxies]
      (add-proxies {:hostname hostname :port port} proxies)))
+
+(defn make-application
+  "Creates an instance of an application object"
+  []
+  (com.aldebaran.qimessaging.Application.))
+
+(defn make-session
+  "Create a session connected to a robot"
+  [hostname port]
+  (let [session (com.aldebaran.qimessaging.Session.)
+        fut (.connect session (str "tcp://" hostname ":" port))]
+        (.wait fut 1000)
+        session))

 (defn get-proxy
   "Gets a proxy from a robot, constructing it if necessary"
@@ -240,7 +253,7 @@
   [robot name]
   (.getBodyNames (get-proxy robot :motion) name))

-;; broken - can't construct variant holding array of values
+;; broken - can't construct variant holding array of values
 (defn set-joint-angles
   "Set the named joints to absolute changes"
   [robot names angles speed]
@@ -248,7 +261,7 @@
               (to-array names)
               (to-array angles) speed))

-;; broken - can't construct variant holding array of values
+;; broken - can't construct variant holding array of values
 (defn change-joint-angles
   "Relative changes to joint angles"
   [robot names changes speed]
@@ -295,4 +308,4 @@
 (defn set-volume
   "Set the volume used by the robot"
   [robot vol]
-  (.setVolume (get-proxy robot :tts) (float vol)))+  (.setVolume (get-proxy robot :tts) (float vol)))


Stupid typo

Stupid typo

--- src/oxcart/passes/fn_reduction.clj
+++ src/oxcart/passes/fn_reduction.clj
@@ -220,10 +220,10 @@

   Walks the argument AST, rewriting invoke nodes where it is possible
   to call a previously emitted single arity function rather than a
-  decomposed multiple arity function by doing static arity resolution
-  defaulting to the variadic implementation if present and failing
-  back to the original unaltered function in all cases. Returns an
-  updated top level form."
+  multiple arity function by doing static arity resolution defaulting
+  to the variadic implementation if present and failing back to the
+  original unaltered function in all cases. Returns an updated top
+  level form."
   [top-ast munged-fns]
   (let [munged-fns @munged-fns]
     (postwalk top-ast


TEMP debug kludge #awt #todo

TEMP debug kludge #awt #todo

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -37,7 +37,8 @@
 (defn result-set->pg-insert [tbl-name-str result-set]
   (jdbc/with-db-connection [pg-conn pg-spec]
     (let [rows-inserted (atom 0) ]
-      (doseq [it (partition-all 1000 result-set)]
+      (doseq [it (partition-all 1000
+                    (take 1234 result-set))]    ; #awt #todo #kludge *********************************
         (print (format "%7d  " (swap! rows-inserted + (count it))))
         (time
           (apply jdbc/insert! pg-conn tbl-name-str it ))))))


Created a game update loop in a seperate thread.

--- Clojure/asteroids.clj
+++ Clojure/asteroids.clj
@@ -9,33 +9,54 @@
     '(java.awt.event.ActionListener)
 )

+(defn do-mod [coll func v]
+    (dosync (alter coll (fn [x] (apply func [x v])))))
+
+(defn create-component [game-state]
+    (doto
+        (proxy [javax.swing.JComponent] []
+            (paint [g] (dosync
+                (.setColor g (if (empty? (deref game-state)) (java.awt.Color/RED) (java.awt.Color/BLUE)))
+                (let [rect (.getClipBounds g)]
+                    (.fillRect g (.x rect) (.y rect) (.width rect) (.height rect))))))
+        (.setPreferredSize (new java.awt.Dimension 640 480))
+        (.setDoubleBuffered true)
+        (.setFocusable true)))
+
+(defn game-step [state keys-pressed]
+    (if (empty? keys-pressed)
+        (assoc (hash-map) :a true)
+        (hash-map)))
+
 (defn create-game []
-    (let [keys-pressed (ref #{})
-        result
-        (doto
-            (proxy [javax.swing.JComponent] []
-                (paint [g]
-                    (do
-                        (.setColor g (if (empty? (deref keys-pressed)) (java.awt.Color/RED) (java.awt.Color/BLUE)))
-                        (let [rect (.getClipBounds g)]
-                            (.fillRect g (.x rect) (.y rect) (.width rect) (.height rect))))))
-            (.setPreferredSize (new java.awt.Dimension 640 480))
-            (.setFocusable true)
-            (.addKeyListener (proxy [java.awt.event.KeyAdapter] []
-                (keyPressed [event] (if (not (.isConsumed event)) (do
-                    (dosync
-                        (alter keys-pressed (fn [x] (conj x (.getKeyCode event)))))
-                    (.consume event))))
-                (keyReleased [event] (if (not (.isConsumed event)) (do
-                    (dosync
-                        (alter keys-pressed (fn [x] (disj x (.getKeyCode event))))))))))
-        )]
+    (let [
+        keys-pressed (ref (hash-set))
+        game-state (ref (hash-map))
+        result (create-component game-state)
+        ]
         (do
+            (doto
+                result
+                (.addKeyListener (proxy [java.awt.event.KeyAdapter] []
+                    (keyPressed [event] (if (not (.isConsumed event)) (do
+                        (do-mod keys-pressed conj (.getKeyCode event))
+                        (.consume event))))
+                    (keyReleased [event] (if (not (.isConsumed event)) (do
+                        (do-mod keys-pressed disj (.getKeyCode event))
+                        (.consume event)))))))
+
             (doto
                 (new javax.swing.Timer (/ 1000 60)
                     (reify java.awt.event.ActionListener
                         (actionPerformed [this event] (.repaint result))))
                 (.start))
+
+            (future (loop []
+                (do
+                    (Thread/sleep 1)
+                    (dosync (alter game-state (fn [state] (game-step state (deref keys-pressed)))))
+                    (recur))))
+
             result)))

 (let [frame (new javax.swing.JFrame)]


CW /callback redirects to /voting with access-token in session

--- src/stonecutter_client/handler.clj
+++ src/stonecutter_client/handler.clj
@@ -10,6 +10,7 @@
             [stonecutter-client.view.login :as login]
             [stonecutter-client.view.voting :as voting]
             [stonecutter-client.config :as config]
+            [cheshire.core :as json]
             [clj-http.client :as http]
             [clojure.tools.logging :as log]))

@@ -48,15 +49,22 @@
     response))

 (defn oauth-callback [request]
-  (let [auth-code (get-in request [:params :code])]
-    (http/get oauth-token-path {:query-params {:grant_type   "authorization_code"
-                                               :redirect_uri callback-uri
-                                               :code         auth-code
-                                               :client_id     client-id
-                                               :client_secret client-secret}})))
+  (let [auth-code (get-in request [:params :code])
+        token-response (http/get oauth-token-path {:query-params {:grant_type   "authorization_code"
+                                                                  :redirect_uri callback-uri
+                                                                  :code         auth-code
+                                                                  :client_id     client-id
+                                                                  :client_secret client-secret}})]
+    (-> (r/redirect (path :voting))
+        (assoc :session {:access-token (-> token-response
+                                           :body
+                                           (json/parse-string keyword)
+                                           :access_token)}))))

 (defn voting [request]
- (html-response (voting/voting-page request)))
+  (if (get-in request [:session :access-token])
+  (html-response (voting/voting-page request))
+    (r/redirect (path :login))))

 (defn not-found [request]
   (html-response "404 PAGE NOT FOUND"))


🔇 Silence errors from gis-sync during shutdown

Why:
- Since notified-refresh cannot wait for the tasks to end, because
  PGConnection.getNotifications() is not interruptible, it is necessary
  to allow the database connection being closed first, which will result
  in getNotifications() throwing an exception. This exception is safe to
  ignore, so it should not be logged with a scary stack trace. This
  happens especially during app-cds-setup.

--- src/territory_bro/gis/gis_sync.clj
+++ src/territory_bro/gis/gis_sync.clj
@@ -18,7 +18,8 @@
            (java.time Duration)
            (java.util UUID)
            (java.util.concurrent Executors ExecutorService TimeUnit)
-           (org.postgresql PGConnection)))
+           (org.postgresql PGConnection)
+           (org.postgresql.util PSQLException)))

 (defn- process-changes! [conn state had-changes?]
   (if-some [change (gis-db/next-unprocessed-change conn)]
@@ -85,7 +86,13 @@
       (notify)
       (loop []
         ;; getNotifications is not interruptible, so it will take up to `timeout` for this loop to exit
-        (let [notifications (.getNotifications pg-conn (.toMillis timeout))]
+        (let [notifications (try
+                              (.getNotifications pg-conn (.toMillis timeout))
+                              (catch PSQLException e
+                                ;; hide failures during shutdown; the database connection was closed while waiting for notifications
+                                (if (.isInterrupted (Thread/currentThread))
+                                  (log/info "Ignoring errors during shutdown:" (str e))
+                                  (throw e))))]
           (when-not (.isInterrupted (Thread/currentThread))
             (doseq [_ notifications]
               (notify))
@@ -109,4 +116,5 @@
            (.submit ^Callable (until-interrupted
                                (executors/safe-task
                                 #(listen-for-gis-changes refresh-async!)))))
+  ;; XXX: not awaiting termination, because PGConnection.getNotifications() is not interruptible
   :stop (.shutdownNow ^ExecutorService notified-refresh))


Add tests for default values for map lookups.


Put control buttons and sigma container in the same react component.

--- cljx/plongeur-cljs/src/plongeur/view.cljs
+++ cljx/plongeur-cljs/src/plongeur/view.cljs
@@ -29,15 +29,19 @@
 (let [sigma-state (atom {})]
   (defcomponent Sigma
     "Component on which the Sigma canvas is mounted."
-    :on-mount (fn [node [plot-state id] {:keys [set-force
+
+    :keyfn (fn [[plot-state id idx]] id)
+
+    :on-mount (fn [node [plot-state id idx] {:keys [drop-plot
+                                                set-force
                                                 toggle-force
                                                 toggle-lasso
                                                 merge-plot-data]}]
                 (prn "on-mount")

                 (let [sigma-instance   (-> (s/make-sigma-instance (graph-id id)
-                                                                  (m/sigma-settings plot-state))
-                                           (s/read (m/sigma-data plot-state))
+                                                                  (m/plot-settings plot-state))
+                                           (s/read (m/plot-data plot-state))
                                            (s/toggle-force-atlas-2 (m/force-layout-active? plot-state))
                                            (s/refresh))

@@ -59,12 +63,16 @@
                   (go-loop []
                            (let [interval-ms (-> plot-state m/sync-interval-ms (or 30000))
                                  timeout-ch  (timeout interval-ms)
-                                 [_ ch]      (alts! [timeout-ch ctrl-ch])]
+                                 [v ch]      (alts! [timeout-ch ctrl-ch])]
                              (condp = ch
-                               timeout-ch (let [plot-data (s/data sigma-instance)]
-                                            (>! merge-plot-data [id plot-data])
+                               timeout-ch (do
+                                            (prn (str "merging plot " id))
+                                            (>! merge-plot-data [id (s/data sigma-instance)])
                                             (recur))
-                               _ )))
+                               ctrl-ch    (when v
+                                            (prn (str "merging plot " id))
+                                            (>! merge-plot-data [id (s/data sigma-instance)])
+                                            (recur)))))

                   (swap! sigma-state assoc id
                          {:sigma     sigma-instance
@@ -72,62 +80,59 @@
                           :lasso     lasso
                           :ctrl      ctrl-ch})))

-    :on-unmount (fn [node [plot-state id] cmd-chans]
+    :on-unmount (fn [node [plot-state id idx] cmd-chans]

                   (prn "on-unmount")

                   (swap! sigma-state
                          (fn [m]
-                           (some->> id m :sigma s/kill)
-                           (some->> id m :ctrl  close!)
+                           (some-> id m :sigma s/kill)
+                           (some-> id m :ctrl  close!)
                            (dissoc m id))))

-    :on-update (fn [node [plot-state id] old cmd-chans]
-                 (let [{{:keys [sigma keyboard lasso]} id} @sigma-state]
+    :on-update (fn [node [plot-state id idx] old cmd-chans]
+                 (let [{{:keys [sigma lasso]} id} @sigma-state]
                    (some-> sigma
                            (s/toggle-force-atlas-2 (m/force-layout-active? plot-state))
                            (s/refresh))
                    (some-> lasso
                            (s/toggle-lasso (m/lasso-tool-active? plot-state)))))

-    [[plot-state id] cmd-chans]
-    (html [:div {:id         (graph-id id)
-                 :class-name "sigma-dark"}])))
-
-(defcomponent
-  Card
-  "Component surrounding the visualization containers."
-  :keyfn (fn [[_ id _]] id)
-
-  [[plot-state id idx] {:keys [drop-plot toggle-force toggle-lasso] :as cmd-chans}]
-
-  (let [force? (m/force-layout-active? plot-state)
-        lasso? (m/lasso-tool-active?   plot-state)]
-
-    (html [:div {:class-name "mdl-cell mdl-cell--6-col-desktop mdl-cell--6-col-tablet mdl-cell--6-col-phone"}
-           [:div {:id         (str "card-" id)
-                  :class-name "mdl-card mdl-shadow--2dp"}
-
-            (Sigma [plot-state id] cmd-chans)
-
-            [:div {:class-name "mdl-card__actions"}
-
-             [:button {:on-click   #(go (>! toggle-force id))
-                       :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"
-                       :title      (if force? "Pause force layout" "Resume force layout")}
-              [:i {:class-name "material-icons mdl-badge"} (if force? "pause" "play_arrow")]]
-
-             [:button {:on-click   #(go (>! toggle-lasso id))
-                       :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"
-                       :title      (if lasso? "Pan tool" "Lasso tool")}
-              [:i {:class-name "material-icons mdl-badge"} (if lasso? "pan_tool" "gesture" )]]
-
-             [:div {:on-click   #(go (>! drop-plot id))
-                    :id         (str "drop-plot-" id)
-                    :title      (str "Remove plot " id)
-                    :class-name "mdl-button mdl-js-button mdl-button--fab mdl-button--mini-fab"}
-              [:i {:class-name "material-icons"} "delete"]]]]])))
-
+    [[plot-state id idx] {:keys [drop-plot toggle-force toggle-lasso]}]
+
+    (html
+      [:div {:class-name "mdl-cell mdl-cell--6-col-desktop mdl-cell--6-col-tablet mdl-cell--6-col-phone"}
+       [:div {:id         (str "card-" id)
+              :class-name "mdl-card mdl-shadow--2dp"}
+
+        [:div {:id         (graph-id id)
+               :class-name "sigma-dark"}]
+
+        [:div {:class-name "mdl-card__actions"}
+
+         (let [force? (m/force-layout-active? plot-state)]
+           [:button {:on-click   #(go (>! toggle-force id))
+                     :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"
+                     :title      (if force? "Pause force layout" "Resume force layout")}
+            [:i {:class-name "material-icons mdl-badge"} (if force? "pause" "play_arrow")]])
+
+         (let [lasso? (m/lasso-tool-active? plot-state)]
+           [:button {:on-click   #(go (>! toggle-lasso id))
+                     :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"
+                     :title      (if lasso? "Pan tool" "Lasso tool")}
+            [:i {:class-name "material-icons mdl-badge"} (if lasso? "pan_tool" "gesture")]])
+
+         [:button {:on-click   #(let [{{ctrl-ch :ctrl} id} @sigma-state]
+                                  (go (>! ctrl-ch :!)))
+                   :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"
+                   :title      "Persist"}
+          [:i {:class-name "material-icons mdl-badge"} "save"]]
+
+         [:div {:on-click   #(go (>! drop-plot id))
+               :id         (str "drop-plot-" id)
+               :title      (str "Remove plot " id)
+               :class-name "mdl-button mdl-js-button mdl-button--fab mdl-button--mini-fab"}
+         [:i {:class-name "material-icons"} "delete"]]]]])))

 (defcomponent Grid
   [state cmd-chans]
@@ -136,7 +141,8 @@
           [:div {:class-name "mdl-grid mdl-cell mdl-cell--12-col-desktop mdl-cell--12-col-tablet mdl-cell--4-col-phone mdl-cell--top"}
            (for [[idx [id plot-state]] (->> (m/plots state)
                                             (map-indexed vector))]
-             (Card [plot-state id idx] cmd-chans))]]]))
+             (condp = (m/plot-type plot-state)
+               :sigma (Sigma [plot-state id idx] cmd-chans)))]]]))

 (defcomponent Menu
               [state {:keys [debug]}]
@@ -175,10 +181,6 @@
                              :title      "Add plot"
                              :hidden     (>= (m/plot-count state) 4)
                              :class-name "material-icons mdl-badge mdl-button--icon"} "add"]
-
-                      [:div {:on-click #(go (>! fill-plots :click))
-                             :title      "Generate plots"
-                             :class-name "material-icons mdl-badge mdl-button--icon"} "new_releases"]

                       [:button {:id "more-vert-btn"
                                 :title      "More options"


rename leader update message to dashboard

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -171,7 +171,7 @@

   ; Send top ranked players to the MC.
   (let [ranks (take 10 (rank-players @game-count @game-mode))]
-    (.. io (to "dashboard") (emit "update-lead-players" (pr-str ranks))))
+    (.. io (to "dashboard") (emit "leader-update" (pr-str ranks))))

   )


Correct measurement / magnitude errors

Correct measurement / magnitude errors

Previous commits treated `typical-stage-separation` as a function
returning a magnitude and `stage-extents` as a function consuming only
magnitudes.

This commit changes `typical-stage-separation` to return a measurement
and `stage-extents` to expect an argument containing a sequence of two
measurements.

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -247,9 +247,9 @@

 (defn stage-extents []
   (let [extent-0 (typical-stage-extent)
-        next-fn (fn [[top-n-1 bottom-n-1] extent-0]
-                  (let [bottom (- top-n-1 (typical-stage-separation))
-                        top (- bottom (typical-stage-length))]
+        next-fn (fn [[top-n-1 _]]
+                  (let [bottom (make-measurement (- (magnitude top-n-1) (typical-stage-separation)) (unit top-n-1))
+                        top (make-measurement (- (magnitude bottom) (typical-stage-length)) (unit bottom))]
                     [top bottom]))]
     (iterate next-fn extent-0)))


update streams test for append and register

--- test/riemann/streams_test.clj
+++ test/riemann/streams_test.clj
@@ -18,7 +18,7 @@
 (defmacro run-stream
   "Applies inputs to stream, and returns outputs."
   [stream inputs]
-  `(let [out# (ref [])
+  `(let [out# (atom [])
          stream# (~@stream (append out#))]
      (doseq [e# ~inputs] (stream# e#))
      (deref out#)))
@@ -27,7 +27,7 @@
   "Applies a seq of alternating events and intervals (in seconds) between them
   to stream, returning outputs."
   [stream inputs-and-intervals]
-  `(let [out# (ref [])
+  `(let [out# (atom [])
          stream# (~@stream (append out#))
          start-time# (ref (unix-time))
          next-time# (ref (deref start-time#))]
@@ -50,7 +50,7 @@
   "Exposes a fake index, verifies that the given stream, taking inputs,
   forwards outputs to children"
   [sym stream inputs outputs]
-  `(let [out#    (ref [])
+  `(let [out#    (atom [])
          ~sym    (append out#)
          stream# ~stream]
      (doseq [e# ~inputs] (stream# e#))
@@ -74,7 +74,7 @@
   (vec (map (fn [m] {:metric m}) metrics)))

 (deftest combine-test
-         (let [r (ref nil)
+         (let [r (atom nil)
                sum (combine folds/sum (register r))
                min (combine folds/minimum (register r))
                max (combine folds/maximum (register r))
@@ -529,7 +529,7 @@

          (testing "tagged (one tag)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged "foo") (append r))
                         events [{}
                                 {:tags []}
@@ -541,7 +541,7 @@
                            [{:tags ["foo"]} {:tags ["foo" "bar"]}]))))

          (testing "tagged-all (one tag)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged-all "foo") (append r))
                         events [{}
                                 {:tags []}
@@ -553,7 +553,7 @@
                            [{:tags ["foo"]} {:tags ["foo" "bar"]}]))))

          (testing "tagged-any (one tag)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged-any "foo") (append r))
                         events [{}
                                 {:tags []}
@@ -565,7 +565,7 @@
                            [{:tags ["foo"]} {:tags ["foo" "bar"]}]))))

          (testing "tagged (multiple tags)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged ["foo" "bar"]) (append r))
                         events [{}
                                 {:tags []}
@@ -578,7 +578,7 @@
                            [{:tags ["foo" "bar"]} {:tags ["foo" "bar" "baz"]}]))))

          (testing "tagged-all (multiple tags)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged-all ["foo" "bar"]) (append r))
                         events [{}
                                 {:tags []}
@@ -591,7 +591,7 @@
                            [{:tags ["foo" "bar"]} {:tags ["foo" "bar" "baz"]}]))))

          (testing "tagged-any (multiple tags)"
-                  (let [r (ref [])
+                  (let [r (atom [])
                         s (where (tagged-any ["foo" "bar"]) (append r))
                         events [{}
                                 {:tags []}
@@ -659,7 +659,7 @@
                   (is (= nil ((where nil) :zoooom!)))))

 (deftest default-kv
-         (let [r (ref nil)
+         (let [r (atom nil)
                s (default :service "foo" (register r))]
            (s {:service nil})
            (is (= {:service "foo"} (deref r)))
@@ -671,7 +671,7 @@
            (is (= {:service "bar" :test "baz"} (deref r)))))

 (deftest default-map
-         (let [r (ref nil)
+         (let [r (atom nil)
                s (default {:service "foo" :state nil} (register r))]
            (s (event {:service nil}))
            (is (= "foo" (:service (deref r))))
@@ -1038,13 +1038,12 @@
            (em 12 200)))

 (deftest changed-test
-         (let [output (ref [])
-               r (changed :state
-                          (fn [event] (dosync (alter output conj event))))
-               r2 (changed :state {:init :ok}
+         (let [output (atom [])
+               r (changed :state (append output))
+               r2 (changed :state {:init :ok}
                            (append output))
                states [:ok :bad :bad :ok :ok :ok :evil :bad]]
-
+
            ; Apply states
            (doseq [state states]
              (r {:state state}))
@@ -1054,13 +1053,13 @@
                   (vec (map (fn [s] (:state s)) (deref output)))))

            ; Test with init
-           (dosync (ref-set output []))
+           (reset! output [])
            (doseq [state states]
              (r2 {:state state}))
-
+
            (is (= [:bad :ok :evil :bad]
                   (vec (map (fn [s] (:state s)) (deref output)))))))
-
+
 (deftest changed-state-test
          ; Each test stream keeps track of the first host/service it sees, and
          ; confirms that each subsequent event matches that host, and that
@@ -1412,7 +1411,7 @@
             [nil {:service "bar" :state "ok2"}]]))

 (deftest adjust-test
-  (let [out (ref nil)
+  (let [out (atom nil)
         s (adjust [:state str " 2"] (register out))]

     (s {})
@@ -1421,7 +1420,7 @@
     (s {:state "hey" :service "bar"})
     (is (= (deref out) {:state "hey 2" :service "bar"})))

-  (let [out (ref nil)
+  (let [out (atom nil)
         s (adjust #(assoc % :metric (count (:tags %)))
                   (register out))]


Preventing PDFs errors from blank fields

--- src/time_tracker/invoices/core.clj
+++ src/time_tracker/invoices/core.clj
@@ -140,12 +140,15 @@
       [:table {:width 100 :border false :cell-border false :spacing -5 :num-cols 2}
        [[:cell {:align "left" :style :bold} name]
         [:cell {:align "right":style :bold} (str "Client: " (:client printable-invoice))]]
+       ;; clj/pdf will fail to load PDFs created if fields are null
+       ;; so whichever fields can possibly be null
+       ;; should be set as an empty string
        [[:cell {:align "left"} address1]
         [:cell {:align "right"} client-address1]]
-       [[:cell {:align "left"} address2]
-        [:cell {:align "right"} client-address2]]
-       [[:cell {:align "left"} address3]
-        [:cell {:align "right"} (apply str client-rest)]]]
+       [[:cell {:align "left"} (or address2 "")]
+        [:cell {:align "right"} (or client-address2 "")]]
+       [[:cell {:align "left"} (or address3 "")]
+        [:cell {:align "right"} (apply str (or client-rest ""))]]]

       [:paragraph {:spacing-before 50} [:chunk {:style :bold} "Issue Date: "]
        [:chunk (date->string (-> (time/now) (clj-time.coerce/to-long) (/ 1000))


steal code from ClojureScript

steal code from ClojureScript

--- src/uglify2/core.clj
+++ src/uglify2/core.clj
@@ -21,23 +21,40 @@
   (.eval engine s))

 (defn eval-resource
-  "Evaluate a file on the classpath in the engine."
+  "Evaluate a file on the classpath in the engine.
+  Stolen from ClojureScript"
   [^ScriptEngine engine path]
   (let [r (io/resource path)]
     (eval-str engine (slurp r))
     (println "loaded: " path)))

-(defn js-engine
-  "create a js engine"
-  []
-  (.getEngineByName (ScriptEngineManager.)  "javascript"))
+(defn create-engine
+  "Create a JS engine
+  Stolen from ClojureScript"
+  ([] (create-engine nil))
+  ([{:keys [code-cache] :or {code-cache true}}]
+   (let [args (when code-cache ["-pcc"])
+         factories (.getEngineFactories (ScriptEngineManager.))
+         factory (get (zipmap (map #(.getEngineName %) factories) factories) "Oracle Nashorn")]
+     (if-let [engine (if-not (empty? args)
+                       (.getScriptEngine ^ScriptEngineFactory factory (into-array args))
+                       (.getScriptEngine ^ScriptEngineFactory factory))]
+       (let [context (.getContext engine)]
+         (.setWriter context *out*)
+         (.setErrorWriter context *err*)
+         engine)
+       (throw (IllegalArgumentException.
+               "Cannot find the Nashorn script engine, use a JDK version 8 or higher."))))))
+

 (defn get-context
   "get the context from an engine"
   [^ScriptEngine engine]
   (.getContext engine))

-(defn set-writer! [context writer]
+(defn set-writer!
+  "set the writer of an engine"
+  [context writer]
   (.setWriter context writer))

 ;;;;;;;;;;;;;;;;
@@ -56,11 +73,7 @@
 ;;   nil)

-(let [engine  (js-engine)
-      context (get-context engine)
-      writer (StringWriter.)]
+(let [engine  (create-engine)]

-  (set-writer! context writer)
   (eval-str engine "print('hello JS');")
-  (println (str writer))
   )


Test for empty builds end-to-end for Jenkins sync

--- test/buildviz/jenkins/sync_jobs_test.clj
+++ test/buildviz/jenkins/sync_jobs_test.clj
@@ -17,6 +17,13 @@
   [["http://jenkins:4321/api/json"
     (successful-json-response {:jobs jobs})]])

+(defn- a-job-with-builds [job-name & builds]
+  (let [job-builds [(format "http://jenkins:4321/job/%s/api/json?tree=allBuilds%%5Bnumber,timestamp,duration,result,actions%%5BlastBuiltRevision%%5BSHA1%%5D,remoteUrls,parameters%%5Bname,value%%5D,causes%%5BupstreamProject,upstreamBuild%%5D%%5D%%5D%%7B0,10%%7D"
+                            job-name)
+                    (successful-json-response {:allBuilds []})]]
+    [job-builds]))
+
+
 (defn- serve-up [& routes]
   (->> routes
        (mapcat identity)
@@ -26,9 +33,17 @@

 (deftest test-sync-jobs
-  (testing "should handle empty jobs"
+  (testing "should handle no jobs "
     (let [store (atom [])]
       (fake/with-fake-routes-in-isolation (serve-up (a-view))
         (with-out-str (sut/sync-jobs (url/url "http://jenkins:4321") (url/url "http://buildviz:8010") beginning-of-2016)))
       (is (= []
+             @store))))
+
+  (testing "should handle no builds"
+    (let [store (atom [])]
+      (fake/with-fake-routes-in-isolation (serve-up (a-view (a-job "some_job"))
+                                                    (a-job-with-builds "some_job"))
+        (with-out-str (sut/sync-jobs (url/url "http://jenkins:4321") (url/url "http://buildviz:8010") beginning-of-2016)))
+      (is (= []
              @store)))))


Test SPARQL query syntax

Test SPARQL query syntax

--- test/rdf_path_examples/examples_test.clj
+++ test/rdf_path_examples/examples_test.clj
@@ -11,21 +11,27 @@

 (def configuration
   {:limit 5
+   :sampling-factor 20
    :selection-method "random"
    :sparql-endpoint "http://lod2-dev.vse.cz:8890/sparql"})
+
+(defn- valid-sparql-query?
+  "Test if SPARQL `query` is syntactically valid."
+  [^String query]
+  (try (QueryFactory/create query)
+       true
+       (catch QueryParseException e
+         (log/error (.getMessage e))
+         false)))

 (defn- valid-template?
   "Test if rendering the template from `template-path` using the default valid configuration
   results in a syntactically valid SPARQL query."
-  [template-path]
+  [^String template-path]
   (let [query (render-file template-path
                            (assoc (examples/preprocess-path valid-path)
                                   :limit (:limit configuration)))]
-    (try (QueryFactory/create query)
-         true
-         (catch QueryParseException e
-           (log/error (.getMessage e))
-           false))))
+    (valid-sparql-query? query)))

 (deftest preprocess-path
   (let [preprocessed-path (examples/preprocess-path valid-path)]


Fix the :build-fork-prs blurb.

Fix the :build-fork-prs blurb.

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -371,14 +371,14 @@
                                    "web UI and the API."]})
            (describe-flag {:flag :build-fork-prs
                            :title "Project fork pull requests"
-                           :blurb [:p
-                                   "CircleCI will automatically update the commit status shown on GitHub's "
-                                   "pull request page. Builds will will be run using the parent repository's plan "
-                                   "and will be able to access the parent project's environment settings."
-                                   :p
-                                   "If you have SSH keys or AWS credentials stored in your project settings and "
-                                   "untrusted forks can make pull requests against your repo, then this option "
-                                   "isn't for you!"]})]])))))
+                           :blurb '([:p
+                                     "CircleCI will automatically update the commit status shown on GitHub's "
+                                     "pull request page. Builds will will be run using the parent repository's plan "
+                                     "and will be able to access the parent project's environment settings."]
+                                    [:p
+                                     "If you have SSH keys or AWS credentials stored in your project settings and "
+                                     "untrusted forks can make pull requests against your repo, then this option "
+                                     "isn't for you!"])})]])))))

 (defn dependencies [project-data owner]
   (reify


Give CI more time

Give CI more time

--- integration-tests/apps/caching/counter/test/counter/test/locking.clj
+++ integration-tests/apps/caching/counter/test/counter/test/locking.clj
@@ -26,11 +26,11 @@
 (deftest correct-counting-with-pessimistic-locking
   (csh/put (:pessimistic caches) :count 0)
   (dotimes [_ 10] (msg/publish "/queue/work" {:name :pessimistic :key :count}))
-  (is (every? (partial = :success) (take 10 (msg/message-seq "/queue/done"))))
+  (is (every? (partial = :success) (take 10 (msg/message-seq "/queue/done" :timeout 30000))))
   (is (= 10 (:count (:pessimistic caches)))))

 (deftest correct-counting-with-optimistic-locking
   (csh/put (:optimistic caches) :count 0)
   (dotimes [_ 3] (msg/publish "/queue/work" {:name :optimistic :key :count}))
-  (is (every? (partial = :success) (take 3 (msg/message-seq "/queue/done"))))
+  (is (every? (partial = :success) (take 3 (msg/message-seq "/queue/done" :timeout 30000))))
   (is (= 3 (:count (:optimistic caches)))))


Info model: add state-aggregation, lifecycle calls

--- doc/information_model.clj
+++ doc/information_model.clj
@@ -263,6 +263,20 @@
    :type :string
    :optional? true}}

+  :state-aggregation
+  {:aggregation/init {:doc "Fn (window) to initialise the state."
+                      :type :function
+                      :optional? true}
+   :aggregation/fn {:doc "Fn (state, window, segment) to generate a serializable state machine update."
+                    :type :function
+                    :optional? false}
+   :aggregation/super-aggregation-fn {:doc "Fn (state-1, state-2, window) to combine two states in the case of two windows being merged, e.g. session windows."
+                                      :type :function
+                                      :optional? true}
+   :aggregation/apply-state-update {:doc "Fn (state, entry) to apply state machine update entry to a state."
+                                    :type :function
+                                    :optional? false}}
+
  :trigger-entry
  {:trigger/window-id
   {:doc "The name of a `:window/id` window to fire the trigger against."
@@ -313,6 +327,28 @@
   {:doc "A docstring for this lifecycle."
    :type :string
    :optional? true}}
+  :lifecycle-calls
+   {:lifecycle/start-task? {:doc "A function that takes two arguments - an event map, and the matching lifecycle map. Must return a boolean value indicating whether to start the task or not. If false, the process backs off for a preconfigured amount of time and calls this task again. Useful for lock acquisition. This function is called prior to any processes inside the task becoming active."
+                            :type :function
+                            :optional? true}
+    :lifecycle/before-task-start {:doc "A function that takes two arguments - an event map, and the matching lifecycle map. Must return a map that is merged back into the original event map. This function is called after processes in the task are launched, but before the peer listens for incoming segments from other peers."
+                                  :type :function
+                                  :optional? true}
+    :lifecycle/before-batch {:doc "A function that takes two arguments - an event map, and the matching lifecycle map. Must return a map that is merged back into the original event map. This function is called prior to receiving a batch of segments from the reading function."
+                             :type :function
+                             :optional? true}
+    :lifecycle/after-batch {:doc "A function that takes two arguments - an event map, and the matching lifecycle map. Must return a map that is merged back into the original event map. This function is called immediately after a batch of segments has been read by the peer. The segments are available in the event map by the key `:onyx.core/batch`."
+                            :type :function
+                            :optional? true}
+    :lifecycle/after-task-stop {:doc "A function that takes two arguments - an event map, and the matching lifecycle map. Must return a map that is merged back into the original event map. This function is called before the peer relinquishes its task. No more segments will be received."
+                                :type :function
+                                :optional? true}
+    :lifecycle/after-ack-segment {:doc "A function that takes four arguments - an event map, a message id, the return of an input plugin ack-segment call, and the matching lifecycle map. May return a value of any type which will be discarded. This function is whenever a segment at the input task has been fully acked."
+                                  :type :function
+                                  :optional? true}
+    :lifecycle/after-retry-segment {:doc "A function that takes four arguments - an event map, a message id, the return of an input plugin ack-segment call, and the matching lifecycle map. May return a value of any type which will be discarded. This function is whenever a segment at the input task has been pending for greater than pending-timeout time and will be retried."
+                                    :type :function
+                                    :optional? true}}

  :peer-config
  {:onyx.peer/inbox-capacity


:bug: Minor fix on commit-snapshot handler.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -164,8 +164,8 @@
   (ptk/reify ::handle-page-snapshot
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [local (:workspace-local state)]
-        (when (= (:page-id local) page-id)
+      (let [page-id' (get-in state [:workspace-page :id])]
+        (when (= page-id page-id')
           (rx/of (shapes-changes-commited msg)))))))

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


All frequencies of events depends on fastness now

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -316,7 +316,7 @@
           _               (update-settlement settlement)]
           _               (assert (= settlement (get-settlement id-settlement)))
           _               (assert (= tribe (get-tribe id-tribe)))
-        (run-randomly (update-tribe-fun id-tribe) 3000 10000)
+        (run-randomly (update-tribe-fun id-tribe) (* 3 fastness) (* 10 fastness))
         (run-randomly (update-settlement-fun id-settlement) (* fastness 3) (* fastness 10))
         (record-event (str "Creating tribe " name-tribe) pos)
         (record-event (str "Creating village " name-settlement) pos)
@@ -343,7 +343,7 @@
     (run-every-second f)))

 (defn run-every-n-seconds [f n]
-  (future (Thread/sleep (* n 1000))
+  (future (Thread/sleep (* n 1 fastness))
     (f)
     (run-every-n-seconds f n)))


CMR-348: Added tests for open ended ranges in orbit-number searches.

--- test/cmr/system_int_test/search/granule_orbit_number_search_test.clj
+++ test/cmr/system_int_test/search/granule_orbit_number_search_test.clj
@@ -8,7 +8,8 @@
             [cmr.system-int-test.data2.granule :as dg]
             [cmr.system-int-test.data2.core :as d]
             [cmr.search.validators.messages :as m]
-            [cmr.search.services.messages.orbit-number-messages :as on-m]))
+            [cmr.search.services.messages.orbit-number-messages :as on-m]
+            [cmr.common.services.messages :as cm]))

 (use-fixtures :each (ingest/reset-fixture "CMR_PROV1"))

@@ -56,7 +57,7 @@
     (index/flush-elastic-index)

     (testing "search by exact orbit number"
-      (let [references (search/find-refs :granule {:orbit-number 1})]
+      (let [references (search/find-refs :granule {:orbit-number "1"})]
         (is (d/refs-match? [gran1 gran2 gran3] references))))
     (testing "search by orbit number range"
       (let [references (search/find-refs :granule {:orbit-number "1,2"})]
@@ -76,19 +77,21 @@
     (testing "search by unused orbit number range returns nothing"
       (let [references (search/find-refs :granule {:orbit-number "17,18"})]
         (is (d/refs-match? [] references))))
+    (testing "search by min value"
+      (let [references (search/find-refs :granule {:orbit-number "3.5,"})]
+        (is (d/refs-match? [gran5 gran6 gran7] references))))
+    (testing "search by max value"
+      (let [references (search/find-refs :granule {:orbit-number ",1"})]
+        (is (d/refs-match? [gran1 gran2 gran3] references))))
     (testing "invalid orbit number range"
       (let [{:keys [status errors]} (search/find-refs :granule {:orbit-number "2,1"})]
         (is (= 422 status))
         (is (= errors [(m/min-value-greater-than-max 2.0 1.0)]))))
-    (testing "incomplete range"
-      (let [{:keys [status errors]} (search/find-refs :granule {:orbit-number "1,"})]
-        (is (= 422 status))
-        (is (= errors [(on-m/invalid-orbit-number-msg)]))))
     (testing "non-numeric orbit-number"
       (let [{:keys [status errors]} (search/find-refs :granule {:orbit-number "ABC"})]
         (is (= 422 status))
-        (is (= errors [(on-m/invalid-orbit-number-msg)]))))
+        (is (= errors [(on-m/invalid-orbit-number-msg) (cm/invalid-numeric-range-msg "ABC")]))))
     (testing "non-numeric orbit-number in range"
       (let [{:keys [status errors]} (search/find-refs :granule {:orbit-number "1,X"})]
         (is (= 422 status))
-        (is (= errors [(on-m/invalid-orbit-number-msg)]))))))+        (is (= errors [(on-m/invalid-orbit-number-msg) (cm/invalid-numeric-range-msg "1,X")]))))))


Simplify

Simplify

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

--- acqEngine/src/org/micromanager/mm.clj
+++ acqEngine/src/org/micromanager/mm.clj
@@ -151,7 +151,7 @@

 (defn parse-core-metadata [^Metadata m]
   (into {}
-    (for [k (seq (.GetKeys m))]
+    (for [k (.GetKeys m)]
       [k (.. m (GetSingleTag k) GetValue)])))

 (defn reload-device [dev]


~(defn model): fix reference to variable 'model'

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -555,14 +555,13 @@
          :lookup (fn [arg]
                    (analyze arg lexicon))
          :morph morph
-         :morph-ps fo-ps
-
-         :vocab2model (fn [vocab-items filter-lexicon-fn]
-                        (model-with-vocab-items vocab-items filter-lexicon-fn model))}]
-    (assoc model
-          :generate-fn
-          (fn [spec]
-            (generate/generate spec model)))))
+         :morph-ps fo-ps}]
+    (merge model
+           {:vocab2model (fn [vocab-items filter-lexicon-fn]
+                           (model-with-vocab-items vocab-items filter-lexicon-fn model))
+            :generate-fn
+            (fn [spec]
+              (generate/generate spec model))})))

 (defn model-with-vocab-items [vocab-items filter-lexicon-fn model]
   (let [input-lexicon (transform-with-english-lexical-rules


fix comment

fix comment

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2772,6 +2772,8 @@
       (verb-pred-defaults encyc/verb-pred-defaults)

       ;; if a verb has a subject,
+      ;; and the subject is {:cat :noun},
+      ;; then the subject is {:synsem {:case :nom}}.
       (default {:synsem {:cat :verb
                          :subcat {:1 {:cat :noun
                                       :case :nom}}}})


add intransitive "abandon"

add intransitive "abandon"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -64,12 +64,18 @@
                    :of {:pred nil}}
              :agr {:number :sing}}}

-   "abandon" {:synsem {:cat :verb
-                       :sem {:pred :abandon}
-                       :subcat {:1 {:cat :noun
-                                    :sem {:human true}}
-                                :2 {:cat :noun
-                                    :sem {:physical-object true}}}}}
+   "abandon" [{:synsem {:cat :verb
+                        :sem {:pred :abandon}
+                        :subcat {:1 {:cat :noun
+                                     :sem {:human true}}
+                                 :2 {:cat :noun
+                                     :sem {:physical-object true}}}}}
+              {:synsem {:cat :verb
+                        :sem {:pred :abandon}
+                        :subcat {:1 {:cat :noun
+                                     :sem {:human true}}
+                                 :2 '()}}}]
+
    "accept"  {:synsem {:cat :verb
                        :sem {:pred :accept}}}


add necessary reflexive specifications

add necessary reflexive specifications

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1538,7 +1538,10 @@
                    subject-agr (ref :top)]
                {:synsem {:cat :verb
                          :essere true
-                         :sem {:pred :sit-down}
+                         :sem {:pred :sit-down
+                               :reflexive true
+                               :subj subject-semantics
+                               :obj subject-semantics}
                          :subcat {:1 {:agr subject-agr
                                       :sem subject-semantics}
                                   :2 {:agr subject-agr


fix :g (generation)

fix :g (generation)

--- src/babel/latin/morphology.clj
+++ src/babel/latin/morphology.clj
@@ -3,37 +3,37 @@

 (def replace-patterns
   {:p [#"^(.)eo$" "$1ēre"]
-   :g [#"^(.)eo$" "$1eo"]
+   :g [#"^(.)ēre$" "$1eo"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :sing
                                    :person :1st}}}}}}
   {:p [#"^(.)as$" "$1ēre"]
-   :g [#"^(.)eo$" "$1es"]
+   :g [#"^(.)ēre$" "$1as"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :sing
                                    :person :2nd}}}}}}
   {:p [#"^(.)at$" "$1ēre"]
-   :g [#"^(.)eo$" "$1et"]
+   :g [#"^(.)ēre$" "$1at"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :sing
                                    :person :3rd}}}}}}
   {:p [#"^(.)amus$" "$1ēre"]
-   :g [#"^(.)eo$" "$1emus"]
+   :g [#"^(.)ēre$" "$1amus"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :plur
                                    :person :1st}}}}}}
   {:p [#"^(.)atis$" "$1ēre"]
-   :g [#"^(.)eo$" "$1etis"]
+   :g [#"^(.)ēre$" "$1atis"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :plur
                                    :person :2nd}}}}}}
   {:p [#"^(.)ant$" "$1ēre"]
-   :g [#"^(.)eo$" "$1ent"]
+   :g [#"^(.)ēre$" "$1ant"]
    :u {:synsem {:infl :present
                 :sem {:tense :present}
                 :subcat {:1 {:agr {:number :plur


allow more versatile collection rendering via group-by

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -319,6 +319,7 @@
 (def ^:private +collection-defaults+
   {:out-dir "public"
    :filterer identity
+   :groupby (fn [x] "index.html")
    :sortby (fn [file] (:date-published file))
    :comparator (fn [i1 i2] (compare i2 i1))})

@@ -328,15 +329,21 @@
    r renderer   RENDERER   sym  "Page renderer. Fully qualified symbol resolving to a function."
    f filterer   FILTER     code "Filter function"
    s sortby     SORTBY     code "Sort by function"
+   g groupby    GROUPBY    code "Group posts by function, keys will be used as filenames where posts (values) will be rendered"
    c comparator COMPARATOR code "Sort by comparator function"
    p page       PAGE       str  "Collection result page path"]
   (let [pods      (wrap-pool (pod/pod-pool (boot/get-env)))
         tmp       (boot/tmp-dir!)
-        options   (merge +collection-defaults+ *opts*)]
+        options   (merge +collection-defaults+ *opts* (if-let [p (:page *opts*)]
+                                                        {:groupby (fn [_] p)}))]
     (cond (not (test/function? (:comparator options)))
               (u/fail "collection task :comparator option should be a function\n")
           (not (test/function? (:filterer options)))
               (u/fail "collection task :filterer option should be a function\n")
+          (and (:page options) (:groupby *opts*))
+              (u/warn "using the :page option will render any :groupby option setting effectless\n")
+          (not (ifn? (:groupby options)))
+              (u/fail "collection task :groupby option should implement IFn\n")
           (not (test/function? (:sortby options)))
               (u/fail "collection task :sortby option should be a function\n")
           :else
@@ -344,9 +351,11 @@
               (let [pod            (pods fileset)
                     files          (vals (perun/get-meta fileset))
                     filtered-files (filter (:filterer options) files)
-                    sorted-files   (vec (sort-by (:sortby options) (:comparator options) filtered-files))
-                    html           (render-in-pod pod renderer (perun/get-global-meta fileset) sorted-files)
-                    page-filepath  (perun/create-filepath (:out-dir options) page)]
-                (perun/create-file tmp page-filepath html)
-                (u/info (str "Render collection " page "\n"))
+                    grouped-files  (group-by (:groupby options) filtered-files)]
+                (doseq [[page files] grouped-files]
+                  (let [sorted-files  (vec (sort-by (:sortby options) (:comparator options) files))
+                        html          (render-in-pod pod renderer (perun/get-global-meta fileset) sorted-files)
+                        page-filepath (perun/create-filepath (:out-dir options) page)]
+                    (perun/create-file tmp page-filepath html)
+                    (u/info (str "Render collection " page "\n"))))
                 (commit fileset tmp))))))


add another option to dump meta task

add another option to dump meta task

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -28,9 +28,11 @@

 (deftask dump-meta
   "Utility task to dump perun metadata via boot.util/info"
-  [r to-remove REMOVE [kw] "Keys to remove from metadata map values"]
-  (boot/with-pre-wrap fileset
-    (prn (pr-str (map #(apply dissoc % to-remove) (perun/get-meta fileset))))
+  [r to-remove REMOVE [kw] "Keys to remove from metadata map values"
+   m map-fn    MAPFN  code "function to map over metadata items before printing"]
+  (boot/with-pre-wrap fileset
+    (let [map-fn (or map-fn identity)]
+      (prn (pr-str (map map-fn (perun/get-meta fileset)))))
     fileset))

 (deftask base


Rename `mv-impl` to `mv-pre-wrap` Trying to be consistent about these things. I also made the args a map, like `render-pre-wrap` and `content-pre-wrap`

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -382,9 +382,9 @@
         (perun/report-info "build-date" "added date-build to %s files" (count updated-metas))
       (pm/set-global-meta updated-fs new-global-meta))))

-(defn mv-impl
+(defn mv-pre-wrap
   "Abstraction for tasks that move files in the fileset"
-  [task-name path-fn tracer options]
+  [{:keys [task-name path-fn tracer options]}]
   (boot/with-pre-wrap fileset
     (let [global-meta (pm/get-global-meta fileset)
           metas (filter-meta-by-ext fileset options)
@@ -420,7 +420,10 @@
                   (let [{:keys [path filename]} m
                         slug (slug-fn global-meta m)]
                     (str (perun/parent-path path filename) slug "." (perun/extension filename))))]
-    (mv-impl "slug" path-fn :io.perun/slug options)))
+    (mv-pre-wrap {:task-name "slug"
+                  :path-fn path-fn
+                  :tracer :io.perun/slug
+                  :options options})))

 (def ^:private +permalink-defaults+
   {:permalink-fn (fn [global-meta m]
@@ -443,7 +446,10 @@
                   (let [permalink (permalink-fn global-meta m)]
                     (str (:doc-root global-meta)
                          (string/replace permalink #"/$" "/index.html"))))]
-    (mv-impl "permalink" path-fn :io.perun/permalink options)))
+    (mv-pre-wrap {:task-name "permalink"
+                  :path-fn path-fn
+                  :tracer :io.perun/permalink
+                  :options options})))

 (deftask canonical-url
   "Deprecated - The `:canonical-url` key will now automatically be set in the `entry` map passed


Build regex from `file-exts` parameter to `content-pre-wrap`

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -147,13 +147,14 @@
             input-meta (meta-by-ext input-fs file-exts)
             output-meta (doall
                          (for [{:keys [path parsed filename] :as entry*} input-meta]
-                           (let [page-filepath (string/replace path #"(?i).[a-z]+$" ".html")
+                           (let [ext-pattern (re-pattern (str "(" (string/join "|" file-exts) ")$"))
+                                 page-filepath (string/replace path ext-pattern ".html")
                                  entry (-> entry*
                                            (assoc :has-content true
                                                   :original-path path
                                                   :path page-filepath
                                                   :filename (string/replace filename
-                                                                            #"(?i).[a-z]+$" ".html"))
+                                                                            ext-pattern ".html"))
                                            (dissoc :parsed :extension :file-type :full-path
                                                    :mime-type :original))]
                              (perun/create-file tmp page-filepath parsed)