*** empty log message ***

*** empty log message ***

--- frontpage-re-frame/src/cljs/frontpage_re_frame/solr.cljs
+++ frontpage-re-frame/src/cljs/frontpage_re_frame/solr.cljs
@@ -14,16 +14,6 @@
    (s/optional-key :body) s/Str ; search results don't have a body
    :categories (s/pred not-empty #{s/Str})})

-(def SolrFacetPair
-  [(s/one s/Str "facet") (s/one s/Int 1)])
-
-;; A facet could have zero results.
-(def SolrFacetResult
-  [SolrFacetPair])
-
-(def SolrFacetFields
-  "a schema for a range of facets"
-  {:author SolrFacetResult})

 (defn transform-doc [doc]
   (-> doc
@@ -43,10 +33,35 @@

 (def result-fields [:id :title :author :categories :created-on])
 (def document-fields [:id :title :body :author :categories :created-on])
-(def facet-document-fields [:author :categories :created-on-year])
+
+(def facets
+  [{:field :author
+    :title "Authors"}
+   {:field :categories
+    :title "Categories"
+    :multi-valued true}
+   {:field :created-on-year
+    :title "Years"}])
+
+(def facet-document-fields (map :field facets))
+(def SolrFacetPair
+  [(s/one s/Str "facet") (s/one s/Int 1)])
+
+;; A facet could have zero results.
+(def SolrFacetResult
+  [SolrFacetPair])
+
+(def SolrFacetFields
+  "a schema for a range of facets"
+  {(s/pred (apply hash-set facet-document-fields)) SolrFacetResult})

 (defn create-field-param [fields]
   (string/join " " (map csk/->snake_case_string fields)))
+
+(defn set-field-parameter [fields field value multi-valued]
+  "Set the field parameter in the fields map, adding / removing if the field is multi-valued.
+   Returns the new value of the fields map"
+  )

 (defn search-params [{:keys [text page page-size fields]}]
   (let [params {:q text
@@ -58,9 +73,11 @@
                 :hl.fragsize 300
                 :fl (create-field-param result-fields)
                 :facet true
-                :facet.field "author" ;; FIXME, cljs-ajax translates vector args into f[0], f[1] etc.
+                :facet.field (map csk/->snake_case_string facet-document-fields)
                 :facet.mincount 1}]
-    (if fields
-      (let [[field value] (first fields)]  ;; no multiple facet fields for now
-        (assoc params :fq (str (csk/->snake_case_string field) ":\"" value "\"")))
-      params)))
+    (assoc params :fq
+           (->> fields
+                (map (fn [[field values]]
+                       (map (fn [value]
+                              (str (csk/->snake_case_string field) ":\"" value "\"")))))
+                (concat)))))


fix back button after going to /new

fix back button after going to /new

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -167,7 +167,8 @@
   (go (let [comms (:comms current-state)
             result (<! (ajax/managed-ajax :post "/api/v1/document/new"))]
         (if (= :success (:status result))
-          (put! (:nav comms) [:navigate! {:path (str "/document/" (get-in result [:document :db/id]))}])
+          (put! (:nav comms) [:navigate! {:path (str "/document/" (get-in result [:document :db/id]))
+                                          :replace-token? true}])
           (if (and (= :unauthorized-to-team (get-in result [:response :error]))
                    (get-in result [:response :redirect-url]))
             (set! js/window.location (get-in result [:response :redirect-url]))


inline `workflow-id`

inline `workflow-id`

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -24,14 +24,12 @@
             [goog.string :as gstring])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]))

-(defn- workflow-id [state]
+
+(defn- maybe-add-workflow-response-data [state]
   (let [{:keys [workflow-id]} (get-in state state/navigation-data-path)]
-    workflow-id))
-
-(defn- maybe-add-workflow-response-data [state]
-  (cond-> state
-    (= (workflow-id state) "mock-workflow-id")
-    (assoc-in state/workflow-path workflow/fake-progress-response)))
+    (cond-> state
+      (= workflow-id "mock-workflow-id")
+      (assoc-in state/workflow-path workflow/fake-progress-response))))

 ;; TODO we could really use some middleware here, so that we don't forget to
 ;;      assoc things in state on every handler
@@ -138,7 +136,7 @@
   (set-page-title! "Build State"))

 (defn- add-crumbs [state {:keys [vcs_type project-name build-num org repo tab container-id action-id]}]
-  (let [workflow-id (workflow-id state)
+  (let [{:keys [workflow-id]} (get-in state state/navigation-data-path) (workflow-id state)
         crumbs (if workflow-id
                  [{:type :workflows-dashboard}
                   {:type :org :username org :vcs_type vcs_type}


Switch to thread random local uuid

Switch to thread random local uuid

--- src/onyx/plugin/datomic.clj
+++ src/onyx/plugin/datomic.clj
@@ -5,6 +5,7 @@
             [onyx.peer.function :as function]
             [onyx.types :as t]
             [onyx.static.default-vals :refer [defaults]]
+            [onyx.static.uuid :refer [random-uuid]]
             [onyx.extensions :as extensions]
             [taoensso.timbre :refer [info debug fatal]]))

@@ -82,13 +83,13 @@
                                    datoms (seq (drop num-ignored
                                                      (datoms-sequence db task-map)))]
                               (when datoms
-                                (let [success? (>!! ch (assoc (t/input (java.util.UUID/randomUUID)
+                                (let [success? (>!! ch (assoc (t/input (random-uuid)
                                                                        {:datoms (map unroll (take datoms-per-segment datoms))})
                                                               :chunk-index chunk-index))]
                                   (if success?
                                     (recur (inc chunk-index)
                                            (seq (drop datoms-per-segment datoms)))))))
-                            (>!! ch (t/input (java.util.UUID/randomUUID) :done))
+                            (>!! ch (t/input (random-uuid) :done))
                             (catch Exception e
                               (fatal e))))]

@@ -154,7 +155,7 @@
   (retry-segment
     [_ event segment-id]
     (when-let [msg (get @pending-messages segment-id)]
-      (>!! read-ch (assoc msg :id (java.util.UUID/randomUUID))))
+      (>!! read-ch (assoc msg :id (random-uuid))))
     (swap! pending-messages dissoc segment-id))

   (pending?
@@ -272,7 +273,7 @@
                                                                       (< (:t %) max-tx))
                                                                  entries)]
                                              (>!! read-ch
-                                                  (t/input (java.util.UUID/randomUUID)
+                                                  (t/input (random-uuid)
                                                            (update (into {} entry)
                                                                    :data
                                                                    (partial map unroll-log-datom)))))
@@ -284,7 +285,7 @@
                                            (recur tx-index next-backoff)))
                                        :shutdown))]
                           (if-not (= exit :shutdown)
-                            (>!! read-ch (t/input (java.util.UUID/randomUUID) :done))))
+                            (>!! read-ch (t/input (random-uuid) :done))))
                         (catch Exception e
                           (fatal e))))]

@@ -350,7 +351,7 @@
   (retry-segment
     [_ event segment-id]
     (when-let [msg (get @pending-messages segment-id)]
-      (>!! read-ch (assoc msg :id (java.util.UUID/randomUUID))))
+      (>!! read-ch (assoc msg :id (random-uuid))))
     (swap! pending-messages dissoc segment-id))

   (pending?


Fix bug where users might blow up (#62)

Fix bug where users might blow up (#62)

--- src/yetibot/core/models/users.clj
+++ src/yetibot/core/models/users.clj
@@ -98,7 +98,8 @@
   (let [chat-source (select-keys source [:adapter :uuid :room])]
     (->> @users
          vals
-         (filter (fn [u] (and (:channels u) ((:channels u) chat-source)))))))
+         (filter (fn [{:keys [channels]}]
+                   (and channels ((set channels) chat-source)))))))

 (defn get-user [source id]
   (@users {:adapter (:adapter source) :id id}))


serving admin app

serving admin app

--- booking-service/src/booking_service/service.clj
+++ booking-service/src/booking_service/service.clj
@@ -91,7 +91,7 @@
 (defn admin-page [req]
   {:status 200
    :headers {"Content-Type" "text/html; charset=utf-8"}
-   :body "Hello Admin!"})
+   :body (slurp "public/admin-app.html" :encoding "UTF-8")})

 (defn not-found-page [req]
@@ -174,7 +174,10 @@
            (update-in [:cookies] merge cookie))))

-(def admin-subscribe (partial subscribe-for "admin-session" ::wait-for-events))
+(defn admin-subscribe [request]
+
+  )
+;(def admin-subscribe (partial subscribe-for "admin-session" ::wait-for-events))

 (def wait-for-events (sse-setup (partial add-subscriber "admin-session")))

@@ -271,7 +274,10 @@
        :post do-booking
       }
       ["/odmin" ^:interceptors [basic-auth ] {:get admin-subscribe}
-          ["/all" {:get wait-for-events}]
+          ["/all"
+           {:get admin-page}
+           ;{:get wait-for-events}
+           ]
      ]]]])


Remove zoom on build perf graph

Remove zoom on build perf graph

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -64,7 +64,6 @@
                                                    (concat ["Median Build Time"] (map last build-times))]}
                                   :legend {:hide true}
                                   :grid {:y {:show true}}
-                                  :zoom {:enabled true}
                                   :axis {:x {:type "timeseries"
                                              :tick {:format "%m/%d"}}
                                          :y {:min 0


sort the envvars before displaying them

sort the envvars before displaying them

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -515,7 +515,9 @@
                                                                                :on-success close-fn}])}
                                                                         "Add Variable")]
                                        :close-fn close-fn})))
