Removed old comments

Removed old comments

--- src/cfpb/qu/data.clj
+++ src/cfpb/qu/data.clj
@@ -1,7 +1,3 @@
-;; TODO: reverse how this works.
-;; data should _only_ talk to the DB with very specific inputs from a query
-;; the query namespace should handle getting the results
-
 (ns cfpb.qu.data
   "This namespace contains all our functions for retrieving data from
 MongoDB, including creating queries and light manipulation of the data


Print stack trace when 500 error is throwed.

--- src/uxbox/frontend/errors.clj
+++ src/uxbox/frontend/errors.clj
@@ -24,6 +24,7 @@

 (defmethod handle-exception :default
   [err]
+  (.printStackTrace err)
   (let [response (select-keys (ex-data err) [:type :payload])
         response (assoc response :message (.getMessage err))]
     (http/internal-server-error (rsp response))))


fix missing sente-id

fix missing sente-id

--- src/pc/server.clj
+++ src/pc/server.clj
@@ -314,7 +314,7 @@
   (fn [req]
     (let [sente-id (or (get-in req [:session :sente-id])
                        (str (UUID/randomUUID)))]
-      (if-let [response (handler req)]
+      (if-let [response (handler (assoc-in req [:session :sente-id] sente-id))]
         (assoc-sente-id req response sente-id)))))

 (defn handler [sente-state]


CMR-1772: Added test to check syncing of revision ids between virtual granules and the corresponding real granules.

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -185,10 +185,39 @@
           (search/find-refs :granule {:entry-title (:entry-title vp-coll)
                                       :page-size 50}))))))

