Make the dummy reader view slightly more useful

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -42,6 +42,11 @@
          (set-page-key :site-list)
          (maybe-load-sites))))

+  (re-frame/reg-sub
+   :site-id
+   (fn [app-db _]
+     (:site-id app-db)))
+
   (re-frame/reg-event-db
    :view-comics
    (fn [db [_ site-id]]
@@ -51,17 +56,26 @@
          (assoc :site-id site-id
                 :comic-list :loading))))

+  (re-frame/reg-sub
+   :comic-id
+   (fn [app-db _]
+     (:comic-id app-db)))
+
   (re-frame/reg-event-db
    :read-comic
    (fn [db [_ comic-id]]
      (-> db
-         (set-page-key :reader)))))
+         (set-page-key :reader)
+         (assoc :comic-id comic-id
+                :loading-images true)))))

 (defn main-panel [page-key]
   (case page-key
     :site-list [site-list/site-list-container]
     :comic-list [comic-list/comic-page-container]
-    :reader [:div [:h1 "Read a Comic!"]]
+    :reader [:div [:h1 "Read a Comic!"]
+             [:pre (pr-str {:site-id @(re-frame/subscribe [:site-id])
+                            :comic-id @(re-frame/subscribe [:comic-id])})]]
     nil [:span ""]
     [base/four-oh-four]))


Correctly remove the waypoints on component unmounting

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -74,6 +74,9 @@
                                     :chapter chapter
                                     :page page}))})]
           (reset! waypoint wp)))
+      :componentWillUnmount
+      (fn []
+        (.destroy @waypoint))
       :reagent-render
       (fn [site location {:keys [tag]}]
         tag)})))


Add domain label beside story link

Add domain label beside story link

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -84,7 +84,8 @@
   (let [{:keys [id by title kids type time url score]} @data]
     (when id
       [:div.top-item
-       [:p.title [:a {:href url} title]]
+       [:p.title [:a {:href url} title]
+         [:span.comhead (str " (" (utils/domain url) ") ")]]
        [:p.subtext
         [anim-score {:value score}]
         (str " points by " by)
@@ -99,7 +100,8 @@
     (when (every? identity [by title score])
       [:li
        [:div
-        [:p.title [:a {:href url} title]]
+        [:p.title [:a {:href url} title]
+         [:span.comhead (str " (" (utils/domain url) ") ")]]
         [:p.subtext
          [anim-score {:value score}]
          (str " points by " by)


Add all game/to-ecn options to core/game-to-ecn.

--- src/clojure/clj_chess/core.cljc
+++ src/clojure/clj_chess/core.cljc
@@ -709,8 +709,8 @@
 (defn game-to-ecn
   "Exports the game as ECN data, optionally including comments and
   variations."
-  [game]
-  (g/to-ecn game))
+  [game & rest]
+  (apply g/to-ecn game rest))

 (defn game-from-ecn
   "Creates a game from ECN data."


Avro job configuration should override existing conf.

--- src/clojure/parkour/io/avro.clj
+++ src/clojure/parkour/io/avro.clj
@@ -99,17 +99,15 @@
 optional value schema `vs`.  Configures job output format to match
 when the output format has not been otherwise explicitly specified."
   ([^Job job ks]
-     (when (nil? (get-output-format job))
-       (lazy-output-format job AvroKeyOutputFormat))
      (doto job
        (set-data-model)
+       (.setOutputFormatClass AvroKeyOutputFormat)
        (AvroJob/setOutputKeySchema (avro/parse-schema ks))
        (.setOutputValueClass NullWritable)))
   ([^Job job ks vs]
-     (when (nil? (get-output-format job))
-       (lazy-output-format job AvroKeyValueOutputFormat))
      (doto job
        (set-data-model)
+       (.setOutputFormatClass AvroKeyValueOutputFormat)
        (AvroJob/setOutputKeySchema (avro/parse-schema ks))
        (AvroJob/setOutputValueSchema (avro/parse-schema vs)))))


Docstrings and tweaked interface for avro dseq/dsink.

--- src/clojure/parkour/io/avro.clj
+++ src/clojure/parkour/io/avro.clj
@@ -67,10 +67,12 @@
        (AvroJob/setMapOutputKeySchema (avro/parse-schema ks))
        (.setMapOutputValueClass NullWritable)))
   ([^Job job ks vs]
-     (doto job
-       (set-data-model)
-       (AvroJob/setMapOutputKeySchema (avro/parse-schema ks))
-       (AvroJob/setMapOutputValueSchema (avro/parse-schema vs)))))
+     (if (nil? vs)
+       (set-map-output ks)
+       (doto job
+         (set-data-model)
+         (AvroJob/setMapOutputKeySchema (avro/parse-schema ks))
+         (AvroJob/setMapOutputValueSchema (avro/parse-schema vs))))))

 (defn set-grouping
   "Configure `job` combine & reduce phases to group keys via schema `gs`,
@@ -95,7 +97,7 @@
   [job klass] (lazy-output-format* ^Job job ^Class klass))

 (defn set-output
-    "Configure `job` output to produce Avro with key schema `ks` and
+  "Configure `job` output to produce Avro with key schema `ks` and
 optional value schema `vs`.  Configures job output format to match
 when the output format has not been otherwise explicitly specified."
   ([^Job job ks]
@@ -115,7 +117,8 @@
   [x] (or (instance? Schema x) (keyword? x)))

 (defn dseq
-  "Distributed sequence of Avro input."
+  "Distributed sequence of Avro input, applying the vector of `schemas` as per
+the arguments to `set-input`, and reading from `paths`."
   [schemas & paths]
   (dseq/dseq
    (fn [^Job job]
@@ -124,7 +127,8 @@
        (FileInputFormat/addInputPath job (fs/path path))))))

 (defn shuffle
-  "Configuration step for Avro shuffle."
+  "Configuration step for Avro shuffle, with key schema `ks`, optional value
+schema `vs`, and optional grouping schema `gs`."
   ([ks] (mpartial set-map-output ks))
   ([ks vs] (mpartial set-map-output ks vs))
   ([ks vs gs]
@@ -132,7 +136,8 @@
       (mpartial set-grouping gs)]))

 (defn dsink
-  "Distributed sink for Avro output."
+  "Distributed sink for Avro output, applying the vector of `schemas` as per the
+arguments to `set-output`, and writing to `path`."
   [schemas path]
   (dsink/dsink
    (let [defaults (-> schemas count (repeat :default))]


toString method of implications now returns the same as print-method does

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -20,7 +20,9 @@
   (equals [this other]
     (generic-equals [this other] Implication [premise conclusion]))
   (hashCode [this]
-    (hash-combine-hash Implication premise conclusion)))
+    (hash-combine-hash Implication premise conclusion))
+  (toString [this]
+    (str "(" premise "  ==>  " conclusion ")")))

 (defmulti premise
   "Returns premise of given object."
@@ -41,7 +43,7 @@
 (defmethod print-method Implication
   [impl out]
   (.write ^java.io.Writer out
-          ^String (str "(" (premise impl) "  ==>  " (conclusion impl) ")")))
+          ^String (str impl)))

 (defn implication?
   "Returns true iff thing is an implication."


Added test that provider holdings are limited to what a user has access to.

--- test/cmr/system_int_test/search/provider_holdings_test.clj
+++ test/cmr/system_int_test/search/provider_holdings_test.clj
@@ -6,7 +6,8 @@
             [cmr.system-int-test.utils.index-util :as index]
             [cmr.system-int-test.data2.collection :as dc]
             [cmr.system-int-test.data2.granule :as dg]
-            [cmr.system-int-test.data2.core :as d]))
+            [cmr.system-int-test.data2.core :as d]
+            [cmr.system-int-test.utils.echo-util :as e]))

 ;; total number of collections in PROV1
 (def prov1-collection-count 5)
@@ -55,57 +56,79 @@
     {"PROV1" prov1-holdings
      "PROV2" prov2-holdings}))

