refine update transaction test

refine update transaction test

--- test/clj_money/web/transactions_test.clj
+++ test/clj_money/web/transactions_test.clj
@@ -9,7 +9,8 @@
             [clj-money.validation :as validation]
             [clj-money.factories.user-factory]
             [clj-money.test-helpers :refer [reset-db
-                                            with-authentication]]
+                                            with-authentication
+                                            pprint-diff]]
             [clj-money.models.transactions :as transm]
             [clj-money.web.transactions :as transactions]))

@@ -127,31 +128,26 @@
                                            :debit-amount-3 ""}}))
         actual (simplify-transaction (transm/find-by-id storage-spec (:id trans) (t/local-date 2016 1 2)))
         expected {:transaction-date (t/local-date 2016 1 2)
-            :description "Employer"
-            :entity-id (-> context :entities first :id)
-            :memo nil
-            :items [{:action :debit
-                     :account-id (:id checking)
-                     :amount 1001M
-                     :balance 1001M
-                     :index 0
-                     :memo nil}
-                    {:action :credit
-                     :account-id (:id salary)
-                     :amount 901M
-                     :balance 901M
-                     :index 0
-                     :memo nil}
-                    {:action :credit
-                     :account-id (:id bonus)
-                     :amount 100M
-                     :balance 100M
-                     :index 0
-                     :memo nil}]}]
-
-    (when (not= expected actual)
-      (pprint {:expected expected
-               :actual actual
-               :diff (diff expected actual)}))
-
+                  :description "Employer"
+                  :entity-id (-> context :entities first :id)
+                  :memo nil
+                  :items [{:action :debit
+                           :account-id (:id checking)
+                           :amount 1001M
+                           :balance 1001M
+                           :index 0
+                           :memo nil}
+                          {:action :credit
+                           :account-id (:id salary)
+                           :amount 901M
+                           :balance 901M
+                           :index 0
+                           :memo nil}
+                          {:action :credit
+                           :account-id (:id bonus)
+                           :amount 100M
+                           :balance 100M
+                           :index 0
+                           :memo nil}]}]
+    (pprint-diff expected actual)
     (is (= expected actual) "The updated transaction can be retrieved")))


Fixed parser start of range for lists

Fixed parser start of range for lists

