Clean up streams documentation.

Clean up streams documentation.

--- src/reimann/streams.clj
+++ src/reimann/streams.clj
@@ -6,8 +6,8 @@
   (:use [clojure.contrib.math])
   (:use [clojure.contrib.logging]))

-; Call each fn, in order, with event. Rescues and logs any failure.
 (defmacro call-rescue [event children]
+  "Call each child, in order, with event. Rescues and logs any failure."
   `(do
      (doseq [child# ~children]
        (try
@@ -73,12 +73,11 @@
             t (or (event :time) (unix-time))]
         (bin event t)))))

-; Partitions events by time (fast variant). Over interval seconds, adds events
-; to a bin, created with (create). When the interval is complete, calls (finish
-; bin start-time end-time)
-;
 ; This leaks a thread. Need to think about dynamic scheduling/expiry.
 (defn part-time-fast [interval create add finish]
+ "Partitions events by time (fast variant). Over interval seconds, adds events
+  to a bin, created with (create). When the interval is complete, calls (finish
+  bin start-time end-time)"
   (let [current (ref (create))
         start (ref (unix-time))
         switcher (.start (new Thread (bound-fn []
@@ -100,9 +99,9 @@
       (dosync
         (add (deref current) event)))))

-; Take the sum of every event over interval seconds and divide by the interval
-; size.
 (defn rate [interval & children]
+  "Take the sum of every event over interval seconds and divide by the interval
+  size."
   (part-time-fast interval
       (fn [] {:count (ref 0)
               :state (ref {})})
@@ -132,18 +131,18 @@
                                   (sorted-sample (deref r) points))]
                     (doseq [event samples] (call-rescue event children))))))

-; Sums all metric_fs together. Emits the most recent event each time this stream
-; is called, but with summed metric_f.
 (defn sum [& children]
+  "Sums all metric_fs together. Emits the most recent event each time this
+  stream is called, but with summed metric_f."
   (let [sum (ref 0)]
     (fn [event]
       (let [s (dosync (commute sum + (:metric_f event)))
             event (assoc event :metric_f s)]
         (call-rescue event children)))))

-; Emits the most recent event each time this stream is called, but with the
-; average of all received metric_fs.
 (defn mean [children]
+  "Emits the most recent event each time this stream is called, but with the
+  average of all received metric_fs."
   (let [sum (ref nil)
         total (ref 0)]
     (fn [event]
@@ -208,24 +207,24 @@
             (call-rescue events children)))))))

-; Conj events onto the given reference
 (defn append [reference]
+  "Conj events onto the given reference"
   (fn [event]
     (dosync
       (alter reference conj event))))

-; Set reference to the most recent event that passes through.
 (defn register [reference]
+  "Set reference to the most recent event that passes through."
   (fn [event]
     (dosync (ref-set reference event))))

-; Prints an event to stdout
 (defn stdout [event]
+  "Prints an event to stdout"
   (fn [event]
     (prn event)))

-; Sends a map to a client, coerced to state
 (defn fwd [client]
+  "Sends a map to a client, coerced to state"
   (fn [statelike]
     (reimann.client/send-state client statelike)))

@@ -251,9 +250,9 @@
   "Passes on events with state expired"
   (apply match :state "expired" children))

-; Transforms an event by associng a set of new k:v pairs
 (defmulti with (fn [& args] (map? (first args))))
 (defmethod with true [m & children]
+  "Transforms an event by associng a set of new k:v pairs"
   (fn [event]
 ;    Merge on protobufs is broken; nil values aren't applied.
 ;    (let [e (merge event m)]
@@ -267,11 +266,11 @@
     (let [e (if (nil? v) (dissoc event k) (assoc event k v))]
       (call-rescue e children))))

-; Splits stream by field.
-; Every time an event arrives with a new value of field, this macro invokes
-; its enclosed form to return a *new*, distinct stream for that particular
-; value.
 (defmacro by [field & children]
+  "Splits stream by field.
+  Every time an event arrives with a new value of field, this macro invokes
+  its enclosed form to return a *new*, distinct stream for that particular
+  value."
   ; new-fork is a function which gives us a new copy of our children.
   ; table is a reference which maps (field event) to a fork (or list of
   ; children).
@@ -315,9 +314,9 @@
               true)))
         (call-rescue event children)))))

-; Passes on events only when their metric falls within the given inclusive
-; range. (within [0 1] (fn [event] do-something))
 (defn within [r & children]
+  "Passes on events only when their metric falls within the given inclusive
+  range. (within [0 1] (fn [event] do-something))"
   (fn [event]
     (when (<= (first r) (:metric_f event) (last r))
       (call-rescue event children))))


Fix raft rendering

Fix raft rendering

--- src/robinson/render.clj
+++ src/robinson/render.clj
@@ -768,8 +768,8 @@
                                     (let [[chr fg bg] out-char]
                                       (info "raft-cell" out-char cell-items)
                                       (if (> (count cell-items) 1)
-                                        [chr fg :brown]
-                                        ["\u2225" :black :brown]))
+                                        [chr fg (color->rgb :brown)]
+                                        ["\u2225" (color->rgb :black) (color->rgb :brown)]))
                                   :else
                                     out-char)
                 shaded-out-char (if (= (get cell :discovered) current-time)


finished reading ch 12

finished reading ch 12

--- src/joy/ch12.clj
+++ src/joy/ch12.clj
@@ -260,3 +260,93 @@
 points
 (.setLocation y 0 0)
 points
+
+;; 12.6 definterface
+
+(definterface ISliceable
+  (slice [^long s ^long e])
+  (^long sliceCount []))
+
+(def dumb
+  (reify joy.ch12.ISliceable
+    (slice [_ s e] [:empty])
+    (sliceCount [_] 42)))
+
+(.slice dumb 1 2)
+(.sliceCount dumb)
+
+(defprotocol Sliceable
+  (slice [this s e])
+  (sliceCount [this]))
+
+(extend joy.ch12.ISliceable
+  Sliceable
+  {:slice (fn [this s e] (.slice this s e))
+   :sliceCount (fn [this] (.sliceCount this))})
+(sliceCount dumb)
+
+(defn calc-slice-count [thing]
+  (let [! #(reduce * (take % (iterate inc 1)))
+        n (count thing)]
+    (/ (! (- (+ n 2) 1))
+       (* (! 2) (! (- n 1))))))
+
+(extend-type String
+  Sliceable
+  (slice [this s e] (.substring this s (inc e)))
+  (sliceCount [this] (calc-slice-count this)))
+
+(slice "abc" 0 1)
+(sliceCount "abc")
+
+;; 12.7 Beware the exceptions
+(comment
+  (defn explode [] (explode))
+  (try (explode) (catch Exception e "stack is blown"))
+  (try (explode (catch StackOverflowError e "stack is blown")))
+  (try (throw (RuntimeException.))
+       (catch Throwable e "Catching throwable is bad"))
+
+  (defmacro do-something [x] `(~x))
+  (do-something 1)
+
+  (defmacro pairs [& args]
+    (if (even? (count args))
+      `(partition 2 '~args)
+      (throw (Exception.
+              (str "Pairs requires and even number of args")))))
+
+  (pairs 1 2 3)
+  (pairs 1 2 3 4)
+
+  (fn [] (pairs 1 2 3)))
+
+(defmacro -?> [& forms]
+  `(try (-> ~@forms)
+        (catch NullPointerException _# nil)))
+(-> 25 Math/sqrt (+ 100))
+
+(-?> 25 Math/sqrt (and nil) (+ 100))
+#_(-> 25 Math/sqrt (and nil) (+ 100))
+
+
+(defn perform-unclean-act [x y]
+  (/ x y))
+
+(try (perform-unclean-act 42 0)
+     (catch RuntimeException ex
+       (println (str "something went wrong"))))
+
+(defn perform-cleaner-act [x y]
+  (try
+    (/ x y)
+    (catch ArithmeticException ex
+      (throw (ex-info "You attempted an unclean act"
+                     {:args [x y]})))))
+
+(try
+  (perform-cleaner-act 108 0)
+  (catch RuntimeException ex
+    (println (str "received error: " (.getMessage ex)))
+    (when-let [ctx (ex-data ex)]
+      (println (str "more information:" ctx)))))


more tweaks for mobile support.

more tweaks for mobile support.

--- src/play_clj/core_listeners.clj
+++ src/play_clj/core_listeners.clj
@@ -4,7 +4,7 @@

 (defn ^:private input-processor
   [{:keys [on-key-down on-key-typed on-key-up on-mouse-moved
-           on-scrolled on-touch-down on-touch-dragged on-touch-up]}
+           on-scrolled on-touch-down on-touch-dragged on-touch-up] :as screen}
    execute-fn!]
   (reify InputProcessor
     (keyDown [this k]
@@ -41,7 +41,7 @@
      (u/call! object# ~k ~@options)))

 (defn ^:private gesture-listener
-  [{:keys [on-fling on-long-press on-pan on-pan-stop on-pinch on-tap on-zoom]}
+  [{:keys [on-fling on-long-press on-pan on-pan-stop on-pinch on-tap on-zoom pinch-stop]}
    execute-fn!]
   (reify GestureDetector$GestureListener
     (fling [this vx vy b]
@@ -52,23 +52,27 @@
       (some? on-long-press))
     (pan [this x y dx dy]
       (execute-fn! on-pan {:input-x x :input-y y :delta-x dx :delta-y dy})
-      (some? on-pan))
+      false)
     (panStop [this x y p b]
       (execute-fn! on-pan-stop {:input-x x :input-y y :pointer p :button b})
-      (some? on-pan-stop))
+      false)
+    (pinchStop [this]
+      (execute-fn! pinch-stop
+                   {})
+      false)
     (pinch [this ip1 ip2 p1 p2]
       (execute-fn! on-pinch
                    {:initial-pointer-1 ip1 :initial-pointer-2 ip2
                     :pointer-1 p1 :pointer-2 p2})
-      (some? on-pinch))
+      false)
     (tap [this x y c b]
       (execute-fn! on-tap {:input-x x :input-y y :count c :button b})
-      (some? on-tap))
+      false)
     (touchDown [this x y p b]
       false)
     (zoom [this id d]
       (execute-fn! on-zoom {:initial-distance id :distance d})
-      (some? on-zoom))))
+      false)))

 (defn ^:private gesture-detector
   [options execute-fn!]


fixup for other darwin handlers (likely not used; still not working)

--- src/polismath/darwin/server.clj
+++ src/polismath/darwin/server.clj
@@ -181,6 +181,21 @@
   ([darwin filename]
    (let [expiration (-> darwin :config :export :expiry-days)]
      (generate-aws-url! darwin filename expiration))))
+
+
+;; The filename is actually pretty iportant.
+;; It should be unique between different exports, as is used as the identifying key for the aws buckets, postgres
+;; tracking and as part of the API requests.
+
+(defn generate-filename
+  "Generates a filename based on request-params"
+  [{:as request-params :keys [zinvite at-date format]}]
+  {:pre [zinvite format]}
+  (log/debug "generating filename for request-params:" request-params)
+  (let [last-updated (or at-date (System/currentTimeMillis))
+        ext (case format :excel "xlsx" :csv "zip")
+        filename (str "polis-export-" zinvite "-" last-updated "." ext)]
+    filename))

 ;; What follows is the guts of our responding and computing.
@@ -223,10 +238,69 @@

 ;; General helpers..

+
+;; The following is really just a bunch of parameter parsing stuff.
+;; Tihs could all possibly be interwoven with the config component as well.
+
+(defn- ->long
+  "Try to parse as an integer as long; return nil if not possible."
+  [x]
+  (try (Long/parseLong x)
+       (catch Exception e nil)))
+
+(defn- between? [a b x]
+  (and x (< a x) (> b x)))
+
+(defn- parse-and-validate-timeout
+  [x]
+  (let [x (try (Long/parseLong x)
+               (catch Exception e (throw (Exception. "Invalid timeout value"))))]
+    (assert (and x (< 0 x) (>= 29000 x)) "Invalid timout value")
+    x))
+
+(def parsers {:at-date ->long
+              :format  keyword
+              :timeout parse-and-validate-timeout})
+
 (def respond-404
   {:status 404
    :headers {"Content-Type" "text/plain"}
    :body "Unknown, incomplete or expired conversation export"})