-(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"}))
+(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"} false))

 (deftest retrieve-provider-holdings
+
+  ;; Grant all holdings to registered users
+  (e/grant-registered-users (e/coll-catalog-item-id "provguid1"))
+  (e/grant-registered-users (e/coll-catalog-item-id "provguid2"))
+
+  ;; Grant provider 1 holdings to guests
+  (e/grant-guest (e/coll-catalog-item-id "provguid1"))
+
   (let [all-holdings (create-holdings)
-        expected-all-holdings (set (flatten (vals all-holdings)))]
+        expected-all-holdings (set (flatten (vals all-holdings)))
+        guest-token (e/login-guest)
+        user-token (e/login "user1")]
     (testing "retrieve provider holdings in xml"
-      (let [response (search/provider-holdings-in-format :xml)]
+      (let [response (search/provider-holdings-in-format :xml {:token user-token})]
         (is (= 200 (:status response)))
         (is (= expected-all-holdings
                (set (:results response))))))
     (testing "retrieve provider holdings for list of providers in xml"
-      (let [response (search/provider-holdings-in-format :xml {:provider_id "PROV1"})]
+      (let [response (search/provider-holdings-in-format :xml {:provider_id "PROV1"
+                                                               :token user-token})]
         (is (= 200 (:status response)))
         (is (= (set (get all-holdings "PROV1"))
                (set (:results response)))))
-      (let [response (search/provider-holdings-in-format :xml {:provider_id ["PROV1" "PROV2"]})]
+      (let [response (search/provider-holdings-in-format :xml {:provider_id ["PROV1" "PROV2"]
+                                                               :token user-token})]
+        (is (= 200 (:status response)))
+        (is (= expected-all-holdings
+               (set (:results response))))))
+    (testing "retrieve provider holdings applies acls"
+      ;; Guests only have access to provider 1
+      (let [response (search/provider-holdings-in-format :xml {:token guest-token})]
+        (is (= 200 (:status response)))
+        (is (= (set (get all-holdings "PROV1"))
+               (set (:results response))))))
+    (testing "as extension"
+      (is (= (select-keys
+               (search/provider-holdings-in-format :xml {:provider_id "PROV1"
+                                                         :token user-token})
+               [:status :results])
+             (select-keys
+               (search/provider-holdings-in-format :xml
+                                                   {:provider_id "PROV1"
+                                                    :token user-token}
+                                                   {:format-as-ext? true})
+               [:status :results]))))
+    (testing "retrieve provider holdings in JSON"
+      (let [response (search/provider-holdings-in-format :json {:token user-token})]
+        (is (= 200 (:status response)))
+        (is (= expected-all-holdings
+               (set (:results response))))))
+    (testing "retrieve provider holdings for list of providers in JSON"
+      (let [response (search/provider-holdings-in-format :json {:provider_id "PROV1"
+                                                                :token user-token})]
+        (is (= 200 (:status response)))
+        (is (= (set (get all-holdings "PROV1"))
+               (set (:results response)))))
+      (let [response (search/provider-holdings-in-format :json {:provider_id ["PROV1" "PROV2"]
+                                                                :token user-token})]
         (is (= 200 (:status response)))
         (is (= expected-all-holdings
                (set (:results response))))))
     (testing "as extension"
       (is (= (select-keys
-               (search/provider-holdings-in-format :xml {:provider_id "PROV1"})
-               [:status :results])
-             (select-keys
-               (search/provider-holdings-in-format :xml
-                                                   {:provider_id "PROV1"}
-                                                   {:format-as-ext? true})
-               [:status :results]))))
-
-
-    (testing "retrieve provider holdings in JSON"
-      (let [response (search/provider-holdings-in-format :json)]
-        (is (= 200 (:status response)))
-        (is (= expected-all-holdings
-               (set (:results response))))))
-    (testing "retrieve provider holdings for list of providers in JSON"
-      (let [response (search/provider-holdings-in-format :json {:provider_id "PROV1"})]
-        (is (= 200 (:status response)))
-        (is (= (set (get all-holdings "PROV1"))
-               (set (:results response)))))
-      (let [response (search/provider-holdings-in-format :json {:provider_id ["PROV1" "PROV2"]})]
-        (is (= 200 (:status response)))
-        (is (= expected-all-holdings
-               (set (:results response))))))
-    (testing "as extension"
-      (is (= (select-keys
-               (search/provider-holdings-in-format :json {:provider_id "PROV1"})
+               (search/provider-holdings-in-format :json {:provider_id "PROV1"
+                                                          :token user-token})
                [:status :results])
              (select-keys
                (search/provider-holdings-in-format :json
-                                                   {:provider_id "PROV1"}
+                                                   {:provider_id "PROV1"
+                                                    :token user-token}
                                                    {:format-as-ext? true})
                [:status :results]))))))


Fix connection manager

Fix connection manager

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -112,7 +112,7 @@
 ;; Event logic
 (defn add-event-to-channel-with-pool
   [channel-id event]
-  (let [cm (make-reusable-conn-manager)
+  (let [cm (make-reusable-conn-manager {:threads 4 :timeout 10 :default-per-route 5})
         api-key (str "key=" (or (env :firebase-api-key) ""))
         added-event (add-event-to-channel-db channel-id event)]
     (map (fn [client-token]


Test.

Test.

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -104,7 +104,7 @@
   (http/post firebase-send-uri
              {:content-type :json
               :headers {"Authorization" (str "key=" (or (env :firebase-api-key) ""))}
-              :form-params (build-notification event client)}))
+              :form-params (build-notification event client-key)}))

 ;; Event logic
 (defn add-event-to-channel


to-split, splitted, mutliple requires

to-split, splitted, mutliple requires

--- src/hackerrank/clojure_libs.clj
+++ src/hackerrank/clojure_libs.clj
@@ -1,10 +1,19 @@
 ;; https://8thlight.com/blog/colin-jones/2010/12/05/clojure-libs-and-namespaces-require-use-import-and-ns.html
 ;; Clojure Libs and Namespaces: require, use, import, and ns

+(def to-split "name,address,city,state,zip,email,phone")
+(def splitted (clojure.string/split to-split #","))
+
 ;;; The baseline: require
 ;; witout require it should throw Exception
-;; (clojure.string/split "name,address,city,state,zip,email,phone" #",")
+(clojure.string/split to-split #",")

 ;; now should work
-(require 'clojure.string)
-(clojure.string/split "name,address,city,state,zip,email,phone" #",")
+;; (require 'clojure.string)
+;; (clojure.string/split to-split #",")
+
+;; mutliple requires
+;; every time new REPL - needed require
+(require 'clojure.string 'clojure.test)
+(clojure.string/join " " splitted)
+(clojure.test/is (= 1 2))


revert

revert

--- src/java_time/defconversion.clj
+++ src/java_time/defconversion.clj
@@ -64,7 +64,7 @@
                        (ex-info "Conversion failed"
                                 {:path (:path path#), :arguments ~args, :to ~tp}
                                 e#))))]
-       (if (seq? ~tp)
+       (if (instance? clojure.lang.ISeq ~tp)
          result#
          (first result#))
        (throw (ex-info


style

style

--- src/java_time/single_field.cljc
+++ src/java_time/single_field.cljc
@@ -22,8 +22,8 @@
 (defn- get-only-unit-value ^long [^TemporalAmount a, ^TemporalUnit u]
   (let [non-zero-units
         (->> (.getUnits a)
-             (map (fn [^TemporalUnit tu] (vector tu (.get a tu))))
-             (filter (fn [[_ uv]] (not (zero? uv)))))
+             (map (fn [^TemporalUnit tu] [tu (.get a tu)]))
+             (remove (fn [[_ uv]] (zero? uv))))
         [our-unit our-value] (first (filter (fn [[tu]] (= tu u)) non-zero-units))]
     (when-not our-unit
       (let [msg (format "No unit: %s found in %s!" u a)]


Add get-peer-site for dummy messenger.

Add get-peer-site for dummy messenger.

--- test/onyx/messaging/dummy_messenger.clj
+++ test/onyx/messaging/dummy_messenger.clj
@@ -4,6 +4,10 @@
 (defmethod extensions/assign-site-resources :dummy-messenger
   [config peer-site peer-sites]
   {:port 1})
+
+(defmethod extensions/get-peer-site :dummy-messenger
+  [replica peer]
+  "localhost")

 (defrecord DummyMessenger [peer-opts])


* Added many more comments * Consolidated keyboard and mouse scrub handlers * Changed mouse pointers to a resize icon when scrubbing

--- src/lt/plugins/lt_scrubber.cljs
+++ src/lt/plugins/lt_scrubber.cljs
@@ -1,14 +1,30 @@
+;; This is a Light Table plugin that will allow you to rapidly
+;; change the value of a number with the mouse or keyboard, then
+;; automatically evaluate your code so you can get instant feedback.
+;; It works great for visualizing CSS changes live, as well as
+;; for getting a feel for data flow thorugh Clojure/Clojurescript code
+;; with form-eval and watches.
+;;
+;; This code is largely a port of Peter Flynn's everyscrub extension
+;; for the Brackets editor: https://github.com/peterflynn/everyscrub
+;;
+;; I am also hugely inspired by Bret Victor's awesome work. In this case
+;; specifically Tangle (http://worrydream.com/Tangle/). I'm hoping
+;; we can push the limits of programming UX with Light Table!
+
+;; Here we're requiring the bare minimum Light Table namespaces
 (ns lt.plugins.lt-scrubber
   (:require [lt.object :as object]
             [lt.objs.command :as cmd]
             [lt.objs.editor :as editor]
-            [lt.objs.editor.pool :as pool])
+            [lt.objs.editor.pool :as pool]
+            [lt.util.dom :as dom])
   (:require-macros [lt.macros :refer [behavior]]))

 ;; These are some regex helper functions to find the position
 ;; of matches. This is currently not built into Clojurescript.
 ;; We will be using various regex to match for the different
-;; types of values that can be scrubbed
+;; types of values that can be scrubbed.
 ;;
 ;; http://stackoverflow.com/questions/18735665/how-can-i-get-the-positions-of-regex-matches-in-clojurescript
 (defn regex-modifiers
@@ -29,6 +45,7 @@
         res))))

 (comment (
+  ;; regex playground!
   (. (js/RegExp. (.-source #"-?\d*\.?\d+") (str "g")) exec "1 2 3")
   (. (js/RegExp. (.-source #"h") (str "g")) exec "this is h h")))

@@ -40,9 +57,6 @@
   (filter (fn [x]
             (let [[match-pos match-str] x
                   end-pos (+ match-pos (count match-str))]
-              (comment (print (str "match-pos: " match-pos ", "
-                           "target-pos: " target-pos ", "
-                           "end-pos: " end-pos)))
               (and (<= match-pos target-pos)
                        (>= end-pos target-pos))))
           (re-pos regex string)))
@@ -58,23 +72,10 @@
 (find-match-near-pos simple-number-regex "I have 1 cookie 30" 17)

 ;; We then parse a line of text using a
-;; TODO: is this extraneous?
+;; TODO: is this extraneous? maybe it'll be needed for multiple regex types
 (defn parse-for-scrub [line-text target-pos]
   (let [match (find-match-near-pos simple-number-regex line-text target-pos)]
     (flatten match)))
-
-(defn adder [x y]
-  (+ x y))
-
-(defn circle-radius [r]
-  (* 3.1492653 (* r r)))
-
-(adder 144 244)
-
-(circle-radius 219.6)
-
-;; This holds the global state for this plugin
-(def app-state (atom {:last-range 0}))

 ;; This returns the number of places to the right of a decimal point
 ;; in a string representation of an integer or floating point number
@@ -107,112 +108,108 @@
 (get-next-value "0.00" 1)
 (get-next-value "0.00" -1)

-;; When the user mouses down on a valid value, we are going to
-;; dynamically add and remove mousemove/mouseup handlers that
-;; will scrub the value up or down based on the mouse position
-(defn attach-scrub-handlers [e ed value-to-scrub pos]
-  (if (> (count value-to-scrub) 0)
-    (do
-      (. e (stopPropagation))
-      (. e (preventDefault))
-      (let [[scrub-pos scrub-value] value-to-scrub
+;; This holds the global state for this plugin
+(def app-state (atom {:last-range 0
+                      :origin ""}))
+
+;; This is where the magic happens. We update the selected value
+;; based on whether we are handling a continuous mouse scrub or
+;; a single keyboard nudge. Most of the logic is shared, except
+;; we need to dynamically add and remove mousemove/mouseup handlers.
+(defn handle-keyboard-or-mouse-scrub [{:keys [type delta e]}]
+  (if (or
+       (= type :keyboard)
+       ;; Alt-mouse click on window/linux, command-mouse on mac
+       (and (= type :mouse) (or (.-metaKey e) (.-altKey e))))
+      (let [ed (pool/last-active)
+            cm (editor/->cm-ed ed)
+
+            ;; We pick out the range of text that matches the regex
+            ;; based on the position of the mouse or the keyboard cursor.
+            pos  (condp = type
+                       :mouse (.. cm (coordsChar #js {:left (.-pageX e) :top (.-pageY e)}))
+                       :keyboard (.getCursor cm))
+            line-text (editor/line ed (.-line pos))
+            value-to-scrub (parse-for-scrub line-text (.-ch pos))
+            [scrub-pos scrub-value] value-to-scrub
             last-range {:start {:line (.-line pos)
                                 :ch scrub-pos}
                         :end {:line (.-line pos)
                               :ch (+ scrub-pos (count (str scrub-value)))}}
-            cm (editor/->cm-ed ed)
-            scroller (.getScrollerElement cm)
-            down-x (.-pageX e)
+
             last-text scrub-value
-            origin (str "*scrubber" (rand-int 100000)) ;; set unique label for undo. TODO: monotonic increment?
-            move-handler (fn [e]
-                           (. e (stopPropagation))
-                           (. e (preventDefault))
-                           (let [px-delta (- (.-pageX e) down-x)
-                                 val-delta (bit-or (/ px-delta 8) 0)
-                                 new-text (get-next-value scrub-value val-delta)
-                                 last-range (get-in @app-state [:last-range])]
-                             (if (not= new-text last-text)
-                               (do
-                                 (.replaceRange cm new-text
-                                                (clj->js (:start last-range))
-                                                (clj->js (:end last-range))
-                                                origin)
-                                 (swap! app-state update-in [:last-range :end :ch]
-                                        #(+ (get-in last-range [:start :ch]) (count new-text)))
-                                 (editor/set-selection ed pos) ;; temporarily deselect text, so entire form evals
-                                 (cmd/exec! :eval-editor-form) ;; TODO: speed this up somehow? avoid saves?
-                                 (editor/set-selection ed (:start last-range) (:end last-range))
-                                 ))))
-                             ]
+
+            ;; This is a unique string for CodeMirror's replaceRange, so that
+            ;; we can undo to before the beginning of a scrub action
+            origin (str "*scrubber" (:origin (swap! app-state update-in [:origin] inc)))
+
+            ;; This method performs the scrub after setting up the mouse or
+            ;; keyboard specific logic
+            do-scrub! (fn [val-delta]
+                        (let [new-text (get-next-value scrub-value val-delta)
+                              last-range (get-in @app-state [:last-range])]
+                          (if (not= new-text last-text)
+                            (do
+                              (.replaceRange cm new-text
+                                             (clj->js (:start last-range))
+                                             (clj->js (:end last-range))
+                                             origin)
+                              (swap! app-state update-in [:last-range :end :ch]
+                                     #(+ (get-in last-range [:start :ch]) (count new-text)))
+                              (editor/set-selection ed pos) ;; temporarily deselect text, so entire form evals
+                              (cmd/exec! :eval-editor-form) ;; TODO: is there anyway to speed this up?
+                              (editor/set-selection ed (:start last-range) (:end last-range)) ;; reselect text
+                              ))))]
+
+        ;; Update the state with this initial selected range before scrubbing
         (swap! app-state update-in [:last-range] (fn [] last-range))
-        (editor/set-selection ed (:start last-range) (:end last-range))
-        (.. window/document
-            (addEventListener "mousemove" move-handler))
-        (.. window/document
-            (addEventListener "mouseup"
-                              (fn [e]
-                                (.. window/document (removeEventListener "mousemove" move-handler)))))))))
-
-(defn mouse-down-fn* [e]
-  "Real handler for mouse-down on a LightTable editor pane"
-    (if (or (.-metaKey e)
-            (.-altKey e))
-      (let [ed (pool/last-active)
-            cm (editor/->cm-ed ed)
-            page-x (.-pageX e)
-            page-y (.-pageY e)
-            pos (.. cm (coordsChar #js {:left page-x :top page-y}))
-            line-text (editor/line ed (.-line pos))
-            value-to-scrub (parse-for-scrub line-text (.-ch pos))]
-        (attach-scrub-handlers e ed value-to-scrub pos))))
-
-;; TODO: can we just use the mouse-down-fn* directly?
+        (editor/set-selection ed (:start last-range) (:end last-range)) ;; select the matched value
+
+        ;; Input type specific handling
+        (condp = type
+          :mouse (let [scroller (.getScrollerElement cm)
+                       down-x (.-pageX e)
+
+                       ;; We want the mouse cursor to be a resizer, but to reset it
+                       ;; to whatever it used to be after the handler is removed.
+                       set-css-cursor (fn [cursors]
+                                        (let [[val-1 val-2 val-3] cursors]
+                                          (dom/css (dom/$ ".CodeMirror-lines") {:cursor val-1})
+                                          (dom/css (dom/$ ".CodeMirror-gutter-elt") {:cursor val-2})
+                                          (dom/css (dom/$ "html") {:cursor val-3})))
+                       old-css-cursors [(dom/css (dom/$ ".CodeMirror-lines") :cursor)
+                                        (dom/css (dom/$ ".CodeMirror-gutter-elt") :cursor)
+                                        (dom/css (dom/$ "html") :cursor)]
+
+                       ;; Scrub based on how far the mouse moves left or right from select value
+                       move-handler (fn [e]
+                                      (. e (stopPropagation))
+                                      (. e (preventDefault))
+                                      (let [px-delta (- (.-pageX e) down-x)
+                                            val-delta (bit-or (/ px-delta 8) 0)]
+                                        (do-scrub! val-delta)))]
+
+                   (set-css-cursor (repeat 3 "col-resize"))
+
+                   ;; Add the mouse handlers temporarily until mouse click is released
+                   (.. window/document (addEventListener "mousemove" move-handler))
+                   (.. window/document (addEventListener "mouseup"
+                     (fn [e]
+                       (.. window/document (removeEventListener "mousemove" move-handler))
+                       (set-css-cursor old-css-cursors)))))
+
+          :keyboard (do-scrub! delta)))))
+
+;; We send the mouse-event to the scrub handler method for processing
 (defn mouse-down-fn [e]
-  (mouse-down-fn* e))
+  (handle-keyboard-or-mouse-scrub {:type :mouse
+                                   :e e}))

 ;; We also support nudging a value by a small amount using the keyboard
+;; dir will be 1 for incrementing and -1 for decrementing
 (defn nudge [dir]
-  ;; handle keyboard specific
-  (let [ed (pool/last-active)
-        cm (editor/->cm-ed ed)
-        pos (.getCursor cm)
-        line-text (editor/line ed (.-line pos))
-        value-to-scrub (parse-for-scrub line-text (.-ch pos))
-        [scrub-pos scrub-value] value-to-scrub
-        last-text scrub-value
-        origin (str "*scrubber" (rand-int 100000)) ;; set unique label for undo. TODO: monotonic increment?
-                    last-range {:start {:line (.-line pos)
-                                :ch scrub-pos}
-                        :end {:line (.-line pos)
-                              :ch (+ scrub-pos (count (str scrub-value)))}}
-        ]
-    (print "nudge " dir)
-    (swap! app-state update-in [:last-range] (fn [] last-range))
-    (editor/set-selection ed (:start last-range) (:end last-range))
-    (let [new-text (get-next-value scrub-value dir)
-          last-range (get-in @app-state [:last-range])]
-      (if (not= new-text last-text)
-        (do
-          (.replaceRange cm new-text
-                         (clj->js (:start last-range))
-                         (clj->js (:end last-range))
-                         origin)
-          (swap! app-state update-in [:last-range :end :ch]
-                 #(+ (get-in last-range [:start :ch]) (count new-text)))
-          (editor/set-selection ed pos) ;; temporarily deselect text, so entire form evals
-          (cmd/exec! :eval-editor-form) ;; TODO: speed this up somehow? avoid saves?
-          (editor/set-selection ed (:start last-range) (:end last-range))
-                                 )))))
-
-;; TODO: can we just use an already existing behavior
-(behavior ::eval-on-change
-          :triggers #{:change}
-          ;;:debounce 200
-          :reaction (fn [this]
-                      (do
-                        (.log js/console "eval on change")
-                        (js/setTimeout #(cmd/exec! :eval-editor-form) 0))))
+  (handle-keyboard-or-mouse-scrub {:type :keyboard
+                                   :delta dir}))

 ;; This Light Table object template contains whether the
 ;; scrubber is active or not.


Envelope is marked sent even when it is expired

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/signals/core.cljs
+++ src/status_im/signals/core.cljs
@@ -55,7 +55,7 @@
       "node.stopped"       (status-node-stopped cofx)
       "module.initialized" (status-module-initialized cofx)
       "envelope.sent"      (transport.message/update-envelope-status cofx (:hash event) :sent)
-      "envelope.expired"   (transport.message/update-envelope-status cofx (:hash event) :sent)
+      "envelope.expired"   (transport.message/update-envelope-status cofx (:hash event) :not-sent)
       "bundles.added"      (pairing/handle-bundles-added cofx event)
       "mailserver.request.completed" (when (accounts.db/logged-in? cofx)
                                        (mailserver/update-mailserver-topics cofx {:request-id (:requestID event)


move util tasks to boot.task repo

move util tasks to boot.task repo

--- src/tailrecursion/boot/core.clj
+++ src/tailrecursion/boot/core.clj
@@ -42,32 +42,7 @@
         sel   #(select-keys % [:directories :dependencies :repositories])]
     (merge env task main (merge-with into (sel env) (sel task)))))

-;; TASKS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn make-event
-  ([]       {:id (gensym), :time (System/currentTimeMillis)})
-  ([event]  (merge event (make-event))))
-
-(defn pre-task
-  [boot & {:keys [process configure] :or {process identity configure identity}}]
-  (locking boot
-    (swap! boot configure)
-    (fn [continue]
-      (fn [event]
-        (continue (process event))))))
-
-(defn post-task
-  [boot & {:keys [process configure] :or {process identity configure identity}}]
-  (locking boot
-    (swap! boot configure)
-    (fn [continue]
-      (fn [event]
-        (process (continue event))))))
-
-(def identity-task pre-task)
-
-(defn config-task [boot configure]
-  (pre-task boot :configure configure))
+;; CORE TASKS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn help-task [boot]
   (let [tasks (map name (remove nil? (sort (keys (:tasks @boot)))))]
@@ -81,6 +56,10 @@
         (continue event)))))

 ;; BOOT API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn make-event
+  ([]       {:id (gensym), :time (System/currentTimeMillis)})
+  ([event]  (merge event (make-event))))

 (defn init! [env]
   (doto (atom env) (add-watch ::_ #(configure! %3 %4))))


Add the ability to invert matrix.

Add the ability to invert matrix.

--- src/uxbox/main/geom/matrix.cljs
+++ src/uxbox/main/geom/matrix.cljs
@@ -123,3 +123,21 @@
       (+ ty1 (* tx2 c1) (* ty2 d1)))))
   ([m om & others]
    (reduce append (append m om) others)))
+
+(defn ^boolean invertible?
+  [{:keys [a b c d tx ty] :as m}]
+  (let [det (- (* a d) (* c b))]
+    (and (not (mth/nan? det))
+         (mth/finite? tx)
+         (mth/finite? ty))))
+
+(defn invert
+  [{:keys [a b c d tx ty] :as m}]
+  (when (invertible? m)
+    (let [det (- (* a d) (* c b))]
+      (Matrix. (/ d det)
+               (/ (- b) det)
+               (/ (- c) det)
+               (/ a det)
+               (/ (- (* c ty) (* d tx)) det)
+               (/ (- (* b tx) (* a ty)) det)))))


successful just one call to atom!

successful just one call to atom!

--- statspop/src/statspop/core.cljs
+++ statspop/src/statspop/core.cljs
@@ -114,7 +114,7 @@
   [:div
    [:h2 "Welcome to Reagent"]
    [:p (test-jstat [[1 2] [3 4] [5 6]])]
-   [:p [:button {:on-click #(switch-line-chart line-datom)} "switch charts"]]
+   [:p [:button {:on-click #(switch-line-chartb line-datomb)} "switch charts"]]
    [line-componentb line-datomb]])

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


clean up a test

clean up a test

--- test/boost_bin/handler_test.clj
+++ test/boost_bin/handler_test.clj
@@ -17,20 +17,17 @@
       (it "should return a 400"
           (should= (:status response) 404)))))

+(defn jetty-port
+	[jetty-args]
+	(:port (nth jetty-args 1)))

 (describe "The app"
   (it "should default to port 8080"
     (with-redefs [run-jetty (fn [handler opts] [handler opts])]
-      (should= 8080 (->
-											(underTest/-main)
-											(nth 1)
-											(:port)))))
+      (should= 8080 (jetty-port (underTest/-main)))))
 	(it "should overide the port with first arg"
 		(with-redefs [run-jetty (fn [handler opts] [handler opts])]
-			(should= 8081 (->
-											(underTest/-main "8081")
-											(nth 1)
-											(:port)))))
+			(should= 8081 (jetty-port (underTest/-main "8081")))))
 	(it "should set the app handler"
 		(with-redefs [run-jetty (fn [handler opts] [handler opts])]
 			(should= underTest/app (first (underTest/-main))))))


asserting contains

asserting contains

--- test/celestial/test/freenas.clj
+++ test/celestial/test/freenas.clj
@@ -8,6 +8,4 @@
 (with-conf
   (let [{:keys [machine freenas]} redis-freenas]
     (fact "legal freenas system"
-       (:spec (vconstruct redis-freenas)) => (contains {:jail_type :standard}))
-
-    ))
+       (:spec (vconstruct redis-freenas)) => (contains {:jail_type :standard}))))


spacing

spacing

--- test/celestial/test/proxmox.clj
+++ test/celestial/test/proxmox.clj
@@ -11,8 +11,6 @@
     [proxmox.auth :only (fetch-headers auth-headers auth-store auth-expired?)]
     [celestial.fixtures :only (redis-prox-spec with-conf with-m?)])
   (:import clojure.lang.ExceptionInfo))
-
-

 (with-conf
   (let [{:keys [machine proxmox]} redis-prox-spec]


update tests

update tests

--- test/desdemona/ui/nav_test.cljs
+++ test/desdemona/ui/nav_test.cljs
@@ -28,7 +28,8 @@

 (deftest nav-test
   (is (= (n/nav)
-         [:div.navbar.navbar-default.navbar-double-row
+         [:div {:class "navbar navbar-default navbar-double-row"
+                :id "page-nav"}
           [:div.container-fluid.pt-30.pb-30
            [:div.navbar-header
             [:a.navbar-brand.brand-logo {:href "#"}


adding test for http get

adding test for http get

--- test/clj/ohds/service_test.clj
+++ test/clj/ohds/service_test.clj
@@ -1,11 +1,18 @@
 (ns ohds.service-test
   (:require
    [clojure.test :refer :all]
-   [ohds.service :refer :all])
-  (:import (java.time LocalDateTime)))
+   [ohds.service :refer :all]
+   [org.httpkit.client :as http])
+)

 (deftest json->cljs-test
   (is (= {:foo "bar"} (json->cljs "{\"foo\": \"bar\"}"))))

 (deftest http-methods-test
-  (testing "Testing get"))
+  (testing "Testing get"
+    (with-redefs [http/get
+                  (fn [url req]
+                    (is (= url "http://localhost:8080/foo"))
+                    (is (= req {:basic-auth ["user" "password"]}))
+                    (atom {:body "{\"uuid\": \"abc-123\"}"}))]
+      (is (= (get "/foo") {:uuid "abc-123"})))))


create (and delete) temp file for test db

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -46,9 +46,12 @@
 ; ------------------------------------------------------------------------------

 (defn gen-db-fixture-config []
-  (let [unique (gensym)
-        path   (str "./data/test-db-" unique)]
-    {:path path
+  (let [file     (java.io.File/createTempFile "test-db-" ".mv.db")
+        absolute (.getAbsolutePath file)
+        path     (subs absolute 0 (- (count absolute) 6))]
+    (.deleteOnExit file)
+    {:file file
+     :path path
      :rw (str "jdbc:h2:file:" path ";MODE=MySQL;TRACE_LEVEL_FILE=0;TRACE_LEVEL_SYSTEM_OUT=1")
      :ro (str "jdbc:h2:file:" path ";MODE=MySQL;TRACE_LEVEL_FILE=0;TRACE_LEVEL_SYSTEM_OUT=1;ACCESS_MODE_DATA=r")}))

@@ -61,10 +64,9 @@
     :up   (log/debug "Applying" id)
     :down (log/debug "Rolling back" id)))

-(defn cleanup-db-fixture [path]
-  (log/info "deleting database fixture:" path)
-  (io/delete-file (str path ".mv.db"))
-  nil)
+(defn cleanup-db-fixture [file]
+  (log/info "deleting temporaray test database: " (.getAbsolutePath file))
+  (io/delete-file file))

 (defrecord DatabaseFixture [config created]
   component/Lifecycle
@@ -86,7 +88,7 @@
     (if (not created) ; already stopped
       this
       (do
-        (cleanup-db-fixture (:path config))
+        (cleanup-db-fixture (:file config))
         (assoc this :created false)))))

 (defn new-db-fixture []


ruggero.clj: fixed an error

ruggero.clj: fixed an error

--- clojure/org/gavrog/clojure/ruggero.clj
+++ clojure/org/gavrog/clojure/ruggero.clj
@@ -25,11 +25,19 @@
   (and (every? #(not= % (s ds 2 %)) (elements ds))
        (every? (partial good-orbit? ds [1 2]) (orbit-reps ds [1 2]))))

+(defn- complete [ds]
+  (let [ops* (ops ds)
+        vs* (into {} (for [i (indices ds) :when (index? ds (inc i))]
+                       [i (into {} (for [D (elements ds)]
+                                     [D (or (v ds i (inc i) D) 1)]))]))]
+    (make-dsymbol (dim ds) (size ds) ops* vs*)))
+
 (defn self-dual-3-4-regular [n]
   (for [i (range (inc (- n 4)))
         :let [face-list (apply append (concat (repeat 4 triangle)
                                               (repeat i quadrangle)))]
-        set (results (combine-tiles face-list) (comp good? first))
+        set (map complete
+                 (results (combine-tiles face-list) (comp good? first)))
         :when (and (self-dual? set) (proto-spherical? set))
         ]
     set))


Comment out digest-test in cljs until support is added.

--- test/multihash/test_runner.cljs
+++ test/multihash/test_runner.cljs
@@ -4,9 +4,9 @@
   (:require
     doo.runner
     multihash.core-test
-    multihash.digest-test))
+    #_ multihash.digest-test))

 (doo-tests
   'multihash.core-test
-  'multihash.digest-test)
+  #_ 'multihash.digest-test)


Fix naming in tests

Fix naming in tests

--- test/micro_logic/core_test.clj
+++ test/micro_logic/core_test.clj
@@ -92,8 +92,8 @@
              (run 5 [q] (fives-and-sixes q))))
       ))

-  (testing "walk*"
-    (are [lvar s-map, value] (= value (walk* lvar s-map))
+  (testing "deep-walk"
+    (are [lvar s-map, value] (= value (deep-walk lvar s-map))

          a {},        a
          a {a 2},     2


Fix invalid markdown resource

Fix invalid markdown resource

--- dev/src/yada/dev/markdown_resource.clj
+++ dev/src/yada/dev/markdown_resource.clj
@@ -13,4 +13,4 @@
     (resource
      {:produces [{:media-type #{"text/html"}}]
       :properties {:last-modified (to-date (now)) :version content}
-      :methods {:get {:handler (fn [ctx] content)}}})))
+      :methods {:get {:response (fn [ctx] content)}}})))


overflow ellipsis and titles for env vars

Closes #1899

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -296,8 +296,8 @@
               [:tbody
                (for [{:keys [name value]} env-vars]
                  [:tr
-                  [:td name]
-                  [:td value]
+                  [:td {:title name} name]
+                  [:td {:title value} value]
                   [:td
                    [:a
                     {:title "Remove this variable?",


comment about filtering for particular lexemes


part 1

part 1

--- 2016/day-10/src/day_10/core.clj
+++ 2016/day-10/src/day_10/core.clj
@@ -1,9 +1,13 @@
 (ns day-10.core
   (:gen-class))

-(def init-state
-  {:bots {1 [3]
-          2 [2 5]}})
+(def instrs
+  ["value 5 goes to bot 2"
+   "bot 2 gives low to bot 1 and high to bot 0"
+   "value 3 goes to bot 1"
+   "bot 1 gives low to output 1 and high to bot 0"
+   "bot 0 gives low to output 2 and high to output 0"
+   "value 2 goes to bot 2"])

 (defn conj-s
   [s v]
@@ -33,11 +37,13 @@
       [board]
       (let [chips (get-in board [:bots bot])
             [low high] (sort chips)]
-        (->
+        (if (< (count chips) 2)
           board
-          (assoc-in [:bots bot] #{})
-          (update-in [low-type low-bot] #(conj-s % low))
-          (update-in [high-type high-bot] #(conj-s % high)))))))
+          (->
+            board
+            (assoc-in [:bots bot] #{})
+            (update-in [low-type low-bot] #(conj-s % low))
+            (update-in [high-type high-bot] #(conj-s % high))))))))

 (defn parse-cmd
   [cmd]
@@ -61,7 +67,36 @@
       (map parse-cmd)
       (reduce #(%2 %1) board))))

+(defn bot-has
+  [chips]
+  (fn
+    [board]
+    (let [matches (filter #(= chips (second %)) (board :bots))]
+      (if (= (count matches) 0)
+        false
+        true))))
+
+(defn find-bot
+  [chips board & cmds]
+  (let [val-cmds
+        (filter #(= (first (clojure.string/split % #"\s+")) "value") cmds)
+        bot-cmds
+        (filter #(= (first (clojure.string/split % #"\s+")) "bot") cmds)
+        initial-board (reduce #(%2 %1) board (map parse-cmd val-cmds))]
+      (->>
+        bot-cmds
+        (map parse-cmd)
+        cycle
+        (reductions #(%2 %1) initial-board)
+        (filter (bot-has chips))
+        (take 1))))
+
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]
-  (println "Hello, World!"))
+  (->>
+    *in*
+    slurp
+    clojure.string/split-lines
+    (apply find-bot #{61 17} {:bots {}})
+    println))


how about this?

how about this?

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

--- clojure/sequence_generator.clj
+++ clojure/sequence_generator.clj
@@ -13,7 +13,7 @@
 ;               IN NO EVENT SHALL THE COPYRIGHT OWNER OR
 ;               CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
 ;               INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES.
-; CVS:          $Id: $
+; CVS:          $Id: MMStudioMainFrame.java 5857 2010-12-09 21:42:12Z arthur $
 ;

 (ns sequence-generator)


Add TODO note on page-persisted event.

Add TODO note on page-persisted event.

--- frontend/src/uxbox/main/data/pages.cljs
+++ frontend/src/uxbox/main/data/pages.cljs
@@ -173,6 +173,9 @@
 (defrecord PagePersisted [data]
   ptk/UpdateEvent
   (update [_ state]
+    ;; TODO: update only the version instead of complete unpacking
+    ;; this will improve the application responsiveness when multiple
+    ;; updates are performed
     (assoc-page state data)))

 (defn- page-persisted?


LongLongByReference should not be LongLong

See https://jnr.github.io/jnr-ffi/apidocs/jnr/ffi/byref/LongLongByReference.html


Add a test for equality between identifiers

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -11,7 +11,12 @@
                  [:identifier "ip"]
                  [:identifier "x"]]]
          (#'q/infix-parser "ip(x)"))
-      "infix parses simple fn calls"))
+      "infix parses simple fn calls")
+  (is (= [:expr [:eq
+                 [:identifier "a"]
+                 [:identifier "b"]]]
+         (#'q/infix-parser "a = b"))
+      "parse simple equality between identifiers"))

 (deftest infix->dsl-tests
   (is (= '(= (:ip x) "10.0.0.1")


added test for eliding :task-map in task bundles

--- test/onyx/validation_test.clj
+++ test/onyx/validation_test.clj
@@ -579,4 +579,13 @@
                        :schema {:flow-conditions [{:custom/thing s/Str}
                                                   (os/restricted-ns :custom) s/Any]}}]
       (is (add-task blank-job (assoc-in task-bundle [:task :flow-conditions 0 :custom/thing] "Hello")))
+      (is (thrown? Exception (add-task blank-job task-bundle)))))
+  (testing "task bundles with just flow conditions"
+    (let [task-bundle {:task {:flow-conditions [{:flow/to :n
+                                                 :flow/predicate ::f
+                                                 :flow/from :n
+                                                 :flow/action :retry}]}
+                       :schema {:flow-conditions [{:custom/thing s/Str}
+                                                  (os/restricted-ns :custom) s/Any]}}]
+      (is (add-task blank-job (assoc-in task-bundle [:task :flow-conditions 0 :custom/thing] "Hello")))
       (is (thrown? Exception (add-task blank-job task-bundle))))))


Fixed bug which caused empty view instead of an error message.

--- app/src/weather/ui/view/history.cljs
+++ app/src/weather/ui/view/history.cljs
@@ -20,7 +20,7 @@
 (defn error-view
   []
   [:div
-   [:h1 (tr :bad-request)]])
+   [:p (tr :bad-request)]])

 (defn weather-view
   [data]
@@ -30,5 +30,5 @@
         (= 200 (:status data))
         [weather-data-view (:body data)]

-        (not (:status data))
+        (not (= 200 (:status data)))
         [error-view]))


add debugging macro

add debugging macro

--- logging-macro-demo/src/logging_macro_demo/core.clj
+++ logging-macro-demo/src/logging_macro_demo/core.clj
@@ -54,6 +54,25 @@
        (println "new-functoin: " '~new-function)
        (eval '~new-function))))

+(defmacro my-debug-sm
+  "Call with a function definition and this will add logging to the start and end."
+  [arg]
+  (let [param-index (first (indices vector? arg))
+        first-half (take (inc param-index) arg)
+        body (drop (inc param-index) arg)
+        func-name (second arg)
+        params (nth arg param-index)
+        new-print-args-statement `(println (str "(" '~func-name " " ~params ")"))
+        last-statement (take-last 1 body)
+        body-remainder (drop-last 1 body)
+        print-last-statement `(println (str '~func-name " result: " ~(first last-statement)))
+        new-function (concat first-half
+                             (list new-print-args-statement)
+                             body-remainder
+                             (list print-last-statement)
+                             last-statement)]
+    `(do
+       (eval '~new-function))))
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]


remove useless `declare`

remove useless `declare`

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -1230,8 +1230,6 @@
 (defn- str-butlast
   [s]
   (subs s 0 (dec (count s))))
-
-(declare print-value)

 (defn- format-spec
   [spec left-margin ns]


Fix loadig source map for core namespaces

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -757,15 +757,15 @@

 (defn- load-core-source-maps!
   []
-  (when-not (get (:source-maps @planck.repl/st) 'planck.repl)
-    (swap! st update-in [:source-maps] merge {'planck.repl
+  (when-not (get (:source-maps @planck.repl/st) 'cljs.core)
+    (swap! st update-in [:source-maps] merge {'cljs.core
                                               (sm/decode
                                                 (cljson->clj
-                                                  (first (js/PLANCK_LOAD "planck/repl.js.map"))))
-                                              'cljs.core
+                                                  (first (js/PLANCK_LOAD "cljs/core.js.map"))))
+                                              'cljs.core$macros
                                               (sm/decode
                                                 (cljson->clj
-                                                  (first (js/PLANCK_LOAD "cljs/core.js.map"))))})))
+                                                  (first (js/PLANCK_LOAD "core$macros.js.map"))))})))

 (defonce ^:dynamic ^:private *planck-integration-tests* false)


Eliminate unused symbol

Eliminate unused symbol

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -760,7 +760,7 @@
       (handle-error e include-stacktrace? in-exit-context?))))

 (defn execute-source
-  [[source-type source-value] {:keys [expression? expression-ns] :as opts}]
+  [[source-type source-value] {:keys [expression?] :as opts}]
   (binding [ana/*cljs-ns* @current-ns
             *ns* (create-ns @current-ns)
             cljs/*load-fn* load


Set max-threads to something usable.

Set max-threads to something usable.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -188,10 +188,20 @@
       (wrap-reload)
       (add-version-header)))

+; jetty default thread use is availableProcessors/4 acceptor threads,
+; and selector threads equal to acceptor threads. For https + http, that
+; sums to exactly availableProcessors. Pick a max thread pool two that.
+;
+; We could also manipulate acceptor threads, or make it configurable, but
+; trying this for now.
+(def max-threads
+  (delay (max 80 (* 2 (.availableProcessors (Runtime/getRuntime))))))
+
 (defn- serv [app host port {:keys [keystore password]}]
   (ring.adapter.jetty/run-jetty app {:host host
                                      :port port
                                      :ssl? true
+                                     :max-threads @max-threads
                                      :ssl-port (+ port 1)
                                      :keystore keystore
                                      :key-password password


Fix the production DB host variable

Fix the production DB host variable

--- src/circle/db.clj
+++ src/circle/db.clj
@@ -9,11 +9,10 @@

 (def production-db ; mongodb://<user>:<password>@staff.mongohq.com:10078/large1
   {:db (System/getenv "MONGOHQ_DATABASE")
-   :host (System/getenv "MONGOHQ_PASSWORD")
+   :host (System/getenv "MONGOHQ_HOST")
    :port (Integer/parseInt (or (System/getenv "MONGOHQ_PORT") "0"))
    :username (System/getenv "MONGOHQ_USERNAME")
-   :password (System/getenv "MONGOHQ_PASSWORD")
-   })
+   :password (System/getenv "MONGOHQ_PASSWORD")})

 (def staging-db ; mongodb://<user>:<password>@staff.mongohq.com:10017/staging
   {:db :staging


hashi-tools as link

hashi-tools as link

--- main/src/dda/pallet/dda_managed_ide/infra/devops.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/devops.clj
@@ -71,6 +71,7 @@
    config :- Packer]
   (let [{:keys [version sha256-hash]} config
         file-name (str "packer_" version "_linux_amd64.zip")
+        usr-local-lib-dir (str "/usr/local/lib/packer/" version)
         sum-name (str file-name "SHA256SUM")]
     (actions/as-action
       (logging/info (str facility "-install system: install-packer")))
@@ -83,14 +84,16 @@
         :literal true
         :content (str sha256-hash " " file-name)))
     (actions/exec-checked-script
-      "install packer"
-      ("curl" "-L" "-o" ~(str "/tmp/" file-name)
-        ~(str "https://releases.hashicorp.com/packer/" version "/" file-name))
-      ("cd" "/tmp")
-      (if (file-exists? ~sum-name)
-        ("sha256sum" "-c" ~sum-name))
-      ("unzip" ~file-name)
-      ("mv" "packer" "/usr/local/bin/"))))
+     "install packer"
+     ("curl" "-L" "-o" ~(str "/tmp/" file-name)
+             ~(str "https://releases.hashicorp.com/packer/" version "/" file-name))
+     ("cd" "/tmp")
+     (if (file-exists? ~sum-name)
+       ("sha256sum" "-c" ~sum-name))
+     ("unzip" ~file-name)
+     ("mkdir" "-p" ~usr-local-lib-dir)
+     ("mv" "packer" ~usr-local-lib-dir)
+     ("ln" "-s" "-f" ~(str usr-local-lib-dir "/packer") "/usr/local/bin/packer"))))

 (defn install-docker
   [facility]
@@ -166,6 +169,7 @@
    terraform-config :- Terraform]
   (let [{:keys [version sha256-hash]} terraform-config
         terraform-file-name (str "terraform_" version "_linux_amd64.zip")
+        usr-local-lib-dir (str "/usr/local/lib/terraform/" version)
         terraform-sum-name (str terraform-file-name "SHA256SUM")]
     (actions/as-action
       (logging/info (str facility "-install system: install-terraform")))
@@ -178,14 +182,16 @@
         :literal true
         :content (str sha256-hash " " terraform-file-name)))
     (actions/exec-checked-script
-      "install terraform"
-      ("curl" "-L" "-o" ~(str "/tmp/" terraform-file-name)
-        ~(str "https://releases.hashicorp.com/terraform/" version "/" terraform-file-name))
-      ("cd" "/tmp")
-      (if (file-exists? ~terraform-sum-name)
-        ("sha256sum" "-c" ~terraform-sum-name))
-      ("unzip" ~terraform-file-name)
-      ("mv" "terraform" "/usr/local/bin/"))))
+     "install terraform"
+     ("curl" "-L" "-o" ~(str "/tmp/" terraform-file-name)
+             ~(str "https://releases.hashicorp.com/terraform/" version "/" terraform-file-name))
+     ("cd" "/tmp")
+     (if (file-exists? ~terraform-sum-name)
+       ("sha256sum" "-c" ~terraform-sum-name))
+     ("unzip" ~terraform-file-name)
+     ("mkdir" "-p" ~usr-local-lib-dir)
+     ("mv" "terraform" ~usr-local-lib-dir)
+     ("ln" "-s" "-f" ~(str usr-local-lib-dir "/terraform") "/usr/local/bin/terraform"))))

 (s/defn install-system
   [facility :- s/Keyword


more logging

more logging

--- src/babel/forest.clj
+++ src/babel/forest.clj
@@ -96,7 +96,11 @@
                                                                                "NULL MORPH"))))
                                     candidate-lexemes))
                         (let [result (over/overh parent (lazy-shuffle (get-lex parent :head index spec)) morph)]
-                          (log/debug (str "results of attaching lexemes to: " (:rule parent) ": (size=" (if result (.size result) "0") ")" (string/join "," (map strip-refs result))))
+                          (log/debug (str "results of attaching lexemes to: " (:rule parent) ": (size=" (if result (.size result) "0") ")"
+                                          (string/join ","
+                                                       (map #(if morph (morph %1)
+                                                                 "(string)")
+                                                            result))))
                           result)))
                     candidate-parents)
             phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
@@ -161,8 +165,7 @@
         (let [shuffled-candidate-lexical-complements (lazy-shuffle complement-candidate-lexemes)
               return-val
               (filter (fn [result]
-                        (or true
-                        (not (fail? result))))
+                        (not (fail? result)))
                       (map (fn [complement]
                              (let [debug (log/debug (str "Trying complement:" (morph complement)))
                                    result
@@ -172,7 +175,7 @@
                                    is-fail? (fail? result)]
                                (if is-fail?
                                  (do
-                                   (log/debug (str "fail-path-between:" (fail-path-between (strip-refs (get-in bolt path))
+                                   (log/trace (str "fail-path-between:" (fail-path-between (strip-refs (get-in bolt path))
                                                                                (strip-refs complement))))))
                                (if is-fail? :fail result)))

@@ -188,17 +191,18 @@
               (do
                 (log/warn (str " add-complement took " run-time " msec, but found no lexical complements for "
                                (morph from-bolt) "(rule: " (:rule from-bolt) ")"
+                               "; head rule:" (:rule (get-in from-bolt [:head]))
                                ". Complements tried were: " (morph complement-candidate-lexemes)))

-                ;; TODO: show warn about not finding ny phrasal complements, as well as not finding any lexical complements.
+                ;; TODO: show warn about not finding any phrasal complements, as well as not finding any lexical complements.
                 (log/debug (str " fail-paths:"))
                 (vec (map (fn [lexeme]
                             (log/debug (str " path in bolt: " path))
                             (log/debug (str " value of bolt at path: " (get-in bolt path)))
                             (log/debug (str " value of gender at path: " (get-in bolt (concat path [:synsem :agr :gender])))))
                           complement-candidate-lexemes))))
-
-            return-val)))
+            (do (log/debug (str "add-complement after adding complement: " (morph return-val)))
+                return-val))))

       ;; path doesn't exist in bolt: simply return the bolt unmodified.
       (do


~generate-question-and-correct-set: set use-spec-cache? to true

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -148,7 +148,7 @@
         target-expression
         (target-timing-fn
          (binding [babel.generate/truncate? true
-                   babel.generate/use-spec-cache? false]
+                   babel.generate/use-spec-cache? true]
            (babel.generate/generate target-spec target-model)))
         source-spec
         (u/strip-refs ;; TODO: consider removing strip-refs; not clear if there is any reason why we need to do it.


rename variable for clarity

rename variable for clarity

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -59,7 +59,7 @@
               target-spec (json-read-str
                            (if-let [target-spec (get (:query-params request) "target-spec")]
                              target-spec "{}"))
-              gcacs
+              q-and-a
               (try
                 (wait wait-ms-for-question
                       (fn []
@@ -70,7 +70,15 @@
                 (catch Exception e
                   {:return-a-500 true
                    :exception (str e)}))]
-          (cond (nil? gcacs)
+          ;; at this point q-and-a is either:
+          ;; - nil: the (wait) timed out; meaning the
+          ;; system is either over-capacity (CPU-starved)
+          ;; or the underlying algorithm is simply not
+          ;; efficient with the supplied inputs.
+          ;; - {:return-a-500 true} The generation attempt
+          ;; threw an exception of some kind, the value of
+          ;; which is available in the :exception key.
+          (cond (nil? q-and-a)

                 ;; Avoid any logging here since it will further
                 ;; slow down system since it's already overloaded.
@@ -79,17 +87,17 @@
                  :body (write-str {:message "Capacity overload: please try again later."
                                    :spec target-spec})}

-                (= true (:return-a-500 gcacs))
+                (= true (:return-a-500 q-and-a))
                 (do
                   (log/error (str "Internal error: returning 500. Exception was:"
-                                  (:exception gcacs)))
+                                  (:exception q-and-a)))
                   {:status 500
                    :headers {"Content-Type" "application/json;charset=utf-8"}
                    :body (write-str {:message "Unexpected internal error. Sorry: hopefully a human will work on it."})})

                 true
-                (let [source (:source gcacs)
-                      targets (:targets gcacs)]
+                (let [source (:source q-and-a)
+                      targets (:targets q-and-a)]
                   (log/info (str "returning normal response:"
                                  "'" source "'"
                                  " -> " targets "; spec:" target-spec))


fix typos

fix typos

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -462,7 +462,6 @@
     (exec-raw [(str "TRUNCATE " import_table)])

     (log/debug (str "Units: " (.size units)))
-
     (.size (map (fn [unit]
                   (log/trace (str "TYPE OF UNIT: " (type unit)))
                   (log/trace (str "KEYS OF UNIT: " (keys unit)))
@@ -483,15 +482,15 @@
                          "expression_import"
                          (->> member-of-unit :fill :source-model)
                          (->> member-of-unit :fill :target-model))))
-                    (if (:fill-with-language member-of-unit)
-                      (let [count (or (->> member-of-unit :fill-with-language :count) 10)]
-                        (log/debug (str "doing fill-with-language: " (->> member-of-unit :fill-with-language :spec)
+                    (if (:fill-one-language member-of-unit)
+                      (let [count (or (->> member-of-unit :fill-one-language :count) 10)]
+                        (log/debug (str "doing fill-one-language: " (->> member-of-unit :fill-one-language :spec)
                                         "; count=" count))
                         (fill-language-by-spec
-                         (->> member-of-unit :fill-with-language :spec)
+                         (->> member-of-unit :fill-one-language :spec)
                          count
                          "expression_import"
-                         (->> member-of-unit :fill-with-language :model))))
+                         (->> member-of-unit :fill-one-language :model))))
                     (if (:fill-verb member-of-unit)
                       (do
                         (log/info (str "Doing fill-verb: " (:fill-verb member-of-unit)))


make fetch functions accept optional row-maker or column-reader argument

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -57,48 +57,54 @@

 (defn fetch-rows
   "Given a java.sql.ResultSet and asphalt.internal.ISql instances fetch a vector of rows using ISql."
-  [isql ^ResultSet result-set]
-  (let [rows (transient [])
-        ^ResultSetMetaData rsmd (.getMetaData result-set)
-        column-count (.getColumnCount rsmd)]
-    (while (.next result-set)
-      (conj! rows (t/read-row isql result-set column-count)))
-    (persistent! rows)))
+  ([isql ^ResultSet result-set]
+    (fetch-rows t/read-row isql result-set))
+  ([row-maker isql ^ResultSet result-set]
+    (let [rows (transient [])
+          ^ResultSetMetaData rsmd (.getMetaData result-set)
+          column-count (.getColumnCount rsmd)]
+      (while (.next result-set)
+        (conj! rows (row-maker isql result-set column-count)))
+      (persistent! rows))))

 (defn fetch-single-row
   "Given java.sql.ResultSet and asphalt.internal.ISql instances ensure result has exactly one row and fetch it using
   ISql."
-  [isql ^ResultSet result-set]
-  (if (.next result-set)
-    (let [^ResultSetMetaData rsmd (.getMetaData result-set)
-          column-count (.getColumnCount rsmd)
-          row (t/read-row isql result-set column-count)]
-      (if (.next result-set)
-        (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found more than one for SQL: "
-                                    (t/get-sql isql))))
-        row))
-    (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found no result row for SQL: "
-                                (t/get-sql isql))))))
+  ([isql ^ResultSet result-set]
+    (fetch-single-row t/read-row isql result-set))
+  ([row-maker isql ^ResultSet result-set]
+    (if (.next result-set)
+      (let [^ResultSetMetaData rsmd (.getMetaData result-set)
+            column-count (.getColumnCount rsmd)
+            row (row-maker isql result-set column-count)]
+        (if (.next result-set)
+          (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found more than one for SQL: "
+                                      (t/get-sql isql))))
+          row))
+      (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found no result row for SQL: "
+                                  (t/get-sql isql)))))))

 (defn fetch-single-value
   "Given java.sql.ResultSet and asphalt.internal.ISql instances, ensure result has exactly one row and one column, and
   fetch it using ISql."
-  [isql ^ResultSet result-set]
-  (let [^ResultSetMetaData rsmd (.getMetaData result-set)
-        column-count (.getColumnCount rsmd)]
-    (when (not= 1 column-count)
-      (throw (RuntimeException. (str "Expected exactly one JDBC result column but found " column-count " for SQL: "
-                                  (t/get-sql isql)))))
-    (if (.next result-set)
-      (let [column-value (t/read-col isql result-set 1)]
-        (if (.next result-set)
-          (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found more than one for SQL: "
-                                      (t/get-sql isql))))
-          column-value))
-      (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found no result row for SQL: "
-                                  (t/get-sql isql)))))))
+  ([isql ^ResultSet result-set]
+    (fetch-single-value t/read-col isql result-set))
+  ([column-reader isql ^ResultSet result-set]
+    (let [^ResultSetMetaData rsmd (.getMetaData result-set)
+          column-count (.getColumnCount rsmd)]
+      (when (not= 1 column-count)
+        (throw (RuntimeException. (str "Expected exactly one JDBC result column but found " column-count " for SQL: "
+                                    (t/get-sql isql)))))
+      (if (.next result-set)
+        (let [column-value (column-reader isql result-set 1)]
+          (if (.next result-set)
+            (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found more than one for SQL: "
+                                        (t/get-sql isql))))
+            column-value))
+        (throw (RuntimeException. (str "Expected exactly one JDBC result row, but found no result row for SQL: "
+                                    (t/get-sql isql))))))))

 ;; ----- working with javax.sql.DataSource -----


add logging

add logging

--- src/babel/enrich.clj
+++ src/babel/enrich.clj
@@ -1,6 +1,7 @@
 (ns babel.enrich
   (:refer-clojure :exclude [get-in]))
 (require '[dag-unify.core :refer [fail? get-in strip-refs unify]])
+(require '[clojure.tools.logging :as log])

 (declare against-comp)
 (declare against-pred)
@@ -10,6 +11,7 @@
 (defn enrich [spec lexicon]
   (let [against-pred (against-pred spec lexicon)]
     (if true against-pred
+        ;; TODO: remove this else since it's never executed (since above we have "if true")
         (let [against-comp (map (fn [spec]
                                   (against-comp spec lexicon))
                                 (if (seq? against-pred)
@@ -29,7 +31,9 @@
                                     {:synsem {:essere (strip-refs (get-in lexeme [:synsem :essere] :top))}}
                                     )]
                   (if (not (fail? result))
-                    (list result))))
+                    (do
+                      (log/debug (str "matched head lexeme: " (strip-refs lexeme)))
+                      (list result)))))
               (matching-head-lexemes spec lexicon)))))

 (defn against-comp [spec lexicon]


fix typo

fix typo

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -72,7 +72,7 @@
       (deserialize (read-string (:structure (first results)))))))

 (defn generate-question-and-correct-set-dynamic [target-spec source-language source-locale
-                                                 target-language target-local
+                                                 target-language target-locale
                                                  source-model target-model]
   (let [target-expression (engine/generate target-spec :model target-model)
         source-expression (engine/generate {:synsem {:sem (get-in target-expression [:synsem :sem])}}


Compilable test functions

Compilable test functions

--- lazytest.clj
+++ lazytest.clj
@@ -20,9 +20,14 @@
 (def *defining-context-bindings* [])

 (defprotocol Successful
-  (success? [r] "Returns true if the result r was 100% successful."))
-
-(deftype Assertion [form])
+  (success? [r] "Returns true if the TestResult or
+  SuiteResult was 100% successful."))
+
+(defprotocol TestCompilable
+  (compile [x active-contexts] "Compiles the Test or Suite to a fn."))
+
+(defprotocol TestRunnable
+  (run [x] "Executes the Test or Suite."))

 (deftype Test [locals contexts assertions])

@@ -30,20 +35,30 @@

 (deftype Suite [contexts children])

-(deftype AssertionSuccess [assertion]
+(deftype AssertionSuccess [form]
   Successful (success? [] true))

-(deftype AssertionFailure [assertion]
+(deftype AssertionFailure [form]
   Successful (success? [] false))

-(deftype AssertionThrown [assertion throwable]
+(deftype AssertionThrown [form throwable]
   Successful (success? [] false))

 (deftype TestResult [test assertion-results]
   Successful (success? [] (every? success? assertion-results)))

-(deftype SuiteResult [suite test-results]
-  Successful (success? [] (every? success? test-results)))
+(deftype SuiteResult [suite child-results]
+  Successful (success? [] (every? success? child-results)))
+
+(defmulti report-start type)
+
+(defmulti report-done type)
+
+(defmethod report-start TestResult [tr]
+  (println "Starting test" (:name (meta (:test tr)))))
+
+(defmethod report-done TestResult [tr]
+  (println "Finished test" (:name (meta (:test tr)))))

 (defn context?
   "Returns true if x is a Context."
@@ -62,210 +77,134 @@

 (defn- format-assertion [expr]
   `(try (if ~expr
-          (AssertionSuccess (quote ~expr))
-          (AssertionFailure (quote ~expr)))
+          (AssertionSuccess '~expr)
+          (AssertionFailure '~expr))
         (catch Throwable t#
-          (AssertionThrown (quote ~expr) t#))))
-
-;; TODO: Lazy evaluation
+          (AssertionThrown '~expr t#))))
+
 (defn- format-test [t]
   {:pre [(test? t)
          (vector? (:locals t))
          (every? symbol? (:locals t))]}
   `(fn ~(:locals t)
-     (list ~@(map format-assertion (:assertions t)))))
-
-(defn- compile-test* [t]
-  (eval (format-test t)))
-
-(def #^{:doc "Compile a Test to a function of its locals. (memoized)"
-        :arglists '([t])}
-     compile-test (memoize compile-test*))
+     (lazy-seq
+      ~(loop [r nil, as (reverse (:assertions t))]
+         (if (seq as)
+           (recur (list 'cons (format-assertion (first as)) r)
+                  (next as))
+           r)))))
+
+(defn- compile-test
+  "Compile a Test to a function of its locals."
+  [t]
+  (or (::compiled (meta t))
+      (eval (format-test t))))

 (defn- open-context
   "Calls Context c's :before function, returns result."
-  [c]
-  (or (*active-contexts* c)
+  [active-contexts c]
+  (or (active-contexts c)
       (when-let [f (:before c)]
         (f))))

 (defn- close-context
   "Calls Context c's :after function on state."
-  [c state]
-  (when-not (contains? *active-contexts* c)
+  [active-contexts c state]
+  (when-not (contains? active-contexts c)
     (when-let [f (:after c)]
       (f state))))

-(defn call-with-contexts
-  "Applies f to the result of opening all contexts,
-  then closes contexts in reverse order."
-  [contexts f]
-  {:pre [(every? context? contexts)]}
-  (let [states (map open-context contexts)
-        result (binding [*active-contexts*
-                         (merge *active-contexts*
-                                (zipmap contexts states))]
-                 (apply f states))]
-    (dorun (map close-context
-                (reverse contexts) (reverse states)))
-    result))
-
-(defn run-test
-  "Run a Test t, return a TestResult."
-  [t]
-  {:pre [(test? t)]}
-  (TestResult t (call-with-contexts (:contexts t)
-                  (compile-test t))))
-
-(declare run)
-
-(defn run-suite
-  "Run a Suite s, return a SuiteResult."
-  [s]
-  (SuiteResult s (call-with-contexts (:contexts s)
-                   (fn [& _]
-                     (doall (map run (:children s)))))))
-
-
-(defn run [x]
-  (cond (suite? x) (run-suite x)
-        (test? x) (run-test x)
-        :else (throw (IllegalArgumentException.
-                      "Suites may only contain Tests and other Suites"))))
-
-
-
-;;; CONVENIENCE MACROS
-
-(defn- reformat-context [x]
-  (if (symbol? x) x
-      `(Context (fn [] ~x) nil)))
-
-(defmacro make-test
-  "args => docstring? [bindings*] assertions*
-
-  bindings => local-name context
-
-  If context is an expression, will create an anonymous
-  context using that expression in its :before function."
-  [& args]
-  (let [docstring (if (string? (first args))
-                    (first args)
-                    nil)
-        args (if (string? (first args))
-                (next args) args)
-        context-bindings (if (vector? (first args))
-                           (first args)
-                           [])
-        assertions (if (vector? (first args))
-                     (next args) args)]
-    `(Test (quote ~(vec (map first (partition 2 context-bindings))))
-           ~(vec (map (comp reformat-context second)
-                      (partition 2 context-bindings)))
-           (quote ~(vec assertions))
-           {:doc ~docstring} {})))
-
-(defmacro deftest [name & args]
-  `(def ~name (let [t# (make-test ~@args)]
-                (with-meta t# (assoc (meta t#)
-                                :name '~name
-                                :ns *ns*
-                                :file *file*
-                                :line @clojure.lang.Compiler/LINE)))))
-
-(declare reformat-child)
-
-(defmacro make-child-test [parent-bindings & args]
-  (let [docstring (if (string? (first args))
-                    (first args)
-                    nil)
-        args (if (string? (first args))
-                (next args) args)
-        context-bindings (if (vector? (first args))
-                           (vec (concat parent-bindings (first args)))
-                           parent-bindings)
-        assertions (if (vector? (first args))
-                     (next args) args)]
-    `(Test (quote ~(vec (map first (partition 2 context-bindings))))
-           ~(vec (map (comp reformat-context second)
-                      (partition 2 context-bindings)))
-           (quote ~(vec assertions))
-           {:doc ~docstring} {})))
-
-(defmacro make-child-suite [parent-bindings & args]
-  (let [docstring (if (string? (first args))
-                    (first args)
-                    nil)
-        args (if (string? (first args))
-                (next args)
-                args)
-        context-bindings (if (vector? (first args))
-                           (vec (concat parent-bindings (first args)))
-                           parent-bindings)
-        children (if (vector? (first args))
-                   (next args) args)]
-    `(Suite ~(vec (map (comp reformat-context second) (partition 2 context-bindings)))
-            ~(vec (map (partial reformat-child context-bindings) children))
-            {:doc ~docstring} {})))
-
-(defn reformat-child [parent-bindings args]
-  (cond (symbol? args) args
-        (= :test (first args)) `(make-child-test ~parent-bindings ~@(rest args))
-        (= :suite (first args)) `(make-child-suite ~parent-bindings ~@(rest args))
-        :else args))
-
-(defmacro make-suite [& args]
-  (let [docstring (if (string? (first args))
-                    (first args)
-                    nil)
-        args (if (string? (first args))
-                (next args)
-                args)
-        context-bindings (if (vector? (first args))
-                           (first args) [])
-        children (if (vector? (first args))
-                   (next args) args)]
-    `(Suite ~(vec (map (comp reformat-context second) (partition 2 context-bindings)))
-            ~(vec (map (partial reformat-child context-bindings) children))
-            {:doc ~docstring} {})))
-
-(defmacro defsuite [name & args]
-  `(def ~name (let [s# (make-suite ~@args)]
-                (with-meta s# (assoc (meta s#)
-                                :name '~name
-                                :ns *ns*
-                                :file *file*
-                                :line @clojure.lang.Compiler/LINE)))))
+(defn- call-with-context
+  "Opens all contexts, applies f to their state, closes all contexts
+  in reverse order, and returns f's return value.  Executes strictly
+  if any contexts has an :after function; otherwise executes lazily."
+  [active-contexts f contexts]
+  {:pre [(every? context? contexts) (fn? f)]}
+  (if (some :after contexts)
+    ;; strict (non-lazy)
+    (let [states (doall (map (partial open-context active-contexts)
+                             contexts))
+          result (doall (apply f states))]
+      (doall (map (partial close-context active-contexts)
+                  (reverse contexts) (reverse states)))
+      result)
+    ;; lazy
+    (apply f (map open-context contexts))))
+
+(defn- compile-suite [active-contexts s]
+  (or (::compiled (meta s))
+      (fn [& _] (map (partial active-contexts run)
+                     (:children s)))))
+
+(extend-protocol TestCompilable
+  ::Test
+  (run [active-contexts t]
+       (TestResult t (call-with-context
+                        active-contexts
+                        (compile-test s) (:contexts t))))
+  ::Suite
+  (run [active-contexts s]
+       (SuiteResult s (call-with-context
+                        active-contexts
+                        (compile-suite s) (:contexts s)))))
+
+(defn run-with-active-context [active-contexts x]
+  )

 ;;; RAW API USAGE:

-(def c1 (Context (fn [] 1) nil))
-
-(def c2 (Context (fn [] (Thread/sleep 1000) 2) nil))
-
-(def t1 (Test '[a b] [c1 c2] '[(integer? a) (integer? b)]))
-
-(def t2 (Test '[a b] [c1 c2] '[(> b a) (< a b)]))
+(def c1 (Context (fn [] (prn "Opening context c1.") 1)
+                 (fn [_] (prn "Closing context c1.") 1)))
+
+(def c2 (Context (fn [] (prn "Opening context c2.") 2)
+                 (fn [_] (prn "Closing context c2."))))
+
+(def c3 (Context (fn [] (prn "Opening lazy context c3.") 3)
+                 nil))
+
+(def c4 (Context (fn [] (prn "Opening lazy context c4.") 4)
+                 nil))
+
+(def c5 (Context (fn [] (prn "Opening lazy context c5.") 3)
+                 nil))
+
+(def c6 (Context (fn [] (prn "Opening lazy context c6.") 4)
+                 nil))
+
+(def t1 (Test '[a b] [c1 c2]
+              '[(do (prn "Evaluating test t1-a.") (integer? a))
+                (do (prn "Evaluating test t1-b.") (integer? b))]))
+
+(def t2 (Test '[a b] [c1 c2]
+              '[(do (prn "Evaluating test t2-a.") (integer? a))
+                (do (prn "Evaluating test t2-b.") (integer? b))]))
+
+(def t3 (Test '[a b] [c3 c4]
+              '[(do (prn "Evaluating test t3-a.") (integer? a))
+                (do (prn "Evaluating test t3-b.") (integer? b))]))
+
+(def t4 (Test '[a b] [c5 c6]
+              '[(do (prn "Evaluating test t4-a.") (integer? a))
+                (do (prn "Evaluating test t4-b.") (integer? b))]))
+
+(def s1 (Suite [] [t1 t2]))

 ;; Including context c2 in the Suite means it's only executed once for
 ;; all tests in the suite.
-(def s1 (Suite [c2] [t1 t2]))
+(def s2 (Suite [c1] [t1 t2]))
+
+(def s3 (Suite [c1 c2] [t1 t2]))
+
+;; Tests and Suites are evaluated lazily if and only if none of their
+;; Contexts has an :after function.
+(def s4 (Suite [] [t3 t4]))
+
+(def s5 (Suite [c3 c4] [t3 t4]))

 ;; Suites may be nested.
-(def s2 (Suite nil [s1]))
-
-;; user=> (run-suite s2)
+
+;; user=> (run s2)
 ;; ...
 ;; user=> (success? *1)
 ;; true
-
-
-;;; DEFSUITE USAGE
-
-(defsuite s3 [a c1 b 2]
-  t1 t2
-  (:test [b 2] (> b a))
-  (:suite [c 3]
-          (:test (integer? c))
-          (:test (< a c))))


Collisions.

Collisions.


fix compilation error

fix compilation error

--- src/clj/hsm/ring.clj
+++ src/clj/hsm/ring.clj
@@ -3,6 +3,7 @@
     [clojure.tools.logging  :as log]
     [ring.util.response     :as resp]
     [cognitect.transit       :as t]
+    [clojure.stacktrace     :as clj-stk]
     [cheshire.core           :refer :all])
   (:import
     [java.io ByteArrayInputStream ByteArrayOutputStream]))
@@ -21,7 +22,7 @@
       (catch Throwable e
         (do
           (log/error e)
-          (clojure.stacktrace/print-stack-trace e)
+          (clj-stk/print-stack-trace e)
         (->
          (resp/response (.getMessage e))
          (resp/status 500)))))))


Created SHON.collection class

Created SHON.collection class

--- src/cassidy/shon.clj
+++ src/cassidy/shon.clj
@@ -66,17 +66,17 @@

 (defn- write-ol [coll el]
   (html [el
-         [:ol.SHON
+         [:ol {:class (-get-class-attribute coll)}
          (map #(-write-str (*value-fn* nil %) :li) coll)]]))

 (defn- write-ul [coll el]
   (html [el
-         [:ul.SHON
+         [:ul {:class (-get-class-attribute coll)}
          (map #(-write-str (*value-fn* nil %) :li) coll)]]))

 (defn- write-dl [m el]
   (html [el
-         [:dl.SHON
+         [:dl {:class (-get-class-attribute m)}
          (map #(let [[k v] %
                      out-key (*key-fn* k)
                      out-value (*value-fn* k v)]
@@ -94,6 +94,7 @@
   (html [el [:a {:href (str x)} (str x)]]))

 (def shon-number (constantly "SHON.number"))
+(def shon-collection (constantly "SHON.collection"))

 ;; nil, true, false
 (extend nil                    SHONWriter
@@ -134,13 +135,13 @@
         {:-write-str write-escaped-string :-get-class-attribute (constantly nil)})

 (extend java.util.Map SHONWriter
-        {:-write-str write-dl :-get-class-attribute (constantly "SHON")})
+        {:-write-str write-dl :-get-class-attribute shon-collection})
 (extend java.util.List         SHONWriter
         {:-write-str write-ol
-         :-get-class-attribute (constantly "SHON")})
+         :-get-class-attribute shon-collection})
 (extend java.util.Collection   SHONWriter
         {:-write-str write-ul
-         :-get-class-attribute (constantly "SHON")})
+         :-get-class-attribute shon-collection})

 ;; html things
 (extend java.net.URL           SHONWriter
@@ -172,7 +173,7 @@
   (let [[key-fn value-fn] (parse-options options)]
     (binding [*key-fn* key-fn
               *value-fn* value-fn]
-      (-write-str x :div))))
+      (-write-str x :div.shon.root))))

 (defn pprint
   "Pretty prints an object as a SHON string. Options are the same as in


wait for collapse anim before spawning new piece

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -330,8 +330,9 @@
         piece (:piece @state)
         board (:board @state)]
     (swap! state assoc :board (write-piece-to-board piece x y board))
-    (go-go-collapse!)
-    (spawn-piece!)))
+    (if-let [collapse-anim (go-go-collapse!)]
+      (go (<! collapse-anim) (spawn-piece!))
+      (spawn-piece!))))

 (defn go-go-gravity!
   "Starts the gravity routine."


Generating the full set of IFn -invoke methods

--- src/cljs/go/core.clj
+++ src/cljs/go/core.clj
@@ -739,7 +739,7 @@
   (let [[proto-params] ((group-by count (:method-params proto-fn)) (count sig))]
     `(~(vec (cons (vary-meta this assoc :tag type)
                   (map #(vary-meta % assoc :tag (-> %2 meta :tag))
-                       args (next proto-params))))
+                       args (or (next proto-params) args))))
       (this-as ~this
         ~@body))))

@@ -757,21 +757,20 @@

 (defn ifn-invoke-methods [type type-sym [f & meths :as form]]
   (let [proto-fn (get-in (ana/get-namespace 'cljs.core) [:defs f])
-        ;; we don't support varargs here for now, so we drop the last rest fn.
-        meths (remove #(core/> (core/dec (count (first %))) 20) meths)]
-    (map
-     (fn [meth]
-       (let [arity (count (first meth))]
-         `(do
-            ~(with-meta `(fn ~f ~meth) (meta form)))))
-     (map #(adapt-proto-params type proto-fn %) meths))))
-
-;; This generates off-by-one arities, needs fixing. It should also add the missing arities which throws arity.
+        ;; we don't support provided varargs here for now, so we drop the last rest fn.
+        meths (remove #(core/> (core/dec (count (first %))) 20) meths)
+        f (with-meta f {:tag (:ret-tag proto-fn)})
+        missing (for [params (:method-params proto-fn)
+                      :let [body `(throw (js/Error. ~(core/str "Invalid arity: " (core/dec (count params)))))]]
+                  [(count params)
+                   (with-meta `(fn ~f ~(adapt-proto-params type proto-fn `[~params ~body])) (meta form))])
+        provided (for [meth meths]
+                   [(count (first meth))
+                    (with-meta `(fn ~f ~(adapt-proto-params type proto-fn meth)) (meta form))])]
+    (vals (merge (into (sorted-map) missing) (into {} provided)))))
+
 (defn add-ifn-methods [type type-sym [f & meths :as form]]
-  (let [meths    (map #(adapt-ifn-params type %) meths)
-        this-sym (with-meta 'self__ {:tag type})
-        argsym   (gensym "args")]
-    (ifn-invoke-methods type type-sym form)))
+  (ifn-invoke-methods type type-sym form))

 (defn proto-slot-name [fname sig]
   (core/str (-> fname cljs.compiler/munge cljs.compiler/go-public)


Set the namespace for dtb

Set the namespace for dtb

--- src/mdr2/rdf.clj
+++ src/mdr2/rdf.clj
@@ -13,8 +13,7 @@
            totalTime audioFormat type]}]
   [:rdf:DRF {:xmlns:rdf "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
              :xmlns:dc "http://purl.org/dc/elements/1.1/"
-             :xmlns:ncc "http://www.daisy.org/publications/specifications/"
-             :xmlns:sbs "http://www.sbszh.ch/sbs/namespace"}
+             :xmlns:dtb "http://www.daisy.org/z3986/2005/dtbook/"}
    ;; see also
    ;; http://www.daisy.org/z3986/2005/Z3986-2005.html#Over
    [:rdf:Description