Send page data and options already serialized.

--- src/uxbox/repo/pages.cljs
+++ src/uxbox/repo/pages.cljs
@@ -8,56 +8,84 @@
   "A main interface for access to remote resources."
   (:require [beicon.core :as rx]
             [uxbox.repo.core :refer (request url send!)]
-            [uxbox.state :as ust]))
+            [uxbox.state :as ust]
+            [uxbox.util.transit :as t]))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Login
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn- decode-page
+  [{:keys [data options] :as page}]
+  (merge page
+         (when data {:data (t/decode data)})
+         (when options {:options (t/decode options)})))
+
+(defn- decode-payload
+  [{:keys [payload] :as rsp}]
+  (if (sequential? payload)
+    (assoc rsp :payload (mapv decode-page payload))
+    (assoc rsp :payload (decode-page payload))))

 (defmethod request :fetch/pages
   [type data]
-  (send! {:url (str url "/pages") :method :get}))
+  (let [params {:url (str url "/pages")
+                :method :get}]
+    (->> (send! params)
+         (rx/map decode-payload))))

 (defmethod request :fetch/pages-by-project
   [type {:keys [project] :as params}]
   (let [url (str url "/projects/" project "/pages")]
-    (send! {:method :get :url url})))
+    (->> (send! {:method :get :url url})
+         (rx/map decode-payload))))

 (defmethod request :fetch/page-history
   [type {:keys [page] :as params}]
   (let [url (str url "/pages/" page "/history")
-        query (select-keys params [:max :since :pinned])]
-    (send! {:method :get :url url :query query })))
+        query (select-keys params [:max :since :pinned])
+        params {:method :get :url url :query query}]
+    (->> (send! params)
+         (rx/map decode-payload))))

 (defmethod request :delete/page
   [_ id]
   (let [url (str url "/pages/" id)]
-    (send! {:url url :method :delete})))
+    (send! {:url url
+            :method :delete})))

 (defmethod request :create/page
-  [type {:keys [id] :as data}]
-  (let [params {:url (str url "/pages")
+  [type {:keys [data options] :as body}]
+  (let [body (assoc body
+                    :data (t/encode data)
+                    :options (t/encode options))
+        params {:url (str url "/pages")
                 :method :post
-                :body data}]
-    (send! params)))
+                :body body}]
+    (->> (send! params)
+         (rx/map decode-payload))))

 (defmethod request :update/page
-  [type {:keys [id] :as data}]
-  (let [params {:url (str url "/pages/" id)
+  [type {:keys [id data options] :as body}]
+  (let [body (assoc body
+                    :data (t/encode data)
+                    :options (t/encode options))
+        params {:url (str url "/pages/" id)
                 :method :put
-                :body data}]
-    (send! params)))
+                :body body}]
+    (->> (send! params)
+         (rx/map decode-payload))))

 (defmethod request :update/page-history
   [type {:keys [id page] :as data}]
   (let [params {:url (str url "/pages/" page "/history/" id)
                 :method :put
                 :body data}]
-    (send! params)))
+    (->> (send! params)
+         (rx/map decode-payload))))

 (defmethod request :update/page-metadata
-  [type {:keys [id] :as data}]
-  (let [params {:url (str url "/pages/" id "/metadata")
+  [type {:keys [id options] :as body}]
+  (let [body (dissoc body :data)
+        body (assoc body :options (t/encode options))
+        params {:url (str url "/pages/" id "/metadata")
                 :method :put
-                :body data}]
-    (send! params)))
+                :body body}]
+    (->> (send! params)
+         (rx/map decode-payload))))


Add pe-rbac-service to classifier's dependencies.

As of NC-213, the classifier now depends on pe-rbac service, so add it
to the dependencies in classifier.clj.

--- configs/classifier/classifier.clj
+++ configs/classifier/classifier.clj
@@ -2,6 +2,7 @@
   :description "Release artifacts for classifier"
   :pedantic? :abort
   :dependencies [[puppetlabs/classifier "{{{classifier-version}}}"]
+                 [puppetlabs/pe-rbac-service "{{{pe-rbac-version}}}"]
                  [puppetlabs/trapperkeeper-webserver-jetty9 "0.7.2"]]

   :uberjar-name "classifier-release.jar"


Format lines.

Format lines.

--- project/analyze-data/src/analyze_data/corpus_to_tf_idf.clj
+++ project/analyze-data/src/analyze_data/corpus_to_tf_idf.clj
@@ -42,7 +42,8 @@
         (cons header-row data)))

 (defn csv-corpus-to-tf-idf-data!
-  "Transform a csv containing a corpus of documents into a file of tf-idf vectors.
+  "Transform a csv containing a corpus of documents into a file of tf-idf
+  vectors.

   in-path: path to a csv file. It should contain the headers 'item-name' and
            'item-text', with values as described in corpus-to-tf-idf-data.


Better docstring for with-base-url

Better docstring for with-base-url

--- src/hiccup/util.clj
+++ src/hiccup/util.clj
@@ -7,7 +7,8 @@
 (def ^:dynamic *base-url* nil)

 (defmacro with-base-url
-  "Sets a base URL that will be prepended onto relative URIs."
+  "Sets a base URL that will be prepended onto relative URIs. Note that for this
+  to work correctly, it needs to be placed outside the html macro."
   [base-url & body]
   `(binding [*base-url* ~base-url]
      ~@body))


Pattern matching more robust.  Now only collects comparisons that were not nil (i.e. failed).

--- src/isla/parser.clj
+++ src/isla/parser.clj
@@ -67,9 +67,10 @@
     nil))

 (defn pattern-sequence [tokens patterns collected]
-  (if (> (count patterns) 0)
-      (pattern-sequence (rest tokens) (rest patterns)
-                        (conj collected ((first patterns) (first tokens))))
+  (if (> (count patterns) 0) ;; still patterns to test
+    (if-let [node ((first patterns) (first tokens))] ;; pattern matches token
+      (pattern-sequence (rest tokens) (rest patterns) (conj collected node))
+      collected)
     collected))


Mine based on distance

Mine based on distance

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -19,6 +19,9 @@
 (defmacro swap-keys [swap-atom & forms]
   (for [pair (partition 2 forms)]
     `(swap! ~swap-atom swap-key ~@pair)))
+
+(defn dist [a b]
+  (Math/sqrt (+ (Math/pow (- (.getX a) (.getX b)) 2) (Math/pow (- (.getY a) (.getY b)) 2))))

 (defn korhal-main [& args]
   (let [ai (korhal.core.)
@@ -63,7 +66,8 @@
       (when (and (.isIdle unit) (not (= (.getID unit) (:pool-drone @(.state this)))))
         (let [mineral? (fn [unit] (= (.getTypeID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Resource_Mineral_Field)))
               mineral (first (filter mineral? (.getNeutralUnits (:api @(.state this)))))]
-        (.rightClick (:api @(.state this)) (.getID unit) (.getID mineral)))))))
+          (when (< (dist unit mineral) 300)
+            (.rightClick (:api @(.state this)) (.getID unit) (.getID mineral))))))))


Port `http.experimental.event` tests over to use `test-id`s

This commit ports the http event query tests over to use the
new `test-id` field in the example report data, rather than
the more complex approach that we were using before.

--- test/com/puppetlabs/puppetdb/test/http/experimental/event.clj
+++ test/com/puppetlabs/puppetdb/test/http/experimental/event.clj
@@ -12,7 +12,7 @@
         [clj-time.core :only [now]]
         [clj-time.coerce :only [to-string to-long]]
         [com.puppetlabs.puppetdb.testutils :only (response-equal?)]
-        [com.puppetlabs.puppetdb.testutils.report :only (store-example-report!)]))
+        [com.puppetlabs.puppetdb.testutils.report :only (store-example-report! get-events-map)]))

 (def content-type-json "application/json")

@@ -58,8 +58,9 @@
   (set (map #(expected-resource-event-response % report-hash) resource-events)))

 (deftest query-by-report
-  (let [basic       (:basic reports)
-        report-hash (store-example-report! basic (now))]
+  (let [basic         (:basic reports)
+        report-hash   (store-example-report! basic (now))
+        basic-events  (get-events-map basic)]

     ;; TODO: test invalid requests

@@ -69,28 +70,6 @@
                         (:resource-events basic)
                         report-hash)]
         (response-equal? response expected munge-event-values)))
-
-    ;; NOTE: more exhaustive testing for these queries can be found in
-    ;; `com.puppetlabs.puppetdb.test.query.event`
-    (testing "should support querying resource events by timestamp"
-      (let [start-time  "2011-01-01T12:00:01-03:00"
-            end-time    "2011-01-01T12:00:03-03:00"]
-        (testing "should support single term timestamp queries"
-          (let [response (get-response ["<" "timestamp" end-time])
-                expected (expected-resource-events-response
-                            (filter #(< (to-long (:timestamp %)) (to-long end-time))
-                              (:resource-events basic))
-                            report-hash)]
-            (response-equal? response expected munge-event-values)))
-        (testing "should support compound timestamp queries"
-          (let [response (get-response ["and" [">" "timestamp" start-time]
-                                              ["<" "timestamp" end-time]])
-                expected (expected-resource-events-response
-                            (filter #(and (< (to-long (:timestamp %)) (to-long end-time))
-                                          (> (to-long (:timestamp %)) (to-long start-time)))
-                              (:resource-events basic))
-                            report-hash)]
-            (response-equal? response expected munge-event-values)))))

     (testing "query exceeding event-query-limit"
@@ -106,6 +85,25 @@
         (fn []
           (let [response (get-response ["=" "report" report-hash] {"limit" 500})
                 expected (expected-resource-events-response
-                            (:resource-events basic)
+              (:resource-events basic)
+              report-hash)]
+            (response-equal? response expected munge-event-values)))))
+
+    ;; NOTE: more exhaustive testing for these queries can be found in
+    ;; `com.puppetlabs.puppetdb.test.query.event`
+    (testing "should support querying resource events by timestamp"
+      (let [start-time  "2011-01-01T12:00:01-03:00"
+            end-time    "2011-01-01T12:00:03-03:00"]
+        (testing "should support single term timestamp queries"
+          (let [response (get-response ["<" "timestamp" end-time])
+                expected (expected-resource-events-response
+                            (utils/select-values basic-events [1 3])
+                            report-hash)]
+            (response-equal? response expected munge-event-values)))
+        (testing "should support compound timestamp queries"
+          (let [response (get-response ["and" [">" "timestamp" start-time]
+                                              ["<" "timestamp" end-time]])
+                expected (expected-resource-events-response
+                            (utils/select-values basic-events [3])
                             report-hash)]
             (response-equal? response expected munge-event-values)))))))


[Client] [Docs] Improve `client/request` docstring

