ExpressionLists and FieldReferences

ExpressionLists and FieldReferences

--- src/atom_finder/classifier/macro-operator-precedence.clj
+++ src/atom_finder/classifier/macro-operator-precedence.clj
@@ -1,7 +1,7 @@
 (in-ns 'atom-finder.classifier)
-(import '(org.eclipse.cdt.core.dom.ast IASTNode IASTName IASTIdExpression IASTBinaryExpression IASTUnaryExpression IASTExpressionStatement IASTPreprocessorFunctionStyleMacroDefinition IASTDoStatement IASTLiteralExpression IASTPreprocessorMacroExpansion cpp.ICPPASTTemplateId IASTCastExpression IASTFunctionCallExpression IASTEqualsInitializer IASTIfStatement IASTWhileStatement IASTForStatement IASTDoStatement IASTArraySubscriptExpression)
+(import '(org.eclipse.cdt.core.dom.ast IASTNode IASTName IASTIdExpression IASTBinaryExpression IASTUnaryExpression IASTExpressionStatement IASTPreprocessorFunctionStyleMacroDefinition IASTDoStatement IASTLiteralExpression IASTPreprocessorMacroExpansion cpp.ICPPASTTemplateId IASTCastExpression IASTFunctionCallExpression IASTEqualsInitializer IASTIfStatement IASTWhileStatement IASTForStatement IASTDoStatement IASTArraySubscriptExpression IASTExpressionList IASTFieldReference)
         '(org.eclipse.cdt.internal.core.parser.scanner ASTFunctionStyleMacroDefinition ASTMacroDefinition)
-        '(org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTUnaryExpression)
+        '(org.eclipse.cdt.internal.core.dom.parser.cpp CPPASTUnaryExpression CPPASTExpressionList)
         )

 ;; ExpressionWriter adds superfluous parens to cast statements.
@@ -126,12 +126,15 @@
 (s/defn -maybe-set-value!
   [getter setter node replacements]
   (when-let* [operand     (getter node)
-              _           (instance? IASTIdExpression operand)
-              replacement (-> operand .getName str replacements)
+              name        (cond (instance? IASTIdExpression operand) (.getName operand)
+                                (instance? IASTName operand) operand
+                                :else nil)
+              replacement (-> name str replacements)
               _           (instance? IASTExpression replacement)
               ]
        (doto node
-         (setter (.copy replacement)))))
+         (setter (.copy (cond (instance? IASTIdExpression operand) replacement
+                              (instance? IASTName operand) (.getName replacement)))))))

 (s/defn -maybe-set-args!
   [node :- IASTFunctionCallExpression replacements]
@@ -147,6 +150,15 @@

     (doto node (.setArguments args))))

+(s/defn -maybe-set-expr-list!
+  [node :- CPPASTExpressionList replacements]
+  (doseq [expr (.getExpressions node)]
+    (-maybe-set-value!
+     (fn [node] expr)
+     (fn [_ new-child] (.replace node expr new-child))
+     node replacements))
+  node)
+
 (s/defn -maybe-set-operand!
   "Take an identifier, and replace it with its full tree"
   [method node replacements]
@@ -154,26 +166,33 @@
                      #(call-method %1 (str 'set method) %2)
                      node replacements))

