add --dry-run to satellite-slave

add --dry-run to satellite-slave

--- satellite-slave/src/satellite_slave/core.clj
+++ satellite-slave/src/satellite_slave/core.clj
@@ -84,7 +84,7 @@
            (keys event))))

 (defn app
-  [settings finish-chan]
+  [settings dry-run finish-chan]
   (let [clients (map (fn [satellite]
                        (tcp-client satellite))
                      (:satellites settings))
@@ -107,7 +107,10 @@
                                           (run-test (dissoc test :schedule))
                                           (catch java.util.concurrent.TimeoutException ex
                                             {:state "critical"
-                                             :description "timed out"}))
+                                             :description "timed out"})
+                                          (catch Exception ex
+                                            {:state "critical"
+                                             :description (str "command: " (:command test) ex)}))
                           riemann-event (assoc riemann-event
                                                :time (.toSeconds TimeUnit/MILLISECONDS
                                                                  (System/currentTimeMillis))
@@ -115,7 +118,9 @@
                                                              (:service riemann-event)))]
                       (doseq [client clients]
                         (try
-                          (send-event client riemann-event)
+                          (if dry-run
+                            (println riemann-event)
+                            (send-event client riemann-event))
                           (log/debug (format "Sent event: %s" riemann-event))
                           (catch Exception ex
                             (log/error (str "service: " (:service riemann-event) " "
@@ -143,5 +148,6 @@
     (do (log/info (str "Reading config from file: " config))
         (config/include config))
     (log/info (str "Using default settings.")))
-  (let [finish-chan (async/chan 1)]
-    (app config/settings finish-chan)))
+  (let [finish-chan (async/chan 1)
+        dry-run (when args (.contains args "--dry-run"))]
+    (app config/settings dry-run finish-chan)))


Fixing accidental revert.

Fixing accidental revert.

--- storm-core/src/clj/backtype/storm/daemon/executor.clj
+++ storm-core/src/clj/backtype/storm/daemon/executor.clj
@@ -60,7 +60,7 @@
     ))

 (defn- mk-grouper
-  "returns a function that returns a vector of which task indices to send tuple to, or just a single task index."
+  "Returns a function that returns a vector of which task indices to send tuple to, or just a single task index."
   [^WorkerTopologyContext context component-id stream-id ^Fields out-fields thrift-grouping ^List target-tasks]
   (let [num-tasks (count target-tasks)
         random (Random.)


Convert af-key to use juxt

Convert af-key to use juxt

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -11,6 +11,7 @@
   (:gen-class :main true))

 (set! *warn-on-reflection* false)
+(set-logger-level! "org.jaudiotagger" Level/OFF)

 (defn audio-file [file]
   (try (AudioFileIO/read file)
@@ -90,17 +91,16 @@
   ([m [k v]]
    (put m k v)))

-(defn af-key [{:keys [:artist :album :title] :as v}]
-  [artist album title])
+(defn af-key [v]
+  ((juxt :artist :album :title) v))

-(defn entry [v]
-  (let [af (metadata v)]
+(defn af-entry [f]
+  (let [af (metadata f)]
     [(af-key af) af]))

 (defn -main
   ([] (-main "."))
   ([dir]
-   (set-logger-level! "org.jaudiotagger" Level/OFF)
-   (pprint (reduce put {} (map entry (filtered dir))))))
+   (pprint (reduce put {} (map af-entry (filtered dir))))))

 #_(-main)


Adding a bit of docstring to the add-errors

Trying to add a bit of clarifying info about
the arguments for the error methods.


RP + CW | 25 | add debug logging for exit code of email bash script

--- src/stonecutter/email.clj
+++ src/stonecutter/email.clj
@@ -39,10 +39,12 @@
   (if email-script-path
     (fn [email-address subject body]
       (log/debug (format "sending email to '%s' using bash script: '%s'." email-address email-script-path))
-      (shell/sh email-script-path
+      (let [shell-response (shell/sh email-script-path
                 (str email-address)
                 (str subject)
-                (str body)))
+                (str body))]
+        (log/debug (format "script returned exit code: '%s'" shell-response))
+        shell-response))
     stdout-sender))

 (defn reset-email-configuration! []


cleanup

cleanup

--- src/subticket/service.clj
+++ src/subticket/service.clj
@@ -10,70 +10,44 @@
             [subticket.data-model]
             [korma.db]))

-(defn about-page
-  [request]
-  (ring-resp/response (format "Clojure %s - served from %s"
-                              (clojure-version)
-                              (route/url-for ::about-page))))
-
-(defn home-page
-  [request]
-  (ring-resp/response "Hello World!"))
-
 (defn response [status body & {:as headers}]
   {:status status :body body :headers headers})

-(def ok       (partial response 200))
-
-(def echo
-  {:name :echo
-   :enter
-   (fn [context]
-     (let [request (:request context)
-           response (ok context)]
-       (assoc context :response response)))})
+(def ok                (partial response 200))
+(def bad-request       (partial response 400))

 (def param-keys [:edn-params :form-params :json-params :path-params :query-params])

 (defn- get-params [request] (apply merge (vals (select-keys request param-keys))))
+
+(defn- spec-for [route] (keyword "subticket.data-model" (name route)))

 (def default-json
   {:name :default-json
    :enter
    (fn [context]
      (let [request (:request context)
-           params (get-params request)]
-       (assoc context ::tmp-request request :request params)))
+           params (get-params request)
+           route (get-in context [:route :route-name])
+           errors (s/explain-data (spec-for route) params)]
+     (log/info :msg errors)
+     (if errors
+       (chain/terminate (assoc context :response (bad-request errors)))
+       (assoc context ::tmp-request request :request params))))
    :leave
    (fn [context]
      (let [request (::tmp-request context)
            body (:response context)]
        (assoc context :request request :response (ok body))))})

-(def bad-request
-  {:name :bad-request
-   :enter
-   (fn [context]
-     (let [request (:request context)
-           route (get-in context [:route :route-name])
-           params (get-params request)
-           errors (s/explain-data (keyword "subticket.data-model" (name route)) params)]
-       (log/info :msg errors)
-       (if errors
-         (chain/terminate (assoc context :response (response 400 errors)))
-         context)))})
-

 ;; Defines "/" and "/about" routes with their associated :get handlers.
 ;; The interceptors defined after the verb map (e.g., {:get home-page}
 ;; apply to / and its children (/about).
-(def common-interceptors [(body-params/body-params) http/html-body])
-(defn json-interceptors [handler] [(body-params/body-params) http/json-body bad-request default-json (fn [request] (korma.db/transaction (handler request)))])
+(defn json-interceptors [handler] [(body-params/body-params) http/json-body default-json (fn [request] (korma.db/transaction (handler request)))])

 ;; Tabular routes
-(def routes #{["/" :get (conj common-interceptors `home-page)]
-              ["/about" :get (conj common-interceptors `about-page)]
-              ["/user/:username" :put (json-interceptors users/add-user-handler) :route-name :add-user]})
+(def routes #{["/user/:username" :put (json-interceptors users/add-user-handler) :route-name :add-user]})

 ;; Map-based routes
 ;(def routes `{"/" {:interceptors [(body-params/body-params) http/html-body]


removes reference to jobsystem (#520)

removes reference to jobsystem (#520)

--- waiter/src/waiter/settings.clj
+++ waiter/src/waiter/settings.clj
@@ -256,7 +256,7 @@
               :invalid-service-description "Service description using waiter headers/token improperly configured"
               :not-enough-memory "Not enough memory allocated"
               :not-found "Not found"
-              :prestashed-tickets-not-available "Prestashed jobsystem tickets not available"
+              :prestashed-tickets-not-available "Prestashed tickets not available"
               :service-state-failing "Failing"
               :service-state-idle "Idle"
               :service-state-running "Running"


Replace Teams button

Replace Teams button

--- src-cljs/frontend/components/pages/team.cljs
+++ src-cljs/frontend/components/pages/team.cljs
@@ -217,16 +217,15 @@
                                                                                (deselect! owner user))}]))}]
                                                             :striped? true})]))]))
                                   :actions [(button/button {:on-click close-fn} "Cancel")
-                                            (forms/managed-button
-                                             [:button.btn.btn-primary {:style {:width "155px"}
-                                                                       :data-success-text "Sent"
-                                                                       :on-click #(do
-                                                                                (raise! owner [:invited-team-members {:invitees (invitees state vcs-users)
-                                                                                :vcs_type (:vcs_type selected-org)
-                                                                                :org-name (:name selected-org)}])
-                                                                                (close-fn))
-                                                                       :disabled (= 0 count-selected)}
-                                              (invite-button-text count-selected)])]
+                                            (button/managed-button {:success-text "Sent"
+                                                                    :on-click #(do
+                                                                                (raise! owner [:invited-team-members {:invitees (invitees state vcs-users)
+                                                                                :vcs_type (:vcs_type selected-org)
+                                                                                :org-name (:name selected-org)}])
+                                                                                (close-fn))
+                                                                    :primary? true
+                                                                    :disabled? (zero? count-selected)}
+                                                                   (invite-button-text count-selected))]
                                   :close-fn close-fn})))])))))

 (defn- main-content [app owner]


Add a (failing) cell update function

Add a (failing) cell update function

--- src/utf8ify/web/core.cljs
+++ src/utf8ify/web/core.cljs
@@ -31,12 +31,13 @@
   (loop [[msg-name {x :x y :y}] (<! app/draw-events)]
     (let [cell (.elementFromPoint js/document x y)
           data-id (.-id (.-dataset cell))]
-      (.log js/console (str "Cell: " data-id))
       (activate-cell data-id))
     (recur (<! app/draw-events))))

 (defn activate-cell [id]
+  (.log js/console (str "Cell: " id))
   (swap! app-state (fn [data]
          (let [cells (:cells data)
-               updated-cells (map (fn [cell] (assoc cell {:on (or (:on cell) (= (:id cell) id))})) cells)]
+               updated-cells (map (fn [cell]
+                                    (assoc cell {:on (or (:on cell) (= (:id cell) id))})) cells)]
            (assoc data {:cells updated-cells})))))


improved printing of :top and nil

improved printing of :top and nil

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -108,14 +108,14 @@
    (get-string @word :show-notes show-notes :lexicon lexicon :from-language from-language)

    (= word :top)
-   ".."
+   ":top"

    (and (map? word)
         (nil? (:a word))
         (nil? (:b word))
         (nil? (:english word))
         (nil? (:english word)))
-   ".."
+   "nil"

    (and (= true (get-in word [:exception] false))
         ;; for exceptions, lexical compilation sets [:exception] to true


Upgrade todomvc example binaryage/devtools to 1.0.2

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -12,7 +12,7 @@
                  [reagent                    "0.10.0"]
                  [net.cgrand/macrovich       "0.2.1"]
                  [org.clojure/tools.logging  "0.4.1"]
-                 [binaryage/devtools         "1.0.0"]
+                 [binaryage/devtools         "1.0.2"]
                  [clj-commons/secretary      "1.2.4"]
                  [day8.re-frame/tracing      "0.5.5"]]


fixes

fixes

--- src/clj/com/rpl/specter/impl.cljc
+++ src/clj/com/rpl/specter/impl.cljc
@@ -659,10 +659,7 @@
         (->DynamicVal (:sym o))

         (instance? SpecialFormUse o)