-              (when-let [env-vars-entries (seq (:envvars project-data))]
+              (when-let [env-vars-entries (->> project-data
+                                               :envvars
+                                               (sort-by key))]
                 (om/build table/table
                           {:rows env-vars-entries
                            :key-fn key


Close the code signing keys upload modal on upload.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1369,6 +1369,7 @@
               [:input.save {:data-failed-text "Failed",
                             :data-success-text "Uploaded",
                             :data-loading-text "Uploading...",
+                            :data-dismiss "modal"
                             :value "Upload",
                             :type "submit"
                             :disabled (not (and file-content description))


clojure: added spacegroup detection based on improved symmetry computation

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -5,7 +5,7 @@
              IEdge
              PeriodicGraph$CoverNode Morphism Morphism$NoSuchMorphismException)
            (org.gavrog.joss.pgraphs.io Net)
-           (org.gavrog.joss.geometry Operator Vector)
+           (org.gavrog.joss.geometry Operator Vector SpaceGroup)
            (org.gavrog.jane.compounds Matrix)
            (org.gavrog.jane.numbers Whole)))

@@ -125,7 +125,7 @@
           (let [[a b] (first q)]
             (cond
               (empty? q)
-              [M src2img]
+              [op src2img]

               (nil? b)
               nil
@@ -158,3 +158,6 @@
       (->> bases
         (map #(symmetry-from-base-pair net (first bases) % sigs))
         (filter identity)))))
+
+(defn spacegroup [net]
+  (SpaceGroup. (.getDimension net) (map first (symmetries net))))


CMR-6296 fixes ltest run-suites command

CMR-6296 fixes ltest run-suites command

--- common-lib/src/cmr/common/test/runners/util.clj
+++ common-lib/src/cmr/common/test/runners/util.clj
@@ -22,7 +22,6 @@
   []
   (->> (all-ns)
        (map str)
-       (filter #(re-find #"cmr\..*test" %))
        set
        (#(set/difference % (set (integration-test-namespaces))))
        vec


Test that multiple names are displayed properly.

--- test/ahnentafel/server/pages/search_test.clj
+++ test/ahnentafel/server/pages/search_test.clj
@@ -48,5 +48,14 @@
        "John /Doe"
        "Jane /Doe"))))

-(deftest result-with-multiple-names)
+(deftest result-with-multiple-names
+  (with-redefs [query/search
+                (fn [data query]
+                  [{:xref "@I1@"
+                    :name ["John /Doe" "John J. /Doe"]
+                    :birth {:date "yesterday"}
+                    :death {:date "today"}}])]
+    (let [page (get-page search "/Doe")]
+      (are-on-page "John /Doe (a.k.a. John J. /Doe)"))))
+
 (deftest with-missing-dates)


string-to-double shouldn't barf of nil values. Courtesy of Amit Rathore.

--- src/redis.clj
+++ src/redis.clj
@@ -57,7 +57,8 @@
 (defn string-to-double
   "Convert a string in floating point format to a double"
   [string]
-  (Double/parseDouble string))
+  (if string
+    (Double/parseDouble string)))

 (defn int-to-date
   "Return a Date representation of a UNIX timestamp"


[#3031] Use lumen db user from config

[#3031] Use lumen db user from config

Relates https://github.com/akvo/akvo-lumen/commit/90ece9acc0dde141f07afd898f015729ecffcd74

--- backend/src/akvo/lumen/admin/remove_tenant.clj
+++ backend/src/akvo/lumen/admin/remove_tenant.clj
@@ -34,8 +34,7 @@
 (defn exec [{:keys [authorizer dbs]} label]
   (binding [admin.db/env-vars (:root dbs)]
     (let [tenant (str "tenant_" (str/replace label "-" "_"))
-         db-uris (admin.db/db-uris label nil (-> dbs :lumen :password))]
-     (admin.db/drop-tenant-database label db-uris)
+         db-uris (admin.db/db-uris label nil (-> dbs :lumen :password) (-> dbs :lumen :user))]
      (admin.keycloak/remove-tenant authorizer label)
      true)))


Updated date of homepage article

Updated date of homepage article

--- src/sdos_site/core.clj
+++ src/sdos_site/core.clj
@@ -13,7 +13,7 @@
   [{:title "Announcing Sauerbraten Day of Sobriety, a New Tournament"
     :link nil
     :author "mefisto"
-    :date "September 12, 2013"
+    :date "September 17, 2013"
     :content (md-to-html-string
               "
 Feeling down because there's no Sauerbraten tournament for you to play


Update entries scene with feedback when loading

Add visual feedback pushing the refresh button when the entries list is
empty.

--- src/elfeed_cljsrn/android/scenes/entries.cljs
+++ src/elfeed_cljsrn/android/scenes/entries.cljs
@@ -85,17 +85,20 @@
        [icon {:style (:icon styles) :name "archive" :size 22}]]]]))

 (defn no-entries-component []
-  (let [styles {:wrapper {:height 400
-                          :justify-content "center"
+  (let [loading? (subscribe [:loading?])
+        styles {:wrapper {:height 300
                           :align-items "center"}
                 :button {:margin-top 10
                          :border-radius 2
                          :background-color (:secondary-text palette)
                          :padding 10}
                 :button-text {:color (:white colors)}}]
-    [rn/view {:style (:wrapper styles)}
-     [rn/text "There are no entries"]
-     [button {:on-press #(dispatch [:fetch-content])} "REFRESH"]]))
+    (fn []
+      (let [label (if @loading? "LOADING..." "REFRESH")
+            on-press-fn (if @loading? nil #(dispatch [:fetch-content]))]
+        [rn/view {:style (:wrapper styles)}
+         [rn/text "There are no entries"]
+         [button {:on-press on-press-fn} label]]))))

 (defn entries-scene []
   (let [loading (subscribe [:loading?])
@@ -118,26 +121,25 @@
          [rn/view {:style {:flex 1}}
           (when @remote-error
             [remote-error-message])
-          (when @entries
-            (if-not (empty? @entries)
-              [rn/swipeable-list-view {:dataSource datasource
-                                       :max-swipe-distance 50
-                                       :bounceFirstRowOnMount false
-                                       :refresh-control (r/as-element [rn/refresh-control {:refreshing @loading
-                                                                                :on-refresh #(dispatch [:fetch-content])}])
-                                       :style (:list styles)
-                                       :enableEmptySections true
-                                       :render-header (fn [_ _]
-                                                        (when (> @update-time 0)
-                                                          (r/as-element [update-time-info @update-time])))
-                                       :render-quick-actions (fn [row-data section-id row-id]
-                                                               (r/as-element [entry-quick-actions (js->clj row-data :keywordize-keys true)]))
-                                       :render-row (fn [data section-id row-id]
-                                                     (let [entry-data (js->clj data :keywordize-keys true)
-                                                           unread? (and (boolean (some #{"unread"} (:tags entry-data)))
-                                                                        (not (boolean (some #{(:webid entry-data)} @recent-reads))))]
-                                                       (r/as-element [entry-row (merge  entry-data {:unread? unread?})])))
-                                       :render-separator (fn [section-id row-id _]
-                                                           (r/as-element [rn/view {:key (str section-id "-" row-id)
-                                                                                :style (:separator styles)}]))}]
-              [no-entries-component]))]]))))
+          [rn/swipeable-list-view {:dataSource datasource
+                                   :max-swipe-distance 50
+                                   :bounceFirstRowOnMount false
+                                   :refresh-control (r/as-element [rn/refresh-control {:refreshing @loading
+                                                                                :on-refresh #(dispatch [:fetch-content])}])
+                                   :style (:list styles)
+                                   :enableEmptySections true
+                                   :render-header (fn [_ _]
+                                                    (when (> @update-time 0)
+                                                      (r/as-element [update-time-info @update-time])))
+                                   :render-quick-actions (fn [row-data section-id row-id]
+                                                           (r/as-element [entry-quick-actions (js->clj row-data :keywordize-keys true)]))
+                                   :render-row (fn [data section-id row-id]
+                                                 (let [entry-data (js->clj data :keywordize-keys true)
+                                                       unread? (and (boolean (some #{"unread"} (:tags entry-data)))
+                                                                    (not (boolean (some #{(:webid entry-data)} @recent-reads))))]
+                                                   (r/as-element [entry-row (merge  entry-data {:unread? unread?})])))
+                                   :render-separator (fn [section-id row-id _]
+                                                       (r/as-element [rn/view {:key (str section-id "-" row-id)
+                                                                               :style (:separator styles)}]))}]
+          (when (empty? @entries)
+            [no-entries-component])]]))))


Add channel options to connect

Add channel options to connect

--- src/squelch/audio_node.cljs
+++ src/squelch/audio_node.cljs
@@ -71,8 +71,14 @@

 (defn connect
   "Allows us to connect one output of this node to one input of another node."
-  [src dest]
-  (.connect src dest))
+  ([src dest]
+   (.connect src dest))
+
+  ([src dest src-channel]
+   (.connect src dest src-channel))
+
+  ([src dest src-channel dest-channel]
+   (.connect src dest src-channel dest-channel)))

 (defn disconnect
   "Allows us to disconnect the current node from another one it is already


play works

play works

--- src/tenbytenbot/tactics.clj
+++ src/tenbytenbot/tactics.clj
@@ -6,35 +6,48 @@

-(defn play [board slot-nums]
-  ""
-  (let [slots (map (fn [num] (get p/pieces num)) slot-nums)]
+(defn play [board slot-nums debug]
+  "elects a move to perform"
+  (let [slots (vec (map (fn [num] (get p/pieces num)) slot-nums))]

-    ;(println slots)
-    (println "----")
-    (doseq [[i slot] (map-indexed vector slots)]
-      (println (str "\n" i ":"))
-      (m/mprint slot))
+    (when debug
+      (println "----")
+      (doseq [[i slot] (map-indexed vector slots)]
+        (println (str "\n" i ":"))
+        (m/mprint slot)))

     (let [pos [0 0]
           slot-index 0
           slot (get slots slot-index)]
-      (println (str "\nabout to play " slot-index " on " pos "..."))
-      {:slot-index slot-index :pos pos}
-      ;(io/play )
-      ;(m/mprint (m/glue board slot pos))
-      )))
+
+      (when debug
+        (println (str "\nabout to play " slot-index " on " pos "...")))
+
+      { :slot slot
+        :slot-index slot-index
+        :pos pos})))

 (defn go []
   "play a tenbyten game"
-  (let [board (m/mcreate [10 10])
+  (let [debug true
+        board (m/mcreate [10 10])
         ng (io/new-game)]
-    (println ng)

-    (let [p (play board (:slots ng))
+    (when debug
+      (println ng))
+
+    (let [p (play board (:slots ng) debug)
           [x y] (:pos p)]

-      (let [r (io/play (:id ng) (:step ng) (:slot-index p) x y)]
-        (println r)))))
+      (let [r (io/play (:id ng) (:step ng) (:slot-index p) x y)
+            board2 (m/glue board (:slot p) (:pos p))]
+        (when debug
+          (println r)
+          (println)
+          (m/mprint (:slot p))
+          (println)
+          (m/mprint board2))
+
+        ))))


Removed tabs from r.m.session indentation.

--- ring-core/src/ring/middleware/session.clj
+++ ring-core/src/ring/middleware/session.clj
@@ -24,8 +24,8 @@
     (wrap-session handler {}))
   ([handler options]
      (let [store        (options :store (memory-store))
-	   cookie       (options :cookie-name "ring-session")
-	   cookie-attrs (options :cookie-attrs {})]
+           cookie       (options :cookie-name "ring-session")
+           cookie-attrs (options :cookie-attrs {})]
       (wrap-cookies
         (fn [request]
           (let [sess-key (get-in request [:cookies cookie :value])
@@ -38,9 +38,9 @@
                               (if sess-key
                                 ((store :delete) sess-key))))
                 response (dissoc response :session)]
-              (if (and sess-key* (not= sess-key sess-key*))
-                (assoc response
-		  :cookies (merge (response :cookies)
-				  {cookie (merge cookie-attrs
-						 {:value sess-key*})}))
-                response)))))))
+            (if (and sess-key* (not= sess-key sess-key*))
+              (assoc response
+                :cookies (merge (response :cookies)
+                                {cookie (merge cookie-attrs
+                                               {:value sess-key*})}))
+              response)))))))


samples 100

samples 100

--- src-cljs/flatride/core.cljs
+++ src-cljs/flatride/core.cljs
@@ -58,7 +58,7 @@

 (defn start-compute-elevation-data [route idx display-elev-fn]
   (let [es (window/google.maps.ElevationService.)
-        path-req (js-obj "path" (.-overview_path route) "samples" 300)]
+        path-req (js-obj "path" (.-overview_path route) "samples" 100)]
     (.getElevationAlongPath es
                             path-req
                             (partial process-elevation-data display-elev-fn idx))))


Helpful method to allow changing data file in development.

--- dev/reloaded.clj
+++ dev/reloaded.clj
@@ -3,6 +3,9 @@

 (defn- set-port [port]
   (alter-var-root #'env assoc :port port))
+
+(defn- set-data-file [file]
+  (alter-var-root #'env assoc :gedcom-file file))

 (def the-system "The System." nil)


Adapt auth frontend code to schema api change.

--- src/uxbox/frontend/auth.clj
+++ src/uxbox/frontend/auth.clj
@@ -6,10 +6,10 @@

 (ns uxbox.frontend.auth
   (:require [catacumba.handlers.postal :as pc]
+            [promesa.core :as p]
             [uxbox.schema :as us]
             [uxbox.frontend.core :refer (-handler)]
-            [uxbox.services :as sv]
-            [promesa.core :as p]))
+            [uxbox.services :as sv]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Schema
@@ -26,7 +26,7 @@

 (defmethod -handler [:novelty :auth/login]
   [context {:keys [data dest]}]
-  (p/alet [data (us/extract! +auth-frame-schema+ data)
+  (p/alet [data (us/extract! data +auth-frame-schema+)
            data (assoc data :type dest)
            resp (p/await (sv/novelty data))]
     (pc/frame resp)))


added explicit test for #39; seems fixed

--- test/push/interpreter/interpreter_running_test.clj
+++ test/push/interpreter/interpreter_running_test.clj
@@ -42,6 +42,8 @@
     (owe/make-everything-interpreter :bindings {:a 8}) :a) :exec) => '(8) ;; lookup
   (u/get-stack (handle-item
     (owe/make-everything-interpreter :bindings {:a 8 :b nil}) :b) :ref) => '()
+  (u/get-stack (handle-item
+    (owe/make-everything-interpreter :bindings {:a 8 :b nil}) :b) :exec) => '()

   (let [dumb (owe/make-everything-interpreter :bindings {:a 8 :b nil})]


Tidied a couple of things, including improving how rhythm is done in the body of play#.

--- src/overtunes/songs/row_row_row_your_boat.clj
+++ src/overtunes/songs/row_row_row_your_boat.clj
@@ -3,13 +3,13 @@
     [overtone.live :only [at now]]
     [overtone.inst.sampled-piano :only [sampled-piano]]))

-(defn sum-up-to [series n] (reduce + (take n series)))
-(def major-scale #(sum-up-to (cycle [2 2 1 2 2 2 1]) %))
+(defn sum-n [series n] (reduce + (take n series)))
+(def major-scale (partial sum-n (cycle [2 2 1 2 2 2 1])))
 (def g-major #(-> % major-scale (+ 67)))

 (defn bpm [beats start] #(-> % (/ beats) (* 60) (* 1000) (+ start)))
 (defn after [timing beats] #(timing (+ beats %)))
-(defn syncopate [timing lengths] #(timing (sum-up-to lengths %)))
+(defn syncopate [timing durations] #(timing (sum-n durations %)))

 (def pitches [0 0 0 1 2, 2 1 2 3 4, 7 7 7 4 4 4 2 2 2 0 0 0, 4 3 2 1 0])
 (def durations [1 1 2/3 1/3 1, 2/3 1/3 2/3 1/3 2, 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3 1/3, 2/3 1/3 2/3 1/3 2])
@@ -20,12 +20,12 @@

 (defn play# []
   (let [timing (bpm 150 (now))
-        rhythm #(syncopate % durations)]
-    (melody# (rhythm (after timing 0)) pitches)
-    (melody# (rhythm (after timing 16)) pitches)
-    (melody# (rhythm (after timing 20)) pitches)
-    (melody# (rhythm (after timing 24)) pitches)
-    (melody# (rhythm (after timing 28)) pitches)
+        rhythm-from #(syncopate (after timing %) durations)]
+    (melody# (rhythm-from 0)  pitches)
+    (melody# (rhythm-from 16) pitches)
+    (melody# (rhythm-from 20) pitches)
+    (melody# (rhythm-from 24) pitches)
+    (melody# (rhythm-from 28) pitches)
     ))

 (play#)


(PDB-3930) Don't json-serialize fact values during ~ comparisons

Excepting the query vector directly below, assume we're using SQL
quotation syntax.

Previously, for a comparison (say to the nodes endpoint) like

  ["~", ["fact", "osfamily"], "foo"]

the query engine would generate a path like this to look up the value:

  ...->'osfamily')::text

The -> operator produces json(b), and then the ::text serializes the
value as json, so that a value of 'bar' in the database will actually
be compared to the regular expression as '"bar"'.  Note the extra
double quotes from the json serialization.

This was originally reported because comparisons against the regex
'^foo' were failing while comparisons against '^"foo' would succeed.

For the case in question, change the query engine to generate
a (possibly nested) path lookup that uses -> only for the non-leaf
elements and uses ->> for the final retrieval.  (The ->> operator
produces the unserialzed text representation of the value.)

With that, the query should compare 'foo' to 'foo', rather than
'"foo"'.

--- src/puppetlabs/puppetdb/scf/storage_utils.clj
+++ src/puppetlabs/puppetdb/scf/storage_utils.clj
@@ -240,16 +240,22 @@
 (defn jsonb-path-binary-expression
   "Produce a predicate that compares against nested value with op and checks the
   existence of a (presumably) top-level value. The existence check is necessary
-  because -> is not indexable (with GIN) but ?? is. Assumes a GIN index on the
+  because -> is not indexable (with GIN) but ? is. Assumes a GIN index on the
   column supplied."
   [op column qmarks]
-  (let [delimited-qmarks (str/join "->" qmarks)
-        re? (= "~" (name op))]
-    (hcore/raw (string/join \space
-                            [(str "(" column "->" delimited-qmarks ")" (when re? "::text"))
-                             (name op)
-                             (if re? "(?#>>'{}')::text" "?")
-                             "and" column "??" "?"]))))
+  (if (= "~" (name op))
+    (let [path-elts (cons column qmarks)
+          path (apply str
+                      (str/join "->" (butlast path-elts))
+                      (when-let [x (last path-elts)] ["->>" x]))]
+      (hcore/raw (string/join \space
+                              [(str "(" path ")") (name op) "(?#>>'{}')::text"
+                               "and" column "??" "?"])))
+    (let [delimited-qmarks (str/join "->" qmarks)]
+      (hcore/raw (string/join \space
+                              [(str "(" column "->" delimited-qmarks ")")
+                               (name op) "?"
+                               "and" column "??" "?"])))))

 (defn jsonb-scalar-cast
   [typ]


http4s AttributeKey on muuttunut uudemmassa versiossa, korjattu käyttämään oikeaa constructoria

--- clj-cas/src/clj_cas/client.clj
+++ clj-cas/src/clj_cas/client.clj
@@ -32,7 +32,7 @@

 (defn attribute-entry [k v]
-  (org.http4s.AttributeEntry. (org.http4s.AttributeKey. k) v))
+  (org.http4s.AttributeEntry. (org.http4s.AttributeKey.) v))

 (defn attributes [am]
   (.apply org.http4s.AttributeMap$/MODULE$


CLJS-456: test case for CLJS-544 named fn shadows namespaced

Was resolved w/ CLJS-544, commit
9ddf847b44ec82070e91038f4afbd8a2baec94ff, however there was no test
case.

--- test/cljs/foo/ns_shadow_test.cljs
+++ test/cljs/foo/ns_shadow_test.cljs
@@ -5,5 +5,10 @@
 (defn quux [foo]
   (+ (foo.ns-shadow-test/bar) foo))

+(defn id [x] x)
+
+(defn foo [] (id 42))
+
 (defn test-shadow []
-  (assert (= (quux 2) 3)))+  (assert (= (quux 2) 3))
+  (assert (= (foo) 42)))


remove old comments

remove old comments

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -124,18 +124,6 @@
               :role "button"}
              (common/icon :command)
              [:span "Shortcuts"]]
-            ; [:a.vein.make
-            ;  {:href "/home"
-            ;   :role "button"}
-            ;  (common/icon :home)
-            ;  [:span "Home"]]
-            ; [:a.vein.make
-            ;  {:href "/blog"
-            ;   :target "_self"
-            ;   :role "button"}
-            ;  (common/icon :blog)
-            ;  [:span "Blog"]]
-            ; (om/build auth-link app {:opts {:source "start-overlay"}})
             ]])))))

 (defn team-start [app owner]
@@ -158,7 +146,7 @@
               :role "button"}
              (common/icon :clock)
              [:span "Team Documents"]]
-            ; (om/build auth-link app {:opts {:source "start-overlay"}})
+            (om/build auth-link app {:opts {:source "start-overlay"}})
             ]])))))

 (defn private-sharing [app owner]


wire up the AST stuff

wire up the AST stuff

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/aurora/editor/fake.cljs
+++ src/aurora/editor/fake.cljs
@@ -213,8 +213,6 @@
 (defmethod draw-clause "all" [clause world path]
   [:span [:span.keyword "all "] (rule-ui clause world path)])

-(list [3] [2])
-
 (defmethod draw-clause "change" [clause world path]
   (let [rule (get-in @state [:madlibs (:ml clause)])
         placeholders (into {} (for [k (keys (:placeholders rule))]
@@ -235,20 +233,20 @@
   (compile-clause (assoc clause :type "find") world))

 (defmethod compile-clause "find" [clause world]
-  [(dissoc clause :type)])
+  [(denotation/Filter. (dissoc clause :type))])

 (defmethod compile-clause "add" [clause world]
-  [(list '+ (dissoc clause :type))])
+  [(denotation/Assert. (dissoc clause :type))])

 (defmethod compile-clause "all" [clause world]
   (let [things (get clause "things")]
-    [(list '+s (if (string? things)
-                 (reader/read-string things)
-                 (or things [])))]))
+    [(denotation/AssertMany. (if (string? things)
+                               (reader/read-string things)
+                               (or things [])))]))

 (defmethod compile-clause "forget" [clause world]
-  [(list '- (dissoc clause :type))])
+  [(denotation/Retract. (dissoc clause :type))])

 (defmethod compile-clause "see" [clause world]
   (let [exp (get clause "expression")
@@ -256,7 +254,7 @@
               (reader/read-string exp)
               exp)
         final (list '= (get clause "name") exp)]
-    [(list '= (get clause "name" 'x) exp)]))
+    [(denotation/Let. (get clause "name" 'x) exp)]))

 (defmethod compile-clause "change" [clause world]
   (let [rule (get-in @state [:madlibs (:ml clause)])
@@ -267,16 +265,16 @@
         syms (into {} (for [k (keys (dissoc clause :ml))]
                         [k (gensym k)]))
         sees (for [[k v] (dissoc clause :ml)]
-               (list '= (syms k) (if (string? v)
-                                   (reader/read-string v)
-                                   v)))
+               (denotation/Let. (syms k) (if (string? v)
+                                           (reader/read-string v)
+                                           v)))
         jsd (into clause (for [[k v] (dissoc clause :ml)]
                            [k (syms k)]))
         ]
     (conj sees
-          (merge clause placeholders)
-          (list '- (merge clause placeholders new-bound-syms))
-          (list '+ (merge placeholders clause new-bound-syms jsd)))
+          (denotation/Filter. (merge clause placeholders))
+          (denotation/Retract. (merge clause placeholders new-bound-syms))
+          (denotation/Assert. (merge placeholders clause new-bound-syms jsd)))
     )
   )

@@ -285,16 +283,16 @@
         ui-facts (try
                    (reader/read-string ui)
                    (catch :default e))]
-    [(list '+s (if-not ui-facts
-                 []
-                 `(hiccup ~ui-facts)))]
+    [(denotation/AssertMany. (if-not ui-facts
+                               []
+                               `(hiccup ~ui-facts)))]
     ))

 (defn compile-rule* [r world]
   (mapcat compile-clause (:clauses r)))

 (defn compile-rule [r world]
-  (aurora.language.macros/macroless-rule (vec (compile-rule* r world))))
+  (denotation/clauses->rule (vec (compile-rule* r world))))

 (defn compile-fact [f world]
   (dissoc f :type))
@@ -318,7 +316,7 @@

 (defn inject-compiled []
   (let [comped (compile-state)
-        tick-rules (stratifier/strata->ruleset (:rules comped))
+        tick-rules (stratifier/strata->ruleset (stratifier/stratify (:rules comped)))
         paused? (:paused @cur-env)]
     (pause cur-env)
     (swap! cur-env assoc :tick-rules tick-rules)


Missed some examples

Missed some examples

--- src/aurora/interpreter.cljs
+++ src/aurora/interpreter.cljs
@@ -123,3 +123,5 @@

 (run-example example-c [0])
 (run-example example-c [1])
+(run-example example-c [7])
+(run-example example-c [10])


event => !speakable

event => !speakable

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -67,7 +67,8 @@
    {:edible true}    {:consumable true
                       :drinkable false}

-   {:event true}     {:physical-object false}
+   {:event true}     {:physical-object false
+                      :speakable false}

    {:furniture true} {:artifact true
                       :animate false


add example "study" of inference rule for semantics of verbs

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -179,9 +179,22 @@

    {:pred :student}  {:human true}

+   ;; The following inference rule is not
+   ;; yet used, but intended as a way to integrate
+   ;; verbs into the encyclopedia as we do with nouns.
+   ;; Note the use of {:cat :verb} to distinguish this
+   ;; from ..
+   {:pred :study
+    :cat :verb}  {:activity true
+                  :subj {:human true}
+                  :obj {:legible true}}
+
+   ;; .. the next rule which applies to nouns only.
+   {:pred :study
+    :cat :noun}  {:place true}
+
    {:pred :vino}     {:artifact true
                       :drinkable true}
-
    ;; </preds>

    {:stupid true}    {:animate true}


Upgrade karma to 5.1.0

Upgrade karma to 5.1.0

--- src/deps.cljs
+++ src/deps.cljs
@@ -1,5 +1,5 @@
 {:npm-dev-deps {"shadow-cljs"              "2.10.17"
-                "karma"                    "4.4.1"
+                "karma"                    "5.1.0"
                 "karma-phantomjs-launcher" "1.0.4"
                 "karma-chrome-launcher"    "3.1.0"
                 "karma-cljs-test"          "0.1.0"


Added support for collections of keys to ae-memcache/get and ae-memcache/delete.

--- src/appengine_magic/services/memcache.clj
+++ src/appengine_magic/services/memcache.clj
@@ -31,7 +31,7 @@
                        total-item-bytes])

-(defn stats [& {:keys [service namespace]}]
+(defn statistics [& {:keys [service namespace]}]
   (let [service (get-memcache-service :service service :namespace namespace)
         stats (.getStatistics service)]
     (Statistics. (.getBytesReturnedForHits stats)
@@ -42,7 +42,7 @@
                  (.getTotalItemBytes stats))))

-(defn clear
+(defn clear-all
   "Clears the entire cache. Does not respect namespaces!"
   [& {:keys [service namespace]}]
   (let [service (get-memcache-service :service service :namespace namespace)]
@@ -54,16 +54,26 @@
     (.contains service key)))

-(defn delete [key & {:keys [service namespace millis-no-readd]}]
+(defn delete
+  "If (sequential? key), deletes in batch."
+  [key & {:keys [service namespace millis-no-readd]}]
   (let [service (get-memcache-service :service service :namespace namespace)]
     (if millis-no-readd
-        (.delete service key millis-no-readd)
-        (.delete service key))))
+        (if (sequential? key)
+            (.deletAll service key millis-no-readd)
+            (.delete service key millis-no-readd))
+        (if (sequential? key)
+            (.deleteAll service key)
+            (.delete service key)))))

-(defn get [key & {:keys [service namespace]}]
+(defn get
+  "If (sequential? key), returns values as a map."
+  [key & {:keys [service namespace]}]
   (let [service (get-memcache-service :service service :namespace namespace)]
-    (.get service key)))
+    (if (sequential? key)
+        (into {} (.getAll service key))
+        (.get service key))))

 (defn put [key value & {:keys [service namespace]}]


Reformatted core.clj by zprint

Reformatted core.clj by zprint

--- src/branch_handler/core.clj
+++ src/branch_handler/core.clj
@@ -36,215 +36,225 @@
 (def jenkins-url (System/getenv "JENKINS_URL"))

 (defn read-request-body
-    "Read all informations from the request body."
-    [request]
-    (file-utils/slurp- (:body request)))
+  "Read all informations from the request body."
+  [request]
+  (file-utils/slurp- (:body request)))

 (defn log-request
-    [request]
-    (log/info "Handling request: " (:uri request) (:remote-addr request))
+  [request]
+  (log/info "Handling request: " (:uri request) (:remote-addr request))
+  (if verbose
+    (clojure.pprint/pprint request)))
+
+(defn send-response
+  [response-text]
+  (-> (http-response/response response-text)
+      (http-response/content-type "text/html")))
+
+(defn parse-gitlab-info
+  [request]
+  (let [body (read-request-body request)]
+    (if body
+      (json/read-str body :key-fn clojure.core/keyword))))
+
+(defn repo-workdir
+  [workdir group reponame]
+  (string/join "/" [workdir group reponame]))
+
+(defn repodir-exists?
+  [workdir group reponame]
+  (let [f (new java.io.File (repo-workdir workdir group reponame))]
+    (.isDirectory f)))
+
+(defn fetch-mirror-repo
+  [workdir group reponame repository-url]
+  (log/info "Fetching mirror repository" repository-url)
+  ; TODO test --prune
+  (shell/sh "git" "--git-dir" (repo-workdir workdir group reponame) "fetch"))
+
+(defn clone-mirror-repo
+  [workdir group reponame repository-url]
+  (log/info "Cloning mirror repository" repository-url)
+  (shell/sh "git"
+            "clone"
+            "--mirror"
+            repository-url
+            (repo-workdir workdir group reponame)))
+
+(defn read-branch-list-from-repo
+  [workdir group reponame]
+  (let [repodir (repo-workdir workdir group reponame)]
+    (log/info "Reading branches from repository" repodir)
+    (->> (shell/sh "git"
+                   "--git-dir"
+                   (repo-workdir workdir group reponame)
+                   "branch")
+         :out
+         string/split-lines
+         (map #(subs % 2)))))
+
+(defn clone-or-fetch-mirror-repo
+  [action]
+  (log/info "Cloning or fetching repository")
+  (let [reponame       (:name action)
+        group          (:group action)
+        repository-url (:url action)]
+    (log/info (repo-workdir workdir group reponame))
+    (if (repodir-exists? workdir group reponame)
+      (fetch-mirror-repo workdir group reponame repository-url)
+      (clone-mirror-repo workdir group reponame repository-url))))
+
+(defn start-jenkins-jobs
+  [jenkins-url action]
+  (let [original-data (:original-data action)]
+    (clojure.pprint/pprint original-data)))
+
+(defn filter-branch-jobs
+  [all-jobs prefix]
+  (for [job all-jobs
+        :when (.startsWith (get job "name") prefix)]
+    (get job "name")))
+
+(defn read-jobs-for-branches
+  [jenkins-url job-list-command branch-job-prefix]
+  (-> (jenkins-api/read-list-of-all-jobs jenkins-url job-list-command)
+      (filter-branch-jobs branch-job-prefix)))
+
+(defn parse-job-name
+  [branch-job-prefix job-name]
+  (let [parsed (clojure.string/split job-name #"\+")]
+    (if (= (count parsed) 3)
+      {:name       job-name,
+       :group      (subs (clojure.string/trim (first parsed))
+                         (count branch-job-prefix)),
+       :repository (clojure.string/trim (second parsed)),
+       :branch     (clojure.string/trim (nth parsed 2))})))
+
+(defn parse-job-names
+  [branch-job-prefix job-names]
+  (for [job-name job-names]
+       (parse-job-name branch-job-prefix job-name)))
+
+(defn create-or-delete-jenkins-job
+  [jenkins-url job-list-command branch-job-prefix action]
+  (log/info "Create-or-delete-jenkins-job")
+  (let [reponame       (:name action)
+        group          (:group action)
+        jobs-for-branches (read-jobs-for-branches jenkins-url
+                                                  job-list-command
+                                                  branch-job-prefix)
+        jobs-info      (parse-job-names branch-job-prefix jobs-for-branches)
+        branch-list-in-repo (read-branch-list-from-repo workdir group reponame)]
+    jobs-info))
+
+(defn create-action-queue
+  []
+  (java.util.concurrent.LinkedBlockingQueue.))
+
+(defn action-consumer
+  [actions-queue]
+  (while true
+         (when-let [action (.take actions-queue)] ; blocking operation
+           (log/info "Started action for repository" action)
+           (clone-or-fetch-mirror-repo action)
+           (create-or-delete-jenkins-job jenkins-url
+                                         job-list-command
+                                         branch-job-prefix
+                                         action)
+           (start-jenkins-jobs jenkins-url action)
+           (log/info "Finished action for repository" action))))
+
+(defn start-action-consumer
+  [actions-queue]
+  (log/info "Starting actions consumer")
+  (future                                    ; start consumer in its own thread
+    (action-consumer actions-queue)))
+
+(defn new-action
+  [actions-queue action]
+  (.put actions-queue action))
+
+(def empty-SHA "0000000000000000000000000000000000000000")
+
+(defn get-operation
+  [before after]
+  (if (= before empty-SHA)
+    (if (= after empty-SHA)
+        :unknown
+        :branch-created)
+    (if (= after empty-SHA)
+        :branch-deleted
+        :branch-updated)))
+
+(defn get-branch
+  [git-ref]
+  (try (subs git-ref (inc (.lastIndexOf git-ref "/")))
+       (catch Exception e
+              nil)))
+
+(def actions-queue (create-action-queue))
+
+(defn api-call-handler
+  [request]
+  (let [gitlab-info      (parse-gitlab-info request)
+        repository-url   (-> gitlab-info :repository :url)
+        repository-name  (-> gitlab-info :repository :name)
+        repository-group (-> gitlab-info :project :namespace)
+        branch           (get-branch (-> gitlab-info :ref))
+        before           (-> gitlab-info :before)
+        after            (-> gitlab-info :after)
+        operation        (get-operation before after)]
     (if verbose
-        (clojure.pprint/pprint request)))
-
-(defn send-response
-    [response-text]
-    (-> (http-response/response response-text)
-        (http-response/content-type "text/html")))
-
-(defn parse-gitlab-info
-    [request]
-    (let [body (read-request-body request)]
-        (if body
-            (json/read-str body :key-fn clojure.core/keyword))))
-
-(defn repo-workdir
-    [workdir group reponame]
-    (string/join "/" [workdir group reponame]))
-
-(defn repodir-exists?
-    [workdir group reponame]
-    (let [f (new java.io.File (repo-workdir workdir group reponame))]
-        (.isDirectory f)))
-
-(defn fetch-mirror-repo
-    [workdir group reponame repository-url]
-    (log/info "Fetching mirror repository" repository-url)
-    ; TODO test --prune
-    (shell/sh "git" "--git-dir" (repo-workdir workdir group reponame) "fetch"))
-
-(defn clone-mirror-repo
-    [workdir group reponame repository-url]
-    (log/info "Cloning mirror repository" repository-url)
-    (shell/sh "git" "clone" "--mirror" repository-url (repo-workdir workdir group reponame)))
-
-(defn read-branch-list-from-repo
-    [workdir group reponame]
-    (let [repodir (repo-workdir workdir group reponame)]
-        (log/info "Reading branches from repository" repodir)
-        (->> (shell/sh "git" "--git-dir" (repo-workdir workdir group reponame) "branch")
-             :out
-             string/split-lines
-             (map #(subs % 2)))))
-
-(defn clone-or-fetch-mirror-repo
-    [action]
-    (log/info "Cloning or fetching repository")
-    (let [reponame       (:name action)
-          group          (:group action)
-          repository-url (:url action)]
-          (log/info (repo-workdir workdir group reponame))
-          (if (repodir-exists? workdir group reponame)
-              (fetch-mirror-repo workdir group reponame repository-url)
-              (clone-mirror-repo workdir group reponame repository-url))))
-
-(defn start-jenkins-jobs
-    [jenkins-url action]
-    (let [original-data (:original-data action)]
-        (clojure.pprint/pprint original-data)
-        )
-)
-
-(defn filter-branch-jobs
-    [all-jobs prefix]
-    (for [job all-jobs :when (.startsWith (get job "name") prefix)]
-        (get job "name")))
-
-(defn read-jobs-for-branches
-    [jenkins-url job-list-command branch-job-prefix]
-    (-> (jenkins-api/read-list-of-all-jobs jenkins-url job-list-command)
-        (filter-branch-jobs branch-job-prefix)))
-
-(defn parse-job-name
-    [branch-job-prefix job-name]
-    (let [parsed (clojure.string/split job-name #"\+")]
-         (if (= (count parsed) 3)
-            {:name       job-name
-             :group      (subs (clojure.string/trim (first parsed)) (count branch-job-prefix))
-             :repository (clojure.string/trim (second parsed))
-             :branch     (clojure.string/trim (nth parsed 2))
-            })))
-
-(defn parse-job-names
-    [branch-job-prefix job-names]
-    (for [job-name job-names]
-        (parse-job-name branch-job-prefix job-name)))
-
-(defn create-or-delete-jenkins-job
-    [jenkins-url job-list-command branch-job-prefix action]
-    (log/info "Create-or-delete-jenkins-job")
-    (let [reponame       (:name action)
-          group          (:group action)
-          jobs-for-branches   (read-jobs-for-branches jenkins-url job-list-command branch-job-prefix)
-          jobs-info      (parse-job-names branch-job-prefix jobs-for-branches)
-          branch-list-in-repo (read-branch-list-from-repo workdir group reponame)]
-          jobs-info))
-
-(defn create-action-queue
-    []
-    (java.util.concurrent.LinkedBlockingQueue.))
-
-(defn action-consumer
-    [actions-queue]
-    (while true
-        (when-let [action (.take actions-queue)] ; blocking operation
-            (log/info "Started action for repository" action)
-            (clone-or-fetch-mirror-repo action)
-            (create-or-delete-jenkins-job jenkins-url job-list-command branch-job-prefix action)
-            (start-jenkins-jobs jenkins-url action)
-            (log/info "Finished action for repository" action)
-        )))
-
-(defn start-action-consumer
-    [actions-queue]
-    (log/info "Starting actions consumer")
-    (future                                    ; start consumer in its own thread
-        (action-consumer actions-queue)))
-
-(defn new-action
-    [actions-queue action]
-    (.put actions-queue action))
-
-(def empty-SHA "0000000000000000000000000000000000000000")
-
-(defn get-operation
-    [before after]
-    (if (= before empty-SHA)
-        (if (= after empty-SHA)
-            :unknown
-            :branch-created)
-        (if (= after empty-SHA)
-            :branch-deleted
-            :branch-updated)))
-
-(defn get-branch
-    [git-ref]
-    (try
-        (subs git-ref (inc (.lastIndexOf git-ref "/")))
-        (catch Exception e
-            nil)))
-
-(def actions-queue (create-action-queue))
-
-(defn api-call-handler
-    [request]
-    (let [gitlab-info      (parse-gitlab-info request)
-          repository-url   (-> gitlab-info :repository :url)
-          repository-name  (-> gitlab-info :repository :name)
-          repository-group (-> gitlab-info :project :namespace)
-          branch           (get-branch (-> gitlab-info :ref))
-          before           (-> gitlab-info :before)
-          after            (-> gitlab-info :after)
-          operation        (get-operation before after)]
-        (if verbose
-            (clojure.pprint/pprint gitlab-info))
-        (log/info "repository" repository-name)
-        (log/info "URL"        repository-url)
-        (log/info "group"      repository-group)
-        (log/info "branch"     branch)
-        (log/info "before"     before)
-        (log/info "after"      after)
-        (log/info "operation"  operation)
-        (if (contains? #{:branch-created :branch-deleted :branch-updated} operation)
-            (let [action {:action :clone-or-fetch-repository
-                          :name  repository-name
-                          :group repository-group
-                          :url   repository-url
-                          :original-data gitlab-info}]
-                 (new-action actions-queue action))) ; add new action into the queue that will serialize it
-        ))
+      (clojure.pprint/pprint gitlab-info))
+    (log/info "repository" repository-name)
+    (log/info "URL"        repository-url)
+    (log/info "group"      repository-group)
+    (log/info "branch"     branch)
+    (log/info "before"     before)
+    (log/info "after"      after)
+    (log/info "operation"  operation)
+    (if (contains? #{:branch-created :branch-deleted :branch-updated} operation)
+      (let [action {:action :clone-or-fetch-repository,
+                    :name    repository-name,
+                    :group   repository-group,
+                    :url     repository-url,
+                    :original-data gitlab-info}]
+        (new-action actions-queue action))) ; add new action into the queue that
+                                            ; will serialize it
+  ))

 (defn http-request-handler
-    "Handler that is called by Ring for all requests received from user(s)."
-    [request]
-    (log-request request)
-    (if (= [:post "/"] [(:request-method request) (:uri request)])
-        (api-call-handler request))
-    (send-response ""))
+  "Handler that is called by Ring for all requests received from user(s)."
+  [request]
+  (log-request request)
+  (if (= [:post "/"] [(:request-method request) (:uri request)])
+    (api-call-handler request))
+  (send-response ""))

 (def ring-app
-    "Definition of a Ring-based application behaviour."
-    (-> http-request-handler      ; handle all events
-        http-params/wrap-params)) ; and process request parameters, of course
+  "Definition of a Ring-based application behaviour."
+  (-> http-request-handler      ; handle all events
+      http-params/wrap-params)) ; and process request parameters, of course

 (defn start-server
-    "Start the service on regular machine."
-    [ring-app port]
-    (log/info "Starting the server at the port: " port)
-    (jetty/run-jetty ring-app {:port port}))
+  "Start the service on regular machine."
+  [ring-app port]
+  (log/info "Starting the server at the port: " port)
+  (jetty/run-jetty ring-app {:port port}))

 (defn create-workdir
-    [workdir]
-    (let [directory (new java.io.File workdir)]
-        (when (not (.isDirectory directory))
-              (log/info "Creating work directory" (.getAbsolutePath directory))
-              (.mkdir directory))))
+  [workdir]
+  (let [directory (new java.io.File workdir)]
+    (when (not (.isDirectory directory))
+      (log/info "Creating work directory" (.getAbsolutePath directory))
+      (.mkdir directory))))

 (defn -main
-    "Entry point to the branch handler service server."
-    [& args]
-    (log/info "Started app on port" port)
-    (log/info "JENKINS_URL is set to" jenkins-url)
-    (create-workdir workdir)
-    (start-action-consumer actions-queue)
-    (start-server ring-app port))
-
+  "Entry point to the branch handler service server."
+  [& args]
+  (log/info "Started app on port" port)
+  (log/info "JENKINS_URL is set to" jenkins-url)
+  (create-workdir workdir)
+  (start-action-consumer actions-queue)
+  (start-server ring-app port))
+


Emit text with windows newlines

Emit text with windows newlines

--- src/catalog/layout/text.clj
+++ src/catalog/layout/text.clj
@@ -10,16 +10,19 @@
              [walk :as walk]]
             [endophile.core :as endophile]))

+(def ^:private newline "\r\n")
+(def ^:private double-newline (str newline newline))
+
 (defmulti to-text (fn [{:keys [tag attrs content]}] tag))

 (defmethod to-text :a [{content :content {href :href} :attrs}]
   (if (not-empty content) content href))
-(defmethod to-text :h1 [{content :content}] (str  content "\n\n"))
-(defmethod to-text :h2 [{content :content}] (str  content "\n\n"))
-(defmethod to-text :h3 [{content :content}] (str  content "\n\n"))
+(defmethod to-text :h1 [{content :content}] (str content double-newline))
+(defmethod to-text :h2 [{content :content}] (str  content double-newline))
+(defmethod to-text :h3 [{content :content}] (str  content double-newline))
 (defmethod to-text :ul [{content :content}] [:list {:type "ul"} content])
 (defmethod to-text :li [{content :content}] [:li content])
-(defmethod to-text :br [_] "\n")
+(defmethod to-text :br [_] newline)
 (defmethod to-text :default [{content :content}] content) ; just assume :p

 (defn- node? [node]
@@ -42,7 +45,7 @@

 (defn wrap-line [text]
   ;; see http://rosettacode.org/wiki/Word_wrap#Clojure
-  (string/join "\n" (re-seq (re-pattern (str ".{1," line-length "}(?:\\s|\\z)")) text)))
+  (string/join newline (re-seq (re-pattern (str ".{1," line-length "}(?:\\s|\\z)")) text)))

 (defn- entry-heading-str
   [{:keys [creator title subtitles name-of-part source-publisher source-date]}]
@@ -92,7 +95,7 @@
 (defn- join [& more]
   (->> more
    (remove empty-or-blank?)
-   (string/join "\n")))
+   (string/join newline)))

 (defmethod entry-str :braille
   [{:keys [creator title subtitles name-of-part source-publisher
@@ -194,15 +197,16 @@
 (defn- level-str [items path path-to-numbers]
   (str
    (when-let [section-title (last path)]
-     (format "%s%s\n\n"
+     (format "%s%s%s"
              (layout/section-numbers (get path-to-numbers path))
-             (layout/translations section-title "FIXME")))
+             (layout/translations section-title "FIXME")
+             double-newline))
    (cond
      ;; handle the special case where the editorial or the recommendations are passed in the tree
      (#{:editorial :recommendation} (last path)) (md-to-text items)
      ;; handle a list of entries
-     (sequential? items) (string/join "\n\n" (map entry-str items))
-     :else (string/join "\n\n" (map #(level-str (get items %) (conj path %) path-to-numbers) (keys items))))))
+     (sequential? items) (string/join double-newline (map entry-str items))
+     :else (string/join double-newline (map #(level-str (get items %) (conj path %) path-to-numbers) (keys items))))))

 (defn- standard-catalog?
   "If `items` is a map, i.e. are grouped by genre, then we assume that
@@ -216,7 +220,7 @@
 (defn- impressum []
   (let [creator (layout/translations :sbs)]
     (string/join
-     "\n"
+     newline
      ["Herausgeber:"
       creator
       "Grubenstrasse 12"
@@ -235,7 +239,7 @@
                 (not (string/blank? recommendation)) (assoc :recommendation recommendation))
         path-to-numbers (layout/path-to-number items)]
     (string/join
-     "\n\n"
+     double-newline
      (concat
       [title
        (format "%s-%s" year issue)
@@ -249,7 +253,7 @@
   (let [title (layout/translations :catalog-custom)
         date (time.core/now)
         path-to-numbers (layout/path-to-number items)]
-    (string/join "\n\n"
+    (string/join double-newline
      [title
       (format "Stand %s" (time.format/unparse date-formatter date))
       query


Fix non-array return values.

Fix non-array return values.

--- src/cavm/views/datasets.clj
+++ src/cavm/views/datasets.clj
@@ -119,4 +119,4 @@
 ; XXX The call to read-symbols needs a list of sources, I think.
 (defpage [:get ["/data/:expression" :expression #".+"]] {:keys [expression]}
   (h2/with-db (:db (ring-request))
-    (response/json (map vec (expr/expression expression f/functions functions)))))
+    (response/json (expr/expression expression f/functions functions))))


Add utilities to build urls in the http ns

--- src/cider_ci/utils/http.clj
+++ src/cider_ci/utils/http.clj
@@ -2,6 +2,7 @@
   (:refer-clojure
     :exclude [get])
   (:require
+    [cider-ci.utils.debug :as debug]
     [cider-ci.utils.with :as with]
     [clj-http.client :as http-client]
     [clj-logging-config.log4j :as logging-config]
@@ -9,11 +10,37 @@
     [ring.middleware.basic-authentication :refer [wrap-basic-authentication]]
     ))

-;(logging-config/set-logger! :level :debug)
-;(logging-config/set-logger! :level :info)
-

 (defonce conf (atom nil))
+
+;### build url ##################################################################
+
+(defn sanitize-query-params [params]
+  (into {} (sort (for [[k v] params]
+                   [(-> k name clojure.string/trim
+                        clojure.string/lower-case
+                        (clojure.string/replace " " "-")
+                        (clojure.string/replace "_" "-")
+                        (clojure.string/replace #"-+" "-")
+                        keyword)
+                    v]))))
+
+(defn build-url-query-string [params]
+  (-> params sanitize-query-params
+      http-client/generate-query-string))
+
+(defn build-url
+
+  ([config path]
+   (let [ protocol (if (or (:server_ssl config) (:ssl config)) "https" "http")
+         host (or (:server_host config) (:host config))
+         port (or (:server_port config) (:port config))
+         context (:context config) ]
+     (str protocol "://" host (when port (str ":" port)) context path)))
+
+  ([config path query-params]
+   (str (build-url config path)
+        "?" (build-url-query-string query-params))))

 ;### Http request #############################################################
@@ -66,9 +93,13 @@

 ;### Initialize ###############################################################

-
 (defn initialize [new-conf]
   (reset! conf new-conf))

+;### Debug ####################################################################
+;(debug/debug-ns *ns*)
+;(logging-config/set-logger! :level :debug)
+;(logging-config/set-logger! :level :info)

+


Maybe make tests not fail randomly as often

--- test/metabase/permissions_collection_test.clj
+++ test/metabase/permissions_collection_test.clj
@@ -55,7 +55,9 @@
     (println "[In the occasionally failing test]") ; DEBUG
     (set-card-collection! collection)
     (permissions/grant-collection-read-permissions! (group/all-users) collection)
-    (can-run-query? :rasta)))
+    ;; try it twice because sometimes it randomly fails :unamused:
+    (or (can-run-query? :rasta)
+        (can-run-query? :rasta))))

 ;; Make sure a User isn't allowed to save a Card they have collections readwrite permissions for
 ;; if they don't have data perms for the query


(PDB-2775) admin-clean-test: disable gc completely

stop-and-reset-pool! doesn't actually wait for any tasks that are
already running to finish.  So (even better) just start the pdb test
instances with gc disabled.

This should fix some intermittent admin-clean-test failures which were
caused by unexpected, interleaved garbage collections.

--- test/puppetlabs/puppetdb/admin_clean_test.clj
+++ test/puppetlabs/puppetdb/admin_clean_test.clj
@@ -5,17 +5,28 @@
             [metrics.counters :as counters]
             [metrics.gauges :as gauges]
             [metrics.timers :as timers]
-            [overtone.at-at :as at-at]
             [puppetlabs.puppetdb.cheshire :as json]
             [puppetlabs.puppetdb.cli.services :as cli-svc]
             [puppetlabs.puppetdb.http :as http]
+            [puppetlabs.puppetdb.testutils.db :refer [*db* with-test-db]]
             [puppetlabs.puppetdb.testutils.services :as svc-utils
-             :refer [*server* with-single-quiet-pdb-instance]]
+             :refer [*server*
+                     call-with-single-quiet-pdb-instance
+                     with-single-quiet-pdb-instance]]
             [puppetlabs.puppetdb.utils :as utils]
             [puppetlabs.trapperkeeper.app :refer [get-service]]
             [puppetlabs.trapperkeeper.services :refer [service-context]])
   (:import
    [java.util.concurrent CyclicBarrier]))
+
+(defmacro with-pdb-with-no-gc [& body]
+  `(with-test-db
+     (call-with-single-quiet-pdb-instance
+      (-> (svc-utils/create-temp-config)
+          (assoc :database *db*)
+          (assoc-in [:database :gc-interval] 0))
+      (fn []
+        ~@body))))

 (defn- post-admin [path form]
   (http-client/post (str (utils/base-url->str (svc-utils/pdb-admin-url))
@@ -51,10 +62,8 @@
          (.await ~test-finished)))))

 (deftest admin-clean-basic
-  (with-single-quiet-pdb-instance
+  (with-pdb-with-no-gc
     (let [pdb (get-service *server* :PuppetDBServer)]
-      ;; Stop intermittent cleaning so it can't interfere
-      (at-at/stop-and-reset-pool! (:job-pool (service-context pdb)))
       (is (= http/status-ok (:status (post-clean []))))
       (is (= http/status-ok (:status (post-clean ["expire_nodes"]))))
       (is (= http/status-ok (:status (post-clean ["purge_nodes"]))))
@@ -63,13 +72,11 @@
       (is (= http/status-bad-request (:status (post-clean ["?"])))))))

 (deftest admin-clean-competition
-  (with-single-quiet-pdb-instance
+  (with-pdb-with-no-gc
     (let [pdb (get-service *server* :PuppetDBServer)
           orig-clean cli-svc/clean-up
           in-clean (CyclicBarrier. 2)
           test-finished (CyclicBarrier. 2)]
-      ;; Stop intermittent cleaning so it can't interfere
-      (at-at/stop-and-reset-pool! (:job-pool (service-context pdb)))
       (with-redefs [cli-svc/clean-up (fn [& args]
                                        (.await in-clean)
                                        (.await test-finished)
@@ -81,15 +88,13 @@
   (gauges/value (:cleaning cli-svc/admin-metrics)))

 (deftest admin-clean-status
-  (with-single-quiet-pdb-instance
+  (with-pdb-with-no-gc
     (let [pdb (get-service *server* :PuppetDBServer)
           clean-serializer (Object.)  ; Ensures previous iteration has unlocked
           orig-clean @#'cli-svc/clean-puppetdb
           orig-finish @#'cli-svc/finishing-clean-up
           in-clean (CyclicBarrier. 2)
           test-finished (CyclicBarrier. 2)]
-      ;; Stop intermittent cleaning so it can't interfere
-      (at-at/stop-and-reset-pool! (:job-pool (service-context pdb)))
       (with-redefs [cli-svc/clean-puppetdb #(locking clean-serializer
                                               (apply orig-clean %&))
                     cli-svc/finishing-clean-up (fn [& args]
@@ -128,10 +133,8 @@
            (:other-clean-time cli-svc/admin-metrics))})

 (defn- check-counts [get-counts]
-  (with-single-quiet-pdb-instance
+  (with-pdb-with-no-gc
     (let [pdb (get-service *server* :PuppetDBServer)]
-      ;; Stop intermittent cleaning so it can't interfere
-      (at-at/stop-and-reset-pool! (:job-pool (service-context pdb)))
       (doseq [requested (combinations ["expire_nodes" "purge_nodes"
                                        "purge_reports"
                                        "other"]


(PDB-5336) Create migration 75 schema diff test

Add schema diff test to the existing migration 75 test which adds the
report_type column to the partitioned reports table.

--- test/puppetlabs/puppetdb/scf/migrate_test.clj
+++ test/puppetlabs/puppetdb/scf/migrate_test.clj
@@ -1410,12 +1410,53 @@
         (is (= expected
                (first hashes)))))))

+(def migration-75-expected-diff
+  "Table partitions for reports are created for a range of dates automatically
+  in migration 74 so we must programmatically create the expected diff based on
+  the current date and the aforementioned range."
+  (let [generic-table-diff {:left-only nil,
+                            :right-only
+                            {:numeric_scale nil,
+                             :column_default "'agent'::text",
+                             :character_octet_length 1073741824,
+                             :datetime_precision nil,
+                             :nullable? "NO",
+                             :character_maximum_length nil,
+                             :numeric_precision nil,
+                             :numeric_precision_radix nil,
+                             :data_type "text",
+                             :column_name "report_type"},
+                            :same nil}
+        generic-constraint-diff {:left-only nil,
+                                 :right-only
+                                 {:constraint_name "report_type IS NOT NULL",
+                                  :constraint_type "CHECK",
+                                  :initially_deferred "NO",
+                                  :deferrable? "NO"},
+                                 :same nil}
+        table-names (->> (range -4 4)
+                         (map #(.plusDays (ZonedDateTime/now) %))
+                         (map part/date-suffix)
+                         ;; Postgres automatically lowercases trailing "Z"
+                         (map str/lower-case)
+                         (map #(str "reports_" %))
+                         ;; Add the main reports table to the front of the list
+                         (cons "reports"))]
+    {:index-diff nil
+     :table-diff
+     (map #(assoc-in generic-table-diff [:right-only :table_name] %)
+          table-names)
+     :constraint-diff
+     (map #(assoc-in generic-constraint-diff [:right-only :table_name] %)
+          table-names)}))
+
 (deftest migration-75-add-report-type-column-with-default
   (testing "reports should get default value of 'agent' for report_type"
     (jdbc/with-db-connection *db*
       (clear-db-for-testing!)
       (fast-forward-to-migration! 74)
-      (let [current-time (to-timestamp (now))]
+      (let [current-time (to-timestamp (now))
+            before-migration (schema-info-map *db*)]
         (jdbc/insert! :report_statuses {:status "testing1" :id 1})
         (jdbc/insert! :environments {:id 0 :environment "testing"})
         (jdbc/insert! :certnames {:certname "testing1"})
@@ -1437,7 +1478,9 @@
                        :logs (sutils/munge-json-for-storage [{:bar "baz"}])})
         (apply-migration-for-testing! 75)
         (is (= "agent" (-> (query-to-vec "select * from reports")
-                           first :report_type)))))))
+                           first :report_type)))
+        (is (= migration-75-expected-diff
+               (diff-schema-maps before-migration (schema-info-map *db*))))))))

 (deftest migration-76-adds-report-id-idx-when-not-added-by-migration-74
   (testing "All report paritions have idx_reports_id index when old version of 74 applied"


Remove timeout that does nothing every second

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -238,10 +238,7 @@
            nav-tap ([v] (nav-handler v state history-imp))
            api-tap ([v] (api-handler v state container))
            ws-tap ([v] (ws-handler v state pusher-imp))
-           errors-tap ([v] (errors-handler v state container))
-           ;; Capture the current history for playback in the absence
-           ;; of a server to store it
-           (async/timeout 10000) (do #_(print "TODO: print out history: ")))))))
+           errors-tap ([v] (errors-handler v state container)))))))

 (defn subscribe-to-user-channel [user ws-ch]
   (put! ws-ch [:subscribe {:channel-name (pusher/user-channel user)


matcher-combinators: Expand `predicate-test`

--- test/com/nomistech/clojure_the_language/c_800_libraries/s_106_matcher_combinators/matcher_generators_test.clj
+++ test/com/nomistech/clojure_the_language/c_800_libraries/s_106_matcher_combinators/matcher_generators_test.clj
@@ -34,8 +34,13 @@
               "The quick brown fox jumps over the lazy dog")))

 (deftest predicate-test
+  ;; Functions are used as predicates.
   (is (match? even?
               1234))
+  (is (match? not
+              (= 1 2)))
+  (is (match? inc ; not normally considered a predicate, but used as one here
+              1))
   (is (match? (m/pred even?)
               1234)) ; TODO: I guess we need this in contexts where `even?` would not be treated as a pred -- but what are those contexts?
   )


PCP-157 add connection-associated unit test

--- test/unit/puppetlabs/pcp/broker/core_test.clj
+++ test/unit/puppetlabs/pcp/broker/core_test.clj
@@ -325,6 +325,17 @@
       (connection-open broker capsule connection)
       (is (not= nil @associate-request)))))

+(deftest connection-associated-test
+  (let [broker (make-test-broker)
+        message (message/make-message :message_type "http://puppetlabs.com/associate_request")
+        capsule (capsule/wrap message)
+        connection (connection/make-connection "ws1")
+        accepted (atom nil)]
+    (with-redefs [puppetlabs.pcp.broker.core/accept-message-for-delivery (fn [broker capsule]
+                                                                           (reset! accepted capsule))]
+      (connection-associated broker capsule connection)
+      (is (not= nil @accepted)))))
+
 (deftest determine-next-state-test
   (testing "illegal next states raise due to schema validation"
     (let [broker (make-test-broker)


fix many-files

fix many-files

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1085,7 +1085,7 @@

 (def text-reader-schema
   {:many-files {:docstr "Hints that the filepattern specified matches a very large number of files."
-                :action (fn [transform] (.withHintMatchesManyFiles transform))}
+                :action (fn [transform _] (.withHintMatchesManyFiles transform))}
    :empty-match-treatment {:docstr "Options for allowing or disallowing filepatterns that match no resources"
                            :enum empty-match-treatment-enum
                            :action (select-enum-option-fn


Remove ANSI escape codes

Remove ANSI escape codes

--- src/clj/nightcode/utils.clj
+++ src/clj/nightcode/utils.clj
@@ -107,7 +107,9 @@
       .toURI))

 (defn remove-returns [^String s]
-  (str/escape s {\return ""}))
+  (-> s
+      (str/escape {\return ""})
+      (str/replace #"\u001b[^\n]*" "")))

 (defn get-boot-path []
   (let [windows? (.startsWith (System/getProperty "os.name") "Windows")


cleanup

cleanup

--- src/clj/scraper/threads.clj
+++ src/clj/scraper/threads.clj
@@ -90,20 +90,6 @@
     nil
     (get reply-levels (dec indent-level))))

-(defn combine-users
-  [thread-data user bulb-users]
-  (let [users (:users thread-data)]
-    (-> users
-        (into (list user))
-        (into bulb-users)
-        (distinct))))
-
-(defn update-thread-data
-  [thread-data replies users]
-  (-> thread-data
-      (assoc :replies replies)
-      (assoc :users   users)))
-
 (defn rm-nil-bulb
   [reply]
   (if (nil? (:bulbs reply))
@@ -122,20 +108,41 @@
       (rm-nil-bulb)
       (rm-nil-parent-id)))

+(defn combine-users
+  [thread-data user bulb-users]
+  (let [users (:users thread-data)]
+    (-> users
+        (into (list user))
+        (into bulb-users)
+        (distinct))))
+
+(defn combine-replies
+  [thread-data reply]
+  (->> reply
+       (rm-nil-keys)
+       (list)
+       (into (:replies thread-data))))
+
+(defn update-thread-data
+  [thread-data replies users]
+  (-> thread-data
+      (assoc :replies replies)
+      (assoc :users   users)))
+
 (defn get-data-helper
   [rows reply-parents thread-data]
   (when (first rows)
-    (let [row            (first                 rows)
-          cols           (utils/get-cols        row)
-          reply-url      (get-reply-url         cols)
-          reply-id       (get-reply-id          reply-url)
-          reply-title    (get-reply-title       cols)
-          post-time      (get-reply-post-time   cols)
-          bulbs          (bulbs/get-data        reply-url)
-          user-url       (utils/get-user-url    cols)
-          user-id        (utils/get-user-id     user-url)
-          username       (utils/get-username    cols)
-          indent-level   (get-indent-level      cols)
+    (let [row            (first                rows)
+          cols           (utils/get-cols       row)
+          reply-url      (get-reply-url        cols)
+          reply-id       (get-reply-id         reply-url)
+          reply-title    (get-reply-title      cols)
+          post-time      (get-reply-post-time  cols)
+          bulbs          (bulbs/get-data       reply-url)
+          user-url       (utils/get-user-url   cols)
+          user-id        (utils/get-user-id    user-url)
+          username       (utils/get-username   cols)
+          indent-level   (get-indent-level     cols)
           reply-parents  (assoc reply-parents indent-level reply-id)
           parent-id      (get-parent-id indent-level reply-parents)
           user           {:id         user-id
@@ -150,25 +157,23 @@
                           :post-time  post-time
                           :user-id    user-id
                           :bulbs      bulbs}
-          replies        (into (:replies thread-data) (list (rm-nil-keys reply)))
+          replies        (combine-replies thread-data reply)
           users          (combine-users thread-data user bulb-users)
           thread-data    (update-thread-data thread-data replies users)]
       (merge thread-data (get-data-helper (rest rows) reply-parents thread-data)))))

 (defn get-data-by-url
   [url]
-  (web/set-driver! {:browser           :firefox
-                    :profile           bo-ffprofile})
+  (web/set-driver!  {:browser            :firefox
+                     :profile            bo-ffprofile})
   (let [table        (get-replies-table  url)
         rows         (utils/get-rows     table)
         thread-id    (get-thread-id      url)
         thread-data  (get-data-helper rows [] {:replies '() :users '()})
         replies      (reverse (:replies thread-data))
         users        (:users   thread-data)
-        data         {:thread {
-                        :id       thread-id
-                        :replies  (map :id replies)
-                      }
+        data         {:thread {:id       thread-id
+                               :replies  (map :id replies)}
                       :replies replies
                       :users   users}]
     (web/close)


fix rollcage component

fix rollcage component

--- src/clj/tictag/rollcage.clj
+++ src/clj/tictag/rollcage.clj
@@ -5,10 +5,11 @@
 (defrecord RollcageClient [token environment]
   component/Lifecycle
   (start [component]
-    (when (and environment token)
+    (if (and environment token)
       (let [client (rollcage/client token {:environment environment})]
         (rollcage/setup-uncaught-exception-handler client)
-        (assoc component :client client))))
+        (assoc component :client client))
+      component))
   (stop [component]
-    {}))
+    component))


log in using cookie if present

log in using cookie if present

--- src/cljs/tictag/events.cljs
+++ src/cljs/tictag/events.cljs
@@ -1,6 +1,6 @@
 (ns tictag.events
   (:require [cljs.tools.reader.edn :as edn]
-            [re-frame.core :refer [reg-event-fx reg-event-db reg-fx]]
+            [re-frame.core :refer [reg-event-fx reg-event-db reg-fx reg-cofx inject-cofx]]
             [taoensso.timbre :as timbre]
             [ajax.core :refer [transit-response-format transit-request-format]]
             [tictag.nav :as nav]
@@ -129,17 +129,29 @@
    (doseq [[k v] kv]
      (.set goog.net.cookies (name k) v))))

+(reg-cofx
+ :cookie
+ (fn [coeffects key]
+   (assoc-in coeffects
+             [:cookies key]
+             (.get goog.net.cookies (name key)))))
+
 (reg-event-fx
  :initialize
- (fn [_ _]
-   {:pushy-init true
-    :http-xhrio {:method          :get
-                 :uri             "/api/timezones"
-                 :timeout         8000
-                 :format          (transit-request-format {})
-                 :response-format (transit-response-format {})
-                 :on-success      [:success-timezones]
-                 :on-failure      [:failed-timezones]}}))
+ [(inject-cofx :cookie :auth-token)]
+ (fn [{:keys [cookies]} _]
+   (let [result {:pushy-init     true
+                 :http-xhrio     {:method          :get
+                                  :uri             "/api/timezones"
+                                  :timeout         8000
+                                  :format          (transit-request-format {})
+                                  :response-format (transit-response-format {})
+                                  :on-success      [:success-timezones]
+                                  :on-failure      [:failed-timezones]}
+                 :db             {:auth-token (:auth-token cookies)}}]
+     (if-let [token (:auth-token cookies)]
+       (assoc result :dispatch-later [{:dispatch [:fetch-pings] :ms 100} {:dispatch [:fetch-user-info] :ms 100}])
+       result))))

 (reg-event-db
  :success-timezones


game and ai separation

game and ai separation

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -150,16 +150,15 @@
 ;; -----------------------------------------

 (defn new-game []
-  (let [board (board/new-board)]
-    (-> {:board board
-         :player (rand-nth cst/players)
-         :moves {}
-         :help false
-         :scores
-         {:blue cst/init-block-count
-          :red cst/init-block-count
-          :green cst/init-block-count}}
-      with-available-moves)))
+  (-> {:board (board/new-board)
+       :player (rand-nth cst/players)
+       :moves {}
+       :help false
+       :scores
+       {:blue cst/init-block-count
+        :red cst/init-block-count
+        :green cst/init-block-count}}
+    with-available-moves))

 (defonce app-state
   (atom {:games (list (with-ai-data (new-game)))
@@ -190,7 +189,7 @@
         move (ai-algo @game @current-player)]
     (update-game! play-move move)))

-(defn cancel-last-move
+(defn cancel-last-move ;; TODO - It needs the ai: how to move it in the game?
   [old-turns]
   (let [ai-turn? #(contains? (:ai-players %) (:player %))
         new-turns (drop-while ai-turn? (drop 1 old-turns))]


Added new reducer.

Added new reducer.

Also, fixed issue with all jars being returned instead of only jars that
matched the required criteria.

--- src/cmr/plugin/jar/core.clj
+++ src/cmr/plugin/jar/core.clj
@@ -7,11 +7,15 @@
   (java.util.jar JarFile)
   (java.util.jar Attributes$Name)))

-(defn named-jars
+(defn tagged-jars
   "Generate a collection of `JarFile` maps, each with a `:file` and `:object`
   key for easy readability and use."
-  [jarfiles]
-  (mapv #(hash-map :file (jarfile/name %) :object %) jarfiles))
+  [jarfiles plugin-name plugin-type]
+  (mapv #(hash-map :file (jarfile/name %)
+                   :plugin-name (first (jarfile/matched-manifest-keys % plugin-name))
+                   :plugin-type (first (jarfile/matched-manifest-values % plugin-name plugin-type))
+                   :object %)
+        jarfiles))

 (defn no-manifest-reducer
   "This reducer will generate a collection of JAR files that have no MANIFEST file.
@@ -32,29 +36,40 @@
 (defn create-has-plugin-name-reducer
   "This creates a reducer that will generate a collection of JAR files that
   have a MANIFEST file and that also have a key in the MANIFEST file which
-  exactly matches the given pluging name."
-  [plugin-name]
+  exactly matches the given plugin name."
+  [plugin-name _]
   (fn [acc ^JarFile jar]
     (conj acc
-          (when (jarfile/manifest-has-key? jar plugin-name))
-            jar)))
+          (when (jarfile/manifest-has-key? jar plugin-name)
+            jar))))
+
+(defn create-has-plugin-type-reducer
+  "This creates a reducer that will generate a collection of JAR files that
+  have a MANIFEST file and that also have a key in the MANIFEST file which
+  exactly matches both the given plugin name as well as the plugin type."
+  [plugin-name plugin-type]
+  (fn [acc ^JarFile jar]
+    (conj acc
+          (when (jarfile/manifest-has-value? jar plugin-name plugin-type)
+            jar))))

 (defn create-regex-plugin-name-reducer
   "This creates a reducer that will generate a collection of JAR files that
   have a MANIFEST file and that also have a key in the MANIFEST file which
-  exactly matches the given pluging name."
-  [plugin-name]
+  matches the given plugin name (possibly a regular expression)."
+  [plugin-name _]
   (fn [acc ^JarFile jar]
     (conj acc
-          (when (jarfile/matches-manifest-key? jar plugin-name))
-            jar)))
+          (when (jarfile/matches-manifest-key? jar plugin-name)
+            jar))))

 (defn create-regex-plugin-type-reducer
   "This creates a reducer that will generate a collection of JAR files that
   have a MANIFEST file and that:
   1) have a key in the MANIFEST file which exactly matches the given plugin
      name, and
-  2) have a value for the plugin key that matches the configured plugin type."
+  2) have a value for the plugin key that matches the configured plugin type,
+     where the plugin type is possibly a regular expression."
   [plugin-name plugin-type]
   (fn [acc ^JarFile jar]
     (conj acc
@@ -87,8 +102,8 @@
   "Given a plugin name (MANIFEST file entry), plugin type (the MANIFEST file
   entry's value), and a reducer-factory function, return all the JAR files
   that are accumulated by the redcuer."
-  [^String plugin-name ^String plugin-type reducer]
+  [^String plugin-name ^String plugin-type reducer-factory]
   (->> (jarfile/all-jars)
-       (reduce (reducer plugin-name plugin-type)
+       (reduce (reducer-factory plugin-name plugin-type)
                [])
        (remove nil?)))


Fix regex replace issue

Fix regex replace issue

--- src/clj/org/openforis/ceo/db/projects.clj
+++ src/clj/org/openforis/ceo/db/projects.clj
@@ -367,8 +367,8 @@
                     (mapv #(-> %
                                (str/upper-case)
                                (str/replace #"-| " "_")
-                               (str/replace #"X|LONGITUDE|LONG|CENTER_X" "LON")
-                               (str/replace #"Y|LATITUDE|CENTER_Y" "LAT"))
+                               (str/replace #"^(X|LONGITUDE|LONG|CENTER_X)$" "LON")
+                               (str/replace #"^(Y|LATITUDE|CENTER_Y)$" "LAT"))
                           hr))]
       [headers (type-columns headers) (str/replace body #"," "\t")])))


mapping services to the host network

mapping services to the host network

#444

--- src/clj/swarmpit/docker/engine/client.clj
+++ src/clj/swarmpit/docker/engine/client.clj
@@ -333,6 +333,12 @@
                 :api    "/version"})
       :body))

+(defn swarm
+  []
+  (-> (execute {:method :GET
+                :api    "/swarm"})
+      :body))
+
 ;; Images

 (defn image


add class to hr

add class to hr

--- src/cljs/salava/badge/ui/endorsement.cljs
+++ src/cljs/salava/badge/ui/endorsement.cljs
@@ -266,7 +266,7 @@

   (fn []
     [:div {:style {:display @(cursor state [:show-content])}}
-     [:hr]
+     [:hr.border]
      [:div.row
       [:div.col-xs-12 {:style {:margin-bottom "10px"}} [:a.cancel.pull-right {:href "#" :on-click #(do
                                                                                (.preventDefault %)
@@ -317,7 +317,7 @@
                                 :disabled (blank? @(cursor state [:endorsement-comment]))

                                 } (t :badge/Endorsebadge)]]
-     [:hr]]))
+     [:hr.border]]))

 (defn endorsement-text [state]
   (let [user-endorsement (->> @(cursor state [:user-badge-endorsements])


Add skeleton of pull request operations list.

--- src/cljs/hatnik/web/client/form/github_pull_request.cljs
+++ src/cljs/hatnik/web/client/form/github_pull_request.cljs
@@ -35,6 +35,32 @@
                  (form-status-handler "has-error"))))
            error-handler))
         1000)))))
+
+(defn pull-request-operation [data owner]
+  (reify
+    om/IRender
+    (render [this]
+      (dom/div nil
+               (dom/div #js {:className "form-group"}
+                        (dom/label nil "file")
+                        (dom/input #js {:type "text"
+                                        :className "form-control"}))
+               (dom/div #js {:className "form-group"}
+                        (dom/label nil "regex")
+                        (dom/input #js {:type "text"
+                                        :className "form-control"}))
+               (dom/div #js {:className "form-group"}
+                        (dom/label nil "replacement")
+                        (dom/input #js {:type "text"
+                                        :className "form-control"}))))))
+
+(defn pull-request-operations-list [data owner]
+  (reify
+    om/IRender
+    (render [this]
+      (dom/div #js {:className "form-group"}
+               (dom/label nil "Operations list")
+               (om/build pull-request-operation {})))))

 (defn github-pull-request-component [data owner]
   (reify
@@ -78,4 +104,5 @@
                         (dom/textarea #js {:cols "40"
                                                :className "form-control"}))

-               (dom/div nil "Operations")))))
+               (dom/div nil
+                        (om/build pull-request-operations-list {}))))))


Add accordion around github pull request body.

--- src/cljs/hatnik/web/client/form/github_pull_request.cljs
+++ src/cljs/hatnik/web/client/form/github_pull_request.cljs
@@ -89,15 +89,28 @@
                                           (fn [st] (om/set-state! owner :form-status "has-error")))
                                         }))

-               (dom/div #js {:className "form-group"}
-                        (dom/label nil "Title")
-                        (dom/input #js {:type "text"
-                                        :className "form-control"}))
+               (dom/div
+                #js {:className "panel-group" :id "github-pull-req-text"}
+                (dom/div #js {:className "panel panel-default"}
+                         (dom/div #js {:className "panel-heading"}
+                                  (dom/h4 #js {:className "panel-title"}
+                                          (dom/a #js {:data-toggle "collapse"
+                                                      :data-parent "#github-pull-req-text"
+                                                      :href "#github-pull-req-text-body"}
+                                                 "GitHub pull request body")))
+
+                         (dom/div #js {:className "panel-collapse collapse"
+                                       :id "github-pull-req-text-body"}
+                                  (dom/div #js {:className "panel-body"}
+                                           (dom/div #js {:className "form-group"}
+                                                    (dom/label nil "Title")
+                                                    (dom/input #js {:type "text"
+                                                                    :className "form-control"}))

-               (dom/div #js {:className "form-group"}
-                        (dom/label nil "Body")
-                        (dom/textarea #js {:cols "40"
-                                               :className "form-control"}))
+                                           (dom/div #js {:className "form-group"}
+                                                    (dom/label nil "Body")
+                                                    (dom/textarea #js {:cols "40"
+                                                                       :className "form-control"}))))))

                (dom/div #js {:className "form-group"}
                         (dom/label nil "Commit message")


Found a bottleneck in to-binary-matrix

Found a bottleneck in to-binary-matrix

caused by aset. Fixed this.

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

--- src/conexp/contrib/algorithms/bitwise.clj
+++ src/conexp/contrib/algorithms/bitwise.clj
@@ -73,13 +73,14 @@
   ""
   [object-vector attribute-vector incidence-relation]
   (let [incidence-matrix (make-array Integer/TYPE (count object-vector) (count attribute-vector))]
-    (doseq [obj-idx (range (count object-vector))
-	    att-idx (range (count attribute-vector))]
-      (aset incidence-matrix obj-idx att-idx
-	    (if (contains? incidence-relation [(nth object-vector obj-idx)
-					       (nth attribute-vector att-idx)])
-	      (int 1)
-	      (int 0))))
+    (dotimes [obj-idx (count object-vector)]
+      (let [#^ints row (aget #^objects incidence-matrix obj-idx)]
+	(dotimes [att-idx (count attribute-vector)]
+	  (aset row att-idx
+		(if (contains? incidence-relation [(nth object-vector obj-idx)
+						   (nth attribute-vector att-idx)])
+		  (int 1)
+		  (int 0))))))
     incidence-matrix))

 (defn to-binary-context


Move logging out of let bindings.

Move logging out of let bindings.

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -101,8 +101,8 @@
                                                      :builds-per-page (:builds-per-page current-state)))
               api-resp (<! (ajax/managed-ajax :get builds-url))
               scopes (:scopes api-resp)
-              _ (mlog (str "post-navigated-to! :dashboard, " builds-url " scopes " scopes))
               comms (get-in current-state [:comms])]
+          (mlog (str "post-navigated-to! :dashboard, " builds-url " scopes " scopes))
           (condp = (:status api-resp)
             :success (put! (:api comms) [:recent-builds :success (assoc api-resp :context args)])
             :failed (put! (:nav comms) [:error {:status (:status-code api-resp) :inner? false}])


Refactor all parts to use names.

Refactor all parts to use names.

--- src/african_polyphony_and_polyrhythm/talk.clj
+++ src/african_polyphony_and_polyrhythm/talk.clj
@@ -2,7 +2,7 @@
   (:require [overtone.live :refer :all :exclude [stop]]
             [leipzig.melody :refer :all]
             [leipzig.canon :refer [canon]]
-            [leipzig.scale :refer [A B major minor pentatonic]]
+            [leipzig.scale :refer [A B major minor pentatonic high]]
             [leipzig.temperament :as temperament]
             [leipzig.live :as live]
             [leipzig.live :refer [stop]]))
@@ -88,26 +88,27 @@
     (part model a b c d)))

 (def ha
-  (part
-    (phrase [2/4 12/4 2/4] (cons nil (repeat 2)))
-    (comp (split 2/4 1/4) (split 0 1/4))
-    (comp (split 6/4 1/4) (split 0 1/4))
-    (comp (split 6/4 1/4))
-    (comp (split 6/4 1/4) (split 2/4 1/4) (split 0 1/4))))
+  (let [model (->> (phrase [12/4 2/4] (repeat 2)) (after 2/4))
+        a (comp (split 2/4 1/4) (split 0 1/4))
+        b (comp (split 6/4 1/4))
+        c (comp (split 0 1/4) b)
+        d (comp a b)]
+    (part model a b c d)))

 (def tulule
-  (part
-    (phrase [8/4 8/4] (repeat 3))
-    (comp (split 8/4 2/4) (split 0 2/4)) ; 28
-    (comp (split 1/4 0) (split 2/4 1/4) (split 8/4 2/4) (split 0 2/4)) ; 6
-    (comp (split 3/4 1/8) (split 1/4 0) (split 2/4 1/4) (split 8/4 2/4) (split 0 2/4)))) ; 5
+  (let [model (phrase [8/4 8/4] (repeat 3))
+        a (comp (split 8/4 2/4) (split 0 2/4)) ; 28
+        b (comp (split 0 1/4) (split 2/4 1/4) a) ; 6
+        c (comp (accent 7/8) (split 3/4 1/8) b)] ; 5
+    (part model a b c)))

 (def bongo
-  (part
-    (phrase [6/4 3/4 7/4] (cons nil (repeat 4))) ; 5
-    (split 9/4 5/4) ; 6
-    (comp (split 6/4 1/4) (split 9/4 5/4)) ; 9
-    (comp (split 14/4 1/4) (split 3/2 1/4) (split 9/4 5/4)))) ; 8
+  (let [model (->> (phrase [3/4 7/4] (repeat 4)) (after 6/4)) ; 5
+        a (split 9/4 5/4) ; 6
+        b (comp (split 6/4 1/4) a) ; 9
+        c (comp (split 14/4 1/4) b) ; 8
+        d (comp (accent 10/4) (split 9/4 1/4) b)] ; 19
+    (part model a b c d)))

 (defn big [notes]
   (->> notes
@@ -133,10 +134,11 @@

 (comment
   (fx-reverb)
+  (map fx-chorus [0 1])
   (map fx-distortion [0 1])
   (->>
     balendoro
-    (where :pitch (comp temperament/equal A inverse-pentatonic))
+    (where :pitch (comp temperament/equal high A inverse-pentatonic))
     (tempo (bpm 120))
     (live/play)
     )


Name clash with new core function.

Name clash with new core function.

--- test/behaviors/t_canary.clj
+++ test/behaviors/t_canary.clj
@@ -4,7 +4,6 @@
 ;;; bugs. They've been fixed, and more specific tests have been
 ;;; written, but no harm in keeping them around. Delete if they start
 ;;; to annoy.
-

 (ns behaviors.t-canary
   (:use [midje.sweet])
@@ -76,10 +75,10 @@
 (def fn-map
  {:foo #'another-fn})

-(defn some-fn [k arg]
+(defn a-fn [k arg]
  ((get fn-map k) arg))

 (fact
-  (some-fn :foo 55) => ...something...
+  (a-fn :foo 55) => ...something...
   (provided
     (another-fn 55) => ...something...))


renaming

renaming

--- test/celestial/fixtures.clj
+++ test/celestial/fixtures.clj
@@ -4,6 +4,6 @@

 (def spec (slurp-edn "fixtures/redis-system.edn"))

-(def type (slurp-edn "fixtures/redis-type.edn"))
+(def redis-type (slurp-edn "fixtures/redis-type.edn"))

 (def local-prox (slurp-edn "fixtures/.celestial.edn"))


#99 use sorted-map in tests

#99 use sorted-map in tests

--- test/cheshire/test/core.clj
+++ test/cheshire/test/core.clj
@@ -253,7 +253,7 @@
                       {:pretty true}))))

 (deftest t-custom-pretty-print-with-defaults
-  (let [test-obj {:foo 1 :bar {:baz [{:ulu "mulu"} {:moot "foo"} 3]} :quux "blub"}
+  (let [test-obj (sorted-map :foo 1 :bar {:baz [{:ulu "mulu"} {:moot "foo"} 3]} :quux :blub)
         pretty-str-default (json/encode test-obj {:pretty true})
         pretty-str-custom (json/encode test-obj {:pretty {}})]
     ; print for easy comparison
@@ -264,7 +264,7 @@
     (is (= pretty-str-default pretty-str-custom))))

 (deftest t-custom-pretty-print-with-non-defaults
-  (let [test-obj {:foo 1 :bar {:baz [{:ulu "mulu"} {:moot "foo"} 3]} :quux "blub"}
+  (let [test-obj (sorted-map :foo 1 :bar {:baz [{:ulu "mulu"} {:moot "foo"} 3]} :quux :blub)
         test-opts {:pretty {:indentation 4
                             :indent-arrays? false
                             :before-array-values ""


Fix bug with object in goal.

Fix bug with object in goal.

--- src/angelic/domains/discrete_manipulation.clj
+++ src/angelic/domains/discrete_manipulation.clj
@@ -915,7 +915,8 @@
                                    (if-let [s (util/singleton o-dsts)]
                                      [[[:object-at s] #{o}]]
                                      (for [o-dst o-dsts]
-                                       [[:object-at o-dst] (conj (state/get-var ss [:object-at o-dst]) o)]))))
+                                       [[:object-at o-dst] (conj (state/get-var ss [:object-at o-dst]) o
+                                                                 (if (= o-dst o-src) nil o))]))))
         (+ pickup-reward putdown-reward
            (apply max
                   (concat


Removed more obsolete code

Removed more obsolete code

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -722,17 +722,6 @@
   (load-mm)
   (add-to-album))

-(defn -doSnap [this]
-  (load-mm)
-  (do-snap))
-
-(defn -isLiveRunning [this]
-  @live-mode-running)
-
-(defn -enableLiveMode [this ^Boolean on]
-  (load-mm)
-  (enable-live-mode on))
-
 (defn -pause [this]
   (log "pause requested!")
   (swap! (.state this) assoc :pause true))


cassandra: allow :consistency opt in UpsertOptsWithTimestampSchema

--- src/er_cassandra/model/alia/fn_schema.clj
+++ src/er_cassandra/model/alia/fn_schema.clj
@@ -66,6 +66,7 @@
   (conditional-upsert-schema
    (merge
     rs/PrepareOptSchema
+    UpsertConsistencySchema
     UpsertWhereSchema
     UpsertUsingOnlyOptsWithTimestampSchema)))