--- src/org/httpkit/client.clj
+++ src/org/httpkit/client.clj
@@ -205,20 +205,18 @@
     (println \"resp1's status: \" (:status @resp1))
     (println \"resp2's status: \" (:status @resp2)))

-  Output coercion:
-  ;; Return the body as a byte stream
-  (request {:url \"http://site.com/favicon.ico\" :as :stream})
-  ;; Coerce as a byte-array
-  (request {:url \"http://site.com/favicon.ico\" :as :byte-array})
-  ;; return the body as a string body
-  (request {:url \"http://site.com/string.txt\" :as :text})
-  ;; Try to automatically coerce the output based on the content-type header, currently supports :text :stream, (with automatic charset detection)
-  (request {:url \"http://site.com/string.txt\" :as :auto})
-  ;; return the body as is with no unzipping or coercion whatsoever. return as byte[]
-  (request {:url \"http://site.com/favicon.ico\" :as :raw-byte-array})
-  ;; return the body as is with no unzipping or coercion whatsoever. returns as org.httpkit.DynamicBytes
-  (request {:url \"http://site.com/favicon.ico\" :as :none})
-
+  Returned body type is controlled by `:as` option:
+
+   Without automatic unzipping:
+      `:none`           - org.httpkit.DynamicBytes
+      `:raw-byte-array` - bytes[]
+
+    With automatic unzipping:
+      `:byte-array`     - bytes[]
+      `:stream`         - ByteInputStream
+      `:text`           - String (charset based on Content-Type header)
+      `:auto`           - As `:text` or `:stream` (based on Content-Type header)
+
   Request options:
     :url :method :headers :timeout :connect-timeout :idle-timeout :query-params
     :as :form-params :client :body :basic-auth :user-agent :filter :worker-pool"


define-routes! only takes a single argument

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -88,7 +88,7 @@
         history-path "/"
         history-imp (history/new-history-imp top-level-node)
         pusher-imp (pusher/new-pusher-instance)]
-    (routes/define-routes! state history-imp)
+    (routes/define-routes! state)
     (om/root
      app/app
      state


rename look-back to project-in-interval

rename look-back to project-in-interval

--- src/paulkrake/crossval.clj
+++ src/paulkrake/crossval.clj
@@ -31,11 +31,14 @@
        (map (fn [x] (* -1 x)))
        (apply +)))

-(defn look-back [min-n max-n  t]
+(defn project-in-interval
+  "precondition: min-n <= max-n.
+  Returns t if min < t < max, min if t < min and max if t > max"
+  [min-n max-n t]
   (max min-n (min t max-n)))

 (defn points [[s t] min-n max-n]
-  (let [n (look-back min-n max-n t)
+  (let [n (project-in-interval min-n max-n t)
         result (as-> (dc/spieltag s t) x
                  (reduce (fn [a [h g hg gg]] (assoc a [h g] [(int hg) (int gg) ])) nil x))
         prediction (as-> (g/predict-result s t n) x


Changed the main around to work with the shader stuff. Also kept it from loading the shader again every time.

--- src/petulant_life/main.clj
+++ src/petulant_life/main.clj
@@ -5,7 +5,8 @@
                              ContextAttribs
                              PixelFormat))

-  (:require [petulant-life.rendering :as r]))
+  (:require [petulant-life.rendering :as r]
+            [petulant-life.shader :as s]))

 ;; Defining some width and height constraints to the program.
 (def width 640)
@@ -29,14 +30,14 @@
   (Display/destroy))

 ;; Running the simulation / graphics.
-(defn run []
+(defn run [shader]
   (while (not (Display/isCloseRequested))
     (do (GL11/glClear GL11/GL_COLOR_BUFFER_BIT)
         (r/draw-rectangles [[10 10 50 50]
                             [70 10 50 50]
                             [10 70 50 50]
                             [70 70 50 50]]
-                           (r/load-shader-program "resource/gol"))
+                           shader)
         (Display/update))))

 (defmacro with-cleanup [close-fn & body]
@@ -49,4 +50,4 @@
 (defn -main [& args]
   (with-cleanup destroy
     (create)
-    (run)))
+    (run (s/load-shader-program "resources/gol"))))


Behave better outside container

Behave better outside container

--- modules/core/src/main/clojure/immutant/registry.clj
+++ modules/core/src/main/clojure/immutant/registry.clj
@@ -18,12 +18,13 @@
 (ns immutant.registry
   (:import (org.jboss.msc.service ServiceName)))

-(def registry)
+(def registry nil)

 (defn set-registry [v]
   (def registry v))

 (defn service [name]
-  (let [key (ServiceName/parse name)
-        value (.getService registry key)]
-    (and value (.getValue value))))
+  (if registry
+    (let [key (ServiceName/parse name)
+          value (.getService registry key)]
+      (and value (.getValue value)))))


Replaced extraneous instance of old flatten-vote-batches

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -199,7 +199,7 @@
           (log/error "Unable to send metrics for failed compute for" zid-str)))
       ; Try to save conversation state for debugging purposes
       (try
-        (let [votes (flatten-vote-batches vote-batches)]
+        (let [votes (flatten vote-batches)]
           (conv/conv-update-dump @conv-actor votes opts update-error))
         (catch Exception e
           (log/error "Unable to perform conv-update dump for" zid-str))))))


CMR-1129: Fixed bug in psa->keywords handling of nil values.

--- indexer-app/src/cmr/indexer/data/concepts/attribute.clj
+++ indexer-app/src/cmr/indexer/data/concepts/attribute.clj
@@ -104,8 +104,9 @@
 (defn psa->keywords
   "Converts a PSA into a vector of terms to be used in keyword searches"
   [psa]
-  (let [{:keys [name data-type value description]} psa]
-    (filter identity [name (value->elastic-value data-type value) description])))
+  (let [{:keys [name data-type value description]} psa
+        value (when value (data-type value->elastic-value value))]
+    (filter identity [name value description])))

 (defn psas->keywords
   [collection]


buglet working

buglet working

--- src/luffer/core.clj
+++ src/luffer/core.clj
@@ -233,6 +233,18 @@

 (def pc (atom 0))

+(defn buglet []
+  (reset! pc 0)
+  (println (format "new future [%,d,%,d)" 0 nil))
+  (select-in-batches (-> (select* plays) (assoc , :fields [:id])) 0 1350000 nil
+                           (fn [bat]
+                             (let [joined-bat (assoc bat :batch (join-plays (:batch bat)))]
+                               (swap! pc + (-> bat :batch count))
+                               (println (format "batched %,d plays. total=%,d" (-> bat :batch count) @pc))
+                               (println '(write-batch-to-file "./tmp/batch-%d.json" joined-bat)))))
+  (println (format "done with [%,d,%,d). total=%,d" 0 nil @pc)))
+
+
 (defn -main [& args]
   (let [batch-size 15000
         concurrency 1
@@ -241,15 +253,15 @@
         id-stop (+ quoti (- batch-size (mod quoti batch-size)))]
     (reset! batchno 1)
     (reset! pc 0)
-    (println (format "there are %d plays" cnt))
+    (println (format "there are %,d plays" cnt))
     (loop [i 0, start 0, stop id-stop]
       (when (< i concurrency)
-        (println (format "new future   [%d,%d)" start stop))
+        (println (format "new future [%,d,%,d)" start stop))
         (select-in-batches (select* plays) start batch-size stop
                            (fn [bat]
                              (let [joined-bat (assoc bat :batch (join-plays (:batch bat)))]
                                (swap! pc + (-> bat :batch count))
-                               (println (format "did %d plays. total=%d" (-> bat :batch count) @pc))
+                               (println (format "batched %,d plays. total=%,d" (-> bat :batch count) @pc))
                                (write-batch-to-file "./tmp/batch-%d.json" joined-bat))))
-        (println (format "done with    ^ [%d,%d). total=%d" start stop @pc))
+        (println (format "done with [%,d,%,d). total=%,d" start stop @pc))
         (recur (inc i) (+ start id-stop) (if (= (inc i) concurrency) nil (+ stop id-stop)))))))


The project file lookup should be nil safe; should allow for no project.edn

--- cmma-clj/src/cmma/project.clj
+++ cmma-clj/src/cmma/project.clj
@@ -48,10 +48,11 @@
 (defn project-root-path
   ([] (project-root-path (io/file (System/getProperty "user.dir"))))
   ([working-dir]
-   (if (or (.exists (io/file (str (.getPath working-dir) "/project.edn")))
-            (nil? working-dir))
-      (str (.getPath working-dir) "/")
-      (recur (.getParent working-dir)))))
+   (when working-dir
+     (if (or (.exists (io/file (str (.getPath working-dir) "/project.edn")))
+             (nil? working-dir))
+       (str (.getPath working-dir) "/")
+       (recur (.getParent working-dir))))))

 (defn project-str []
   (str (or (project-root-path) "") "project.edn"))


staging cluster

staging cluster

--- src/terraboot/infra.clj
+++ src/terraboot/infra.clj
@@ -16,6 +16,14 @@
                              :max-number-of-slaves 2
                              :min-number-of-public-slaves 1
                              :max-number-of-public-slaves 2}) (str infra-path "cluster.tf"))
+    (to-file (cluster-infra {:vpc-name vpc-name
+                             :cluster-name "staging"
+                             :min-number-of-masters 3
+                             :max-number-of-masters 3
+                             :min-number-of-slaves 2
+                             :max-number-of-slaves 2
+                             :min-number-of-public-slaves 1
+                             :max-number-of-public-slaves 1}) (str infra-path "staging.tf"))))

 ;; Possible extra option: to make directory a parameter
 (defn -main []


Synchronize topic listeners to account for slow CI hardware.

--- integration-tests/apps/messaging/topics/src/immutant/init.clj
+++ integration-tests/apps/messaging/topics/src/immutant/init.clj
@@ -19,8 +19,8 @@
 (msg/start "topic.198")

 ;;; Topic listeners are additive, not idempotent
-(msg/listen "topic.198" #(msg/publish "queue.198" (inc %)))
-(msg/listen "topic.198" #(msg/publish "queue.198" (dec %)))
+@(msg/listen "topic.198" #(msg/publish "queue.198" (inc %)))
+@(msg/listen "topic.198" #(msg/publish "queue.198" (dec %)))

 (msg/start "queue.result")
 (msg/start "topic.echo")
@@ -32,7 +32,7 @@
        (do
          (msg/unlisten @responder)
          (reset! responder nil))
-       (reset! responder (msg/listen "topic.echo" #(msg/publish "queue.result"
-                                                                (identity %)))))
+       (reset! responder @(msg/listen "topic.echo" #(msg/publish "queue.result"
+                                                                 (identity %)))))
      {:status 200
       :body ":success"})))


Make pooled-db atom private

Make pooled-db atom private

--- src/time_tracker/db.clj
+++ src/time_tracker/db.clj
@@ -10,7 +10,7 @@
                      (.setMaxIdleTime config/cp-max-idle-time))]
     {:datasource datasource}))

-(defonce pooled-db (atom nil))
+(defonce ^:private pooled-db (atom nil))

 (defn init-db! []
   (reset! pooled-db (pool)))


Fixed import

Fixed import

--- src/warehouse/core.cljs
+++ src/warehouse/core.cljs
@@ -141,7 +141,7 @@
   [:button
    [:label
     [:input {:type "file"
-             :on-change (m/handler-fn (f))}]
+             :on-change f}]
     name]])

 (defmulti show-change-set (fn [change-set] (:type change-set)))