-
-
-
-
-
-
-
+(defn- virtual-granules-attrs
+  "Get the values of the attribute 'field' from the search references returned by searching for all
+  the granules of the collections vp-colls"
+  [vp-colls field]
+  (mapcat #(map field (:refs (search/find-refs
+                             :granule {:entry-title (:entry-title %) :page-size 50}))) vp-colls))
+
+(defn- assert-mdb-revision-ids-equal
+  "Assert that the concepts with the given concept-ids and revision-id exist in mdb"
+  [concept-ids revision-id]
+  (apply = true (map #(ingest/concept-exists-in-mdb? % revision-id) concept-ids)))
+
+;; Verify that latest revision ids of virtual granules and the corresponding real granules
+;; are in sync as various ingest operoations are performed on the real granule
+(deftest revision-ids-in-sync-test
+  (let [ast-coll (d/ingest "LPDAAC_ECS"
+                           (dc/collection
+                             {:entry-title "ASTER L1A Reconstructed Unprocessed Instrument Data V003"}))
+        vp-colls (ingest-virtual-collections [ast-coll])
+        granule-ur "SC:AST_L1A.003:2006227720"
+        ast-l1a-gran (dg/granule ast-coll {:granule-ur granule-ur})
+        ingest-result (d/ingest "LPDAAC_ECS" (assoc ast-l1a-gran :revision-id 5))
+        _ (index/wait-until-indexed)
+        vp-granule-ids (virtual-granules-attrs vp-colls :id)]
+    ;; check revision ids are synced due to ingest/update operations
+    (is (apply = 5 (virtual-granules-attrs vp-colls :revision-id)))
+    (d/ingest "LPDAAC_ECS" (assoc ast-l1a-gran :revision-id 10))
+    (index/wait-until-indexed)
+    (is (apply = 10 (virtual-granules-attrs vp-colls :revision-id)))
+    ;; check revision ids are synced due to delete operations
+    (ingest/delete-concept (d/item->concept ingest-result) {:revision-id 12})
+    (index/wait-until-indexed)
+    (is (assert-mdb-revision-ids-equal vp-granule-ids 12))
+    (ingest/delete-concept (d/item->concept ingest-result) {:revision-id 14})
+    (index/wait-until-indexed)
+    (is (assert-mdb-revision-ids-equal vp-granule-ids 14))))


Added call function to call other tasks in deftask

--- src/control/core.clj
+++ src/control/core.clj
@@ -159,7 +159,7 @@
         new-body (postwalk (fn [item]
                              (if (list? item)
                                (let [cmd (first item)]
-                                 (if (or (= cmd (symbol "ssh")) (= cmd (symbol "scp")) (= cmd (symbol "rsync")))
+                                 (if (or (= cmd (symbol "ssh")) (= cmd (symbol "scp")) (= cmd (symbol "rsync")) (= cmd (symbol "call")))
                                    (concat (list cmd  'host 'user 'cluster) (rest item))
                                    item))
                                item))
@@ -170,6 +170,13 @@
             ~(list 'fn
                    (vec (concat '[host user cluster] arguments))
                    (cons 'do new-body)))))
+
+(defn call
+  "Call another task in a task"
+  [host user cluster task & args]
+  (apply
+   (task @tasks)
+   host user cluster args))

 (defn- unquote-cluster [args]
   (walk (fn [item]


Properly integrated index generation into sitegen

--- src/omhome/ssgen.clj
+++ src/omhome/ssgen.clj
@@ -65,7 +65,7 @@
 (defn indices
   "Generate a map of index URLs to topic indices & the general index"
   []
-  {"/index.html" (topic-index) })
+  {"/index.html" (fn [req] (layout-page req (topic-index))) })

 (defn get-basic-pages []
   (stasis/merge-page-sources


Added opts-default & {:data-fn str/trim}

--- src/cooljure/csv.clj
+++ src/cooljure/csv.clj
@@ -42,12 +42,15 @@
   [csv-lines & {:as opts} ]
   { :pre  [ (string? csv-lines) ]
     :post [ (map? (first %)) ] }
-  (let [opts-def        (merge {:delimiter \,} opts)
-        parsed-lines    (apply csv/parse-csv csv-lines (keyvals opts-def))
+  (let [opts-default    {:delimiter \,  :data-fn str/trim}
+        opts-use        (merge opts-default opts)
+        parsed-lines    (apply csv/parse-csv csv-lines (keyvals opts-use))
         {:keys [labels-kw data-lines]}
                         (get-labels-and-data-lines opts parsed-lines)
+        data-fn         (:data-fn opts-use)
         row-maps        (for [data-line data-lines]
-                          (zipmap labels-kw data-line) )
+                          (zipmap labels-kw
+                                  (map #(data-fn %) data-line) ))
   ] row-maps ))

 ; AWTAWT TODO: clean up, enforce identical columns each row


Use validate-no-missing-elements for name & type

--- src/vip/data_processor/validation/v5/electoral_district.clj
+++ src/vip/data_processor/validation/v5/electoral_district.clj
@@ -2,28 +2,10 @@
   (:require [vip.data-processor.validation.v5.util :as util]))

 (def validate-no-missing-names
-  (util/build-xml-tree-value-query-validator
-   :errors :electoral-district :missing :missing-name
-   "SELECT xtv.path
-    FROM (SELECT DISTINCT subltree(path, 0, 4) || 'Name' AS path
-          FROM xml_tree_values WHERE results_id = ?
-          AND subltree(path, 0, 4) ~ 'VipObject.0.ElectoralDistrict.*{1}') xtv
-    LEFT JOIN (SELECT path FROM xml_tree_values WHERE results_id = ?) xtv2
-    ON xtv.path = subltree(xtv2.path, 0, 5)
-    WHERE xtv2.path IS NULL"
-   util/two-import-ids))
+  (util/validate-no-missing-elements :electoral-district :name))

 (def validate-no-missing-types
-  (util/build-xml-tree-value-query-validator
-   :errors :electoral-district :missing :missing-type
-   "SELECT xtv.path
-    FROM (SELECT DISTINCT subltree(path, 0, 4) || 'Type' AS path
-          FROM xml_tree_values WHERE results_id = ?
-          AND subltree(path, 0, 4) ~ 'VipObject.0.ElectoralDistrict.*{1}') xtv
-    LEFT JOIN (SELECT path FROM xml_tree_values WHERE results_id = ?) xtv2
-    ON xtv.path = subltree(xtv2.path, 0, 5)
-    WHERE xtv2.path IS NULL"
-   util/two-import-ids))
+  (util/validate-no-missing-elements :electoral-district :type))

 (def types
   #{"city" "city-council" "congressional" "county" "county-council" "judicial"


space

space

--- src/puny/core.clj
+++ src/puny/core.clj
@@ -35,7 +35,7 @@
   `(defn ~(<<< "gen-~{name*}") []
     (wcar (car/incr ~(<< "~{name*}:ids")))))

-(defn indices-fn-ids [name* ]
+(defn indices-fn-ids [name*]
   {:index-add (<<< "index-~{name*}") :index-del (<<< "clear-~{name*}-indices")
    :index-get (<<< "get-~{name*}-index") :reindex (<<< "reindex-~{name*}") })


Refactored to use proc-table

Refactored to use proc-table

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -40,22 +40,6 @@
   { :primary :primary_val } )

-(defn tables-drop-create []
-  (jdbc/with-db-connection [pg-conn pg-spec]
-    (doseq [ [table-name creation-sql-str] tables/table-name->creation-sql ]
-      (println (format "  drop/create: %s" table-name))
-      (jdbc/execute! pg-conn [ (format "drop table if exists %s cascade" table-name) ] )
-      (jdbc/execute! pg-conn [creation-sql-str] ))))
-
-(defn result-set->pg-insert [tbl-name-str result-set]
-  (jdbc/with-db-connection [pg-conn pg-spec]
-    (let [rows-inserted     (atom 0) ]
-      (doseq [rows-chunk (partition-all 1000 result-set) ]
-        (let [rows-chunk-new    (map #(set/rename-keys % column-name-corrections) rows-chunk) ]
-          (print (format "%7d  " (swap! rows-inserted + (count rows-chunk-new))))
-          (time
-            (apply jdbc/insert! pg-conn tbl-name-str rows-chunk-new  )))))))
-
 (defn oracle-set-context [ora-conn]
   (when-not large-db
     (jdbc/execute! ora-conn
@@ -86,30 +70,56 @@
   (println "-----------------------------------------------------------------------------")
 )

+(def enable-testing true)   ; #todo  FOR TESTING ONLY *******************************************
+(def test-rs-limit-fn       ; #todo  FOR TESTING ONLY *******************************************
+  (if enable-testing
+    #(take 1234 %)
+    identity ))
+
+(defn result-set->pg-insert [table-name table-rows result-set]
+  (jdbc/with-db-connection [pg-conn pg-spec]
+    (println (format "  drop/create: %s" table-name))
+    (newline)
+    (let [creation-sql-str (tables/table-name->creation-sql table-name) ]
+      (jdbc/execute! pg-conn [ (format "drop table if exists %s cascade" table-name) ] )
+      (jdbc/execute! pg-conn [creation-sql-str] ))
+
+    (let [rows-inserted     (atom 0)
+          result-set        (test-rs-limit-fn result-set) ]
+      (doseq [rows-chunk (partition-all 1000 result-set) ]
+        (let [rows-chunk-new    (map #(set/rename-keys % column-name-corrections) rows-chunk) ]
+          (print (format "%s: %7d/%7d  "    table-name
+                                            (swap! rows-inserted + (count rows-chunk-new))
+                                            table-rows ))
+          (time (apply jdbc/insert! pg-conn table-name rows-chunk-new  )))))
+
+    (newline)
+    (println table-name "query:")
+    (doseq [it (take 2 (jdbc/query pg-spec (format "select * from %s" table-name ))) ]
+      (newline)
+      (prn (into (sorted-map) it)))
+  ))
+
+(defn proc-table [table-name]
+  (jdbc/with-db-connection [ora-conn ora-spec]
+    (oracle-set-context ora-conn)
+    (let [table-rows    (-> (jdbc/query ora-conn
+                            [ (format "select count(*) as result from %s" table-name) ] )
+                        first
+                        :result
+                        long )
+    ]
+      (newline)
+      (println "-----------------------------------------------------------------------------")
+      (println "Transferring rows from Oracle to Postgres:" table-name "  rows:" table-rows)
+      (jdbc/query ora-conn [ (format "select * from %s" table-name) ]
+        :result-set-fn  #(result-set->pg-insert table-name table-rows %) )
+    )))
+
 (defn transfer-data []
   (newline)
-  (println "Initializing tables:")
-  (tables-drop-create)
-
-  (jdbc/with-db-connection [ora-conn ora-spec]
-    (oracle-set-context ora-conn)
-    (doseq [ table-name (keys tables/table-name->creation-sql) ]
-      (newline)
-      (newline)
-      (println "-----------------------------------------------------------------------------")
-      (println "Transferring rows from Oracle to Postgres:" table-name "  rows:"
-        (-> (jdbc/query ora-conn [ (format "select count(*) as result from %s" table-name) ] )
-            first
-            :result
-            long ))
-      (jdbc/query ora-conn [ (format "select * from %s" table-name) ]
-        :result-set-fn  #(result-set->pg-insert table-name %) )
-      (newline)
-      (println "query:")
-      (doseq [it (take 2 (jdbc/query pg-spec (format "select * from %s" table-name ))) ]
-        (newline)
-        (prn (into (sorted-map) it)))
-    ))
+  (doseq [table-name (keys tables/table-name->creation-sql) ]
+    (proc-table table-name))
   (newline))

 (defn -main []


Resize plots witih window.

Resize plots witih window.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -34,18 +34,16 @@
   (ajax-get (str "/latest/" series-name) cb))

 (defn fetch-series-data [ series-name query-window-secs cb ]
-  (watch [:fetch series-name])
   (ajax-get (str "/data/" series-name "?query-window-secs=" query-window-secs)
             (fn [ data ]
-              (watch [:response series-name])
               (cb data))))

 (defn tsplot-fetch-and-draw [ canvas series-name width ]
   (let [ ctx (.getContext canvas "2d")]
     (go
-      (tsplot/draw ctx width 180 (<! (<<< fetch-series-data
-                                         series-name
-                                         @query-window-secs))))))
+      (tsplot/draw ctx width 180  (<! (<<< fetch-series-data
+                                           series-name
+                                           @query-window-secs))))))

 (defn dom-width [ node ]
   (if node
@@ -58,18 +56,17 @@
      {:display-name (str "series-tsplot-" (:name series))
       :component-did-update
       (fn [ this ]
-        (tsplot-fetch-and-draw (reagent/dom-node this) (:name series) initial-width))
+        (tsplot-fetch-and-draw (reagent/dom-node this) (:name series) (dom-width (:dom-node @series-state))))

       :component-did-mount
       (fn [ this ]
-        (tsplot-fetch-and-draw (reagent/dom-node this) (:name series) initial-width))
+        (swap! series-state assoc :dom-node (.-parentNode (reagent/dom-node this)))
+        (tsplot-fetch-and-draw (reagent/dom-node this) (:name series) (dom-width (.-parentNode (reagent/dom-node this)))))

       :reagent-render
       (fn [ width ]
-        @query-window-secs
-        @series-state
         @window-width
-        [:canvas { :width 1024 :height 180}])})))
+        [:canvas { :width (dom-width (:dom-node @series-state)) :height 180}])})))

 (defn series-pane [ series ]
   (let [ pane-state (atom {})]
@@ -81,7 +78,6 @@

       :reagent-render
       (fn []
-        (watch :series-pane-reagent-render (dom-width (:dom-node @pane-state)))
         @window-width
         [:div.series-pane
          [:div.series-pane-header
@@ -118,7 +114,6 @@
    [:div.content
     [series-list]]])

-
 (defn on-window-resize [ evt ]
   (reset! window-width (.-innerWidth js/window)))


Minor refactoring to split plot from data access layer.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -24,9 +24,9 @@

 (defonce query-window (reagent/atom "1d"))

-(def dashboard-state (reagent/atom {:series [] :text ""}))
+(defonce dashboard-state (reagent/atom {:series [] :text ""}))

-(def window-width (reagent/atom nil))
+(defonce window-width (reagent/atom nil))

 (defn <<< [f & args]
   (let [c (chan)]
@@ -80,6 +80,14 @@
       (recur))
     channel))

+(defn subscribe-plot-data [ series series-state ]
+  (let [ channel (series-data-channel series (query-range-channel (periodic-event-channel 15000))) ]
+    (go-loop []
+      (let [ data (<! channel) ]
+        (when data
+          (swap! series-state assoc :series-data data)
+          (recur))))))
+
 (defn series-tsplot [ series qws-arg ]
   (let [dom-node (reagent/atom nil)
         series-state (reagent/atom {})]
@@ -98,12 +106,7 @@
       :component-did-mount
       (fn [ this ]
         (reset! dom-node (reagent/dom-node this))
-        (let [ channel (series-data-channel series (query-range-channel (periodic-event-channel 15000))) ]
-          (go-loop []
-            (let [ data (<! channel) ]
-              (when data
-                (swap! series-state assoc :series-data data)
-                (recur))))))
+        (subscribe-plot-data series series-state))

       :reagent-render
       (fn [ & rest ]


Added pixels warning

Added pixels warning

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -1657,7 +1657,9 @@
   "Array containing the values for all the pixels in the display
   window. This array is therefore the size of the display window. If
   this array is modified, the update-pixels fn must be called to update
-  the changes. Calls load-pixels before obtaining the pixel array."
+  the changes. Calls load-pixels before obtaining the pixel array.
+
+  Only works with P2D and P3D renderer."
   []
   (load-pixels)
   (.-pixels (current-surface)))


fix and and or for zero args

fix and and or for zero args

--- src/sledge/db.clj
+++ src/sledge/db.clj
@@ -118,19 +118,22 @@
 ;; in each constituent list

 (defmethod where "and" [index [_ & terms]]
-  (let [results (map #(into {} (where index %)) terms)
-        _ (println results)
-        paths (apply set/intersection (map #(set (keys %)) results))]
-    (map (fn [path]
-           [path (reduce * (map #(get % path) results))])
-         paths)))
+  (if terms
+    (let [results (map #(into {} (where index %)) terms)
+          paths (apply set/intersection (map #(set (keys %)) results))]
+      (map (fn [path]
+             [path (reduce * (map #(get % path) results))])
+           paths))
+    (map #(vector % 1) (keys @(:data index)))))

 (defmethod where "or" [index [_ & terms]]
-  (let [results (map #(into {} (where index %)) terms)
-        paths (apply set/union (map #(set (keys %)) results))]
-    (map (fn [path]
-           [path (reduce max (map #(get % path 0) results))])
-         paths)))
+  (if terms
+    (let [results (map #(into {} (where index %)) terms)
+          paths (apply set/union (map #(set (keys %)) results))]
+      (map (fn [path]
+             [path (reduce max (map #(get % path 0) results))])
+           paths))
+    []))

 (defn by-pathname [index pathname]


Truncate text in huge table cells

Truncate text in huge table cells

--- src/tesq/html.clj
+++ src/tesq/html.clj
@@ -8,7 +8,7 @@
 			))

-(def big-text 100) ; anything bigger justifies textarea
+(def big-text 200) ; anything bigger justifies truncation or textarea

 (defn- read-only?
@@ -21,10 +21,9 @@
 (defn- truncate
   "If string is too long, cut short and append ellipsis."
   [s]
-  (let [limit 250]
-	(if (< limit (count s))
-	  (str (apply str (take limit s)) "... (more)")
-	  s)))
+  (if (< big-text (count (str s)))
+	(str (apply str (take big-text (str s))) "... (more)")
+	s))

 (defn rows->table
@@ -58,7 +57,7 @@
 	(for [[k v] row]
 	  [:tr
 	   [:td k]
-	   [:td v]])]
+	   [:td (truncate v)]])]
    [:button [:a {:href (str "/edit?table=" table "&id=" (:id row))} "Edit"]]
    ))


Fix: rename a test to make it run

Fix: rename a test to make it run

The renamed test is redeclared later in the same namespace
causing the original one to not be run with `lein test`.

--- test/clj/reitit/http_test.clj
+++ test/clj/reitit/http_test.clj
@@ -171,7 +171,7 @@
           (testing "handler rejects"
             (is (= -406 (:status (app {:request-method :get, :uri "/pong"}))))))))))

-(deftest default-options-handler-test
+(deftest deprecated-default-options-handler-test
   (testing "Assertion fails when using deprecated options-handler"
     (is (thrown? ExceptionInfo (ring/router [] {::ring/default-options-handler (fn [_])})))))


add CLJS-411 test cases

add CLJS-411 test cases

--- test/cljs/cljs/core_test.cljs
+++ test/cljs/cljs/core_test.cljs
@@ -1699,5 +1699,18 @@

   (assert (= 2 (-bar (baz inc) 1)))

+  ;; CLJS-411
+
+  (assert (= "original" (let [x "original"
+                              oce (fn [] x)
+                              x "overwritten"]
+                          (oce))))
+
+
+  (letfn [(x [] "original")
+          (y [] (x))]
+    (let [x (fn [] "overwritten")]
+      (assert (= "original" (y)))))
+
   :ok
   )


Use goog.typeOf instead of object? to be compatible with iframe

--- src/javascript_externs_generator/extern.cljs
+++ src/javascript_externs_generator/extern.cljs
@@ -1,6 +1,7 @@
 (ns javascript-externs-generator.extern
   (:require [goog.dom :as dom]
             [goog.object :as obj]
+            [goog :as g]
             [clojure.string :as string]))

 (defn get-type
@@ -13,7 +14,7 @@
 (defn parent-type?
   "Whether it is possible for this object to have child properties"
   [obj]
-  (or (object? obj)
+  (or (= (g/typeOf obj) "object")
       (fn? obj)))

 (defn build-tree


Refactor

Refactor

--- backend/src/akvo/lumen/auth.clj
+++ backend/src/akvo/lumen/auth.clj
@@ -141,9 +141,6 @@
                                     (handler request)
                                     not-authorized)
               :else not-authorized))
-          (catch java.util.concurrent.TimeoutException e
-            (log/info (.getMesage e))
-            service-unavailable)
           (catch Exception e
             (let [wrap-info (fn [e v] (log/info (.getMessage e)) v)]
               (case (-> e ex-data :response-code)


Remove seesaw tutorial

Remove seesaw tutorial

Does not belong here

--- stuff/seesaw-repl-tutorial.clj
+++ stuff/seesaw-repl-tutorial.clj
@@ -1,458 +0,0 @@
-; A REPL-based, annotated Seesaw tutorial
-; Please visit https://github.com/daveray/seesaw for more info
-;
-; This is a very basic intro to Seesaw, a Clojure UI toolkit. It covers
-; Seesaw's basic features and philosophy, but only scratches the surface
-; of what's available. It only assumes knowledge of Clojure. No Swing or
-; Java experience is needed.
-;
-; This material was first presented in a talk at @CraftsmanGuild in
-; Ann Arbor, MI.
-;
-; Dave Ray, December 2011
-
-
-; First install Leiningen (https://github.com/technomancy/leiningen) and
-; create a new project. In a terminal:
-;
-;    $ lein new hello-seesaw
-;    $ cd hello-seesaw
-;    $ edit project.clj and add [seesaw "1.2.2"] to :dependencies
-;    $ lein deps
-
-; Now let's start up the REPL and do some Seesaw stuff. Repl results are
-; marked with ;=> in the usual way.
-$ lein repl
-
-; Here we go. First will use Seesaw and stuff
-(use 'clojure.repl)
-;=> nil
-(use 'seesaw.core)
-;=> nil
-
-; Now before we create any UI stuff, tell Seesaw to try to make things look as
-; native as possible. This puts the menubar in the right place on Mac, etc.
-(native!)
-;=> nil
-
-; Now we'll start by making a frame to put stuff in. Most Seesaw widgets are
-; constructed with simple functions that take :keyword/value pairs.
-; (seesaw.core/frame) creates a new frame.
-(def f (frame :title "Get to know Seesaw"))
-;=> #'user/f
-
-; So now we have a frame, but we haven't displayed it yet. Usually, we
-; want to pack and show a frame. pack! just auto-sizes the frame for its
-; contents
-(-> f pack! show!)
-;=> #<JFrame ... >
-
-; Note that pack! and show! both return their argument so they can be chained.
-; This is true of most Seesaw functions with side-effects.
-;
-; At this point you should have a very small, very boring window on your screen.
-;
-;
-;               +-----------------------------+
-;               | Get to know Seesaw         x|
-;               +-----------------------------+
-;               |                             |
-;               +-----------------------------+
-;
-
-; The properties of a widget can be queried ...
-(config f :title)
-;=> "Get to know Seesaw"
-
-; ... and modified
-(config! f :title "No RLY, get to know Seesaw!")
-;=> #<JFrame ...>
-
-; Note that the title of the frame changed!
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               |                              |
-;               +------------------------------+
-
-
-; So we have an empty frame. Let's give it some content
-(config! f :content "This is some content")
-;=> #<JFrame ... >
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               | This is some content         |
-;               +------------------------------+
-
-; Now we have a frame with a label in it. When Seesaw sees something like a
-; string, it will create a label, mostly out of habit. Of course, we could
-; create a label ourselves ...
-(def lbl (label "I'm another label"))
-;=> #'user/lbl
-
-; and show it in the frame
-(config! f :content lbl)
-;=> #<JFrame ... >
-
-; You know, we're going to be doing that a lot. Let's make a function
-(defn display [content]
-  (config! f :content content)
-  content)
-;=> #'user/display
-
-(display lbl)
-
-; Like the frame, a label can be manipulated with (config!). We can set some
-; colors
-(config! lbl :background :pink :foreground "#00f")
-;=> #<JLabel ... >
-
-; Seesaw knows about CSS color names and codes. Notice how we can set as many
-; properties as we want with one (config!) call
-
-; We can change the font too
-(config! lbl :font "ARIAL-BOLD-21")
-;=> #<JLabel ... >
-
-; "FAMILY-STYLE-SIZE" is conventient, but using (seesaw.font/font) we get a
-; little more control
-(use 'seesaw.font)
-;=> nil
-(config! lbl :font (font :name :monospaced
-                         :style #{:bold :italic}
-                         :size 18))
-;=> #<JLabel ... >
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; So we know a little about labels now. How about a button?
-(def b (button :text "Click Me"))
-;=> #'user/b
-
-; Sometimes we might want to show a message ...
-(alert "I'm an alert")
-;=> nil
-
-; or get input from the user ...
-(input "What's your favorite color?")
-;=> "Blue"
-
-; Notice that both functions block until the popup is dismissed. They both
-; take an additional, initial argument which indicates which frame they're
-; associated with. Otherwise, they'll just pop up in the middle of your screen
-
-
-; Let's get back to our button and get him doing something...
-(display b)
-;=> #<JButton>
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               |+----------------------------+|
-;               ||                            ||
-;               ||          Click Me          ||
-;               ||                            ||
-;               |+----------------------------+|
-;               +------------------------------+
-;
-; Click it. Nothing happens.
-
-; Seesaw's (listen) function let's us register handler functions for events on
-; a widget. All buttons support an :action event. So,
-(listen b :action (fn [e] (alert e "Thanks!")))
-;=> #<core$juxt$fn__3775 clojure.core$juxt$fn__3775@2e46638f>
-
-; Now we can click the button and see something happen. The 'e' parameter
-; is an event object. Most of the time in Seesaw, an event object can be used
-; as a proxy for the widget that triggered the event. In this case, the button
-; becomes the "parent" of the alert, so it's placed nicely over our frame.
-
-; Also note that (listen) returned a function. Calling this function will
-; undo the effects of the (listen) call, i.e. unregister the listener
-(*1)
-;=> [...]
-
-; Now clicking does nothing again.
-
-; (listen) can register multiple event handlers at once
-(listen b :mouse-entered #(config! % :foreground :blue)
-          :mouse-exited  #(config! % :foreground :red))
-;=> #<core$juxt$fn__3775 clojure.core$juxt$fn__3775@2e46638f>
-
-; Move the mouse over the buttons to see the text color change. Again note
-; that we're using the event parameter as a proxy for the button. This
-; time with (config!).
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Now let's talk about a slightly more interesting widget, a listbox.
-(def lb (listbox :model (-> 'seesaw.core ns-publics keys sort)))
-;=> #<JList ...>
-(display lb)
-;=> #<JList ...>
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               |#abtract-panel################|
-;               | action                       |
-;               | add!                         |
-;               | add!*                        |
-;               | alert                        |
-;               +------------------------------+
-
-; (listbox)'s most important option is :model which can take any (finite)
-; sequence and display it. Items are displayed using (str) unless a custom
-; :renderer is used.
-
-; This listbox is ok, but our list doesn't fit in the frame and there's no
-; scrollbars. You can add scrolling to most widgets with (scrollable) ...
-(display (scrollable lb))
-;=> #<JScrollPane ... >
-
-; Now that we have a list, it'd be nice to know what its selection is. Seesaw
-; has a unified nice selection interface. If there's no selection we get nil
-(selection lb)
-;=> nil
-
-; Otherwise, we get the value:
-(selection lb)
-;=> abstract-panel
-(type *1)
-;=> clojure.lang.Symbol
-
-; Note we get the same objects out that we put in the :model above.
-
-; If we want multi-selection (shift/ctrl-click)
-(selection lb {:multi? true})
-;=> (action add! add!* alert)
-
-; Similarly, we can set the selection
-(selection! lb 'all-frames)
-;=> #<JList ... >
-
-; was all-frames selected for you too?
-
-; Finally, we might want to know when the selection changes. Everybody
-; supports the :selection event
-(listen lb :selection (fn [e] (println "Selection is " (selection e))))
-;=> #<core$juxt$fn__3775 clojure.core$juxt$fn__3775@2e46638f>
-
-; click around on the listbox and watch the selection print out.
-
-; and unregister as usual
-(*1)
-;=> [...]
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Now we come to editable text widgets. It's easy to make one
-(def field (display (text "This is a text field.")))
-;=> #<JTextField ... >
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               |                              |
-;               |                              |
-;               | This is a text field|        |
-;               |                              |
-;               |                              |
-;               +------------------------------+
-
-; A text field is a single line of text. You can query the text...
-(text field)
-;=> "This is a text field."
-
-; ... and change it programmatically
-(text! field "A new value")
-;=> #<JTextField ... >
-
-; ... and you can set the font, etc as usual with config
-(config! field :font "MONOSPACED-PLAIN-12" :background "#f88")
-;=> #<JTextField ... >
-
-
-; If you've got more than one line, you can make it multi-line...
-(def area (text :multi-line? true :font "MONOSPACED-PLAIN-14"
-                :text "This
-is
-multi
-line
-text"))
-;=> #<JTextArea ... >
-
-(display area)
-;=> #<JTextArea ... >
-;
-;               +------------------------------+
-;               | NO RLY, get to know Seesaw  x|
-;               +------------------------------+
-;               | This                         |
-;               | is                           |
-;               | multi                        |
-;               | line|                        |
-;               +------------------------------+
-
-
-; If you've got a reader, URL, or anything else slurp-able, you can fill up the
-; text area with it
-(text! area (java.net.URL. "http://clojure.com"))
-;=> #<JTextArea ... >
-
-; Of course, we need scrollbars now
-(display (scrollable area))
-;=> #<JTextArea ... >
-
-; Like selection, Seesaw has a unified scrolling API. You can scroll to the top ...
-(scroll! area :to :top)
-;=> #<JTextArea ... >
-
-; ... or the bottom ...
-(scroll! area :to :bottom)
-;=> #<JTextArea ... >
-
-; ... or to a particular line ...
-(scroll! area :to [:line 50])
-;=> #<JTextArea ... >
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Let's try showing two widgets at once. One option is a splitter:
-(def split (left-right-split (scrollable lb) (scrollable area) :divider-location 1/3))
-;=> #'user/split
-
-(display split)
-;=> #<JSplitPane ... >
-;
-;
-;             +-------------------------------------+
-;             | NO RLY, get to know Seesaw         x|
-;             +-----------+-------------------------+
-;             |abstract-pa| This                    |
-;             |action     | is                      |
-;             |add!#######| multi                   |
-;             |add!*      | line|                   |
-;             +-----------+-------------------------+
-;
-
-; This shows both our listbox on the left and text area on the right with a
-; movable splitter. If you're familiar with Swing, you'll recognize what an
-; achievement :divider-location is.
-
-; Let's hook them together. First a function to grab a doc string
-(defn doc-str [s] (-> (symbol "seesaw.core" (name s)) resolve meta :doc))
-;=> #'user/doc-str
-
-; ... and now the usual selection handler
-(listen lb :selection
-        (fn [e]
-          (when-let [s (selection e)]
-            (-> area
-              (text!   (doc-str s))
-              (scroll! :to :top)))))
-;=> #<JList ... >
-
-; note how we have to be sure to check for nil selection
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Ok. We're pushing on the limits of what we can comfortably type in a REPL,
-; so just a couple more things ...
-
-; Imagine we wanted to show source as well as docs. A set of radio button might be
-; a nice way to switch betwen them ...
-
-(def rbs (for [i [:source :doc]]
-           (radio :id i :class :type :text (name i))))
-;=> #'user/rbs
-
-; we have a couple radio buttons. Let's add them to our frame. We'll use a
-; border-panel to lay things out. This is what a border-panel layout looks like:
-;
-;     +------------------------------------------+
-;     |                 :north                   |
-;     |                                          |
-;     +----------+-------------------+-----------+
-;     |          |                   |           |
-;     |          |                   |           |
-;     | :west    |       :center     |   :east   |
-;     |          |                   |           |
-;     |          |                   |           |
-;     +----------+-------------------+-----------+
-;     |                                          |
-;     |                 :south                   |
-;     +------------------------------------------+
-;
-
-
-(display (border-panel
-           :north (horizontal-panel :items rbs)
-           :center split
-           :vgap 5 :hgap 5 :border 5))
-;=> #<JPanel ...>
-
-; The :vgap, :hgap, and :border options just make things look a little nicer.
-
-; If you click the radio buttons, you'll notice a little problem. They're not
-; mutually exclusive. We'll put them in a button group to fix that, but first
-; a small detour...
-
-; How can we get to the radio buttons without using the rbs var? How about
-; with a selector:
-(select f [:JRadioButton])
-;=> (#<JRadioButton ... > #<JRadioButton ... >)
-
-; or, since we gave them a :class option above ...
-(select f [:.type])
-;=> (#<JRadioButton ... > #<JRadioButton ... >)
-
-; or, we can get them individually by :id
-(select f [:#source])
-;=> #<JRadioButton ... >
-
-; Selectors are always enclosed in a vector.
-
-; Now, about those buttons. We'll need a button group...
-(def group (button-group))
-;=> #'user/group
-
-; It happens that (config!) can take a sequence as its first argument in addition
-; to a single widget ...
-(config! (select f [:.type]) :group group)
-;=> (#<JRadioButton ... > #<JRadioButton ... >)
-
-; Now our buttons are nice and mutex-y. A button group, like most things, has a
-; selection too, whichever button is currently selected:
-(selection group)
-;=> #<JRadioButton ...>
-
-; Combine this with (id-of) and we have our original keywords back:
-(-> group selection id-of)
-;=> :source
-(-> group selection id-of)
-;=> :doc
-
-; and, of course, you can register a listener for group selection changes
-(listen group :selection
-        (fn [e]
-          (when-let [s (selection group)]
-            (println "Selection is " (id-of s)))))
-
-; Now open hello-seesaw.core.clj and see if you can put this all together into
-; an app.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; For more info see the Seesaw wiki:
-;    https://github.com/daveray/seesaw/wiki
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-


Refactor away configure-session

Refactor away configure-session

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -55,16 +55,13 @@
    :read    ContentCapability/READ
    :update  ContentCapability/UPDATE})

-(def transaction-mode
+(def transaction-modes
   "Enumeration of valid Session transaction modes. See
   https://docs.marklogic.com/javadoc/xcc/com/marklogic/xcc/Session.TransactionMode.html"
   {:auto Session$TransactionMode/AUTO
    :query Session$TransactionMode/QUERY
    :update Session$TransactionMode/UPDATE
    :update-auto-commit Session$TransactionMode/UPDATE_AUTO_COMMIT})
-
-;; For temporary backwards compatibility; TODO remove at next major version change
-(def transaction-modes transaction-mode)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -233,25 +230,6 @@
     ;; TODO test each
     request))

-(defn- configure-session
-  "Returns the given Session object, configured according to given
-  options map. Assumes correct types are passed: map
-  for :default-request-options, Logger object for :logger, Object
-  for :user-object, keyword for :transaction-mode, integer
-  for :transaction-timeout."
-  [session options]
-  (when-let [dro (:default-request-options options)]
-    (.setDefaultRequestOptions session (request-options dro)))
-  (when-let [lgr (:logger options)]
-    (.setLogger session lgr))
-  (when-let [uo (:user-object options)]
-    (.setUserObject session uo))
-  (when-let [tm (:transaction-mode options)]
-    (.setTransactionMode session (transaction-mode tm)))
-  (when-let [tt (:transaction-timeout options)]
-    (.setTransactionTimeout session tt))
-  session)
-

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Session management
@@ -296,8 +274,21 @@
   session.)"
   ([db-info]
    (create-session* db-info))
-  ([db-info {:keys [options]}]
-   (configure-session (create-session* db-info) options)))
+  ([db-info {:keys [default-request-options logger user-object
+                    transaction-mode transaction-timeout]}]
+   (let [session (create-session* db-info)]
+     (when (map? default-request-options)
+       (.setDefaultRequestOptions session (request-options default-request-options)))
+     (when (instance? Logger logger)
+       (.setLogger session logger))
+     ;; XXX the following is not the strictest test!
+     (when (instance? Object user-object)
+       (.setUserObject session user-object))
+     (when (keyword? transaction-mode)
+       (.setTransactionMode session (transaction-modes transaction-mode)))
+     (when (integer? transaction-timeout)
+       (.setTransactionTimeout session transaction-timeout))
+     session)))

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


Rework the API around a bunch of multimethods

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -2,223 +2,86 @@
   "This namespace serves to implement an abstraction layer for looking
   up examples, symbols, namespaces and artifacts as values without
   regard to the implementation of the datastore. Ports of Grimoire to
-  different datastores should only need to tweak this namespace."
+  different datastores should only need to extend the multimethods in
+  this namespace.")

-  (:refer-clojure :exclude [isa?])
-  (:require [grimoire.util :as util]
-            [grimoire.things :refer :all]
-            [clojure.java.io :as io]
-            [clojure.string :as string]
-            [clojure.edn :as edn]
-            [clj-semver.core :as semver]))
+(def dispatch (comp :mode :datastore))

 ;; Interacting with the datastore - reading
 ;;--------------------------------------------------------------------

-;; Private helpers for getting fs handles
-;;--------------------
-(defn- thing->handle
-  "Helper for grabbing handles for reading/writing.
+(defmulti list-groups
+  "Returns a sequence of Thing[:group] representing all Maven groups
+  in the queried datastore."

-  :meta     -> .edn file
-  :related  -> .txt
-  :notes    -> .md file
-  :examples -> dir"
+  {:arglists '[[config]]}
+  dispatch)

-  [{store :datastore} which thing]
-  (let [which-store (if-not (= :notes which)
-                      :docs :notes)
-        d           (get store which (which-store store))
-        parent      (:parent thing)
-        p           (io/file (str d "/" (when parent (thing->path parent))))
-        e           (case which
-                      (:meta)     ".edn"
-                      (:related)  ".txt"
-                      (:examples) "/examples/"
-                      (:notes)    ".md"
-                      nil)
-        n           (if (= :def (:type thing))
-                      (util/munge (:name thing))
-                      (:name thing))
-        h           (io/file p (str n e))]
-    (.mkdirs p)
-    (when (= :examples which)
-      (when-not (.isDirectory h)
-        (.mkdir h)))
-    h))

-(defn- thing->notes-handle
-  "Helper for grabbing the handle of a notes file "
+(defmulti list-artifacts
+  "Returns a sequence of Thing[:artifact] representing all Maven
+  artifacts in the queried datastore that belong to the specified
+  Thing[:group]."
+
+  {:arglists '[[config group-thing]]}
+  dispatch)

-  [c thing]
-  (thing->handle c :notes thing))
+(defmulti list-versions

-(defn- thing->example-handle
-  "Helper for getting a file handle for reading and writing a named example."
+  {:arglists '[[config artifact-thing]]}
+  dispatch)

-  [c thing name]
-  (let [h (thing->handle c :examples thing)]
-    (io/file h (str name ".clj"))))
+(defmulti list-namespaces

-(defn- thing->meta-handle
-  "Helper for getting a file handle for reading and writing meta"
+  {:arglists '[[config version-thing]]}
+  dispatch)

-  [c thing]
-  (let [h (thing->handle c :meta thing)]
-    h))
+(defmulti list-classes
+
+  {:arglists '[[config version-thing]]}
+  dispatch)

-(defn- thing->related-handle
-  "Helper for getting a file handle for reading and writing related files"
+(defmulti list-defs

-  [c thing]
-  (let [h (thing->handle c :related thing)]
-    h))
+  {:arglists '[[config namespace-thing]]}
+  dispatch)

-;; List things
-;;--------------------
-(defn list-groups [config]
-  (let [handle (io/file (-> config :datastore :docs))]
-    (for [d (.listFiles handle)
-          :when (.isDirectory d)]
-      (->T :group nil (.getName d)))))
-
-(defn list-artifacts [config thing]
-  (let [thing  (ensure-thing thing)
-        thing  (thing->group thing)
-        _      (assert thing)
-        handle (thing->handle config :else thing)]
-    (for [d (.listFiles handle)
-          :when (.isDirectory d)]
-      (->T :artifact thing (.getName d)))))
-
-(defn list-versions [config thing]
-  (let [thing    (ensure-thing thing)
-        artifact (thing->artifact thing)
-        _        (assert artifact)
-        handle   (thing->handle config :else artifact)]
-    (for [d     (.listFiles handle)
-          :when (.isDirectory d)]
-      (->T :version artifact (.getName d)))))
-
-(defn list-namespaces [config thing]
-  (let [thing   (ensure-thing thing)
-        _       (assert thing)
-        version (thing->version thing)
-        _       (assert version)
-        handle  (thing->handle config :else version)]
-    (for [d     (.listFiles handle)
-          :when (.isDirectory d)]
-      (->T :namespace version (.getName d)))))
-
-(defn list-defs [config thing]
-  (let [thing     (ensure-thing thing)
-        _         (assert thing)
-        namespace (thing->namespace thing)
-        _         (assert namespace)
-        handle    (thing->handle config :else namespace)]
-    (for [d     (.listFiles handle)
-          :when (.isFile d)]
-      (->T :def namespace (string/replace (.getName d) #".edn" "")))))
-
-(declare read-meta)
-
-;; FIXME: this should really be handled in data generation not in data use
-(defn normalize-version [x]
-  (if-not (re-matches #"[0-9]+.[0-9]+.[0-9]+" x)
-    (str x ".0")
-    x))
-
-(defn thing->prior-versions
+(defmulti thing->prior-versions
   "Returns a sequence of things representing itself at earlier or equal versions."

-  [config thing]
-  (let [thing    (ensure-thing thing)
-        currentv (thing->version thing)               ; version handle
-        current  (normalize-version (:name currentv)) ; version string
-        added    (-> config
-                     (read-meta thing)
-                     (get :added "1.0.0")             ; FIXME: added in 1.0.0 by default. OK for core.
-                     normalize-version)               ; version string
-        versions (->> (:parent currentv)
-                      (list-versions config))
-        unv-path (thing->relative-path :version thing)]
-    (for [v     versions
-          :when (or (semver/newer? (:name v) added)
-                    (semver/equal? (:name v) added))
-          :when (or (semver/older? (:name v) current)
-                    (semver/equal? (:name v) current))]
-      ;; FIXME: this could be a direct constructor given an
-      ;; appropriate vehicle for doing so since the type is directed
-      ;; and single but may not generally make sense if this is not
-      ;; the case.
-      (path->thing (str (thing->path v) "/" unv-path)))))
+  dispatch)

-;; Read things
-;;--------------------
-(defn read-notes
+
+(defmulti read-notes
   "Returns a sequence of pairs [version note-text] for all notes on
   prior or equal versions of the given thing."

-  [config thing]
-  (let [thing  (ensure-thing thing)]
-    (for [thing (thing->prior-versions config thing)
-          :let  [v (:name (thing->version thing))
-                 h (thing->notes-handle config thing)]
-          :when (.exists h)
-          :when (.isFile h)]
-      [v (slurp h)])))
+  {:arglists '[[config thing]]}
+  dispatch)

-(defn read-examples
+(defmulti read-examples
   "Returns a sequence of pairs [version example-text] for all examples on prior
   or equal versions of the given thing."

-  [config thing]
-  (let [thing  (ensure-thing thing)]
-    (for [thing (thing->prior-versions config thing)
-          :let  [v (:name (thing->version thing))
-                 h (thing->handle config :examples thing)]
-          ex    (.listFiles h)
-          :when (.isFile ex)]
-      [v (slurp ex)])))
+  {:arglists '[[config thing]]}
+  dispatch)

-(defn read-meta [config thing]
-  (let [thing  (ensure-thing thing)
-        handle (thing->meta-handle config thing)]
-    (when (.exists handle) ;; guard against missing files
-      (-> handle
-          slurp
-          (string/replace #"#<.*?>" "nil") ;; FIXME: Hack to ignore unreadable #<>s
-          edn/read-string))))
+(defmulti read-meta

-(defn read-related
+  {:arglists '[[config thing]]}
+  dispatch)
+
+(defmulti read-related
   "Returns a sequence of things representing symbols related to this or prior
   versions of the given symbol."

-  [config thing]
-  (let [thing  (ensure-thing thing)]
-    (for [thing (thing->prior-versions config thing)
-          :let  [v (:name (thing->version thing))
-                 h (thing->related-handle config thing)]
-          :when (.exists h)
-          :when (.isFile h)
-          line  (line-seq (io/reader h))]
-      (path->thing line))))
+  {:arglists '[[config thing]]}
+  dispatch)

 ;; Interacting with the datastore - writing
 ;;--------------------------------------------------------------------

-;; FIXME: Remove this update when 1.7 drops
-(defn update
-  "λ [{A → B} A (λ [B args*] → C) args*] → {A → C}
-
-  Updates a key in the map by applying f to the value at that key more
-  arguments, returning the resulting map."
-
-  [map key f & args]
-  (assoc map key
-         (apply f (get map key) args)))
-
-(defn write-meta
+(defmulti write-meta
   "Writes a map, being documentation data, into the datastore as specified by
   config at the def denoted by thing. Note that non-readable structures such as
   Namespaces must be stringified or removed by users. This function provides no
@@ -237,43 +100,29 @@
   - :redirect -> string being symbol name for implementing macro. only for {:type :sentinel}
   - :type     -> one of #{:macro :fn :var :special :sentinel}

-  Expected keys for namespace:
+  Expected keys for namespaces:
   - :doc      -> documentation string"

-  [config thing data]
-  (let [thing  (ensure-thing thing)
-        _      (assert thing)
-        handle (thing->meta-handle config thing)
-        _      (assert handle)]
-    (spit handle (pr-str data))
-    nil))
+  {:arglists '[[config thing data]]}
+  dispatch)

-(defn write-notes
+(defmulti write-notes
   "Writes a string into the datastore specified by the config at the path
   represented by thing. Note that thing need not be a def."

-  [config thing data]
-  {:pre [(string? data)
-         thing
-         config
-         (-> config :datastore :doc)]}
-  (let [thing  (ensure-thing thing)
-        _      (assert thing)
-        handle (thing->notes-handle config thing)
-        _      (assert thing)]
-    (spit handle data)))
+  {:arglists '[[config thing data]]}
+  dispatch)

-;; FIXME: add write-example
-(defn write-related
+(defmulti write-example
+  "Writes an example into the datastore specified by the config at the
+  path represented by thing. Note that thing need not be a def."
+
+  {:arglists '[[config thing data]]}
+  dispatch)
+
+(defmulti write-related
   "Writes a sequence of things representing defs into the datastore's
   related file as specified by the target thing."
-
-  [config thing related-things]
-  (let [thing  (ensure-thing thing)
-        _      (assert thing)
-        _      (assert (isa? :def thing))
-        handle (thing->related-handle config thing)
-        _      (assert thing)]
-    (doseq [thing related-things]
-      (spit handle (str (thing->path thing) \newline)
-            :append true))))
+
+  {:arglists '[[config thing related-things]]}
+  dispatch)


Add warning sign

Add warning sign

--- src/useful/state.clj
+++ src/useful/state.clj
@@ -91,7 +91,12 @@

    If you call the returned function with no arguments, it blocks until
    some cached value is available; with one not-found argument, it returns
-   the not-found value if no cached value has yet been computed."
+   the not-found value if no cached value has yet been computed.
+
+   Take care: if the duration you specify causes your task to be scheduled
+   again while it is still running, the task will wait in a queue. That queue
+   will continue to grow unless your task is able to complete more quickly
+   than the duration you specified."
     [f duration]
     (let [{:keys [unit num]} duration
           worker (agent {:ready false})


Formatting and removal of old comments

Formatting and removal of old comments

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -167,9 +167,7 @@
                                         ::http-response true}
                                        ctx)))

-                   (assoc-in ctx [:response :headers "last-modified"] (format-date last-modified))
-
-                   ))
+                   (assoc-in ctx [:response :headers "last-modified"] (format-date last-modified))))

                (do
                  (infof "No if-modified-since header: %s" (:headers req))
@@ -201,37 +199,45 @@
                      (rep/content-type-default state)))
                content-length (rep/content-length state)]

-           (d/chain
-
-            ;; Determine body
-            (cond
-              body (p/body body ctx)
-              state state         ; the state here can still be deferred
-              )
-
-            ;; serialize to representation (an existing string will be left intact)
-            (fn [state]
-              (rep/content state content-type))
-
-            ;; on nil, compose default result (if in dev)
-            #_(fn [x] (if x x (rep/content nil content-type)))
-
-            (fn [body]
-              (if (not= method :head)
-                (assoc-in ctx [:response :body] body)
-                ctx))
-
-            (fn [ctx]
-              (if content-type
-                (update-in ctx [:response :headers] assoc "content-type" content-type)
-                ctx
-                ))
-
-            (fn [ctx]
-              (if content-length
-                (update-in ctx [:response :headers] assoc "content-length" content-length)
-                ctx
-                ))))))
+           (case method
+             :head (if content-type
+                     ;; We don't need to add Content-Length,
+                     ;; Content-Range, Trailer or Tranfer-Encoding, as
+                     ;; per rfc7231.html#section-3.3
+                     (update-in ctx [:response :headers] assoc "content-type" content-type)
+                     ctx)
+
+             :get
+             (d/chain
+
+              ;; Determine body
+              (cond
+                body (p/body body ctx)
+                state state       ; the state here can still be deferred
+                )
+
+              ;; serialize to representation (an existing string will be left intact)
+              (fn [state]
+                (rep/content state content-type))
+
+              ;; on nil, compose default result (if in dev)
+              #_(fn [x] (if x x (rep/content nil content-type)))
+
+              (fn [body]
+                (if (not= method :head)
+                  (assoc-in ctx [:response :body] body)
+                  ctx))
+
+              (fn [ctx]
+                (if content-type
+                  (update-in ctx [:response :headers] assoc "content-type" content-type)
+                  ctx
+                  ))
+
+              (fn [ctx]
+                (if content-length
+                  (update-in ctx [:response :headers] assoc "content-length" content-length)
+                  ctx)))))))

       :post
       (d/chain
@@ -401,8 +407,7 @@
                        :path patch
                        :trace (p/trace? trace? ctx)
                        :options (or allow-origin)
-                       nil)
-                     )
+                       nil))
                   (do
                     (warnf "Method not allowed %s" method)
                     (d/error-deferred
@@ -568,34 +573,7 @@
                             [:body
                              [:h1 "Internal Server Error"]
                              [:p (str %)]
-                             [:pre (with-out-str (apply str (interpose "\n" (seq (.getStackTrace %)))))]
-                             ])}))))))))
-
-
-;; TODO: pets should return resource-metadata with a (possibly deferred) model
-
-;; handle-method-not-allowed 405 "Method not allowed."
-
-;; This is OK
-;; ((api-handler api) (mock/request :get "/persons"))
-
-;; This is should yield 405 "Method not allowed."
-;; ((api-handler api) (mock/request :get "/persons"))
-
-;; List of interesting things to do
-
-;; There should be a general handler that does the right thing
-;; wrt. available methods (Method Not Allowed) and calls out to
-;; callbacks accordingly. Perhaps there's no sense in EVERYTHING being
-;; overridable, as with Liberator. It should hard-code the things that
-;; don't make sense to override, and use hooks for the rest.
-
-;; Resource existence is most important - and not covered by swagger, so it's a key hook.
-
-;; Return deferreds, if necessary, if the computation is length to compute (e.g. for exists? checks)
-
-;; CORS support: build this in, make allow-origin first-class, which headers should be allowed should be a hook (with default)
-
+                             [:pre (with-out-str (apply str (interpose "\n" (seq (.getStackTrace %)))))]])}))))))))

 (defn yada [& args]
   (if (keyword? (first args))


fixing used key

fixing used key

--- src/kvm/provider.clj
+++ src/kvm/provider.clj
@@ -14,7 +14,7 @@
     [kvm.validations :refer (provider-validation)]
     [clojure.core.strint :refer (<<)]
     [kvm.clone :refer (clone-domain)]
-    [kvm.common :refer (connect)]
+    [kvm.common :refer (connect get-domain state)]
     [supernal.sshj :refer (ssh-up?)]
     [celestial.core :refer (Vm)]
     [taoensso.timbre :as timbre]
@@ -24,8 +24,8 @@

 (timbre/refer-timbre)

-(defn connection [{:keys [host user port]}]
-  (connect (<< "qemu+ssh://~{user}@~{host}:~{port}/system")))
+(defn connection [{:keys [host username port]}]
+  (connect (<< "qemu+ssh://~{username}@~{host}:~{port}/system")))

 (defmacro with-connection [& body]
   `(let [~'connection (connection ~'node)] (do ~@body)))
@@ -37,13 +37,24 @@
       (let [{:keys [image target]} domain]
         (clone-domain connection image target))))

-  (delete [this])
+  (delete [this]
+    (with-connection
+      (.destroy (get-domain connection (domain :name))))
+    )

-  (start [this])
+  (start [this]
+    (with-connection
+      (.create (get-domain connection (domain :name)))))

-  (stop [this])
+  (stop [this]
+    (with-connection
+      (.shutdown (get-domain connection (domain :name)))))

-  (status [this])
+  (status [this]
+    (with-connection
+      (state (get-domain connection (domain :name)))
+      )
+    )

   (ip [this]))

@@ -57,11 +68,10 @@
    (-> machine
      (mappings {:os :image :hostname :name})
      (transform (machine-ts machine))
-     (selections [[:name :user :image]])))
+     (selections [[:name :user :image :cpu :ram]])))

 (defmethod vconstruct :kvm [{:keys [kvm machine system-id] :as spec}]
    (let [[domain] (translate spec) {:keys [node]} kvm]
      (provider-validation domain)
-     (->Domain system-id (hypervisor* :kvm :nodes node) domain))
-  )
+     (->Domain system-id (hypervisor* :kvm :nodes node) domain)))


switch from :use to :require

switch from :use to :require

--- test/aspire/web_test.clj
+++ test/aspire/web_test.clj
@@ -1,8 +1,8 @@
 (ns aspire.web-test
-  (:use aspire.web
-        clojure.test
-        ring.mock.request
-        aspire.web-test-config))
+  (:require [aspire.web :as a-web]
+            [clojure.test :refer :all]
+            [ring.mock.request :as rmr]
+            [aspire.web-test-config :refer :all]))

 ;; web-test-config makes the mock ring requests to the resources
 ;; defined in web.clj. The resulting vars are available for testing here.


Pretty print js objects and eductions

Pretty print js objects and eductions

--- ClojureScript/replete/src/replete/pprint.cljs
+++ ClojureScript/replete/src/replete/pprint.cljs
@@ -1,7 +1,8 @@
 (ns replete.pprint
   (:refer-clojure :exclude [lift-ns])
   (:require [fipp.visit :refer [visit visit*]]
-            [fipp.engine :refer (pprint-document)]))
+            [fipp.engine :refer (pprint-document)]
+            [goog.object :as gobj]))

 (defn pretty-coll [{:keys [print-level print-length] :as printer}
                    open xs sep close f]
@@ -51,7 +52,21 @@
   fipp.visit/IVisitor

   (visit-unknown [this x]
-    [:text (pr-str x)])
+    (cond
+      (instance? Eduction x)
+      (visit this (sequence x))
+      (array? x)
+      (pretty-coll this "#js [" x :line "]" visit)
+      (object? x)
+      (let [kvs (map (fn [k]
+                       [(cond-> k (some? (re-matches #"[A-Za-z][\w\*\+\?!\-']*" k)) keyword)
+                        (gobj/get x k)])
+                  (js-keys x))]
+        (pretty-coll this "#js {" kvs [:span "," :line] "}"
+          (fn [printer [k v]]
+            [:span (visit printer k) " " (visit printer v)])))
+      :else
+      [:text (binding [*print-meta* false] (pr-str x))]))

   (visit-nil [this]


Add more DOM tests cases

Add more DOM tests cases

--- test/om_tools/dom_test.cljs
+++ test/om_tools/dom_test.cljs
@@ -58,7 +58,7 @@
   (testing "duplicate classes"
     (is (= "foo" (dom/class-set {:foo true "foo" true})))))

-(deftest element
+(deftest element-test
   (testing "simple element"
     (is=el (dom/element js/React.DOM.a {:href "/"} ["foo" "bar"])
            (om-dom/a #js {:href "/"} "foo" "bar")))
@@ -75,7 +75,7 @@
     (is=el (dom/element js/React.DOM.label {:for "bar"} "foo")
            (om-dom/label #js {:htmlFor "bar"} "foo"))))

-(deftest om-equiv
+(deftest om-equiv-test
   (testing "simple tag"
     (is=el (dom/a "test") (om-dom/a nil "test")))

@@ -89,9 +89,17 @@
     (is=el (dom/div {:dangerouslySetInnerHTML {:__html "
foo
"}})
            (om-dom/div #js {:dangerouslySetInnerHTML #js {:__html "
foo
"}})))

-  (testing "runtime template"
+  (testing "runtime opts"
     (is=el (dom/a (when true {:href "/test"}) "test")
            (om-dom/a (when true #js {:href "/test"}) "test")))
+
+  (testing "runtime children"
+    (is=el (dom/a (when true "foo") "bar")
+           (om-dom/a nil (when true "foo") "bar"))
+    (is=el (dom/a (when true "foo"))
+           (om-dom/a nil (when true "foo")))
+    (is=el (dom/a (when true "foo") ["bar" "baz"])
+           (apply om-dom/a nil (when true "foo") ["bar" "baz"])))

   (testing "runtime flatten"
     (is=el (dom/a (when true {:href "/test"}) ["foo" ["bar"]])


Add tests for equality and meta testing

Add tests for equality and meta testing

--- test/protobuf/core_test.clj
+++ test/protobuf/core_test.clj
@@ -59,6 +59,21 @@
     (let [p (dissoc p :label :tags)]
       (is (= nil (:tags p)))
       (is (= nil (:label p))))))
+
+(deftest test-equality
+  (let [m {:id 5 :tags ["fast" "shiny"] :label "nice"}
+        p (protobuf Foo :id 5 :tags ["fast" "shiny"] :label "nice")
+        q (protobuf Foo :id 5 :tags ["fast" "shiny"] :label "nice")]
+    (is (= m p))
+    (is (= q p))))
+
+(deftest test-meta
+  (let [p (protobuf Foo :id 5 :tags ["fast" "shiny"] :label "nice")
+        m {:foo :bar}
+        q (with-meta p m)]
+    (is (empty? (meta p)))
+    (is (= p q))
+    (is (= m (meta q)))))

 (deftest test-string-keys
   (let [p (protobuf Foo "id" 5 "label" "rad")]


DRY up SGR test with clojure.test/are

DRY up SGR test with clojure.test/are

--- test/asciinema_player/vt_test.cljs
+++ test/asciinema_player/vt_test.cljs
@@ -1,5 +1,5 @@
 (ns asciinema-player.vt-test
-  (:require-macros [cljs.test :refer (is deftest testing)]
+  (:require-macros [cljs.test :refer (is are deftest testing)]
                    [asciinema-player.vt-test :refer [property-tests-multiplier]]
                    [clojure.test.check.clojure-test :refer (defspec)])
   (:require [cljs.test]
@@ -1697,28 +1697,31 @@
           all-on-params "1;3;4;5;7;31;42m"
           all-on-attrs {:bold true :italic true :underline true :blink true
                         :inverse true :fg 1 :bg 2}
-          expect-attrs #(is (= (-> %1 (feed-str "A") :lines ffirst last) %2))]
-      (expect-attrs (feed-csi vt "1m") {:bold true})
-      (expect-attrs (feed-csi vt "3m") {:italic true})
-      (expect-attrs (feed-csi vt "4m") {:underline true})
-      (expect-attrs (feed-csi vt "5m") {:blink true})
-      (expect-attrs (feed-csi vt "7m") {:inverse true})
-      (expect-attrs (feed-csi vt "32m") {:fg 2})
-      (expect-attrs (feed-csi vt "43m") {:bg 3})
-      (expect-attrs (feed-csi vt "93m") {:fg 11})
-      (expect-attrs (feed-csi vt "104m") {:bg 12})
-      (expect-attrs (feed-csi vt "1;38;5;88;48;5;99;5m") {:fg 88 :bg 99 :bold true :blink true})
-      (expect-attrs (feed-csi vt all-on-params) all-on-attrs)
-      (expect-attrs (reduce feed-csi vt [all-on-params   "m"]) {}) ; implicit 0 param
-      (expect-attrs (reduce feed-csi vt [all-on-params  "0m"]) {}) ; explicit 0 param
-      (expect-attrs (reduce feed-csi vt [all-on-params "21m"]) (dissoc all-on-attrs :bold))
-      (expect-attrs (reduce feed-csi vt [all-on-params "22m"]) (dissoc all-on-attrs :bold))
-      (expect-attrs (reduce feed-csi vt [all-on-params "23m"]) (dissoc all-on-attrs :italic))
-      (expect-attrs (reduce feed-csi vt [all-on-params "24m"]) (dissoc all-on-attrs :underline))
-      (expect-attrs (reduce feed-csi vt [all-on-params "25m"]) (dissoc all-on-attrs :blink))
-      (expect-attrs (reduce feed-csi vt [all-on-params "27m"]) (dissoc all-on-attrs :inverse))
-      (expect-attrs (reduce feed-csi vt [all-on-params "39m"]) (dissoc all-on-attrs :fg))
-      (expect-attrs (reduce feed-csi vt [all-on-params "49m"]) (dissoc all-on-attrs :bg))))
+          compare-attrs #(= (-> %1 (feed-csi %2) (feed-str "A") :lines ffirst last) %3)]
+      (are [input-str expected-attrs] (compare-attrs vt input-str expected-attrs)
+        "1m" {:bold true}
+        "3m" {:italic true}
+        "4m" {:underline true}
+        "5m" {:blink true}
+        "7m" {:inverse true}
+        "32m" {:fg 2}
+        "43m" {:bg 3}
+        "93m" {:fg 11}
+        "104m" {:bg 12}
+        "1;38;5;88;48;5;99;5m" {:fg 88 :bg 99 :bold true :blink true}
+        all-on-params all-on-attrs)
+      (let [vt (feed-csi vt all-on-params)]
+        (are [input-str expected-attrs] (compare-attrs vt input-str expected-attrs)
+          "m" {} ; implicit 0 param
+          "0m" {} ; explicit 0 param
+          "21m" (dissoc all-on-attrs :bold)
+          "22m" (dissoc all-on-attrs :bold)
+          "23m" (dissoc all-on-attrs :italic)
+          "24m" (dissoc all-on-attrs :underline)
+          "25m" (dissoc all-on-attrs :blink)
+          "27m" (dissoc all-on-attrs :inverse)
+          "39m" (dissoc all-on-attrs :fg)
+          "49m" (dissoc all-on-attrs :bg)))))

   (testing "CSI !p (DECSTR)"
     (let [vt (-> (make-vt 4 4)


add tests for all custom helpers

add tests for all custom helpers

--- test/cheshire/test/core.clj
+++ test/cheshire/test/core.clj
@@ -239,3 +239,51 @@
     (is (= "bar" (json/decode (json/encode rec))))
     (gen/remove-encoder cheshire.test.core.TestR)
     (is (= {:state "quux"} (json/decode (json/encode rec) true)))))
+
+(defprotocol CTestP
+  (thing [this] "thing method"))
+(defrecord CTestR [state])
+(extend CTestR
+  CTestP
+  {:thing (constantly "thing")})
+
+(deftest t-custom-helpers
+  (let [thing (CTestR. :state)
+        remove #(gen/remove-encoder CTestR)]
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-nil nil jg)))
+    (is (= nil (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-str "foo" jg)))
+    (is (= "foo" (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-number 5 jg)))
+    (is (= 5 (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-long 4 jg)))
+    (is (= 4 (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-int 3 jg)))
+    (is (= 3 (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-ratio 1/2 jg)))
+    (is (= 0.5 (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-seq [:foo :bar] jg)))
+    (is (= ["foo" "bar"] (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-date (Date. 0) jg)))
+    (binding [gen/*date-format* "YYYY"]
+      (is (= "1970" (json/decode (json/encode thing) true))))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-bool true jg)))
+    (is (= true (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-named :foo jg)))
+    (is (= "foo" (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-map {:foo "bar"} jg)))
+    (is (= {:foo "bar"} (json/decode (json/encode thing) true)))
+    (remove)
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-symbol 'foo jg)))
+    (is (= "foo" (json/decode (json/encode thing) true)))
+    (remove)))


Flesh out Redis tests

Flesh out Redis tests

--- test/exploud/redis_test.clj
+++ test/exploud/redis_test.clj
@@ -7,7 +7,7 @@

 (binding [*dummy-connection* true]

-  (fact "Enqueuing something does the right thing"
+  (fact "that enqueuing something does the right thing"
         (enqueue ..task..) => ..id..
         (provided
          (car-mq/enqueue "scheduled-tasks" ..task..) => ..id..))
@@ -27,12 +27,94 @@
         (provided
          (car/del "exploud:lock") => ..result..))

-  (fact "Application/environment combination is not in-progress when not present"
+  (fact "that determining whether something is not paused when not present"
+        (paused? "app" "env" "region") => falsey
+        (provided
+         (car/hget "exploud:deployments:paused" "app-env-region") => nil))
+
+  (fact "that determining whether something is paused when present"
+        (paused? "app" "env" "region") => truthy
+        (provided
+         (car/hget "exploud:deployments:paused" "app-env-region") => "id"))
+
+  (fact "that getting paused deployments works"
+        (paused) => [{:application "app1" :environment "env1" :id "id1" :region "region1"}
+                     {:application "app2" :environment "env2" :id "id2" :region "region2"}]
+        (provided
+         (car/hgetall "exploud:deployments:paused") => ["app1-env1-region1" "id1" "app2-env2-region2" "id2"]))
+
+  (fact "that getting paused deployments works when nothing is paused"
+        (paused) => []
+        (provided
+         (car/hgetall "exploud:deployments:paused") => []))
+
+  (fact "that pausing a deployment is truthy when it wasn't already paused"
+        (pause "app" "env" "id" "region") => truthy
+        (provided
+         (car/hsetnx "exploud:deployments:paused" "app-env-region" "id") => 1))
+
+  (fact "that pausing a deployment is falsey when it wasn't already paused"
+        (pause "app" "env" "id" "region") => falsey
+        (provided
+         (car/hsetnx "exploud:deployments:paused" "app-env-region" "id") => 0))
+
+  (fact "that unpausing a deployment is truthy when it was already paused"
+        (resume "app" "env" "region") => truthy
+        (provided
+         (car/hdel "exploud:deployments:paused" "app-env-region") => 1))
+
+  (fact "that unpausing a deployment is falsey when it wasn't already paused"
+        (resume "app" "env" "region") => falsey
+        (provided
+         (car/hdel "exploud:deployments:paused" "app-env-region") => 0))
+
+  (fact "that determining whether a pause is registered is truthy when present"
+        (pause-registered? "app" "env" "region") => truthy
+        (provided
+         (car/sismember "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that determining whether a pause is registered is falsey when not present"
+        (pause-registered? "app" "env" "region") => falsey
+        (provided
+         (car/sismember "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that getting all deployments awaiting a pause works"
+        (awaiting-pause) => [{:application "app1" :environment "env1" :region "region1"}
+                             {:application "app2" :environment "env2" :region "region2"}]
+        (provided
+         (car/smembers "exploud:deployments:awaiting-pause") => ["app1-env1-region1" "app2-env2-region2"]))
+
+  (fact "that getting all deployments awaiting a pause works when there aren't any"
+        (awaiting-pause) => []
+        (provided
+         (car/smembers "exploud:deployments:awaiting-pause") => []))
+
+  (fact "that registering a pause is truthy when one wasn't already present"
+        (register-pause "app" "env" "region") => truthy
+        (provided
+         (car/sadd "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that registering a pause is falsey when one was already present"
+        (register-pause "app" "env" "region") => falsey
+        (provided
+         (car/sadd "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that unregistering a pause is truthy when one was present"
+        (unregister-pause "app" "env" "region") => truthy
+        (provided
+         (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 1))
+
+  (fact "that unregistering a pause is truthy when one was present"
+        (unregister-pause "app" "env" "region") => falsey
+        (provided
+         (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0))
+
+  (fact "that a deployment is not in-progress when not present"
         (in-progress? "app" "env" "region") => falsey
         (provided
          (car/hget "exploud:deployments:in-progress" "app-env-region") => nil))

-  (fact "Application/environment combination is in-progress when present"
+  (fact "that a deployment is in-progress when present"
         (in-progress? "app" "env" "region") => truthy
         (provided
          (car/hget "exploud:deployments:in-progress" "app-env-region") => "id"))
@@ -49,12 +131,12 @@
      :id "id"
      :region "region"})

-  (fact "Beginning a deployment when one doesn't exist gives true"
+  (fact "that beginning a deployment when one doesn't exist gives true"
         (begin-deployment begin-deployment-params) => true
         (provided
          (car/hsetnx "exploud:deployments:in-progress" "app-env-region" "id") => 1))

-  (fact "Beginning a deployment when one already exists give false"
+  (fact "that beginning a deployment when one already exists give false"
         (begin-deployment begin-deployment-params) => false
         (provided
          (car/hsetnx "exploud:deployments:in-progress" "app-env-region" "id") => 0))
@@ -64,13 +146,13 @@
      :environment "env"
      :region "region"})

-  (fact "Ending a deployment which exists returns true"
+  (fact "that ending a deployment which exists returns true"
         (end-deployment end-deployment-params) => true
         (provided
          (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0
          (car/hdel "exploud:deployments:in-progress" "app-env-region") => 1))

-  (fact "Ending a deployment which didn't exist returns false"
+  (fact "that ending a deployment which didn't exist returns false"
         (end-deployment end-deployment-params) => false
         (provided
          (car/srem "exploud:deployments:awaiting-pause" "app-env-region") => 0


Add missing gen import

Add missing gen import

--- test/icecap/crypto_test.clj
+++ test/icecap/crypto_test.clj
@@ -5,6 +5,7 @@
             [caesium.crypto.util :refer [array-eq]]
             [clojure.test :refer :all]
             [clojure.test.check.properties :as prop]
+            [clojure.test.check.generators :as gen]
             [clojure.test.check.clojure-test :refer [defspec]]))

 (defn scheme-roundtrip-prop


remove some logging

remove some logging

--- test/metabase/test_data.clj
+++ test/metabase/test_data.clj
@@ -51,9 +51,7 @@
 (def db-id
   "The ID of the test `Database`."
   (delay (assert @test-db)
-         (let [{id :id} @test-db]
-           (assert (integer? id))
-           id)))
+         (:id @test-db)))

 (defn field->id
   "Return the ID of a Field with FIELD-NAME belonging to Table with TABLE-NAME.
@@ -62,9 +60,7 @@
   [table-name field-name]
   {:pre [(keyword? table-name)
          (keyword? field-name)]
-   :post [(or (println % "<->" (type %))
-              true)
-          (integer? %)
+   :post [(integer? %)
           (not (zero? %))]}
   (-> @table-fields table-name field-name))

@@ -89,9 +85,7 @@
 (def org-id
   "The ID of the test Organization."
   (delay (assert @test-org)
-         (let [{id :id} @test-org]
-           (assert (integer? id))
-           id)))
+         (:id @test-org)))

 ;; ## Test Users


Uncommit the focus on a test

Uncommit the focus on a test

--- test/picard/test/server.clj
+++ test/picard/test/server.clj
@@ -167,7 +167,7 @@
         :binding nil
         :request [(includes-hdrs {"connection" "close"}) nil]))))

-(deftest ^{:focus true} aborting-a-request
+(deftest aborting-a-request
   (println "aborting-a-request")
   (with-channels
     [ch _]


Don't turn off continuous focus if the z stage is a continuous focus drive

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -118,7 +118,8 @@

 (defn set-z-stage-position [stage pos]
   (when-not (empty? stage)
-    (when (core isContinuousFocusEnabled)
+    (when (and (core isContinuousFocusEnabled)
+               (not (core isContinuousFocusDrive stage)))
       (core enableContinuousFocus false))
       (core setPosition stage pos)))


wrap test with in-memory db with (facts )

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -45,25 +45,25 @@

 ; ------------------------------------------------------------------------------

-; TODO wrap in (facts ...), maybe?
-(with-state-changes [(before :facts (reset! system (fresh-system (fn []) db-config-in-memory)))
-                     (after  :facts (component/stop @system))]
-  (log/info "starting tests with in-memory DB")
-  (fact "db exists"
-        (first (run-query (:db @system) :check [])) => {:check "passed"})
-  (fact "meta on query result only when requested"
-        (meta (run-query (:db @system) :check [] :debug true)) =not=> nil
-        (meta (run-query (:db @system) :check [])) => nil
-        (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check")) => nil
-        (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) =not=> nil)
-  (fact "meta contains :stmt"
-        (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:stmt "SELECT 'passed' as check"}))
-  (fact "meta contains :hits"
-        (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:hits 1}))
-  (fact "meta contains :time > 0"
-        (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:time pos?})
-        (meta (raw-jdbc-execute (:db @system) "CREATE TABLE new_tbl;" :debug true))  => (contains {:time pos?}))
-  (log/info "completed tests with in-memory DB"))
+(facts "with in-memory DB"
+  (with-state-changes [(before :facts (reset! system (fresh-system (fn []) db-config-in-memory)))
+                       (after  :facts (component/stop @system))]
+    (log/info "starting tests with in-memory DB")
+    (fact "db exists"
+          (first (run-query (:db @system) :check [])) => {:check "passed"})
+    (fact "meta on query result only when requested"
+          (meta (run-query (:db @system) :check [] :debug true)) =not=> nil
+          (meta (run-query (:db @system) :check [])) => nil
+          (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check")) => nil
+          (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) =not=> nil)
+    (fact "meta contains :stmt"
+          (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:stmt "SELECT 'passed' as check"}))
+    (fact "meta contains :hits"
+          (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:hits 1}))
+    (fact "meta contains :time > 0"
+          (meta (raw-jdbc-fetch (:db @system) "SELECT 'passed' as check" :debug true)) => (contains {:time pos?})
+          (meta (raw-jdbc-execute (:db @system) "CREATE TABLE new_tbl;" :debug true))  => (contains {:time pos?}))
+    (log/info "completed tests with in-memory DB")))

 (def write-query (str


added reversi solution

added reversi solution

--- src/main/cljc/clojure_club/x124_analyze_reversi/jstrength.cljc
+++ src/main/cljc/clojure_club/x124_analyze_reversi/jstrength.cljc
@@ -1,55 +1,23 @@
 (ns clojure-club.x124-analyze-reversi.jstrength
    (:require [clojure.test :refer :all]))

-(defn south [x]
-  (update x 0 inc))
-
-(defn reversi [board color]
-  (for [r (range 4)
-        c (range 4)]
-    (when (= color (get-in board [r c]))
-      (loop [r0 r
-             c0 c
-             cord-dirs #{:s :w :e :n}
-             paths {:s {} :w {} :e {} :n {}}]
-        (if (= 'b (get-in board [r0 c0]))
-
-          )
-        )
-      ))
-   )
-
-(rest (take-while #(< (% 0) 4) (iterate south [1 2])))
-
-(update [1 2] 0 inc)
-
-(defn reversi [board color]
-  (let [ret (for [r (range 1 4)
-                  c (repeat 1)
-                  :while (= (get-in board [r c]) 'b)]
-              (do
-                (println [r c])
-                [r c]))]
-    [(last ret) (rest ret)]))
-
-(defn find-next-empty [board start dir-fn]
-  (dir-fn
-    (last (take-while #(= 'b (get-in board %))
-                      (rest (iterate #(update % 1 inc) [0 1])))))
-  )
-
-(let [board '[[e w b b]]]
-  #_(take-while #(and (get-in board %) (not= (get-in board %) 'e))
-              (rest (iterate #(update % 1 inc) [0 1])))
-  (find-next-empty board [0 1] #(update % 1 inc))
-  #_(loop []
-
-    ))
-
-(reversi '[[e e e e]
-           [e w b e]
-           [e b w e]
-           [e e e e]] 'w)
+(defn reversi [b c]
+  (let [neighbors [[1 -1] [0 1] [1 0] [1 1]
+                   [-1 1] [0 -1] [-1 0] [-1 -1]]
+        opp (fn [c] (if (= c 'w) 'b 'w))
+        oob? (fn [[x y]] (or (< x 0) (< y 0) (> y 3) (> x 3)))]
+    (into {}
+          (filter (comp not nil?)
+                  (for [x (range 0 4)
+                        y (range 0 4)
+                        :when (= c (get-in b [x y]))
+                        n neighbors]
+                    (when (= (opp c) (get-in b (map + [x y] n)))
+                      (loop [d [x y]
+                             p []]
+                        (if (oob? d)
+                          nil (if (= 'e (get-in b d))
+                                {d (into (sorted-set) (vec (drop-last p)))} (recur (map + d n) (conj p (mapv + d n))))))))))))

 (deftest one
   (is (= {[1 3] #{[1 2]}, [0 2] #{[1 2]}, [3 1] #{[2 1]}, [2 0] #{[2 1]}}


Make open-all-datasets tests robust to file ordering

--- test/grafter/tabular_test.clj
+++ test/grafter/tabular_test.clj
@@ -89,15 +89,16 @@
       (is (seq? sheets) "should yield a seq")
       (is (= 2 (count sheets)) "should be 2 datasets")

-      (let [[loaded-csv-sheet loaded-excel-sheet] sheets]
-        (is (= loaded-csv-sheet csv-sheet))
-        (is (= loaded-excel-sheet excel-sheet))))
+      (let [read-data     (set sheets)
+            expected-data (set [csv-sheet excel-sheet])]
+        (is (= read-data expected-data))))
+
     (testing "with-metadata-columns"
-      (let [[csv-dataset excel-dataset] (open-all-datasets "./test/grafter" :metadata-fn with-metadata-columns)]
+      (let [[csv-dataset] (open-all-datasets "./test/grafter/test.csv" :metadata-fn with-metadata-columns)]
         (is (= (inc/$ 0 :file csv-dataset) "test.csv")
             "Should contain file name")

-        (is (re-find #"/test/grafter" (inc/$ 0 :path excel-dataset))
+        (is (re-find #"/test/grafter" (inc/$ 0 :path csv-dataset))
             "Should contain file path")))))

 (deftest make-dataset-tests


fix session creation after register.

fix session creation after register.

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -150,7 +150,7 @@

   (POST "/rest/v1/register" {params :params cookies :cookies}
       (let [user (register-user params)]
-        (json-response {"token" (auth-token user) "username" (:username user)} 200)))
+        (json-response {"token" (auth-token user) "username" (:username params)} 200)))

   (POST "/rest/v1/change-password" {params :params cookies :cookies}
     (json-response (change-password (user-from-cookie cookies) params)))


chmod + shebang cyclic dependency check

chmod + shebang cyclic dependency check

--- test/scripts/cyclic/foo/b.clj
+++ test/scripts/cyclic/foo/b.clj
@@ -1 +1,3 @@
+#!/usr/bin/env inlein
+
 '{:file-deps #{"foo/c.clj"}}


CMR-6318 removed commented out section

CMR-6318 removed commented out section

--- indexer-app/src/cmr/indexer/services/index_service.clj
+++ indexer-app/src/cmr/indexer/services/index_service.clj
@@ -307,12 +307,11 @@
   [context]
   (let [provider-ids (map :provider-id (meta-db/get-providers context))]
     (doseq [provider-id provider-ids]
-      (reindex-suggestions-for-provider context provider-id)
-      #_(try
-          (reindex-suggestions-for-provider context provider-id)
-          (catch Exception e (error (format "An error occurred while reindexing autocomplete suggestions in provider [%s] : %s"
-                                            provider-id
-                                            (.getMessage e))))))))
+      (try
+        (reindex-suggestions-for-provider context provider-id)
+        (catch Exception e (error (format "An error occurred while reindexing autocomplete suggestions in provider [%s] : %s"
+                                          provider-id
+                                          (.getMessage e))))))))

 (defn reindex-provider-collections
   "Reindexes all the collections in the providers given.


Fix atom-patch ordering

Fix atom-patch ordering

--- src/atom_finder/atom_patch.clj
+++ src/atom_finder/atom_patch.clj
@@ -90,6 +90,13 @@
     [(f (parse-source (commit-file-source repo parent-commit file-name)))
      (f (parse-source (commit-file-source repo rev-commit file-name)))]))

+(s/defn build-srcs
+  [source-before :- String source-after :- String]
+  {:ast-before (parse-source source-before)
+   :ast-after  (parse-source source-after)
+   :source-before source-before
+   :source-after  source-after})
+
 (s/defn before-after-data
   "Return the ast of changed files before/after a commit"
   [repo rev-commit :- RevCommit file-name]
@@ -103,13 +110,6 @@
       :patch-str  patch-str
       }
      (build-srcs source-before source-after))))
-
-(s/defn build-srcs
-  [source-before :- String source-after :- String]
-  {:ast-before (parse-source source-before)
-   :ast-after  (parse-source source-after)
-   :source-before source-before
-   :source-after  source-after})

 (defn atom-specific-srcs
   [srcs atom]


add lexical compilation rule for spanish: if no :obj, then set to :obj to :unspec.

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -860,6 +860,12 @@
 ;; argument-position-sensitive function.
 (def lexicon
   (-> (compile-lex lexicon-source morph/exception-generator morph/phonize)
+
+      ;; if a non-auxiliary verb has no :obj, then its {:obj is :unspec}.
+      (if-then {:synsem {:cat :verb
+                         :aux false
+                         :sem {:obj :unspec}}}
+               {:synsem {:sem {:obj :unspec}}})

       ;; make an intransitive version of every verb which has an
       ;; [:sem :obj] path.
@@ -867,7 +873,7 @@

       ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
       transitivize
-
+
       ;; if verb has no :aux, it's {:aux false}
       (if-then {:synsem {:cat :verb
                          :aux false}}


Add color collections related events.

Add color collections related events.

--- frontend/uxbox/data/dashboard.cljs
+++ frontend/uxbox/data/dashboard.cljs
@@ -86,9 +86,85 @@
   (reify
     rs/UpdateEvent
     (-apply-update [_ state]
-      (println "set-collection" id)
       (assoc-in state [:dashboard :collection-id] id))

     IPrintWithWriter
     (-pr-writer [mv writer _]
       (-write writer "#<event:u.d.d/set-collection>"))))
+
+(defn mk-color-collection
+  []
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (let [id (random-uuid)
+            coll {:name "Unnamed collection"
+                  :id id :colors #{}}]
+        (-> state
+            (assoc-in [:colors-by-id id] coll)
+            (assoc-in [:dashboard :collection-id] id)
+            (assoc-in [:dashboard :collection-type] :own))))
+
+    IPrintWithWriter
+    (-pr-writer [mv writer _]
+      (-write writer "#<event:u.d.d/mk-color-collection>"))))
+
+(defn rename-color-collection
+  [id name]
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (assoc-in state [:colors-by-id id :name] name))
+
+    IPrintWithWriter
+    (-pr-writer [mv writer _]
+      (-write writer "#<event:u.d.d/rename-color-collection>"))))
+
+(defn delete-color-collection
+  [id]
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (let [state (update state :colors-by-id dissoc id)
+            colls (sort-by :id (vals (:colors-by-id state)))]
+        (assoc-in state [:dashboard :collection-id] (:id (first colls)))))
+
+    IPrintWithWriter
+    (-pr-writer [mv writer _]
+      (-write writer "#<event:u.d.d/rename-color-collection>"))))
+
+(defn replace-color
+  "Add or replace color in a collection."
+  [{:keys [id from to] :as params}]
+  (sc/validate! +color-replace-schema+ params)
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (if-let [colors (get-in state [:colors-by-id id :colors])]
+        (as-> colors $
+          (disj $ from)
+          (conj $ to)
+          (assoc-in state [:colors-by-id id :colors] $))
+        state))
+
+    IPrintWithWriter
+    (-pr-writer [mv writer _]
+      (-write writer "#<event:u.d.d/replace-color>"))))
+
+(defn remove-color
+  "Remove color in a collection."
+  [{:keys [id color] :as params}]
+  (sc/validate! +remove-color-schema+ params)
+  (reify
+    rs/UpdateEvent
+    (-apply-update [_ state]
+      (if-let [colors (get-in state [:colors-by-id id :colors])]
+        (as-> colors $
+          (disj $ color)
+          (assoc-in state [:colors-by-id id :colors] $))
+        state))
+
+    IPrintWithWriter
+    (-pr-writer [mv writer _]
+      (-write writer "#<event:u.d.d/remove-color>"))))
+


Update fn wpml/run-properties to support Half Point Value

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -322,7 +322,7 @@
                            :w:cs font})) ; Complex Script Font
         (when font-size
           ;; Font Size
-          (node :w:sz {:w:val font-size}))
+          (node :w:sz {:w:val (* 2 font-size)})) ; Half Point Value = (2 x Point Value)
         (when font-color
           ;; Run Content Color
           (node :w:color {:w:val font-color}))


fix uploading files for new thread schema

--- src/braid/ui/views/thread.cljs
+++ src/braid/ui/views/thread.cljs
@@ -100,7 +100,7 @@
         open? (subscribe [:thread-open? (thread :id)])

         maybe-upload-file!
-        (fn [thread-id file]
+        (fn [thread file]
           (if (> (.-size file) max-file-size)
             (store/display-error! :upload-fail "File to big to upload, sorry")
             (do (set-uploading! true)
@@ -108,7 +108,8 @@
                                   (set-uploading! false)
                                   (dispatch! :new-message
                                              {:content url
-                                              :thread-id thread-id}))))))]
+                                              :group-id (thread :group-id)
+                                              :thread-id (thread :id)}))))))]

     (fn [thread]
       (let [{:keys [dragging? uploading? focused?]} @state
@@ -148,7 +149,7 @@
             (let [pasted-files (.. e -clipboardData -files)]
               (when (< 0 (.-length pasted-files))
                 (.preventDefault e)
-                (maybe-upload-file! (thread :id) (aget pasted-files 0)))))
+                (maybe-upload-file! thread (aget pasted-files 0)))))

           :on-drag-over
           (fn [e]
@@ -166,7 +167,7 @@
             (set-dragging! false)
             (let [file-list (.. e -dataTransfer -files)]
               (when (< 0 (.-length file-list))
-                (maybe-upload-file! (thread :id) (aget file-list 0)))))}
+                (maybe-upload-file! thread (aget file-list 0)))))}

          (when limbo?
            [:div.notice "No one can see this conversation yet. Mention a @user or #tag in a reply."])


format piece count numbers

format piece count numbers

--- src/client/pages/spectate.cljs
+++ src/client/pages/spectate.cljs
@@ -385,13 +385,13 @@
   "Called when we receive new piece stats from the server."
   [data-str]
   (let [piece-counts (read-string data-str)]
-    (dom/set-html! "pieceCountI" (:I piece-counts))
-    (dom/set-html! "pieceCountS" (:S piece-counts))
-    (dom/set-html! "pieceCountJ" (:J piece-counts))
-    (dom/set-html! "pieceCountT" (:T piece-counts))
-    (dom/set-html! "pieceCountL" (:L piece-counts))
-    (dom/set-html! "pieceCountZ" (:Z piece-counts))
-    (dom/set-html! "pieceCountO" (:O piece-counts))))
+    (dom/set-html! "pieceCountI" (util/format-number (:I piece-counts)))
+    (dom/set-html! "pieceCountS" (util/format-number (:S piece-counts)))
+    (dom/set-html! "pieceCountJ" (util/format-number (:J piece-counts)))
+    (dom/set-html! "pieceCountT" (util/format-number (:T piece-counts)))
+    (dom/set-html! "pieceCountL" (util/format-number (:L piece-counts)))
+    (dom/set-html! "pieceCountZ" (util/format-number (:Z piece-counts)))
+    (dom/set-html! "pieceCountO" (util/format-number (:O piece-counts)))))

 (defn on-time-left
   "Called when receiving time-left update from server."


Unused

Unused

--- integration-tests/src/test/clojure/immutant/integs/msg/priority.clj
+++ integration-tests/src/test/clojure/immutant/integs/msg/priority.clj
@@ -21,7 +21,6 @@
   (:use immutant.messaging))

 (def ham-queue "/queue/ham")
-(def biscuit-queue ".queue.biscuit")

 (use-fixtures :once (with-deployment *file*
                       {


Stop trying to convert Java maps, etc to clj

--- src/clinvar_submitter/core.clj
+++ src/clinvar_submitter/core.clj
@@ -62,18 +62,10 @@
                                (if (instance? List r) (some #(= % v) r) (= r v))))  m)
             (when (= v (ld-> t m ks)) m))))

-(defn convert-jsonld
-  "Convert java structures from jsonld library into clojure structures"
-  [m]
-  (walk/postwalk (fn [n] (cond
-                           (instance? Map n) (into {} n)
-                           (instance? List n) (into [] n)
-                           :else n)) m))
-
 (defn construct-symbol-table
   [coll]
   (let [graph (into [] (get coll "@graph"))]
-    (reduce (fn [acc v] (assoc acc (.get v "id") (convert-jsonld v))) {} graph)))
+    (reduce (fn [acc v] (assoc acc (.get v "id") v)) {} graph)))

 (defn flatten-interpretation
   []