-        (let [code (:code o)
-              v (->DynamicVal code)]
-          (if (= 'fn* (first code))
-            (->DynamicFunction pred* [v])))
+        (->DynamicVal (:code o))

         (instance? FnInvocation o)
         (let [op (magic-precompilation* (:op o))
@@ -733,9 +730,15 @@
         (resolve-magic-code path)))

     (instance? DynamicVal o)
-    (if (-> o :code direct-nav?)
-      (:code o)
-     `(coerce-nav ~(:code o)))
+    (let [code (:code o)]
+      (cond (direct-nav? code)
+            code
+
+            (or (set? code) (and (fn-invocation? code) (= 'fn* (first code))))
+            `(pred* ~code)
+
+            :else
+            `(coerce-nav ~code)))

     (instance? DynamicFunction o)
     (let [op (resolve-dynamic-fn-arg (:op o))


implemented NONE removal for keypath, must, MAP-VALS (except PersistentArrayMap), ALL (except lists and PersistentArrayMap)

--- src/clj/com/rpl/specter/navs.cljc
+++ src/clj/com/rpl/specter/navs.cljc
@@ -64,8 +64,10 @@
 (defn- non-transient-map-all-transform [structure next-fn empty-map]
   (reduce-kv
     (fn [m k v]
-      (let [[newk newv] (next-fn [k v])]
-        (assoc m newk newv)))
+      (let [newkv (next-fn [k v])]
+        (if (identical? newkv i/NONE)
+          m
+          (assoc m (nth newkv 0) (nth newkv 1)))))

     empty-map
     structure))
@@ -88,7 +90,10 @@

   #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
   (all-transform [structure next-fn]
-    (mapv next-fn structure))
+    (into []
+      (comp (map next-fn)
+            (filter #(-> % (identical? i/NONE) not)))
+      structure))

   #?(:clj clojure.lang.PersistentArrayMap)
   #?(:clj
@@ -96,6 +101,9 @@
        (let [k-it (.keyIterator structure)
              v-it (.valIterator structure)
              array (i/fast-object-array (* 2 (.count structure)))]
+         ;;TODO: how to handle NONE here...?
+         ;;needs to size the array appropriately...
+         ;;need to use the same strategy for MAP-VALS
          (loop [i 0]
            (if (.hasNext k-it)
              (let [k (.next k-it)
@@ -123,8 +131,10 @@
     (persistent!
       (reduce-kv
         (fn [m k v]
-          (let [[newk newv] (next-fn [k v])]
-            (assoc! m newk newv)))
+          (let [newkv (next-fn [k v])]
+            (if (identical? newkv i/NONE)
+              m
+              (assoc! m (nth newkv 0) (nth newkv 1)))))

         (transient
           #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))
@@ -139,12 +149,14 @@
        (let [empty-structure (empty structure)]
          (cond (and (list? empty-structure) (not (queue? empty-structure)))
             ;; this is done to maintain order, otherwise lists get reversed
+              ;;TODO: need to handle NONE here
                (doall (map next-fn structure))

                (map? structure)
             ;; reduce-kv is much faster than doing r/map through call to (into ...)
                (reduce-kv
                  (fn [m k v]
+                   ;;TODO: need to handle NONE here
                    (let [[newk newv] (next-fn [k v])]
                      (assoc m newk newv)))

@@ -153,12 +165,14 @@

                :else
+               ;;TODO: need to handle NONE here
                (->> structure (r/map next-fn) (into empty-structure))))))

   #?(:cljs default)
   #?(:cljs
      (all-transform [structure next-fn]
+       ;;TODO: need to handle NONE here
        (let [empty-structure (empty structure)]
          (if (and (list? empty-structure) (not (queue? empty-structure)))
         ;; this is done to maintain order, otherwise lists get reversed
@@ -173,7 +187,10 @@
 (defn map-vals-non-transient-transform [structure empty-map next-fn]
   (reduce-kv
     (fn [m k v]
-      (assoc m k (next-fn v)))
+      (let [newv (next-fn v)]
+        (if (identical? newv i/NONE)
+          m
+          (assoc m k newv))))
     empty-map
     structure))

@@ -189,6 +206,7 @@
        (let [k-it (.keyIterator structure)
              v-it (.valIterator structure)
              array (i/fast-object-array (* 2 (.count structure)))]
+        ;;TODO: Need to handle NONE here just like it's handled in all-transform
          (loop [i 0]
            (if (.hasNext k-it)
              (let [k (.next k-it)
@@ -216,7 +234,10 @@
     (persistent!
       (reduce-kv
         (fn [m k v]
-          (assoc! m k (next-fn v)))
+          (let [newv (next-fn v)]
+            (if (identical? newv i/NONE)
+              m
+              (assoc! m k newv))))
         (transient
           #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))

@@ -227,7 +248,10 @@
   (map-vals-transform [structure next-fn]
     (reduce-kv
       (fn [m k v]
-        (assoc m k (next-fn v)))
+        (let [newv (next-fn v)]
+          (if (identical? newv i/NONE)
+            m
+            (assoc m k newv))))
       (empty structure)
       structure)))

@@ -407,6 +431,13 @@
     (walk/walk (partial walk-until pred on-match-fn) identity structure)))

+(defn- do-keypath-transform [vals structure key next-fn]
+  ;;TODO: not right, this doesn't handle sequences
+  (let [newv (next-fn vals (get structure key))]
+    (if (identical? newv i/NONE)
+      (dissoc structure key)
+      (assoc structure key newv))))
+
 (defrichnav
   ^{:doc "Navigates to the specified key, navigating to nil if it does not exist."}
   keypath*
@@ -414,7 +445,8 @@
   (select* [this vals structure next-fn]
     (next-fn vals (get structure key)))
   (transform* [this vals structure next-fn]
-    (assoc structure key (next-fn vals (get structure key)))))
+    (do-keypath-transform vals structure key next-fn)
+    ))

 (defrichnav
@@ -427,5 +459,5 @@
       i/NONE))
   (transform* [this vals structure next-fn]
    (if (contains? structure k)
-     (assoc structure k (next-fn vals (get structure k)))
+     (do-keypath-transform vals structure key next-fn)
      structure)))


inject form validators into Enlive shopping template

--- src/clj/modern_cljs/templates/shopping.clj
+++ src/clj/modern_cljs/templates/shopping.clj
@@ -1,12 +1,30 @@
 (ns modern-cljs.templates.shopping
-  (:require [net.cgrand.enlive-html :refer [deftemplate set-attr]]
-            [modern-cljs.remotes :refer [calculate]]))
+  (:require [net.cgrand.enlive-html :refer [deftemplate content do-> add-class set-attr attr=]]
+            [modern-cljs.remotes :refer [calculate]]
+            [modern-cljs.shopping.validators :refer [validate-shopping-form]]))

-(deftemplate shopping "public/shopping.html"
-  [quantity price tax discount]
-  [:#quantity] (set-attr :value quantity)
-  [:#price] (set-attr :value price)
-  [:#tax] (set-attr :value tax)
-  [:#discount] (set-attr :value discount)
-  [:#total] (set-attr :value
-                      (format "%.2f" (double (calculate quantity price tax discount)))))
+(defmacro maybe-error [expr]
+  `(if-let [x# ~expr]
+     (do-> (add-class "error")
+           (content x#))
+     identity))
+
+(deftemplate update-shopping-form "public/shopping.html"
+  [q p t d e]
+
+  [[:label (attr= :for "quantity")]] (maybe-error (first (:quantity e)))
+  [[:label (attr= :for "price")]] (maybe-error (first (:price e)))
+  [[:label (attr= :for "tax")]] (maybe-error (first (:tax e)))
+  [[:label (attr= :for "discount")]] (maybe-error (first (:discount e)))
+
+  [:#quantity] (set-attr :value q)
+  [:#price] (set-attr :value p)
+  [:#tax] (set-attr :value t)
+  [:#discount] (set-attr :value d)
+  [:#total] (if e
+              (set-attr :value "0.00")
+              (set-attr :value
+                         (format "%.2f" (double (calculate q p t d))))))
+
+(defn shopping [q p t d]
+  (update-shopping-form q p t d (validate-shopping-form q p t d)))


Updated Foxfire's trace msg

Updated Foxfire's trace msg

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -183,7 +183,7 @@
    {:trace {:base 7 :prompt "Choose 1 card to trash" :not-distinct true
             :choices {:req #(and (:installed %)
                                  (or (has? % :subtype "Virtual") (has? % :subtype "Link")))}
-            :msg (msg "trash " (:title target)) :effect (effect (trash target))}}
+            :msg "trash 1 virtual resource or link" :effect (effect (trash target) (system-msg (str "trashes " (:title target))))}}

    "Freelancer"
    {:req (req tagged) :msg (msg "trash " (join ", " (map :title targets)))


Fix: Image and tag display abnormally at service edit page if registry port introduced

#73

--- src/clj/swarmpit/docker/mapper/inbound.clj
+++ src/clj/swarmpit/docker/mapper/inbound.clj
@@ -178,6 +178,13 @@
     (if (some? value)
       (= "true" value)
       value)))
+
+(defn ->service-image-details
+  [image-name]
+  (let [separator-pos (str/last-index-of image-name ":")
+        length (count image-name)]
+    {:name (subs image-name 0 separator-pos)
+     :tag  (subs image-name (inc separator-pos) length)}))

 (defn ->service
   [service tasks nodes networks]
@@ -193,8 +200,7 @@
         image (get-in service-task-template [:ContainerSpec :Image])
         image-info (str/split image #"@")
         image-name (first image-info)
-        image-digest (second image-info)
-        image-segments (str/split image-name #":")]
+        image-digest (second image-info)]
     (array-map
       :id service-id
       :version (get-in service [:Version :Index])
@@ -202,10 +208,9 @@
       :updatedAt (date (:UpdatedAt service))
       :registry {:name (:swarmpit.service.registry.name service-labels)
                  :user (:swarmpit.service.registry.user service-labels)}
-      :repository {:image       image-name
-                   :imageDigest image-digest
-                   :name        (first image-segments)
-                   :tag         (second image-segments)}
+      :repository (merge (->service-image-details image-name)
+                         {:image       image-name
+                          :imageDigest image-digest})
       :serviceName service-name
       :mode service-mode
       :replicas replicas


basic parsing done

basic parsing done

--- src/basilisk/tasks/collector/tsetmc/core.clj
+++ src/basilisk/tasks/collector/tsetmc/core.clj
@@ -7,15 +7,25 @@

 (def input-channel (async/chan 1000))

+(defrecord TradeSymbol [symbol name tsetmc-id tsetmc-name])
+

 (defn fetch-csv []
-  (clojure.string/split (:body (http/get (:index-csv (:fa site-url)))) #";"))
+  (async/>!! input-channel
+             (clojure.string/split (:body (http/get (:index-csv (:fa site-url)))) #";")))

+(defn create-record [line]
+  (let [fields (clojure.string/split line #",")]
+    (if (= 23 (count fields))
+      (map->TradeSymbol
+        {:symbol      (get fields 2)
+         :name        (get fields 3)
+         :tsetmc-id   (get fields 0)
+         :tsetmc-name (get fields 1)})
+      nil)))

-(defn with-each-symbol [input]
+(defn with-each-symbol []
   (let [lines (take 5 (fetch-csv))]
-    (doseq [line lines]
-      (let [field (clojure.string/split line #",")]
-        (println (str ">>>>> " field))))))
+    (map create-record lines)))

 (defn collect-symbols [])


Review comment: save allocations when evolving.

--- src/common/datomish/transact.cljc
+++ src/common/datomish/transact.cljc
@@ -406,18 +406,17 @@

 (defn evolve-upserts-e [id->e upserts-e]
   (let [evolve1
-        (fn [[op id-e a v]]
-          (let [e* (get id->e id-e)]
-            (if e*
-              [:upserted [op e* a v]]
-              [:allocations-e [op id-e a v]])))]
+        (fn [[op id-e a v :as entity]]
+          (if-let [e* (get id->e id-e)]
+            [:upserted [op e* a v]]
+            [:allocations-e entity]))]
     (util/group-by-kv evolve1 upserts-e)))

 (defn evolve-upserts-ev [id->e upserts-ev]
   "Given a map id->e of id-literals to integer entids, evolve the given entities.  Returns a map
   whose keys are generations and whose values are vectors of entities in those generations."
   (let [evolve1
-        (fn [[op id-e a id-v]]
+        (fn [[op id-e a id-v :as entity]]
           (let [e* (get id->e id-e)
                 v* (get id->e id-v)]
             (if e*
@@ -426,36 +425,34 @@
                 [:allocations-v [op e* a id-v]])
               (if v*
                 [:upserts-e [op id-e a v*]]
-                [:upserts-ev [op id-e a id-v]]))))]
+                [:upserts-ev entity]))))]
     (util/group-by-kv evolve1 upserts-ev)))

 (defn evolve-allocations-e [id->e allocations-e]
   "Given a map id->e of id-literals to integer entids, evolve the given entities.  Returns a map
   whose keys are generations and whose values are vectors of entities in those generations."
   (let [evolve1
-        (fn [[op id-e a v]]
-          (let [e* (get id->e id-e)]
-            (if e*
-              [:resolved [op e* a v]]
-              [:allocations-e [op id-e a v]])))]
+        (fn [[op id-e a v :as entity]]
+          (if-let [e* (get id->e id-e)]
+            [:resolved [op e* a v]]
+            [:allocations-e entity]))]
     (util/group-by-kv evolve1 allocations-e)))

 (defn evolve-allocations-v [id->e allocations-v]
   "Given a map id->e of id-literals to integer entids, evolve the given entities.  Returns a map
   whose keys are generations and whose values are vectors of entities in those generations."
   (let [evolve1
-        (fn [[op e a id-v]]
-          (let [v* (get id->e id-v)]
-            (if v*
-              [:resolved [op e a v*]]
-              [:allocations-v [op e a id-v]])))]
+        (fn [[op e a id-v :as entity]]
+          (if-let [v* (get id->e id-v)]
+            [:resolved [op e a v*]]
+            [:allocations-v entity]))]
     (util/group-by-kv evolve1 allocations-v)))

 (defn evolve-allocations-ev [id->e allocations-ev]
   "Given a map id->e of id-literals to integer entids, evolve the entities in allocations-ev.  Returns a
   map whose keys are generations and whose values are vectors of entities in those generations."
   (let [evolve1
-        (fn [[op id-e a id-v]]
+        (fn [[op id-e a id-v :as entity]]
           (let [e* (get id->e id-e)
                 v* (get id->e id-v)]
             (if e*
@@ -464,7 +461,7 @@
                 [:allocations-v [op e* a id-v]])
               (if v*
                 [:allocations-e [op id-e a v*]]
-                [:allocations-ev [op id-e a id-v]]))))]
+                [:allocations-ev entity]))))]
     (util/group-by-kv evolve1 allocations-ev)))

 (defn <evolve [db evolution]


Do not throw exception if median calculation fails

Fix for Townsend Deprivation Score data causing numpy error until script
or data modified.

--- src/clj/popchange/lib/raster_calculation.clj
+++ src/clj/popchange/lib/raster_calculation.clj
@@ -124,7 +124,9 @@
   [filename]
   (do
     (prep-scripts!)
-    (Double. (python raster-median-script filename))))
+    (if-let [m (python raster-median-script filename {:throw false})]
+      (if-not (empty? m)
+        (Double. m)))))

 ;; https://color.adobe.com/create/color-wheel/?base=2&rule=Analogous&selected=4&name=My%20Color%20Theme&mode=rgb&rgbvalues=0.050000000000000044,0.4863328728314287,1,0.04550000000000004,0.91,0.4170136015589975,0.8899342843958493,1,0,0.91,0.565626307834159,0,1,0.045165788032136334,0&swatchOrder=0,1,2,3,4
 (def colour-map-stop-values


Inject dummy github payload in the main store at init

--- src/cljs/funnel_front/stores/main_store.cljs
+++ src/cljs/funnel_front/stores/main_store.cljs
@@ -3,7 +3,7 @@
 (def app-state (atom {
   :token "64b51cd543da47b2ab2aa4514374640d"
   :index-id "5c9ed77507174544bb8b8f9b50480401"
-  :current-query :e8fb941f95c4470c9f1d1175578f352c
+  :current-query :dc94eb136e9b46a8919a2aad3e82000b
   :example-query-id "b273d5362c0f42a6b198e5e3ab7374da"
   :queries {
             :e8fb941f95c4470c9f1d1175578f352c
@@ -11,8 +11,18 @@
              :es-query "flop flip flup"
              :query_id "id1"
              :items [{:type :github-commit :json "{a: \"a\"}"}]}
-            :id2
+            :dc94eb136e9b46a8919a2aad3e82000b
             {:label "bar"
              :es-query "blop blip blup"
              :query_id "id2"
-             :items [{:type :trello-comment :json ""}]}}}))
+             :items [{:type :trello-comment :json ""}
+                     ]}}}))
+
+
+(defn triquer []
+  (swap! app-state update-in
+           [:queries :dc94eb136e9b46a8919a2aad3e82000b :items]
+           conj
+           {:body {"compare" "https://github.com/AF83/funnel_http/compare/a6e82e80c30f...4fec1337b1ef", "pusher" {"email" "chatgri@gmail.com", "name" "chatgris"}, "created" false, "repository" {"size" 220, "fork" false, "private" false, "has_downloads" true, "created_at" 1402309085, "name" "funnel_http", "homepage" "", "url" "https://github.com/AF83/funnel_http", "open_issues" 0, "forks" 0, "organization" "AF83", "owner" {"email" nil, "name" "AF83"}, "has_wiki" true, "watchers" 0, "stargazers" 0, "language" "Elixir", "pushed_at" 1403279902, "id" 20642419, "description" "Streaming API built upon ElasticSearch's percolation.", "master_branch" "master", "has_issues" true}, "ref" "refs/heads/master", "head_commit" {"removed" [], "added" [], "message" "Fix README\n\nSigned-off-by: chatgris <julien.boyer@af83.com>", "modified" ["README.md"], "committer" {"email" "jboyer@af83.com", "name" "chatgris", "username" "chatgris"}, "author" {"email" "jboyer@af83.com", "name" "chatgris", "username" "chatgris"}, "url" "https://github.com/AF83/funnel_http/commit/4fec1337b1efce6c586162e3ea7256523654317e", "timestamp" "2014-06-20T17:58:07+02:00", "id" "4fec1337b1efce6c586162e3ea7256523654317e", "distinct" true}, "deleted" false, "forced" false, "after" "4fec1337b1efce6c586162e3ea7256523654317e", "commits" [{"removed" [], "added" [], "message" "Fix README\n\nSigned-off-by: chatgris <julien.boyer@af83.com>", "modified" ["README.md"], "committer" {"email" "jboyer@af83.com", "name" "chatgris", "username" "chatgris"}, "author" {"email" "jboyer@af83.com", "name" "chatgris", "username" "chatgris"}, "url" "https://github.com/AF83/funnel_http/commit/4fec1337b1efce6c586162e3ea7256523654317e", "timestamp" "2014-06-20T17:58:07+02:00", "id" "4fec1337b1efce6c586162e3ea7256523654317e", "distinct" true}], "before" "a6e82e80c30f64830ae7696ac561c038af301eeb"}}))
+
+(triquer)