@@ -221,7 +221,7 @@
    [:button "Export"]])

 (defn import []
-  [file-input "Import" (fn [e]
+  [file-input "Import" (m/handler-fn
                          (let [reader (js/FileReader.)
                                this (aget e "currentTarget")]
                            (aset reader


Added a way to convert a single softmax vector

--- cortex/src/cortex/nn/network.cljc
+++ cortex/src/cortex/nn/network.cljc
@@ -50,6 +50,11 @@
                       [max-val max-idx]))
                   [nil nil]
                   (range (count coll)))))
+
+(defn softmax-result-to-unit-vector
+  [result]
+  (let [zeros (apply vector (repeat (first (m/shape result)) 0))]
+    (assoc zeros (max-index (into [] (seq result))) 1.0)))

 (defn softmax-results-to-unit-vectors


Updated documentation in code in the db-interface module

--- src/zg/db_interface.clj
+++ src/zg/db_interface.clj
@@ -72,19 +72,25 @@
             [])))

 (defn delete-word
+    "Mark the selected word with the flag 'deleted'. The word remains in the
+     dictionary so it can be undeleted in the future."
     [word dictionary-type]
     (set-word-status word dictionary-type :deleted))

 (defn undelete-word
+    "Mark the selected word with the flag 'active' (ie it's 'undeleted')."
     [word dictionary-type]
     (set-word-status word dictionary-type :undeleted))

 (defn read-all-words
+    "Read all words from both dictionaries (dictionary-type is nil) or
+     from selected dictionary (dictionary-type is specified)."
     [dictionary-type]
     (try
         (if dictionary-type
             (jdbc/query db-spec/zg-db
-                ["select * from dictionary where dictionary=? order by word" (dictionary-type->char dictionary-type->char)])
+                ["select * from dictionary where dictionary=? order by word"
+                    (dictionary-type->char dictionary-type)])
             (jdbc/query db-spec/zg-db
                 ["select * from dictionary order by word"]))
         (catch Exception e


spec refinement

spec refinement

--- iwaswhere-web/src/cljc/iwaswhere_web/specs.cljc
+++ iwaswhere-web/src/cljc/iwaswhere_web/specs.cljc
@@ -10,6 +10,7 @@
   [start end]
   (fn [val]
     (and (number? val) (<= start val) (< val end))))
+(def possible-timestamp? (number-in-range? 0 5000000000000))

 (defn pos-int? [n] (and (integer? n) (pos? n)))

@@ -24,14 +25,14 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  Journal Entry Specs
-(s/def :iww.entry/timestamp (number-in-range? 0 5000000000000))
+(s/def :iww.entry/timestamp possible-timestamp?)
 (s/def :iww.entry/md string?)
 (s/def :iww.entry/tags (s/coll-of (is-tag? "#") #{}))
 (s/def :iww.entry/mentions (s/coll-of (is-tag? "@") #{}))
 (s/def :iww.entry/timezone (s/nilable string?))
 (s/def :iww.entry/utc-offset (number-in-range? -720 720))
 (s/def :iww.entry/entry-type #{:pomodoro})
-(s/def :iww.entry/comment-for (number-in-range? 0 5000000000000))
+(s/def :iww.entry/comment-for possible-timestamp?)
 (s/def :iww.entry/latitude (s/nilable (number-in-range? -180.0 180.0)))
 (s/def :iww.entry/longitude (s/nilable (number-in-range? -180.0 180.0)))
 (s/def :iww.entry/planned-dur (s/and integer? pos?))
@@ -157,24 +158,12 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Client Store State Spec
-{:entries     []
- :temp-query  {}
- :cfg         {:active             nil
-               :show-maps-for      #{}
-               :show-comments-for  #{}
-               :sort-by-upvotes    false
-               :show-all-maps      false
-               :show-hashtags      true
-               :comments-w-entries true
-               :show-context       true
-               :show-pvt           false}}
-
 (s/def :iww.client-state/entries (s/* entry-spec))
-(s/def :iww.client-state/last-alive (number-in-range? 0 5000000000000))
+(s/def :iww.client-state/last-alive possible-timestamp?)
 (s/def :iww.client-state/current-query map?)

 ;; map with entries as values
-;(s/def :iww.client-state/new-entries (s/* entry-spec))
+(s/def :iww.client-state/new-entries (s/map-of possible-timestamp? entry-spec))

 (s/def :iww.client-state.cfg/active (s/nilable number?))
 (s/def :iww.client-state.cfg/show-maps-for set?)


Update meta data from all abacus requests

and don't forget the narrator

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -41,6 +41,7 @@
    :language [:MetaData :dc :language text]
    :source_publisher [:MetaData :ncc :sourcePublisher text]
    :source_edition [:MetaData :ncc :sourceDate text]
+   :narrator [:MetaData :ncc :narrator text]
    :volumes [:MetaData :ncc :setInfo text]
    :revision_date [:MetaData :ncc :revisionDate text]
    :mvl_only [:mvl_only text]
@@ -54,12 +55,13 @@
   and `periodical_number`"
   [{:keys [mvl_only command idVorstufe] :as raw-production}]
   (let [production_type (cond
-                       (= command "mdaDocAdd_Kleinauftrag") "other"
-                       (= mvl_only "yes") "periodical"
-                       :else "book")]
-      (merge (dissoc raw-production :mvl_only :command :idVorstufe)
-             {:production_type production_type
-              :periodical_number (when (= production_type "periodical") idVorstufe)})))
+                          (= command "mdaDocAdd_Kleinauftrag") "other"
+                          (= mvl_only "yes") "periodical"
+                          :else "book")]
+    (-> raw-production
+        (dissoc :mvl_only :command :idVorstufe)
+        (merge {:production_type production_type
+                :periodical_number (when (= production_type "periodical") idVorstufe)}))))

 (defn read-file
   "Read an export file from ABACUS and return a map with all the data"
@@ -77,28 +79,27 @@
   [f]
   (if-let [error (validation/open-validation-errors f)]
     error
-    (prod/create (read-file f))))
+    (prod/update-or-create! (read-file f))))

 (defn import-recorded-production
   "Import a recorded production from file `f`"
   [f]
   (if-let [error (validation/recorded-validation-errors f)]
     error
-    (let [{product_number :product_number} (read-file f)
+    (let [{product_number :product_number :as new-production} (read-file f)
           production (prod/find-by-productnumber product_number)]
-      (if (and production
-               (= "structured" (:state production))
-               (prod/manifest? production))
-        (prod/set-state-recorded! production)
-        (cond
-          (empty? production)
-          (format "Non-existing product number %s" product_number)
-          (not= "structured" (:state production))
-          (format "Production %s is not structured (%s instead)"
-                  product_number (:state production))
-          (not (prod/manifest? production))
-          (format "Production %s has no DAISY Export in %s"
-                  product_number (path/manifest-path production)))))))
+      (cond
+        (empty? production)
+        (format "Non-existing product number %s" product_number)
+        (not= "structured" (:state production))
+        (format "Production %s is not structured (%s instead)"
+                product_number (:state production))
+        (not (prod/manifest? production))
+        (format "Production %s has no DAISY Export in %s"
+                product_number (path/manifest-path production))
+        :else (-> production
+                  (merge new-production)
+                  prod/set-state-recorded!)))))

 (defn import-status-request
   "Import a status request from file `f`"
@@ -115,7 +116,7 @@
   [f]
   (if-let [error (validation/metadata-sync-errors f)]
     error
-    (prod/update-or-create! (read-file f))))
+    (prod/update! (read-file f))))

 (defn wrap-rows
   "Wrap an export record according to ABACUS conventions"


(MAINT) Don't flush non-initialized pool-context at shutdown

Previously, if an exception were thrown before the jruby-puppet-service
had been completely initialized, a stop call to the service on shutdown
would lead to a separate exception being thrown and logged due to trying
to operate on a nil pool-context.

This commit changes the jruby-puppet-service stop logic to avoid trying
to flush the pool-context if it has not yet been created.  This avoids
having the exception be thrown and logged for the nil pool-context.

--- src/clj/puppetlabs/services/jruby/jruby_puppet_service.clj
+++ src/clj/puppetlabs/services/jruby/jruby_puppet_service.clj
@@ -41,7 +41,12 @@
   (stop
    [this context]
    (let [{:keys [pool-context]} (tk-services/service-context this)]
-     (jruby-core/flush-pool-for-shutdown! pool-context))
+     ;; Only flush the pool if there is a pool-context available.  No pool-context
+     ;; would be available if an exception were to be thrown during service
+     ;; initialization before the pool-context were created - e.g., during the
+     ;; the initialization of an upstream service.
+     (when pool-context
+       (jruby-core/flush-pool-for-shutdown! pool-context)))
    context)

   (free-instance-count


Retain fact code in files even when not checking on load

When running something like eastwood to lint test files, it's nice to be
able to not also run tests while linting.  Unfortunately setting
include-midje-checks to false means the test code that's meant to be
linted macro-expands to nil, so this patch puts the expanded code into a
defn where it won't be run but can still be linted.

--- src/midje/sweet.clj
+++ src/midje/sweet.clj
@@ -180,16 +180,21 @@
     (provided (g ..x..) => 6))
   "
   [& _] ; we work off &form, not the arguments
-  (when (user-desires-checking?)
-    (error/parse-and-catch-failure &form
-      #(do (pointer/set-fallback-line-number-from &form)
-           (let [[metadata forms] (parse-metadata/separate-metadata &form)
-                 [background remainder] (parse-background/separate-extractable-background-changing-forms forms)]
-             (if (seq background)
-               (pointer/positioned-form `(against-background [~@background]
-                                                             ~(parse-facts/wrap-fact-around-body metadata remainder))
-                                         &form)
-               (parse-facts/complete-fact-transformation metadata remainder)))))))
+  (let [defn-name (if (string? (second &form))
+                    (str/replace (second &form) #"[^\w\d]" "-")
+                    (second &form))
+        body (error/parse-and-catch-failure &form
+               #(do (pointer/set-fallback-line-number-from &form)
+                    (let [[metadata forms] (parse-metadata/separate-metadata &form)
+                          [background remainder] (parse-background/separate-extractable-background-changing-forms forms)]
+                      (if (seq background)
+                        (pointer/positioned-form `(against-background [~@background]
+                                                                      ~(parse-facts/wrap-fact-around-body metadata remainder))
+                                                 &form)
+                        (parse-facts/complete-fact-transformation metadata remainder)))))]
+    (if (user-desires-checking?)
+      body
+      `(defn ~(gensym defn-name) [] ~body))))

 (defmacro facts
   "Alias for fact."


Add test to test help output.

Add test to test help output.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -80,6 +80,13 @@
         out-string (test-cli-stderr #(start-cli cli-opts) test-cmd-input)]
     (is (= "Divide by zero" out-string))))

+(deftest help-cmd-cli-interaction-stdout-test
+  (let [cli-opts {:cmds {:add {:fn #(+ %1 %2)}}}
+        test-cmd-input ["help"]
+        out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
+    (is (= "add\n\n\nexit [e q quit]\n\tExit the CLI.\n\tTerminate and close the command line interface.\n\nhelp [? h]\n\tShow help.\n\tDisplay a help text that lists all available commands including further detailed information about these commands."
+           out-string))))
+

 (deftest expected-string-creation-single-line-test


Moved some unit tests over to Clout

Moved some unit tests over to Clout

--- test/compojure/routes.clj
+++ test/compojure/routes.clj
@@ -2,72 +2,6 @@
   (:use clojure.contrib.test-is)
   (:use compojure.routes)
   (:use test.helpers))
-
-(deftest fixed-path
-  (are (match-uri (compile-uri-matcher _1) _1)
-    "/"
-    "/foo"
-    "/foo/bar"
-    "/foo/bar.html"))
-
-(deftest nil-paths
-  (is (match-uri (compile-uri-matcher "/") nil)))
-
-(deftest keyword-paths
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/:x"       "/foo"     {:x "foo"}
-    "/foo/:x"   "/foo/bar" {:x "bar"}
-    "/a/b/:c"   "/a/b/c"   {:c "c"}
-    "/:a/b/:c"  "/a/b/c"   {:a "a", :c "c"}))
-
-(deftest keywords-match-extensions
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/foo.:ext" "/foo.txt" {:ext "txt"}
-    "/:x.:y"    "/foo.txt" {:x "foo", :y "txt"}))
-
-(deftest hyphen-keywords
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/:foo-bar" "/baz" {:foo-bar "baz"}
-    "/:foo-"    "/baz" {:foo- "baz"}))
-
-(deftest urlencoded-keywords
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/:x" "/foo%20bar" {:x "foo bar"}
-    "/:x" "/foo+bar"   {:x "foo bar"}))
-
-(deftest same-keyword-many-times
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/:x/:x/:x" "/a/b/c" {:x ["a" "b" "c"]}
-    "/:x/b/:x"  "/a/b/c" {:x ["a" "c"]}))
-
-(deftest wildcard-paths
-  (are (= (match-uri (compile-uri-matcher _1) _2) _3)
-    "/*"     "/foo"         {:* "foo"}
-    "/*"     "/foo.txt"     {:* "foo.txt"}
-    "/*"     "/foo/bar"     {:* "foo/bar"}
-    "/foo/*" "/foo/bar/baz" {:* "bar/baz"}
-    "/a/*/d" "/a/b/c/d"     {:* "b/c"}))
-
-(deftest url-paths
-  (is (match-uri (compile-uri-matcher "http://localhost")
-                 "http://localhost")))
-
-(deftest url-port-paths
-  (let [matcher (compile-uri-matcher "localhost:8080")]
-    (is (match-uri matcher "localhost:8080"))
-    (is (not (match-uri matcher "localhost:7070")))))
-
-(deftest unmatched-paths
-  (is (nil? (match-uri (compile-uri-matcher "/foo") "/bar"))))
-
-(deftest regex-paths
-  (is (match-uri #"/[A-Z][a-z]" "/Ab"))
-  (is (not (match-uri  #"/[A-Z][a-z]" "/ab"))))
-
-(deftest regex-path-params
-  (are (= (match-uri _1 _2) _3)
-    #"/foo/(\w+)"   "/foo/bar" ["bar"]
-    #"/(\w+)/(\d+)" "/foo/10"  ["foo" "10"]))

 (deftest assoc-route-map
   (is (= (assoc-route-params {:params {}} {"foo" "bar"})


Allow skin to take a FileHandle

Allow skin to take a FileHandle

--- src/play_clj/ui.clj
+++ src/play_clj/ui.clj
@@ -39,7 +39,10 @@

     (skin \"uiskin.json\")"
   [path & options]
-  `(u/calls! ^Skin (Skin. (.internal ^Files (Gdx/files) ~path)) ~@options))
+  `(u/calls! ^Skin (Skin. (if (string? ~path)
+                            (.internal ^Files (Gdx/files) ~path)
+                            ~path))
+             ~@options))

 (defmacro align
   "Returns a static field from [Align](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/scenes/scene2d/utils/Align.html).


Improve fullscreen.

Improve fullscreen.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -129,7 +129,10 @@
   "Checks that the size vector is exactly two elements. If not, throws
   an exception, otherwise returns the size vector unmodified."
   [size]
-  (cond (= size :fullscreen) (display-size)
+  (cond (= size :fullscreen)
+        (do
+          ; (japplemenubar.JAppleMenuBar/hide) on os x???
+          (display-size))
         (and (coll? size) (= 2 (count size))) size
         :else (throw (IllegalArgumentException.
                       (str "Invalid size definition:" size ". Was expecting :fullscreen or 2 elements vector: [x-size y-size].")))))
@@ -357,6 +360,7 @@
                                   :target :frame
                                   :safe-draw-fn true}
                                  (apply hash-map opts))
+        decor             (:decor opts (not= :fullscreen (:size options)))
         size              (process-size (:size options))
         target            (validate-target! (:target options))
         title             (or (:title options) (str "Quil " (swap! untitled-applet-id* inc)))
@@ -388,8 +392,7 @@
                                   :size size
                                   :target-frame-rate (atom 60)}
                                  listeners)
-        prx-obj           (quil.Applet. applet-state)
-        ]
+        prx-obj           (quil.Applet. applet-state)]
     (doto prx-obj
       (applet-run title renderer target)
       (attach-applet-listeners))))


Darn it. Another method-size overflow tabular test.

--- test/midje/t_checkers.clj
+++ test/midje/t_checkers.clj
@@ -83,8 +83,20 @@
 odd?                           odd?    =>       ;; different

 (exactly odd?)                 3       =not=>
-(exactly odd?)                 odd?    =>
+(exactly odd?)                 odd?    =>)

+;;; Right now there's a Java method overflow problem. Until that's
+;;; fixed, split table in two.
+
+(tabular
+  (fact
+    (silent-fact
+     (outer ?actual) => "expected"
+     (provided
+       (inner ?expected) => "expected"))
+    @silent-fact:failure-count ?arrow zero?)
+
+?expected                      ?actual ?arrow
 (as-checker odd?)              3       =>
 (as-checker odd?)              odd?    =not=>


separate concerns wrt task switching and running

--- src/tailrecursion/boot.clj
+++ src/tailrecursion/boot.clj
@@ -51,17 +51,25 @@
   (when-let [ns (namespace sym)] (require (symbol ns)))
   (or (resolve sym) (assert false (format "Can't resolve #'%s." sym))))

+(defn prep-task! [env & [spec]]
+  (let [spec (or spec env)
+        args (get-in env [:system :argv])]
+    (if-let [task-key (keyword (first args))]
+      (let [task (get-in spec [:tasks task-key])
+            argv (if task (rest args) args)
+            sel  #(select-keys % [:directories :dependencies :repositories])
+            deps (merge-with into (sel spec) (sel task))]
+        (assoc-in (merge env spec task deps) [:system :argv] argv))
+      env)))
+
+(defn run-task! [env & spec]
+  (apply swap! env prep-task! spec)
+  (when-let [m (:main @env)]
+    (cond (symbol? m) ((load-fn m) env) (seq? m) ((eval m) env))))
+
 (defn -main [& args]
-  (let [env (make-env base-env)
+  (let [env (make-env (assoc-in base-env [:system :argv] args))
+        tmp #(tmp/init! (tmp/registry (io/file ".boot" "tmp")))
         f   (io/file (get-in @env [:system :bootfile]))]
     (assert (.exists f) (format "File '%s' not found." f))
-    (let [spec  (read-string (slurp f))
-          task  (when-let [t (first args)] (get-in spec [:tasks (keyword t)]))
-          argv  (if task (rest args) args)
-          sel   #(select-keys % [:directories :dependencies :repositories])
-          deps  (merge-with into (sel spec) (sel task))]
-      (swap! env #(assoc-in (merge % spec task deps) [:system :argv] argv))
-      (when-let [m (:main @env)]
-        (swap! env assoc :tmp (tmp/init! (tmp/registry (io/file ".boot" "tmp"))))
-        (cond (symbol? m)   ((load-fn m) env)
-              (seq? m)      ((eval m) env))))))
+    (run-task! env (assoc (read-string (slurp f)) :tmp (tmp)))))


fix test

fix test

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -244,11 +244,11 @@
                             ;; c.f. TODO on babel.test.translate/latin-to-english
                             :subcat []
                             :cat :noun
-                            :sem {:number :sing
+                            :sem {:mod []
+                                  :number :sing
                                   :spec {:pred :of
                                          :of {:pred :Juana}}
-                                  :pred :dog}}
-                   :head {:synsem {:mod []}}})]
+                                  :pred :dog}}})]
     (is (not (nil? result)))
     (is (= "Juana's dog" (morph result)))))


add roundtrip parsing for grammar: small

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -60,11 +60,13 @@

 (deftest round-trip-1
-  (let [expr (generate {:synsem {:sem {:spec {:def :def}
+  (let [expr (generate {:synsem {:subcat '()
+                                 :sem {:spec {:def :def}
                                        :mod {:pred :difficile}
                                        :number :sing
                                      :pred :donna}}}
-                       np-grammar)]
+                       np-grammar
+                       {:allow-meta-lexemes false})]
     (is (= (fo expr) "la donna difficile"))
     (is (not (empty? (parse (fo expr) np-grammar))))))

@@ -85,7 +87,7 @@
                  :expr (get-in expr [:synsem :sem])
                  :sem (get-in (first (parse (fo expr) np-grammar))
                               [:synsem :sem])})))))