--- parser/parser.clj
+++ parser/parser.clj
@@ -47,7 +47,7 @@

 (def parse-list (original-input parse-expressions)
      (match (parse-expressions original-input Empty)
-            (Pair input expressions) (ParseNext input (List expressions (range-between original-input input)))))
+            (Pair input expressions) (ParseNext input (List expressions (Range (- (offset-of original-input) 1) (offset-of input))))))

 (def parse-expression (input parse-expressions)
      (match input


fix incomplete intensity-projection function

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

--- plugins/SlideExplorer2/src/slide_explorer/image.clj
+++ plugins/SlideExplorer2/src/slide_explorer/image.clj
@@ -227,6 +227,7 @@

 (def projection-methods
   {:average ZProjector/AVG_METHOD
+   :mean ZProjector/AVG_METHOD
    :max ZProjector/MAX_METHOD
    :min ZProjector/MIN_METHOD
    :sum ZProjector/SUM_METHOD
@@ -238,14 +239,13 @@
    returning an ImageProcessor of the same type. Methods
    are :average, :max, :min, :sum, :std-dev, :median."
   [method processors]
-  (let [float-processor
-        (->
-          (doto
-            (ZProjector. (ImagePlus. "" (make-stack processors)))
-            (.setMethod (projection-methods method))
-            .doProjection)
-          .getProjection
-          .getProcessor)]
+  (->
+    (doto
+      (ZProjector. (ImagePlus. "" (make-stack processors)))
+      (.setMethod (projection-methods method))
+      .doProjection)
+    .getProjection
+    .getProcessor
     (convert-to-type-like (first processors))))

 (defn gaussian-blur


Create and use wrap-main higher order function.

--- src/incise/core.clj
+++ src/incise/core.clj
@@ -49,16 +49,32 @@
   [args & body]
   `(with-args* ~args (fn [~'args] ~@body)))

+(defn wrap-pre [func pre-func & more]
+  (fn [& args]
+    (apply pre-func more)
+    (apply func args)))
+
+(defn wrap-post [func post-func & more]
+  (fn [& args]
+    (let [return-value (apply func args)]
+      (apply post-func more)
+      return-value)))
+
+(defn wrap-main
+  [main-func]
+  (-> main-func
+      (wrap-pre conf/load)
+      (wrap-post #(System/exit 0))
+      (wrap-log-exceptions :bubble false)))
+
 (defn -main
   "Based on the given args either deploy, compile or start the development
   server."
   [& args]
   (with-args args
     (case (conf/get :method)
-      :deploy (do ((wrap-log-exceptions deploy :bubble false))
-                  (System/exit 0))
-      :once (do ((wrap-log-exceptions once :bubble false))
-                (System/exit 0))
+      :deploy (wrap-main deploy)
+      :once (wrap-main once)
       (serve))))

 (defn restart


Halfway working now

Halfway working now

--- src/qttt/ui/om_ios.cljs
+++ src/qttt/ui/om_ios.cljs
@@ -29,6 +29,10 @@
   [opts & children]
   (apply js/React.createElement js/React.View opts children))

+(defn touchable-without-feedback
+  [opts & children]
+  (apply js/React.createElement js/React.TouchableWithoutFeedback opts children))
+
 (defn class-name
   "Return a class name string given multiple CSS classes. Nil classes are filtered out."
   [& classes]
@@ -39,11 +43,11 @@
   [{:keys [player turn focus collapsing]}]
   (let [icon (if (= 0 player) "fa-plus" "fa-circle-o")
         player-class (if (= 0 player) "player-x" "player-o")]
-    (view #js {:key (str player)
-                 :className (class-name "mark" player-class (when focus "highlight")
-                                        (when collapsing "shake") (when collapsing "shake-constant"))}
-            (view #js {:className (class-name "fa" icon)})
-            (view #js {:className "turn"} turn))))
+    (view #js {:key       (str player)
+               :className (class-name "mark" player-class (when focus "highlight")
+                            (when collapsing "shake") (when collapsing "shake-constant"))}
+      (view #js {:className (class-name "fa" icon)})
+      (view #js {:className "turn"} turn))))

 (defn entanglement
   "Om component for an individual entanglement"
@@ -53,17 +57,18 @@
     (reify
       om/IRender
       (render [this]
-        (view #js {:className (class-name (if (empty? e) "empty-mark" "spooky-mark"))
-                   :onClick (fn [evt]
-                              (om/transact! game-cursor
-                                            #(game/play (game/unspeculate %) cell subcell)))
-                   :onMouseEnter (fn [evt]
+        (touchable-without-feedback #js {:className    (class-name (if (empty? e) "empty-mark" "spooky-mark"))
+                   :onPress      (fn [evt]
                                    (om/transact! game-cursor
-                                                 #(game/speculate % cell subcell)))
-                   :onMouseLeave (fn [evt]
+                                     #(game/play (game/unspeculate %) cell subcell)))
+                   :onPressIn (fn [evt]
+                                   (om/transact! game-cursor
+                                     #(game/speculate % cell subcell)))
+                   :onPressOut (fn [evt]
                                    (om/transact! game-cursor game/unspeculate))}
-              (css-transition-group #js {:transitionName "mark-transition"}
-                                    (when-not (empty? e) (mark e))))))))
+          (text nil (if (empty? e) "e" "m"))
+          #_(css-transition-group #js {:transitionName "mark-transition"}
+            (when-not (empty? e) (mark e))))))))

 (defn superposition
   "Om component for a quantum cell"
@@ -72,17 +77,20 @@
     om/IRender
     (render [this]
       (view #js {:className (class-name "superposition")}
-            (apply table nil
-                   (map (fn [row]
-                          (apply tr nil
-                                 (map (fn [idx]
-                                        ;; Make sure were have a valid cursor
-                                        (let [e (get-in cell [:entanglements idx]
-                                                        (get-in (assoc-in cell [:entanglements idx] {})
-                                                                [:entanglements idx]))]
-                                          (om/build entanglement e)))
-                                      row)))
-                        (partition 3 (range 9))))))))
+        (apply table #js {:style #js {:flexDirection   "row"
+                                      :margin          40
+                                      :backgroundColor "#EE1EEE"
+                                      :justifyContent  "center"}}
+          (map (fn [row]
+                 (apply tr nil
+                   (map (fn [idx]
+                          ;; Make sure were have a valid cursor
+                          (let [e (get-in cell [:entanglements idx]
+                                    (get-in (assoc-in cell [:entanglements idx] {})
+                                      [:entanglements idx]))]
+                            (om/build entanglement e)))
+                     row)))
+            (partition 3 (range 9))))))))

 (defn classical
   "Om component for a classical cell"
@@ -91,7 +99,7 @@
     om/IRender
     (render [this]
       (view #js {:className "classical"}
-            (mark (:classical cell))))))
+        (mark (:classical cell))))))

 (defn cell
   "Om component for a square"
@@ -109,8 +117,8 @@
                              ["player-x" "fa-plus"]
                              ["player-o" "fa-circle-o"])]
         (text #js {:className "instructions"}
-               (view #js {:className (apply class-name "mark" "fa" player-classes)})
-               (str "'s turn: " phase))))))
+          #_(view #js {:className (apply class-name "mark" "fa" player-classes)})
+          (str "'s turn: " phase))))))

 (defn board [game owner]
   (reify
@@ -121,17 +129,24 @@
                                  :margin          40
                                  :backgroundColor "#EE1EEE"
                                  :justifyContent  "center"}}
-             (om/build instructions game)
-             (apply table #js {:className "board"}
-                    (map (fn [row]
-                           (apply tr nil
-                                  (map (fn [idx]
-                                         (om/build cell
-                                                   (get-in game [:board idx]))) row)))
-                         (partition 3 (range 9))))
-             (view #js {:className "repo-link"}
-                    (text #js {:href "http://github.com/levand/qttt"}
-                         "http://github.com/levand/qttt"))))))
+        (om/build instructions game)
+        (apply table #js {:className "board"
+                          :style     #js {:flexDirection   "row"
+                                          :margin          40
+                                          :backgroundColor "#EE1EEE"
+                                          :justifyContent  "center"}}
+          (map (fn [row]
+                 (apply tr {:style #js {:flexDirection   "row"
+                                        :margin          40
+                                        :backgroundColor "#EE1EEE"
+                                        :justifyContent  "center"}}
+                   (map (fn [idx]
+                          (om/build cell
+                            (get-in game [:board idx]))) row)))
+            (partition 3 (range 9))))
+        (view #js {:className "repo-link"}
+          (text #js {:href "http://github.com/levand/qttt"}
+            "http://github.com/levand/qttt"))))))

 (defn screen [game owner]
   (reify
@@ -142,7 +157,7 @@
                                  :margin          40
                                  :backgroundColor "#EE1EEE"
                                  :justifyContent  "center"}}
-            (om/build board game)))))
+        (om/build board game)))))

 (defn ^:export main


replaced popover-color with popover-style

--- src/re_com/popover.cljs
+++ src/re_com/popover.cljs
@@ -146,7 +146,7 @@
    {:name :position       :required false :default :right-below :type "keyword"          :validate-fn position?         :description [:span "relative to this anchor. One of " position-options-list]}
    {:name :width          :required false                       :type "string"           :validate-fn string?           :description "a CSS style describing the popover width"}
    {:name :height         :required false :default "auto"       :type "string"           :validate-fn string?           :description "a CSS style describing the popover height"}
-   {:name :popover-color  :required false :default "white"      :type "string"           :validate-fn string?           :description "fill color of the popover"}
+   {:name :style          :required false                       :type "CSS style map"    :validate-fn css-style?        :description "override popover style(s) with a style map"}
    {:name :arrow-length   :required false :default 11           :type "integer | string" :validate-fn number-or-string? :description "the length in pixels of the arrow (from pointy part to middle of arrow base)"}
    {:name :arrow-width    :required false :default 22           :type "integer | string" :validate-fn number-or-string? :description "the width in pixels of arrow base"}
    {:name :padding        :required false                       :type "string"           :validate-fn string?           :description "a CSS style which overrides the inner padding of the popover"}
@@ -157,7 +157,7 @@

 (defn popover-border
   "Renders an element or control along with a Bootstrap popover"
-  [& {:keys [children position width height popover-color arrow-length arrow-width padding margin-left margin-top tooltip-style? title]
+  [& {:keys [children position width height style arrow-length arrow-width padding margin-left margin-top tooltip-style? title]
       :or {arrow-length 11 arrow-width 22}
       :as args}]
   {:pre [(validate-args-macro popover-border-args-desc args "popover-border")]}
@@ -182,7 +182,7 @@

        :component-function
        (fn
-         [& {:keys [children position width height popover-color arrow-length arrow-width padding margin-left margin-top tooltip-style? title]
+         [& {:keys [children position width height style arrow-length arrow-width padding margin-left margin-top tooltip-style? title]
              :or {arrow-length 11 arrow-width 22}
              :as args}]
          {:pre [(validate-args-macro popover-border-args-desc args "popover-border")]}
@@ -198,7 +198,6 @@
                              {:top "-10000px" :left "-10000px"})
                            (if width  {:width  width})
                            (if height {:height height})
-                           (if popover-color {:background-color popover-color})
                            (when tooltip-style?
                              {:border-radius "4px"
                               :box-shadow    "none"
@@ -219,8 +218,11 @@
                            ;; make it visible and turn off Bootstrap max-width and remove Bootstrap padding which adds an internal white border
                            {:display   "block"
                             :max-width "none"
-                            :padding   (px 0)})}
-            [popover-arrow orientation pop-offset arrow-length arrow-width grey-arrow? tooltip-style? popover-color]
+                            :background "black"
+                            :padding   (px 0)}
+                           style)}
+            [popover-arrow orientation pop-offset arrow-length arrow-width grey-arrow? tooltip-style?
+              (or (:background style) "black")]
             (when title title)
             (into [:div.popover-content {:style {:padding padding}}] children)]))})))

@@ -267,7 +269,7 @@
    {:name :close-button?    :required false  :default true         :type "boolean"                                         :description "when true, displays the close button"}
    {:name :body             :required false                        :type "string | hiccup"  :validate-fn string-or-hiccup? :description "describes the popover body. Must be a single component"}
    {:name :tooltip-style?   :required false  :default false        :type "boolean"                                         :description "setup popover styles for a tooltip"}
-   {:name :popover-color    :required false  :default "white"      :type "string"           :validate-fn string?           :description "fill color of the popover"}
+   {:name :popover-style    :required false                        :type "CSS style map"    :validate-fn css-style?        :description "override popover style(s) with a style map"}
    {:name :arrow-length     :required false  :default 11           :type "integer | string" :validate-fn number-or-string? :description "the length in pixels of the arrow (from pointy part to middle of arrow base)"}
    {:name :arrow-width      :required false  :default 22           :type "integer | string" :validate-fn number-or-string? :description "the width in pixels of arrow base"}
    {:name :padding          :required false                        :type "string"           :validate-fn string?           :description "a CSS style which overrides the inner padding of the popover"}
@@ -275,7 +277,7 @@

 (defn popover-content-wrapper
   "Abstracts several components to handle the 90% of cases for general popovers and dialog boxes"
-  [& {:keys [showing? position no-clip? width height backdrop-opacity on-cancel title close-button? body tooltip-style? popover-color arrow-length arrow-width padding style]
+  [& {:keys [showing? position no-clip? width height backdrop-opacity on-cancel title close-button? body tooltip-style? popover-style arrow-length arrow-width padding style]
       :or {arrow-length 11 arrow-width 22}
       :as args}]
   {:pre [(validate-args-macro popover-content-wrapper-args-desc args "popover-content-wrapper")]}
@@ -296,7 +298,7 @@

        :component-function
        (fn
-         [& {:keys [showing? position no-clip? width height backdrop-opacity on-cancel title close-button? body tooltip-style? popover-color arrow-length arrow-width padding style]
+         [& {:keys [showing? position no-clip? width height backdrop-opacity on-cancel title close-button? body tooltip-style? popover-style arrow-length arrow-width padding style]
              :or {arrow-length 11 arrow-width 22}
              :as args}]
          {:pre [(validate-args-macro popover-content-wrapper-args-desc args "popover-content-wrapper")]}
@@ -316,7 +318,7 @@
            :width          width
            :height         height
            :tooltip-style? tooltip-style?
-           :popover-color  popover-color
+           :style          popover-style
            :arrow-length   arrow-length
            :arrow-width    arrow-width
            :padding        padding
@@ -378,12 +380,12 @@
    {:name :position      :required false :default :below-center :type "keyword"                :validate-fn position?            :description [:span "relative to this anchor. One of " position-options-list]}
    {:name :width         :required false                        :type "string"                 :validate-fn string?              :description "specifies width of the tooltip"}
    {:name :style         :required false                        :type "CSS style map"          :validate-fn css-style?           :description "override component style(s) with a style map, only use in case of emergency"}
-   {:name :popover-color :required false                        :type "string"                 :validate-fn string?              :description "specifies background color of tooltip"}
+   {:name :popover-style :required false                        :type "CSS style map"          :validate-fn css-style?           :description "override popover style(s) with a style map"}
    {:name :tooltip-style :required false                        :type "CSS style map"          :validate-fn css-style?           :description "ovverride tooltip style(s) with a style map"}])

 (defn popover-tooltip
   "Renders text as a tooltip in Bootstrap popover style"
-  [& {:keys [label showing? on-cancel close-button? anchor position width style popover-color tooltip-style] :as args}]
+  [& {:keys [label showing? on-cancel close-button? anchor position width style popover-style tooltip-style] :as args}]
   {:pre [(validate-args-macro popover-tooltip-args-desc args "popover-tooltip")]}
   (let [label         (deref-or-value label)]
     [popover-anchor-wrapper
@@ -397,7 +399,7 @@
                :on-cancel      on-cancel
                :width          width
                :tooltip-style? true
-               :popover-color  (if popover-color popover-color "black")
+               :popover-style  popover-style
                :padding        "3px 8px"
                :arrow-length   6
                :arrow-width    12


Change condp to case for performance

Change condp to case for performance

--- src/reabledit/core.cljs
+++ src/reabledit/core.cljs
@@ -41,7 +41,7 @@
         rows (-> data count dec)
         cols (-> headers count dec)
         f (partial set-selected! state)]
-    (condp = keycode
+    (case keycode
       37 (f current-row (max 0 (dec current-col)))
       38 (f (max 0 (dec current-row)) current-col)
       39 (f current-row (min cols (inc current-col)))


Streams: rename sum and mean to sum-over-time and mean-over-time.

--- src/reimann/streams.clj
+++ src/reimann/streams.clj
@@ -131,7 +131,7 @@
                                   (sorted-sample (deref r) points))]
                     (doseq [event samples] (call-rescue event children))))))

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

-(defn mean [children]
+(defn mean-over-time [children]
   "Emits the most recent event each time this stream is called, but with the
   average of all received metric_fs."
   (let [sum (ref nil)


don't require else-form in if-ns

don't require else-form in if-ns

--- src/useful.clj
+++ src/useful.clj
@@ -40,7 +40,7 @@
   [val coll]
   (some (partial = val) coll))

-(defmacro if-ns [ns-reference then-form else-form]
+(defmacro if-ns [ns-reference then-form & [else-form]]
   "Try to load a namespace reference. If sucessful, evaluate then-form otherwise evaluate else-form."
   `(try (ns ~(.getName *ns*) ~ns-reference)
         (eval '~then-form)


do not break the way `where` works for now.

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -990,7 +990,8 @@
   (let [p (where-rewrite expr)]
     `(let [kids# [~@children]]
       (fn [event#]
-        (when ~p (call-rescue event# kids#))))))
+        (when (let [~'event event#] ~p)
+          (call-rescue event# kids#))))))

 (defn update-index
   "Updates the given index with all events received."


Use new-line over /newline in search output

--- src/kale/search.clj
+++ src/kale/search.clj
@@ -37,5 +37,5 @@
                      query-string)]
       (str (get-msg :found-num-results (:numFound response))
            new-line new-line
-           (str/join \newline (map #(result highlighting %)
+           (str/join new-line (map #(result highlighting %)
                                    (:docs response)))))))


Deprecate within and without

Deprecate within and without

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1512,19 +1512,21 @@

   (within [0 1] (fn [event] do-something))"
   [r & children]
-  (fn stream [event]
-    (when-let [m (:metric event)]
-      (when (<= (first r) m (last r))
-        (call-rescue event children)))))
+  (deprecated "streams/within is deprecated; use (where (< x metric y))"
+              (fn stream [event]
+                (when-let [m (:metric event)]
+                  (when (<= (first r) m (last r))
+                    (call-rescue event children))))))

 (defn without
   "Passes on events only when their metric falls outside the given (inclusive)
   range."
   [r & children]
-  (fn stream [event]
-    (when-let [m (:metric event)]
-      (when-not (<= (first r) m (last r))
-        (call-rescue event children)))))
+  (deprecated "streams/without is deprecated; use (where (not (< x metric y)))"
+              (fn stream [event]
+                (when-let [m (:metric event)]
+                  (when-not (<= (first r) m (last r))
+                    (call-rescue event children))))))

 (defn over
   "Passes on events only when their metric is greater than x"


clean up internal local names

clean up internal local names

--- src/keypin/core.clj
+++ src/keypin/core.clj
@@ -26,14 +26,14 @@

 (defn lookup-key
   "Look up a key in a map or something that implements clojure.lang.ILookup."
-  [the-map the-key validator description property-parser default-value? default-value not-found]
+  [the-map the-key validator description value-parser default-value? default-value not-found]
   (when-not (or (instance? Map the-map)
               (instance? ILookup the-map))
     (i/illegal-arg (format "Key %s looked up in a non map (or clojure.lang.ILookup) object: %s"
                      (pr-str the-key) the-map)))
   (let [value (if (contains? the-map the-key)
                 (->> (get the-map the-key)
-                  (property-parser the-key))
+                  (value-parser the-key))
                 (if default-value?
                   default-value
                   (i/illegal-arg (not-found
@@ -44,7 +44,7 @@

 (defn lookup-keypath
   "Look up a key path in a map or something that implements clojure.lang.ILookup."
-  [the-map ks validator description property-parser default-value? default-value not-found]
+  [the-map ks validator description value-parser default-value? default-value not-found]
   (let [value (loop [data the-map
                      path ks]
                 (when-not (or (instance? Map data)


Implement hashCode for TaggedValue

Implement hashCode for TaggedValue

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -259,8 +259,12 @@
   java.lang.Object
   (equals [t o]
     (and (= (type o) (type t))
-         (= (.tag ^TaggedValue t) (.tag ^TaggedValue o))
-         (= (.rep ^TaggedValue t) (.rep ^TaggedValue o)))))
+         (= (.tag t) (.tag ^TaggedValue o))
+         (= (.rep t) (.rep ^TaggedValue o))))
+  (hashCode [t]
+    (reduce unchecked-multiply-int
+            17
+            [31 (.hashCode (.tag t)) 31 (.hashCode (.rep t))])))

 (defn tagged-value [tag rep] (TaggedValue. tag rep))


4x speedup

4x speedup

--- src/ulam/connect4.clj
+++ src/ulam/connect4.clj
@@ -118,14 +118,9 @@

 (subvec [1 2 3] 0 (dec (count [1 2 3])))

-
 (defn best-child [mtcs path]
-  (last (sort-by #(uct (second %) (:visited (mtcs path)))
-                 (filter (fn [[p node]]
-                           (and (= (count p)
-                                   (inc (count path)))
-                                (= (subvec p 0 (count path))
-                                   path))) mtcs))))
+  (last (sort-by #(uct (mtcs %) (:visited (mtcs path)))
+                 (:children (mtcs path)))))

 (defn simulate-game [state]
   (if-let [result (check-terminal state)]
@@ -133,41 +128,41 @@
     (let [move (rand-nth (valid-moves state))]
       (recur (perform-move state move)))))

-(defn add-node [move state]
-  (if-let [result (check-terminal state)]
-    {:state state :terminal true :visited 0 :score 0 :result result}
-    {:state state :unvisited (set (valid-moves state)) :action move :visited 0 :score 0 :children {}})
-  )
-
 (defn generate-node [mtcs path state]
-  (if-let [result (check-terminal state)]
-    {:state state :terminal true :visited 0 :score 0 :result result}
-    (reduce (fn [coll move]
-              (assoc coll (conj path move) {:state (perform-move state move) :visited 0 :score 0})
-              )
-            mtcs
-            (valid-moves state)))
-  )
+  (reduce (fn [coll move]
+            (let [new-state (perform-move state move)
+                  new-path (conj path move)
+                  terminal-result (check-terminal new-state)]
+              (-> coll
+                  (update-in [path :children] #(conj % new-path))
+                  (assoc new-path
+                           (if terminal-result
+                             {:state new-state :terminal true :visited 0 :score 0 :result terminal-result}
+                             {:state new-state :visited 0 :score 0}))))
+            )
+          mtcs
+          (valid-moves state)))

 (backprop (generate-node {[] {:visited 0 :score 0}} [] (init)) [6] 1)

+(update-in {} [:fuck] #(conj % 1))
 (defn process [mtcs path]
   (let [node (mtcs path)]
-      (cond
-        (> (:visited node) 100)
-        (sort mtcs)
+    (cond
+      (> (:visited node) 1000)
+      (best-child mtcs [])

-        (zero? (:visited node))
-        (recur (-> mtcs
+      (:terminal node)
+      (recur (backprop mtcs path (:result node)) [])
+
+      (zero? (:visited node))
+      (recur (-> mtcs
                  (generate-node path (:state node))
                  (backprop path (simulate-game (:state node))))
-               [])
+             [])

-        (:terminal node)
-        (recur (backprop mtcs path (:result node)) [])
-
-        :else (let [[child-path _] (best-child mtcs path)]
-                (recur mtcs child-path)))))
+      :else (let [child-path (best-child mtcs path)]
+              (recur mtcs child-path)))))

 (time (loop [root {[] {:visited 0 :score 0 :state (init)}}]
    (process root [])))


add tests for lenses

add tests for lenses

--- test/cljs_morphic/test.cljs
+++ test/cljs_morphic/test.cljs
@@ -1,8 +1,11 @@
 (ns cljs-morphic.test
-  (:require [cljs.test]
-        [cljs-morphic.morph :refer [rectangle ellipse image redefine
-                                    move-morph without set-prop add-morphs-to]])
-  (:require-macros [cljs.test :refer [deftest testing is run-all-tests]]))
+  (:require [cemerick.cljs.test :as t]
+            [fresnel.lenses :refer [fetch putback]]
+            [fipp.edn :refer [pprint]]
+            [cljs-morphic.morph :refer [morphic-read rectangle ellipse image redefine
+                                        move-morph without set-prop add-morphs-to add-morph
+                                        submorphs properties description changes $morph it morph-lens]])
+  (:require-macros [cemerick.cljs.test :refer (is deftest with-test run-tests testing test-var)]))

 (def simple-ast
   (rectangle {:id "a"}
@@ -13,6 +16,15 @@
   (rectangle {:id "world" :position {:x 0 :y 0}}
              (ellipse {:id "b" :position {:x 42 :y 42}})
              (image {:id "c" :position {:x 100 :y 100}})))
+
+(def complex-world
+  (rectangle {:id "world" :position {:x 0 :y 0}}
+             (ellipse {:id "b" :position {:x 42 :y 42}}
+                      (ellipse {:id "tea" :fill "black"})
+                      (ellipse {:id "milk" :fill "white"}))
+             (image {:id "c" :position {:x 100 :y 100}}
+                    (rectangle {:id "miso" :fill "red"}
+                               (ellipse {:id "beans" :fill "green"})))))

 (def simple-ast-wrapped
   [(rectangle {:id "a"}
@@ -20,42 +32,310 @@
               (image {:id "c"}))
    (rectangle {:id "hand"})])

+(deftest test-morph-lens
+  (testing "Getting a morph through submorph lenses."
+    (is (= (fetch simple-world [submorphs 0])
+           (ellipse {:id "b" :position {:x 42 :y 42}})))
+    (is (= (fetch complex-world [submorphs 1 submorphs 0 submorphs 0])
+           (ellipse {:id "beans" :fill "green"}))))
+
+  (testing "Acessing morph props through the prop lens."
+    (is (= (fetch simple-world [submorphs 0 properties :position])
+           {:x 42 :y 42}))
+    (is (= (fetch complex-world [submorphs 1 submorphs 0 submorphs 0 properties :fill])
+           "green")))
+
+  (testing "Setting morph props through the prop lens."
+    (is (= (putback simple-world [submorphs 0 properties :position] {:x 100 :y 50})
+           (rectangle {:id "world" :position {:x 0 :y 0}}
+                      (ellipse {:id "b" :position {:x 100 :y 50}})
+                      (image {:id "c" :position {:x 100 :y 100}}))))
+    (is (= (putback complex-world [submorphs 1 submorphs 0 submorphs 0 properties :fill] "black")
+           (rectangle {:id "world" :position {:x 0 :y 0}}
+                      (ellipse {:id "b" :position {:x 42 :y 42}}
+                               (ellipse {:id "tea" :fill "black"})
+                               (ellipse {:id "milk" :fill "white"}))
+                      (image {:id "c" :position {:x 100 :y 100}}
+                             (rectangle {:id "miso" :fill "red"}
+                                        (ellipse {:id "beans" :fill "black"})))))))
+
+  (testing "morph-lens produces lens composition"
+    (is
+     (= (morph-lens simple-world "b" [it])
+        [it submorphs 0])))
+
+  (testing "Getting a morph through lens generator $morph"
+    (is (= (fetch simple-world ($morph "b"))
+           (ellipse {:id "b" :position {:x 42 :y 42}})))
+    (is (= (fetch complex-world ($morph "beans"))
+           (ellipse {:id "beans" :fill "green"})))
+    (is (= (fetch complex-world [($morph "beans") properties :fill])
+           "green"))))
+
+(deftest test-morph-description-lens
+  (testing "Description lens with plain lens composition"
+    (is (= (fetch simple-world [description])
+           (-> simple-world
+             pprint
+             with-out-str))))
+
+  (testing "Description changes are propagated back to morphs"
+    (is
+     (= (cljs.reader/read-string
+         "(image {:id \"c\", :position {:x 0, :y 10}, :extent {:x 42, :y 50}})")
+        (image {:id "c" :position {:x 0 :y 10} :extent {:x 42 :y 50}})))
+    (is
+     (= (putback simple-world [submorphs 1 description]
+                 "(image {:id \"c\", :position {:x 0, :y 10}, :extent {:x 42, :y 50}})")
+        (rectangle {:id "world" :position {:x 0 :y 0}}
+                   (ellipse {:id "b" :position {:x 42 :y 42}})
+                   (image {:id "c" :position {:x 0 :y 10} :extent {:x 42 :y 50}}))))))
+
+(deftest test-morph-change-lens
+  (testing "Changes lens reflects changes that have been introduced to morphs."
+    (is (= (fetch simple-world [submorphs 1 changes])
+           {:structure []
+            :properties {}}))
+    (is (= (-> simple-world
+             (putback [submorphs 1 properties :position] {:x 101 :y 102})
+             (fetch [submorphs 1 changes]))
+           {:recompile? false
+            :structure []
+            :properties {"c" {:position {:x 101 :y 102}}}}))
+    (let [shiro-miso (-> complex-world
+                       (putback [submorphs 1 submorphs 0 properties :fill] "white"))]
+      (is
+       (= (fetch shiro-miso changes)
+          {:recompile? false
+           :structure []
+           :properties {"miso" {:fill "white"}}}))
+      (is
+       (= (fetch shiro-miso [submorphs 1 submorphs 0 changes])
+          {:recompile? false
+           :structure []
+           :properties {"miso" {:fill "white"}}}))
+      (is
+       (= (fetch shiro-miso [submorphs 1 submorphs 0 submorphs 0 changes])
+          {:structure []
+           :properties {}}))))
+
+  (testing "redefine captures add-morph change"
+    (let [redefined-morph (redefine (ellipse {:id "moon"} (rectangle {:id "cheese"}))
+                                    it
+                                    (fn [moon props submorphs]
+                                      (moon props submorphs (ellipse {:id "green"}))))]
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(add-morph "moon" (ellipse {:id "green"}))]
+              :properties {}}))))
+
+  (testing "redefine captures add-morph-before change"
+    (let [redefined-morph (redefine (ellipse {:id "moon"}
+                                             (rectangle {:id "gouda"})
+                                             (rectangle {:id "cheese"}))
+                                    it
+                                    (fn [moon props submorphs]
+                                      (moon props
+                                            (ellipse {:id "green"})
+                                            submorphs)))]
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(add-morph-before "moon" "gouda" (ellipse {:id "green"}))]
+              :properties {}})))
+    (let [redefined-morph (redefine (ellipse {:id "moon"}
+                                             (rectangle {:id "gouda"})
+                                             (rectangle {:id "cheese"}))
+                                    it
+                                    (fn [moon props [gouda cheese]]
+                                      (moon props
+                                            gouda
+                                            (ellipse {:id "green"})
+                                            cheese)))]
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(add-morph-before "moon" "cheese" (ellipse {:id "green"}))]
+              :properties {}}))))
+
+  (testing "redefine captures without morph change"
+    (let [redefined-morph (redefine (ellipse {:id "moon"}
+                                             (rectangle {:id "gouda"})
+                                             (rectangle {:id "cheese"}))
+                                    [submorphs 0]
+                                    (fn [gouda props submorphs]))]
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(without "gouda")]
+              :properties {}}))))
+
+  (testing "shorthand calls to add-morph causes changes"
+    (let [redefined-morph (add-morph (ellipse {:id "moon"}
+                                              (rectangle {:id "gouda"})
+                                              (rectangle {:id "cheese"}))
+                                     "moon"
+                                     (ellipse {:id "green"}))]
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(add-morph "moon" (ellipse {:id "green"}))]
+              :properties {}}))))
+
+  (testing "the submorphs lens transfers property changes"
+    (let [redefined-morph (set-prop (ellipse {:id "moon"}
+                                             (rectangle {:id "gouda"})
+                                             (rectangle {:id "cheese"}))
+                                    "gouda"
+                                    :position {:x 42 :y 24})]
+      (is (= (fetch redefined-morph changes)
+             (fetch redefined-morph [submorphs 0 changes])))
+      (is (= (fetch redefined-morph changes)
+             {:recompile? false
+              :structure []
+              :properties {"gouda" {:position {:x 42 :y 24}}}}))))
+
+  (testing "the submorphs lens transfers structural changes"
+    (let [redefined-morph (add-morph (ellipse {:id "moon"}
+                                              (rectangle {:id "gouda"})
+                                              (rectangle {:id "cheese"}))
+                                     "gouda"
+                                     (ellipse {:id "green"}))]
+      (is (= redefined-morph
+             (ellipse {:id "moon"}
+                      (rectangle {:id "gouda"}
+                                 (ellipse {:id "green"}))
+                      (rectangle {:id "cheese"}))))
+      (is (= (fetch redefined-morph changes)
+             {:recompile? true
+              :structure ['(add-morph "gouda" (ellipse {:id "green"}))]
+              :properties {}}))))
+
+  (testing "Use putback lenses to clarify intention of changes")
+
+  (testing "Changes lens applies changes that have been added by redefining changes."
+    (let [changed-world (putback simple-world [changes]
+                                 {:structure ['(add-morph "c" (rectangle {:id "mops" :fill "brown"}))]
+                                  :properties {"c" {:position {:x 50 :y 50}}
+                                               "b" {:fill "green"}}})]
+      (is (= changed-world
+             (rectangle {:id "world" :position {:x 0 :y 0}}
+                        (ellipse {:id "b" :position {:x 42 :y 42} :fill "green"})
+                        (image {:id "c" :position {:x 50 :y 50}}
+                               (rectangle {:id "mops" :fill "brown"})))))
+      (is (= (fetch changed-world [submorphs 1 submorphs 0 changes])
+             {:structure []
+              :properties {}}))
+      (is (= (fetch changed-world [submorphs 1 changes])
+             {:recompile? true
+              :structure ['(add-morph "c" (rectangle {:id "mops" :fill "brown"}))]
+              :properties {"c" {:position {:x 50 :y 50}}}}))
+      (is (= (fetch changed-world [changes])
+             {:recompile? true
+              :structure ['(add-morph "c" (rectangle {:id "mops" :fill "brown"}))]
+              :properties {"c" {:position {:x 50 :y 50}}
+                           "b" {:fill "green"}}})))))
+
+(defn japanese-kitchen [pos]
+  (rectangle {:id "miso" :fill "red" :position pos}
+             (ellipse {:id "beans" :fill "green"})))
+
+(def expression-world
+  (morphic-read
+   '(rectangle {:id "world" :position {:x 0 :y 0}}
+               (ellipse {:id "b" :position {:x 42 :y 42}}
+                        (map (fn [a b]
+                               (ellipse {:extent {:x a :y b}})) (range 3) (range 3))
+                        (ellipse {:id "tea" :fill "black"})
+                        (ellipse {:id "milk" :fill "white"}))
+               (image {:id "c" :position {:x 100 :y 100}}
+                      (japanese-kitchen {:x 42 :y 42})))))
+
+(deftest test-lenses-and-expressions
+  (testing "An abstraction is preserved yet its submorphs are also accessible."
+    (is (= (fetch expression-world [($morph "c") submorphs 0])
+           '(japanese-kitchen {:x 42 :y 42})))
+    (is (= (fetch expression-world [($morph "c") submorphs 0 submorphs])
+           [(rectangle {:id "miso" :fill "red" :position {:x 42 :y 42}}
+             (ellipse {:id "beans" :fill "green"}))]))
+    (is (= (fetch expression-world [($morph "c") submorphs 0 submorphs 0 properties :position])
+           {:x 42 :y 42})))
+
+  (testing "Redefining an abstraction causes changes in its submorphs."
+    (is (= (-> expression-world
+             (redefine [($morph "c") submorphs 0] (fn [expr]
+                                                    '(japanese-kitchen {:x 100 :y 100})))
+             (fetch [($morph "c") submorphs 0]))
+           '(japanese-kitchen {:x 100 :y 100}))))
+
+  (testing "Redefining the submorphs of an abstraction causes the abstraction to be redefined."
+    (is (= (-> expression-world
+             (set-prop "miso" :position {:x 0 :y 0})
+             (fetch [($morph "c") submorphs 0]))
+           '(-> (japanese-kitchen {:x 42 :y 42})
+              (set-prop "miso" :position {:x 0 :y 0}))))
+    (is (= (-> expression-world
+             (add-morph "miso" (ellipse {:id "sakana" :fill "blue"}))
+             (fetch [($morph "c") submorphs 0]))
+           '(-> (japanese-kitchen {:x 42 :y 42})
+              (add-morph "miso" (ellipse {:id "sakana" :fill "blue"})))))
+    (is (= (-> expression-world
+             (set-prop "miso" :position {:x 0 :y 0})
+             (add-morph "miso" (ellipse {:id "sakana" :fill "blue"}))
+             (fetch [($morph "c") submorphs 0]))
+           '(-> (japanese-kitchen {:x 42 :y 42})
+              (add-morph "miso" (ellipse {:id "sakana" :fill "blue"}))
+              (set-prop "miso" :position {:x 0 :y 0}))))
+    (is (= (-> expression-world
+             (without "miso")
+             (fetch [($morph "c") submorphs 0]))
+           '(-> (japanese-kitchen {:x 42 :y 42})
+              (without "miso")))))
+  (testing "Morphs next to Expressions can still be removed."
+    (is (= (-> expression-world
+                 (without "tea"))
+               '(rectangle {:id "world" :position {:x 0 :y 0}}
+                           (ellipse {:id "b" :position {:x 42 :y 42}}
+                                    (map (fn [a b]
+                                           (ellipse {:extent {:x a :y b}})) (range 3) (range 3))
+                                    (ellipse {:id "milk" :fill "white"}))
+                           (image {:id "c" :position {:x 100 :y 100}}
+                                  (japanese-kitchen {:x 42 :y 42})))))))
+
+(deftest test-render-lens)
+
 (deftest test-set-prop
   (testing "Setting a prop redefines the morph in the ast."
     (is (= (set-prop simple-ast "b" :position {:x 42 :y 314})
-              (rectangle {:id "a"}
-                          (ellipse {:id "b" :position {:x 42 :y 314}})
-                          (image {:id "c"}))))))
+           (rectangle {:id "a"}
+                      (ellipse {:id "b" :position {:x 42 :y 314}})
+                      (image {:id "c"}))))))

 (deftest test-move-morph
   (testing "Moving a morph in the ast."
     (is (= (move-morph simple-world "b" "c")
-               (rectangle {:id "world" :position {:x 0 :y 0}}
-                          (image {:id "c" :position {:x 100 :y 100}}
-                                 (ellipse {:id "b" :position {:x -58 :y -58}})))))))
+           (rectangle {:id "world" :position {:x 0 :y 0}}
+                      (image {:id "c" :position {:x 100 :y 100}}
+                             (ellipse {:id "b" :position {:x -58 :y -58}})))))))

 (deftest test-ast-remove-morph
   (testing "Correct Modification of the morphic AST when removing a morph."
     (is (= (without simple-ast "b")
-              (rectangle {:id "a"}
-              (image {:id "c"}))))))
+           (rectangle {:id "a"}
+                      (image {:id "c"}))))))

 (deftest test-ast-add-morph
   (testing "Correct Modification of the morphic AST when adding a morph."
-    (is (= (add-morphs-to simple-ast "a" (ellipse {:id "x"}))
-              (rectangle {:id "a"}
-                          (ellipse {:id "x"})
-                          (ellipse {:id "b"})
-                          (image {:id "c"}))))))
+    (is (= (add-morph simple-ast "a" (ellipse {:id "x"}))
+           (rectangle {:id "a"}
+                      (ellipse {:id "b"})
+                      (image {:id "c"})
+                      (ellipse {:id "x"}))))))

 (deftest test-ast-add-morphs
   (testing "Correct Modification of the morphic AST when adding multiple morphs."
     (is (= (add-morphs-to simple-ast "a" [(ellipse {:id "x"}) (ellipse {:id "y"})])
-              (rectangle {:id "a"}
-                          (ellipse {:id "x"})
-                          (ellipse {:id "y"})
-                          (ellipse {:id "b"})
-                          (image {:id "c"}))))))
+           (rectangle {:id "a"}
+                      (ellipse {:id "x"})
+                      (ellipse {:id "y"})
+                      (ellipse {:id "b"})
+                      (image {:id "c"}))))))

 (deftest test-wrapped-ast-add-morph
   (testing "Correct Modifaction of a morphic AST starting with a collection of morphs."


play-notes

play-notes

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -140,7 +140,16 @@
    If pitch is omitted (or nil), the note is treated as a rest (a pause in the
    sequence, the length of `duration`."
   [osc-model notes]
-  "TODO")
+
+  ; stop any currently playing oscillators for this osc-model
+  (stop-osc osc-model)
+
+  (reduce (fn [timeout {:keys [pitch duration volume] :as note-model}]
+            (when pitch
+              (c/set-timeout! clock #(play-note osc-model note-model) timeout))
+            (+ timeout duration))
+          0
+          notes))

 (comment "
   TODO:


SQS/SNS Hackfest - Use explicit basic creds.

--- message-queue-lib/src/cmr/message_queue/queue/sqs.clj
+++ message-queue-lib/src/cmr/message_queue/queue/sqs.clj
@@ -24,9 +24,11 @@
    (clojure.lang Keyword Reflector)
    (cmr.message_queue.test ExitException)
    (com.amazonaws ClientConfiguration)
+   (com.amazonaws.auth BasicAWSCredentials)
    (com.amazonaws.auth.policy Condition Policy Principal Resource Statement Statement$Effect)
    (com.amazonaws.auth.policy.actions SQSActions)
    (com.amazonaws.auth.policy.conditions ConditionFactory)
+   (com.amazonaws.regions InMemoryRegionImpl)
    (com.amazonaws.services.sns AmazonSNSClient)
    (com.amazonaws.services.sqs AmazonSQSClient)
    (com.amazonaws.services.sns.util Topics)
@@ -67,23 +69,23 @@
   {:default nil
    :type String})

+(defconfig sqs-extend-policy-remaining-exchanges
+  "When subscribing a queue to a topic, one may override the AWS policy or
+  extend it. CMR's default behaviour for AWS is to not extend the policy
+  of the queue that is bound to the first in a set of exchanges, but to do
+  so for the remaining exchanges.
+
+  When running SQS/SNS locally, however, to keep policy handling simple, we
+  do not want to extend the policies."
+  {:default true
+   :type Boolean})
+
 (defconfig sns-endpoint
   "By default the SNS client will not explicitly set the SNS endpoint. This
   configuration is provided for use in situations where explicitly setting
   the SNS endpoint is desirable or required."
   {:default nil
    :type String})
-
-(defconfig sqs-extend-policy-remaining-exchanges
-  "When subscribing a queue to a topic, one may override the AWS policy or
-  extend it. CMR's default behaviour for AWS is to not extend the policy
-  of the queue that is bound to the first in a set of exchanges, but to do
-  so for the remaining exchanges.
-
-  When running SQS/SNS locally, however, to keep policy handling simple, we
-  do not want to extend the policies."
-  {:default true
-   :type Boolean})

 (defn queue-visibility-timeout
   "Number of seconds SQS should wait after a message is read from a provider queue before making
@@ -287,11 +289,13 @@
   (memoize -get-queue-url))

 (defn set-aws-client-attr!
-  "Conditionally configure the AWS client instance based passed as an argument."
-  [client-obj [method value]]
-  (when (complement (nil? value))
+  "Conditionally configure the AWS client instance with by calling the given
+  method with the given args."
+  [client-obj method args]
+  (when-not (nil? (first args))
+    (info "\tConfig:" method "=" args)
     (Reflector/invokeInstanceMethod
-     client-obj (name method) (object-array [value]))))
+     client-obj (name method) (object-array args))))

 (defn configure-aws-client
   "Configure an AWS service client with values passed pair-wise to the methods
@@ -319,27 +323,35 @@
   it is best to define the default configuration value as nil, so as to avoid
   unexpected client behaviour."
   [client-obj & args]
-  (doall
-    (->> args
-         (partition 2)
-         (map (partial set-aws-client-attr! client-obj))))
+  (info "Configuring client" client-obj)
+  (doseq [[config-key config-vals] (partition 2 args)]
+    (set-aws-client-attr! client-obj config-key config-vals))
   client-obj)

 (defmulti create-aws-client
-  "Create an AWS service client, conditionally setting any configured values."
+  "Create an AWS service client, conditionally setting any configured values.
+
+  Note that if the configuration calls (e.g., `(sqs-endpoint)`) return `nil`,
+  the configuration operation doesn't actually take place."
   identity)

 (defmethod create-aws-client :sqs
   [^Keyword type]
-  (configure-aws-client
-    (new AmazonSQSClient)
-    :setEndpoint (sqs-endpoint)))
+  (let [endpoint (sqs-endpoint)]
+    (if (nil? endpoint)
+      (new AmazonSQSClient)
+      (configure-aws-client
+        (new AmazonSQSClient (new BasicAWSCredentials "unused" "unused"))
+        :setEndpoint [endpoint]))))

 (defmethod create-aws-client :sns
   [^Keyword type]
-  (configure-aws-client
-    (new AmazonSNSClient)
-    :setEndpoint (sns-endpoint)))
+  (let [endpoint (sns-endpoint)]
+    (if (nil? endpoint)
+      (new AmazonSNSClient)
+      (configure-aws-client
+        (new AmazonSNSClient (new BasicAWSCredentials "unused" "unused"))
+        :setEndpoint [endpoint]))))

 (defrecord SQSQueueBroker
   ;; A record containing fields related to accessing SNS/SQS exchanges and queues.


improved body comparison

improved body comparison

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -6,7 +6,8 @@
             [clj-http.client :as client]
             [clojure
              [data :as data]
-             [string :as str]]
+             [string :as str]
+             [test :refer [deftest is run-tests testing]]]
             [clojure.data.csv :as csv]
             [clojure.java.io :as io]
             [clojure.tools.logging :as log])
@@ -27,11 +28,25 @@
    (if-not (str/blank? s)
      (->> (str/split s #"\s*,\s*") (map #(let [[k v] (str/split % sep 2)]
                                            [k (replace-opts v opts)])) (into {})))))
+(defn- diff* [a b]
+  (cond
+    (= a b) nil
+    (map? a) (if (map? b)
+               (let [d (filter #(diff* (second %) (b (first %))) a)]
+                 (if (empty? d) nil (into {} d)))
+               a)
+    (vector? a) (if (vector? b)
+                  (let [e (filter (fn [x] (every? #(diff* x %) b)) a)]
+                    (if (empty? e) nil (vec e)))
+                  a)
+    (string? a) (and (= \# (first a)) (not (re-matches (re-pattern (subs a 1)) (str b)))
+                     a)
+    :else a))

-(defn tests-from [file opts]
+(defn load-tests-from [file opts]
   (with-open [in-file (io/reader file)]
     (reduce
-     (fn[suites [suite test url verb headers payload params exp-status exp-body exp-headers]]
+     (fn [suites [suite test url verb headers payload params exp-status exp-body exp-headers]]
        (let [test-case {:test test :url (replace-opts url opts) :verb verb
                         :headers (str->map headers #":" opts)
                         :params (str->map params #"\s*=\s*" opts)
@@ -67,38 +82,42 @@
                (and (not= status exp-status)
                     (str "status " status " not equal to expected " exp-status))
                (some (fn [[header value]]
-                        (if (not= value (headers header))
-                          (str "header " header " was " (headers header) " expected " value))) exp-headers)
-               (if-let [diff (and (not-empty exp-body) (first (data/diff exp-body body*)))]
+                       (if (not= value (headers header))
+                         (str "header " header " was " (headers header) " expected " value))) exp-headers)
+               (if-let [diff (and (not-empty exp-body) (first (diff* exp-body body*)))]
                  (->> diff json/generate-string (str "expected body missing:" ))))]
     (if error [error resp])))

 (defn test-all [suites]
-  (for [{:keys[suite tests]} suites
-        :let [results (doall (map #(future [(% :test)
-                                            (verify-response (mk-request %) %)]) tests))]]
-    {:suite suite
-     :results results
-     :total (count results)
-     :failures (count (filter #(second @%) results))}))
+  (-> (for [{:keys[suite tests]} suites
+         :let [results (doall (map #(future [(% :test)
+                                             (verify-response (mk-request %) %)]) tests))]]
+     {:suite suite
+      :results results
+      :count (count results)
+      :failures (count (filter #(second @%) results))})
+      (#(hash-map :suites %
+                  :total (reduce + (map :count %))
+                  :total-failures (reduce + (map :failures %))))))

-(defn print-test-results [suites]
-  (let [total (reduce + (map :total suites))
-        fail-count (reduce + (map :failures suites))]
-    (println "=============================================================")
-    (println "Test cases:" total ", failed:" fail-count)
-    (doseq [{:keys [suite results]} suites]
-      (println suite)
-      (doseq [result results :let [[test result] @result]][]
-        (print (if result "\u001B[31m [x] " "\u001B[32m [v] "))
-        (println test "\t" (or (first result) :OK) "\u001B[0m")))))
+(defn print-test-results [{:keys[suites total total-failures]}]
+  (flush)
+  (println "=============================================================")
+  (println "Test cases:" total ", failed:" total-failures)
+  (doseq [{:keys [suite results]} suites]
+    (println suite)
+    (doseq [result results :let [[test result] @result]][]
+           (print (if result "\u001B[31m [x] " "\u001B[32m [v] "))
+           (println test "\t" (or (first result) :OK) "\u001B[0m"))))

 (defn -main
   "Give me a CSV with API rest cases and I will verify them"
   [& args]
-  (let [opts (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) (rest args)))]
-    (println "running with arguments:" opts)
+  (let [opts (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) (rest args)))
+        _ (println "running with arguments:" opts)
+        results (test-all (load-tests-from (first args) opts))]
     (try
-      (print-test-results (test-all (tests-from (first args) opts)))
+      (print-test-results results)
+      (System/exit (:total-failures results))
       (finally
         (shutdown-agents)))))


.accept may return nil

.accept may return nil

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -132,7 +132,13 @@
         (is (ready-for? ready ssh :write)))
       (let [msg (ByteBuffer/wrap (.getBytes "hello world\n"))]
         (.write ssh msg)
-        (is (ready-for? (poll-channels [[ssh :read]] 1000) ssh :read))))))
+        (is (ready-for? (poll-channels [[ssh :read]] 1357) ssh :read))))))
+
+(defn accept-connection [socket]
+  (let [s1 (.accept socket)]
+    (when s1
+      (doto s1
+        (.configureBlocking false)))))

 (defn backend [serversocket host port finished-ch]
   (let [bytebuffer (ByteBuffer/allocate 8192)]
@@ -216,14 +222,15 @@
             ;; Note this may block in connect(), I haven't decided if that's
             ;; bad or not
             (get ready-channels serversocket)
-            (let [sock (doto (.accept serversocket)
-                         (.configureBlocking false))]
+            (let [sock (accept-connection serversocket)]
               (recur nil
-                     (assoc downstreams-for-upstreams
-                            sock
-                            (doto (SocketChannel/open)
-                              (.connect (InetSocketAddress. host port))
-                              (.configureBlocking false)))))
+                     (if sock
+                       (assoc downstreams-for-upstreams
+                              sock
+                              (doto (SocketChannel/open)
+                                (.connect (InetSocketAddress. host port))
+                                (.configureBlocking false)))
+                       downstreams-for-upstreams)))
             :default
             (do
               (println "timeout")


Added 'add' without repeated application of 'add-1'.

--- SICP/ex_2_6.clj
+++ SICP/ex_2_6.clj
@@ -1,4 +1,6 @@
 ; :mode=clojure:
+
+; Church numerals

 (def zero (fn [f] (fn [x] x)))

@@ -9,8 +11,13 @@

 (defn two [f] (fn [x] (f (f x))))

+(defn add [a b]
+    (fn [f] (fn [x] ((a f) ((b f) x)))))
+
 (println
     (((add-1 (add-1 (add-1 (add-1 zero)))) inc) 0)
     ((one inc) 0)
-    ((two inc) 0))
+    ((two inc) 0)
+    (((add one two) inc) 0)
+    (((add (add-1 (add-1 (add-1 zero))) (add-1 (add-1 zero))) inc) 0))


Create single function to build and save a package.

This uses multimethods to replace the type-specific build functions.

--- src/omnibus/core.clj
+++ src/omnibus/core.clj
@@ -233,6 +233,31 @@
    (str "'Opscode " project-name " " version "'")
    "./setup.sh"
    :dir OMNIBUS-HOME-DIR])
+
+(defn build-and-bucket-package
+  "Builds a software bundle of `package-type` of the software described in `project` and subsequently stashes it in S3."
+  [package-type {:keys [project-name]
+                 {:keys [platform platform_version machine]} :os-data
+                 :as project}]
+  (let [name (asset-name package-type project)
+        path (asset-path package-type project)
+        status (apply sh (command-line package-type project))]
+    (log-sh-result
+     status
+     (do
+       (put-in-bucket path
+                      @*bucket-name*
+                      (str platform "-" platform_version "-" machine "/" name)
+                      @*s3-access-key*
+                      @*s3-secret-key*)
+       (str "Created " (name package-type) " package for "
+            project-name " on " platform " "
+            platform_version " "
+            machine))
+     (str "Failed to create " (name package-type) " package for "
+          project-name " on " platform
+          " " platform_version " "
+          machine))))
 (defn build-project
   "Build a project by building all the software in the appropriate build order"
   [project software-descs]


Change vertical arrow caps

Change vertical arrow caps

--- src/tixi/items.cljs
+++ src/tixi/items.cljs
@@ -20,11 +20,11 @@
     (case edge
       :start
       (if (= (direction item) "vertical")
-        (if (g/flipped-by-y? (:input item)) "v" "^")
+        (if (g/flipped-by-y? (:input item)) "∨" "∧")
         (if (g/flipped-by-x? (:input item)) ">" "<"))
       :end
       (if (= (direction item) (if (rect-line? item) "horizontal" "vertical"))
-        (if (g/flipped-by-y? (:input item)) "^" "v")
+        (if (g/flipped-by-y? (:input item)) "∧" "∨")
         (if (g/flipped-by-x? (:input item)) "<" ">")))))

 (defn- replace-char-in-cache! [item cache i chr]


From pg-demo #1

From pg-demo #1

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -14,25 +14,29 @@
   (:import java.util.TimeZone)
   (:gen-class))

-(def large-db false)
+(def large-db true)
+(def insert-chunk-size 10000)
+(def pg-threadpool (cp/threadpool 8))

 (def ora-spec
-  { :classname    "oracle.jdbc.OracleDriver"  ; must be in classpath
-    :subprotocol  "oracle"
-    :subname      "thin:@//10.100.6.231:1521/pvram"
-    :user         (if large-db  "mart_user_bkp"
-                                "mart_user" )
-    :password     "rxlogix"
+  { :classname      "oracle.jdbc.OracleDriver"  ; must be in classpath
+    :subprotocol    "oracle"
+    :subname        "thin:@//10.100.6.231:1521/pvram"
+    :user           (if large-db  "mart_user_bkp"
+                                  "mart_user" )
+    :password       "rxlogix"
   } )

 (def pg-spec
-  { :classname    "org.postgresql.Driver"
-    :subprotocol  "postgresql"
-    :subname      (if large-db  "//localhost:5432/ubuntu_large"
-                                "//localhost:5432/ubuntu" )
+  { :classname      "org.postgresql.Driver"
+    :subprotocol    "postgresql"
+    :subname        "//pg-test-1.cksh17mdz5oo.us-west-1.rds.amazonaws.com:5432/postal"
+    :user           "rxlogix"
+    :password       "rxlogix123"
+
+;   :subname      (if large-db  "//localhost:5432/ubuntu_large"
+;                               "//localhost:5432/ubuntu" )
   } )
-
-(def insert-chunk-size 10000)

 (def column-name-corrections
   "A map used to rename problematic columns with more acceptable names.  In the future,
@@ -115,32 +119,27 @@
     #(take 12345 %)
     identity ))

-(def pg-threadpool (cp/threadpool 4))
-
 (defn result-set->pg-insert [table-name result-set]
   (jdbc/with-db-connection [pg-conn pg-spec]
     (let [rows-inserted     (atom 0)
           table-rows        (@oracle-table-rows table-name)
           result-set        (test-rs-limit-fn result-set) ]
       (doseq [rows-chunk (partition-all insert-chunk-size result-set) ]
-        (let [rows-chunk-new (map #(set/rename-keys % column-name-corrections) rows-chunk) ]
-          (time (apply jdbc/insert! pg-conn table-name rows-chunk-new  ))
-          (println (format "%9d/%9d  %s"    (swap! rows-inserted + (count rows-chunk-new))
-                                            table-rows
-                                            table-name ))
-          (newline) (flush) )))
-
-    (when false
-      (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))))
-  ))
+        (let [
+          rows-chunk-new    (map #(set/rename-keys % column-name-corrections) rows-chunk)
+          start-time        (System/nanoTime)
+        ]
+          (apply jdbc/insert! pg-conn table-name rows-chunk-new  )
+          (println (format "%9d/%9d  %25s  %10.3f"
+                    (swap! rows-inserted + (count rows-chunk-new))
+                    table-rows table-name
+                    (/ (double (- (System/nanoTime) start-time)) 1e9)))
+          (flush) )))))

 (defn proc-table [table-name]
   (let [completed (atom false)]
     (while (not @completed)
+      (Thread/sleep (-> (rand 5) (* 1000) (long)))  ; [0..5) seconds (in millis)
       (println "Processing:" table-name)
       (try
         (jdbc/with-db-connection [ora-conn ora-spec]
@@ -150,7 +149,6 @@
         (reset! completed true)
         (catch Exception ex
           (println (format "    %s failed... will retry" table-name))
-          (Thread/sleep (-> (rand 5) (+ 5) (* 1000) (long)))  ; [5..10) seconds (in millis)
         )))))

 (defn transfer-data []


Default SQLite's user_version to zero.

Default SQLite's user_version to zero.

I saw nil here with Sqlite.jsm.

--- src/datomish/sqlite.cljc
+++ src/datomish/sqlite.cljc
@@ -101,7 +101,9 @@
 (defn get-user-version [db]
   (go-pair
     (let [row (first (<? (all-rows db ["PRAGMA user_version"])))]
-      (:user_version row))))
+      (or
+        (:user_version row)
+        0))))

 (defn set-user-version [db version]
   (execute! db [(str "PRAGMA user_version = " version)]))


Make it easier to incorporate this into a plugin

--- src/dot_utility/core.clj
+++ src/dot_utility/core.clj
@@ -60,8 +60,8 @@
   (emit-dependencies g)
   (println "}"))

-(defn -main [& args]
-  (doseq [f args]
+(defn text->dot-string [f]
+  (with-out-str
     (->> f
          (slurp)
          (split-lines)
@@ -70,3 +70,5 @@
          (insert-root)
          (graphify)
          (emit-dot))))
+
+(defn -main [& args] (doseq [f args] (println  (text->dot-string f))))


Initial implementation of file importing.

--- src/expenses/service.clj
+++ src/expenses/service.clj
@@ -4,24 +4,35 @@
             [io.pedestal.http.body-params :as body-params]
             [io.pedestal.http.ring-middlewares :as ring-middlewares]
             [io.pedestal.http.route.definition :refer [defroutes]]
+            [io.pedestal.interceptor :as interceptor]
             [ring.util.response :as ring-resp]
             [clojure.java.io :as io]
-            [expenses.db :as db]))
+            [expenses.db :as db]
+            [expenses.parser :as parser]))

-(defn list-financial-records [request]
+(defn list-financial-records [_]
   (ring-resp/response (db/all-financial-records)))

 (defn list-financial-record [{{id :id} :path-params}]
   (ring-resp/response (db/financial-record-by-id (Long/parseLong id))))

-(defn test-file-request [request]
-  (clojure.pprint/pprint request)
-  (ring-resp/response (str (get-in request [:headers "content-length"]))))
+(defn import-file [request]
+  (let [file (get-in request [:multipart-params "file" :tempfile])]
+    (-> file
+        parser/transform-file
+        db/import-financial-records!))
+  (ring-resp/redirect "/financial-record"))
+
+(interceptor/defon-request long-content-length
+  [request]
+  (if-let [c-len (get-in request [:headers "content-length"])]
+    (assoc-in request [:headers "content-length"] (long c-len))))

 (defroutes routes
   [[["/financial-record" {:get list-financial-records
-                          :post test-file-request}
-     ^:interceptors [(body-params/body-params)
+                          :post import-file}
+     ^:interceptors [(body-params/body-params)
+                     long-content-length
                      (ring-middlewares/multipart-params)
                      bootstrap/json-body]
      ["/:id" {:get list-financial-record}]]]])


update exception message

update exception message

--- src/graphql_clj/type.clj
+++ src/graphql_clj/type.clj
@@ -180,11 +180,11 @@
   "Get the type of a field definied in given 'type-name'."
   [schema type-name field-name]
   (if (nil? type-name)
-    (throw (ex-info "get-field-type: type-name is NULL!" {:type-name type-name
-                                                           :field-name field-name})))
+    (throw (ex-info (format "get-field-type: type-name is NULL for field(%s)!" field-name) {:type-name type-name
+                                                                                :field-name field-name})))
   (if (nil? field-name)
-    (throw (ex-info "get-field-type: field-name is NULL!" {:type-name type-name
-                                                           :field-name field-name})))
+    (throw (ex-info (format "get-field-type: field-name is NULL in type(%s)!" type-name) {:type-name type-name
+                                                                                :field-name field-name})))
   (let [type (get-type-in-schema schema type-name)
         field-type (get-in type [:fields field-name :type-field-type])
         field-type-kind (:kind field-type)]


remove more unused imports

remove more unused imports

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -4,7 +4,6 @@
             [clojure.tools.logging :as log]
             [korma.core :refer :all]
             [metabase.config :as config]
-            [metabase.db :refer :all]
             [metabase.driver.query-processor :as qp]
             (metabase.driver.generic-sql [native :as native]
                                          [util :refer :all])


adding that missing convert function without an actual implementation

--- src/watney/core.clj
+++ src/watney/core.clj
@@ -1,6 +1,7 @@
 (ns watney.core)

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(defn convert
+  "Convert the HTML string given into Markdown"
+  [html-string]
+  html-string)
+


Allow empty strings in ::t.d-c.derivation.text/mappings

--- backend/specs/akvo/lumen/specs/transformation.clj
+++ backend/specs/akvo/lumen/specs/transformation.clj
@@ -236,8 +236,7 @@
 (s/def ::transformation.derive-category/target (s/keys
                                                :req-un [::transformation.derive-category.target/column]))

-(s/def ::transformation.derive-category.derivation.text/mappings (s/coll-of (s/tuple (s/coll-of ::lumen.s/non-empty-string :kind vector? :min-count 1) ::lumen.s/non-empty-string) :kind vector? :min-count 1))
-
+(s/def ::transformation.derive-category.derivation.text/mappings (s/coll-of (s/tuple (s/coll-of string? :kind vector? :min-count 1) string?) :kind vector? :min-count 1))

 (s/def ::transformation.derive-category.derivation.number/op #{">" "<" ">=" "<=" "="})


WIP: finances.

WIP: finances.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -110,7 +110,9 @@
 (defn- metric
   ([label value] (metric label value false))
   ([label value currency]
-  (let [formatted-value (.format (java.text.NumberFormat/getInstance java.util.Locale/US) (int value))
+  (let [formatted-value (if (number? value)
+                          (.format (java.text.NumberFormat/getInstance java.util.Locale/US) (int value))
+                          value)
         final-value (if currency (str currency formatted-value) formatted-value)] ; TODO negative currency
                                                                                ; TODO max 3 digits
     [:table {:class "metric"}
@@ -149,7 +151,7 @@
         date (s/upper-case (f/unparse monthly-date period))
         cash? (:cash finances)
         revenue? (:revenue finances)
-        costs? (and (not revenue?) (:costs finances))
+        costs? (:costs finances)
         cash-flow? (and revenue? costs?)
         burn-rate? (and cash? (or costs? cash-flow?))]
     [:table {:class "finances-metrics"}
@@ -157,13 +159,13 @@
         [:td
           (when cash? (metric (str "CASH - " date) (:cash finances) "$")) ; TODO other currencies
           (when revenue? (metric (str "REVENUE - " date) (:revenue finances) "$")) ; TODO other currencies
-          (when costs? (metric (str "COSTS - " date) (:costs finances) "$"))]]])) ; TODO other currencies
-          ; (when (or cash-flow? burn-rate?)
-          ;   [:p {:class "metric"} "$-211K"]
-          ;   [:p {:class "label"} "CASH FLOW - OCT 2016"])
-          ; (when (and cash? burn-rate?)
-          ;   [:p {:class "metric"} "1 year"]
-          ;   [:p {:class "label"} "RUNWAY - OCT 2016"])]]]))
+          (when costs? (metric (str "COSTS - " date) (:costs finances) "$")) ; TODO other currencies
+          (when (or cash-flow? burn-rate?)
+            (if cash-flow?
+              (metric (str "CASH FLOW - " date) 25 "$") ; TODO other currencies
+              (metric (str "BURN RATE - " date) 50 "$"))) ; TODO other currenciesk
+          (when (and cash? burn-rate?)
+            (metric (str "RUNWAY - " date) "1 year"))]]]))

 (defn- data-topic [snapshot topic-name topic topic-url]
   (let [currency (:currency snapshot)


upgraded faq back button to use browser history

--- src/prais2/faqs.cljc
+++ src/prais2/faqs.cljc
@@ -83,6 +83,9 @@
                        (vec (zipmap (range) faq-sections))))])

+(defn go-back [event]
+  (.go js/history -1))
+
 (rum/defc render-faq-section [[section-ix ix :as faq-ref]]
   (prn "render-faq-section " faq-ref)
   [:.faq.col-sm-10.col-sm-offset-1.col-md-7.col-md-offset-1
@@ -110,8 +113,8 @@
         [:button.btn.btn-primary.back
          ; :todo: replace with a call on history
          {:key 3
-          :on-click #(core/click->event-bus % :faqs nil "faqs")
-          :on-touch-start #(core/click->event-bus % :faqs nil "faqs")
+          :on-click go-back                                 ;#(core/click->event-bus % :faqs nil "faqs")
+          :on-touch-start go-back                           ;#(core/click->event-bus % :faqs nil "faqs")
           }
          "Back"
          ]])])


code for drawing tiles

code for drawing tiles

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

--- plugins/SlideExplorer2/src/slide_explorer/display.clj
+++ plugins/SlideExplorer2/src/slide_explorer/display.clj
@@ -47,7 +47,7 @@

 ;; tile/pixels

-(defn tile-locations-in-pixels [[nx ny] [tile-width tile-height]]
+(defn tile-to-pixels [[nx ny] [tile-width tile-height]]
   [(* nx tile-width) (* ny tile-height)])

 (defn round-int
@@ -68,12 +68,12 @@

 ;; pixels/stage

-(defn pixels-to-stage [^AffineTransform transform [x y]]
-  (let [p (.transform transform (Point2D$Double. x y) nil)]
+(defn pixels-to-stage [^AffineTransform pixel-to-stage-transform [x y]]
+  (let [p (.transform pixel-to-stage-transform (Point2D$Double. x y) nil)]
     [(.x p) (.y p)]))

-(defn stage-to-pixels [^AffineTransform transform [x y]]
-  (let [p (.inverseTransform transform (Point2D$Double. x y) nil)]
+(defn stage-to-pixels [^AffineTransform pixel-to-stage-transform [x y]]
+  (let [p (.inverseTransform pixel-to-stage-transform (Point2D$Double. x y) nil)]
     [(.x p) (.y p)]))

 ;; tile image handling
@@ -84,15 +84,13 @@
 (defn awt-image [^TaggedImage tagged-image]
   (.getImage (ImagePlus. "" (ImageUtils/makeProcessor tagged-image))))

-(def visible-tiles (agent {}))
-
 (defn get-tile [[nx ny nz nc nt nzoom]]
   (grab-tagged-image))

 (defn add-tile [tile-map indices]
   (assoc tile-map indices (get-tile indices)))

-(defn add-to-visible-tiles [indices]
+(defn add-to-visible-tiles [visible-tiles indices]
   (send-off visible-tiles add-tile indices))

 ;; gui utilities
@@ -147,8 +145,7 @@
         (.dispose window)
         (.setUndecorated window true)
         (.setFullScreenWindow device window)
-        (.show window)
-        )
+        (.show window))
       (let [window (.getFullScreenWindow device)]
         (.setFullScreenWindow device nil)
         (when window
@@ -165,8 +162,6 @@

 (defrecord screen-properties [x y z width height zoom])

-(def screen-state (atom nil))
-
 (defn snap-image []
   (. mmc snapImage)
   (. mmc getTaggedImage))
@@ -178,15 +173,6 @@
 (defn get-image-dimensions [^TaggedImage tagged-image]
   [(MDUtils/getWidth (.tags tagged-image))
    (MDUtils/getHeight (.tags tagged-image))])
-
-(defn buffered-image
-  ([[w h] pixels]
-    (let [image (ImageIO/read (ByteArrayInputStream. pixels))
-          raster (cast WritableRaster (.getData image))]
-      (.setPixels raster 0 0 w h pixels)
-      image))
-  ([^TaggedImage tagged-image]
-    (buffered-image (get-image-dimensions tagged-image) (.pix tagged-image))))

 (defn enable-anti-aliasing
   ([^Graphics g]
@@ -199,19 +185,21 @@
                            RenderingHints/VALUE_ANTIALIAS_ON
                            RenderingHints/VALUE_ANTIALIAS_OFF)))))

-(defn draw-tile [^Graphics2D g image-data]
-  (.drawImage g (buffered-image [512 512] (:pixels image-data))
-              (AffineTransform.) nil))
-
-(defn paint-tiles [canvas screen-state]
+(defn paint-tiles [^Graphics2D g visible-tiles]
+  (doseq [[[nx ny nz nt nc nzoom] tagged-image] visible-tiles]
+    (let [[x y] (tile-to-pixels [nx ny] [512 512])]
+      (when tagged-image
+        (.drawImage g (awt-image tagged-image)
+                    x y nil)))))
+
+(defn paint-screen [canvas screen-state visible-tiles]
   (let [g (.getGraphics canvas)
         image @slide-explorer.image/image]
     (doto g
+      (.translate (:x @screen-state) (:y @screen-state))
       enable-anti-aliasing
-      (.drawImage image (:x @screen-state) (:y @screen-state) nil)
-      (.drawImage image (+ 513 (:x @screen-state)) (:y @screen-state) nil)
-      (.drawImage image (:x @screen-state) (+ 513 (:y @screen-state)) nil)
-      (.drawImage image (+ 513 (:x @screen-state)) (+ 513 (:y @screen-state)) nil)
+      (paint-tiles @visible-tiles)
+      (.translate (- (:x @screen-state)) (- (:y @screen-state)))
       (.setColor (Color. 0x00A08F))
       (.fillOval (- (+ (/ (:width @screen-state) 2)
                        (:x @screen-state))
@@ -225,9 +213,6 @@
                    (int 0)
                    (int (- (:height @screen-state) 10))))))

-(defn paint-screen [canvas screen-state]
-  (paint-tiles canvas screen-state))
-
 (defn handle-drags [component position-atom]
   (let [drag-origin (atom nil)
         mouse-adapter
@@ -268,15 +253,15 @@
                           (update-size)))))
   size-atom)

-(defn reflect-changes [canvas screen-state]
-  (add-watch screen-state "display"
-    (fn [_ _ _ new-state]
-      (.repaint canvas))))
-
-(defn main-canvas [screen-state]
+(defn display-follow [canvas reference]
+  (add-watch reference "display"
+    (fn [_ _ _ _]
+      (.repaint canvas))))
+
+(defn main-canvas [screen-state visible-tiles]
   (doto
     (proxy [Canvas] []
-      (paint [^Graphics g] (paint-screen this screen-state)))
+      (paint [^Graphics g] (paint-screen this screen-state visible-tiles)))
     (.setBackground Color/BLACK)))

 (defn main-frame []
@@ -286,15 +271,22 @@

 (defn show []
   (let [screen-state (atom (sorted-map :x 0 :y 0 :z 0))
-        canvas (main-canvas screen-state)
+        visible-tiles (agent {})
+        canvas (main-canvas screen-state visible-tiles)
         frame (main-frame)]
+    (def vt visible-tiles)
+    (def ss screen-state)
     (.add (.getContentPane frame) canvas)
     (setup-fullscreen frame)
     (handle-drags canvas screen-state)
     (handle-wheel canvas screen-state)
     (handle-resize canvas screen-state)
-    (reflect-changes canvas screen-state)
+    (display-follow canvas screen-state)
+    (display-follow canvas visible-tiles)
     canvas))

+(defn test-tile [nx ny]
+  (add-to-visible-tiles vt [nx ny 0 0 0 0]))
+
 ;;;;;;;;


When no metadata exists getting app doesn't show metadata:null.

--- src/onix/persistence.clj
+++ src/onix/persistence.clj
@@ -36,9 +36,9 @@
   (when-let [application (dynamo/with-client
                            @dynamo-client
                            (dynamo/get-item applications-table {:hash_key application-name}))]
-    (let [metadata (cheshire/parse-string (:metadata application) true)]
-      (prn "GET APP" (assoc application :metadata metadata))
-      (assoc application :metadata metadata))))
+    (if-let [metadata (cheshire/parse-string (:metadata application) true)]
+      (assoc application :metadata metadata)
+      application)))

 (defn get-application-metadata-item
   [application-name key]


Catch NoNodeException and return nil for children of non-existing node (#883)

--- src/onyx/log/curator.clj
+++ src/onyx/log/curator.clj
@@ -123,13 +123,15 @@
        (catch KeeperException$NoNodeException e false)))

 (defn children
-  ([^CuratorFramework client path & {:keys [watcher]}]
-   (let [children-builder ^GetChildrenBuilder (.getChildren client)]
-     (if watcher
-       (.forPath ^GetChildrenBuilder (.usingWatcher children-builder
-                                                    ^Watcher (make-watcher watcher))
-                 path)
-       (.forPath ^GetChildrenBuilder children-builder path)))))
+  [^CuratorFramework client path & {:keys [watcher]}]
+  (try
+    (let [children-builder ^GetChildrenBuilder (.getChildren client)]
+      (if watcher
+        (.forPath ^GetChildrenBuilder (.usingWatcher children-builder
+                                                     ^Watcher (make-watcher watcher))
+                  path)
+        (.forPath ^GetChildrenBuilder children-builder path)))
+    (catch KeeperException$NoNodeException e nil)))

 (defn data [^CuratorFramework client path]
   (let [stat ^Stat (Stat.)


Minor code improvements

Minor code improvements

--- src/org/akvo/resumed.clj
+++ src/org/akvo/resumed.clj
@@ -5,7 +5,7 @@
 (ns org.akvo.resumed
   (:require [clojure.string :as str]
             [clojure.java.io :as io])
-  (:import java.io.File
+  (:import [java.io File FileOutputStream ByteArrayOutputStream]
            java.util.UUID
            javax.xml.bind.DatatypeConverter))

@@ -81,8 +81,8 @@
           (if (not= (:offset found) off)
             {:status 409
              :body "Conflict"}
-            (with-open [tmp (java.io.ByteArrayOutputStream.)
-                        fos (java.io.FileOutputStream. (:file found) true)]
+            (with-open [tmp (ByteArrayOutputStream.)
+                        fos (FileOutputStream. (:file found) true)]
               (io/copy (:body req) tmp)
               (.write fos (.toByteArray tmp))
               (swap! current-uploads update-in [id :offset] + off len)


clean up empty let bindings

clean up empty let bindings

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -201,9 +201,7 @@
   ([position target]
      (let [id (alloc-id :node)]
        (group (str "Group-" id) id position target)))
-  ([name position target]
-     (let []
-       (group name (alloc-id :node) position target)))
+  ([name position target] (group name (alloc-id :node) position target))
   ([name id position target]
      (ensure-connected!)
      (let [pos    (if (keyword? position) (get NODE-POSITION position) position)


println doesn't need to be in let statement

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -87,8 +87,8 @@
         last-timestamp  (atom 0)
         conversations   (atom {})]
     (endlessly poll-interval
-      (let [foo (println "poll > " @last-timestamp)
-            new-votes (poll pg-spec @last-timestamp)
+      (println "poll >" @last-timestamp)
+      (let [new-votes (poll pg-spec @last-timestamp)
             split-votes (split-by-conv new-votes)]
         (doseq [[zid votes] split-votes]
           (let [lastVoteTimestamp (:created (last votes))]


rethrowing using throw+

rethrowing using throw+

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -141,7 +141,7 @@
               (->Container node ct* extended network*)
               (catch [:status 500] e
                 (warn "Container already exists" e) (throw e))
-              (catch Throwable e (release-ip ip :proxmox) (throw e)))))
+              (catch Throwable e (release-ip ip :proxmox)  (throw+ e)))))

   (delete [this]
      (try


Reformat code

Reformat code

Change-Id: I68c3a839e7aef03b46570574fe82b996ef19a414

--- src/qcast/infoq/site.clj
+++ src/qcast/infoq/site.clj
@@ -51,6 +51,7 @@
       ;; (pre-cond not= "http://www.infoq.com/error?sc=404")
       ))

+
 ;;; Interface

 (defn base-url [& s]
@@ -90,7 +91,11 @@
         [url length type]))))

 (defn presentations [index]
-  (-> (base-url "/presentations/" index) GET html/dom overview-ids))
+  (->> index
+       (base-url "/presentations/")
+       GET
+       html/dom
+       overview-ids))

 (defn presentation [id]
   (-> id


Added item hovering and selection to dropdown.

--- src/re_com/dropdown.cljs
+++ src/re_com/dropdown.cljs
@@ -14,24 +14,37 @@
 ;; style
 ;; options is   {::id id  :label "DDDD"  :group  "XXXX"  }

+(defn opt-item
+  []
+  (let [mouse-over? (reagent/atom false)]
+    (fn [opt on-click]
+      [:li
+       {:class         (str "active-result" (when @mouse-over? " highlighted"))
+        :on-mouse-over #(reset! mouse-over? true)
+        :on-mouse-out  #(reset! mouse-over? false)
+        :on-click      #(on-click (:index opt))
+        :value         (:value opt)}
+       (:label opt)])))
+
+
 (defn single-drop-down
   [& {:keys [options model placeholder]}]
   "Render a bootstrap styled choosen"
   (let [id                (gensym "select_")
         has-focus         (reagent/atom false)
         drop-showing?     (reagent/atom false)
-        mouse-over?       (reagent/atom false)
         filter-text       (reagent/atom "")
-        backdrop-callback #(reset! drop-showing? false)
-        click-handler     #(reset! drop-showing? (not @drop-showing?))
+        backdrop-click    #(reset! drop-showing? false)
+        dropdown-click    #(reset! drop-showing? (not @drop-showing?))
+        item-click        #(do
+                            (reset! model %)
+                            (reset! drop-showing? false)
+                            (reset! filter-text ""))
         ]
     (fn []
       [:div
        {:class (str "chosen-container chosen-container-single" (when @drop-showing? " chosen-container-active chosen-with-drop"))
-        :style {:width "300px"
-                ;:display "inline-block"
-                }
-        }
+        :style {:width "300px"}}
        (when @drop-showing?
          [:div
           {:style {:position         "fixed"
@@ -41,11 +54,11 @@
                    :height           "100%"
                    :background-color "black"
                    :opacity          0.05}
-           :on-click backdrop-callback}])
+           :on-click backdrop-click}])
        [:a.chosen-single.chosen-default
-        {:on-click  click-handler
+        {:on-click  dropdown-click
          :tab-index "-1"}
-        [:span placeholder]
+        [:span (if @model (:label (nth options @model)) placeholder)]
         [:div [:b]]]
        [:div.chosen-drop
         [:div.chosen-search
@@ -53,15 +66,17 @@
           {:type          "text"
            :auto-complete "off"
            :tab-index     "2"
+           :value         @filter-text
            :on-change     #(reset! filter-text (-> % .-target .-value))}]]
         [:ul.chosen-results
-         (let [re        (js/RegExp. @filter-text "i")
-               filter-fn (partial (fn [re opt] (.test re (:label opt))) re)]
+         (let [index     (atom -1)
+               options   (reduce #(conj %1 (assoc %2 :index (swap! index inc))) [] options)
+               re        (try
+                           (js/RegExp. @filter-text "i")
+                           (catch js/Object e nil))
+               filter-fn (partial (fn [re opt]
+                                    (when-not (nil? re) (.test re (:label opt)))) re)
+               ]
            (doall (for [opt (filter filter-fn options)]       ;; doall prevents warning (https://github.com/holmsand/reagent/issues/18)
-                    ^{:key (:value opt)} [:li
-                                        {:class         (str "active-result" (when @mouse-over? " highlighted")) ;;@mouse-over?
-                                         :on-mouse-over #(reset! mouse-over? true)
-                                         :on-mouse-out  #(reset! mouse-over? false)
-                                         :value         (:value opt)}
-                                        (:label opt)])))]]
+                    ^{:key (:value opt)} [opt-item opt item-click])))]]
        ])))


CMR-662: Added tests for AQL query parameters.

--- test/cmr/system_int_test/search/aql_search_test.clj
+++ test/cmr/system_int_test/search/aql_search_test.clj
@@ -99,6 +99,37 @@
          "SH%RT" [coll1 coll2 coll3 coll4 coll5 coll6]
          "S%R_" [coll1 coll2 coll3 coll4 coll5 coll6])))

+(deftest aql-search-with-query-parameters
+  (let [make-coll (fn [n entry-title]
+                    (d/ingest "PROV1" (dc/collection {:short-name entry-title
+                                                      :entry-title (str "coll" n)})))
+        coll1 (make-coll 1 "SHORT")
+        coll2 (make-coll 2 "SHORT")
+        coll3 (make-coll 3 "SHORT")
+        coll4 (make-coll 4 "SHORT")]
+    (index/refresh-elastic-index)
+    ;; invalid query parameter
+    (is (= {:errors ["Parameter [foo] was not recognized."]
+            :status 422}
+           (search/find-refs-with-aql :collection
+                                      [{:shortName "SHORT"}]
+                                      {}
+                                      {:query-params {:foo true}})))
+    (are [search-str params items]
+         (let [refs (search/find-refs-with-aql :collection [{:shortName search-str}]
+                                               {} {:query-params params})
+               result (d/refs-match? items refs)]
+           (when-not result
+             (println "Expected:" (pr-str (map :entry-title items)))
+             (println "Actual:" (pr-str (map :name (:refs refs)))))
+           result)
+         ;; Exact matches
+         "SHORT" {:page-size 1} [coll1]
+         "SHORT" {:page-size 1 :page-num 3} [coll3]
+         ; TODO - enable this test when sort-key is supported
+         ;"SHORT" {:sort-key :entry-title} [coll2]
+         "SHORT" {} [coll1 coll2 coll3 coll4])))
+

 (deftest aql-search-with-multiple-conditions
   (let [coll1 (d/ingest "PROV1" (dc/collection {:entry-title "Dataset1"


Testing multiple calls to dynamic resolver

--- test/com/wsscode/pathom/connect/run_graph_test.cljc
+++ test/com/wsscode/pathom/connect/run_graph_test.cljc
@@ -1119,6 +1119,39 @@
                     :extended-nodes    #{2}
                     :root              2})))

+  (testing "multiple calls to dynamic resolver"
+    (is (= (compute-run-graph*
+             (-> {::pc/index-resolvers {'dynamic-resolver {::pc/sym               'dynamic-resolver
+                                                           ::pc/cache?            false
+                                                           ::pc/dynamic-resolver? true
+                                                           ::pc/resolve           (fn [_ _])}}
+                  ::resolvers          [{::pc/sym    'b
+                                         ::pc/input #{:a}
+                                         ::pc/output [:b]}]
+                  ::pc/index-oir       {:a {#{} #{'dynamic-resolver}}
+                                        :c {#{:b} #{'dynamic-resolver}}}
+                  ::eql/query          [:c]}))
+
+           '#::pcrg{:nodes             {1 {::pc/sym          dynamic-resolver
+                                           ::pcrg/node-id    1
+                                           ::pcrg/requires   {:release/script {}
+                                                              :label/type     {}}
+                                           ::pcrg/provides   {:release/script {}
+                                                              :label/type     {}}
+                                           ::pcrg/after-node 2}
+                                        2 {::pc/sym        id
+                                           ::pcrg/node-id  2
+                                           ::pcrg/requires #:db{:id {}}
+                                           ::pcrg/provides {:release/script {}
+                                                            :db/id          {}
+                                                            :label/type     {}}
+                                           ::pcrg/run-next 1}}
+                    :index-syms        {dynamic-resolver #{1} id #{2}}
+                    :unreachable-attrs #{}
+                    :unreachable-syms  #{}
+                    :extended-nodes    #{2}
+                    :root              2})))
+
   (testing "inner repeated dependencies"
     (is (= (compute-run-graph*
              (-> {::pc/index-resolvers {'dynamic-resolver {::pc/sym               'dynamic-resolver


No need for do in example code.

No need for do in example code.

--- src/tranjlator/bing.clj
+++ src/tranjlator/bing.clj
@@ -98,15 +98,14 @@

   (def translator (-> (->translator :de out-chan) component/start))

-  (do
-    (let [out-chan (chan 1)]
-      (a/>!! (:ctrl-chan translator) {:topic "original"
-                                      :language :en
-                                      :content "Hello, World!"
-                                      :content-sha "foo"
-                                      :original-sha "foo"
-                                      :user-name "bar"})
-      (a/<!! out-chan)))
+  (let [out-chan (chan 1)]
+    (a/>!! (:ctrl-chan translator) {:topic "original"
+                                    :language :en
+                                    :content "Hello, World!"
+                                    :content-sha "foo"
+                                    :original-sha "foo"
+                                    :user-name "bar"})
+    (a/<!! out-chan))

   )


Improve dev/test-all

Improve dev/test-all

--- resources/leiningen/new/lambone/common/env/dev/src/dev.clj
+++ resources/leiningen/new/lambone/common/env/dev/src/dev.clj
@@ -1,13 +1,13 @@
 (ns dev
   (:require boot
             [clojure.pprint :refer [pprint]]
-            [clojure.test :refer [run-all-tests]]
+            [clojure.test :as test]
             [clojure.reflect :refer [reflect]]
             [clojure.repl :refer [apropos dir doc find-doc pst source]]
-            [clojure.tools.namespace.repl :as tnr]
+            [clojure.tools.namespace.find :as tnfind]
+            [clojure.java.classpath :as jcpath]
             [clojure.java.io :as io]
-            [mount.core :as mount :refer [start-without start-with start-with-states
-                                          stop-except only except swap swap-states with-args]]
+            [mount.core :as mount]
             [mount.tools.graph :as mount-graph]
             [clojure.tools.logging :as log :refer [spy spyf]]
             [adzerk.env :refer [env]]
@@ -33,7 +33,11 @@
   :ready)

 (defn test-all []
-  (run-all-tests #"<<name>>.*test$"))
+  (let [test-namespaces (->> (jcpath/classpath-directories)
+                             (tnfind/find-namespaces)
+                             (filter #(re-find #"booma.*-test$" (str %))))]
+    (run! require test-namespaces)
+    (apply test/run-tests test-namespaces)))

 ;; Deps


imperative solution for p28

imperative solution for p28

--- src/rwn4clojure/core.clj
+++ src/rwn4clojure/core.clj
@@ -222,6 +222,38 @@
                   back-half (->> vs reverse (take n))]
               (= front-half back-half)))]
     (is (all? (p27 f)))))
+
+(defn p28 [__]
+  [(= (__ '((1 2) 3 [4 [5 6]])) '(1 2 3 4 5 6))
+   (= (__ ["a" ["b"] "c"]) '("a" "b" "c"))
+   (= (__ '((((:a))))) '(:a))])
+(deftest t28
+  (let [f (fn [form]
+            (let [todo (atom [form])
+                  result (atom [])]
+              (while (seq @todo)
+                (let [curr (peek @todo)]
+                  (swap! todo pop)
+                  (if (sequential? curr)
+                    (doseq [kid (reverse curr)]
+                      (swap! todo conj kid))
+                    (swap! result conj curr))))
+              @result))
+        #_(fn [form]
+            (->> (clojure.zip/zipper sequential? seq (fn [_ c] c) form)
+                 (iterate clojure.zip/next)
+                 (take-while (complement clojure.zip/end?))
+                 (map clojure.zip/node)
+                 (remove sequential?)))
+        #_(fn f [form]
+            (loop [curr form, todo [], acc []]
+              (if (sequential? curr)
+                (apply conj acc (map f curr))
+                #_(if (seq curr)
+                  (recur (rest curr) (conj acc (first curr)))
+                  (recur (rest curr) acc))
+                (conj acc curr))))]
+    (is (all? (p28 f)))))

 (defn p29 [__]
   [(= (__ "HeLlO, WoRlD!") "HLOWRD")


use require outside of ns

use require outside of ns

--- cljs/src/defn/core.cljs
+++ cljs/src/defn/core.cljs
@@ -1,7 +1,7 @@
-(ns defn.core
-  (:require
-   ["express" :as express]
-   ["http" :as http]))
+(ns defn.core)
+
+(require '["express" :as express])
+(require '["http" :as http])

 (def app (express))

@@ -11,5 +11,3 @@
 (defn -main [& args]
   (doto (.createServer http #(app %1 %2))
     (.listen 3000)))
-
-(set! *main-cli-fn* -main)