docs; replace out of vocab POS tags with unk

--- src/clojure/zensols/nlparse/feature/lang.clj
+++ src/clojure/zensols/nlparse/feature/lang.clj
@@ -69,7 +69,31 @@
 (defn- pos-tag-count-keyword [lab]
   (-> (format "pos-tag-count-%s" lab) keyword))

-(defn pos-tag-features [tokens]
+(defn- pos-tag-or-none [tag]
+  (if (contains? (pt/pos-tags) tag)
+    tag
+    none-label))
+
+(defn pos-tag-features
+  "Return POS tag features computed all **tokens**, which include:
+
+  * **:pos-first-tag** The first POS tag.
+  * **:pos-last-tag** The last POS tag.
+  * **:pos-tag-count-adjective*: The number of adjectives found.
+  * **:pos-tag-ratio-adjective*: The ratio of adjectives to other POS tags.
+  * **:pos-tag-count-adverb*: The number of adverbs found.
+  * **:pos-tag-ratio-adverb*: The ratio of adverbs to other POS tags.
+  * **:pos-tag-count-noun*: The number of nouns found.
+  * **:pos-tag-ratio-noun*: The ratio of nouns to other POS tags.
+  * **:pos-tag-count-verb*: The number of verbs found.
+  * **:pos-tag-ratio-verb*: The ratio of verbs to other POS tags.
+  * **:pos-tag-count-wh*: The number of what/when/where type questions POS
+  tags.
+  * **:pos-tag-ratio-wh*: The ratio of what/when/where type question POS tags
+  to other POS tags.
+  * **:pos-tag-count-adjective*: The number of adjectives found.
+  * **:pos-tag-ratio-adjective*: The ratio of adjectives to other POS tags."
+  [tokens]
   (let [pos-tag-types (pt/pos-tag-types)
         tc (count tokens)]
     (->> (map :pos-tag tokens)
@@ -83,12 +107,12 @@
                 {(pos-tag-ratio-keyword k) (/ v tc)
                  (pos-tag-count-keyword k) v}))
          (apply merge)
-         (merge {:pos-last-tag (->> tokens last :pos-tag)
-                 :pos-first-tag (->> tokens first :pos-tag)}))))
+         (merge {:pos-last-tag (->> tokens last :pos-tag pos-tag-or-none)
+                 :pos-first-tag (->> tokens first :pos-tag pos-tag-or-none)}))))

 (defn pos-tag-feature-metas []
-  (vec (concat [[:pos-last-tag (into () (pt/pos-tags))]
-                [:pos-first-tag (into () (pt/pos-tags))]]
+  (vec (concat [[:pos-last-tag (cons none-label (into () (pt/pos-tags)))]
+                [:pos-first-tag (cons none-label (into () (pt/pos-tags)))]]
                (map #(vector (pos-tag-ratio-keyword %) 'numeric)
                     (pt/pos-tag-types))
                (map #(vector (pos-tag-count-keyword %) 'numeric)


Add a check for updates when starting services

This will log a message if a newer version is available. In the event
the update page can't be contacted, it will simply not log any message,
and continue running properly.

--- src/com/puppetlabs/puppetdb/cli/services.clj
+++ src/com/puppetlabs/puppetdb/cli/services.clj
@@ -61,7 +61,7 @@
         [clojure.tools.nrepl.transport :only (tty tty-greeting)]
         [clojure.core.incubator :only (-?>)]
         [com.puppetlabs.jdbc :only (with-transacted-connection)]
-        [com.puppetlabs.utils :only (cli! configure-logging! inis-to-map with-error-delivery version)]
+        [com.puppetlabs.utils :only (cli! configure-logging! inis-to-map with-error-delivery version upgrade-info)]
         [com.puppetlabs.puppetdb.scf.migrate :only [migrate!]]))

 (def cli-description "Main PuppetDB daemon")
@@ -119,6 +119,16 @@
             (send-command! "deactivate node" 1 node)))))

      (sleep))))
+
+(defn check-for-updates
+  "This will fetch the latest version number of PuppetDB and log if the system
+  is out of date."
+  []
+  (let [upgrade        (upgrade-info)
+        latest-version (:version upgrade)
+        out-of-date?   (:newer upgrade)]
+    (when out-of-date?
+      (log/info (format "Newer version %s is available!" latest-version)))))

 (defn configure-commandproc-threads
   "Update the supplied config map with the number of
@@ -267,6 +277,7 @@
                           (vec (for [n (range nthreads)]
                                  (future (with-error-delivery error
                                            (load-from-mq mq-addr mq-endpoint discard-dir db))))))