-(deftest roundtrip-all
+(deftest roundtrip-np-grammar
   (let [do-this-many 100]
     (is (empty?
          (filter #(not (nil? %))
@@ -108,4 +110,26 @@
                            expressions
                            (take do-this-many expressions)))))))))

+(deftest roundtrip-small-grammar
+  (let [do-this-many 1000]
+    (is (empty?
+         (filter #(not (nil? %))
+                 (let [expressions
+                       (generate-all {:synsem {:cat :verb
+                                               :sem {:tense :present}
+                                               :subcat '()}}
+                                     small)]
+                   (pmap (fn [expr]
+                           (if (empty? (parse (fo expr) small))
+                             (do
+                               (log/error (str "failed to parse: " (fo expr)))
+                             {:fo (fo expr)
+                              :expr (get-in expr [:synsem :sem])
+                              :sem (get-in (first (parse (fo expr) small))
+                                           [:synsem :sem])})
+                             (log/info (str "parse OK:" (fo expr)))))
+                         (if (= do-this-many :all)
+                           expressions
+                           (take do-this-many expressions)))))))))
+


+(defn test-tiny-model)

+(defn test-tiny-model)

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -908,3 +908,15 @@
          (= (:rule rule)
             "vp-pronoun-nonphrasal")))))

+(defn test-tiny-model []
+  (let [spec {:modified false,
+              :synsem {:cat :verb, :subcat [],
+                       :sem {:pred :see,
+                             :tense :present,
+                             :aspect :simple
+                             :obj {:spec :top}}}}
+        tm (tiny-model)]
+    (repeatedly #(println (morph (time (generate spec tm)))))))
+
+
+


+:subcat '()

+:subcat '()

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -431,7 +431,8 @@
 (deftest a-casa-generate-2
   (let [result (generate
                 {:modified false
-                 :synsem {:cat :verb
+                 :synsem {:subcat '()
+                          :cat :verb
                           :sem {:tense :present
                                 :aspect :simple
                                 :pred :a


doc change

doc change

--- test/midje/t_config.clj
+++ test/midje/t_config.clj
@@ -7,7 +7,7 @@
     (try
       (config/choice :print-level) =not=> :print-nothing
       (config/with-augmented-config {:print-level :print-facts}
-        ;; emphasizes that override overrides the root binding
+        ;; emphasizes that changes override the root binding
         (config/change-defaults :print-level :print-nothing))
       (config/choice :print-level) => :print-nothing
     (finally


:tada: Add new dynamic sql builder (for selects only).

--- backend/src/uxbox/util/sql.clj
+++ backend/src/uxbox/util/sql.clj
@@ -25,227 +25,172 @@
 (ns uxbox.util.sql
   "A composable sql helpers."
   (:refer-clojure :exclude [test update set format])
-  (:require [clojure.core :as c]))
+  (:require [clojure.core :as c]
+            [cuerdas.core :as str]))

-(defn- query?
+;; --- Low Level Helpers
+
+(defn raw-expr
   [m]
-  (::query m))
+  (cond
+    (string? m)
+    {::type :raw-expr
+     :sql m
+     :params []}
+
+    (vector? m)
+    {::type :raw-expr
+     :sql (first m)
+     :params (vec (rest m))}
+
+    (and (map? m)
+         (= :raw-expr (::type m)))
+    m
+
+    :else
+    (throw (ex-info "unexpected input" {:m m}))))
+
+(defn alias-expr
+  [m]
+  (cond
+    (string? m)
+    {::type :alias-expr
+     :sql m
+     :alias nil
+     :params []}
+
+    (vector? m)
+    {::type :alias-expr
+     :sql (first m)
+     :alias (second m)
+     :params (vec (drop 2 m))}
+
+    :else
+    (throw (ex-info "unexpected input" {:m m}))))
+
+;; --- SQL API (Select only)
+
+(defn from
+  [name]
+  {::type :query
+   ::from [(alias-expr name)]
+   ::order []
+   ::select []
+   ::join []
+   ::where []})

 (defn select
-  []
-  {::query true
-   ::type ::select})
-
-(defn update
-  ([table]
-   (update table nil))
-  ([table alias]
-   {::query true
-    ::type ::update
-    ::table [table alias]}))
-
-(defn delete
-  []
-  {::query true
-   ::type ::delete})
-
-(defn insert
-  [table fields]
-  {::query true
-   ::table table
-   ::fields fields
-   ::type ::insert})
-
-(defn from
-  ([m name]
-   (from m name nil))
-  ([m name alias]
-   {:pre [(query? m)]}
-   (c/update m ::from (fnil conj []) [name alias])))
-
-(defn field
-  ([m name]
-   (field m name nil))
-  ([m name alias]
-   (c/update m ::fields (fnil conj []) [name alias])))
-
-(defn fields
   [m & fields]
-  (reduce (fn [acc item]
-            (if (vector? item)
-              (apply field acc item)
-              (field acc item)))
-          m
-          fields))
+  (c/update m ::select into (map alias-expr fields)))

 (defn limit
   [m n]
-  {:pre [(= (::type m) ::select)
-         (query? m)]}
-  (assoc m ::limit n))
+  (assoc m ::limit [(raw-expr ["LIMIT ?" n])]))

 (defn offset
   [m n]
-  {:pre [(= (::type m) ::select)
-         (query? m)]}
-  (assoc m ::offset n))
+  (assoc m ::offset [(raw-expr ["OFFSET ?" n])]))
+
+(defn order
+  [m e]
+  (c/update m ::order conj (raw-expr e)))

 (defn- join*
-  [m type table alias condition]
-  {:pre [(= (::type m) ::select)
-         (query? m)]}
-  (c/update m ::joins (fnil conj [])
-               {:type type
-                :name table
-                :alias alias
-                :condition condition}))
+  [m type table condition]
+  (c/update m ::join conj
+            {::type :join-expr
+             :type type
+             :table (alias-expr table)
+             :condition (raw-expr condition)}))

 (defn join
-  ([m table condition]
-   (join m table nil condition))
-  ([m table alias condition]
-   {:pre [(= (::type m) ::select)
-          (query? m)]}
-   (join* m :inner table alias condition)))
+  [m table condition]
+  (join* m :inner table condition))

-(defn left-join
-  ([m table condition]
-   (left-join m table nil condition))
-  ([m table alias condition]
-   {:pre [(= (::type m) ::select)
-          (query? m)]}
-   (join* m :left table alias condition)))
+(defn ljoin
+  [m table condition]
+  (join* m :left table condition))
+
+(defn rjoin
+  [m table condition]
+  (join* m :right table condition))

 (defn where
-  [m condition & params]
-  {:pre [(query? m)]}
-  (-> m
-      (c/update ::where (fnil conj []) condition)
-      (cond-> (seq params)
-        (c/update ::params (fnil into []) params))))
-
-(defn set
-  [m field value]
-  {:pre [(query? m)]}
-  (-> m
-      (c/update ::assignations (fnil conj []) field)
-      (c/update ::params (fnil conj []) value)))
-
-(defn values
-  [m values]
-  {:pre [(query? m)]}
-  (assoc ::values values))
-
-(defn raw
-  [m sql & params]
-  (-> m
-      (c/update ::raw (fnil conj []) sql)
-      (c/update ::params (fnil into []) params)))
-
-(defmulti format ::type)
-
-(defn fmt
-  [m]
-  (into [(format m)] (::params m)))
+  [m & conditions]
+  (->> (filter identity conditions)
+       (reduce #(c/update %1 ::where conj (raw-expr %2)) m)))

 ;; --- Formating

-(defn- format-fields
-  [fields]
-  (letfn [(transform [[name alias]]
-            (if (string? alias)
-              (str name " " alias)
-              name))]
-    (apply str (->> (map transform fields)
-                    (interpose ", ")))))
+(defmulti format-expr ::type)

-(defn- format-join
-  [{:keys [type name alias condition]}]
-  (str (case type
-         :inner "INNER JOIN "
-         :left "LEFT JOIN ")
-       (if alias
-         (str name " " alias)
-         name)
-       " ON (" condition ")"))
+(defmethod format-expr :raw-expr
+  [{:keys [sql params]}]
+  [sql params])

-(defn- format-joins
-  [clauses]
-  (apply str (->> (map format-join clauses)
-                  (interpose " "))))
+(defmethod format-expr :alias-expr
+  [{:keys [sql alias params]}]
+  (if alias
+    [(str sql " AS " alias) params]
+    [sql params]))

-(defn- format-where
-  [conditions]
-  (when (seq conditions)
-    (str "WHERE (" (apply str (interpose ") AND (" conditions)) ")")))
+(defmethod format-expr :join-expr
+  [{:keys [table type condition]}]
+  (let [[csql cparams] (format-expr condition)
+        [tsql tparams] (format-expr table)
+        prefix (str/upper (name type))]
+    [(str prefix " JOIN " tsql " ON (" csql ")") (into cparams tparams)]))

+(defn- format-exprs
+  ([items] (format-exprs items {}))
+  ([items {:keys [prefix suffix join-with]
+           :or {prefix ""
+                suffix ""
+                join-with ","}}]
+   (loop [rs []
+          rp []
+          v (first items)
+          n (rest items)]
+     (if v
+       (let [[s p] (format-expr v)]
+         (recur (conj rs s)
+                (into rp p)
+                (first n)
+                (rest n)))
+       [(str prefix (str/join join-with rs) suffix) rp]))))

+(defn- process-param-tokens
+  [sql]
+  (let [cnt (java.util.concurrent.atomic.AtomicInteger. 1)]
+    (str/replace sql #"\?" (fn [& args]
+                             (str "$" (.getAndIncrement cnt))))))

-(defn- format-assignations
-  [assignations]
-  (apply str (->> (map #(str % " = ?") assignations)
-                  (interpose ", "))))
+(def ^:private select-formatters
+  [#(format-exprs (::select %) {:prefix "SELECT "})
+   #(format-exprs (::from %) {:prefix "FROM "})
+   #(format-exprs (::join %))
+   #(format-exprs (::where %) {:prefix "WHERE ("
+                               :join-with ") AND ("
+                               :suffix ")"})
+   #(format-exprs (::order %) {:prefix "ORDER BY "} )
+   #(format-exprs (::limit %))
+   #(format-exprs (::offset %))])

-(defn- format-raw
-  [items]
-  (when (seq items)
-    (apply str (interpose " " items))))
+(defn- collect
+  [formatters qdata]
+  (loop [sqls []
+         params []
+         f (first formatters)
+         r (rest formatters)]
+    (if (fn? f)
+      (let [[s p] (f qdata)]
+        (recur (conj sqls s)
+               (into params p)
+               (first r)
+               (rest r)))
+      [(str/join " " sqls) params])))

-(defmethod format ::select
-  [{:keys [::fields ::from ::joins ::where]}]
-  (str "SELECT "
-       (format-fields fields)
-       " FROM "
-       (format-fields from)
-       " "
-       (format-joins joins)
-       " "
-       (format-where where)))
-
-(defmethod format ::update
-  [{:keys [::table ::assignations ::where]}]
-  (str "UPDATE "
-       (format-fields [table])
-       " SET "
-       (format-assignations assignations)
-       " "
-       (format-where where)))
-
-(defmethod format ::delete
-  [{:keys [::from ::where]}]
-  (str "DELETE FROM "
-       (format-fields from)
-       " "
-       (format-where where)))
-
-(defmethod format ::insert
-  [{:keys [::table ::fields ::values ::raw]}]
-  (let [fsize (count fields)
-        pholder (str "(" (apply str (->> (map (constantly "?") fields)
-                                         (interpose ", "))) ")")]
-
-    (str "INSERT INTO " table "(" (apply str (interpose ", " fields)) ")"
-         " VALUES " (apply str (->> (map (constantly pholder) values)
-                                    (interpose ", ")))
-         " "
-         (format-raw raw))))
-
-;; (defn test-update
-;;   []
-;;   (-> (update "users" "u")
-;;       (set "u.username" "foobar")
-;;       (set "u.email" "niwi@niwi.nz")
-;;       (where "u.id = ? AND u.deleted_at IS null" 555)))
-
-;; (defn test-delete
-;;   []
-;;   (-> (delete)
-;;       (from "users" "u")
-;;       (where "u.id = ? AND u.deleted_at IS null" 555)))
-
-;; (defn test-insert
-;;   []
-;;   (-> (insert "users" ["id", "username"])
-;;       (values [[1 "niwinz"] [2 "niwibe"]])
-;;       (raw "RETURNING *")))
-
+(defn fmt
+  [qdata]
+  (let [[sql params] (collect select-formatters qdata)]
+    (into [(process-param-tokens sql)] params)))


Remove reflection introduced with latest Undertow update

--- web/src/immutant/web/undertow.clj
+++ web/src/immutant/web/undertow.clj
@@ -50,7 +50,7 @@
       (assoc :configuration
         (cond-> builder
           (and ssl-port ssl-context)       (.addHttpsListener ssl-port host ssl-context)
-          (and ssl-port (not ssl-context)) (.addHttpsListener ssl-port host key-managers trust-managers)
+          (and ssl-port (not ssl-context)) (.addHttpsListener ^int ssl-port ^String host ^"[Ljavax.net.ssl.KeyManager;" key-managers ^"[Ljavax.net.ssl.TrustManager;" trust-managers)
           (and ajp-port)                   (.addAjpListener ajp-port host)
           (and port)                       (.addHttpListener port host)))
       (dissoc :host :port :ssl-port :ssl-context :key-managers :trust-managers :ajp-port))))


More informative output messages

More informative output messages

--- test/transit/verify.clj
+++ test/transit/verify.clj
@@ -19,7 +19,8 @@
             [transit.generators :as gen]
             [transit.corner-cases :as cc])
   (:import [java.io PrintStream ByteArrayOutputStream ByteArrayInputStream
-            BufferedInputStream BufferedOutputStream FileInputStream]))
+            BufferedInputStream BufferedOutputStream FileInputStream]
+           [org.apache.commons.codec.binary Hex]))

 (def TIMEOUT
   "Timeout for roundtrip requests to native implementation"
@@ -97,6 +98,9 @@
   data to the output stream. Throws an exception of the output stream
   is closed."
   [proc transit-data]
+  #_(println "Send bytes:")
+  #_(println (count transit-data))
+  #_(println (Hex/encodeHexString transit-data))
   (try
     (.write (:out proc) transit-data 0 (count transit-data))
     (.flush (:out proc))
@@ -161,7 +165,6 @@
   transit enconding, record the time in milliseconds that it takes
   to roundtrip all of the transit messages."
   [transits proc encoding]
-  (println "collecting timing information...")
   (dotimes [x 200]
     (mapv #(roundtrip-transit proc % encoding) transits))
   (let [start (System/nanoTime)]
@@ -190,18 +193,23 @@
   (let [transit-exemplars (exemplar-transit encoding)]
     (filter #((:pred %) proc encoding opts)
             [{:pred (constantly true)
+              :desc "exemplar file"
               :path [:tests :exemplar-file]
               :test #(test-transit transit-exemplars proc encoding)}
              {:pred (constantly true)
+              :desc "EDN corner case"
               :path [:tests :corner-case-edn]
               :test #(test-edn cc/forms proc encoding)}
              {:pred (fn [_ e _] (= e :json))
+              :desc "JSON transit corner case"
               :path [:tests :corner-case-transit-json]
               :test #(test-transit (map (fn [s] (.getBytes s)) cc/transit-json) proc encoding)}
              {:pred (fn [_ _ o] (:gen o))
+              :desc "generated EDN"
               :path [:tests :generated-edn]
               :test #(test-edn (:generated-forms opts) proc encoding)}
              {:pred (fn [_ _ o] (:time o))
+              :desc "timing"
               :path [:time]
               :test #(let [ms (test-timing transit-exemplars proc encoding)]
                        {:ms ms
@@ -225,7 +233,10 @@
                  :encoding encoding}]
     (try
       (let [tests (filter-tests proc encoding opts)
-            results (reduce (fn [r {:keys [path test]}]
+            results (reduce (fn [r {:keys [path test desc]}]
+                              (println (format "running \"%s\" test for %s encoding..."
+                                               desc
+                                               (name encoding)))
                               (assoc-in r path (test)))
                             results
                             tests)]
@@ -241,13 +252,13 @@
   "Given a project name, an encoding and user provided options, run
   tests against this project."
   [project encoding opts]
-  (println "testing" project "...")
+  (println (format "testing %s's %s encoding"
+                   project
+                   (name encoding)))
   (let [command (str "../" project "/bin/roundtrip")]
-    (if (= encoding :msgpack)
-      (println "msgpack tests are disabled until we have a working implementation.")
-      (report (-> (verify-impl-encoding command encoding opts)
-                  (assoc :project project))
-              opts))))
+    (report (-> (verify-impl-encoding command encoding opts)
+                (assoc :project project))
+            opts)))

 (defn verify-impl
   "Given a project name like 'transit-java', 'transit-clj' or


Fix tests

Fix tests

--- test/yada/bidi_test.clj
+++ test/yada/bidi_test.clj
@@ -4,6 +4,7 @@
   (:require
    [clojure.test :refer :all]
    [yada.yada :refer (yada) :as yada]
+   [yada.test.util :refer (given)]
    [yada.bidi :refer (resource-leaf)]
    [bidi.bidi :as bidi :refer (Matched compile-route succeed context)]
    [bidi.ring :refer (make-handler Ring)]
@@ -30,7 +31,9 @@

 (deftest api-tests
   (let [h (make-handler api)
-        send (comp (juxt :status :headers :body) deref h)]
+        response @(h (request :get "/api/status"))]
     (testing "hello"
-      (is (= (send (request :get "/api/status"))
-             [200 {"content-length" 12} "API working!"])))))
+      (given response
+        :status := 200
+        :headers :> {"content-length" 12}
+        :body := "API working!"))))


allow clean for ITs

allow clean for ITs

--- src/shuppet/web.clj
+++ src/shuppet/web.clj
@@ -82,8 +82,8 @@

 (defn- clean-app-config
   [environment name]
-  (when-not (= (env :environment-name) "local")
-    (throw+ {:type ::wrong-environment}))
+  (when-not (or (= (env :environment-name) "local") (= name "test"))
+    (throw+ {:type ::clean-not-allowed}));only allow clean for dev and integration test
   (core/clean-config environment name)
   (response {:message (str "Succesfully cleaned the configuration for application " name)}))


Wrap multi params to receive files

Wrap multi params to receive files

--- domain/src/domain/core.clj
+++ domain/src/domain/core.clj
@@ -2,6 +2,7 @@
   (:require [compojure.core :refer :all]
             [compojure.route :as route]
             [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
+            [ring.middleware.multipart-params :refer [wrap-multipart-params]]
             [ring.middleware.json :refer [wrap-json-body wrap-json-response]]
             [ring.util.response :refer [response]]
             [clojure.java.io :as io]
@@ -87,4 +88,5 @@
   (-> app-routes
       (wrap-defaults api-defaults)
       (wrap-json-body {:keywords? true})
-      (wrap-json-response)))
+      (wrap-json-response)
+      (wrap-multipart-params)))


Use our own html macro

Use our own html macro

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -13,8 +13,8 @@
             [frontend.utils :as utils :include-macros true]
             [frontend.utils.github :as gh-utils]
             [frontend.utils.seq :refer [select-in]]
-            [om.core :as om :include-macros true]
-            [sablono.core :as html :refer-macros [html]]))
+            [om.core :as om :include-macros true])
+  (:require-macros [frontend.utils :refer [html]]))

 (defn active-class-if-active [current-subpage subpage-link]
   (if (= current-subpage subpage-link)
@@ -29,7 +29,7 @@
     (render [_]
       (let [user-and-orgs (sort-by (complement :org)
                                    (get-in app state/user-organizations-path))]
-        (html/html
+        (html
          [:div#settings-plans
           [:legend "Org Settings"]
           [:div.plans-item
@@ -66,7 +66,7 @@
             heroku-api-key-input (get-in app (conj state/user-path :heroku-api-key-input))
             submit-form! #(raise! owner [:heroku-key-add-attempted {:heroku_api_key heroku-api-key-input}])
             project-page? (:project-page? opts)]
-        (html/html
+        (html
          [:div#settings-heroku.settings
           [:div.heroku-item
            [:legend "Heroku API key"]
@@ -107,7 +107,7 @@
       (let [tokens        (get-in app state/user-tokens-path)
             create-token! #(raise! owner [:api-token-creation-attempted {:label %}])
             new-user-token (get-in app state/new-user-token-path)]
-        (html/html
+        (html
          [:div#settings-api.settings
           [:legend "API Tokens"]
           [:div.api-item
@@ -202,7 +202,7 @@
   (reify
     om/IRenderState
     (render-state [_ {:keys [clicked-join?]}]
-      (html/html
+      (html
        [:div
         [:p
          "We invite you to join Inner Circle, our new beta program. As a
@@ -265,7 +265,7 @@
     om/IRender
     (render [_]
       (let []
-        (html/html
+        (html
          [:div#settings-beta-program
           [:div
            (let [message (get-in app state/general-message-path)
@@ -402,7 +402,7 @@
     (render [_]
       (let [user (get-in app state/user-path)
             projects (get-in app state/projects-path)]
-        (html/html
+        (html
          [:div#settings-notification
           [:legend "Notification Settings"]
           (preferred-email-address owner user)


Fixed parsing issue with numbers in symbols

--- minimal/lang.clj
+++ minimal/lang.clj
@@ -32,11 +32,15 @@
 (def open-bracket? (char) (= char 40))
 (def close-bracket? (char) (= char 41))
 (def int32-character? (char) (and (> char 47) (< char 58)))
+(def initial-symbol-character? (char)
+    (and (not (close-bracket? char))
+    (and (not (open-bracket? char))
+    (and (not (int32-character? char))
+         (not (whitespace? char))))))
 (def symbol-character? (char)
-  (and (not (close-bracket? char))
-  (and (not (open-bracket? char))
-  (and (not (int32-character? char))
-       (not (whitespace? char))))))
+    (and (not (close-bracket? char))
+    (and (not (open-bracket? char))
+         (not (whitespace? char)))))

 (def is-first-char-of (source predicate)
      (match source
@@ -84,7 +88,7 @@
     (match (is-first-char-of source int32-character?)
            True (read-int32-token source tokens)
            False
-    (match (is-first-char-of source symbol-character?)
+    (match (is-first-char-of source initial-symbol-character?)
            True (read-symbol-token source tokens)
            False
     (match source


Add missing import on media.

Add missing import on media.

--- src/uxbox/media.clj
+++ src/uxbox/media.clj
@@ -7,6 +7,7 @@
 (ns uxbox.media
   "A media storage impl for uxbox."
   (:require [mount.core :as mount :refer (defstate)]
+            [clojure.java.io :as io]
             [cuerdas.core :as str]
             [storages.core :as st]
             [storages.fs :refer (filesystem)]


Kaffi.. for reals!

Kaffi.. for reals!

--- src/clj/mokkameister/resources/button.clj
+++ src/clj/mokkameister/resources/button.clj
@@ -8,7 +8,7 @@
   (let [token (get-in ctx [:request :params :secret])]
     (= token (system :button-token))))

-(defn- handle-old-button-post [ctx]
+(defn- handle-button [ctx]
   (let [brew {:channel "#penthouse"
               :slack-user "nokon"
               :brew-time 5
@@ -16,15 +16,11 @@
     (start-brewing! brew))
   "OK")

-(defn- handle-button-get [ctx]
-  ;; New button uses GET, seems like SendToHTTP
-  ;; command is very basic :(
-  (notify "Kaffi!" :channel "#testroompleaseignore")
-  "OK")
-
 (defresource coffee-button
   :available-media-types ["text/plain"]
   :allowed-methods [:post :get]
   :authorized? valid-button-token?
-  :post! handle-old-button-post
-  :handle-ok handle-button-get)
+  :post! handle-button
+  ;; New button uses GET, seems like SendToHTTP
+  ;; command is very basic :(
+  :handle-ok handle-button)


Fix minor window issues.

Fix minor window issues.

--- src/cljs/cljs_workspace/morph/window.cljs
+++ src/cljs/cljs_workspace/morph/window.cljs
@@ -16,57 +16,58 @@
    :shape {:ShapeClass "Text"
            :Extent {:x 100 :y 20}}})

-(def close-box
+(defn close-box [$morph target-id]
   {:id "closeBox"
    :morph {:Position {:x 10 :y 10}
            :onMouseEnter (fn [self _]
-                           (let [x-box (-> self :>> :submorphs (get 0))]
-                             (morphic/toggle-visibility x-box)))
+                           (let [x-box (-> self :>> :submorphs first)]
+                             (om/update! x-box [:morph :Visible] true)))
            :onMouseLeave (fn [self _]
-                           (let [x-box (-> self :>> :submorphs (get 0))]
-                             (morphic/toggle-visibility x-box)))
+                           (let [x-box (-> self :>> :submorphs first)]
+                             (om/update! x-box [:morph :Visible] false)))
            :onClick (fn [self _]
-                      (let [->self (self :>>)
-                             ->target (prn (om/path ->self))]
-                        (morphic/remove-morph (get-in ->target :owner) (get @->target :id))))}
+                      (let [->target ($morph target-id)]
+                        (prn "Closing window" @($morph "World"))
+                        (morphic/remove-morph ($morph "World") target-id)))}
    :shape {:ShapeClass "Ellipse"
            :Extent {:x control-height :y control-height}
            :Fill "#ff6052"}
-   :submorphs [{:morph {:Position {:x 2 :y -2}
+   :submorphs [{:morph {:Position {:x -4 :y -8}
                         :TextString "×"
                         :FontSize 10
                         :AllowInput false
                         :Visible false}
                 :shape {:ShapeClass "Text"}}]})

-(def min-box
+(defn min-box [$morph target-id]
   {:id "minBox"
    :morph {:Position {:x 30 :y 10}
-           :onMouseEnter (fn [->self _]
-                           (let [x-box (get-in ->self [:submorphs 0])]
-                             (morphic/toggle-visibility x-box)))
-           :onMouseLeave (fn [->self _]
-                           (let [x-box (get-in ->self [:submorphs 0])]
-                             (morphic/toggle-visibility x-box)))
-           :onClick (fn [->self]
-                      (let [->target (get-in ->self [:owner :owner])
-                            width (get @->target [:shape :Extent :x])]
-                        (morphic/set-extent ->target {:x width :y 15})))}
+           :onMouseEnter (fn [self _]
+                           (let [x-box (-> self :>> :submorphs first)]
+                             (om/update! x-box [:morph :Visible] true)))
+           :onMouseLeave (fn [self _]
+                           (let [x-box (-> self :>> :submorphs first)]
+                             (om/update! x-box [:morph :Visible] false)))
+           :onClick (fn [self]
+                      ; Fixme: Double hopping not yet possible, as parent refs are local to morphs
+                      (let [->target ($morph target-id)
+                            width (-> ->target :shape :Extent :x)]
+                        (morphic/set-extent ->target {:x width :y 30})))}
    :shape {:ShapeClass "Ellipse"
            :Extent {:x control-height :y control-height}
            :Fill "#ffbe06"}
-   :submorphs [{:morph {:Position {:x 2 :y -2}
+   :submorphs [{:morph {:Position {:x -4 :y -8.5}
                         :TextString "−"
                         :FontSize 10
                         :AllowInput false
                         :Visible false}
                 :shape {:ShapeClass "Text"}}]})

-(def window-bar
+(defn window-bar [$morph target-id]
   {:id "windowbar"
    :morph {:Position {:x 0 :y 0}}
    :shape {:Extent {:x 200 :y 30}}
-   :submorphs [(name-morph "Workspace") min-box close-box]})
+   :submorphs [(name-morph target-id) (min-box $morph target-id) (close-box $morph target-id)]})

 (defn resize-button [owner-extent]
   {:id "Button"
@@ -81,7 +82,7 @@
            :Extent {:x 15 :y 15}
            :url "http://lively-web.org/core/media/halos/resize.svg"}})

-(defn create-window [{name :name, position :position, extent :extent}]
+(defn create-window [{name :name, position :position, extent :extent, $morph :$morph}]
   {:id name
    :morph {:Position position
            :isDraggable true}
@@ -91,4 +92,4 @@
            :BorderRadius 10
            :BorderWidth 1
            :DropShadow true}
-   :submorphs [(resize-button extent), window-bar]})
+   :submorphs [(resize-button extent), (window-bar $morph name)]})


Removing accidentally committed file.

Removing accidentally committed file.

--- src/cmr/metadata_db/data/oracle/store.clj
+++ src/cmr/metadata_db/data/oracle/store.clj
@@ -1,70 +0,0 @@
-(ns cmr.metadata-db.data.oracle.core
-  "Contains a record definition that implements the ConcpetStore and Lifecycle protocols
-  backed by an Oracle database."
-  (:require [cmr.metadata-db.data :as data]
-            [cmr.metadata-db.providers :as provider]
-            [cmr.common.lifecycle :as lifecycle]
-            [clojure.string :as string]
-            [cmr.common.services.errors :as errors]
-            [cmr.common.log :refer (debug info warn error)]
-            [cmr.common.util :as cutil]
-            [clojure.pprint :refer (pprint pp)]
-            [clojure.java.jdbc :as j]
-            [cmr.metadata-db.services.utility :as util])
-  (:import com.mchange.v2.c3p0.ComboPooledDataSource))
-
-;;; Constants
-
-(def db-username (get (System/getenv) "MDB_DB_USERNAME" "METADATA_DB"))
-(def db-password (get (System/getenv) "MDB_DB_PASSWORD" "METADATA_DB"))
-(def db-host (get (System/getenv) "MDB_DB_HOST" "localhost"))
-(def db-port (get (System/getenv) "MDB_DB_PORT" "1521"))
-(def db-sid (get (System/getenv) "MDB_DB_SID" "orcl"))
-
-(def db-spec
-  {:classname "oracle.jdbc.driver.OracleDriver"
-   :subprotocol "oracle"
-   :subname (format "thin:@%s:%s:%s" db-host db-port db-sid)
-   :user db-username
-   :password db-password})
-
-
-(defn generate-concept-id
-  "Create a concept-id for a given concept type and provider id."
-  [db concept]
-  (let [{:keys [concept-type provider-id]} concept
-        seq-num (:nextval (first (j/query db ["SELECT METADATA_DB.concept_id_seq.NEXTVAL FROM DUAL"])))]
-    (util/generate-concept-id concept-type provider-id seq-num)))
-
-
-(defrecord OracleStore [db]
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  lifecycle/Lifecycle
-
-  (start [this system]
-         this)
-
-  (stop [this system]
-        this))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn pool
-  [spec]
-  (let [cpds (doto (ComboPooledDataSource.)
-               (.setDriverClass (:classname spec))
-               (.setJdbcUrl (str "jdbc:" (:subprotocol spec) ":" (:subname spec)))
-               (.setUser (:user spec))
-               (.setPassword (:password spec))
-               ;; expire excess connections after 30 minutes of inactivity:
-               (.setMaxIdleTimeExcessConnections (* 30 60))
-               ;; expire connections after 3 hours of inactivity:
-               (.setMaxIdleTime (* 3 60 60)))]
-    {:datasource cpds}))
-
-(defn create-db
-  "Creates and returns the database connection pool."
-  [db-spec]
-  (map->OracleStore (pool db-spec)))


simplify

simplify

--- src/app.cljs
+++ src/app.cljs
@@ -1,7 +1,4 @@
-(ns app
-  (:require [clojure.browser.repl :as repl]))
-
-;; (repl/connect "http://localhost:9000/repl")
+(ns app)

 (enable-console-print!)


using pmap to improve performance of bolts-with-comps

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -179,7 +179,8 @@
   addition, there is an key [] whose value is the bolt itself."
   [spec model depth max-depth]
   (log/debug  (str "bolts-with-comps:" depth "/" max-depth ":" (strip-refs spec)))
-  (map (fn [lb]
+  ;; using pmap rather than map improves performance about 40% in some cases.
+  (pmap (fn [lb]
           (merge
            (let [comp-paths (find-comp-paths lb)]
              (zipmap comp-paths
@@ -187,7 +188,7 @@
                             (filter not-fail? (comp-path-to-complements lb path model depth max-depth)))
                           comp-paths)))
            {[]
-           (filter not-fail? [lb])}))
+            (filter not-fail? [lb])}))
         (let [bolts
               (lightning-bolts model spec depth max-depth)]
           (if (empty? bolts)


Old Entry Warning

Old Entry Warning

Older posts have technical details that could be considered out of date. To avoid misleading people I have introduced a banner (currently only on screencasts) to warn people of this fact.

--- src/briefcase/views.clj
+++ src/briefcase/views.clj
@@ -4,7 +4,9 @@
            [optimus.hiccup    :as bundles]
            [cemerick.url      :refer [url-encode]]
            [slugger.core      :refer [->slug]]
-           [hiccup.page       :refer [html5]]))
+           [hiccup.page       :refer [html5]]
+           [clj-time.core     :refer [minus months before?]]
+           [clj-time.coerce   :refer [from-date]]))

 (declare main-layout)

@@ -48,6 +50,17 @@
     [:div.dater (pretty-date (:date data))]
     [:div.categories (published data)]))

+(def ^:private six-months-ago
+  (minus (from-date (java.util.Date.) (months 6))))
+
+(defn- old-entry-warning
+  "Generates a warning for entries that are more than 6 months or so old"
+  [data]
+  (when (before? (:date data) six-months-ago)
+    (hiccup.core/html
+      [:blockquote.warning "This post is over 6 months old.
+      	Some details, especially technical, may have changed
+      	since posting."])))

 (defn index
   "Renders the landing page of the site"
@@ -75,6 +88,7 @@
   "Renders a non-external screencast page"
   [request data]
   (main-layout request (:title data)
+               (old-entry-warning data)
                [:div.vimeo
                  [:iframe { :src (:url data)
                             :width "631"


Fix email on copyright notice on core.hash ns.

--- src/buddy/core/hash.clj
+++ src/buddy/core/hash.clj
@@ -1,4 +1,4 @@
-;; Copyright 2014-2015 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2014-2015 Andrey Antukh <niwi@niwi.nz>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


Aggregate jobs for stages by default, allow exceptions

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -40,8 +40,8 @@
    ["-f" "--from DATE" "DATE from which on builds are loaded (by default tries to pick up where the last run finished)"
     :id :sync-start-time
     :parse-fn #(tf/parse date-formatter %)]
-   ["-s" "--aggregate PIPELINE" "PIPELINE for which a complete stage will be synced as a job"
-    :id :aggregate-jobs-for-pipelines
+   ["-j" "--sync-jobs PIPELINE" "PIPELINE for which Go jobs will be synced individually (not aggregated inside stage)"
+    :id :sync-jobs
     :default '()
     :assoc-fn (fn [previous key val] (assoc previous key (conj (get previous key) val)))]
    ["-h" "--help"]])
@@ -110,11 +110,11 @@
            :job-instances (list (assoc aggregated-build
                                        :junit-xml aggregated-junit-xml)))))

-(defn- aggregate-jobs-for-selected-stages [stage-instance aggregate-jobs-for-pipelines]
+(defn- aggregate-jobs-for-stage-instance [stage-instance sync-jobs-for-pipelines]
   (let [{pipeline-name :pipelineName} stage-instance]
-    (if (contains? aggregate-jobs-for-pipelines pipeline-name)
-      (aggregate-jobs-for-stage stage-instance)
-      stage-instance)))
+    (if (contains? sync-jobs-for-pipelines pipeline-name)
+      stage-instance
+      (aggregate-jobs-for-stage stage-instance))))

 (defn- build-for-job [stage-instance job-name]
@@ -123,7 +123,7 @@
         (assoc :name job-name)
         (assoc :junit-xml (goapi/get-junit-xml go-url job-instance)))))

-(defn- add-job-instances-for-stage-instances [stage-instance]
+(defn- add-job-instances-for-stage-instance [stage-instance]
   (let [job-names (:job-names stage-instance)]
     (assoc stage-instance
            :job-instances (map #(build-for-job stage-instance %) job-names))))
@@ -145,7 +145,7 @@
          (take-while #(t/after? (:scheduled-time %) safe-build-start-date)))))

-(defn add-inputs-for-stage-instances [stage-instance]
+(defn add-inputs-for-stage-instance [stage-instance]
   (let [pipeline-run (:pipelineRun stage-instance)
         pipeline-name (:pipelineName stage-instance)
         inputs (goapi/get-inputs-for-pipeline-run go-url pipeline-name pipeline-run)]
@@ -234,11 +234,9 @@

 ;; run

-(defn- emit-start [sync-start-time aggregate-jobs-for-pipelines pipeline-stages]
+(defn- emit-start [sync-start-time pipeline-stages]
   (println "Looking at pipeline groups" (distinct (map :group pipeline-stages)))
   (println "Syncing all stages starting from" (tf/unparse (:date-time tf/formatters) sync-start-time))
-  (when (some? aggregate-jobs-for-pipelines)
-    (println "Aggregating jobs for stages of" aggregate-jobs-for-pipelines))

   (println "Finding all pipeline runs for syncing...")

@@ -267,18 +265,18 @@
   (println "Go" go-url "-> buildviz" buildviz-url)

   (let [sync-start-time (get-start-date (:sync-start-time (:options args)))
-        aggregate-jobs-for-pipelines (set (:aggregate-jobs-for-pipelines (:options args)))
+        sync-jobs-for-pipelines (set (:sync-jobs (:options args)))
         selected-pipeline-group-names (set (drop 1 (:arguments args)))]

     (->> (goapi/get-stages go-url)
          (select-stages selected-pipeline-group-names)
-         (emit-start sync-start-time aggregate-jobs-for-pipelines)
+         (emit-start sync-start-time)
          (mapcat #(stage-instances-from sync-start-time %))
          (sort-by :scheduled-time)
          emit-count-items
-         (map add-inputs-for-stage-instances)
-         (map add-job-instances-for-stage-instances)
-         (map #(aggregate-jobs-for-selected-stages % aggregate-jobs-for-pipelines))
+         (map add-inputs-for-stage-instance)
+         (map add-job-instances-for-stage-instance)
+         (map #(aggregate-jobs-for-stage-instance % sync-jobs-for-pipelines))
          (mapcat stage-instances->builds)
          (map put-to-buildviz)
          emit-end)))


Properties can allow namespaced entries

Properties can allow namespaced entries

--- src/yada/schema.clj
+++ src/yada/schema.clj
@@ -152,7 +152,8 @@
 (s/defschema StaticProperties
   {(s/optional-key :last-modified) s/Inst
    (s/optional-key :version) s/Any
-   (s/optional-key :exists?) s/Bool})
+   (s/optional-key :exists?) s/Bool
+   NamespacedKeyword s/Any})

 (s/defschema PropertiesResult
   (merge StaticProperties


fix checking named instances for CLJS

fix checking named instances for CLJS

--- src/calfpath/route.cljc
+++ src/calfpath/route.cljc
@@ -171,7 +171,8 @@
   [routes {:keys [allowed-methods method-finder] :as opts}]
   (when (not (or allowed-methods method-finder))
     (i/expected "either :allowed-methods or :method-finder key to be present" opts))
-  (let [as-str (fn [x] (if (instance? clojure.lang.Named x)
+  (let [as-str (fn [x] (if #?(:cljs (cljs.core/implements? INamed x)
+                               :clj (instance? clojure.lang.Named x))
                          (name x)
                          (str x)))
         methods-list (or allowed-methods


use update-when-in to prevent a race

use update-when-in to prevent a race

--- src-cljs/frontend/sente.cljs
+++ src-cljs/frontend/sente.cljs
@@ -45,9 +45,8 @@
 (defmethod handle-message :frontend/subscriber-left [app-state message data]
   (swap! app-state update-in [:subscribers] dissoc (:client-uuid data)))

-;; TODO: update-when-in
 (defmethod handle-message :frontend/mouse-move [app-state message data]
-  (swap! app-state update-in [:subscribers (:client-uuid data)] merge (select-keys data [:mouse-position :tool :layers])))
+  (swap! app-state utils/update-when-in [:subscribers (:client-uuid data)] merge (select-keys data [:mouse-position :tool :layers])))

 (defmethod handle-message :frontend/update-subscriber [app-state message data]
   (swap! app-state update-in [:subscribers (:client-uuid data)] merge (:subscriber-data data)))


Assert we don't use element incorrectly

Assert we don't use element incorrectly

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -1,21 +1,22 @@
 (ns frontend.utils
   (:refer-clojure :exclude [uuid])
   (:require [ajax.core :as ajax]
-            [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
             [cljs-time.core :as time]
+            [cljs.core.async :as async :refer [<! >! alts! chan close! sliding-buffer]]
             [clojure.string :as string]
-            [frontend.async :refer [raise! put!]]
+            [frontend.async :refer [put! raise!]]
             [frontend.config :as config]
             [frontend.state :as state]
-            [goog.Uri]
-            [goog.async.AnimationDelay]
+            goog.async.AnimationDelay
+            [goog.crypt :as crypt]
             [goog.crypt.Md5 :as md5]
-            [goog.crypt :as crypt]
             [goog.dom :as dom]
             [goog.events :as ge]
             [goog.net.EventType :as gevt]
+            [goog.object :as gobject]
             [goog.string :as gstring]
             [goog.style :as style]
+            goog.Uri
             [om.core :as om :include-macros true]
             [sablono.core :as html :include-macros true])
   (:require-macros [frontend.utils :refer [inspect timing defrender html]])
@@ -413,18 +414,32 @@
       clojure.string/lower-case
       keyword))

+
+(defn- has-prop?
+  "True if the React element has a value specified for the prop name."
+  [element prop-name]
+  (gobject/containsKey (.-props element) prop-name))
+
 (defn component*
   "Gives a React element a data-component value of name, unless the element
   already has a data-component value. (Use the macro `component` instead; it
   validates that the name is a Var at compile time.)"
   [name element]
-  (let [existing-data-component (aget (.-props element) "data-component")]
-    (cond-> element
-      (not existing-data-component) (js/React.cloneElement #js {:data-component name}))))
+  (cond-> element
+    (not (has-prop? element "data-component")) (js/React.cloneElement #js {:data-component name})))

 (defn element*
   "Gives a React element a data-element value of element-name \"namespaced\" to
   component-name. (Use the macro `element` instead; it uses the component-name
   of the nearest `component` macro form."
   [element-name component-name element]
-  (js/React.cloneElement element #js {:data-element (str component-name "/" element-name)}))
+  (let [full-name (str component-name "/" element-name)]
+    (assert (not (has-prop? element "data-component"))
+            (str "Tried to assign data-element "
+                 full-name
+                 " to a React element which already has data-component."))
+    (assert (not (has-prop? element "data-element"))
+            (str "Tried to assign data-element "
+                 full-name
+                 " to a React element which already has data-element."))
+    (js/React.cloneElement element #js {:data-element full-name})))


add gravatar-url helper

add gravatar-url helper

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -195,3 +195,8 @@
 (defn stop-event [e]
   (.stopPropagation e)
   (.preventDefault e))
+
+(defn gravatar-url [email & {:keys [default]
+                             :or {default "https://prcrsr.com/img/avatar.png"}}]
+  (str "https://www.gravatar.com/avatar/" (md5 (string/lower-case email))
+       "?d=" (js/encodeURIComponent default)))


lose unnecessary code

lose unnecessary code

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -331,10 +331,7 @@
 	    src-key-type Object
 	    tgt-metadata (count-reducer-metadata
 			  (map
-			   (fn [key]
-			       (let [[name type mutable] (.getAttribute src-metadata key)]
-				 [name type mutable] ;; TODO - try removing this deconstruction
-				 ))
+			   (fn [key] (.getAttribute src-metadata key))
 			   [src-key]))
 	    tgt-key "count"]
 	[ ;; get metadata / key


don't bother testing even numbers for primality

--- euler-clj/src/euler_clj/core.clj
+++ euler-clj/src/euler_clj/core.clj
@@ -56,18 +56,23 @@
 (defn prime?
   "Test if n is a prime number."
   [n]
-  (loop [p (int (math/floor (math/sqrt n)))]
-    (if (= p 1)
-      true
-      (if (= (mod n p) 0)
-        false
-        (recur (- p 1))))))
+  (case n
+    2 true
+    even? false
+    (loop [p (int (math/floor (math/sqrt n)))]
+      (if (= p 1)
+        true
+        (if (= (mod n p) 0)
+          false
+          (recur (- p 1)))))))

 (defn problem-3
   "Find the largest prime factor of n."
   [n]
   (loop [p (int (math/floor (math/sqrt n)))]
-    (if (and (= (mod n p) 0)
-             (prime? p))
+    (if (or (< p 3)
+            (and (= (mod n p) 0)
+                 (odd? p)
+                 (prime? p)))
       p
       (recur (- p 1)))))


solved problem 8

solved problem 8

--- euler-clj/src/euler_clj/core.clj
+++ euler-clj/src/euler_clj/core.clj
@@ -91,7 +91,7 @@
 (defn problem-4
   "Find the largest palindrome made from the product of two 3-digit numbers."
   []
-  (first (reverse (sort (palindromes-for-problem-4)))))
+  (apply max (palindromes-for-problem-4)))

 (defn problem-5
   "Return the smallest integer evenly divisible by every integer from m to n."
@@ -132,17 +132,13 @@
 (defn problem-8
   "Return the greatest product of 5 consecutive digits in a number."
   [n]
-  (let [p       (map #(java.lang.Integer/parseInt %) (rest(string/split (str problem-8-number) #"")))
-        result  (atom 0)]
-    (loop [sequence p]
-      (let [digits (take 5 sequence)]
-        (if (not-any? zero? digits)
-          (let [product (apply * digits)]
-            (if (> product @result)
-              (reset! result product))))
-        (if (< (count sequence) 6)
-          @result
-          (recur (rest sequence)))))))
+  (apply max
+    (loop [p      (map #(java.lang.Integer/parseInt %) (rest (string/split (str n) #"")))
+           result []]
+      (let [result (conj result (apply * (take 5 p)))]
+        (if (<= (count p) 5)
+          result
+          (recur (rest p) result))))))

 (defn -main
   [& args]


Removes superflous if.

Removes superflous if.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -441,10 +441,7 @@
             (let [[mode body] body
                   mflat?      (flat? mode)
                   k           (make-key (if mflat? body (:key body)))]
-              ;; FIXME: we are now doing in both cases the same
-              (if (flat? mode)
-                `(key-exists-without-binding-clause ~k)
-                `(key-exists-without-binding-clause ~k))))
+              `(key-exists-without-binding-clause ~k)))

           :key-exists-with-binding
           (let [k (make-key (:key body))


fix valid-word? to deal with qu and gi

fix valid-word? to deal with qu and gi

--- src/bogo_clojure/bg_word.clj
+++ src/bogo_clojure/bg_word.clj
@@ -77,24 +77,29 @@
           ""
           word))

+(defn valid-word-qu-gi?
+  [comps]
+  (let [[first-consonant vowel last-consonant] comps]
+       (cond
+        (and (= first-consonant "qu") (= (subs vowel 0 1) "u")) false
+        (and (= first-consonant "gi") (= (subs vowel 0 1) "i")) false
+        :else true)))
+
 (defn valid-word?
   "Return true if the given word is a valid vietnamese words or is extendable to
 a valid vietnamese word"
   [word]
   (let [comps (split-word (normalize word))
-        [first-consonant vowel last-consonant] comps
-        ]
+        [first-consonant vowel last-consonant] comps]
     (if (and (contains? CONSONANTS first-consonant)
              (contains? VOWELS vowel)
-             (contains? TERMINAL_CONSONANTS last-consonant))
+             (contains? TERMINAL_CONSONANTS last-consonant)
+             (valid-word-qu-gi? comps))
       (if (contains? TERMINAL_VOWELS vowel)
         (= "" last-consonant)
         (case last-consonant
-               "ch" (contains? #{"a" "ê" "uê" "i" "uy" "oa"} vowel)
-               "c" (not (= "ơ" vowel))
-               true
-               ))
-      false
-      )
-    )
-  )
+          "ch" (contains? #{"a" "ê" "uê" "i" "uy" "oa"} vowel)
+          "c" (not (= "ơ" vowel))
+          true
+          ))
+      false)))


fix API setLastMove & setCheck

fix API setLastMove & setCheck

--- src/chessground/handler.cljs
+++ src/chessground/handler.cljs
@@ -18,8 +18,8 @@
     :get-current-premove #(a/put! msg (-> % :premovable :current))
     :set-fen #(assoc % :chess (chess/make (or msg "start")))
     :api-move (fn [app] (update-in app [:chess] #(chess/move-piece % msg)))
-    :set-last-move (fn [app] (update-in app :chess #(chess/set-last-move % msg)))
-    :set-check (fn [app] (update-in app [:chess] #(chess/set-check % msg)))
+    :set-last-move #(data/set-last-move % msg)
+    :set-check #(data/set-check % msg)
     :set-pieces (fn [app] (update-in app [:chess] #(chess/set-pieces % msg)))
     :set-dests #(data/set-dests % msg)
     :set-turn-color #(data/set-turn-color % msg)


Small bugfix

Small bugfix

--- src/clj_simple_chart/jfx.clj
+++ src/clj_simple_chart/jfx.clj
@@ -95,7 +95,7 @@
         attrs (second t)
         width (:width attrs)
         height (:height attrs)]
-    (render t)
+    (render-svg t)
     (Platform/runLater
       (fn []
         (let [snap (SnapshotParameters.)]


Adding rendering pauses to router loop

Adding rendering pauses to router loop

--- src/cljs/zetawar/router.cljs
+++ src/cljs/zetawar/router.cljs
@@ -1,8 +1,9 @@
 (ns zetawar.router
   (:require
-   [cljs.core.async :refer [chan close! put!]]
+   [cljs.core.async :refer [chan close! put! sliding-buffer]]
    [cljsjs.raven]
    [datascript.core :as d]
+   [reagent.core :as r]
    [taoensso.timbre :as log]
    [zetawar.players :as players])
   (:require-macros
@@ -27,7 +28,6 @@
       (js/Raven.captureMessage log-msg)
       (log/error log-msg))))

-;; TODO: add pause for rendering after fixed interval
 (defn handle-event* [{:as router-ctx :keys [conn ev-chan notify-chan]} msg]
   (let [ev-ctx (assoc router-ctx :db @conn)
         {:as ret :keys [tx]} (handle-event ev-ctx msg)]
@@ -42,14 +42,35 @@
       (players/notify notify-chan notify-msg))))

 (defn start [{:as router-ctx :keys [ev-chan]}]
-  (go-loop [msg (<! ev-chan)]
-    (when msg
-      (try
-        (log/debugf "Handling event: %s" (pr-str msg))
-        ;; TODO: validate event
-        ;; TODO: validate handler return value
-        (handle-event* router-ctx msg)
-        (catch :default ex
-          (js/Raven.captureException ex)
-          (log/errorf ex "Error handling event: %s" (pr-str msg))))
-      (recur (<! ev-chan)))))
+  (let [start-ts (atom -1)
+        last-render-ts (atom 0)
+        render-chan (chan (sliding-buffer 1))]
+    (go-loop [msg (<! ev-chan)]
+      (when (< @start-ts @last-render-ts)
+        (let [current-ts (.getTime (js/Date.))]
+          (log/tracef "Setting start-ts to %d" current-ts)
+          (reset! start-ts current-ts)))
+      (r/next-tick #(let [current-ts (.getTime (js/Date.))]
+                      (log/trace "Rendering...")
+                      (put! render-chan :rendered)
+                      (when (> current-ts @last-render-ts)
+                        (log/tracef "Setting last-render-ts to %d" current-ts)
+                        (reset! last-render-ts current-ts))))
+      (when msg
+        (try
+          (log/debugf "Handling event: %s" (pr-str msg))
+          ;; TODO: validate event
+          ;; TODO: validate handler return value
+          (handle-event* router-ctx msg)
+          (catch :default ex
+            (js/Raven.captureException ex)
+            (log/errorf ex "Error handling event: %s" (pr-str msg))))
+        (when (< @last-render-ts @start-ts)
+          (let [ts-diff (- (.getTime (js/Date.)) @start-ts)]
+            (log/tracef "Milliseconds since render timer started: %d" ts-diff)
+            ;; TODO: make ts-diff threshold an argument to start
+            (when (> ts-diff 200)
+              (log/trace "Blocking till next render...")
+              (<! render-chan)
+              (log/trace "Render completed; unblocking"))))
+        (recur (<! ev-chan))))))


Add demarcate macro for automatic start/end msgs

We had several bits of code that would log "Starting foo", then do foo,
then log "Finished foo". That can be automated through a simple macro.

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

--- src/com/puppetlabs/utils.clj
+++ src/com/puppetlabs/utils.clj
@@ -353,6 +353,22 @@
     (log/debug "Debug logging enabled"))
   config)

+(defmacro demarcate
+  "Executes `body`, but logs `msg` to info before and after `body` is
+  executed. `body` is executed in an implicit do, and the last
+  expression's return value is returned by `demarcate`.
+
+    user> (demarcate \"reticulating splines\" (+ 1 2 3))
+    \"Starting reticulating splines\"
+    \"Finished reticulating splines\"
+    6
+  "
+  [msg & body]
+  `(do (log/info (str "Starting " ~msg))
+       (let [result# (do ~@body)]
+         (log/info (str "Finished " ~msg))
+         result#)))
+
 ;; ## Command-line parsing

 (defn cli!


Log message.

Log message.

--- src/onyx/messaging/aeron_media_driver.clj
+++ src/onyx/messaging/aeron_media_driver.clj
@@ -10,6 +10,6 @@
               ;(.threadingMode ThreadingMode/DEDICATED)
               (.dirsDeleteOnExit true))
         media-driver (MediaDriver/launch ctx)]
-    media-driver)
-  (<!! (chan)))
+    (println "Launched the Media Driver. Blocking forever...")
+    (<!! (chan))))