+
+
+(def allowed-params #{:zinvite :filename :at-date :format :email :timeout})
+
+;; And finally, our param parser.
+
+(defn params-with-zid
+  [darwin params]
+  (assoc params
+    :zid (or (:zid params)
+             (db/get-zid-from-zinvite (:postgres darwin) (:zinvite params)))))
+
+(defn params-with-filename
+  [params]
+  (assoc params
+    :filename
+    (or (:filename params)
+        (generate-filename params))))
+
+(defn parsed-params
+  "Parses the params for a request, occording to parsers."
+  [darwin params]
+  ;(log/info "Here are the params:" params)
+  (->>
+    params
+    (reduce
+      (fn [m [k v]]
+        ;; Don't really need this if we have params instead of query params, but whateves
+        (let [k (keyword k)]
+          (if (get allowed-params k)
+            (assoc m k ((or (parsers k) identity) v))
+            m)))
+      {})
+    (params-with-zid darwin)
+    (params-with-filename)))

 ;; Requests for exported files in aws.
@@ -240,9 +314,9 @@

 (defn filename-request-handler
   "Given aws-creds, returns a function handler function which responds to requests for an existing file on AWS."
-  [{:as darwin :keys [params postgres]} request]
-  (let [{:keys [filename zinvite]} params
-        zid (db/get-zid-from-zinvite postgres zinvite)]
+  [{:as darwin :keys [postgres]}
+   {:as request :keys [params]}]
+  (let [{:as params :keys [filename]} (parsed-params darwin params)]
     (if (= (get (get-export-status darwin params) "status") "complete")
       ;; Have to think about the security repercussions here. Would be nice if we could stream this and never
       ;; expose the link here. XXX
@@ -253,13 +327,13 @@
 ;; Couple helpful things for below

 (defn get-status-location-url
-  [darwin filename zinvite]
-  (private-url darwin (str "datadump/status?filename=" filename "&conversation_id=" zinvite)))
+  [darwin {:as params :keys [filename zinvite]}]
+  (private-url darwin (str "datadump/status?filename=" filename "&zinvite=" zinvite)))

 (defn check-back-response
   ([darwin params status]
    (let [{:keys [filename zinvite]} params
-         status-url (get-status-location-url darwin filename zinvite)]
+         status-url (get-status-location-url darwin params)]
      {:status  status
       :headers {"Content-Type" "text/plain"
                 "Location" status-url}
@@ -279,9 +353,9 @@
      :body    (str "Export is complete. Download at the Location url specified in the header (" url ")")}))

 (defn get-datadump-status-handler
-  [{:as darwin :keys [params postgres]} request]
-  (let [{:keys [filename zinvite]} params
-        zid (db/get-zid-from-zinvite postgres zinvite)]
+  [{:as darwin :keys [postgres]}
+   {:as request :keys [params]}]
+  (let [params (parsed-params darwin params)]
     (case (-> (get-export-status darwin params) (get "status"))
       ("pending" "started" "processing") (check-back-response darwin params 200)
       "complete"                         (complete-response darwin params)
@@ -294,7 +368,7 @@

 (defn run-datadump
   "Based on params this actually runs the export-conversation computation."
-  [darwin filename params]
+  [darwin {:as params :keys [filename]}]
   (log/info "Params for run-datadump are:" (with-out-str (prn params)))
   (try
     (let [;; The dissoc is just a vague security measure
@@ -312,76 +386,6 @@

-;; The filename is actually pretty iportant.
-;; It should be unique between different exports, as is used as the identifying key for the aws buckets, postgres
-;; tracking and as part of the API requests.
-
-(defn generate-filename
-  "Generates a filename based on request-params"
-  [{:as request-params :keys [zinvite at-date format]}]
-  {:pre [zinvite format]}
-  (log/debug "generating filename for request-params:" request-params)
-  (let [last-updated (or at-date (System/currentTimeMillis))
-        ext (case format :excel "xlsx" :csv "zip")
-        filename (str "polis-export-" zinvite "-" last-updated "." ext)]
-    filename))
-
-
-
-;; The following is really just a bunch of parameter parsing stuff.
-;; Tihs could all possibly be interwoven with the config component as well.
-
-(defn- ->long
-  "Try to parse as an integer as long; return nil if not possible."
-  [x]
-  (try (Long/parseLong x)
-       (catch Exception e nil)))
-
-(defn- between? [a b x]
-  (and x (< a x) (> b x)))
-
-(defn- parse-and-validate-timeout
-  [x]
-  (let [x (try (Long/parseLong x)
-               (catch Exception e (throw (Exception. "Invalid timeout value"))))]
-    (assert (and x (< 0 x) (>= 29000 x)) "Invalid timout value")
-    x))
-
-(def parsers {:at-date ->long
-              :format  keyword
-              :timeout parse-and-validate-timeout})
-
-
-(def base-params #{:zinvite})
-(def datadump-params (set/union base-params #{:filename :at-date :format :email :timeout}))
-
-
-;; And finally, our param parser.
-
-(defn parsed-params
-  "Parses the params for a request, occording to parsers."
-  [allowed-params params]
-  ;(log/info "Here are the params:" params)
-  (reduce
-    (fn [m [k v]]
-      ;; Don't really need this if we have params instead of query params, but whateves
-      (let [k (keyword k)]
-        (if (allowed-params k)
-          (assoc m k ((or (parsers k) identity) v))
-          m)))
-    {}
-    params))
-
-
-(defn params-with-zid
-  [darwin parsed-params]
-  (assoc parsed-params
-    :zid (or (:zid parsed-params)
-             (db/get-zid-from-zinvite (:postgres darwin) (:zinvite parsed-params)))))
-
-(defn params-with-filename
-  [parsed-params]
-  (assoc parsed-params :filename (generate-filename parsed-params)))

 (defn get-datadump-handler
   "Main handler function; Attempts to return a datadump file within within a set amount of time, and if it can't, will
@@ -389,14 +393,11 @@
   [{:as darwin :keys [postgres]}
    {:as request :keys [params]}]
   {:pre [(:zinvite params)]}
-  (let [params (->> params
-                    (parsed-params datadump-params)
-                    (params-with-zid darwin)
-                    (params-with-filename))
-        {:keys [zinvite zid filename]} params
+  (let [{:as params :keys [filename]}
+        (parsed-params darwin params)
         ;; Check validity of params here
         _ (log/info "Handling datadump request with params:" (with-out-str (prn params)))
-        datadump (async/thread (run-datadump darwin filename params))
+        datadump (async/thread (run-datadump darwin params))
         timeout (async/timeout (or (:timeout parsed-params) 29000))
         [done? _] (async/alts!! [datadump timeout])]
     (cond
@@ -470,8 +471,8 @@
   ["/" {"ping"      ping-handler
         "datadump/" {"ping"    ping-handler
                      "get"     #(get-datadump-handler darwin %)
-                     "status"  (partial get-datadump-status-handler darwin)
-                     "results" (partial filename-request-handler darwin)}}])
+                     "status"  #(get-datadump-status-handler darwin %)
+                     "results" #(filename-request-handler darwin %)}}])

 (defn make-handler [darwin]
   (bidi.ring/make-handler (routes darwin)))
@@ -521,6 +522,7 @@
           (-> (make-handler component)
               ring.keyword-params/wrap-keyword-params
               ring.params/wrap-params
+              ;; Should really be doing the additional params processing here, but it might change request by request, so need to think at least a bit about this
               (auth/wrap-basic-authentication (partial authenticated? component))
               log-requests)]
       ;redirect-http-to-https-if-required


Increasing socket timeouts in tests

Increasing socket timeouts in tests

--- test/ctia/test_helpers/core.clj
+++ test/ctia/test_helpers/core.clj
@@ -131,7 +131,9 @@
 (defn get [path & {:as options}]
   (let [options
         (merge {:accept :edn
-                :throw-exceptions false}
+                :throw-exceptions false
+                :socket-timeout 10000
+                :conn-timeout 10000}
                options)

         response
@@ -145,8 +147,8 @@
         (merge {:content-type :edn
                 :accept :edn
                 :throw-exceptions false
-                :socket-timeout 2000
-                :conn-timeout 2000}
+                :socket-timeout 10000
+                :conn-timeout 10000}
                options)

         response
@@ -166,8 +168,8 @@
         (merge {:content-type :edn
                 :accept :edn
                 :throw-exceptions false
-                :socket-timeout 2000
-                :conn-timeout 2000}
+                :socket-timeout 10000
+                :conn-timeout 10000}
                options)

         response


Add newline between arglists in api docs

--- docs/src/ns_to_markdown.clj
+++ docs/src/ns_to_markdown.clj
@@ -79,7 +79,7 @@
   [name-without-ns arglists]
   (reduce
     (fn [markdown arglist]
-      (str markdown "\n" (format "`#!clj (%s%s)`" name-without-ns (arglist->markdown arglist))))
+      (str markdown "\n" (format "`#!clj (%s%s)`\n" name-without-ns (arglist->markdown arglist))))
     ""
     arglists))


Four tests added into exporter_test.clj

Four tests added into exporter_test.clj

--- test/hurvinek/exporter_test.clj
+++ test/hurvinek/exporter_test.clj
@@ -117,3 +117,26 @@
         (is (callable? 'hurvinek.exporter/components->csv))))

+(deftest test-product-output-data-existence
+    "Check that the hurvinek.exporter/product-output-data definition exists."
+    (testing "if the hurvinek.exporter/product-output-data definition exists."
+        (is (callable? 'hurvinek.exporter/product-output-data))))
+
+
+(deftest test-chapters-output-data-existence
+    "Check that the hurvinek.exporter/chapters-output-data definition exists."
+    (testing "if the hurvinek.exporter/chapters-output-data definition exists."
+        (is (callable? 'hurvinek.exporter/chapters-output-data))))
+
+
+(deftest test-groups-output-data-existence
+    "Check that the hurvinek.exporter/groups-output-data definition exists."
+    (testing "if the hurvinek.exporter/groups-output-data definition exists."
+        (is (callable? 'hurvinek.exporter/groups-output-data))))
+
+
+(deftest test-components-output-data-existence
+    "Check that the hurvinek.exporter/components-output-data definition exists."
+    (testing "if the hurvinek.exporter/components-output-data definition exists."
+        (is (callable? 'hurvinek.exporter/components-output-data))))
+


home page search results is now a state, can back to it

* but back buttoning betweening queries doesn't work, try popstate
* previous attempt wasn't working b/c cljs borked on mls-search
  being 2/3 arity

--- src/semtag_web/client/main.cljs
+++ src/semtag_web/client/main.cljs
@@ -48,12 +48,13 @@
                             :row-partial view/tag-search-row
                             :caption (str "Total: " (count data)))))

-(defn mls-search [search-box text-field]
+(defn mls-search
+  [search-box text-field & [callback]]
   (let [query (jq/val text-field)]
     (-> (jq/find search-box :h2)
       (inner (str "Search results for '" query "'")))
     (backend-request (str "/mls?query=" query) (partial create-search-table search-box))
-    (.pushState window.history "" "" (str "/?query=" query))))
+    (when callback (callback query))))

 ;;; on-load js fns for specific pages
 (defn ^:export tag-show []
@@ -72,19 +73,20 @@
 (defn ^:export home []
   (let [$button ($ :#url_search_button)
         $text-field ($ :#url_search_text)
-        mls-search-box (partial mls-search ($ :#search_box) $text-field)
+        search-and-update-page (partial mls-search ($ :#search_box) $text-field)
+        search-and-update-page-and-url (partial search-and-update-page
+                                                #(.pushState window.history "" "" (str "/?query=" %)))
         query-param (re-find #"[\?&]?query=([^&]+)" (.-search window.location))]

-    (bind $button "click" mls-search-box)
+    (bind $button "click" search-and-update-page-and-url)
     (backend-request "/tags"
       #(jq/after $text-field (view/generate-datalist %))
       console-error)
-    (bind $text-field :keypress (return-key-pressed mls-search-box))
+    (bind $text-field :keypress (return-key-pressed search-and-update-page-and-url))

     (when-let [query (when (seq query-param) (second query-param))]
       (jq/val $text-field query)
-      (mls-search-box)
-      (.log js/console query))))
+      (search-and-update-page))))

 (defn ^:export model-show []
   (let [model (match-from-current-uri #"[^\/]+$")]


Fix test - topic is not part of events any more, as WAMP has it.

--- test/pubsure_ws/reader_test.clj
+++ test/pubsure_ws/reader_test.clj
@@ -23,10 +23,10 @@

     ;; Test automatic subscribe and events.
     (api/add-source dir "test-topic" (URI. "ws://source-1"))
-    (is (= {"event" "joined", "topic" "test-topic", "uri" "ws://source-1"}
+    (is (= {"event" "joined", "uri" "ws://source-1"}
            (-> (async/alts!! [recv (async/timeout 500)]) first json/parse-string (nth 2))))
     (api/remove-source dir "test-topic" (URI. "ws://source-1"))
-    (is (= {"event" "left", "topic" "test-topic", "uri" "ws://source-1"}
+    (is (= {"event" "left", "uri" "ws://source-1"}
            (-> (async/alts!! [recv (async/timeout 500)]) first json/parse-string (nth 2))))

     ;; Test unsubscribe.
@@ -39,7 +39,7 @@
     (ws/send-msg ws (json/generate-string [5 "test-topic"]))
     (Thread/sleep 500) ; give the server the chance to sub
     (api/remove-source dir "test-topic" (URI. "ws://source-1"))
-    (is (= {"event" "left", "topic" "test-topic", "uri" "ws://source-1"}
+    (is (= {"event" "left", "uri" "ws://source-1"}
            (-> (async/alts!! [recv (async/timeout 500)]) first json/parse-string (nth 2))))

     ;; Done


stylo

stylo

--- src/site/navigation.clj
+++ src/site/navigation.clj
@@ -61,7 +61,8 @@
      [:.footer-line {:background "rgba(46,48,58,1)"}
       (s/&text :center)
       (s/&margin 2 0 0 0)
-      (s/&padding 1 0)]])
+      (s/&padding 1 0)]
+     [:li (s/&margin 0.5 0)]])
    [:div.container
     (grid
      [(footer-title "products" :products)


Remove phone asking message

Remove phone asking message

--- src/status_im/chat/sign_up.cljs
+++ src/status_im/chat/sign_up.cljs
@@ -64,7 +64,8 @@
     :to           "me"}])

 (def start-signup-events
-  [[:received-message
+  ;; TODO(janherich): show this message again once `/phone` command is working properly again
+  [#_[:received-message
     {:message-id   (random/id)
      :content      (command-content
                     :phone


bugfix

bugfix

--- src/stash_bot/core.cljs
+++ src/stash_bot/core.cljs
@@ -63,8 +63,8 @@

 (defn- init-hardware [next-fn]
   (let [five (js/require "johnny-five")
-        raspi-io (js/require "raspi-io")
-        board (js/five.Board. (js-obj "io" raspi-io))]
+        Raspi (js/require "raspi-io")
+        board (js/five.Board. (js-obj "io" Raspi))]
     (.on board "ready"
       (fn []
         (set! led (js/five.Led. "GPIO16"))


added  documentation

added  documentation

--- src/such/better_doc.clj
+++ src/such/better_doc.clj
@@ -8,14 +8,14 @@

 ;; Interning copies in this namespace allows codox to find them.
-(defmacro ^:private local-copy [var doc-string]
+(defmacro ^:private update-and-make-local-copy! [var doc-string]
   `(let [var-name# (:name (meta ~var))]
      (alter-meta! ~var assoc :doc ~doc-string)
      (ns-unmap *ns* var-name#)
      (intern *ns* (with-meta var-name#
                     (assoc (meta ~var) :doc ~doc-string)) (vars/root-value ~var))))

-(local-copy #'clojure.core/ns-name
+(update-and-make-local-copy! #'clojure.core/ns-name
   "`ns` *must* be either a namespace or a symbol naming a namespace.
    If the namespace exists, its symbol-name is returned. If not, an exception is thrown.
    Note: the more common `name` function cannot be applied to namespaces.
@@ -24,14 +24,14 @@
        (ns-name *ns*) => 'such.better-doc
 ")

-(local-copy #'clojure.core/find-ns
+(update-and-make-local-copy! #'clojure.core/find-ns
   "`sym` *must* be a symbol. If it names an existing namespace, that namespace is returned.
    Otherwise, `nil` is returned. [Other examples](https://clojuredocs.org/clojure.core/find-ns)

        (find-ns 'clojure.core) => #<Namespace clojure.core>
 ")

-(local-copy #'clojure.core/ns-resolve
+(update-and-make-local-copy! #'clojure.core/ns-resolve
   "`ns-resolve` goes from a symbol to the var or class it represents. [Other examples](https://clojuredocs.org/clojure.core/ns-resolve)

@@ -97,7 +97,7 @@
 ")

-(local-copy #'clojure.core/symbol
+(update-and-make-local-copy! #'clojure.core/symbol
   "Creates a symbol from its arguments, which *must* be strings.
    The name of that result is `name`. In the one-argument version,
    the result's namespace is `nil`. In the two-argument version, it's
@@ -106,45 +106,32 @@
          (symbol \"no.such.namespace\" \"the\") => 'no.such.namespace/the
 ")

-(local-copy #'clojure.core/butlast
+(update-and-make-local-copy! #'clojure.core/butlast
   "Return a seq of all but the last item in coll, in linear time.
    If you are working on a vector and want the result to be a vector, use `pop`.")

-(local-copy #'clojure.core/every-pred
-   "Take N predicates and produce a single predicate - call it `result`. `result`
-    will return `true` iff each of the original predicates returns a truthy
-    value. The predicates are evaluated in order, and the first one that produces
-    a falsey value stops any further checking.
+(update-and-make-local-copy! #'clojure.core/every-pred
+   "Take N functions and produce a single predicate - call it `result`. `result`
+    will return `true` iff each of the original functions returns a truthy
+    value. `result` evaluates the functions in order, and the first one that produces
+    a falsey value stops any further checking. In that case, `false` is returned.

-    See also `some-fn`.
+    See also [[some-fn]].

          ( (every-pred integer? even? pos?) \"hi\") => false
          ( (every-pred integer? even? pos?) 4) => true
 ")

-(local-copy #'clojure.core/every-pred
-   "Take N functions and produce a single predicate - call it `result`. `result`
-    will return `true` iff each of the original functions returns a truthy
-    value. `result` evaluates the functions in order, and the first one that produces
-    a falsey value stops any further checking. In that case, `false` is returned.
-
-    See also `some-fn`.
-
-         ( (every-pred integer? even? pos?) \"hi\") => false
-         ( (every-pred integer? even? pos?) 4) => true
-")
-
-
-(local-copy #'clojure.core/some-fn
+(update-and-make-local-copy! #'clojure.core/some-fn
    "Take N functions and produce a single function - call it `result`. `result`
     evaluates the N functions in order. When one returns a truthy result, `result`
     skips the remaining functions and returns that result. If none of the functions
     returns a truthy value, `result` returns a falsey value.

     This function is called `some-fn` because it does not produce a pure (true/false)
-    result. See also `every-pred`.
+    result. See also [[every-pred]].

          ( (some-fn even? pos?) 3) => true
          ( (some-fn even? pos?) -3) => false
@@ -155,3 +142,37 @@
 ")

+(update-and-make-local-copy! #'clojure.core/some
+   "Apply `pred` to each element in `coll` until it returns a truthy value,
+    then return that value (*not* the element). This can be used to ask
+    the question \"is there an even value in the collection?\":
+
+        (some even? [1 2 3 4]) => true
+
+    However, as signaled by the lack of a '?' in `some`, its value is not
+    necessarily a boolean. Here is how you would ask \"is there a value
+    greater than zero and, if so, what is the first of them?\":
+
+        (some #(and (pos? %) %) [-1 -3 2 4]) => 2
+
+    `some` is often used to ask the question \"is X in the collection?\".
+    That takes advantage of how sets can be treated as a \"contains value?\"
+    function:
+
+        (#{1 2 3} 2) => 2
+        (#{1 2 3} -88) => nil
+
+    So:
+
+        (some #{2} [1 2 3]) => 2
+        (some #{2} [-1 -2 -3]) => nil
+
+    You may find [[any?]] (in `such.shorthand`) easier to remember.
+
+    It's easy to forget that `some` returns the *value of the predicate*,
+    not the element itself. To be sure you get the element, do this:
+
+        (first (filter pred coll))
+
+    That's [[find-first]] in shorthand.
+")


Housekeeping

Housekeeping

--- src/taoensso/carmine/tundra.clj
+++ src/taoensso/carmine/tundra.clj
@@ -16,6 +16,7 @@
   (:import  [java.net URLDecoder URLEncoder]))

 ;;;; TODO v2/refactor
+;; - Why is evictable set key not configurable?
 ;; - General refactor (reduce-based flow, refactor stores, etc.)
 ;; - Drop mq for a simpler zset {<k> <udt-last-dirty>} based model:
 ;;   atomic-pull ks on verified write when udt unchanged against write val


more progress on data browser

more progress on data browser

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -66,6 +66,11 @@
   (when-let [col-vector (.. table getColumnModel getColumns)]
     (enumeration-seq col-vector)))

+(defn remove-all-columns [table]
+  (let [column-model (. table getColumnModel)]
+    (dorun (->> table get-table-columns reverse
+                      (map #(.removeColumn column-model %))))))
+
 (defn set-filter [table text]
   (let [sorter (.getRowSorter table)
         column-indices
@@ -182,7 +187,6 @@
       (.concat "}}") (read-json false) (get "Summary")))

 (defn get-summary-map [data-set location]
-  (println "get-summary-map" data-set location)
   (merge (read-summary-map data-set)
     (if-let [frames (count-frames data-set)]
       {"Frames" frames})
@@ -274,7 +278,7 @@
       (.. getColumnModel (getColumn 0) (setMaxWidth 20)))
     table))

-(defn update-collection-menu [name ]
+(defn update-collection-menu [name]
   (let [menu (@browser :collection-menu)
         names (sort (keys @collections))
         listeners (.getItemListeners menu)]
@@ -288,10 +292,10 @@
 ;; collection files

-(defn save-last-collection [name]
+(defn set-last-collection-name [name]
   (write-value-to-prefs prefs "last-collection" name))

-(defn load-last-collection []
+(defn get-last-collection-name []
   (or (read-value-from-prefs prefs "last-collection")
     (System/getProperty "user.name")))

@@ -303,6 +307,33 @@

 (defn save-collection-map []
   (write-value-to-prefs prefs "collection-files" @collections))
+
+;; "data and settings"
+
+(defn save-data-and-settings [collection-name settings]
+  (with-open [pr (PrintWriter. (get @collections collection-name))]
+    (write-json settings pr)))
+
+(defn load-data-and-settings [name]
+  (or
+    (when-let [f (get @collections name)]
+      (when (.exists (File. f))
+        (read-json (slurp f))))
+    (fresh-data-and-settings)))
+
+(defn fresh-data-and-settings []
+  {:browser-model-data nil
+   :browser-model-headings tags
+   :window-size nil
+   :display-columns
+     [{:width 0.3 :title "Path"}
+      {:width 0.3 :title "Time"}
+      {:width 0.1 :title "Frames"}
+      {:width 0.3 :title "Comment"}]
+   :locations nil
+   :sorted-column {:order 1 :model-column "Time"}})
+
+;; data and settings <--> gui

 (defn get-current-data-and-settings []
   (let [table (@browser :table)
@@ -312,9 +343,10 @@
      :window-size (let [f (@browser :frame)] [(.getWidth f) (.getHeight f)])
      :display-columns
        (let [total-width (float (.getWidth table))]
-         (map #(hash-map :width (/ (.getWidth %) total-width)
-                                :title (.getIdentifier %))
-              (get-table-columns table)))
+         (when (pos? total-width)
+           (map #(hash-map :width (/ (.getWidth %) total-width)
+                                  :title (.getIdentifier %))
+                (get-table-columns table))))
      :locations
        (->> @settings-window :locations :table .getModel .getDataVector
             seq (map seq) flatten)
@@ -322,10 +354,12 @@
        (when-let [sort-key (->> table .getRowSorter .getSortKeys seq first)]
          {:order ({SortOrder/ASCENDING 1 SortOrder/DESCENDING -1}
                    (.getSortOrder sort-key))
-          :model-column (.getColumnName model (.getColumn sort-key))})
-     }))
-
-(defn apply-data-and-settings [settings]
+          :model-column (.getColumnName model (.getColumn sort-key))})}))
+
+
+(defn apply-data-and-settings [collection-name settings]
+  (update-collection-menu collection-name)
+  (set-last-collection-name collection-name)
   (awt-event
     (let [table (@browser :table)
           model (.getModel table)
@@ -335,48 +369,23 @@
                   locations sorted-column]} settings]
       (def dc display-columns)
       (reset! current-data browser-model-data)
-      (doto model (.fireTableDataChanged) (.fireTableStructureChanged))
-      (-> @settings-window :locations :table .getModel
+      (.fireTableDataChanged model)
+      (doto (-> @settings-window :locations :table .getModel)
         (.setDataVector
           (Vector. (map #(Vector. (list %)) (seq locations)))
-          (Vector. (list "Locations"))))
-      (let [column-model (.. table getColumnModel)]
-        (println (-> table get-table-columns count))
-        (dorun (map #(.removeColumn column-model %)
-             (-> table get-table-columns reverse))))
-      (println display-columns)
+          (Vector. (list "Locations")))
+        .fireTableDataChanged)
+      (remove-all-columns table)
       (let [total-width (.getWidth table)]
         (doseq [col display-columns]
-          (println col)
           (doto (add-browser-column (:title col))
-            (.setPreferredWidth (* total-width (:width col)))))))
+            (.setPreferredWidth (* total-width (:width col))))))
       (-> @settings-window :columns :table
-                           .getModel .fireTableDataChanged)))
-
-(defn save-data-and-settings [collection-name]
-  (with-open [pr (PrintWriter. (get @collections collection-name))]
-    (write-json (get-current-data-and-settings) pr))
-  (println "saved data and settings: " (:display-columns (get-current-data-and-settings))))
-
-(defn fresh-data-and-settings [collection-name]
-  (reset! current-data nil)
-  (save-collection-map)
-  (save-data-and-settings collection-name)
-  (map add-browser-column ["Path" "Time" "Frames" "Comment"])
-  (awt-event
-    (update-collection-menu collection-name)
-      (let [m (-> @browser :table .getModel)]
-        (.fireTableDataChanged m))))
-
-(defn load-data-and-settings [name]
-  (save-last-collection name)
-  (let [f (get @collections name)]
-    (if (.exists (File. f))
-      (apply-data-and-settings (read-json (slurp f))))
-      (fresh-data-and-settings name))
-  (update-collection-menu name))
-
-(defn user-creates-collection []
+                           .getModel .fireTableDataChanged))))
+
+;; creating a new collection
+
+(defn user-specifies-collection-name []
   (let [prompt-msg "Please enter a name for the new collection."]
     (loop [msg prompt-msg]
        (let [collection-name (JOptionPane/showInputDialog msg)]
@@ -389,11 +398,13 @@
                          prompt-msg))
            :else collection-name)))))

-(defn new-data-and-settings []
-  (let [collection-name (user-creates-collection)]
-    (swap! collections assoc collection-name
-      (.getAbsolutePath (File. (str collection-name ".mmdb.txt"))))
-      (fresh-data-and-settings collection-name)))
+(defn create-new-collection []
+  (let [collection-name (user-specifies-collection-name)]
+    (when collection-name
+      (swap! collections assoc collection-name
+        (.getAbsolutePath (File. (str collection-name ".mmdb.txt"))))
+        (save-collection-map)
+        (apply-data-and-settings collection-name (fresh-data-and-settings)))))

 (defn create-image-storage-listener []
   (reify ImageStorageListener
@@ -455,13 +466,12 @@
 (defn create-collection-menu-listener []
   (reify ItemListener
     (itemStateChanged [_ e]
-      (println e)
       (let [item (.getItem e)]
         (if (= (.getStateChange e) ItemEvent/SELECTED)
           (condp = item
-            "New..." (new-data-and-settings)
-            (load-data-and-settings item))
-          (save-data-and-settings item))))))
+            "New..." (create-new-collection)
+            (apply-data-and-settings item (load-data-and-settings item)))
+          (save-data-and-settings item (get-current-data-and-settings)))))))

 (defn create-browser []
   (let [frame (JFrame. "Micro-Manager Data Set Browser")
@@ -513,7 +523,8 @@
   (reset! browser (create-browser))
   (MMImageCache/addImageStorageListener (create-image-storage-listener))
   (.setModel (:table @browser) (create-browser-table-model tags))
-  (load-data-and-settings (load-last-collection))
+  (let [collection-name (get-last-collection-name)]
+    (apply-data-and-settings collection-name (load-data-and-settings collection-name)))
   (.show (@browser :frame))
   browser)


remove bug when no columns were present

remove bug when no columns were present

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


whitespace

whitespace

--- exercism/clojure/collatz-conjecture/src/collatz_conjecture.clj
+++ exercism/clojure/collatz-conjecture/src/collatz_conjecture.clj
@@ -5,5 +5,5 @@
       (loop [k n
              i 0]
         (if (= k 1) i
-          (recur (if (even? k) (quot k 2) (inc (* 3 k)))
-                 (inc i))))))
+            (recur (if (even? k) (quot k 2) (inc (* 3 k)))
+                   (inc i))))))


Remove

Remove

--- src/twentyfortyeight/logic.cljs
+++ src/twentyfortyeight/logic.cljs
@@ -121,10 +121,6 @@
   []
   (rand-nth d/tile-frequencies))

-(s/fdef maybe-insert-new-random-tile
-        :args (s/cat :last-board ::d/game-board :new-board ::d/game-board)
-        :ret ::d/game-board)
-
 (defn same-board?
   [b1 b2]
   (= (set b1) (set b2)))


bug fix

bug fix


Removed clojure directory

Removed clojure directory

--- clojure/project.clj
+++ clojure/project.clj
@@ -1,11 +0,0 @@
-(defproject repl_connect "0.1.0-SNAPSHOT"
-  :description "Embedded project for Debug REPL."
-  :url "http://example.com/FIXME"
-  :license {:name "Eclipse Public License"
-            :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :profiles {:dev {:dependencies [[debug-middleware "0.1.1-SNAPSHOT"]]
-                   :repl-options {:nrepl-middleware [debug-middleware.core/debug-middleware]}}}
-  :resource-paths []
-  :dependencies [[org.clojure/clojure "1.8.0"]
-                 [debug-middleware "0.1.1-SNAPSHOT"]
-                 [cdt "1.2.6.3"]])


Send width and height fields on image uploading repo method.

--- src/uxbox/main/repo/images.cljs
+++ src/uxbox/main/repo/images.cljs
@@ -45,9 +45,11 @@
     (send! params)))

 (defmethod request :create/image
-  [_ {:keys [coll id file] :as body}]
+  [_ {:keys [coll id file width height] :as body}]
   (let [body (doto (js/FormData.)
                (.append "file" file)
+               (.append "width" width)
+               (.append "height" height)
                (.append "id" id))
         params {:url (str url "/library/image-collections/" coll "/images")
                 :method :post


fix typo

fix typo

--- src/cljs/wombats_web_client/components/countdown_timer.cljs
+++ src/cljs/wombats_web_client/components/countdown_timer.cljs
@@ -89,7 +89,7 @@

       :reagent-render
       (fn []
-        ;; triggers a rerender for active timers, will not effect timers with no interval timer
+        ;; triggers a rerender for active timers, will not affect timers with no interval timer
         (:update-counter @cmpnt-state)

         [:span {:class-name "countdown-timer"}


force gopass link

force gopass link

--- main/src/dda/pallet/dda_managed_vm/infra/credential_management.clj
+++ main/src/dda/pallet/dda_managed_vm/infra/credential_management.clj
@@ -60,7 +60,7 @@
   (actions/packages :aptitude ["gopass"])
   (actions/exec-checked-script
    "link gopass -> pass"
-   ("ln" "-s" "/usr/local/bin/gopass" "/usr/local/bin/pass")))
+   ("ln" "-sf" "/usr/local/bin/gopass" "/usr/local/bin/pass")))

 (s/defn configure-user-gopass-config
   [user-name :- s/Str


add default-dataset to query-job; completed? is now successful?; added running?

--- bigquery/src/gclouj/bigquery.clj
+++ bigquery/src/gclouj/bigquery.clj
@@ -269,10 +269,11 @@
 (defn- coerce-result
   [schema]
   (let [coercions (map cell-coercions (map :type schema))
-        names     (map :names schema)]
+        names     (map :name schema)]
     (fn [row]
-      (for [[coerce value] (partition 2 (interleave coercions row))]
-        (coerce value)))))
+      (->> (for [[name coerce value] (partition 3 (interleave names coercions row))]
+             [name (coerce value)])
+           (into {})))))

 (defn query-results-seq
   "Takes a query result and coerces the results from being raw sequences
@@ -286,9 +287,12 @@
 (defn job [service {:keys [project-id job-id] :as job}]
   (to-clojure (.getJob service (JobId/of project-id job-id) (into-array BigQuery$JobOption []))))

-(defn completed? [job]
+(defn successful? [job]
   (and (= :done (get-in job [:status :state]))
        (empty? (get-in job [:status :errors]))))
+
+(defn running? [job]
+  (= :running (get-in job [:status :state])))

 (def create-dispositions {:needed JobInfo$CreateDisposition/CREATE_IF_NEEDED
                           :never  JobInfo$CreateDisposition/CREATE_NEVER})
@@ -317,11 +321,13 @@
     (UserDefinedFunction/inline udf)))

 (defn query-job
-  [service query {:keys [create-disposition write-disposition large-results? dry-run? destination-table use-cache? flatten-results? priority udfs]}]
-  (let [{:keys [project-id dataset-id table-id]} destination-table
-        priorities {:batch       (QueryJobConfiguration$Priority/BATCH)
+  [service query {:keys [create-disposition write-disposition large-results? dry-run? destination-table default-dataset use-cache? flatten-results? priority udfs]}]
+  (let [priorities {:batch       (QueryJobConfiguration$Priority/BATCH)
                     :interactive (QueryJobConfiguration$Priority/INTERACTIVE)}
         builder    (QueryJobConfiguration/builder query)]
+    (when default-dataset
+      (let [{:keys [project-id dataset-id]} default-dataset]
+        (.defaultDataset builder (DatasetId/of project-id dataset-id))))
     (.createDisposition builder (create-dispositions (or create-disposition :never)))
     (.writeDisposition builder (write-dispositions (or write-disposition :append)))
     (.allowLargeResults builder large-results?)
@@ -331,7 +337,8 @@
     (when udfs
       (.userDefinedFunctions builder udfs))
     (when destination-table
-      (.destinationTable builder (TableId/of project-id dataset-id table-id)))
+      (let [{:keys [project-id dataset-id table-id]} destination-table]
+        (.destinationTable builder (TableId/of project-id dataset-id table-id))))
     (when-not (nil? dry-run?)
       (.dryRun builder dry-run?))
     (let [query-config (.build builder)]


test fix

test fix

--- test/metabase/driver/generic_sql/query_processor_test.clj
+++ test/metabase/driver/generic_sql/query_processor_test.clj
@@ -1,5 +1,6 @@
 (ns metabase.driver.generic-sql.query-processor-test
-  (:require [expectations :refer :all]
+  (:require [clojure.math.numeric-tower :as math]
+            [expectations :refer :all]
             [metabase.driver.generic-sql.query-processor :refer :all]
             [metabase.test-data :refer [db-id table->id field->id]]
             metabase.test-setup))
@@ -401,20 +402,19 @@
                             :aggregation ["cum_sum" (field->id :users :id)]}}))

 ;; ### Cumulative sum w/ a breakout field
-;; incidentally this also tests that the QP is casting timestamps -> date
-(expect (let [sorted-user-timestamps (->> metabase.test-data.data/test-data :users :rows (map last) sort)]
-          {:status :completed,
-           :row_count 15,
-           :data {:rows (map vector                                            ; convert to a seq like [[4 timestamp-1] [12 timestamp-2] ...]
-                             [4 12 13 22 34 44 57 72 78 85 90 104 115 118 120] ; by pairing values with corresponding ordered timestamp
-                             sorted-user-timestamps)                           ; that way we don't have to hard code the last_logins here
-                  :columns ["ID" "CAST(LAST_LOGIN AS DATE)"]
-                  :cols [{:special_type "id", :base_type "IntegerField", :description nil, :name "ID", :table_id (table->id :users), :id (field->id :users :id)}
-                         {:special_type nil, :base_type "DateTimeField", :description nil, :name "LAST_LOGIN", :table_id (table->id :users), :id (field->id :users :last_login)}]}})
-  (process-and-run {:type :query
-                    :database @db-id
-                    :query {:limit nil
-                            :source_table (table->id :users)
-                            :filter [nil nil]
-                            :breakout [(field->id :users :last_login)]
-                            :aggregation ["cum_sum" (field->id :users :id)]}}))
+(expect {:status :completed
+         :row_count 15
+         :data {:rows [4 12 13 22 34 44 57 72 78 85 90 104 115 118 120]
+                :columns ["ID" "CAST(LAST_LOGIN AS DATE)"]
+                :cols [{:special_type "id", :base_type "IntegerField", :description nil, :name "ID", :table_id (table->id :users), :id (field->id :users :id)}
+                       {:special_type nil, :base_type "DateTimeField", :description nil, :name "LAST_LOGIN", :table_id (table->id :users), :id (field->id :users :last_login)}]}}
+  (-> (process-and-run {:type :query
+                        :database @db-id
+                        :query {:limit nil
+                                :source_table (table->id :users)
+                                :filter [nil nil]
+                                :breakout [(field->id :users :last_login)]
+                                :aggregation ["cum_sum" (field->id :users :id)]}})
+      ;; Rows come back like `[value timestamp]` but it is hard to compare timestamps directly since the values that come back are casted
+      ;; to Dates and the exact value depends on the locale of the machine running the tests. So just drop the timestamps from the results.
+      (update-in [:data :rows] (partial map first))))


(maint) fix test namespace

(maint) fix test namespace

Corrects one incorrect renaming from 541de56

--- test/puppetlabs/cthun/broker/basic_authorization_test.clj
+++ test/puppetlabs/cthun/broker/basic_authorization_test.clj
@@ -1,4 +1,4 @@
-(ns puppetlabs.cthun.broker.basic-authorization
+(ns puppetlabs.cthun.broker.basic-authorization-test
   (:require [clojure.test :refer :all]
             [puppetlabs.cthun.broker.basic-authorization :refer :all]
             [puppetlabs.cthun.message :as message]


create canvas element and get context for it

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -7,6 +7,15 @@
     (aset div "className" (string/join " " classes))
     div))

+(defn create-canvas []
+  (let [width (aget js/window "innerWidth")
+        height (aget js/window "innerHeight")
+        canvas (js/document.createElement "canvas")]
+    (aset canvas "width" width)
+    (aset canvas "height" height)
+    (js/document.body.appendChild canvas)
+    (.getContext canvas "2d")))
+
 (defn ^:export main [n]
-  (let [div (make-div [] "hiya!")]
-    (js/document.body.appendChild div)))
+  (let [context (create-canvas)]
+    true))


Added Event specs for views

Added Event specs for views

--- libs/datview/src/dat/view.cljs
+++ libs/datview/src/dat/view.cljs
@@ -17,11 +17,24 @@
             [goog.date.Date]
             [cljs-time.core :as cljs-time]
             [cljs.core.async :as async]
+            [cljs.spec :as s]
             [cljs-time.format]
             [cljs-time.coerce]
             [cljs.pprint :as pp]
             [cljs.core.match :as match :refer-macros [match]]
             #_[markdown.core :as md]))
+
+
+
+
+(s/def ::event-id (s/and keyword? namespace))
+
+
+(s/def ::event (s/and vector? (s/cat :event-id  ::event-id
+                                     :event-data (constantly true))))
+
+
+

 ;; Some wrappers for convenience


experimental support for csh formatted output

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -24,6 +24,12 @@
 (defn- fmt-bash [m]
   (fmt-sh m #(str "\"${" % ",,}\"")))

+(defn- fmt-csh [m]
+  (let [f0 #(string/replace % "\n" "")
+        f1 (fn [n k v] (str "set nml__" n "_" k "=\"" (f0 v) "\"\n"))
+        f2 (fn [m [n kv]] (str m (apply str (map (fn [[k v]] (f1 n k v)) kv))))]
+    (reduce f2 "" (sort m))))
+
 (defn- fmt-ksh [m]
   (fmt-sh m #(str "\"$(echo $" % " | tr [:upper:] [:lower:])\"")))

@@ -38,6 +44,7 @@

 (def formats
   {"bash"     fmt-bash
+   "csh"      fmt-csh
    "ksh"      fmt-ksh
    "namelist" fmt-namelist})


CMR-1885 cleanup some syntax

CMR-1885 cleanup some syntax

--- umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
@@ -5,6 +5,8 @@
             [cmr.umm-spec.xml-to-umm-mappings.serf :as utx]
             [cmr.umm-spec.util :refer [without-default-value-of not-provided]]
             [clojure.set :as set]
+            [cmr.common.util :as util]
+            [clojure.string :as str]
             [clojure.string :as str]))

 (def serf-xml-namespaces
@@ -45,14 +47,14 @@
 (defn- extract-contacts-by-type
   "Returns a map of contact types to a list of the values."
   [contacts type]
-  (get (cmr.common.util/map-values #(map :Value %) (group-by :Type contacts)) type))
+  (get (util/map-values #(map :Value %) (group-by :Type contacts)) type))

 (defn- contact-to-serf
   "Converts a UMM-S Contact to the appropriate SERF Personnel elements as a vector"
   [contacts]
   (for [type ["email" "phone" "fax"]
         value (extract-contacts-by-type contacts type)]
-    [(keyword (clojure.string/capitalize type) ) value]))
+    [(keyword (str/capitalize type) ) value]))

 (defn- address-to-serf
   "Converts a UMM-S Addresses to the appropriate SERF Personnel elements as a vector.
@@ -119,6 +121,7 @@
      [:Distribution_Size (:DistributionSize distribution)]
      [:Distribution_Format (:DistributionFormat distribution)]
      [:Fees (:Fees distribution)]]))
+
 (defn- create-related-urls
   "Creates a SERF Related URL element from a UMM-S Document"
   [s]
@@ -126,7 +129,7 @@
     [:Related_URL [:URL_Content_Type
                    [:Type (:Type (:ContentType related-url))]
                    [:Subtype (:Subtype (:ContentType related-url))]]
-     (for[url (:URLs related-url)]
+     (for [url (:URLs related-url)]
        [:URL url])
      [:Description (:Description related-url)]]))

@@ -171,16 +174,14 @@
   "Creates a SERF IDN_Node element from a UMM-S AdditionalAttributes mapping"
   [s]
   (for [idn-node (filter #(= "IDN_Node" (:Name %)) (:AdditionalAttributes s))
-           :let [[:node-short-name :node-long-name] (str/split (:Value idn-node) #"\|")]]
-       [:IDN_Node [:Short_Name node-short-name]
-        [:Long_Name node-long-name]]))
+        :let [[:node-short-name :node-long-name] (str/split (:Value idn-node) #"\|")]]
+    [:IDN_Node [:Short_Name node-short-name]
+     [:Long_Name node-long-name]]))

 (def inserted-metadata
   "Inserted Metadata by CMR to account for missing fields"
   #{"Metadata_Name" "Metadata_Version" "IDN_Node"})
-(comment
-  (println (umm-s-to-serf-xml cmr.umm-spec.test.expected-conversion/example-service-record))
-  )
+
 (defn umm-s-to-serf-xml
   "Returns SERF XML structure from UMM collection record s."
   [s]


Fixed bug, converted ghost cannot generate minis

--- desktop/src-common/ds3/enemy.clj
+++ desktop/src-common/ds3/enemy.clj
@@ -49,7 +49,7 @@
 (def large-size (c/screen-to-world 16))
 (def mini-size (c/screen-to-world 10))

-(defn create-enemy-entity! [screen ship-texture col]
+(defn- create-enemy-entity! [screen ship-texture col]
   (let [pixel-ship (texture ship-texture)]
     (doto (assoc pixel-ship
             :body (create-enemy-body! screen)
@@ -63,7 +63,7 @@
             :ship-texture ship-texture)
       (body! :set-linear-velocity 0 0))))

-(defn create-mini-entity! [screen ship-texture x y bonus-group]
+(defn- create-mini-entity! [screen ship-texture x y bonus-group]
   (let [mini-ship (assoc (texture ship-texture)
                     :body (create-mini-body! screen)
                     :x x :y y
@@ -79,7 +79,7 @@
     mini-ship
     ))

-(defn create-enemy-body!
+(defn- create-enemy-body!
   [screen]
   (let [body (add-body! screen (body-def :dynamic :bullet true))
         enemy-shape (polygon-shape :set-as-box (c/screen-to-world 3) (c/screen-to-world 3) (vector-2 0 0) 0)]
@@ -89,7 +89,7 @@
     (.dispose enemy-shape)
     body))

-(defn create-mini-body!
+(defn- create-mini-body!
   [screen]
   (let [body (add-body! screen (body-def :dynamic :bullet true))
         enemy-shape (polygon-shape :set-as-box (c/screen-to-world 2) (c/screen-to-world 2) (vector-2 0 0) 0)]
@@ -178,7 +178,7 @@
                     (spark-enemy enemy other-entity screen entities))
                   (= :returning m-s)
                   (do
-                    (if (not (:boss? enemy))
+                    (if (not (or (:boss? enemy) (= :ghost-ship (:id enemy))))
                       (create-minis screen (:ship-texture enemy) x (:y enemy)))
                     (if (= hp 0)
                       (explode-enemy enemy other-entity screen entities)
@@ -191,7 +191,6 @@
     (update! screen :p1-level-score (+ (:p1-level-score screen) (* (:score enemy) (:p1-bonus screen))))
     (if (some? spark-emitter-id)
       (spark/remove-spark-emitter spark-emitter-id))
-
     (cond (= (:movement-state enemy) :beaming)
           (let [ship (first (filter #(:ship? %) entities))
                 all-others (filter #(nil? (:ship? %)) entities)


Spelling errors

Spelling errors

--- clojure-programming/src/clojure_programming/chapter01.clj
+++ clojure-programming/src/clojure_programming/chapter01.clj
@@ -7,7 +7,7 @@

 "
 'defn' defines a new function named 'average' in the namespace.
-'average' takes one  refered to as 'number'.
+'average' takes one  referred to as 'number'.
 "
 (defn average
   [numbers]
@@ -327,7 +327,7 @@
   (def p "foo") => #'p
   p => "foo")
 "
-(defn defn- defprotocol defonce defmacro) all use 'def' implicityl
+(defn defn- defprotocol defonce defmacro) all use 'def' implicitly
 therefore can create or redifine vars.

 (deftype defrecord defmethod) don't define or modify vars.
@@ -360,7 +360,7 @@

 [[:subsection {:title "Destructuring - let --  page 28"}]]
 "
-Most Clojure funtions are based around sequential and map data structures.
+Most Clojure functions are based around sequential and map data structures.
 This allows functions and data structures to be trivially composed.
 One challenge is to access$ the data in these structures.
 "
@@ -529,7 +529,7 @@
     (+ k x))
   => 55)

-(fact ":or knows the differnce between no value and 'false' value"
+(fact ":or knows the difference between no value and 'false' value"
   (let [{opt1 :option} {:option false}
         opt1 (or opt1 true)
         {opt2 :option :or {opt2 true}} {:option false}]
@@ -539,17 +539,17 @@

 "Binding values to there key's names  page 34"

-(def chas {:name "Chas" :age 31 :location "Massachesetts"})
+(def chas {:name "Chas" :age 31 :location "Massachusetts"})

 (fact "binding values using the same names can get repetittive:"
   (let [{name :name age :age location :location} chas]
     (format "%s is %s years old and lives in %s." name age location))
-  => "Chas is 31 years old and lives in Massachesetts.")
+  => "Chas is 31 years old and lives in Massachusetts.")

 (fact "using the ':keys' option:"
   (let [{:keys [name age location]} chas]
     (format "%s is %s years old and lives in %s." name age location))
-  => "Chas is 31 years old and lives in Massachesetts.")
+  => "Chas is 31 years old and lives in Massachusetts.")

 "switch when we know we are using strings or symbols as keys"

@@ -586,7 +586,7 @@

 [[:subsection {:title "Creating Functions:fn -- page: 36"}]]

-"Functions are first class so Clojure can create annonymous
+"Functions are first class so Clojure can create anonymous
 functions as a data type"

 (fn [x]
@@ -741,7 +741,7 @@
      (Math/pow %1 %2))

 "
-Function literals also have rest agruments (%&):"
+Function literals also have rest arguments (%&):"

 (fn [x & rest]
   (- x (apply + rest)))
@@ -754,7 +754,7 @@
 [[:subsection {:title "Conditionals: if  --  page: "}]]

 "
-If is Clojures sole primative conditionsal operator.
+If is Clojures sole primative conditional operator.
 "
 (facts "Conditionals determine logical truth to be any thing other than 'nil' or 'false"
   (fact (if "hi" \t)
@@ -792,8 +792,8 @@
 [[:subsection {:title "Looping: loop recure -- page: 43"}]]

 "
-Several useful imperative looping constructs (doseq and dotimes) are based on recure
-'recure' transferes controle without consuming stack space.
+Several useful imperative looping constructs (doseq and dotimes) are based on recur
+'recur' transferes control without consuming stack space.
 "

@@ -822,7 +822,7 @@
 "

-[[:subsection {:title "Reffering to Vars: var -- page:  page: 44"}]]
+[[:subsection {:title "Referring to Vars: var -- page:  page: 44"}]]

 "Sybols name a var evaluate to that vars value:"

@@ -906,8 +906,8 @@
 - deftype: page: 277
 "

-[[:subsection {:title "Primative Locking: monitor-enter, monitor-exit -- page: 45"}]]
-"Primatives for Java Object locking:  page: 225"
+[[:subsection {:title "Primitive Locking: monitor-enter, monitor-exit -- page: 45"}]]
+"Primitives for Java Object locking:  page: 225"

 [[:section {:title "Putting If All Together --  page:  46"}]]
@@ -932,7 +932,7 @@
 [[:subsection {:title "Eval -- page: 46"}]]

 "
-encapsulate evauation semantics
+encapsulate evaluation semantics
 "
 (facts "evaluation of literals:"
   (fact (eval :foo)


Allow configuration of prompt fn.

Allow configuration of prompt fn.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -142,6 +142,7 @@
    :help-cmd-entry-delimiter "\n"
    :print cli-repl-print
    :print-err print-err-fn
+   :prompt-fn (fn [])
    :prompt-string "cli# "
    :read-factory create-jline-read-fn})

@@ -165,7 +166,7 @@
       (repl
         :eval ((options :eval-factory) (options :cmds) (options :allow-eval) (options :print-err))
         :print (options :print)
-        :prompt (fn [])
+        :prompt (options :prompt-fn)
         :read ((options :read-factory) (options :cmds) (options :prompt-string))))))


Fix bad close in sherpa_client

Fix bad close in sherpa_client

--- sherpa-clojure/src/main/clojure/sherpa/sherpa_client.clj
+++ sherpa-clojure/src/main/clojure/sherpa/sherpa_client.clj
@@ -54,5 +54,5 @@
           {:query-handle execution
            :results (map tuple-generator (iterator-seq data-iter))}))
       (cancel [_ query-handle] (.cancel query-handle))
-      (close [_ query-handle] (.close (query-handle)))
+      (close [_ query-handle] (.close query-handle))
       (shutdown [_] (.close transceiver)))))


Add a test

Add a test

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -9,6 +9,7 @@
   (is (= "SELECT asd FROM \"table-name\";"
          (select "table-name"
                  (column "asd"))))
+
   (is (= "SELECT first,second FROM \"table-name\";"
          (select "table-name"
                  (column "first")
@@ -57,11 +58,11 @@
                           [<= :c "z"]])
                   )))

-  (is (= "SELECT DISTINCT asd AS bsd FROM foo;")
-      (select :foo
-              (columns (-> "asd"
-                           distinct*
-                           (as "bsd")))))
+  (is (= "SELECT DISTINCT asd AS bsd FROM foo;"
+         (select :foo
+                 (columns (-> "asd"
+                              distinct*
+                              (as "bsd"))))))

   (is (= "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo LIMIT :limit;";
          (select :foo
@@ -400,13 +401,13 @@

   (is (= "
-	CREATE TABLE foo(
-		a int,
-		b varchar,
-		c int,
-		d int,
-		e int,
-		PRIMARY KEY((a, b), c, d))"
+  CREATE TABLE foo(
+    a int,
+    b varchar,
+    c int,
+    d int,
+    e int,
+    PRIMARY KEY((a, b), c, d))"
          (create-table :foo
                        (column-definitions {:a :int
                                             :b :varchar
@@ -416,13 +417,13 @@
                                             :primary-key [[:a :b] :c :d]}))))

   (is (= "
-	CREATE TABLE foo(
-		a int,
-		c int,
-		d int,
-		e int,
-		b varchar,
-		PRIMARY KEY(a, c, d))"
+  CREATE TABLE foo(
+    a int,
+    c int,
+    d int,
+    e int,
+    b varchar,
+    PRIMARY KEY(a, c, d))"
          (create-table :foo
                        (column-definitions {:a :int
                                             :b :varchar
@@ -433,24 +434,29 @@

   (is (= "
-	CREATE TABLE foo(
-		a int,
-		b map<varchar, varchar>,
-		PRIMARY KEY(a))"
+  CREATE TABLE foo(
+    a int,
+    b map<varchar, varchar>,
+    PRIMARY KEY(a))"
          (create-table :foo
                        (column-definitions {:a :int
                                             :b (map-type :varchar :varchar)
                                             :primary-key [:a]}))))

   (is (= "
-	CREATE TABLE IF NOT EXISTS foo(
-		a int,
-		b varchar,
-		PRIMARY KEY(a))"
+  CREATE TABLE IF NOT EXISTS foo(
+    a int,
+    b varchar,
+    PRIMARY KEY(a))"
          (create-table :foo
                        (column-definitions {:a :int
                                             :b :varchar
                                             :primary-key [:a]})
                        (if-not-exists)
                        )))
+
+  (is (= "
+  ALTER TABLE foo ALTER foo TYPE int"
+         (alter-table :foo
+                      (alter-column :foo :int))))
   )


DM + RS - Remove logging from stub_twitter workflow

--- dev/dev_helpers/stub_twitter.clj
+++ dev/dev_helpers/stub_twitter.clj
@@ -5,17 +5,13 @@
             [objective8.utils :as utils]))

 ;; Stub out twitter authentication workflow
-(defn print-and-pass-through [x]
-  (prn x)
-  x)

 (defn stub-twitter-handler [request]
   (let [session (:session request)]
     (-> (response/redirect (str utils/host-url "/sign-up"))
         (assoc :session (assoc session
                                :twitter-id "twitter-FAKE_ID"
-                               :twitter-screen-name "I'm a teapot"))
-        print-and-pass-through)))
+                               :twitter-screen-name "I'm a teapot")))))

 (def stub-twitter-workflow
   (make-handler ["/twitter-sign-in" stub-twitter-handler]))


added aircraft data to the tests

added aircraft data to the tests

--- umm-spec-lib/test/cmr/umm_spec/test/validation/platform.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/validation/platform.clj
@@ -14,10 +14,10 @@
                                    :ComposedOf [s1 s2]})
         c1 (c/map->CharacteristicType {:Name "C1"})
         c2 (c/map->CharacteristicType {:Name "C2"})
-        c3 (c/map->CharacteristicType {:Name "C3"
-                                       :Value "C3"})
-        c4 (c/map->CharacteristicType {:Name "C3"
-                                       :Value "C4"})]
+        c3 (c/map->CharacteristicType {:Name "AircraftID"
+                                       :Value "C-FSJB"})
+        c4 (c/map->CharacteristicType {:Name "AircraftID"
+                                       :Value "N572AR"})]
     (testing "valid platforms"
       (h/assert-valid (coll/map->UMM-C
                        {:Platforms [(c/map->PlatformType {:ShortName "P1"
@@ -27,9 +27,9 @@
                                                           :Instruments [i1 i2]
                                                           :Characteristics [c1 c2]})]}))
       (h/assert-valid (coll/map->UMM-C
-                       {:Platforms [(c/map->PlatformType {:ShortName "P1"
+                       {:Platforms [(c/map->PlatformType {:ShortName "DHC-6"
                                                           :Characteristics [c3]})
-                                    (c/map->PlatformType {:ShortName "P1"
+                                    (c/map->PlatformType {:ShortName "DHC-6"
                                                           :Characteristics [c4]})]})))

     (testing "invalid platforms"
@@ -43,14 +43,14 @@
             ["Platforms must be unique. The combination of platform ShortName with Characteristics Name and Value contain duplicates named [P1]."])))
       (testing "duplicate platform short names with characteristics"
         (let [coll (coll/map->UMM-C
-                     {:Platforms [(c/map->PlatformType {:ShortName "P1"
+                     {:Platforms [(c/map->PlatformType {:ShortName "DHC-6"
                                                         :Characteristics [c3]})
-                                  (c/map->PlatformType {:ShortName "P1"
+                                  (c/map->PlatformType {:ShortName "DHC-6"
                                                         :Characteristics [c3]})]})]
           (h/assert-invalid
             coll
             [:Platforms]
-            ["Platforms must be unique. The combination of platform ShortName with Characteristics Name and Value contain duplicates named [P1C3C3]."])))
+            ["Platforms must be unique. The combination of platform ShortName with Characteristics Name and Value contain duplicates named [DHC-6AircraftIDC-FSJB]."])))
       (testing "duplicate platform characteristics names"
         (let [coll (coll/map->UMM-C
                      {:Platforms [(c/map->PlatformType {:ShortName "P1"
@@ -66,7 +66,7 @@
           (h/assert-invalid
             coll
             [:Platforms 0 :Characteristics]
-            ["Characteristics must be unique. This contains duplicates named [C3]."])))
+            ["Characteristics must be unique. This contains duplicates named [AircraftID]."])))

       (testing "duplicate instrument short names"
         (let [coll (coll/map->UMM-C


DRY up scroll variants

DRY up scroll variants

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -262,23 +262,24 @@
         (.setAttribute new-link-el "href" canonical-page)
         (dom/appendChild (.-head js/document) new-link-el)))))

+(defn scroll-to-node!
+  [node]
+  (let [body (.-body js/document)
+        node-top (goog.style/getPageOffsetTop node)
+        body-top (goog.style/getPageOffsetTop body)]
+    (set! (.-scrollTop body) (- node-top body-top))))
+
 (defn scroll-to-id!
   "Scrolls to the element with given id, if node exists"
   [id]
   (when-let [node (dom/getElement id)]
-    (let [body (.-body js/document)
-          node-top (goog.style/getPageOffsetTop node)
-          body-top (goog.style/getPageOffsetTop body)]
-      (set! (.-scrollTop body) (- node-top body-top)))))
+    (scroll-to-node! id)))

 (defn scroll-to-selector!
   "Scrolls to the first element matching the selector, if node exists"
   [selector]
   (when-let [node (.querySelector js/document selector)]
-    (let [body (.-body js/document)
-          node-top (goog.style/getPageOffsetTop node)
-          body-top (goog.style/getPageOffsetTop body)]
-      (set! (.-scrollTop body) (- node-top body-top)))))
+    (scroll-to-node! node)))

 (defn scroll!
   "Scrolls to fragment if the url had one, or scrolls to the top of the page"


[WM] update generated deps to latest versions

--- resources/leiningen/new/kraken_http_api/project.clj
+++ resources/leiningen/new/kraken_http_api/project.clj
@@ -6,8 +6,8 @@
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [org.clojure/tools.logging "0.3.1"]
                  [turbovote.resource-config "0.2.0"]
-                 [com.novemberain/langohr "3.4.1"]
-                 [prismatic/schema "1.0.3"]
+                 [com.novemberain/langohr "3.5.0"]
+                 [prismatic/schema "1.0.4"]
                  [ch.qos.logback/logback-classic "1.1.3"]

                  ;; core.async has to come before pedestal or kehaar.wire-up will
@@ -20,9 +20,9 @@
                  [io.pedestal/pedestal.service "0.4.1"]
                  [io.pedestal/pedestal.service-tools "0.4.1"]
                  [democracyworks/pedestal-toolbox "0.6.2"]
-                 [org.immutant/web "2.1.1"]
+                 [org.immutant/web "2.1.2"]
                  [io.pedestal/pedestal.immutant "0.4.1"]
-                 [org.immutant/core "2.1.1"]
+                 [org.immutant/core "2.1.2"]
                  [democracyworks/bifrost "0.1.4"]]
   :plugins [[lein-immutant "2.1.0"]]
   :main ^:skip-aot {{name}}.server


Whitespace deletion

Whitespace deletion

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -173,7 +173,7 @@
 			      [z_2 y] set-of-pairs
                              :when (= z_1 z_2)]))
 	      new))))
-
+
 (defn reflexive-transitive-closure
   "Computes the reflexive, transitive closure of a given set of pairs
   on base-set."


fix permissions

fix permissions

--- server/src/gratefulplace/controllers/shared.clj
+++ server/src/gratefulplace/controllers/shared.clj
@@ -64,8 +64,9 @@
   `(fn [_#]
      (let [auth# ~auth
            record# ~record]
-       (if (or (moderator? auth#)
-               (and (author? record# auth#) (not (:deleted record#))))
+       (if (and (not (:deleted record#))
+                (or (moderator? auth#)
+                    (author? record# auth#)))
          {:record record#}))))

 (defn create-record


Remove writter related tests.

Remove writter related tests.

--- test/cats/labs/writer_spec.cljc
+++ test/cats/labs/writer_spec.cljc
@@ -1,134 +0,0 @@
-(ns cats.labs.writer-spec
-  #?(:cljs
-     (:require [cljs.test :as t]
-               [cats.builtin :as b]
-               [cats.protocols :as p]
-               [cats.data :as d]
-               [cats.labs.writer :as writer]
-               [cats.monad.maybe :as maybe]
-               [cats.context :as ctx :include-macros true]
-               [cats.core :as m :include-macros true])
-     :clj
-     (:require [clojure.test :as t]
-               [cats.builtin :as b]
-               [cats.protocols :as p]
-               [cats.data :as d]
-               [cats.labs.writer :as writer]
-               [cats.monad.maybe :as maybe]
-               [cats.context :as ctx]
-               [cats.core :as m])))
-
-(t/deftest writer-monad-tests
-  ;; Putting a value in a writer context yields an empty log
-  (t/is (= 42 (writer/value (m/return writer/context 42))))
-  (t/is (= [] (writer/log (m/return writer/context 42))))
-
-  ;; The `tell` function adds the given value to the log
-  (t/is (= ["Hello" "world"]
-           (ctx/with-context writer/context
-             (writer/log (m/>> (writer/tell "Hello")
-                               (writer/tell "world"))))))
-
-  ;; The `listen` function yields a pair with the value and the log
-  (let [w (ctx/with-context writer/context
-            (m/>> (writer/tell "Hello")
-                  (writer/tell "world")
-                  (m/return 42)))
-        w (writer/listen w)]
-    (t/is (= (d/pair 42 ["Hello" "world"])
-             (first w)))
-    (t/is (= ["Hello" "world"]
-             (second w))))
-
-  ;; The `pass` function can be used to apply a function to the log
-  (let [w (ctx/with-context writer/context
-            (m/>> (writer/tell "Hello")
-                  (writer/tell "world")
-                  (m/return [42 reverse])))
-        w (writer/listen (writer/pass w))]
-    (t/is (= (d/pair 42 ["world" "Hello"])
-             (first w)))
-    (t/is (= ["world" "Hello"]
-             (second w))))
-
-  ;; The log values are accumulated using Semigroup's `mappend` operation
-  (let [w (ctx/with-context writer/context
-            (m/>> (writer/pass (m/return [42 set]))
-                  (writer/tell "Hello")
-                  (writer/tell "Hello")
-                  (writer/tell "world")
-                  (writer/tell "world")
-                  (writer/tell "Hello")
-                  (writer/tell "world")))
-        w (writer/listen w)]
-    (t/is (= #{"world" "Hello"}
-             (second w)))))
-
-
-(def writer-maybe-t (writer/writer-t maybe/context))
-
-(t/deftest writer-t-tests
-  ;; Putting a value in a writer transformer context yields an empty log
-  (let [w (ctx/with-context writer-maybe-t
-            (m/return 42))]
-    (t/is (= 42 (writer/value (maybe/from-maybe w))))
-    (t/is (= [] (writer/log (maybe/from-maybe w)))))
-
-  ;; The `tell` function adds the given value to the log
-  (let [w (ctx/with-context writer-maybe-t
-            (m/>> (writer/tell "Hello")
-                  (writer/tell "world")))]
-    (t/is (= ["Hello" "world"]
-             (writer/log (maybe/from-maybe w)))))
-
-  ;; The `listen` function yields a pair with the value and the log
-  (let [w (ctx/with-context writer-maybe-t
-            (m/>> (writer/tell "Hello")
-                  (writer/tell "world")
-                  (m/return 42)))
-        w (ctx/with-context writer-maybe-t
-            (writer/listen w))]
-    (t/is (= (d/pair 42 ["Hello" "world"])
-             (first (maybe/from-maybe w))))
-    (t/is (= ["Hello" "world"]
-             (second (maybe/from-maybe w)))))
-
-  ;; The `pass` function can be used to apply a function to the log
-  (let [w (ctx/with-context writer-maybe-t
-            (m/>> (writer/tell "Hello")
-                  (writer/tell "world")
-                  (m/return [42 reverse])))
-        w (ctx/with-context writer-maybe-t
-            (writer/listen (writer/pass w)))]
-    (t/is (= (d/pair 42 ["world" "Hello"])
-             (first (maybe/from-maybe w))))
-    (t/is (= ["world" "Hello"]
-             (second (maybe/from-maybe w)))))
-
-  ;; The log values are accumulated using Semigroup's `mappend` operation
-  (let [w (ctx/with-context writer-maybe-t
-            (m/>> (writer/pass (m/return [42 set]))
-                  (writer/tell "Hello")
-                  (writer/tell "Hello")
-                  (writer/tell "world")
-                  (writer/tell "world")
-                  (writer/tell "Hello")
-                  (writer/tell "world")))
-        w (ctx/with-context writer-maybe-t
-            (writer/listen w))]
-    (t/is (= #{"world" "Hello"}
-             (second (maybe/from-maybe w)))))
-
-  ;; Inner monad values can be lifted into the transformer
-  (let [lifted-just (ctx/with-context writer-maybe-t
-                      (m/lift (maybe/just 3)))
-        lifted-nothing (ctx/with-context writer-maybe-t
-                         (m/lift (maybe/nothing)))]
-    (t/is (= (maybe/just (d/pair 3 ["Hello"]))
-             (ctx/with-context writer-maybe-t
-               (m/>> (writer/tell "Hello")
-                     lifted-just))))
-    (t/is (= (maybe/nothing)
-             (ctx/with-context writer-maybe-t
-               (m/>> (writer/tell "Hello")
-                     lifted-nothing))))))


fixing tests

fixing tests

--- test/celestial/test/vsphere.clj
+++ test/celestial/test/vsphere.clj
@@ -10,5 +10,5 @@
 (with-conf
   (fact "basic construction"
     (let [vm (vconstruct redis-vsphere-spec)]
-      (:allocation vm ) => {:datacenter "playground" :hostname "red1"}
-      (:machine vm ) => {:cpus 1 :disk 10 :memory 512 :template "ubuntu-13.04_puppet-3.1"})))
+      (:allocation vm ) => {:datacenter "playground" :pool ""}
+      (:machine vm ) => {:cpus 1 :hostname "red1" :memory 512 :template "ubuntu-13.04_puppet-3.1"})))


Display programme name on edit form.

Display programme name on edit form.

Fixes #208

--- src-cljs/kixi/hecuba/tabs/hierarchy/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy/programmes.cljs
@@ -81,8 +81,9 @@
                                                               url       (str "/4/programmes/" programme-id)]
                                                           (put-edited-programme programmes refresh-chan owner url programme)))} "Save"]
              [:button.btn.btn-danger {:type "button"
-                                       :onClick (fn [_] (om/update! programmes :editing false))} "Cancel"]]]
+                                      :onClick (fn [_] (om/update! programmes :editing false))} "Cancel"]]]
            (static-text cursor :programme_id "Programme ID")
+           (static-text cursor :name "Programme Name")
            (om/build alert (-> programmes :alert))
            (text-input-control cursor owner :programme :created_at "Created At")
            (text-input-control cursor owner :programme :description "Description")


CMR-356: added cloud cover sorting tests

--- test/cmr/system_int_test/search/granule_sorting_search_test.clj
+++ test/cmr/system_int_test/search/granule_sorting_search_test.clj
@@ -42,10 +42,11 @@
          "readable_granule_name" [g1 g5 g4 g3 g2]
          "-readable_granule_name" (reverse [g1 g5 g4 g3 g2]))))

-(deftest granule-size-sorting-test
+(deftest granule-numeric-sorting-test
   (let [coll (d/ingest "PROV1" (dc/collection {}))
-        make-gran (fn [size]
-                    (d/ingest "PROV1" (dg/granule coll {:size size})))
+        make-gran (fn [number]
+                    (d/ingest "PROV1" (dg/granule coll {:size number
+                                                        :cloud-cover number})))
         g1 (make-gran 20)
         g2 (make-gran 30)
         g3 (make-gran 10)
@@ -57,7 +58,9 @@
                               (search/find-refs :granule {:page-size 20
                                                           :sort-key sort-key}))
          "data_size" [g3 g1 g5 g2 g4]
-         "-data_size" [g2 g5 g1 g3 g4])))
+         "-data_size" [g2 g5 g1 g3 g4]
+         "cloud_cover" [g3 g1 g5 g2 g4]
+         "-cloud_cover" [g2 g5 g1 g3 g4])))

 (deftest coll-identifier-sorting-test


Update armstrong test for consistency

Update armstrong test for consistency

--- exercises/armstrong-numbers/test/armstrong_numbers_test.clj
+++ exercises/armstrong-numbers/test/armstrong_numbers_test.clj
@@ -24,7 +24,7 @@

 (deftest not-armstrong-number-9475
   (testing "Four digit number that is not an Armstrong number"
-    (is (not (armstrong? 9476)))))
+    (is (not (armstrong? 9475)))))

 (deftest armstrong-number-9926315
   (testing "Seven digit number that is an Armstrong number"


(PE-3864) use 'remove' instead of 'filter' + 'not'

--- src/clj/puppetlabs/master/certificate_authority.clj
+++ src/clj/puppetlabs/master/certificate_authority.clj
@@ -611,7 +611,7 @@
   `allowed-extension?`"
   [csr :- (schema/pred utils/certificate-request?)]
   (let [extensions (utils/get-extensions csr)
-        bad-extensions (filter (comp not allowed-extension?) extensions)]
+        bad-extensions (remove allowed-extension? extensions)]
     (when-not (empty? bad-extensions)
       (let [bad-extension-oids (map :oid bad-extensions)]
         (sling/throw+ {:type    :disallowed-extension


Use partial application

Use partial application

--- src/hu/ssh/github_changelog/formatters/markdown.clj
+++ src/hu/ssh/github_changelog/formatters/markdown.clj
@@ -11,7 +11,7 @@
        " "
        (:subject change)
        (if-let [issues (:issues change)]
-         (str ", closes " (str-map #(markdown/link (first %) (second %)) issues)))))
+         (str ", closes " (str-map (partial apply markdown/link) issues)))))

 (s/defn format-changes :- s/Str
   [[type changes :- [Change]]]


start work on rhs deletion

start work on rhs deletion

--- dada2-core/src/test/clojure/org/dada2/test_join_model.clj
+++ dada2-core/src/test/clojure/org/dada2/test_join_model.clj
@@ -90,11 +90,16 @@
   "associate a new rhs with existing index"
   (assoc-in indeces [i fk (rhs-pk-key rhs)] rhs))

+(defn- rhs-dissoc [indeces i rhs-pk-key fk rhs]
+  "dissociate an rhs from existing index"
+  (update-in indeces [i fk (rhs-pk-key rhs)] (fn [_] nil)))
+
 (deftest test-rhs-access
   (let [before [[] {}]
 	after  [[] {String {3 "xxx"}}]]
     (is (= after (rhs-assoc before 1 count String "xxx")))
-    (is (= '(("xxx")) (rhses-get (rest after) [first] [String])))))
+    (is (= '(("xxx")) (rhses-get (rest after) [first] [String])))
+    (is (= [[] {String {3 nil}}] (rhs-dissoc after 1 count String "xxx")))))

 ;;--------------------------------------------------------------------------------
 ;; this layer encapsulates access to both lhs and rhs at the same time...
@@ -143,8 +148,22 @@
     [new-indeces (fn [_] (on-upserts joined-model joins))]
     ))

+;;; TODO - ugly, slow and should remove key rather than leaving a key:nil assoc...
+(defn- rhs-delete [old-indeces i rhs-pk-key rhs-fk-key lhs-fk-keys rhs join-fn joined-model]
+  (let [fk (rhs-fk-key rhs)
+	old-rhs-indeces (rest old-indeces)
+	lhs-indeces (first old-indeces)
+	lhses (lhses-get lhs-indeces (dec i) fk)
+	old-joins (mapcat (fn [lhs] (derive-joins old-rhs-indeces lhs-fk-keys lhs join-fn)) lhses)
+	new-indeces (rhs-dissoc old-indeces i rhs-pk-key fk rhs)
+	new-rhs-indeces (rest new-indeces)
+	new-joins (mapcat (fn [lhs] (derive-joins new-rhs-indeces lhs-fk-keys lhs join-fn)) lhses)
+	joins (remove (fn [i] (contains? (apply hash-set new-joins) i)) old-joins)
+	]
+    [new-indeces (fn [_] (on-deletes joined-model joins))]
+    ))
+
 ;;; TODO
-(defn- rhs-delete [old-indeces i ks v join-fn])
 (defn- rhs-upserts [old-indeces i ks vs join-fn])
 (defn- rhs-deletes [old-indeces i ks vs join-fn])

@@ -153,7 +172,7 @@
    View
    ;; singleton changes
    (on-upsert [_ upsertion] ((swap*! indeces rhs-upsert i rhs-pk-key rhs-fk-key lhs-fk-keys upsertion join-fn joined-model) []) nil) ;TODO: pass in views to notifier
-   (on-delete [_ deletion]  (swap! indeces rhs-delete i lhs-fk-keys deletion join-fn) nil)
+   (on-delete [_ deletion]  ((swap*! indeces rhs-delete i rhs-pk-key rhs-fk-key lhs-fk-keys deletion  join-fn joined-model) []) nil) ;TODO: pass in views to notifier
    ;; batch changes
    (on-upserts [_ upsertions] (swap! indeces rhs-upserts i lhs-fk-keys upsertions join-fn) nil)
    (on-deletes [_ deletions]  (swap! indeces rhs-deletes i lhs-fk-keys deletions join-fn) nil)))
@@ -343,7 +362,7 @@
 	   }
 	   (data joined-model)))

-    ;; join - new lhs - a2
+    ;; join - delete lhs - a2
     (on-delete as a2)
     (is (= [[{:b {:a1 a1v1}}{:c {:a1 a1v1}}]
 	    {:b {:b1 b1v1 :b2 b2}} {:c {:c1 c1v1 :c2 c2}}] (data join)))
@@ -355,6 +374,15 @@
 	   }
 	   (data joined-model)))

+    ;; join - delete rhs - b2
+    (on-delete bs b2)
+    (is (= [[{:b {:a1 a1v1}}{:c {:a1 a1v1}}]
+	    {:b {:b1 b1v1 :b2 nil}} {:c {:c1 c1v1 :c2 c2}}] (data join)))
+    (is (= {
+	   [:a1 :b1 :c1] (->ABC [:a1 :b1 :c1] [1 1 1] "b1v1-data" "c1v1-data")
+	   [:a1 :b1 :c2] (->ABC [:a1 :b1 :c2] [1 1 0] "b1v1-data" "c2-data")
+	   }
+	   (data joined-model)))

     ;; TODO:
     ;;  amend in/out


Fix arity error on benchmarks

Fix arity error on benchmarks

--- modules/reitit-ring/src/reitit/ring.cljc
+++ modules/reitit-ring/src/reitit/ring.cljc
@@ -253,7 +253,8 @@
   (if inject-router?
     (fn enrich-request [request router]
       (impl/fast-assoc request ::r/router router))
-    identity))
+    (fn enrich-request [request _]
+      request)))

 (defn ring-handler
   "Creates a ring-handler out of a router, optional default ring-handler


use deserializer-fn instead of serializer-fn

--- src/leiningen/new/onyx_app/src/onyx_app/jobs/sample_submit_job.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/jobs/sample_submit_job.clj
@@ -28,7 +28,7 @@
       (= :prod mode) (add-kafka-input :read-lines {:kafka/topic "meetup"
                                                    :kafka/group-id "onyx-consumer"
                                                    :kafka/zookeeper "zk:2181"
-                                                   :kafka/serializer-fn :json
+                                                   :kafka/deserializer-fn :json
                                                    :kafka/offset-reset :smallest})
       (= :prod mode) (add-sql-output :write-lines {:sql/classname "com.mysql.jdbc.Driver"
                                                    :sql/subprotocol "mysql"


Add test for `of-millis`

Add test for `of-millis`

--- test/tick/api_test.cljc
+++ test/tick/api_test.cljc
@@ -349,7 +349,8 @@
 ;; units.
 (deftest duration-functions-test
   (is (= (t/of-nanos 10) (t/new-duration 10 :nanos)))
-  (is (= (t/of-micros 10) (t/new-duration 10 :micros))))
+  (is (= (t/of-micros 10) (t/new-duration 10 :micros)))
+  (is (= (t/of-millis 10) (t/new-duration 10 :millis))))


Add docstrings

Add docstrings

--- test/transit/verify.clj
+++ test/transit/verify.clj
@@ -4,7 +4,7 @@
 (ns transit.verify
   "Provides tools for testing all transit implementations at
   once. Tests each implementaion with several sources of data:
-  exemplar files, problem edn data, problem transit data and generated
+  exemplar files, problem EDN data, problem transit data and generated
   data. In addition, it can capture comparative timing results.

   From the REPL, the main entry point is `verify-all` which takes an
@@ -62,7 +62,14 @@
     (catch Throwable e
       ::read-error)))

-(defn start-process [command encoding]
+(defn start-process
+  "Given a command and enconding, start a process which can roundtrip
+  transit data. The command is the path to any program which will
+  start a roundtrip process. The enconding must be either `:json` or
+  `:msgpack`. Returns a map (process map) with keys `:out` the output
+  stream which can be used to send data to the process, `:p` the
+  process and `:reader` a transit reader."
+  [command encoding]
   ;; TODO: what if there is exception here? need to report that we
   ;; couldn't start the process?
   ;; TODO: how do we communicate that the encoding is not supported?
@@ -72,7 +79,11 @@
     ;; r/reader does not return until data starts to flow over in
     {:out out :p p :reader (future (r/reader in encoding))}))

-(defn stop-process [proc]
+(defn stop-process
+  "Given a process, stop the process started by
+  `start-process`. Sends Ctrl-C (SIGINT) to the process before
+  attempting to destroy the process."
+  [proc]
   (try
     (.write (:out proc) 3) ;; send Ctrl+C
     (.flush (:out proc))
@@ -81,64 +92,101 @@
       (println "WARNING! Exception while stopping process.")
       (println (.toString e)))))

-;; TODO: failure to write means that the process has died
-;; catch and throw the way we do with read-response
-(defn write-to-stream [proc transit-data]
-  (.write (:out proc) transit-data 0 (count transit-data))
-  (.flush (:out proc)))
-
-(defn read-response [proc transit-out timeout-ms]
+(defn write-to-stream
+  "Given a process and a byte array of transit data, write this
+  data to the output stream. Throws an exception of the output stream
+  is closed."
+  [proc transit-data]
+  (try
+    (.write (:out proc) transit-data 0 (count transit-data))
+    (.flush (:out proc))
+    (catch Throwable _
+      (throw (ex-info "Disconnected" {:status :disconnected :p proc :transit transit-data})))))
+
+(defn read-response
+  "Given a process and a timeout in milliseconds, attempt to read
+  a transit value.  If the read times out, returns `::timeout`.`"
+  [proc timeout-ms]
   (let [f (future (r/read @(:reader proc)))]
-    (let [response (deref f timeout-ms ::timeout)]
-      (if (= response ::timeout)
-        (throw (ex-info "Response timeout" {:status :timeout :p proc :transit transit-out}))
-        response))))
-
-(defn roundtrip-transit [proc transit-out encoding]
+    (deref f timeout-ms ::timeout)))
+
+(defn roundtrip-transit
+  "Given a process, a byte array of transit data and an encoding,
+  roundtrip the transit data and return a map of test results. Throws
+  an exception if sending transit data causes a timeout. The results
+  map contains the expected and actual Clojure data and the test
+  status: one of `:error` or `:success`."
+  [proc transit-out encoding]
   (write-to-stream proc transit-out)
-  (let [data-in (read-response proc transit-out TIMEOUT)
+  (let [data-in (read-response proc TIMEOUT)
         data-out (read-transit transit-out encoding)]
-    {:transit-expected (String. transit-out)
-     :data-expected data-out
-     :data-actual data-in
-     ;; only checks the top level type
-     :status (if (and (= (type data-out) (type data-in))
-                      (= data-out data-in))
-               :success
-               :error)}))
-
-(defn roundtrip-edn [proc edn encoding]
+    (if (= data-in ::timeout)
+      (throw (ex-info "Response timeout" {:status :timeout :p proc :transit transit-out}))
+      {:transit-expected (String. transit-out)
+       :data-expected data-out
+       :data-actual data-in
+       ;; only checks the top level type
+       :status (if (and (= (type data-out) (type data-in))
+                        (= data-out data-in))
+                 :success
+                 :error)})))
+
+(defn roundtrip-edn
+  "Given a process, an EDN form and an encoding, roundtrip the EDN
+  data and return a map of test results. See `roundtrip-transit`."
+  [proc edn encoding]
   (try
     (let [transit-out (write-transit edn encoding)]
       (roundtrip-transit proc transit-out encoding))
     (catch Throwable e
-      (if (= (-> e ex-data :status) :timeout)
-        (throw (ex-info "Response timeout" (assoc (ex-data e) :edn edn)))
+      (if (contains? #{:disconnected :timeout} (-> e ex-data :status) )
+        (throw (ex-info (.getMessage e) (assoc (ex-data e) :edn edn)))
         (throw e)))))

-(defn test-transit [transits proc encoding]
+(defn test-transit
+  "Given a collection of transit byte arrays, a process and the
+  transit enconding, roundtrip each transit message and return a
+  sequence of results."
+  [transits proc encoding]
   (mapv #(roundtrip-transit proc % encoding) transits))

-(defn test-edn [forms proc encoding]
+(defn test-edn
+  "Given a collection of EDN forms, a process and a transit
+  enconding, roundtrip each form and return a sequence of results."
+  [forms proc encoding]
   (mapv #(roundtrip-edn proc % encoding) forms))

-(defn test-timing [transits proc encoding]
+(defn test-timing
+  "Given a collection of transit byte arrays, a process and the
+  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 100]
+  (dotimes [x 200]
     (mapv #(roundtrip-transit proc % encoding) transits))
-  (let [start (System/currentTimeMillis)]
+  (let [start (System/nanoTime)]
     (mapv #(roundtrip-transit proc % encoding) transits)
-    (- (System/currentTimeMillis) start)))
+    (quot (- (System/nanoTime) start) 1000000)))

 (def extension {:json ".json"
                 :msgpack ".mp"})

-(defn exemplar-transit [encoding]
+(defn exemplar-transit
+  "Given an encoding, return a collection of transit byte arrays in
+  that encoding. The byte arrays are loaded from the exemplar files in
+  the `transit` repository."
+  [encoding]
   (map #(read-bytes %)
        (filter #(and (.isFile %) (.endsWith (.getName %) (extension encoding)))
                (file-seq (io/file "../transit/simple-examples")))))

-(defn filter-tests [proc encoding opts]
+(defn filter-tests
+  "Given a process, an encoding and options provided by the user,
+  return a sequcnes of tests to run. Each test is represented as a map
+  with `:path` and `:test` keys. The value at `:path` is the path into
+  the results where the test results are to be stored. The value at
+  `:test` is a no argument function which will run a single test."
+  [proc encoding opts]
   (let [transit-exemplars (exemplar-transit encoding)]
     (filter #((:pred %) proc encoding opts)
             [{:pred (constantly true)
@@ -160,7 +208,16 @@
                         :count (count transit-exemplars)
                         :encoding encoding})}])))

-(defn verify-impl-encoding [command encoding opts]
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Running Tests
+
+(defn verify-impl-encoding
+  "Given a command string, an encoding and user provided options, run
+  a collection of tests against a specific implementation of
+  transit. The tests which are run are determined by the provided
+  options and the encoding. The implementation which is tested is
+  determined by the provided command string."
+  [command encoding opts]
   (assert (contains? extension encoding)
           (str "encoding must be on of" (keys extension)))
   (let [proc (start-process command encoding)
@@ -180,7 +237,10 @@

 (declare report)

-(defn- run-test [project encoding opts]
+(defn- run-test
+  "Given a project name, an encoding and user provided options, run
+  tests against this project."
+  [project encoding opts]
   (println "testing" project "...")
   (let [command (str "../" project "/bin/roundtrip")]
     (if (= encoding :msgpack)
@@ -189,11 +249,20 @@
                   (assoc :project project))
               opts))))

-(defn verify-impl [project {:keys [enc] :as opts}]
+(defn verify-impl
+  "Given a project name like 'transit-java', 'transit-clj' or
+  'transit-ruby', and user provided options, run tests for each
+  encoding specified in the options. Encoding can be either `:json` or
+  `:msgpack`."
+  [project {:keys [enc] :as opts}]
   (doseq [e (if enc [enc] [:json :msgpack])]
     (run-test project e opts)))

-(defn verify-all [{:keys [impls] :as opts}]
+(defn verify-all
+  "Given user provided options, run all tests specified by the
+  options. If options is an empty map then run all tests against all
+  implementations for both encodings."
+  [{:keys [impls] :as opts}]
   (let [root (io/file "../")
         testable-impls (keep #(let [script (io/file root (str % "/bin/roundtrip"))]
                                 (when (.exists script) %))
@@ -205,7 +274,10 @@
                 (contains? impls impl))
         (verify-impl impl (assoc opts :generated-forms forms))))))

-(defn read-options [args]
+(defn read-options
+  "Given a sequence of strings which are the command line arguments,
+  return an options map."
+  [args]
   (reduce (fn [a [[k] v]]
             (case k
               "-impls" (assoc a :impls (set (mapv #(str "transit-" %) v)))


updating per page

updating per page

--- web/celestial/routes/common.clj
+++ web/celestial/routes/common.clj
@@ -1,5 +1,5 @@
 (ns celestial.routes.common)

-(def per-page 5)
+(def per-page 15)

 (def base {:project-name "Celestial" :title "Celestial" :per-page per-page})