+          updater       (future (check-for-updates))
           web-app       (let [authorized? (if-let [wl (jetty :certificate-whitelist)]
                                             (pl-utils/cn-whitelist->authorizer wl)
                                             (constantly true))
@@ -293,6 +304,7 @@
       (let [exception (deref error)]
         (doseq [cp command-procs]
           (future-cancel cp))
+        (future-cancel updater)
         (future-cancel web-app)
         (future-cancel db-gc)
         ;; Stop the mq the old-fashioned way


Add assertions to validations

Add assertions to validations

--- src/active/clojure/validation.cljc
+++ src/active/clojure/validation.cljc
@@ -133,11 +133,17 @@
   "Lift a value into the validation applicative."
   make-validation-success)

+(defn- assert-validation-result [e]
+  (condition/assert (validation-result? e)
+                    (str "not a validation-result" (pr-str e))))
+
 (defn seq-validation
   "Apply two validations sequentially, from left to right.  Analogous
   to `Either` where `ValidationFailure` is `Left` and
   `ValidationSuccess` is `Right`."
   [v-1 v-2]
+  (assert-validation-result v-1)
+  (assert-validation-result v-2)
   (cond
     (and (validation-failure? v-1)
          (validation-failure? v-2))
@@ -154,12 +160,10 @@
   ;; `e` and a function `f` and applies `e`'s candidate iff `e` is
   ;; a [[ValidationSuccess]].
   [e f]
+  (assert-validation-result e)
   (cond
     (validation-failure? e) e
-    (validation-success? e) (f (validation-success-candidate e))
-
-    :else
-    (condition/assertion-violation `and-then "not a validation-result" e)))
+    (validation-success? e) (f (validation-success-candidate e))))

 (defn and-then
   "Apply validations in sequence.  Takes a validation `e` and a function


Update fn to communicate that second arg is unused

--- src/app/cljs/one/repmax/model.cljs
+++ src/app/cljs/one/repmax/model.cljs
@@ -70,7 +70,7 @@
 ;
 ;  If any step fails along the way, the state changes to :initialization-failed.

-(defmethod update-model :datastore-configuration/initialize [state message]
+(defmethod update-model :datastore-configuration/initialize [state _]
   (-> state
     (assoc :state :datastore-configuration)
     (assoc :datastore-configuration (datastore-configuration-from-cookies))))


Also reserve `drafts` as board slug.

Also reserve `drafts` as board slug.


Fix directory count

Fix directory count

--- src/eion/renderer/components.cljs
+++ src/eion/renderer/components.cljs
@@ -25,7 +25,9 @@
   (let [total (count items)
         { files :file directories :dir links :link } (count-by-type items)
         total-items (str total " items. ")
-        items-counts (str (+ files links) " files and " directories " directories. ")
+        file-count (int (+ files links))
+        dirs-count (int directories)
+        items-counts (str file-count " files and " dirs-count " directories.")
         selected-size (selected-file-size selection)]
       [:div { :class "directory-summary flex" }
         [:div { :class "counts"} (str total-items items-counts)]


Speed up pipeline runtime calculation for many builds without triggered-by information

--- src/buildviz/analyse/pipelines.clj
+++ src/buildviz/analyse/pipelines.clj
@@ -27,7 +27,9 @@
         pipeline))))

 (defn- find-pipeline-runs [builds]
-  (let [pipeline-end-candidates (filter #(is-pipeline-end? % builds) builds)]
+  (let [pipeline-end-candidates (->> builds
+                                     (filter :triggered-by)
+                                     (filter #(is-pipeline-end? % builds)))]
     (->> pipeline-end-candidates
          (map #(find-pipeline-ending-with % builds))
          (filter #(< 1 (count %))))))


Add proper timestamp field for es settings

--- src/in/co/sdslabs/slack_lens/config/es.clj
+++ src/in/co/sdslabs/slack_lens/config/es.clj
@@ -10,7 +10,7 @@

       :_id { :path "id" }

-      :_timestamp { :enabled true :path "ts" }
+      :_timestamp { :enabled true :path "timestamp" }

       :properties {
         :id { :type "integer" }
@@ -18,5 +18,5 @@
         :channel { :type "string" }
         :user { :type "string" }
         :text { :type "string" }
-        :ts { :type "string" }
+        :timstamp { :type "long" }
         :team { :type "string" }}}})


add some view helpers for getting element styles

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -3,7 +3,8 @@
   (:require [cljs.core.async :refer [<! put! chan alts! timeout]]
             [cljs-time.format :as f]
             [cljs-time.core :as t]
-            [chat.client.store :as store]))
+            [chat.client.store :as store]
+            [goog.style :as gstyle]))

 ; TODO: clojure 1.8 should implement these
 (defn starts-with? [s prefix]
@@ -66,3 +67,18 @@
   [e]
   [(.-clientX e) (.-clientY e)])

+(defn element-offset
+  [elt]
+  (let [offset (gstyle/getPageOffset elt)]
+    [(.-x offset) (.-y offset)]))
+
+(defn get-style
+  [elt prop]
+  (cond
+    (.-currentStyle elt)
+    (aget (.-currentStyle elt) prop)
+
+    (.-getComputedStyle js/window)
+    (.. js/document -defaultView
+        (getComputedStyle elt nil)
+        (getPropertyValue prop))))


don't force non-collapse on new messages    (due to weird behaviour when you send a message causing many to collapse)

--- src/chat/client/views/threads.cljs
+++ src/chat/client/views/threads.cljs
@@ -102,8 +102,7 @@
                                                      (:user-id prev-message))
                                                   (> (* 2 60 1000) ; 2 minutes
                                                      (- (:created-at message)
-                                                        (or (:created-at prev-message) 0)))
-                                                  (not (unseen? message thread)))}}))))))
+                                                        (or (:created-at prev-message) 0))))}}))))))
               (om/build new-message-view {:thread-id (thread :id)
                                           :placeholder (if (thread :new?)
                                                          "Start a conversation..."


[PDOK-1952] the version column was stored as a uuid, this results in getdescriptiontype error. If the data is stored as text there is no issue. Data is processed just fine by featured. Also the columns with varchar(xxx) changed -> text. (text is the 'prefered' option for postgresql)

--- src/main/clojure/pdok/featured/geoserver.clj
+++ src/main/clojure/pdok/featured/geoserver.clj
@@ -39,12 +39,12 @@

       (pg/create-table db dataset table
                 [:gid "serial" :primary :key]
-                [:_id "varchar(100)"]
-                [:_version "uuid"]
+                [:_id "text"]
+                [:_version "text"]
                 [:_geometry_point "geometry"]
                 [:_geometry_line "geometry"]
                 [:_geometry_polygon "geometry"]
-                [:_geo_group "varchar (20)"])
+                [:_geo_group "text"])

       (pg/create-index db dataset table "_id")
       (pg/add-geo-constraints db dataset table :_geometry_point ndims srid)


remove TODO

remove TODO

--- src/clj/backtype/storm/testing.clj
+++ src/clj/backtype/storm/testing.clj
@@ -383,7 +383,6 @@
                   (uuid)
                   (Bolt.
                    (serialize-component-object capturer)
-                   ;; TODO need to do a direct subscription for direct streams...
                    (mk-plain-component-common (into {} (for [[id direct?] all-streams]
                                                          [id (if direct?
                                                                (mk-direct-grouping)


Refactor interesting system bits to component-dsl

--- src/clj/com/frereth/web/system.clj
+++ src/clj/com/frereth/web/system.clj
@@ -11,6 +11,7 @@
             [clojure.java.io :as io]
             [com.stuartsierra.component :as component]
             [com.frereth.common.util :as common]
+            [component-dsl.system :as cpt-dsl]
             [io.aviso.config :as cfg]
             [ribol.core :refer (raise)]
             [schema.core :as s]
@@ -21,132 +22,14 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Schema

-(def NameSpace s/Symbol)
-(def SchemaName s/Symbol)

-(def SchemaDescription
-  "Really just a map of symbols marking a namespace to
-  symbols naming schemata in that namespace"
-  {NameSpace (s/either SchemaName [SchemaName])})
-
-(def Schema
-  "An individual description"
-  s/Any)
-
-(def Schemata
-  "Really just so I have a meaningful name to call these things"
-  [Schema])
-
-(def ComponentName s/Keyword)
-(def ComponentInitializer (s/either s/Symbol [(s/one s/Symbol "name") s/Any]))
-(def InitializationMap {ComponentName ComponentInitializer})
-
-(def ComponentInstanceName
-  "TODO: Try redefining ComponentName as this
-I'm just not sure that'll work in non-sequences
-(such as when I'm using it as the key in a map)"
-  (s/one s/Keyword "name"))
-(def ComponentInstance (s/one s/Any "instance"))
-(def Component [ComponentInstanceName ComponentInstance])

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internals

-(s/defn load-var :- s/Any
-  "Get the value of var inside namespace"
-  [namespace :- s/Symbol
-   var-name :- s/Symbol]
-  (let [sym (symbol (str namespace "/" var-name))]
-    (try
-      (eval sym)
-      (catch RuntimeException ex
-        ;; Logger isn't initialized yet
-        (print "Loading" var-name "from" namespace "failed")
-        (raise {:problem var-name
-                :reason ex})))))
-
-(s/defn require-schematic-namespaces!
-  "Makes sure all the namespaces where the schemata
-are found are available, so we can access the schemata"
-  [d :- SchemaDescription]
-  (dorun (map require (keys d))))
-
-(comment
-  (mapcat (fn [[k v]]
-            (println "Extracting" v "from ns" k)
-            (if (symbol? v)
-              (load-var k v)
-              (mapcat (partial load-var k) v)))
-          {'one '[schema-a schema-b]
-           'two 'schema-a}))
-
-(s/defn extract-schema :- Schemata
-  "Returns a seq of the values of the vars in each namespace"
-  [d :- SchemaDescription]
-  (mapcat (fn [[k v]]
-         (if (symbol? v)
-           [(load-var k v)]
-           (map (partial load-var k) v)))
-       d))
-
-(s/defn translate-schematics! :- Schemata
-  "require the namespace and load the schema specified in each.
-
-N.B. Doesn't even think about trying to be java friendly. No defrecord!"
-  [d :- SchemaDescription]
-  (require-schematic-namespaces! d)
-  (extract-schema d))
-
-;;; This actually returns a sequence of the pairs that form a Component.
-;;; So something like (concat [ComponentInstanceName ComponentInstance] ...)
-;;; Q: How can I specify that?
-;;; Q: Would it be better to use map instead of mapcat to build this
-;;; sequence, then concat it before I actually use it?
-(s/defn ^:always-validate initialize! :- [Component]
-  "require the individual namespaces and call each Component's constructor,
-returning a seq of name/instance pairs that probably should have been a map
-
-N.B. this returns key-value pairs that are suitable for passing to dependencies
-as the last argument of apply"
-  [descr :- InitializationMap
-   config-options :- {s/Any s/Any}]
-  (map (fn [[name ctor]]
-         ;; Called for the side-effects
-         ;; This should have been taken care of below,
-         ;; in the call to require-schematic-namespaces!
-         ;; But better safe than sorry
-         (-> ctor namespace symbol require)
-
-         (let [real-ctor (resolve ctor)
-               ;; Note the way this couples the Component name
-               ;; w/ the options.
-               ;; I'm not sure that's a bad thing
-               instance (real-ctor (name config-options))]
-           [name instance]))
-       descr))
-
-(s/defn ^:always-validate system-map! :- SystemMap
-  [descr :- InitializationMap
-   config-options :- {s/Any s/Any}]
-  (let [inited-pairs (initialize! descr config-options)
-        inited (apply concat inited-pairs)]
-    (apply component/system-map inited)))
-
-(s/defn ^:always-validate dependencies :- SystemMap
-  [inited :- SystemMap
-   descr :- {s/Keyword s/Any}]
-  (comment)
-  (let [ks (keys inited)]
-    (comment (log/debug "Preparing to build dependency tree for\n"
-                        (common/pretty inited)
-                        "with" (count ks) "keys\n"
-                        (common/pretty ks)
-                        "\nbased on the dependency description\n"
-                        (common/pretty descr))))
-  (component/system-using inited descr))
-
 (defn configure-logging!
-  "Doesn't belong here"
+  "Doesn't belong here
+TODO: Move to a Component in common"
   [log-file-name]
   (log/set-config!
    ;; TODO: This needs to rotate
@@ -159,9 +42,12 @@
 ;;; Public

 ;; TODO: What's the schema?
+;; I'm using some pieces in here and ctor that are really internal
+;; to component-dsl.
+;; TODO: Don't do that.
 (defn combine-options
   [command-line-args system-description]
-  (let [ctor-schemata (-> system-description :schemas translate-schematics!)]
+  (let [ctor-schemata (-> system-description :schemas cpt-dsl/translate-schematics!)]
     (cfg/assemble-configuration {:prefix "frereth"
                                  :schemas ctor-schemata
                                  ;; seq of absolute file paths that will
@@ -211,9 +97,8 @@
         options (combine-options command-line-args system-description)
         pre-init (-> system-description
                      :initialization-map
-                     (system-map! options))]
-    (dependencies pre-init (:dependencies system-description))
-    #_(component/system-using dependencies)))
+                     (cpt-dsl/system-map options))]
+    (cpt-dsl/dependencies pre-init (:dependencies system-description))))

 ;; TODO: This needs to be a unit test
 (comment


Handle unexpected input in the parse tree

Finds unexpected nodes at any level and submits the outermost node to
nREPL for the real failure message (or success, if we're wrong somehow).

--- src/clj/reply/eval_modes/nrepl.clj
+++ src/clj/reply/eval_modes/nrepl.clj
@@ -72,7 +72,10 @@
            parse-tree (sjacket.parser/parser concatted-text)]
        (if (empty? (:content parse-tree))
          (list "")
-         (let [completed? #(not= :net.cgrand.parsley/unfinished (:tag %))
+         (let [completed? (fn [node]
+                            (or (not= :net.cgrand.parsley/unfinished (:tag node))
+                                (some #(= :net.cgrand.parsley/unexpected (:tag %))
+                                      (tree-seq :tag :content node))))
                complete-forms (take-while completed? (:content parse-tree))
                remainder (drop-while completed? (:content parse-tree))
                form-strings (map sjacket/str-pt


Query & display hash-tags again.

Query & display hash-tags again.

--- src/cljs/link_collective/view.cljs
+++ src/cljs/link_collective/view.cljs
@@ -25,18 +25,27 @@
   (let [db (om/value
             (get-in stage ["eve@polyc0l0r.net"
                            #uuid "b09d8708-352b-4a71-a845-5f838af04116"
-                           "master"]))]
+                           "master"]))
+        qr (map (partial zipmap [:id :title :detail-url :detail-text :user :ts])
+                (d/q '[:find ?p ?title ?durl ?dtext ?user ?ts
+                       :where
+                       [?p :user ?user]
+                       [?p :detail-url ?durl]
+                       [?p :detail-text ?dtext]
+                       [?p :title ?title]
+                       [?p :ts ?ts]]
+                     db))]
     (sort-by
      :ts
-     (map (partial zipmap [:id :title :detail-url :detail-text :user :ts])
-          (d/q '[:find ?p ?title ?durl ?dtext ?user ?ts
-                 :where
-                 [?p :user ?user]
-                 [?p :detail-url ?durl]
-                 [?p :detail-text ?dtext]
-                 [?p :title ?title]
-                 [?p :ts ?ts]]
-               db)))))
+     (map (fn [{:keys [id] :as p}]
+            (assoc p :hashtags (first (first (d/q '[:find (distinct ?hashtag)
+                                                    :in $ ?pid
+                                                    :where
+                                                    [?h :post ?pid]
+                                                    [?h :tag ?hashtag]]
+                                                  db
+                                                  id)))))
+          qr))))

 (defn get-comments [post-id stage]
   (let [db (om/value
@@ -66,7 +75,7 @@

 (defsnippet link-header-hashtag "main.html" [:.link-header-hashtag-item]
   [hashtag]
-  {[:.link-header-hashtag-item-text] (content hashtag)})
+  {[:.link-header-hashtag-item-text] (content (name hashtag))})

 (defsnippet link-detail "main.html" [:.link-detail]


Add capability to reset message ioloop interrupt

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -751,7 +751,14 @@

 (declare schedule-next-timeout!)
 ;; FIXME: This seems like it really should be debug only
-(let [interrupted (promise)]
+(let [interrupted (atom nil)]
+  (defn interrupted?
+    []
+    @interrupted)
+  (comment
+    (interrupted?)
+    )
+
   (s/fdef action-trigger!
           :args (s/cat :timing-details ::action-timing-details
                        :io-handle ::specs/io-handle
@@ -1013,7 +1020,7 @@
           my-logs (::log/state state)
           forked-logs (log/fork my-logs)
           mid (System/currentTimeMillis)]
-      (if (not (realized? interrupted))
+      (if (not (interrupted?))
         ;; This is taking a ludicrous amount of time.
         ;; Q: How much should I blame on logging?
         (schedule-next-timeout! io-handle (assoc state
@@ -1033,14 +1040,21 @@
                                my-logs)))
     nil)

-  (defn interrupt
+  (defn interrupt!
     []
     (println "FIXME: Debug only\nInterrupting ioloop manually")
-    (deliver interrupted true))
-
-  (defn interrupted?
+    (reset! interrupted true))
+  (comment
+    (interrupt!)
+    )
+
+  (defn clear-interrupt
     []
-    (realized? interrupted)))
+    (println "Unblocking ioloop manually")
+    (reset! interrupted false))
+  (comment
+    (clear-interrupt!)
+    ))

 (comment
   (let [delta_f ##Inf,


xlate top-level message helpers w/o circle buffer

Untested, but at least they compile.

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -11,26 +11,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Magic constants
-
-(def incoming
-  "Number of blocks in inbound queue
-
-  Must be a power of 2"
-  64)
-
-(def outgoing
-  "Number of blocks in outbound queue
-
-Must be a power of 2"
-  128)
-
-(def outgoing-1
-  "Decremented size of outbound queue
-
-Used w/ bitwise-and to calculate modulo and wrap circular index
-
-Because this is used more often than outgoing"
-  (dec outgoing))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Specs
@@ -42,6 +22,11 @@
 ;;; Position of a block's first byte within the stream
 ;;; Corresponds to blockpos
 (s/def ::start-pos int?)
+
+;;; Looks like a count:
+;;; How many times has this block been sent?
+;;; Corresponds to blocktransmissions[]
+(s/def ::transmissions int?)

 ;;; Time of last message sending this block
 ;;; 0 means ACK'd
@@ -54,27 +39,59 @@

 (s/def ::block (s/keys :req [::length
                              ::start-pos
-                             ::time]))
+                             ::time
+                             ::transmissions]))
 (s/def ::blocks (s/and (s/coll-of ::block)
                        ;; Actually, the length must be a power of 2
                        ;; TODO: Improve this spec!
                        ;; (Reference implementation uses 128)
                        #(= (rem (count %) 2) 0)))

-;;; Index into the start of a circular queue
-;;; Q: Is this a good idea?
-(s/def ::block-first int?)
-
-;; Number of outgoing blocks being tracked
-(s/def ::block-num integer?)
-
 ;; If nonzero: minimum of active ::time values
-(s/def ::earliest-time integer?)
-
-(s/def ::state (s/keys ::req [::block-first
-                              ::block-num
-                              ::blocks
-                              ::earliest-time]))
+(s/def ::earliest-time int?)
+
+;; Number of initial bytes sent and fully acknowledged
+(s/def ::send-acked int?)
+;; Number of additional bytes to send (i.e. haven't been sent yet)
+(s/def ::send-bytes int?)
+;; within sendbytes, number of bytes absorbed into blocks
+(s/def ::send-processed int?)
+;; Those 3 really swirld around the sendbuf array/circular queue
+;; For this pass, at least, I'm trying to avoid anything along those lines
+
+;; 2048 for normal EOF after sendbytes
+;; 4096 for error after sendbytes
+;; Dual-purposing a magic constant bit for both the
+;; over-wire communications flag and the
+;; internal behavioral flow-controller
+;; chafes.
+;; TODO: Don't.
+(s/def ::send-eof #{false ::normal ::error})
+(s/def ::send-eof-processed boolean?)
+(s/def ::send-eof-acked boolean?)
+
+;; Totally undocumented (so far)
+(s/def ::total-blocks int?)
+(s/def ::total-block-transmissions int?)
+
+(s/def ::state (s/keys ::req [::blocks
+                              ::earliest-time
+                              ::send-eof
+                              ::send-eof-processed
+                              ::send-eof-acked
+                              ::total-blocks
+                              ::total-block-transmissions]))
+
+(defn initial-state
+  ;; TODO: This should probably just be public
+  []
+  {::blocks []
+   ::earliest-time 0
+   ::send-eof false
+   ::send-eof-processed false
+   ::send-eof-acked false
+   ::total-blocks 0
+   ::total-block-transmissions 0})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal
@@ -102,9 +119,14 @@
   "Mark blocks between positions start and stop as ACK'd

 Based [cleverly] on acknowledged, running from lines 155-185"
-  [{:keys [::block-first
-           ::block-num
-           ::blocks]
+  [{:keys [::blocks
+           ::send-acked
+           ::send-bytes
+           ::send-processed
+           ::send-eof
+           ::send-eof-acked
+           ::total-block-transmissions
+           ::total-blocks]
     :as state}
    start
    stop]
@@ -112,21 +134,25 @@
 ;;;           159-167: Flag these blocks as sent
 ;;;                    Marks blocks between start and stop as ACK'd
 ;;;                    Updates totalblocktransmissions and totalblocks
-    (let [pre-acked (map (fn [n]
-                           (let [pos (bit-and (+ block-first n) outgoing-1)]
-                             ;; This raises the spectacle of a huge open question:
-                             ;; do I want to bother with the trappings of a circular
-                             ;; buffer?
-                             ;; It seems likely to reduce GC somewhat, but nowhere
-                             ;; near what I could achieve even just building everything
-                             ;; on byte-arrays.
-                             ;; Which simply is not going to happen until there's
-                             ;; convincing evidence that it's worthwhile.
-                             ;; (It probably is, but not for a first pass, even though
-                             ;; that's a more accurate translation).
-                             ))
-                     (range block-num))]
-      (throw (RuntimeException. "Translate the rest"))
+    (let [acked (reduce (fn [{:keys [::n]
+                              :as acc}
+                             block]
+                          (let [start-pos (::start-pos block)]
+                            (if (<= start
+                                    start-pos
+                                    (+ start-pos (::length block))
+                                    stop)
+                              (-> acc
+                                  (assoc-in [::blocks n ::time] 0)
+                                  (update ::total-blocks inc)
+                                  (update ::total-block-transmissions + (::transmissions block)))
+                              (update acc ::n inc))))
+                        (assoc state ::n 0)
+                        blocks)]
+      ;; To match the next block, the main point is to discard
+      ;; the first sequence of blocks that have been ACK'd
+      ;; drop-while seems obvious
+      ;; However, we also need to update send-acked, send-bytes, and send-processed
 ;;;           168-176: Updates globals for adjacent blocks that
 ;;;                    have been ACK'd
 ;;;                    This includes some counters that seem important:
@@ -135,9 +161,21 @@
 ;;;                        sendbytes
 ;;;                        sendprocessed
 ;;;                        blockfirst
+      (let [[to-drop to-keep] (split-with #(= 0 (::time %)) acked)
+            dropped-block-lengths (apply + (map ::length to-drop))
+            state (update state ::send-acked + dropped-block-lengths)
+            state (update state ::send-bytes - dropped-block-lengths)
+            state (update state ::send-processed - dropped-block-lengths)
 ;;;           177-182: Possibly set sendeofacked flag
+            state (or (when (and send-eof
+                                 (= start 0)
+                                 (> stop (+ (::send-acked state)
+                                            (::send-bytes state)))
+                                 (not send-eof-acked))
+                        (update state ::send-eof-acked true))
+                      state)]
 ;;;           183: earliestblocktime_compute()
-      )
+        (assoc state ::earliest-time (earliest-block-time blocks))))
     ;;; No change
     state))


Fix concurrency of auto-binding.

Fix concurrency of auto-binding.


Selfie badges

Selfie badges


Remove old scratch test.

Remove old scratch test.

--- test/scratch/binding.cljs
+++ test/scratch/binding.cljs
@@ -1,83 +0,0 @@
-(ns scratch.binding
-  (:refer-clojure :exclude [+ - =])
-  (:use-macros [c2.util :only [p pp timeout interval profile
-                               abind!]])
-  (:use [c2.core :only [unify]]
-        [cassowary.core :only [cvar simplex-solver
-                               constrain! stay! value
-                               + - =]])
-  (:require [c2.dom :as dom]))
-
-;; (def !c (atom ["red"]))
-
-;; (def co (abind! "#main"
-;;                 [:ol
-;;                  (unify @!c (fn [color]
-;;                               [:li {:style {:color color :-webkit-transition "all 2s ease-out"}} "list"]))]))
-;; (timeout 1000
-;;          (swap! !c #(conj % "blue")))
-;; (timeout 2000
-;;          (reset! !c ["purple" "red" "blue"]))
-
-
-
-
-
-
-;; (set! *print-fn* #(.log js/console %))
-;; (profile "render/append"
-;;          (dotimes [_ 1000]
-;;            (dom/append! "#main" [:p "new dom" [:span {:style {:color "blue"}}
-;;                                                "IMPLEMENTATION!"]])))
-
-(extend-type Cl/Variable
-  IHash
-  (-hash [this] (goog.getUid this)))
-
-
-
-(let [height 200, width 800, max-radius 40
-      solver  (simplex-solver)
-      spacing (cvar) ;;The spacing between circles (to be solved for)
-      n 10
-      circles (repeatedly n #(hash-map :r  (cvar (* max-radius (rand)))
-                                       :cx (cvar 0)
-                                       :cy (cvar (/ height 2))))]
-
-  ;;The circle radii and vertical positions are constants
-  (doseq [c circles]
-    (stay! solver (:r c))
-    (stay! solver (:cy c)))
-
-  ;;Spacing between first circle and the wall
-  (constrain! solver (= 0 (- (:cx (first circles))
-                             (:r (first circles))
-                             spacing)))
-
-  ;;Spacing between each pair of neighboring circles
-  (doseq [[left right] (partition 2 1 circles)]
-    (constrain! solver (= spacing (- (:cx right)
-                                     (:r right)
-                                     (+ (:cx left) (:r left))))))
-
-  ;;Spacing between last circle and the wall
-  (constrain! solver (= spacing (- width
-                                   (:cx (last circles))
-                                   (:r (last circles)))))
-
-  (let [!grayscales (atom (range 0 101 10))]
-    ;;Draw the circles as SVG
-    (abind! "body"
-            [:svg {:width width :height height
-                   :style {:border "1px solid black"
-                           :margin "20px"}}
-             (unify (map vector circles @!grayscales)
-                    (fn [[c gray]]
-                      [:circle {:style {:-webkit-transition "all 2s ease-out"
-                                        :fill (str "hsl(0,0%," gray "%)")}
-                                :cx (value (:cx c))
-                                :cy (value (:cy c))
-                                :r (value (:r c))}]))])
-
-    (interval 2000
-              (swap! !grayscales reverse))))


Fixed the explosion of REPL on bad input.


Fix query processor for `limit: nil`; handle `page` clause

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -102,6 +102,7 @@
 ;;       [">=" 1412 4]]
 (defmethod apply-form :filter [[_ filter-clause]]
   (match filter-clause
+    nil                  nil ; empty clause
     [nil nil]            nil ; empty clause
     ["AND" & subclauses] (let [m (->> subclauses                                                      ; so far only `AND` filtering is available in the UI
                                       (map (fn [[filter-type field-id value]]                          ; just convert filter-types like `"<="` directly to symbols
@@ -132,6 +133,19 @@
                  `(order ~(field-id->kw field-id) ~(case asc-desc
                                                      "ascending" :ASC
                                                      "descending" :DESC)))))))
+
+;; ### `:page`
+;; ex.
+;;
+;;     {:page 1
+;;      :items 20}
+(defmethod apply-form :page [[_ {:keys [items page]}]]
+  {:pre [(integer? items)
+         (integer? page)]}
+  (println "ITEMS: " items)
+  (println "PAGE: " page)
+  `[(limit ~items)
+    (offset ~(* items (- page 1)))])

 ;; ### `:source_table`
 (defmethod apply-form :source_table [_] ; nothing to do here since getting the `Table` is handled by `process`


first version of page handler

first version of page handler

--- src/hypertext_ray/page_handler.clj
+++ src/hypertext_ray/page_handler.clj
@@ -1,9 +1,29 @@
 (ns hypertext-ray.page-handler
-  (:use [clj-webdriver.taxi])
+  (:use [clj-webdriver.taxi]
+     [hypertext-ray re-maps finders explore navigation login])

   )

-; page-hints, to idenitfy current page
-; front
-; user agreement
-;
+
+
+(defn action-dispatch [siteinfo action current-page]
+  (case action
+    :login (do-login siteinfo)
+    :wait (println "wait")
+    :collect-data (find-data siteinfo current-page)
+    :logout (println "logout")
+    :quit (quit)
+    siteinfo
+    )
+  )
+
+(defn handle-page [siteinfo]
+  (let [current-page (match-page siteinfo)
+        action-list (current-page (:pageactions siteinfo))
+        ]
+    (println current-page action-list)
+    (reduce #(action-dispatch % current-page) siteinfo action-list)
+
+    )
+  )
+


Use affine transform to position primitives within compounds

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


make sure only cljs+goog names affect munging

JS aliases are already unique enough already and otherwise
the set to consider could become quite large (not that that matters)

--- src/main/shadow/build/compiler.clj
+++ src/main/shadow/build/compiler.clj
@@ -994,7 +994,7 @@
                (not= x :none)))

          ns-roots
-         (->> sources
+         (->> (concat cljs goog)
               (mapcat :provides)
               (into #{})
               (map str)


make the default-times arg to defspec optional

--- src/simple_check/clojure_test.clj
+++ src/simple_check/clojure_test.clj
@@ -8,6 +8,8 @@
     (throw result)
     (ct/is result)))

+(def ^:dynamic *default-test-count* 100)
+
 (defmacro defspec
   "Defines a new clojure.test test var that uses `quick-check` to verify
   [property] with the given [args] (should be a sequence of generators),
@@ -15,22 +17,25 @@
   with no arguments to trigger this test directly (i.e.  without starting a
   wider clojure.test run), or with a single argument that will override
   [default-times]."
-  [name default-times property]
-  `(do
-     ;; consider my shame for introducing a cyclical dependency like this...
-     ;; Don't think we'll know what the solution is until simple-check
-     ;; integration with another test framework is attempted.
-     (require 'simple-check.core)
-     (defn ~(vary-meta name assoc
-                       ::defspec true
-                       :test `#(#'assert-check (assoc (~name) :test-var (str '~name))))
-       ([] (~name ~default-times))
-       ([times# & {:keys [seed# max-size#] :as quick-check-opts#}]
-          (apply
+  ([name property]
+   (defspec name *default-test-count* property))
+
+  ([name default-times property]
+   `(do
+      ;; consider my shame for introducing a cyclical dependency like this...
+      ;; Don't think we'll know what the solution is until simple-check
+      ;; integration with another test framework is attempted.
+      (require 'simple-check.core)
+      (defn ~(vary-meta name assoc
+                        ::defspec true
+                        :test `#(#'assert-check (assoc (~name) :test-var (str '~name))))
+        ([] (~name ~default-times))
+        ([times# & {:keys [seed# max-size#] :as quick-check-opts#}]
+         (apply
            simple-check.core/quick-check
            times#
            (vary-meta ~property assoc :name (str '~property))
-           (flatten (seq quick-check-opts#)))))))
+           (flatten (seq quick-check-opts#))))))))

 (def ^:dynamic *report-trials*
   "Controls whether property trials should be reported via clojure.test/report.


oops, mistyped on last commit, this fixes it.

--- src/midje/internal_ideas/fakes.clj
+++ src/midje/internal_ideas/fakes.clj
@@ -232,7 +232,7 @@
 (defmethod call-count-incorrect? :fake [fake]
   (let [method (or (:times fake) :default )
         count (fake-count fake)]
-    (cond (= method :defaul t )
+    (cond (= method :default )
       (zero? count)

       (number? method)


Fix check for publisher boards feature.

Fix check for publisher boards feature.

--- src/oc/storage/resources/board.clj
+++ src/oc/storage/resources/board.clj
@@ -327,8 +327,8 @@
          (sequential? additional-keys)
          (every? #(or (string? %) (keyword? %)) additional-keys)]}
   (let [read-resources (if config/publisher-board-enabled?
-                         (partial db-common/read-resources conn table-name :org-uuid org-uuid)
-                         (partial db-common/filter-resources conn table-name :org-uuid org-uuid [{:fn :ne :value true :field :publisher-board}]))]
+                         (partial db-common/filter-resources conn table-name :org-uuid org-uuid [{:fn :ne :value true :field :publisher-board}])
+                         (partial db-common/read-resources conn table-name :org-uuid org-uuid))]
     (->> (into [primary-key :slug :name :draft] additional-keys)
       read-resources
       (sort-by :slug)


Cosmetic fixe on project state functions.

--- src/uxbox/main/state/project.cljs
+++ src/uxbox/main/state/project.cljs
@@ -56,7 +56,7 @@
                  (assoc :shapes shapes))]
     (-> state
         (update :shapes-by-id merge shapes-by-id)
-        (update-in [:pages-by-id] assoc (:id page) page))))
+        (update :pages-by-id assoc (:id page) page))))

 (defn purge-page
   "Remove page and all related stuff from the state."


Add the rewriting pass

Add the rewriting pass

Mad props to @Bronsa for the var to symbol hack

--- src/oxcart/passes/fn_reduction.clj
+++ src/oxcart/passes/fn_reduction.clj
@@ -17,6 +17,7 @@
             [oxcart.passes :refer :all]
             [oxcart.passes.lambda-lift :refer [lift-lambdas]]
             [oxcart.pattern :as pattern]
+            [clojure.tools.analyzer.ast :refer [postwalk]]
             [clojure.tools.analyzer.passes.jvm.emit-form :refer [emit-form]]))

@@ -34,17 +35,24 @@

 (defn munge-symbol
-  "Stub subject to change based on what TANAL permits, the issue is
-  going to be symbol vs. var type in the AST. Munging vars is gonna be
-  a bitch, munging symbols could happen."
-  [sym arity vardic]
+  [sym arity variadic]
   (symbol
    (str sym "$arity$"
-        (if vardic
+        (if variadic
           (- arity 2)
           arity)
-        (when vardic
+        (when variadic
           "+"))))
+
+
+(defn method-variadic?
+  [method]
+  (if (list? method)
+    (some (partial = '&) (first method))
+    (if (map? method)
+      (or (:variadic? method)
+          (some :variadic?
+                (:params method))))))

 (defn munge-fn-name
@@ -53,7 +61,7 @@
   (munge-symbol
    (pattern/def->symbol wrapping-def)
    (count params)
-   (some :vardic params)))
+   (method-variadic? method)))

 (defn munge-callsite
@@ -103,9 +111,9 @@
                                :when (not (= p '&))]
                            (gensym "OX__P"))

-       vardic?          (some (partial = '&) params)
-
-        new-form         (if vardic?
+        variadic?          (some (partial = '&) params)
+
+        new-form         (if variadic?
                            (list (vec (concat (butlast new-params) ['&] [(last new-params)]))
                                  (concat (list 'apply)
                                          (list (pattern/def->symbol promoted-method))
@@ -118,7 +126,10 @@

 (defn rewrite-fn
-  [{:keys [methods env] :as fn-ast} wrapping-def prefix-forms-atom]
+  [{:keys [methods env] :as fn-ast}
+   wrapping-def
+   prefix-forms-atom
+   munged-fns-atom]
   (if (not (or (pattern/fn? fn-ast)
                (fn-is-multiple-arity? fn-ast)))
     ast
@@ -145,6 +156,17 @@
                               methods
                               promotes)))]

+      (swap! munged-fns-atom
+             assoc (pattern/def->var wrapping-def)
+                   (->> (map (fn [m p]
+                               [(if (:variadic? (:init p))
+                                  :variadic
+                                  (count (first (:arglists p))))
+                                (pattern/def->var p)])
+                             methods
+                             promotes)
+                        (into {})))
+
       (reset! prefix-forms-atom
               (if name
                 (cons fdecl promotes)
@@ -174,12 +196,48 @@
   (if-not (pattern/def? ast)
     ast
     (let [top-level-forms (atom [])
-          new-fn-ast      (rewrite-fn (get ast :init)
-                                      ast top-level-forms)]
+          new-ast         (update ast :init
+                                  update-through-meta
+                                  rewrite-fn
+                                      ast
+                                      top-level-forms
+                                      munged-fns-atom)]

       (-> @top-level-forms
           vec
-          (conj (assoc ast :init new-fn-ast))))))
+          (conj new-ast)))))
+
+
+(defn var-name
+  [v]
+  (symbol
+   (-> v .ns ns-name str)
+   (-> v .sym str)))
+
+
+(defn rewrite-fn-invokes
+  "λ AST → (Atom {Var → {(U Number :variadic) → Var}}) → AST
+
+  Walks the argument AST, rewriting invoke nodes where it is possible
+  to call a previously emitted single arity function rather than a
+  decomposed multiple arity function by doing static arity resolution
+  defaulting to the variadic implementation if present and failing
+  back to the original unaltered function in all cases. Returns an
+  updated top level form."
+  [top-ast munged-fns]
+  (let [munged-fns @munged-fns]
+    (postwalk top-ast
+              (fn [{:keys [op fn args env] :as node}]
+                (if (and (= op :invoke)
+                         (= :var (:op fn)))
+                  (if-let [arities (munged-fns (-> fn :var))]
+                    (if-let [var (get munged-fns
+                                      (count args)
+                                      (get munged-fns :variadic))]
+                      (assoc node :fn (ast (var-name var) env))
+                      node)
+                    node)
+                  node)))))

 (defn reduce-fn-arities
@@ -209,6 +267,7 @@
         ;; FIXME
         ;;   Is this something I need to do? Are there cases in which
         ;;   this analysis is itself desructive? all existing fns,
-        ;;   defs and vars should be preserved by this.
+        ;;   defs and vars should be preserved by this, including all
+        ;;   metadata on them.
         (clobber-passes)
         (record-pass reduce-fn-arities))))


New tests: test-format-minutes1..test-format-minutes3

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -170,3 +170,25 @@
               "2 hours and 2 minutes ago"    (format-hours 2 2)
               "2 hours and 100 minutes ago"  (format-hours 2 100))))

+(deftest test-format-minutes-1
+    "Check the function clj-calendar.format-datetime/format-minutes."
+    (testing "the function clj-calendar.format-datetime/format-minutes."
+        (are [x y] (= x y)
+              "one minute ago"              (format-minutes 1 0))))
+
+(deftest test-format-minutes-2
+    "Check the function clj-calendar.format-datetime/format-minutes."
+    (testing "the function clj-calendar.format-datetime/format-minutes."
+        (are [x y] (= x y)
+              "one minute and one second ago"  (format-minutes 1 1)
+              "one minute and 2 seconds ago"   (format-minutes 1 2)
+              "one minute and 100 seconds ago" (format-minutes 1 100))))
+
+(deftest test-format-minutes-3
+    "Check the function clj-calendar.format-datetime/format-minutes."
+    (testing "the function clj-calendar.format-datetime/format-minutes."
+        (are [x y] (= x y)
+              "2 minutes and one second ago"   (format-minutes 2 1)
+              "2 minutes and 2 seconds ago"    (format-minutes 2 2)
+              "2 minutes and 100 seconds ago"  (format-minutes 2 100))))
+


Fix broken client child in handshake test (WIP)

It was failing to return a response because I was trying to run swap! on
the state atom's value instead of the atom itself.

The test still doesn't pass, but this was a major sticking point.

--- test/frereth_cp/message/handshake_test.clj
+++ test/frereth_cp/message/handshake_test.clj
@@ -198,7 +198,7 @@
   (is incoming)
   (is (or (keyword? incoming)
           (< 0 (count incoming))))
-  (let [prelog (utils/pre-log "Handshake Client: child callback")
+  (let [prelog (utils/pre-log "Handshake Client: child process trigger")
         client-state @client-state-atom]
     (log/info prelog
               (str "Client State: "
@@ -207,7 +207,8 @@
                    incoming ", a " (class incoming)))
     (if incoming
       (let [result (dfrd/future
-                     (let [{n ::count} client-state
+                     (let [prelog2 (utils/pre-log "Handshake Client: child processor")
+                           {n ::count} client-state
                            next-message
                            (condp = n
                              0 (do
@@ -234,7 +235,8 @@
                                  ;; TODO: don't rely on that.
                                  ;; It really would be more efficient for the other
                                  ;; side to batch up the ACK and this response
-                                 (is (b-t/bytes= incoming (vec (range chzbrgr-length))))
+                                 (is (b-t/bytes= incoming
+                                                 (byte-array (vec (range chzbrgr-length)))))
                                  ::kthxbai)
                              4 (do
                                  (is (= incoming ::kk))
@@ -250,11 +252,13 @@
                                      (log/error ex "This really shouldn't pass")
                                      (is (not ex))))
                                  nil))]
-                       (log/info prelog
+                       (log/info prelog2
                                  incoming
+                                 "from\n"
+                                 prelog
                                  "triggered a response:"
                                  next-message)
-                       (swap! client-state update ::count inc)
+                       (swap! client-state-atom update ::count inc)
                        ;; Hmm...I've wound up with a circular dependency
                        ;; on the io-handle again.
                        ;; Q: Is this a problem with my architecture, or just
@@ -266,7 +270,9 @@
                                            "Buffered bytes from child"
                                            "Giving up on sending message from child"
                                            {}))
-                       (<= 5 n)))])
+                       (let [result (> 5 n)]
+                         (log/debug prelog2 "returning" result)
+                         result)))])
       (log/error prelog "No bytes decoded. Shouldn't have gotten here"))))

 (defn mock-client-child


(PDB-3026) Changed import certname extract to a regex

Previously the code would use a somewhat complicated set of substring
operations to extract the certname from the import file path. This
commit switches that logic to a regex, which can also be used to detect
the kind of command at a path. This was detected previously with a
separate regex.

--- src/puppetlabs/puppetdb/import.clj
+++ src/puppetlabs/puppetdb/import.clj
@@ -4,7 +4,8 @@
    This is a command-line tool for importing data into PuppetDB. It expects
    as input a tarball generated by the PuppetDB `export` command-line tool."
   (:import [org.apache.commons.compress.archivers.tar TarArchiveEntry]
-           [puppetlabs.puppetdb.archive TarGzReader])
+           [puppetlabs.puppetdb.archive TarGzReader]
+           [java.io File])
   (:require [clojure.java.io :as io]
             [clojure.tools.logging :as log]
             [puppetlabs.puppetdb.archive :as archive]
@@ -15,32 +16,32 @@
             [puppetlabs.puppetdb.schema :refer [defn-validated]]
             [puppetlabs.puppetdb.utils :as utils]))

-(defn file-pattern
-  [entity]
-  (re-pattern (str "^" (.getPath (io/file utils/export-root-dir entity ".*\\.json")) "$")))
+(defn make-certname-matcher
+  "Returns a function that find a certname in the `file-path` for the
+  given `entity`, the function returns nil if the path is not
+  recognized"
+  [entity with-hash?]
+  (let [command-certname-regex (re-pattern
+                                (str "^"
+                                     (apply str
+                                            (map utils/regex-quote
+                                                 [utils/export-root-dir
+                                                  File/separatorChar
+                                                  entity
+                                                  File/separatorChar]))

-(def after-certname-length
-  "The format is <certname>-<date hash><suffix>. This is a count of
-  the characters after the certname"
-  (+ 1
-     40
-     (count export/file-suffix)))
+                                     "(.*)"
+                                     (when with-hash?
+                                       "\\-\\p{XDigit}{40}")
+                                     "\\.json$"))]
+    (fn [file-path]
+      (when-let [[_ certname-match] (re-matches command-certname-regex file-path)]
+        [entity certname-match]))))

-(def export-root-dir-length
-  (count utils/export-root-dir))
-
-(defn extract-certname [^String command-type ^String path]
-  (let [path-length (.length path)
-        prefix-length (+ export-root-dir-length
-                         (.length command-type)
-                         2)]
-    (subs path prefix-length (- path-length after-certname-length))))
-
-(defn extract-facts-certname [^String path]
-  (let [prefix-length (+ export-root-dir-length
-                         (.length "facts")
-                         2)]
-    (subs path prefix-length (- (.length path) (count export/file-suffix)))))
+(def command-matcher
+  (some-fn (make-certname-matcher "catalogs" true)
+           (make-certname-matcher "reports" true)
+           (make-certname-matcher "facts" false)))

 (defn-validated process-tar-entry
   "Determine the type of an entry from the exported archive, and process it
@@ -49,43 +50,33 @@
    tar-reader :- TarGzReader
    tar-entry :- TarArchiveEntry
    command-versions]
-  (let [path (.getName tar-entry)]
-    (condp re-find path
-      (file-pattern "catalogs")
-      (do (log/infof "Importing catalog from archive entry '%s'" path)
-          ;; NOTE: these submissions are async and we have no guarantee that they
-          ;;   will succeed. We might want to add something at the end of the import
-          ;;   that polls puppetdb until the command queue is empty, then does a
-          ;;   query to the /nodes endpoint and shows the set difference between
-          ;;   the list of nodes that we submitted and the output of that query
-          (command-fn :replace-catalog
-                      (:replace_catalog command-versions)
-                      (extract-certname "catalogs" path)
-                      (-> tar-reader
-                          utils/read-json-content
-                          json/generate-string
-                          (.getBytes "UTF-8")
-                          java.io.ByteArrayInputStream.)))
-      (file-pattern "reports")
-      (do (log/infof "Importing report from archive entry '%s'" path)
-          (command-fn :store-report
-                      (:store_report command-versions)
-                      (extract-certname "reports" path)
-                      (-> tar-reader
-                          (utils/read-json-content true)
-                          json/generate-string
-                          (.getBytes "UTF-8")
-                          java.io.ByteArrayInputStream.)))
-      (file-pattern "facts")
-      (do (log/infof "Importing facts from archive entry '%s'" path)
-          (command-fn :replace-facts
-                      (:replace_facts command-versions)
-                      (extract-facts-certname path)
-                      (-> tar-reader
-                          utils/read-json-content
-                          json/generate-string
-                          (.getBytes "UTF-8")
-                          java.io.ByteArrayInputStream.)))
+  (let [path (.getName tar-entry)
+        [command-type certname] (command-matcher path)
+        command-fn' (fn [command-kwd command-version]
+                      (command-fn command-kwd
+                                  command-version
+                                  certname
+                                  (-> tar-reader
+                                      utils/read-json-content
+                                      json/generate-string
+                                      (.getBytes "UTF-8")
+                                      java.io.ByteArrayInputStream.)))]
+    (case command-type
+      "catalogs"
+      (do
+        (log/infof "Importing catalog from archive entry '%s'" path)
+        (command-fn' :replace-catalog
+                     (:replace_catalog command-versions)))
+      "reports"
+      (do
+        (log/infof "Importing report from archive entry '%s'" path)
+        (command-fn' :store-report
+                    (:store_report command-versions)))
+      "facts"
+      (do
+        (log/infof "Importing facts from archive entry '%s'" path)
+        (command-fn' :replace-facts
+                     (:replace_facts command-versions)))
       nil)))

 (def metadata-path


removed usused server ns

removed usused server ns

--- src/status_im/handlers/server.cljs
+++ src/status_im/handlers/server.cljs
@@ -1,35 +0,0 @@
-(ns status-im.handlers.server
-  (:require [re-frame.core :refer [subscribe dispatch dispatch-sync]]
-            [status-im.utils.utils :refer [http-post]]
-            [taoensso.timbre :as log]
-            [status-im.utils.scheduler :as sch]))
-
-(defn sign-up
-  [db phone-number message-id handler]
-  (let [current-account-id (get db :accounts/current-account-id)
-        {:keys [public-key address]} (get-in db [:accounts/accounts current-account-id])]
-    (log/debug "signing up with public-key" public-key "and phone " phone-number)
-    (http-post "sign-up" {:phone-number     phone-number
-                          :whisper-identity public-key
-                          :address          address}
-               (fn [body]
-                 (log/debug body)
-                 (dispatch [:set-message-status message-id :seen])
-                 (handler))
-               (fn [_]
-                 (sch/execute-later
-                   #(dispatch [:sign-up phone-number message-id])
-                   (sch/s->ms 1))))
-    db))
-
-(defn sign-up-confirm
-  [confirmation-code message-id handler]
-  (http-post "sign-up-confirm"
-             {:code confirmation-code}
-             (fn [body]
-               (dispatch [:set-message-status message-id :seen])
-               (handler body))
-             (fn [_]
-               (sch/execute-later
-                 #(dispatch [:sign-up-confirm confirmation-code message-id])
-                 (sch/s->ms 1)))))


Adjuct mailserver limit when expired/complete events

Signed-off-by: Igor Mandrigin <042dc4512fa3d391c5170cf3aa61e6a638f84342@mandrigin.ru>

--- src/status_im/mailserver/core.cljs
+++ src/status_im/mailserver/core.cljs
@@ -37,9 +37,13 @@
 (def seven-days (* 7 one-day))
 (def maximum-number-of-attempts 2)
 (def request-timeout 30)
+(def min-limit 200)
+(def max-limit 2000)
+(def default-limit max-limit)
 (def connection-timeout
   "Time after which mailserver connection is considered to have failed"
   10000)
+(def limit (atom default-limit))

 (defn connected? [{:keys [db]} id]
   (= (:mailserver/current-id db) id))
@@ -136,6 +140,17 @@
  :mailserver/update-mailservers
  (fn [enodes]
    (update-mailservers! enodes)))
+
+(re-frame/reg-fx
+ :mailserver/set-limit
+ (fn [n]
+   (reset! limit n)))
+
+(defn decrease-limit []
+  (max min-limit (/ @limit 2)))
+
+(defn increase-limit []
+  (min max-limit (* @limit 2)))

 (defn mark-trusted-peer! [web3 enode]
   (.markTrustedPeer (transport.utils/shh web3)
@@ -236,8 +251,6 @@
         mailserver-removed?
         (connect-to-mailserver cofx)))))

-(def limit 2000)
-
 (defn adjust-request-for-transit-time
   [from]
   (let [ttl               (:ttl protocol/whisper-opts)
@@ -247,10 +260,12 @@
     (log/debug "Adjusting mailserver request" "from:" from "adjusted-from:" adjusted-from)
     adjusted-from))

-(defn request-messages! [web3 {:keys [sym-key-id address]} {:keys [topics cursor to from]}]
+(defn request-messages! [web3 {:keys [sym-key-id address]} {:keys [topics cursor to from] :as request}]
   ;; Add some room to from, unless we break day boundaries so that messages that have
   ;; been received after the last request are also fetched
   (let [adjusted-from (adjust-request-for-transit-time from)
+        actual-limit  (or (:limit request)
+                          @limit)
         actual-from   (if (> (- to adjusted-from) one-day)
                         from
                         adjusted-from)]
@@ -258,14 +273,14 @@
               " topics " topics
               " from " actual-from
               " cursor " cursor
-              " limit " limit
+              " limit " actual-limit
               " to   " to)
     (.requestMessages (transport.utils/shh web3)
                       (clj->js {:topics         topics
                                 :mailServerPeer address
                                 :symKeyID       sym-key-id
                                 :timeout        request-timeout
-                                :limit          limit
+                                :limit          actual-limit
                                 :cursor         cursor
                                 :from           actual-from
                                 :to             to})
@@ -497,9 +512,12 @@
   (when (accounts.db/logged-in? cofx)
     (let [error (:errorMessage event)]
       (if (empty? error)
-        (update-mailserver-topics cofx
-                                  {:request-id (:requestID event)
-                                   :cursor     (:cursor event)})
+        (fx/merge
+         cofx
+         {:mailserver/set-limit (increase-limit)}
+         (update-mailserver-topics {:request-id (:requestID event)
+                                    :cursor     (:cursor event)}))
+
         (handle-request-error cofx error)))))

 (fx/defn show-request-error-popup
@@ -553,18 +571,21 @@
     (fx/merge cofx
               {:db (update db :mailserver/current-request dissoc :attemps)}
               (change-mailserver))
-    (when-let [mailserver (get-mailserver-when-ready cofx)]
-      (let [{:keys [topics from to cursor] :as request} (get db :mailserver/current-request)
+    (if-let [mailserver (get-mailserver-when-ready cofx)]
+      (let [{:keys [topics from to cursor limit] :as request} (get db :mailserver/current-request)
             web3 (:web3 db)]
-        (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to "cursor" cursor)
+        (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to "cursor" cursor "limit" (decrease-limit))
         {:db (update-in db [:mailserver/current-request :attemps] inc)
-         :mailserver/request-messages {:web3    web3
-                                       :mailserver   mailserver
-                                       :request request}}))))
+         :mailserver/set-limit (decrease-limit)
+         :mailserver/request-messages {:web3 web3
+                                       :mailserver mailserver
+                                       :request (assoc request :limit (decrease-limit))}})
+      {:mailserver/set-limit (decrease-limit)})))

 (fx/defn initialize-mailserver
   [cofx custom-mailservers]
   (fx/merge cofx
+            {:mailserver/set-limit default-limit}
             (add-custom-mailservers custom-mailservers)
             (set-current-mailserver)))


Remove sleeps.

Remove sleeps.

--- test/clj/hatnik/selenium/core.clj
+++ test/clj/hatnik/selenium/core.clj
@@ -78,8 +78,7 @@
   (.until (WebDriverWait. driver 10)
           (-> type dialog-visible-selector
               By/cssSelector
-              ExpectedConditions/visibilityOfElementLocated))
-  (Thread/sleep 100))
+              ExpectedConditions/visibilityOfElementLocated)))

 (def dialog-invisible-selector {:project "#iModalProjectMenu"
                                 :action "#iModalAddAction"})
@@ -88,17 +87,14 @@
   (.until (WebDriverWait. driver 10)
           (-> type dialog-invisible-selector
               By/cssSelector
-              ExpectedConditions/invisibilityOfElementLocated))
-  (Thread/sleep 100))
+              ExpectedConditions/invisibilityOfElementLocated)))

 (defn wait-until [driver condition message]
   (doto (WebDriverWait. driver 10)
     (.withMessage message)
     (.until (reify ExpectedCondition
               (apply [this driver]
-                (condition driver)))))
-  ; Hack. Tests don't pass on travis for some reason. It should help.
-  (Thread/sleep 100))
+                (condition driver))))))

 (defn wait-until-projects-match [driver projects]
   (wait-until driver


Removing osx beta check and osx-plan feature toggle.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -470,15 +470,13 @@
                [:a {:on-click #(om/set-state! owner [:selected-tab] :osx)}
                 [:i.fa.fa-apple.fa-lg] "Build on OS X"]]]
              (condp = selected-tab
-               :linux
-               [:div (om/build linux-plan {:app app :checkout-loaded? checkout-loaded?})
-                (project-common/mini-parallelism-faq {})]
-
-               :osx (if (and (feature/enabled? :osx-plans)
-                             (get-in app state/org-osx-enabled-path))
-                      (list
-                        (om/build osx-plans plan)
-                        (om/build osx-faq osx-faq-items))))]))))
+               :linux [:div.card
+                       (om/build linux-plan {:app app :checkout-loaded? checkout-loaded?})
+                       (project-common/mini-parallelism-faq {})]
+
+               :osx [:div.card
+                     (om/build osx-plans plan)
+                     (om/build osx-faq osx-faq-items)])]))))

 (defn pricing [app owner]
   (reify


Convert to vec after import

Convert to vec after import


DONE grep for clojure.lang.IFn

DONE grep for clojure.lang.IFn


Use "text/plain" as content-type for Prometheus /metrics endpoint. See https://github.com/prometheus/docs/blob/master/content/docs/instrumenting/exposition_formats.md

--- src/onyx/http_query.clj
+++ src/onyx/http_query.clj
@@ -445,7 +445,7 @@
                 :body (serialize result)}
                (= "/metrics" (:uri request))
                {:status (or status 200)
-                :headers {"Content-Type" (serializer-name content-type)}
+                :headers {"Content-Type" "text/plain"}
                 :body result}
                :else
                {:status (or status 200)


Allow seq recover from checkpoint

Allow seq recover from checkpoint

--- src/onyx/plugin/seq.clj
+++ src/onyx/plugin/seq.clj
@@ -23,7 +23,7 @@
     offset)

   (recover [this checkpoint]
-    this)
+    (assoc this :sequential (drop (inc checkpoint) sequential)))

   (offset-id [this]
     offset)
@@ -34,7 +34,6 @@
   (next-state [this event]
     (let [segment (first rst)
           remaining (rest rst)]
-      ;(println "Next state" segment remaining)
       (assoc this
              :segment segment
              :rst remaining