+(s/defn -maybe-set-operands!
+  [node replacements & methods]
+  (->> methods
+       (map #(-maybe-set-operand! %1 node replacements))
+       doall
+       (some identity)))
+
 (s/defn -replace-identifier!
   "If this node is capable of causing syntax ambiguities,
    try replacing parts of it to observe the ambiguity"
   [node :- IASTNode replacements :- {s/Str IASTNode}]
   (condp instance? node
-    IASTIfStatement                (-maybe-set-operand! "ConditionExpression"  node replacements)
-    IASTForStatement               (-maybe-set-operand! "ConditionExpression"  node replacements)
-    IASTWhileStatement             (-maybe-set-operand! "Condition"  node replacements)
-    IASTDoStatement                (-maybe-set-operand! "Condition"  node replacements)
-    IASTEqualsInitializer          (-maybe-set-operand! "InitializerClause"  node replacements)
-    IASTFunctionCallExpression     (-maybe-set-args!               node replacements)
-    IASTCastExpression             (-maybe-set-operand! "Operand"  node replacements)
-    IASTUnaryExpression            (-maybe-set-operand! "Operand"  node replacements)
-
-    IASTBinaryExpression           (let [op1 (-maybe-set-operand! "Operand1" node replacements)
-                                         op2 (-maybe-set-operand! "Operand2" node replacements)]
-                                     (or op1 op2))
-    IASTArraySubscriptExpression   (let [op1 (-maybe-set-operand! "Argument" node replacements)
-                                         op2 (-maybe-set-operand! "ArrayExpression" node replacements)]
-                                     (or op1 op2))
+    IASTFunctionCallExpression   (-maybe-set-args!      node replacements)
+    IASTExpressionList           (-maybe-set-expr-list! node replacements)
+    IASTIfStatement              (-maybe-set-operands!  node replacements "ConditionExpression")
+    IASTForStatement             (-maybe-set-operands!  node replacements "ConditionExpression")
+    IASTWhileStatement           (-maybe-set-operands!  node replacements "Condition")
+    IASTDoStatement              (-maybe-set-operands!  node replacements "Condition")
+    IASTEqualsInitializer        (-maybe-set-operands!  node replacements "InitializerClause")
+    IASTCastExpression           (-maybe-set-operands!  node replacements "Operand")
+    IASTUnaryExpression          (-maybe-set-operands!  node replacements "Operand")
+    IASTBinaryExpression         (-maybe-set-operands!  node replacements "Operand1" "Operand2")
+    IASTArraySubscriptExpression (-maybe-set-operands!  node replacements "Argument" "ArrayExpression")
+    IASTFieldReference           (-maybe-set-operands!  node replacements "FieldOwner" "FieldName")
+    IASTConditionalExpression    (-maybe-set-operands!  node replacements "LogicalConditionExpression"
+                                                         "PositiveResultExpression" "NegativeResultExpression")
+
       nil))

 (s/defn parse-macro
@@ -227,8 +246,8 @@
               _  (instance? IASTPreprocessorFunctionStyleMacroDefinition (.getMacroDefinition exp))
               replaced-str  (macro-replace-arg-str  exp)
               replaced-tree (macro-replace-arg-tree exp)
-              ;replaced-str  (pap write-ast (macro-replace-arg-str  exp))
-              ;replaced-tree (pap write-ast (macro-replace-arg-tree exp))
+              ;replaced-str  (pap safe-write-ast (macro-replace-arg-str  exp))
+              ;replaced-tree (pap safe-write-ast (macro-replace-arg-tree exp))
               _  (not (atom-finder.tree-diff/tree=by (juxt class expr-operator)
                        replaced-str
                        replaced-tree))


Sort by score not status

Sort by score not status

--- src/clj/made_merits/service/leaderboard_users.clj
+++ src/clj/made_merits/service/leaderboard_users.clj
@@ -4,7 +4,7 @@

 (defn with-winner-first
   [scored-users-with-merits]
-  (reverse (sort-by #(= "winner" (:status %)) scored-users-with-merits)))
+  (reverse (sort-by :score scored-users-with-merits)))

 (defn presentable
   [db-users]


Add endscreens to the end of exercises.

Add endscreens to the end of exercises.

--- src/cljs/daveconservatoire/site/ui/exercises.cljs
+++ src/cljs/daveconservatoire/site/ui/exercises.cljs
@@ -275,13 +275,40 @@
           (completed? props)
           (cond
             (= -1 (get me :db/id))
-            (dom/div nil "You can login to save this progress!")
+            (dom/div #js {:className "tile introboxes"}
+              (dom/div #js {:className "intro-icon-disc cont-large"}
+                (dom/i #js {:className "icon-star intro-icon-large dc-text-orange"}))
+              (dom/h6 #js {}
+                (dom/small #js {}
+                  "CONGRATULATIONS!"))
+              (dom/p #js {}
+                "You have mastered this exercise for today.  You can track your progress on the site by creating and account.")
+              (dom/a #js {:href "/login", :className "btn btn-primary  btn-custom btn-rounded btn-block dc-btn-orange"}
+                "Sign in to track your progress"))

             (= "0" (get me :user/subscription-amount))
-            (dom/div nil "Please donate! ")
+            (dom/div #js {:className "tile introboxes"}
+              (dom/div #js {:className "intro-icon-disc cont-large"}
+                (dom/i #js {:className "icon-money  intro-icon-large dc-text-red"}))
+              (dom/h6 #js {}
+                (dom/small #js {}
+                  "Nice work! You just learned something new - maybe pass that on?"))
+              (dom/p #js {}
+                "Please help Dave Conservatoire to grow by becoming a subscriber! ")
+              (dom/a #js {:href "/subscribe", :className "btn btn-primary  btn-custom btn-rounded btn-block dc-btn-red"}
+                "How you can help"))

             :else
-            (dom/div nil "Congratulations! You've completed this exercise. You Rock!"))
+            (dom/div #js {:className "tile introboxes"}
+              (dom/div #js {:className "intro-icon-disc cont-large"}
+                (dom/i #js {:className "icon-star intro-icon-large dc-text-orange"}))
+              (dom/h6 #js {}
+                (dom/small #js {}
+                  "CONGRATULATIONS!"))
+              (dom/p #js {}
+                "You have mastered this exercise for today.  You can view this progress in your account.")
+              (dom/a #js {:href "/profile", :className "btn btn-primary  btn-custom btn-rounded btn-block dc-btn-orange"}
+                "My profile")))

           :else
           (dom/article #js {:className "exercises-content clearfix"}


Remove local url

Remove local url

--- src/cljs/kixi/hecuba/tabs/hierarchy/tapestry.cljs
+++ src/cljs/kixi/hecuba/tabs/hierarchy/tapestry.cljs
@@ -310,8 +310,7 @@
   (let [[type device_id] (str/split sensor #"~")
         start-ts (data/date->amon-timestamp start-date)
         end-ts   (calculate-end-date start-date)
-        url (data/url-str start-ts end-ts entity_id device_id type :hourly_rollups)
-        url "http://localhost:8000/foo1.json"]
+        url (data/url-str start-ts end-ts entity_id device_id type :hourly_rollups)]
     (om/update! tapestry-data :date start-date)
     (GET url
          {:handler #(load-heatmap-data data-chan tapestry-data start-date %)


Fixed deref stuff with simulator.

Fixed deref stuff with simulator.

--- src/cljs/wombats_web_client/panels/simulator.cljs
+++ src/cljs/wombats_web_client/panels/simulator.cljs
@@ -38,7 +38,7 @@
   (re-frame/dispatch [:simulator/update-code evt.target.value]))

 (defn- on-step-click! [evt state]
-  (ws/send-message :process-simulation-frame {:game-state state}))
+  (ws/send-message :process-simulation-frame {:game-state @state}))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Helper methods
@@ -48,8 +48,8 @@
   [templates wombats]
   (re-frame/dispatch [:simulator/initialized true])
   (ws/send-message :connect-to-simulator
-                   {:simulator-template-id (:simulator-template/id (first templates))
-                    :wombat-id (:wombat/id (first wombats))}))
+                   {:simulator-template-id (:simulator-template/id (first @templates))
+                    :wombat-id (:wombat/id (first @wombats))}))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Render Methods
@@ -73,8 +73,6 @@
   [:div "OUTPUT"])

 (defn- render-tabbed-container [state]
-  #_(prn state)
-  #_(js/console.log (or (get-player-code state) ""))
   [tabbed-container {:tabs [{:label "CODE"
                              :markup (render-code-tab state)}
                             {:label "OUTPUT"
@@ -90,7 +88,7 @@

 (defn- render! [initialized? state templates wombats]
   (when (and (not @initialized?) @templates @wombats)
-    (initialize-simulator! @templates @wombats))
+    (initialize-simulator! templates wombats))

   [:div {:class-name "simulator-panel"}
    [render-left-pane! state]


CMR-809: Removed special processing for NRT aliasing as this is handled in indexer-app now.

--- src/cmr/search/services/parameters/conversion.clj
+++ src/cmr/search/services/parameters/conversion.clj
@@ -10,9 +10,6 @@
             [cmr.search.services.parameters.legacy-parameters :as lp]
             [cmr.common.concepts :as cc]
             [cmr.common.date-time-parser :as parser]))
-
-(def nrt-aliases
-  ["near_real_time","nrt", "NRT", "near real time","near-real time","near-real-time","near real-time"])

 (def concept-param->type
   "A mapping of param names to query condition types based on concept-type"
@@ -226,8 +223,7 @@
         (map #(parameter->condition concept-type param % options) value))
       (gc/or-conds
         (map #(parameter->condition concept-type param % options) value)))
-    (let [value (if (some #{value} nrt-aliases) "NEAR_REAL_TIME" value)
-          case-sensitive (case-sensitive-field? :collection-data-type options)
+    (let [case-sensitive (case-sensitive-field? :collection-data-type options)
           pattern (pattern-field? :collection-data-type options)]
       (if (or (= "SCIENCE_QUALITY" value)
               (and (= "SCIENCE_QUALITY" (str/upper-case value))
@@ -304,18 +300,13 @@
      :pretty? pretty?
      :echo-compatible? echo-compatible?}))

-(defn- alias-nrt
-  "Alias variations of NEAR_REAL_TIME to nrt"
-  [value]
-  (if (some #{value} nrt-aliases) "nrt" value))
-
 (defn parameters->query
   "Converts parameters into a query model."
   [concept-type params]
   (let [options (u/map-keys->kebab-case (get params :options {}))
         query-attribs (standard-params->query-attribs concept-type params)
         keywords (when (:keyword params)
-                   (map alias-nrt (str/split (str/lower-case (:keyword params)) #" ")))
+                  (str/split (str/lower-case (:keyword params)) #" "))
         params (if keywords (assoc params :keyword (str/join " " keywords)) params)
         params (dissoc params :options :page-size :page-num :sort-key :result-format :pretty
                        :include-granule-counts :include-has-granules :include-facets


PDB-463 Fix assertion error in /v1/resources

resource-query-limit wasn't removed from this end-point, this removes it
properly.

Signed-off-by: Ken Barber <470bc578162732ac7f9d387d34c4af4ca6e1b6f7@bob.sh>

--- src/com/puppetlabs/puppetdb/http/v1/resources.clj
+++ src/com/puppetlabs/puppetdb/http/v1/resources.clj
@@ -86,19 +86,17 @@
     rows))

 (defn produce-body
-  "Given a `limit`, a query, and database connection, return a Ring
+  "Given a query, and database connection, return a Ring
   response with the query results. The result format conforms to that documented
   above.

   If the query can't be parsed, a 400 is returned.

   If the query would return more than `limit` results, `status-internal-error` is returned."
-  [limit query db]
-  {:pre [(and (integer? limit) (>= limit 0))]}
+  [query db]
   (try
     (with-transacted-connection db
       (-> (r/query->sql version (json/parse-string query true))
-          ((partial r/limited-query-resources limit))
           (:result)
           (munge-result-rows)
           (pl-http/json-response)))
@@ -114,7 +112,6 @@
     [""]
     {:get (fn [{:keys [params globals]}]
             (produce-body
-              (:resource-query-limit globals)
               (params "query")
               (:scf-read-db globals)))}))


React to tempo tap based on sync mode.

React to tempo tap based on sync mode.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -8,6 +8,7 @@
             [afterglow.midi :as amidi]
             [afterglow.rhythm :as rhythm]
             [afterglow.show :as show]
+            [afterglow.show-context :refer [with-show]]
             [afterglow.util :as util]
             [clojure.math.numeric-tower :as math]
             [environ.core :refer [env]]
@@ -387,10 +388,17 @@

 (defn- interpret-tempo-tap
   "React appropriately to a tempo tap, based on the sync mode of the
-  show metronome."
-  [controller]
-  ;; TODO: Do other things when synced.
-  ((:tap-tempo-handler controller)))
+  show metronome. If it is manual, invoke the metronome tap-tempo
+  handler. If MIDI, align the current beat to the tap. If DJ Link, set
+  the current beat to be a down beat (first beat of a bar)."
+  [controller]
+  (with-show (:show controller)
+    (let [metronome (get-in controller [:show :metronome])]
+      (case (:type (show/sync-status))
+        :manual ((:tap-tempo-handler controller))
+        :midi (rhythm/metro-beat-phase metronome 0)
+        :dj-link (rhythm/metro-bar-start metronome (rhythm/metro-bar metronome))
+        (warn "Don't know how to tap tempo for sync type" (show/sync-status))))))

 (defn- bpm-adjusting-interface
   "Add an arrow showing the BPM is being adjusted."
@@ -482,12 +490,12 @@
 (defn- metronome-sync-label
   "Determine the sync type label to display under the BPM section."
   [controller]
-  (if-let [sync-in-effect @(:sync (:show controller))]
-    (case (:type (afterglow.midi/sync-status sync-in-effect))
+  (with-show (:show controller)
+    (case (:type (show/sync-status))
+      :manual "Manual"
       :midi "MIDI"
       :dj-link "DJ Link"
-      "Unknown")
-    "Manual"))
+      "Unknown")))

 (defn- enter-metronome-showing
   "Activate the persistent metronome display, with sync and reset pads


Load jQuery using HTTPS

Load jQuery using HTTPS

--- src/hackerati_interval_web_app/views/template.clj
+++ src/hackerati_interval_web_app/views/template.clj
@@ -11,7 +11,7 @@

 (defn- load-js []
   (list
-   (include-js "http://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js")
+   (include-js "https://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js")
    (include-js "/bootstrap/js/bootstrap.min.js")
    (include-js "/bootstrap3-editable/js/bootstrap-editable.min.js")
    (include-js "/main.js")))


more betterer queue manipulation functions

--- cljs/sledge/core.cljs
+++ cljs/sledge/core.cljs
@@ -30,7 +30,6 @@
 ;; have to tell the player to change track. so there's information
 ;; flowing both ways there
 ;;
-

 (def app-state
@@ -51,26 +50,57 @@
               }
      }))

+(defn empty-queue [] {:tracks [] :next-track 0})
+
+(defn queue-current-entry
+  "Return the current entry in the queue, or nil if empty"
+  [queue]
+  (let [tracks (:tracks queue)
+        nxt (:next-track queue)]
+    (if (seq tracks)
+      (if (zero? nxt)
+        (first tracks)                  ; dubious
+        (nth tracks (dec nxt))))))
+
+(deftest queue-current-test
+  (is (nil? (queue-current-entry (empty-queue))))
+  (let [q {:tracks [:a :b :c :d] :next-track 2}]
+    (is (= (queue-current-entry q) :b))
+    (is (= (queue-current-entry {:tracks [] :next-track 0}) nil))))
+

 (defn queue-empty?
   "Have we run out of tracks to play when the current track (if any) is done?"
   [queue]
-  (> (:next-track queue) (count (:tracks queue))))
+  (>= (:next-track queue) (count (:tracks queue))))

 (defn queued-track
   [queue]
-  (nth (:tracks queue) (:next-track queue)))
-
-(defn advance-queue [queue]
-  (update-in queue [:next-track] inc))
-
-(deftest queue-fns
+  (if (not (queue-empty? queue))
+    (nth (:tracks queue) (:next-track queue))))
+
+(deftest queue-empty-test
+  (is (queue-empty? (empty-queue)))
+  (is (not (queue-empty? {:tracks [:a] :next-track 0})))
+  (is (queue-empty? {:tracks [:a] :next-track 1}))
   (let [q {:tracks [:a :b :c :d] :next-track 0}]
     (is (= (queued-track q) :a))
-    (is (not (queue-empty? q)))
-    (let [q1 (advance-queue q)]
-      (is (= (:next-track q1) 1))
-      (is (= (:tracks q1) (:tracks q))))))
+    (is (not (queue-empty? q)))))
+
+(defn advance-queue [queue]
+  (if (queue-empty? queue)
+    queue
+    (update-in queue [:next-track] inc)))
+
+(deftest advance-queue-test
+  (let [q {:tracks [:a :b :c :d] :next-track 0}
+        q1 (advance-queue q)
+        q2 (-> q1 advance-queue advance-queue advance-queue advance-queue)]
+    (is (= (:next-track q1) 1))
+    (is (nil? (queued-track q2) ))
+    (is (= (queued-track q2) (queued-track (advance-queue q2))))
+    (is (= (:tracks q1) (:tracks q)))))
+

 (defn remove-from-queue [queue track]
   (if (some #{track} (subvec (:tracks queue) (:next-track queue)))
@@ -81,9 +111,14 @@
   (let [q {:tracks [:a :b :c :d] :next-track 2}]
     ;; can only remove unplayed tracks from queue
     (is (= (remove-from-queue q :c) {:tracks [:a :b :d] :next-track 2}))
-    (is (= (remove-from-queue q :a) q))))
-
-
+    (is (= (remove-from-queue q :a) q)))
+  (let [q (empty-queue)]
+    ;; ok to remove a track that's not there
+    (is (= (remove-from-queue q :foo) q))))
+
+
+(defn enqueue-track [queue track]
+  (update-in queue [:tracks] conj track))

 (defn search-results []
   (om/ref-cursor (:results (:search (om/root-cursor app-state)))))
@@ -126,6 +161,9 @@
   (om/transact! (player-queue)
                 (fn [v] (vec (concat (subvec v 0 index)
                                      (subvec v (inc index)))))))
+(deftest enqueue-test
+  (let [q {:tracks [:a :b :c :d] :next-track 2}]
+    (is (= (:tracks (enqueue-track q :z)) [:a :b :c :d :z]))))

 (defn dequeue-all []
   (om/transact! (player-queue) (fn [v] [])))
@@ -399,12 +437,10 @@

-
 (defn update-term [[command new-terms] previous]
   (case command
     :add (set/union previous (set new-terms))
     :drop (set/difference previous new-terms)))
-

 (defn search-view [search owner]
   (reify
@@ -425,10 +461,7 @@
                          {:init-state {:string ""}})
                (om/build results-view (:results search))))))

-(defn music-in-queue? [tracknum]
-  (let [queue (player-queue)]
-    (nth queue tracknum nil)))
-
+#_
 (defn print-debuggy-stuff []
   (let [p (player-el)]
     (println [(.-currentTime p)
@@ -442,7 +475,7 @@
 (defn sync-transport [_ ref o n]
   (let [desired (:player n)
         actual (player-el)
-        urls (music-in-queue? (:track-number desired))]
+        urls (queue-current-entry (:queue desired))]

     ;; find out what track we should be playing
     (let [bits (best-media-url urls)


fix last minute var rename

fix last minute var rename

--- src/main/shadow/cljs/devtools/server.clj
+++ src/main/shadow/cljs/devtools/server.clj
@@ -48,7 +48,7 @@
 (defn get-ring-handler [app-ref]
   (let [web-root-var
         (delay
-          @web-require-ns
+          @require-web-ns
           (find-var 'shadow.cljs.devtools.server.web/root))]

     (fn [ring-map]


Start with a value of zero on envelopes, which fixes Firefox's clicking.

--- src/klangmeister/sound/synthesis.cljs
+++ src/klangmeister/sound/synthesis.cljs
@@ -29,7 +29,7 @@
   [& corners]
   (fn [context at duration]
     (let [audio-node (.createGain context)]
-      (-> audio-node .-gain (.setValueAtTime 0.0 at))
+      (-> audio-node .-gain (set! 0))
       (reduce
         (fn [x [dx y]]
           (-> audio-node .-gain (.linearRampToValueAtTime y (+ x dx)))


Renamed to app-state/app-ui.

Renamed to app-state/app-ui.


Use static property for reagReactionCache

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -174,10 +174,8 @@

 (declare make-reaction)

-(def ^{:private true :const true} cache-key "reagReactionCache")
-
 (defn- cached-reaction [f o k obj destroy]
-  (let [m (obj/get o cache-key)
+  (let [m (.-reagReactionCache o)
         m (if (nil? m) {} m)
         r (m k nil)]
     (cond
@@ -186,15 +184,15 @@
       :else (let [r (make-reaction
                      f :on-dispose (fn [x]
                                      (when debug (swap! -running dec))
-                                     (as-> (obj/get o cache-key) _
+                                     (as-> (.-reagReactionCache o) _
                                        (dissoc _ k)
-                                       (obj/set o cache-key _))
+                                       (set! (.-reagReactionCache o) _))
                                      (when (some? obj)
                                        (set! (.-reaction obj) nil))
                                      (when (some? destroy)
                                        (destroy x))))
                   v (-deref r)]
-              (obj/set o cache-key (assoc m k r))
+              (set! (.-reagReactionCache o) (assoc m k r))
               (when debug (swap! -running inc))
               (when (some? obj)
                 (set! (.-reaction obj) r))


Do not recreate fnil on every usage

Do not recreate fnil on every usage

Originally part of commit 57e5658c, reverted in 27194f2e

--- src/main/clojure/clojure/tools/namespace/file.clj
+++ src/main/clojure/clojure/tools/namespace/file.clj
@@ -42,6 +42,8 @@
               m))
           {} files))

+(def ^:private merge-map (fnil merge {}))
+
 (defn add-files
   "Reads ns declarations from files; returns an updated dependency
   tracker with those files added."
@@ -49,7 +51,7 @@
   (let [{:keys [depmap filemap]} (files-and-deps files)]
     (-> tracker
         (track/add depmap)
-        (update-in [::filemap] (fnil merge {}) filemap))))
+        (update-in [::filemap] merge-map filemap))))

 (defn remove-files
   "Returns an updated dependency tracker with files removed. The files


Support adding new items

Support adding new items

Support adding new items by POST to /items.

--- src/scavenger/core.clj
+++ src/scavenger/core.clj
@@ -15,7 +15,9 @@
 (defroutes app-routes
   (GET "/items" []
     (response (str (into [] (get-all-items)))))
-  (POST "/items" []
+  (POST "/items" {body :body}
+    (let [data (merge (read-string (slurp body)) {:db/id (d/tempid :items)})]
+      @(d/transact conn [data]))
     "OK")
   (route/not-found "Page not found"))


Fix relations.

Fix relations.

--- src/sem_logic/core.clj
+++ src/sem_logic/core.clj
@@ -3,6 +3,13 @@
    (:use clojure.core.logic
          clojure.core.logic.pldb)
    (:require [clojure.core.logic.fd :as fd]))
+
+
+(db-rel T time)
+(db-rel U name)
+
+(db-rel Pr president t)
+(db-rel Sl sleep t)

 ;; Time Predicats, more elegance welcome ;-)
@@ -29,12 +36,6 @@
          (project [n]
                   (everyg #(pred x %)
                           (range n (inc (apply max time)))))))
-
-(db-rel T time)
-(db-rel U name)
-
-(db-rel Pr president t)
-(db-rel Sl sleep t)

 (def M
   (db [T [1 2 3]] ;; order-rel is fd/<


Regarding #8, explicitly set output type to "text", and avoid use of read-string for parsing a quoted string

--- plugin/src/leiningen/cljs_lambda/aws.clj
+++ plugin/src/leiningen/cljs_lambda/aws.clj
@@ -93,9 +93,10 @@
                      {:function-name fn-name
                       :payload payload
                       :log-type "Tail"
-                      :query "LogResult"}
+                      :query "LogResult"
+                      :output "text"}
                      (assoc global-opts :positional [out-path]))]
-    (println (base64/decode (read-string logs)))
+    (println (base64/decode (str/trim logs)))
     (let [output (slurp out-path)]
       (clojure.pprint/pprint
        (try


up version

up version

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -1,4 +1,4 @@
-(defproject kafka-clj "3.5.6"
+(defproject kafka-clj "3.5.7-SNAPSHOT"
   :description "fast kafka library implemented in clojure"
   :url "https://github.com/gerritjvv/kafka-fast"
   :license {:name "Eclipse Public License"


Fix dependencies test.

Fix dependencies test.

--- test/test_deps.clj
+++ test/test_deps.clj
@@ -1,5 +1,6 @@
 (ns test-deps
-  (:use [leiningen.core] :reload-all)
+  (:use [leiningen.core :only [read-project]]
+        [leiningen.deps :only [deps]] :reload-all)
   (:use [clojure.test]
         [clojure.contrib.set]
         [clojure.contrib.java-utils :only [file delete-file-recursively]]))
@@ -8,7 +9,7 @@

 (deftest test-deps
   (delete-file-recursively (file (:root test-project) "lib"))
-  (leiningen.deps/deps test-project)
+  (deps test-project)
   (is (subset? #{"jdom-1.0.jar" "tagsoup-1.2.jar" "clojure-1.0.0.jar" "rome-0.9.jar"}
                (set (map #(.getName %)
                          (.listFiles (file (:root test-project) "lib")))))))


fix typo

fix typo

--- src/test/clojure/conexp/fca/graph_test.clj
+++ src/test/clojure/conexp/fca/graph_test.clj
@@ -75,7 +75,7 @@

 (deftest test-strictness
-  (let [less (strict <)
+  (let [less (strict <=)
         le (non-strict <)]
     (is (less 1 2))
     (is (less [1 2]))


sayid is provided by cider injection

sayid is provided by cider injection

--- dot/lein/profiles.clj
+++ dot/lein/profiles.clj
@@ -5,7 +5,7 @@
             [lein-kibit "0.1.6"]
             [lein-pprint "1.2.0"]
             [jonase/eastwood "0.3.4"]
-            [com.billpiel/sayid "0.0.17"]
+            ;; [com.billpiel/sayid "0.0.17"]
             [lein-cljfmt "0.6.3"]]
   :dependencies [[slamhound "1.5.5"]]
   :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


better measurements migration

better measurements migration

--- dev/migrate.clj
+++ dev/migrate.clj
@@ -32,11 +32,13 @@
           (when measurements
             (doseq [m measurements]
                (db/execute session
-                           (hayt/update :partitioned_measurements
-                                        (hayt/values {:device_id (:device_id m)
-                                                      :type (:type m)
-                                                      :month (:month m)
-                                                      :timestamp (:timestamp m)
+                           (hayt/insert :partitioned_measurements
+                                        (hayt/values {:device_id  (:device_id m)
+                                                      :type       (:type m)
+                                                      :month      (:month m)
+                                                      :timestamp  (:timestamp m)
+                                                      :value      (:value m)
+                                                      :error      (:error m)
                                                       :reading_metadata (convert-metadata m)})))))))))
   (log/info "Finished migrating reading metadata."))


Use channels for events

Use channels for events

--- src/webapp/client/components/playback.cljs
+++ src/webapp/client/components/playback.cljs
@@ -112,7 +112,7 @@
                                        (= (get-in ui
                                                [:sessions data :highlighted]) "true")
                                        "lightgray"
-                                       ""
+                                       "white"
                                        )
                                      }

@@ -151,29 +151,29 @@
     (init-state [_]

                 {
-                   :highlight            (chan)
-                   :unhighlight            (chan)
+                   :highlight          (chan)
+                   :unhighlight        (chan)
                 })

     om/IWillMount
     ;------------
     (will-mount [_]
-                (let [highlight (om/get-state owner :highlight)
-                      unhighlight (om/get-state owner :unhighlight)]
+                (let [highlight     (om/get-state owner :highlight)
+                      unhighlight   (om/get-state owner :unhighlight)]
                   (go (loop []
                         (let [session (<! highlight)]
-                          (log "****HIGHLIHGT")
-                          (om/update!
+                          ;(log "****HIGHLIGHT")
+                          (om/transact!
                            app
-                           [:ui :sessions session :highlighted] "true" )
+                           [:ui :sessions session :highlighted] (fn[x] "true" ))
                           (recur))))

                   (go (loop []
                         (let [session (<! unhighlight)]
-                          (log "****UNHIGHLIHGT")
-                          (om/update!
+                          ;(log "****UNHIGHLIGHT")
+                          (om/transact!
                            app
-                           [:ui :sessions session :highlighted] "false" )
+                           [:ui :sessions session :highlighted] (fn[x] "false" ))
                           (recur))))

                   ))
@@ -183,7 +183,7 @@

     (render-state
      [this {:keys [highlight unhighlight]}]
-     (log (str "map="(mapv
+     (comment log (str "map="(mapv
                                       (fn [x]
                                         {
                                         :ui      (-> app :ui)
@@ -209,8 +209,8 @@
                                      (-> app :data :sessions)

                                      )
-                                    {:init-state {:highlight highlight
-                                                  :unhighlight unhighlight}}
+                                    {:init-state {:highlight    highlight
+                                                  :unhighlight  unhighlight}}
                                     )
                      )


remove unused namespace from sample_data.clj

--- src/open_company/util/sample_data.clj
+++ src/open_company/util/sample_data.clj
@@ -3,7 +3,6 @@
   (:require [clojure.string :as s]
             [clojure.tools.cli :refer (parse-opts)]
             [defun :refer (defun-)]
-            [open-company.db.pool :as pool]
             [open-company.resources.common :as common]
             [open-company.resources.company :as company]
             [open-company.resources.section :as section])


Thread all request processing through the failure monad.

--- src/asid.clj
+++ src/asid.clj
@@ -3,7 +3,8 @@
         ring.middleware.resource
         ring.middleware.file-info
         ring.util.response
-        midje.sweet)
+        midje.sweet
+        [asid.error-flow :only [fail->]])

   (:require [compojure.route :as route]
             [compojure.handler :as handler]
@@ -34,28 +35,27 @@
         (let [id-seed (slurp body)]
           (if (empty? id-seed)
             (ar/bad-request "Identity seed not supplied")
-            (-> (w/new-wallet id-seed)
-                (wr/save repo)
-                ar/created))))
+            (fail-> (w/new-wallet id-seed)
+                    (wr/save repo)
+                    ar/created))))

   (GET ["/:id", :id aid/grammar] [id :as {accepts :accepts}]
-       (let [wallet (wr/get-wallet id repo)
-             content-handlers {"text/html" (fn [_]
-                                             (File. "resources/public/wallet/index.html"))
-
-                               "application/vnd.org.asidentity.wallet+json" ar/resource}
+       (let [content {"text/html" (fn [] (File. "resources/public/wallet/index.html"))
+                      "application/vnd.org.asidentity.wallet+json" (fn [] (fail->
+                                                                           (wr/get-wallet id repo)
+                                                                           ar/resource))}

-             handler (first (remove nil? (map content-handlers accepts)))]
-         (handler wallet)))
+             handler (first (remove nil? (map content accepts)))]
+         (handler)))

   (POST ["/:id/bag", :id aid/grammar] [id key value]
         (if (or (empty? key)
                 (empty? value))
           (ar/bad-request "Either key or value or both not supplied.")
-          (-> (wr/get-wallet id repo)
-              (w/add-data key value)
-              (wr/save repo)
-              ar/resource)))
+          (fail-> (wr/get-wallet id repo)
+                  (w/add-data key value)
+                  (wr/save repo)
+                  ar/resource)))

   (POST ["/:id/trustpool", :id aid/grammar] [id :as {pool-doc :json-doc}]
         (let [name (get pool-doc "name")]
@@ -69,19 +69,19 @@
               (ar/created pool)))))

   (GET "/:walletid/trustpool/:poolid" [walletid poolid]
-       (-> (wr/get-wallet walletid repo)
-           (tpr/pool-from-wallet poolid)
-           ar/resource))
+       (fail-> (wr/get-wallet walletid repo)
+               (tpr/pool-from-wallet poolid)
+               ar/resource))

   (POST "/:walletid/trustpool/:poolid" [walletid poolid :as {calling-card :json-doc}]
         (let [wallet (wr/get-wallet walletid repo)
               pool (tpr/pool-from-wallet wallet poolid)]
-          (-> (cc/new-calling-card (:identity calling-card)
-                                   (:uri calling-card))
-              (cc/submit wallet pool)
-              ccr/save
-              (cc/attach pool)
-              (ar/created "application/vnd.org.asidentity.calling-card+json"))))
+          (fail-> (cc/new-calling-card (:identity calling-card)
+                                       (:uri calling-card))
+                  (cc/submit wallet pool)
+                  ccr/save
+                  (cc/attach pool)
+                  (ar/created "application/vnd.org.asidentity.calling-card+json"))))

   (route/not-found (File. "resources/public/not-found.html")))


Who needs a favicon?

Who needs a favicon?

--- src/asid.clj
+++ src/asid.clj
@@ -30,8 +30,6 @@
 (def repo (an/initialize!))

 (defroutes main-routes
-  (GET "/favicon.ico" [] "")
-
   (POST "/identity" [_ :as {body :body}]
         (let [id-seed (slurp body)]
           (if (= 0 (count id-seed))


makes test-request-parallel-streaming as flaky (#618)

--- waiter/integration/waiter/websocket_integration_test.clj
+++ waiter/integration/waiter/websocket_integration_test.clj
@@ -439,7 +439,17 @@
       (log/error e "error in executing websocket request for test")
       (is false (str "websocket streaming iteration threw an error:" (.getMessage e))))))

-(deftest ^:parallel ^:integration-slow test-request-parallel-streaming
+;FAIL in (test-request-parallel-streaming) (websocket_integration_test.clj:476)
+;test-request-parallel-streaming
+;{:1006 11}
+;expected: 12
+;actual: 11
+;lein parallel-test :only waiter.websocket-integration-test/test-request-parallel-streaming
+;FAIL in (test-request-parallel-streaming) (websocket_integration_test.clj:477)
+;test-request-parallel-streaming
+;Only in a: {:waiting-to-stream 0}
+;Only in b: {:waiting-to-stream 1}
+(deftest ^:parallel ^:integration-slow ^:explicit test-request-parallel-streaming
   ;; streams requests in parallel and verifies all bytes were transferred correctly and
   ;; they were closed with status codes 1000 and 1006 (due to an issue with jet closing requests).
   (testing-using-waiter-url


from-serialized-str now accepts resolvers

--- src/civs/io.clj
+++ src/civs/io.clj
@@ -86,10 +86,11 @@
   value)

 (defn from-serialized-str [serialized-str options]
-  (let [unserialized-data (clojure.edn/read-string
+  (let [ resolver (:resolver options)
+         unserialized-data (clojure.edn/read-string
                             {
                               :readers {
-                                         'com.github.lands.World (world-reader (dir-lists-resolver [""]))
+                                         'com.github.lands.World (world-reader resolver)
                                          'clojure.lang/PersistentArrayMap PersistentArrayMapReader
                                        }
                               :default tag/tagged-default-reader


Fix flakey `wait-for-condition` test

Fix flakey `wait-for-condition` test

--- test/com/nomistech/clojure_the_language/c_850_utils/s_200_test_utils.clj
+++ test/com/nomistech/clojure_the_language/c_850_utils/s_200_test_utils.clj
@@ -113,4 +113,5 @@
                                     nil)
                                   :timeout-ms 70)]
       [res @cnt-atom])
-    => [false 3]))
+    => (just [false
+              #(<= % 3)])))


fix workspace test

fix workspace test

--- test/com/billpiel/sayid/workspace_test.clj
+++ test/com/billpiel/sayid/workspace_test.clj
@@ -106,8 +106,8 @@
     (ws/init! *ws*)

-    (ws/load! *ws* *shelf* 'test1)
-    => (throws Exception)
+    (t/is (thrown? Exception
+                   (ws/load! *ws* *shelf* 'test1)))

     (t/testing "; didn't overwrite"
       (t/is (= (ws/deep-deref! *ws*)


(maint) fixup test

(maint) fixup test

Had accidentally unbalanced the parentesis when adding a `testing` form to the
test.

--- test/puppetlabs/cthun/messaging_test.clj
+++ test/puppetlabs/cthun/messaging_test.clj
@@ -98,4 +98,4 @@
                 (log/info (str "Asserting that sender \"" expected-sender "\" equals \"" @actual-sender "\""))
                 (is (= expected-sender @actual-sender) (str "Comparing sent sender \"" expected-sender "\" with received sender \"" @actual-sender "\""))
                 (client/close conn1)
-                (client/close conn2))))
+                (client/close conn2)))))


CMR-2889 Changes test exception text to specifiy exact name instead of .*

--- access-control-app/int_test/cmr/access_control/int_test/acl_crud_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_crud_test.clj
@@ -70,11 +70,11 @@
           (update-in provider-acl [:provider_identity] assoc :target "WHATEVER")

           "Provider doesn't exist, provider version"
-          #"Provider with provider-id .* does not exist"
+          #"Provider with provider-id \[WHATEVER\] does not exist"
           (assoc-in provider-acl [:provider_identity :provider_id] "WHATEVER")

           "Provider doesn't exist, catalog-item version"
-          #"Provider with provider-id .* does not exist"
+          #"Provider with provider-id \[WHATEVER\] does not exist"
           (assoc-in catalog-item-acl [:catalog_item_identity :provider_id] "WHATEVER"))

@@ -173,11 +173,11 @@
           (update-in provider-acl [:provider_identity] assoc :target "WHATEVER")

           "Provider doesn't exist, provider version"
-          #"Provider with provider-id .* does not exist"
+          #"Provider with provider-id \[WHATEVER\].* does not exist"
           (assoc-in provider-acl [:provider_identity :provider_id] "WHATEVER")

           "Provider doesn't exist, catalog-item version"
-          #"Provider with provider-id .* does not exist"
+          #"Provider with provider-id \[WHATEVER\] does not exist"
           (assoc-in catalog-item-acl [:catalog_item_identity :provider_id] "WHATEVER"))

     (testing "Acceptance criteria: I receive an error if updating an ACL with invalid JSON"


CMR-1872: Fixed typop

CMR-1872: Fixed typop

--- search-app/src/cmr/search/api/routes.clj
+++ search-app/src/cmr/search/api/routes.clj
@@ -253,7 +253,7 @@
   (let [concept-id (path-w-extension->concept-id path-w-extension)
         revision-id (path-w-extension->revision-id path-w-extension)]
     (if revision-id
-      ;; We don't support Atom or JSON (yet) for lookups that include revision-id do to
+      ;; We don't support Atom or JSON (yet) for lookups that include revision-id due to
       ;; limitations of the current transformer implementation. This will be fixed with CMR-1935.
       (let [supported-mime-types (disj supported-concept-id-retrieval-mime-types mt/atom mt/json)
             result-format (get-search-results-format path-w-extension headers


fix pun

fix pun

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -615,7 +615,7 @@

             ;; TODO Don't forget to mention Hecuba and Stentor (that they're free software)
             {:title "Q & A"
-             :text "(map answer (take n questions))"}
+             :text "(take n (map answer questions))"}

             {:title "Thank you"
              :text "Please evaluate my talk via the mobile app!"}]))}))


add rethrow of exception. invalid topology tests now pass again

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -904,7 +904,8 @@
               (mk-assignments nimbus)))

           (catch Throwable e
-            (log-warn-error e "Topology submission exception. (topology name='" storm-name "')"))))
+            (log-warn-error e "Topology submission exception. (topology name='" storm-name "')")
+            (throw e))))

       (^void killTopology [this ^String name]
         (.killTopologyWithOpts this name (KillOptions.)))


fix mongolab uri | fs / cb | #3

fix mongolab uri | fs / cb | #3

--- src/clj/conference_rating/db_handler.clj
+++ src/clj/conference_rating/db_handler.clj
@@ -7,7 +7,7 @@

 (defn- connect []
   (if mongolab-uri
-    (second (mg/connect-via-uri {:uri mongolab-uri }))
+    (second (mg/connect-via-uri mongolab-uri))
     (mg/get-db (mg/connect {:host "127.0.0.1" :port 27017}) "crdb")))

 (defn add-conference []


remove extra :

remove extra :

--- src/cljs/just_married/home/timeline.cljs
+++ src/cljs/just_married/home/timeline.cljs
@@ -55,5 +55,5 @@
          (for [[time place key] timeline-def]
            [:li {:class (place icons)}
             [:img.timeline__icon {:src (place icons)}]
-            [:span.timeline__time (str time ":")]
+            [:span.timeline__time time]
             [:span.timeline__msg (tr key)]]))])


Add reproductive-change diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1313,6 +1313,16 @@
     (assoc ind :diversifying
       (not= c-made-by gc-made-by))))

+(defn reproductive-change-diversifying?
+  [ind argmap]
+  (let [g (:genome ind)
+        c (produce-child-genome-by-autoconstruction g g argmap)
+        c-made-by (:made-by (meta c))
+        gc (produce-child-genome-by-autoconstruction c g g argmap)
+        gc-made-by (:made-by (meta gc))]
+    (assoc ind :diversifying
+      (not= c-made-by gc-made-by))))
+
 (defn symbolic-reproductive-divergence-diversifying?
   [ind argmap]
   (let [symbolic #(filter (comp not number?) %)
@@ -1520,6 +1530,7 @@
                 :three-children-make-children-differently three-children-make-children-differently-diversifying?
                 :symbolic-reproductive-change-changes symbolic-reproductive-change-changes-diversifying?
                 :symbolic-reproductive-change symbolic-reproductive-change-diversifying?
+                :reproductive-change reproductive-change-diversifying?
                 :symbolic-reproductive-divergence symbolic-reproductive-divergence-diversifying?
                 :reproductive-divergence reproductive-divergence-diversifying?
                 :reproductive-change-changes reproductive-change-changes-diversifying?


Add :reproductive-change-changes diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1273,6 +1273,20 @@
     (assoc ind :diversifying
       (apply distinct? (map :made-by (map meta [gc1 gc2 gc3]))))))

+(defn reproductive-change-changes-diversifying?
+  [ind argmap]
+  (let [g (:genome ind)
+        c (produce-child-genome-by-autoconstruction g g argmap)
+        c-made-by (flatten (:made-by (meta c)))
+        gc (produce-child-genome-by-autoconstruction c g g argmap)
+        gc-made-by (flatten (:made-by (meta gc)))
+        ggc (produce-child-genome-by-autoconstruction gc g g argmap)
+        ggc-made-by (flatten (:made-by (meta ggc)))]
+    (assoc ind :diversifying
+      (distinct? 1
+                 (sequence-similarity c-made-by gc-made-by)
+                 (sequence-similarity gc-made-by ggc-made-by)))))
+
 (defn use-mate-diversifying?
   [ind argmap]
   (let [g (:genome ind)
@@ -1433,6 +1447,7 @@
                 :makes-three-children-differently makes-three-children-differently-diversifying?
                 :children-make-children-differently children-make-children-differently-diversifying?
                 :three-children-make-children-differently three-children-make-children-differently-diversifying?
+                :reproductive-change-changes reproductive-change-changes-diversifying?
                 :use-mate use-mate-diversifying?
                 :use-mate-differently use-mate-differently-diversifying?
                 :si-and-mate-use si-and-mate-use-diversifying?


turn shuffle back on

turn shuffle back on

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -388,8 +388,7 @@
     result))

 (defn lazy-shuffle [seq]
-  (if true seq
-      (lazy-seq (shuffle seq))))
+  (lazy-seq (shuffle seq)))

 (defn exception [error-string]
   #?(:clj


add more pre-unify checks

add more pre-unify checks

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -136,8 +136,14 @@
   (log/trace (str "candidate-parents: spec: " (strip-refs spec)))
   (filter #(not (fail? %))
           (mapfn (fn [rule]
-                   (if (not (fail? (unifyc (get-in rule [:synsem :cat] :top)
-                                           (get-in spec [:synsem :cat] :top))))
+                   (if (and (not (fail? (unifyc (get-in rule [:synsem :cat] :top)
+                                                (get-in spec [:synsem :cat] :top))))
+                            (not (fail? (unifyc (get-in rule [:synsem :infl] :top)
+                                                (get-in spec [:synsem :infl] :top))))
+                            (not (fail? (unifyc (get-in rule [:synsem :sem :tense] :top)
+                                                (get-in spec [:synsem :sem :tense] :top))))
+                            (not (fail? (unifyc (get-in rule [:synsem :modified] :top)
+                                                (get-in spec [:synsem :modified] :top)))))
                      (unifyc spec rule)
                      :fail))
                  (shuffle rules))))


Update protocols.cljc

Update protocols.cljc

--- src/cats/protocols.cljc
+++ src/cats/protocols.cljc
@@ -74,7 +74,7 @@
      inside av's context while preserving the context.")
   (-pure [app v]
     "Takes any context or monadic value `app` and any value `v`, and puts
-     the value `v` in the most minimal context (normally `mempty`) of same type of app"))
+     the value `v` in the most minimal context (normally `mempty`) of same type of `app`"))

 (defprotocol Foldable
   "Abstraction of data structures that can be folded to a summary value."


adding freenas

adding freenas

--- src/celestial/model.clj
+++ src/celestial/model.clj
@@ -26,7 +26,7 @@

 (defn get-env! [] {:pre [env]} env)

-(def hypervizors #{:proxmox :aws :vcenter :vagrant :physical :docker :openstack})
+(def hypervizors #{:proxmox :aws :vcenter :vagrant :physical :docker :openstack :freenas})

 (def operations
  #{:reload :destroy :provision :stage :run-action :create :start :stop :clear :clone})


Remove unused submodule support

Remove unused submodule support

--- src/cider_ci/ex/git.clj
+++ src/cider_ci/ex/git.clj
@@ -114,18 +114,6 @@
     {:dir dir})
   true)

-(defn- prepare-and-create-submodule-dir [submodule working-dir]
-  (let [submodule-repository-path (serialized-initialize-or-update-if-required
-                                    (:git_url submodule) (:repository_id submodule)
-                                    (:git_commit_id submodule))
-        submodule-dir (clojure.string/join
-                                File/separator
-                                (concat [working-dir] (:subpath_segments submodule)))]
-    (system/exec-with-success-or-throw ["mkdir" "-p" submodule-dir])
-    (clone-to-dir submodule-repository-path
-                          (:git_commit_id submodule)
-                          submodule-dir)))
-
 (defn prepare-and-create-working-dir [params]
   (let [working-dir-id (:trial_id params)]
     (when (clojure.string/blank? working-dir-id)
@@ -135,9 +123,6 @@
                             (:git_url params) (:repository_id params) (:git_commit_id params))
           working-dir (str (:working_dir @conf) (File/separator) working-dir-id)]
       (clone-to-dir repository-path (:git_commit_id params) working-dir)
-      (let [submodules (:git_submodules params)]
-        (doseq [submodule submodules]
-          (prepare-and-create-submodule-dir submodule working-dir)))
       (when-let [user (:user (:sudo @conf))]
         (system/exec-with-success-or-throw ["chown" "-R" user working-dir]))
       working-dir)))


CMR-3701:

--- system-int-test/test/cmr/system_int_test/ingest/granule_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/granule_validation_test.clj
@@ -11,7 +11,6 @@
     [cmr.spatial.mbr :as m]
     [cmr.spatial.point :as p]
     [cmr.spatial.polygon :as poly]
-    [cmr.system-int-test.data2.collection :as dc]
     [cmr.system-int-test.data2.core :as d]
     [cmr.system-int-test.data2.granule :as dg]
     [cmr.system-int-test.data2.umm-spec-collection :as data-umm-c]


Fix cli printing

Fix cli printing

--- src/cljam/tools/cli.clj
+++ src/cljam/tools/cli.clj
@@ -25,7 +25,8 @@
 (defn- exit
   "Exits the program with the status after printing the message."
   [status message]
-  (println message)
+  (binding [*out* (if (zero? status) *out* *err*)]
+    (println message))
   (System/exit status))

 (defn- error-msg
@@ -392,7 +393,6 @@
       :dict    (dict args)
       :level   (level args)
       :version (version args)
-      (do (println "Invalid command. See 'cljam --help'.")
-          (when (seq cands)
-            (newline)
-            (exit 1 (candidate-message cands)))))))
+      (exit 1 (str "Invalid command. See 'cljam --help'."
+                   (when (seq cands)
+                     (str \newline (candidate-message cands))))))))


Remove `print-camera` and `print-projection` from cljs as they are not supported by p5js. Issue #255.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -2857,16 +2857,17 @@
   #?(:clj (PApplet/pow (float num) (float exponent))
      :cljs (.pow (ap/current-applet) num exponent)))

-(defn
-  ^{:requires-bindings true
-    :processing-name "printCamera()"
-    :category "Lights, Camera"
-    :subcategory "Camera"
-    :added "1.0"}
-  print-camera
-  "Prints the current camera matrix to std out. Useful for debugging."
-  []
-  (.printCamera (current-graphics)))
+#?(:clj
+   (defn
+     ^{:requires-bindings true
+       :processing-name "printCamera()"
+       :category "Lights, Camera"
+       :subcategory "Camera"
+       :added "1.0"}
+     print-camera
+     "Prints the current camera matrix to std out. Useful for debugging."
+     []
+     (.printCamera (current-graphics))))

 (defn
   ^{:requires-bindings true
@@ -2879,17 +2880,18 @@
   []
   (.printMatrix (current-graphics)))

-(defn
-  ^{:requires-bindings true
-    :processing-name "printProjection()"
-    :category "Lights, Camera"
-    :subcategory "Camera"
-    :added "1.0"}
-  print-projection
-  "Prints the current projection matrix to std out. Useful for
-  debugging"
-  []
-  (.printProjection (current-graphics)))
+#?(:clj
+   (defn
+     ^{:requires-bindings true
+       :processing-name "printProjection()"
+       :category "Lights, Camera"
+       :subcategory "Camera"
+       :added "1.0"}
+     print-projection
+     "Prints the current projection matrix to std out. Useful for
+     debugging"
+     []
+     (.printProjection (current-graphics))))

 (defn
   ^{:requires-bindings true


require g.s.StringBuffer to get tests working

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -8,6 +8,7 @@

 (ns cljs.core
   (:require [goog.string :as gstring]
+            [goog.string.StringBuffer :as gstringbuf]
             [goog.object :as gobject]))

 (defn truth_
@@ -1603,9 +1604,9 @@
   (assert (= [3 2 1] (seq (array 3 2 1))))
   (assert (= {"x" "y"} (meta ^{"x" "y"} [])))

-  #_(assert (= "[1 {:a 2, :b 42} #<Array [3, 4]>]"
+  (assert (= "[1 {:a 2, :b 42} #<Array [3, 4]>]"
              (pr-str [1 {:a 2 :b 42} (array 3 4)])))
-  #_(assert (= "symbol\"'string"
+  (assert (= "symbol\"'string"
              (pr-str (str 'symbol \" \' "string"))))
   (assert (not (= "one" "two")))
   :ok


* src/cljs/cljs/core.cljs: clean up delcares

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -324,6 +324,8 @@
            (recur (f val (-nth cicoll n)) (inc n))
            val))))

+(declare hash-coll cons)
+
 (deftype IndexedSeq [a i]
   ISeqable
   (-seq [this] this)
@@ -1041,6 +1043,8 @@
           (str* sb)))
       (gstring/StringBuffer. (str* x)) ys)))

+(declare apply)
+
 (defn str
   "With no args, returns the empty string. With one arg x, returns
   x.toString().  (str nil) returns the empty string. With more than
@@ -1098,6 +1102,8 @@
 (defn- hash-coll [coll]
   (reduce #(hash-combine %1 (hash %2)) (hash (first coll)) (next coll)))

+(declare name)
+
 (defn- extend-object!
   "Takes a JavaScript object and a map of names to functions and
   attaches said functions as methods on the object.  Any references to
@@ -1219,8 +1225,6 @@
   "Returns a new seq where x is the first element and seq is the rest."
   [x seq]
   (Cons. nil x seq))
-
-(declare hash-map)

 (extend-type string
   IHash
@@ -2234,7 +2238,6 @@
      (> a b) 1
      :else 0)))

-(declare hash-map)
 (deftype ObjMap [meta keys strobj]
   IWithMeta
   (-with-meta [coll meta] (ObjMap. meta keys strobj))


Match cons arglist to docstring

Match cons arglist to docstring

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -899,8 +899,8 @@

 (defn cons
   "Returns a new seq where x is the first element and seq is the rest."
-  [first rest]
-  (Cons. nil first rest))
+  [x seq]
+  (Cons. nil x seq))

 (defn concat
   "Returns a lazy seq representing the concatenation of the elements in the supplied colls."


Handle quirks in the Wit.Microphone API

Handle quirks in the Wit.Microphone API

Wish they would document this better. The Microphone API doesn't return
confidence levels, and may return multiple entity values.

--- src/cljs/shop/core.cljs
+++ src/cljs/shop/core.cljs
@@ -36,8 +36,8 @@
   (log (str "Searching for " q))
   (http/post "https://api.relayfoods.com/api/ecommerce/v1/DCX/search/"
     {:with-credentials? false
-     :form-params {"Query" (str "query:" q), "Page" 1
-                   "PageSize" 20, "RefinementSize" 5
+     :form-params {"Query" (apply str (interpose " " (map #(str "query:" %) q)))
+                   "Page" 1, "PageSize" 20, "RefinementSize" 5
                    "Sort" 2, "Heavy" false}}))

 (defn best-match [q]
@@ -115,12 +115,20 @@
               (:Name (nth products 2)))))
         (say "I'm sorry, I've having trouble searching for that. Please try again")))))

+(defn normalize
+  "The structure of the entities can vary widely, first extract the
+  correct entity(ies) by the supplied key, then they may be an object,
+  or a vector of objects, then the values may be a single word, or a
+  phrase. Normalize all into a list of words."
+  [entities key]
+  (flatten
+    (map #(clojure.string.split % #"\s+")
+      (map :value (flatten (conj [] (key entities)))))))
+
 (defn interact [intent entities]
   (case intent
-    "add_to_cart" (add-to-cart
-                    (->> entities :product :value))
-    "search" (interactively-refine-search
-               (->> entities :local_search_query :value))))
+    "add_to_cart" (add-to-cart (normalize entities :product))
+    "search" (interactively-refine-search (normalize entities :local_search_query))))

 ;; ──────────────────────────────────────────────────────────────────────
 ;; Wit.ai


Clojure default async interface now based on callbacks.

--- src/clojure/nanomsg.clj
+++ src/clojure/nanomsg.clj
@@ -41,10 +41,11 @@
    :push #(PushSocket.)
    :pull #(PullSocket.)})

-(defn- make-iasynccallback
-  "Private function that create a new
-  instance of IAsyncCallback."
-  [ch]
+(defn- ->async-callback
+  "Given a plain callback function, coerce
+  it to an anonymous instance of IAsyncCallback
+  interface."
+  [^IFn continuation]
   (reify IAsyncCallback
     (success [_ result]
       (put! ch result))


Minor fixes to model.validation.

Minor fixes to model.validation.

--- src/cadence/model/validators.clj
+++ src/cadence/model/validators.clj
@@ -1,8 +1,8 @@
 (ns cadence.model.validators
   (:require [cadence.model :as m]
-            [noir.session :as sess]
-            [cadence.model.recaptcha :as recaptcha])
-  (:use noir.validation))
+            [cadence.model.recaptcha :as recaptcha]
+            (noir [session :as sess]
+                  [validation :refer :all])))

 (defn user?
   "Returns whether the given user is valid or not."
@@ -53,7 +53,7 @@
   "Tests whether the given cadence is valid or not."
   [cadence for-auth?]
   (let [{:keys [timeline phrase]} cadence
-        cad-keys (into #{} (keys cadence))
+        cad-keys (set (keys cadence))
         phrase-key (if for-auth?
                      :auth-phrase
                      :training-phrase)]


optimize lookup of structurepath implementation for regular functions (about a 3x speedup in non-compiled execution when functions are involved

--- src/clj/com/rpl/specter/impl.clj
+++ src/clj/com/rpl/specter/impl.clj
@@ -83,8 +83,14 @@
               )]
     (->TransformFunctions StructureValsPathExecutor afn afn)))

+
+(defn structure-path-impl [this]
+  (if (fn? this)
+    (-> StructurePath :impls (get clojure.lang.AFn))
+    (find-protocol-impl! StructurePath this)))
+
 (defn coerce-structure-path [this]
-  (let [pimpl (find-protocol-impl! StructurePath this)
+  (let [pimpl (structure-path-impl this)
         selector (:select* pimpl)
         updater (:update* pimpl)]
     (->TransformFunctions
@@ -96,7 +102,7 @@
     )))

 (defn coerce-structure-path-direct [this]
-  (let [pimpl (find-protocol-impl! StructurePath this)
+  (let [pimpl (structure-path-impl this)
         selector (:select* pimpl)
         updater (:update* pimpl)]
     (->TransformFunctions
@@ -110,6 +116,9 @@
 (defn obj-extends? [prot obj]
   (->> obj (find-protocol-impl prot) nil? not))

+(defn structure-path? [obj]
+  (or (fn? obj) (obj-extends? StructurePath obj)))
+
 (extend-protocol CoerceTransformFunctions

   TransformFunctions
@@ -122,7 +131,7 @@

   Object
   (coerce-path [this]
-    (cond (obj-extends? StructurePath this) (coerce-structure-path this)
+    (cond (structure-path? this) (coerce-structure-path this)
           (obj-extends? Collector this) (coerce-collector this)
           (obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
           :else (throw-illegal (no-prot-error-str this))
@@ -192,7 +201,7 @@
         ))))

 (defn coerce-structure-vals-direct [this]
-  (cond (obj-extends? StructurePath this) (coerce-structure-path-direct this)
+  (cond (structure-path? this) (coerce-structure-path-direct this)
         (obj-extends? Collector this) (coerce-collector this)
         (obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
         (instance? TransformFunctions this) this


add analytic values to budget report

add analytic values to budget report

--- src/clj_money/models/reports.clj
+++ src/clj_money/models/reports.clj
@@ -159,27 +159,41 @@
                   (filter #(= (:id account) (:account-id %)))
                   first)
         budget-amount (if item
-                        (reduce + (->> item
-                                       :periods
-                                       (take period-count)
-                                       (map :amount)))
+                        (reduce + 0M (->> item
+                                          :periods
+                                          (take period-count)
+                                          (map :amount)))
                         0M) ; TODO only total the periods up to and including the as-of date
-        actual-amount (transactions/balance-delta storage (:id account) (:start-date budget) as-of)]
-    {:caption (:name account)
-     :style :data
-     :budget budget-amount
-     :actual actual-amount
-     :difference (if (accounts/left-side? account)
-                   (- budget-amount actual-amount)
-                   (- actual-amount budget-amount))}))
+        actual-amount (transactions/balance-delta storage (:id account)
+                                                  (:start-date budget)
+                                                  as-of)
+        difference (if (accounts/left-side? account)
+                     (- budget-amount actual-amount)
+                     (- actual-amount budget-amount))]
+    (with-precision 10
+      {:caption (:name account)
+       :style :data
+       :budget budget-amount
+       :actual actual-amount
+       :difference difference
+       :percent-difference (when (not= 0M budget-amount)
+                             (/ difference budget-amount))
+       :actual-per-period (/ actual-amount period-count)})))

 (defn- budget-group-header
-  [account-type records]
-  {:caption account-type
-   :style :header
-   :budget (reduce + (map :budget records))
-   :actual (reduce + (map :actual records))
-   :difference (reduce + (map :difference records))})
+  [period-count account-type records]
+  (let [budget (reduce + (map :budget records))
+        actual (reduce + (map :actual records))
+        difference (reduce + (map :difference records))]
+    (with-precision 10
+      {:caption (humanize account-type)
+       :style :header
+       :budget budget
+       :actual actual
+       :difference difference
+       :percent-difference (when (not= budget 0)
+                             (/ difference budget))
+       :actual-per-period  (/ actual period-count)})))

 (defn- process-budget-group
   [storage budget as-of [account-type items]]
@@ -188,7 +202,7 @@
                      (map #(->budget-report-record storage budget period-count as-of %))
                      (sort-by :difference))]
     (conj records
-          (budget-group-header account-type records))))
+          (budget-group-header period-count account-type records))))

 (defn budget
   "Returns a budget report"


ENH: chapter 6, exercise 3: implement assoc-in

--- src/clj_prj03/ch6_additional.clj
+++ src/clj_prj03/ch6_additional.clj
@@ -57,3 +57,16 @@
       ((last fns) (apply (gabe-comp (butlast fns)) args)))))

 ((gabe-comp inc *) 6 2)  ; --> should be 13
+
+;; Exercise 3: implement assoc-in function
+
+(defn gabe-assoc-in
+  [m [k & ks] v]
+  (if (empty? k)
+    (assoc m ks v)
+    (assoc m (first k) (gabe-assoc-in (get m (first k)) [(rest k) ks] v))))
+
+(def users [{:name "James" :age 26}  {:name "John" :age 43}])
+(assoc-in users [1 :age] 44)
+(assoc-in users [1 :password] "nhoJ")
+(assoc-in users [2] {:name "Jack" :age 19})


Expose `eval` in repl (#180)

Expose `eval` in repl (#180)

fixes #146

--- src/cljs/snapshot/lumo/core.cljs
+++ src/cljs/snapshot/lumo/core.cljs
@@ -1,4 +1,5 @@
-(ns lumo.core)
+(ns lumo.core
+  (:require [lumo.repl :as repl]))

 (goog-define
   ^{:doc "A string containing the version of the Lumo executable."}
@@ -9,3 +10,8 @@
     :doc "A sequence of the supplied command line arguments, or nil if
   none were supplied"}
   *command-line-args* nil)
+
+(defn eval
+  "Evaluates the form data structure (not text!) and returns the result."
+  [form]
+  (repl/eval form))


refactor ai score

refactor ai score

--- src/cljs/triboard/ai/scores.cljs
+++ src/cljs/triboard/ai/scores.cljs
@@ -11,15 +11,16 @@
 ;; Private
 ;; -----------------------------------------

-(defn neighbors-coordinates
+(defn- neighbors-coordinates
   [[x y]]
   (map (fn [[dx dy]] [(+ x dx) (+ y dy)]) cst/directions))

 (defn- neighbouring-walls
   [board point]
-  (eduction
-    (filter #(= :wall (board/get-cell-at board % :wall)))
-    (neighbors-coordinates point)))
+  (let [is-wall? #(= :wall (board/get-cell-at board %))]
+    (eduction
+      (filter is-wall?)
+      (neighbors-coordinates point))))

 (defn- get-cell-weight
   [board point]


Patch to solve NPE in blank multipart data from Mike DeLaurentis

--- src/compojure/http/multipart.clj
+++ src/compojure/http/multipart.clj
@@ -55,7 +55,9 @@
       (assoc-vec param-map
         (keyword (.getFieldName item))
         (if (.isFormField item)
-          (.getString item)
+          (if (zero? (.getSize item))
+            ""
+            (.getString item))
           (file-map item))))
     {}
     (.parseRequest


lein-release plugin: preparing 0.3.2 release


fix typo

fix typo

--- src/babel/francais/morphology/verbs.cljc
+++ src/babel/francais/morphology/verbs.cljc
@@ -1194,7 +1194,7 @@
      :unify-with {:synsem {:cat :verb
                            :agr {:person :3rd
                                  :number :sing}
-                           :infl :imperfect}
+                           :infl :conditional}
                   :français {:conditional {:stem true}}}}
     {:prefix :future-stem :suffix "ions"
      :unify-with {:synsem {:cat :verb


Use correct explanation of semantics for fork section

--- frontend/components/add_projects.cljs
+++ frontend/components/add_projects.cljs
@@ -71,7 +71,7 @@
                    (filter (fn [org] (= (:login user) (:login org)))
                            (:collaborators user)))
               [:div
-               [:h4 "Users & organizations with forks of your repos"]
+               [:h4 "Users & organizations who have made pull requests to your repos"]
                (map (fn [org] (side-item org settings controls-ch))
                     (remove (fn [org] (= (:login user) (:login org)))
                             (:collaborators user)))]]])))))


adjusted valid modis.

adjusted valid modis.

--- src/clj/forma/hadoop/jobs/preprocess.clj
+++ src/clj/forma/hadoop/jobs/preprocess.clj
@@ -6,7 +6,6 @@
                                 globbed-wholefile-tap)])
   (:require [forma.source.hdf :as h]
             [forma.source.rain :as r]
-            [forma.source.modis :as m]
             [forma.static :as s])
   (:gen-class))

@@ -33,9 +32,12 @@
         (r/rain-chunks m-res ll-res chunk-size tile-seq source))))

 ;; TEMPORARY stuff for the big run :-*
+;;
+;; TODO: move to hadoop.io
+
 (defn tiles->globstring
   [& tiles]
-  {:pre [(m/valid-modis? tiles)]}
+  {:pre [(valid-modis? tiles)]}
   (let [hv-seq (interpose "," (for [[th tv] tiles]
                                 (format "h%02dv%02d" th tv)))]
     (format "*{%s}*" (apply str hv-seq))))
@@ -48,7 +50,6 @@

    hadoop jar forma-standalone.jar modisdata/MOD13A3/ reddoutput/ [8 6] [10 12]"
   [input-path output-path & tiles]
-  {:pre [(m/valid-modis? tiles)]}
   (let [tileseq (map read-string tiles)
         tilestring (str input-path (apply tiles->globstring tileseq))]
     (modis-chunker s/forma-subsets s/chunk-size
@@ -58,7 +59,6 @@
 (defn rain-main
   "TODO: Example usage."
   [input-path output-path & tiles]
-  {:pre [(m/valid-modis? tiles)]}
   (rain-chunker "1000" 0.5 s/chunk-size (map read-string tiles)
                 (s3-path input-path)
                 (s3-path output-path)))


Refactor register.clj

Refactor register.clj

--- src/clj/rumahsewa141/routes/register.clj
+++ src/clj/rumahsewa141/routes/register.clj
@@ -13,44 +13,39 @@
 (def default-value {:nickname ""
                     :phone_no ""})

-(defn do-register! [{{:keys [username password
-                             confirm nickname
+(defn register-user! [username password nickname phone_no]
+  (when-let [_ (db/create-user! (merge default-value {:username username
+                                                      :password (hashers/encrypt password)
+                                                      :nickname nickname
+                                                      :phone_no phone_no}))]
+    (layout/render "success.html" {:title "Success!"
+                                   :description "You have been registered."})))
+
+(defn valid-registration? [params]
+  (b/valid? params
+            :username [v/required available-username]
+            :password v/required
+            :confirm v/required))
+
+(defn get-registration-error [params]
+  (apply str (:username (first (b/validate
+                                params
+                                :username [v/required available-username]
+                                :password v/required
+                                :confirm v/required)))))
+
+(defn do-registration [{{:keys [username
+                             password
+                             confirm
+                             nickname
                              phone_no] :as params} :params}]
-  (if (b/valid? params
-                :username [v/required available-username]
-                :password v/required
-                :confirm v/required)
-
-    ;; If params is valid then register,
+  (if (valid-registration? params)
     (if (= password confirm)
-      (when-let [_ (db/create-user!
-                    (merge default-value
-                           {:username username
-                            :password (hashers/encrypt password)
-                            :nickname nickname
-                            :phone_no phone_no}))]
-        (layout/render "success.html" {:title "Success!"
-                                       :description
-                                       "You have been registered."}))
-      (layout/render "error_message.html" {:description
-                                           "Wrong password confirmation."}))
-
-    ;; else, display errors.
-    (layout/render
-     "error_message.html"
-     {:title "Registration failed!"
-      :description (apply str
-                          (:username
-                           (first
-                            (b/validate
-                             params
-                             :username [v/required available-username]
-                             :password v/required
-                             :confirm v/required))))})))
+      (register-user! username password nickname phone_no)
+      (layout/render "error_message.html" {:description "Wrong password confirmation."}))
+    (layout/render "error_message.html" {:title "Registration failed!"
+                                         :description (get-registration-error params)})))

 (defroutes register-routes
-  (GET "/register" [] (layout/render "register.html"
-                                     {:allowed (:value
-                                                (db/get-registration-config))}))
-  (POST "/register" req (do-register! req)))
-
+  (GET "/register" [] (layout/render "register.html" {:allowed (:value (db/get-registration-config))}))
+  (POST "/register" req (do-registration req)))


fix build issues

fix build issues

--- src/cljs/infinitelives/utils/events.cljs
+++ src/cljs/infinitelives/utils/events.cljs
@@ -156,6 +156,8 @@
 ;;
 ;; Animation handler
 ;;
+(def fallback-fps 60)
+
 (defn make-request-animation-frame
   "compose a function that is the r-a-f func. returns a function. This returned function takes a callback and ensures
   its called next frame"
@@ -177,7 +179,7 @@
    #(.msRequestAnimationFrame js/window %)

    :else
-   #(.setTimeout js/window % (/ 1000 *target-fps*))))
+   #(.setTimeout js/window % (/ 1000 fallback-fps))))

 ;; build the actual function
 (def
@@ -249,7 +251,7 @@
   (let [size [(.-innerWidth js/window) (.-innerHeight js/window)]]
     (doseq [c @*resize-chans*] (put! c size))))

-(defn install-resize-handler
+(defn install-resize-handler!
   "install the resize callback to resize the main canvas renderer"
   []
   (.addEventListener js/window "resize" resize-event-chan-handler))
@@ -277,15 +279,15 @@
   (request-animation-frame frame-event-chan-handler)
   (doseq [c @*frame-chans*] (put! c true)))

-(defn install-frame-handler
+(defn install-frame-handler!
   "install the frame callback to send frame chan messages"
   []
   (request-animation-frame frame-event-chan-handler))

 ;; install all the event channel handlers
-(install-key-handler)
-(install-frame-handler)
-(install-resize-handler)
+(install-key-handler!)
+(install-frame-handler!)
+(install-resize-handler!)

 ;;
 ;; gamepad wrapper


Extracted bar component

Extracted bar component

--- src/cljs/load_test_client/histogram.cljs
+++ src/cljs/load_test_client/histogram.cljs
@@ -16,19 +16,22 @@
       (.domain #js [0 (apply max response-times)])
       (.range #js [0 chart-width])))

-(defn render-bar [x-scale y-scale bar]
-  (let [scaled-x (x-scale (.-x bar))
-        scaled-y (y-scale (.-y bar))
-        scaled-dx (x-scale (.-dx bar))]
-    (dom/g #js {:transform (str "translate(" scaled-x "," scaled-y ")")
-                :className "bar"}
-           (dom/rect #js {:width (dec scaled-dx)
-                          :height (- chart-height scaled-y)})
-           (dom/text #js {:dy "0.75em"
-                          :y 6
-                          :x (/ scaled-dx 2)
-                          :textAnchor "middle"}
-                     (when (pos? (.-y bar)) (.-y bar))))))
+(defn bar-component [bar x-scale y-scale chart-height]
+  (reify
+    om/IRender
+    (render [_]
+      (let [scaled-x (x-scale (.-x bar))
+            scaled-y (y-scale (.-y bar))
+            scaled-dx (x-scale (.-dx bar))]
+        (dom/g #js {:transform (str "translate(" scaled-x "," scaled-y ")")
+                    :className "bar"}
+               (dom/rect #js {:width (dec scaled-dx)
+                              :height (- chart-height scaled-y)})
+               (dom/text #js {:dy "0.75em"
+                              :y 6
+                              :x (/ scaled-dx 2)
+                              :textAnchor "middle"}
+                         (when (pos? (.-y bar)) (.-y bar))))))))

 (defn x-axis-path-component [scale]
   (reify
@@ -38,13 +41,16 @@
         (dom/path #js {:className "domain"
                        :d (str "M0" (aget rng 0) ",6V0H" (aget rng 1) "V6")})))))

-(defn render-x-axis-ticks [x-scale]
-  (let [ticks (.apply (.-ticks x-scale) x-scale)]
-    (apply dom/g nil (map (fn [tick]
-                            (dom/g #js {:className "tick" :transform (str "translate(" (x-scale tick) ",0)")}
-                                   (dom/line #js {:x2 0 :y2 6})
-                                   (dom/text #js {:dy ".71em" :y 9 :x 0 :style #js {:textAnchor "middle"}} tick)))
-                          ticks))))
+(defn x-axis-ticks-component [scale]
+  (reify
+    om/IRender
+    (render [_]
+      (let [ticks (.apply (.-ticks scale) scale)]
+        (apply dom/g nil (map (fn [tick]
+                                (dom/g #js {:className "tick" :transform (str "translate(" (scale tick) ",0)")}
+                                       (dom/line #js {:x2 0 :y2 6})
+                                       (dom/text #js {:dy ".71em" :y 9 :x 0 :style #js {:textAnchor "middle"}} tick)))
+                              ticks))))))

 (defn x-axis-component [{:keys [chart-height scale]} owner]
   (reify
@@ -52,7 +58,7 @@
     (render [_]
       (dom/g #js {:className "x axis" :transform (str "translate(0," chart-height ")")}
              (om/build x-axis-path-component scale)
-             (render-x-axis-ticks scale)))))
+             (om/build x-axis-ticks-component scale)))))

 (defn component [{:keys [data-points]} owner]
   (reify
@@ -77,4 +83,4 @@
                                :height (+ chart-height top bottom)}
                           (apply dom/g #js {:transform (str "translate(" left "," top ")")}
                                  (om/build x-axis-component {:chart-height chart-height :scale x-scale})
-                                 (map #(render-bar x-scale y-scale %) data))))))))
+                                 (om/build-all #(bar-component % x-scale y-scale chart-height) data))))))))


added discussion forum stuff brah

added discussion forum stuff brah

--- src/crawler/discussion_forum.clj
+++ src/crawler/discussion_forum.clj
@@ -59,11 +59,12 @@
                                  (:corpus x))])
        (:actions estimated-model))

-      :expected
-      (map
-       (fn [l]
-         (* (Math/pow 5 (count l)) 10))
-       (:actions estimated-model))])
+      ;:expected
+      ;; (map
+      ;;  (fn [l]
+      ;;    (* (Math/pow 5 (count l)) 10))
+      ;;  (:actions estimated-model))
+      :observed (:observed x)])
     (>= (:observed x) num-leaves)))

 (defn leaf?


Round corners of boxes

Round corners of boxes

--- src/gigrig/components/boxes.cljs
+++ src/gigrig/components/boxes.cljs
@@ -2,7 +2,7 @@

 (defn boxed-text [{:keys [text x y width height]}]
   [:g
-   [:rect {:x x :y y :width width :height height :fill (:background text)}]
+   [:rect {:x x :y y :width width :height height :rx 1 :ry 1 :fill (:background text)}]
    [:text {:x (:x text) :y (:y text) :font-family "monospace" :font-size (:size text)}
     (:value text)]])


Use utils/remove-prefix-from-path in impl.copy.

--- src/incise/parsers/impl/copy.clj
+++ src/incise/parsers/impl/copy.clj
@@ -1,14 +1,12 @@
 (ns incise.parsers.impl.copy
   (:require [incise.parsers.core :as pc]
+            [incise.utils :refer [remove-prefix-from-path]]
             [clojure.java.io :refer [file copy]]
             [incise.config :as conf]))

-(defn relative-path-from [directory afile]
-  (subs (.getCanonicalPath afile) (inc (count (.getCanonicalPath directory)))))
-
 (defn parse [input-file]
   (let [{:keys [in-dir out-dir]} (conf/get)
-        input-filename (relative-path-from (file in-dir) input-file)
+        input-filename (remove-prefix-from-path in-dir input-file)
         output-file (file out-dir input-filename)]
     (.mkdirs (.getParentFile output-file))
     (copy input-file output-file)


(maint) Drop use of positional params when updating metrics

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -462,8 +462,8 @@
           command-chan (async/chan
                          (queue/sorted-command-buffer
                           max-enqueued
-                          #(cmd/update-counter! :invalidated %1 %2 inc!)
-                          #(cmd/update-counter! :ignored %1 %2 inc!)))
+                          (fn [cmd ver] (cmd/update-counter! :invalidated cmd ver inc!))
+                          (fn [cmd ver] (cmd/update-counter! :ignored cmd ver inc!))))
           emit-cmd-events? (or (conf/pe? config) emit-cmd-events?)
           maybe-send-cmd-event! (partial maybe-send-cmd-event! emit-cmd-events? cmd-event-ch)
           [q load-messages] (queue/create-or-open-stockpile (conf/stockpile-dir config)


(PDB-4732) Forbid migration when there's more than one write db

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -597,6 +597,12 @@

     (when-let [v (version/version)]
       (log/info (trs "PuppetDB version {0}" v)))
+
+    (when (> (count (conf/section-subsections database)) 1)
+      (throw
+       (ex-info "Currently unable to migrate multiple databases (see config)"
+                {:kind ::must-migrate-multiple-databases})))
+
     (init-with-db database config)

     (if upgrade-and-exit?
@@ -737,8 +743,10 @@
           ::invalid-database-configuration
           (stop (invalid-conf-msg (:failed-validation data)) 1)

-          ::migration-required
-          (stop (.getMessage ex) (int \m))
+          ::migration-required (stop (.getMessage ex) (int \m))
+
+          ::must-migrate-multiple-databases
+          (stop (str "puppetdb: " (.getMessage ex) "\n") 2)

           ;; Unrecognized -- pass it on.
           (throw ex))))))


Add curve-tightness to curve/curve.cljs example.

--- src/quil_cljs_examples/curves/curve.cljs
+++ src/quil_cljs_examples/curves/curve.cljs
@@ -7,6 +7,11 @@
 	(q/background 255)
 	(q/no-fill)
 	(q/stroke 0)
+
+	(q/curve-tightness 3.5)
+	(q/curve 5 26 73 24 73 61 15 65)
+
+	(q/curve-tightness 0.0)
 	(q/curve 5 26 73 24 73 61 15 65)
 	(doseq [i (range 6)]
 		(let [t (/ i 6.0)


Removed unused private function

Removed unused private function

--- src/main/cljs/lean_map/core.cljs
+++ src/main/cljs/lean_map/core.cljs
@@ -172,15 +172,6 @@
             (key-test key (aget arr idx)) [(aget arr idx) (aget arr (inc idx))]
             :else                  not-found))))

-(defn- create-node [edit shift key1 val1 key2hash key2 val2]
-  (let [key1hash (hash key1)]
-    (if (== key1hash key2hash)
-      (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2))
-      (let [changed? (Box. false false)]
-        (-> (.-EMPTY BitmapIndexedNode)
-            (.inode-assoc edit shift key1hash key1 val1 changed?)
-            (.inode-assoc edit shift key2hash key2 val2 changed?))))))
-
 (deftype PersistentHashMap [meta cnt root ^:mutable __hash]
   Object
   (toString [coll]


coercion/coerce! can be used now

coercion/coerce! can be used now

--- modules/reitit-frontend/src/reitit/frontend.cljs
+++ modules/reitit-frontend/src/reitit/frontend.cljs
@@ -23,12 +23,9 @@
       (let [q (query-params uri)
             ;; Return uncoerced values if coercion is not enabled - so
             ;; that tha parameters are always accessible from same property.
-            ;; FIXME: coerce! can't be used as it doesn't take query-params
-            parameters (if (:result match)
-                         (coercion/coerce-request (:result match) {:query-params q
-                                                                   :path-params (:path-params match)})
-                         {:query q
-                          :path (:path-params match)})]
+            parameters (or (coercion/coerce! (assoc match :query-params q))
+                           {:path (:path-params match)
+                            :query q})]
         (assoc match :parameters parameters)))))

 (defn match-by-name


Record hashtags if any

Record hashtags if any

--- src/layzee/use_cases/realtime_sample.clj
+++ src/layzee/use_cases/realtime_sample.clj
@@ -3,15 +3,17 @@

 (defn- clean[text] (.replace text "\n" ""))

-(defn- console[tweet]
-(let [text (clean (get tweet "text")) created-at (get tweet "created_at") screen-name (get-in tweet ["user" "screen_name"])]
+(defn- hash-tags[tweet]
+  ;;(println (get-in tweet ["entities" "hashtags"]))
+  (clojure.string/join "," (map #(str "#" (get % "text")) (or (get-in tweet ["entities" "hashtags"]) []))))
+
+(defn- log-with[tweet fn]
+  (let [text (clean (get tweet "text")) created-at (get tweet "created_at") screen-name (get-in tweet ["user" "screen_name"]) hash-tags (hash-tags tweet)]
     (when (not (nil? text))
-      (println (format "[%s] -- @%s -- %s" created-at screen-name text)))))
-
-(defn- record[tweet]
-  (let [text (clean (get tweet "text")) created-at (get tweet "created_at") screen-name (get-in tweet ["user" "screen_name"])]
-    (when (not (nil? text))
-      (journal/record (format "[%s] -- @%s -- %s" created-at screen-name text)))))
+      (apply fn [(format "[%s] -- @%s -- [%s] %s" created-at screen-name hash-tags text)]))))
+
+(defn- console[tweet] (log-with tweet println))
+(defn- record[tweet] (log-with tweet journal/record))

 (defn- view[tweet]
   (console tweet)


Future work comment.

Future work comment.

--- src/onyx/messaging/netty_tcp.clj
+++ src/onyx/messaging/netty_tcp.clj
@@ -298,6 +298,8 @@

 (defmethod extensions/open-peer-site NettyTcpSockets
   [messenger assigned]
+  ;; TODO: get rid of buf-recv-ch and do the handling inside
+  ;; the netty handler
   (let [buf-recv-ch (chan 10000)
         inbound-ch (:inbound-ch (:messenger-buffer messenger))
         release-ch (:release-ch messenger)


Improve warn message when task exception is thrown

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -369,7 +369,7 @@
   (let [data (ex-data e)]
     (if (:onyx.core/lifecycle-restart? data)
       (warn (:original-exception data) "Caught exception inside task lifecycle. Rebooting the task.")
-      (do (warn e "Uncaught exception throw inside task lifecycle.")
+      (do (warn e "Handling uncaught exception thrown inside task lifecycle.")
           (if (restart-pred-fn e)
             (>!! restart-ch true)
             (let [entry (entry/create-log-entry :kill-job {:job job-id})]


bugfix visualize-result switch not working

--- src/distillery/core.clj
+++ src/distillery/core.clj
@@ -23,7 +23,7 @@
   (trace-block
    "Result Output"
    (dt/save-result-as-xml job))
-  (when (get-in job [:configuration :visualize-results])
+  (when (get-in job [:configuration :visualize-result])
     (trace-block
      "Result Visualization"
      (dt/prepare-output-dir job)


Add (try) around Robot. to fix travis testing

--- src/elite_mfd/macro.clj
+++ src/elite_mfd/macro.clj
@@ -2,9 +2,16 @@
       :doc "Macro support"}
   elite-mfd.macro
   (:require [elite-mfd.util :refer [log]])
-  (:import  [java.awt Robot]))
+  (:import  [java.awt Robot AWTException]))

-(def robot (Robot.))
+;; Without this, the Robot init would create a dock icon on OSX
+;;  Not a big deal, but may be nicer when OSX client is released
+(System/setProperty "apple.awt.UIElement" "false")
+
+;; NB travis runs in a headless env, so the following would crash
+(def robot (try
+             (Robot.)
+             (catch AWTException e)))

 ;; TODO read these from commander settings
 (def cmdr-bindings {:navigation "1"


Simple websocket handler

Simple websocket handler

--- src/potential_adventure/core.clj
+++ src/potential_adventure/core.clj
@@ -2,16 +2,27 @@
   (:gen-class)
   (:use org.httpkit.server
         [taoensso.timbre :as log]
+        [clojure.data.json :only [read-json]]
         (compojure [core :only [defroutes GET]]
                    [handler :only [site]]
                    [route :only [not-found files]])))

-(defn request-demo-handler [request]
-  (-> (log/info "get /request-demo-handler")
-      (str request)))
+
+(defn msg-received [msg]
+  (let [data (read-json msg)]
+    (log/info "msg reeived" data)))
+
+
+(defn ws-handler [request]
+  (with-channel request channel
+    (log/info channel "connected")
+    (on-receive channel #'msg-received)
+    (on-close channel (fn [status]
+                        (log/info "Channel closed" status)))))
+

 (defroutes routes
-  (GET "/request-demo-handler" request (request-demo-handler request))
+  (GET "/ws" request (ws-handler request))
   (files "" {:root "static"}))


Remove invalid-column-keys from the public API (its intended to be internal)

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -59,10 +59,10 @@
   (let [headers (column-names dataset)]
     (resolve-col-id column-key headers not-found)))

-(defn invalid-column-keys
+(defn- invalid-column-keys
   "Takes a sequence of column key names and a dataset and returns a
   sequence of keys that are not in the dataset."
-  [keys dataset]
+  [dataset keys]

   (let [not-found (Object.)
         not-found-items (->> keys
@@ -84,7 +84,7 @@
   One advantage of this over using columns is that you can duplicate
   an arbitrary number of columns."
  [dataset cols]
-  (let [not-found-items (invalid-column-keys cols dataset)]
+  (let [not-found-items (invalid-column-keys dataset cols)]
     (if (and (empty? not-found-items)
             (some identity cols))
       (inc/$ cols dataset)


Функционал для ролей

Функционал для ролей

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -701,19 +701,20 @@
       :current
       webuserwebrole-get-rels-set-for-username ))

-(defn keys-for-roles [row roles-set role ks]
-  (if (contains? roles-set (:keyname role))
-    row (reduce dissoc
-                (update-in row [:disabled-keys]
-                           #(if (empty? %)
-                              (set ks)
-                              (reduce conj % ks)))
-                ks)))
-
-(defn throw-when-no-roles [roles-keys-set role]
+(defn contains-webroles? [roles-keys-set roles]
+  (reduce #(or % (contains? roles-keys-set (:keyname %2))) false roles))
+
+(defn keys-for-roles [row roles-keys-set roles ks]
+  (if (contains-webroles? roles-keys-set roles)
+    row (reduce dissoc row ks)))
+
+(defn throw-when-no-role [roles-keys-set role]
   (when (not (contains? roles-keys-set (:keyname role)))
     (throw (Exception. "У вас нет прав доступа для данной функции!"))))
-
+
+(defn throw-when-no-roles [roles-keys-set roles]
+  (when (not (contains-webroles? roles-keys-set roles))
+    (throw (Exception. "У вас нет прав доступа для данной функции!"))))


remove debug printing

remove debug printing

--- src/solar_system_of_js/draw.cljs
+++ src/solar_system_of_js/draw.cljs
@@ -451,7 +451,6 @@
         (global-alpha! alpha))
       (draw-orbit! {:r r})
       (fill-text! (upper-case (name name-)) 7000 y)
-      (println "r" r)
       (restore!))
   (restore!)))


speaker ui sorts participants by number

speaker ui sorts participants by number

--- src/tango/cljs/speaker/core.cljs
+++ src/tango/cljs/speaker/core.cljs
@@ -59,7 +59,7 @@
   (render
     [this]
     (let [{:keys [heats starting]} (om/props this)
-          heat-dist (domain/create-distribution starting heats)]
+          heat-dist (domain/create-distribution (sort-by :participant/number starting) heats)]
       (log heat-dist)
       (dom/div nil
         (map-indexed #((om/factory HeatRow) {:heat-number (inc %1)


ignore drag events in codemirror. closes #1524, closes #1523

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -44,7 +44,6 @@
                              "plaintext")
                      :autoClearEmptyLines true
                      :dragDrop false
-                     :onDragEvent (fn [] true)
                      :undoDepth 10000
                      :matchBrackets true
                      :singleCursorHeightPerLine false
@@ -69,6 +68,10 @@

 (defn wrap-object-events [ed obj]
   (dom/on (->elem ed) :contextmenu #(object/raise obj :menu! %))
+  (on ed :dragstart #(.preventDefault %2))
+  (on ed :dragstenter #(.preventDefault %2))
+  (on ed :dragover #(.preventDefault %2))
+  (on ed :drop #(.preventDefault %2))
   (on ed :scroll #(object/raise obj :scroll %))
   (on ed :update #(object/raise obj :update % %2))
   (on ed :change #(object/raise obj :change % %2))