ctrl+c to copy on windows

ctrl+c to copy on windows

--- src-cljs/frontend/components/clip_viewer.cljs
+++ src-cljs/frontend/components/clip_viewer.cljs
@@ -15,6 +15,7 @@
             [frontend.utils :as utils :include-macros true]
             [frontend.utils.date :refer (date->bucket)]
             [goog.date]
+            [goog.userAgent]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true])
   (:require-macros [sablono.core :refer (html)])
@@ -32,13 +33,14 @@
            [:h2.make
             "Keep track of everything you copy and paste."]
            [:p.make
-            "If you sign in with Google we keep track of everything you copy."]
+            "If you sign in with Google, we'll keep track of all the shapes you copy from the canvas. Use this unique feature to create a custom library of your favorite components."]
            [:div.calls-to-action.make
             (om/build common/google-login {:source "Clip viewer signup"})]]])))))

 (defn clips-list [clips owner]
   (reify
     om/IDisplayName (display-name [_] "Clip Viewer clips List")
+    om/IInitState (init-state [_] {:mac? goog.userAgent/MAC})
     om/IDidMount (did-mount [_] (fdb/watch-doc-name-changes owner))
     om/IRender
     (render [_]
@@ -46,8 +48,10 @@
         (html
          [:div.content
           [:h2.make "Paste clips into your doc. "]
-          [:p.make "Add new clips to the list by copying selected shapes on the canvas with Cmd+C. "
-                   "Star clips to pin them to the top. "]
+          [:p.make "Add new clips to the list by copying selected shapes on the canvas with " (if (om/get-state owner :mac?)
+                                                                                "Cmd+C."
+                                                                                "Ctrl+C.")
+                   " Star clips to pin them to the top. "]
           [:div.clips
            (for [clip clips]
              (html


CMR-307: Added tests for int attribute searching.

--- test/cmr/system_int_test/search/granule_psa_search_test.clj
+++ test/cmr/system_int_test/search/granule_psa_search_test.clj
@@ -32,7 +32,10 @@
        "string,alpha,b,b" (am/max-must-be-greater-than-min-msg "b" "b")
        "float,alpha,a" (am/invalid-value-msg :float "a")
        "float,alpha,a,0" (am/invalid-value-msg :float "a")
-       "float,alpha,0,b" (am/invalid-value-msg :float "b"))
+       "float,alpha,0,b" (am/invalid-value-msg :float "b")
+       "int,alpha,a" (am/invalid-value-msg :int "a")
+       "int,alpha,a,0" (am/invalid-value-msg :int "a")
+       "int,alpha,0,b" (am/invalid-value-msg :int "b"))

     (is (= {:status 422 :errors [(am/attributes-must-be-sequence-msg)]}
          (search/get-search-failure-data
@@ -52,6 +55,8 @@
         gran3 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "bravo" ["aa" "bf"])]}))
         gran4 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "charlie" ["az"])]}))]
     (index/flush-elastic-index)
+
+    ;; TODO add additional deftest for datetime_string date_string, and time_string that they're treated as strings.

     (testing "search by value"
       (are [v items]
@@ -114,7 +119,46 @@
            "float,bravo,120," [gran2 gran3]

            ;; only max range provided
-           "float,bravo,,13.6" [gran2]))))
+           "float,bravo,,13.6" [gran1 gran2]))))
+
+(deftest int-psas-search-test
+  (let [psa1 (dc/psa "alpha" :int)
+        psa2 (dc/psa "bravo" :int)
+        psa3 (dc/psa "charlie" :int)
+        coll1 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2]}))
+        gran1 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes [(dg/psa "alpha" [10 123])
+                                                                                (dg/psa "bravo" [-12])]}))
+        gran2 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes [(dg/psa "bravo" [10 123])]}))
+
+        coll2 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2 psa3]}))
+        gran3 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "alpha" [14])
+                                                                                (dg/psa "bravo" [13 123])]}))
+        gran4 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "charlie" [14])]}))]
+    (index/flush-elastic-index)
+
+    (testing "search by value"
+      (are [v items]
+           (d/refs-match? items (search/find-refs :granule {"attribute[]" v}))
+           "int,bravo,123" [gran2, gran3]
+           "int,alpha,11" []
+           "int,bravo,-12" [gran1]))
+
+    (testing "search by range"
+      (are [v items]
+           (d/refs-match? items (search/find-refs :granule {"attribute[]" v}))
+
+           ;; inside range
+           "int,alpha,9,11" [gran1]
+           ;; beginning edge of range
+           "int,alpha,10,11" [gran1]
+           ;; ending edge of range
+           "int,alpha,9,10" [gran1]
+
+           ;; only min range provided
+           "int,bravo,120," [gran2 gran3]
+
+           ;; only max range provided
+           "int,bravo,,12" [gran1 gran2]))))


reset game fixes

reset game fixes

--- src/cljs/pain_tetris/components/new_game.cljs
+++ src/cljs/pain_tetris/components/new_game.cljs
@@ -13,5 +13,11 @@
                     :onClick (fn []
                                (swap! t/grid g/clear-grid)
                                (reset! g/piece-counter 0)
+                               (reset! t/block-speed 1)
+                               (reset! t/turn-counter 0)
+                               (reset! t/drop-side :top)
+                               (reset! t/gravity-direction :down)
+                               (reset! t/points 0)
+                               (js/clearInterval @t/timer)
                                (t/start-game @t/block-speed))}
                (r/glyphicon {:glyph "refresh"})))))


:no_mouth:

:no_mouth:

port stuff

--- src/main/clj/agency/irl/instagrammer/core.clj
+++ src/main/clj/agency/irl/instagrammer/core.clj
@@ -63,7 +63,8 @@
   (println "***")
   (println)

-  (run-server app {:port (env :port)})
+
+  (run-server app {:port (Integer. (or port (env :port) 5000))})

   ;; Bing all that jazz
 ; (binding [subscribe/*client-id*     (:client-id client-options)


cleanup

cleanup

--- src/name_bazaar/server/emailer/listeners.cljs
+++ src/name_bazaar/server/emailer/listeners.cljs
@@ -63,9 +63,7 @@
                                           #(prn "Success sending email")
                                           #(prn "An error has occured: " %))))))

-;; TODO
 (defn- on-offering-bought [server-state offering original-owner name price]
-  (prn "@on-offering-bought")
   (go
     (let [[_ owner-encrypted-email] (<! (district0x-emails-api/get-email @server-state {:district0x-emails/address original-owner}))]
       (when-let [to-email (validate-email owner-encrypted-email)]


Deferring extracting lefts

Deferring extracting lefts

--- src/structural_typing/mechanics/m_compile.clj
+++ src/structural_typing/mechanics/m_compile.clj
@@ -34,9 +34,11 @@

     (fn [object-to-check]
       (reduce (fn [all-errors [original-path compiled-path per-path-error-maps]]
-                (into all-errors (oopsies-for-one-path object-to-check
-                                                      (specter/compiled-select compiled-path object-to-check)
-                                                      original-path
-                                                      per-path-error-maps)))
+                (let [selected-values (specter/compiled-select compiled-path object-to-check)
+                      oopsies (oopsies-for-one-path object-to-check
+                                                    selected-values
+                                                    original-path
+                                                    per-path-error-maps)]
+                  (into all-errors oopsies)))
               []
               processed-triples))))


(PDB-3830) Decrement queue depth when discarding a message

Prior to this commit, when a message is discarded it had no effect
on the command queue depth metrics.

After this commit, when a message is discarded we decrement the
queue depth metric.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -473,7 +473,9 @@
   (-> cmdref
       (queue/cons-attempt ex)
       (dlo/discard-cmdref q dlo))
-  (mark-both-metrics! (:command cmdref) (:version cmdref) :discarded))
+  (let [{:keys [command version]} cmdref]
+    (mark-both-metrics! command version :discarded)
+    (update-counter! :depth command version dec!)))

 (defn process-delete-cmdref
   "Processes a command ref marked for deletion. This is similar to


Add partial stroke element options menu.

--- src/uxbox/ui/workspace/options.cljs
+++ src/uxbox/ui/workspace/options.cljs
@@ -26,7 +26,12 @@
    :menu/fill
    {:name "Fill"
     :icon i/fill
-    :id :menu/fill}})
+    :id :menu/fill}
+
+   :menu/stroke
+   {:name "Stroke"
+    :icon i/stroke
+    :id :menu/stroke}})

 (defn- viewportcoord->clientcoord
   [pageid viewport-x viewport-y]
@@ -44,6 +49,81 @@

 (defmulti -render-menu
   (fn [menu own shape] (:id menu)))
+
+(defmethod -render-menu :menu/stroke
+  [menu own shape]
+  (letfn [(change-stroke [value]
+            (let [sid (:id shape)]
+              (rs/emit! (dw/update-shape-stroke sid value))))
+          (on-width-change [event]
+            (let [value (dom/event->value event)
+                  value (parse-float value 1)]
+              (change-stroke {:width value})))
+          (on-opacity-change [event]
+            (let [value (dom/event->value event)
+                  value (parse-float value 1)]
+              (change-stroke {:opacity value})))
+          (on-color-change [event]
+            (let [value (dom/event->value event)]
+              (change-stroke {:color value})))]
+    (html
+     [:div.element-set {:key (str (:id menu))}
+      [:div.element-set-title (:name menu)]
+      [:div.element-set-content
+       [:span "Style"]
+       [:div.row-flex
+        [:input#width.input-text
+         {:placeholder "Width"
+          :type "number"
+          :min "0"
+          :value (:stroke-width shape "")
+          :on-change on-width-change}]
+        [:select#style {:placeholder "Style"}
+         [:option {:value "none"} "None"]
+         [:option {:value "none"} "Solid"]
+         [:option {:value "none"} "Dotted"]
+         [:option {:value "none"} "Dashed"]]]
+
+       ;; SLIDEBAR FOR ROTATION AND OPACITY
+       [:span "Color"]
+       (colorpicker {:picker {:width 165 :height 165}
+                     :bar {:width 15 :height 165}
+                     :callback #(change-stroke {:color (:hex %)})})
+
+       [:div.row-flex
+        [:input#width.input-text
+         {:placeholder "#"
+          :type "text"
+          :value (:stroke shape "")
+          :on-change on-color-change}]]
+
+       (recent-colors shape #(change-stroke {:color %}))
+       [:span "Border radius"]
+       [:div.row-flex
+        [:div.border-element.top-left
+         i/radius
+         [:input.input-text {:type "text" :placeholder "px"}]]
+        [:div.border-element.top-right
+         i/radius
+         [:input.input-text {:type "text" :placeholder "px"}]]
+        [:span.lock-size i/lock]
+        [:div.border-element.bottom-left
+         i/radius
+         [:input.input-text {:type "text" :placeholder "px"}]]
+        [:div.border-element.bottom-right
+         i/radius
+         [:input.input-text {:type "text" :placeholder "px"}]]]
+
+       ;; SLIDEBAR FOR ROTATION AND OPACITY
+       [:span "Opacity"]
+       [:div.row-flex
+        [:input.slidebar
+         {:type "range"
+          :min "0"
+          :max "1"
+          :value (:stroke-opacity shape "1")
+          :step "0.0001"
+          :on-change on-opacity-change}]]]])))

 (defmethod -render-menu :menu/fill
   [menu own shape]


minor

minor

--- contrib/tools.reader/src/main/clojure/clojure/tools/reader.clj
+++ contrib/tools.reader/src/main/clojure/clojure/tools/reader.clj
@@ -346,7 +346,6 @@
   (log-source rdr
     (let [[line column] (starting-line-col-info rdr)
           m (desugar-meta (read rdr true nil true))]
-      ;;(println m)
       (when-not (map? m)
         (reader-error rdr "Metadata must be Symbol, Keyword, String or Map"))
       (let [o (read rdr true nil true)]


web task: fixes #206, web.xml format regression

--- boot/worker/src/boot/web.clj
+++ boot/worker/src/boot/web.clj
@@ -39,7 +39,7 @@
                 "context-destroy" context-destroy)
        [:servlet-mapping {}
         [:servlet-name {} name]
-        [:url-pattern {} [:url-pattern {} "/*"]]]]
+        [:url-pattern {} "/*"]]]
       splice
       xml/sexp-as-element
       xml/indent-str))


Add activity edit cancel button

Add activity edit cancel button

--- src/cljs/elevent_client/pages/events/id/activities/id/edit.cljs
+++ src/cljs/elevent_client/pages/events/id/activities/id/edit.cljs
@@ -240,7 +240,11 @@
               [action-button/component
                {:class (str "primary" (when (seq errors) " disabled"))}
                (if activity-id "Edit" "Add")
-               (create-activity @form)]]]
+               (create-activity @form)]
+              (when activity-id
+                [:button.ui.button
+                 {:on-click #(js/location.replace (routes/event-activity-add event))}
+                 "Cancel"])]]
             [:div.ui.vertical.segment
              [:h2.ui.header
               "Activities"]


memoize a couple profiling funcs

memoize a couple profiling funcs

--- src/com/billpiel/mem_tracer/util/tree_query.clj
+++ src/com/billpiel/mem_tracer/util/tree_query.clj
@@ -101,20 +101,21 @@
              (or #{})
              (apply conj* <> tag))})

-(defn get-children-tag-summary*
-  [zipr pred-map]
-  (let [this-tags (-> zipr
-                      z/node
-                      (get-tags' pred-map))]
-    (insert-tag-into-children-tag-summary this-tags
-                                          (if-let [ch-zips (-> zipr
-                                                               children-zips
-                                                               not-empty)]
-                                            (->> ch-zips
-                                                 (map #(get-children-tag-summary* %
-                                                                                pred-map))
-                                                 (apply merge-children-tag-summary))
-                                            (merge-children-tag-summary)))))
+(def get-children-tag-summary*
+  (memoize
+   (fn [zipr pred-map]
+     (let [this-tags (-> zipr
+                         z/node
+                         (get-tags' pred-map))]
+       (insert-tag-into-children-tag-summary this-tags
+                                             (if-let [ch-zips (-> zipr
+                                                                  children-zips
+                                                                  not-empty)]
+                                               (->> ch-zips
+                                                    (map #(get-children-tag-summary* %
+                                                                                pred-map))
+                                                    (apply merge-children-tag-summary))
+                                               (merge-children-tag-summary)))))))

 (defn get-children-tag-summary ;; memoize?
   [zipr pred-map]
@@ -128,17 +129,17 @@
                                    {:a #(-> % :id #{1 2 3 4}) :even #(-> (do %)
                                                                          :id
                                                                          even?)}))
-
-(defn seq->tag-summary ;; memoize?
-  [zips pred-map]
-  (let [[fst & rest] (or zips [])]
-    (insert-tags-into-summary
-     (when fst
-       (get-tags' (z/node fst)
-                  pred-map))
-     (when rest
-       (seq->tag-summary rest
-                         pred-map)))))
+(def seq->tag-summary
+  (memoize
+   (fn [zips pred-map]
+     (let [[fst & rest] (or zips [])]
+       (insert-tags-into-summary
+        (when fst
+          (get-tags' (z/node fst)
+                     pred-map))
+        (when rest
+          (seq->tag-summary rest
+                            pred-map)))))))

 (defn tag*
   [zipr pred-map]


added a collected?/DISPENSE test case for transform path

--- test/com/rpl/specter/core_test.cljx
+++ test/com/rpl/specter/core_test.cljx
@@ -1238,5 +1238,16 @@
                         s/DISPENSE
                         ]
                         data)
-           ))
-    ))
+           )))
+  (let [data {:active 3 :items [{:id 1 :val 0} {:id 3 :val 11}]}]
+    (is (= (transform [:items s/ALL (s/selected? :id #(= % 3)) :val] inc data)
+           (transform [(s/collect-one :active)
+                       :items
+                       s/ALL
+                       (s/collect-one :id)
+                       (collected? [a i] (= a i))
+                       s/DISPENSE
+                       :val]
+                      inc
+                      data)
+           ))))


removed brittle (Value-based) test

removed brittle (Value-based) test

--- test/forma/trends/analysis_test.clj
+++ test/forma/trends/analysis_test.clj
@@ -87,8 +87,7 @@
  271: last period in test time series"
  (count (telescoping-long-trend 23 100 271 ndvi reli rain)) => 172
  (count (first (telescoping-long-trend 23 100 271 ndvi reli rain))) => 3
- (count (telescoping-short-trend 30 10 23 100 271 ndvi reli))  => 172
- (last  (telescoping-short-trend 30 10 23 100 271 ndvi reli))  => (roughly -89.45618))
+ (count (telescoping-short-trend 30 10 23 100 271 ndvi reli))  => 172)

 (fact
  "test that the magnitude of the short-term drop of the


Add import test with goog.string.StringBuffer

--- test/node/replumb/require_test.cljs
+++ test/node/replumb/require_test.cljs
@@ -48,6 +48,7 @@
       (is (= 'cljs.user (repl/current-ns)) "(require 'foo.bar.baz) should not change namespace")
       (is (= "nil" out) "(require 'foo.bar.baz) should return \"nil\"")
       (repl/reset-env! ['foo.bar.baz]))
+
     (let [res (do (read-eval-call "(require 'foo.bar.baz)")
                   (read-eval-call "foo.bar.baz/a"))
           out (unwrap-result res)]
@@ -56,6 +57,7 @@
       (is (= 'cljs.user (repl/current-ns)) "(require 'foo.bar.baz) and foo.bar.baz/a should not change namespace")
       (is (= "\"whatever\"" out) "(require 'foo.bar.baz) and foo.bar.baz/a should return \"whatever\"")
       (repl/reset-env! ['foo.bar.baz]))
+
     ;; https://github.com/ScalaConsultants/replumb/issues/39
     (let [res (do (read-eval-call "(require 'foo.bar.baz)")
                   (read-eval-call "foo.bar.baz/const-a"))
@@ -65,7 +67,9 @@
       (is (= 'cljs.user (repl/current-ns)) "(require 'foo.bar.baz) and foo.bar.baz/const-a should not change namespace")
       (is (= "1024" out) "(require 'foo.bar.baz) and foo.bar.baz/const-a should return \"1024\"")
       (repl/reset-env! ['foo.bar.baz]))
-    ;; AR - how to purge referred vars?
+
+    ;; AR - Upstream problem (already solved)
+    ;; https://github.com/ScalaConsultants/replumb/issues/66
     #_(let [res (do (read-eval-call "(require '[foo.bar.baz :refer [a]])")
                     (read-eval-call "a"))
             out (unwrap-result res)]
@@ -101,7 +105,18 @@
       (is (valid-eval-result? out) "(require 'clojure.string) and clojure.string/reverse should be a valid result")
       (is (= 'cljs.user (repl/current-ns)) "(require 'clojure.string) and clojure.string/reverse should not change namespace")
       (is (= "\"tpircserujolc\"" out) "(require 'clojure.string) and clojure.string/reverse should return \"tpircserujolc\"")
-      (repl/reset-env! ['clojure.string])))
+      (repl/reset-env! ['clojure.string]))
+
+    (let [res (do (read-eval-call "(import 'goog.string.StringBuffer)")
+                  (read-eval-call "(let [sb (StringBuffer. \"clojure\")]
+                                     (.append sb \"script\")
+                                     (.toString sb))"))
+          out (unwrap-result res)]
+      (is (success? res) "(import 'goog.string.StringBuffer) and .toString should succeed")
+      (is (valid-eval-result? out) "(import 'goog.string.StringBuffer) and .toString should be a valid result")
+      (is (= 'cljs.user (repl/current-ns)) "(import 'goog.string.StringBuffer) and .toString should not change namespace")
+      (is (= "\"clojurescript\"" out) "(import 'goog.string.StringBuffer) and .toString should return \"clojurescript\"")
+      (repl/reset-env! ['goog.string.StringBuffer])))

   (deftest process-reload
     (let [alterable-core-path "dev-resources/private/test/src/cljs/alterable/core.cljs"
@@ -116,6 +131,7 @@
         (is (valid-eval-result? out) "(require 'alterable.core) and alterable.core/b should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.core) and alterable.core/b should not change namespace")
         (is (= "\"pre\"" out) "(require 'alterable.core) and alterable.core/b should return \"pre\""))
+
       ;; Writing "post" version of alterable.core
       (io/write-file! alterable-core-path post-content)
       (let [res (do (read-eval-call "(require 'alterable.core :reload)")
@@ -145,6 +161,7 @@
         (is (valid-eval-result? out) "(require 'alterable.core) and alterable.core/b should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.core) and alterable.core/b should not change namespace")
         (is (= "\"pre\"" out) "(require 'alterable.core) and alterable.core/b should return \"pre\""))
+
       (let [res (do (read-eval-call "(require 'alterable.utils)")
                     (read-eval-call "alterable.utils/c"))
             out (unwrap-result res)]
@@ -152,6 +169,7 @@
         (is (valid-eval-result? out) "(require 'alterable.utils) and alterable.utils/c should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.utils) and alterable.utils/c should not change namespace")
         (is (= "\"pre\"" out) "(require 'alterable.utils) and alterable.utils/c should return \"pre\""))
+
       ;; Writing "post" version of alterable.core & alterable.utils
       (io/write-file! alterable-utils-path utils-post-content)
       (let [res (do (read-eval-call "(require 'alterable.core :reload-all)")


Sisennys

Sisennys

--- mtg-pairings-server/src/mtg_pairings_server/tournament_api.clj
+++ mtg-pairings-server/src/mtg_pairings_server/tournament_api.clj
@@ -23,8 +23,8 @@
     :body [tournament InputTournament {:description "Uusi turnaus"}]
     (if-let [user (user-for-apikey key)]
       (let [tournament (-> tournament
-                         (update-in [:day] clj-time.coerce/to-local-date)
-                         (assoc :owner user))]
+                           (update-in [:day] clj-time.coerce/to-local-date)
+                           (assoc :owner user))]
         (add-tournament tournament)
         {:status 204})
       {:status 400}))


Bind compiler environment

Bind compiler environment

Fixes #86

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -345,6 +345,7 @@
    (read-eval-print source true))
   ([source expression?]
    (binding [ana/*cljs-ns* @current-ns
+             env/*compiler* st
              *ns* (create-ns @current-ns)
              r/*data-readers* tags/*cljs-data-readers*
              r/resolve-symbol ana/resolve-symbol


basic parameterization tests

basic parameterization tests

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -18,7 +18,6 @@
 ;;TODO:
 ;; test walk, codewalk
 ;; test keypath
-;; test comp-structure-paths

 (defn limit-size [n {gen :gen}]
@@ -404,3 +403,58 @@
     (= (s/select-one (s/transformed [s/ALL pred] op) v)
        (s/transform [s/ALL pred] op v))
     ))
+
+(defspec basic-parameterized-composition-test
+  (for-all+
+    [k1 (limit-size 3 gen/keyword)
+     k2 (limit-size 3 gen/keyword)
+     m1 (limit-size 5
+                 (gen-map-with-keys
+                  gen/keyword
+                  (gen-map-with-keys gen/keyword gen/int k2)
+                  k1))
+    pred (gen/elements [inc dec])]
+    (let [p (s/comp-paths s/keypath s/keypath)]
+      (and
+        (= (s/compiled-select (p k1 k2) m1) (s/select [k1 k2] m1))
+        (= (s/compiled-transform (p k1 k2) pred m1) (s/transform [k1 k2] pred m1))
+        ))))
+
+(defspec various-orders-comp
+  (for-all+
+    [k1 (limit-size 3 gen/keyword)
+     k2 (limit-size 3 gen/keyword)
+     k3 (limit-size 3 gen/keyword)
+     m1 (limit-size 5
+                 (gen-map-with-keys
+                  gen/keyword
+                  (gen-map-with-keys
+                    gen/keyword
+                    (gen-map-with-keys
+                      gen/keyword
+                      gen/int
+                      k3
+                      )
+                    k2)
+                  k1))
+    pred (gen/elements [inc dec])]
+    (let [paths [((s/comp-paths s/keypath s/keypath k3) k1 k2)
+                 (s/comp-paths k1 k2 k3)
+                 ((s/comp-paths s/keypath k2 s/keypath) k1 k3)
+                 ((s/comp-paths k1 s/keypath k3) k2)
+                 (s/comp-paths k1 (s/keypath k2) k3)
+                 ((s/comp-paths (s/keypath k1) s/keypath (s/keypath k3)) k2)
+                 ((s/comp-paths s/keypath (s/keypath k2) s/keypath) k1 k3)
+                 ]
+          ]
+      (and
+        (apply = (for [p paths] (s/compiled-select p m1)))
+        (apply = (for [p paths] (s/compiled-transform p pred m1)))
+        ))))
+
+;;TODO: test using params path
+;; using filterer, transformed, selected? with parameterized paths
+;; using cond-path parameterized paths
+;; parameterized filterer can be composed with other parmaterized paths
+;; parameterized cond-path can be composed with other parammed paths
+;; nested selected? takes params correctly


small test for unit test.

small test for unit test.

--- test/metabase/api/activity_test.clj
+++ test/metabase/api/activity_test.clj
@@ -19,7 +19,8 @@
 ;  2. :user and :model_exists are hydrated

 ; NOTE: timestamp matching was being a real PITA so I cheated a bit.  ideally we'd fix that
-(expect-let [_         (korma.core/delete Activity)
+(expect-let [_         (user->client :crowberto)            ; HACK. we do this to create the user-joined activity after first login before we delete it
+             _         (korma.core/delete Activity)         ; clear out any existing activity
              activity1 (db/ins Activity
                          :topic     "install"
                          :details   {}


add :grammar-map to grammar "medium"

add :grammar-map to grammar "medium"

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -575,6 +575,12 @@
                   (if (not (empty? filtered-v))
                     [k filtered-v]))))]
     {:name "medium"
+
+     ;; Will throw a clojure/core-level exception if more than 1 rule has the same :rule value:
+     :grammar-map (zipmap
+                   (map #(keyword (get-in % [:rule])) grammar)
+                   grammar)
+
      :morph-walk-tree (fn [tree]
                         (do
                           (merge tree


fix typo

fix typo

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -179,11 +179,12 @@
                                        } ;; subcat {
                               } ;; synsem {
                      } ;; end of map
-                    )
-
-             (unify common
-                    {:synsem {:sem {:pred :be}
-                              :subcat {:2 {:cat :prep}}}}))])
+                    ))
+
+           (unify common
+                  {:synsem {:sem {:pred :be}
+                            :subcat {:2 {:cat :prep}}}})])
+

    "be able to" {:english {:imperfect {:1sing "was able to"
                                        :2sing "were able to"


fix typos

fix typos

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1528,28 +1528,23 @@
                          :sem {:pred :scrivere}}
                 :italiano {:passato "scritto"}}

- "sedersi" (let [subject-semantics (ref {:animate true})
+   "sedersi" (let [subject-semantics (ref {:animate true})
                    subject-agr (ref :top)]
                {:synsem {:cat :verb
                          :essere true
-                         :sem {:pred :sit-down
-                  :present {:1sing "siedo"
-                          :2sing "siedi"
-                          :3sing "siede"
-                          :1plur "sediamo"
-                          :2plur "sedete"
-                          :3plur "siedono"}
-                         :sem {:pred :get-up
-                               :reflexive true
-                               :subj subject-semantics
-                               :obj subject-semantics}
+                         :sem {:pred :sit-down}
                          :subcat {:1 {:agr subject-agr
                                       :sem subject-semantics}
                                   :2 {:agr subject-agr
                                       :pronoun true
                                       :reflexive true
-                                      :sem subject-semantics}}}})
-
+                                      :sem subject-semantics}}}
+                :italiano {:present {:1sing "siedo"
+                                     :2sing "siedi"
+                                     :3sing "siede"
+                                     :1plur "sediamo"
+                                     :2plur "sedete"
+                                     :3plur "siedono"}}})
    "sgridare" {:synsem {:cat :verb
                         :sem {:subj {:human true}
                               :pred :scold}}}
@@ -1809,3 +1804,4 @@
              :sem {:human true
                    :pred :voi}
               :subcat '()}}]})
+


Changed indentation level in sparse-expander.

--- src/clj/forma/matrix/utils.clj
+++ src/clj/forma/matrix/utils.clj
@@ -64,10 +64,10 @@
               tup-seq tuples
               v (transient [])]
          (let [[pos val] (first tup-seq)]
-           (cond (halt? idx tup-seq) (persistent! v)
+           (cond (halt? idx tup-seq)    (persistent! v)
                  (when pos (= idx pos)) (recur (inc idx) (rest tup-seq) (conj! v val))
                  (when pos (> idx pos)) (recur (inc idx) (rest tup-seq) (conj! v placeholder))
-                 :else       (recur (inc idx) tup-seq (conj! v placeholder))))))))
+                 :else                  (recur (inc idx) tup-seq (conj! v placeholder))))))))

 (defn idx->colrow
   "Takes an index within a row vector, and returns the appropriate


refine user validation

refine user validation

clearer names
duplicate structure of validation error

--- src/clj_money/models/users.clj
+++ src/clj_money/models/users.clj
@@ -28,25 +28,28 @@
   [schema]
   (when (= s/Str schema)
     (coerce/safe
-      (fn [x]
-        (if (and (string? x) (= 0 (count x)))
+      (fn [value]
+        (if (and (string? value) (= 0 (count value)))
           nil
-          x)))))
+          value)))))

-(defn- coerce-and-validate-user
+(defn- validate-new-user
   [user]
   (let [coercer (coerce/coercer NewUser
                                 nil-matcher)
         result (coercer user)]
     (if (sutils/error? result)
-      (throw (ex-info "The user is not valid." (sutils/error-val result)))
+      (throw (ex-info "The user is not valid."
+                      (merge result
+                             {:schema NewUser
+                              :value user
+                              :type :schema.core/error})))
       result)))

 (defn create
   "Creates a new user record"
   [data-store user]
-  (coerce-and-validate-user user)
-  (let [user (coerce-and-validate-user user)]
+  (let [user (validate-new-user user)]
     (try
       (dissoc (->> user
                    prepare-user-for-insertion


kill loop on closed channels

kill loop on closed channels

--- src/cljs/lesezeichen/core.cljs
+++ src/cljs/lesezeichen/core.cljs
@@ -13,8 +13,6 @@

 (enable-console-print!)
-
-(println "ALL HAIL TO MASTER KONNY!")

 (def uri (goog.Uri. js/location.href))

@@ -32,20 +30,13 @@
                    :ip "0.0.0.0" :port 9001)))

-;; weasel websocket
-(if (= "localhost" (.getDomain uri))
+;; weasel websocket, development only
+#_(if (= "localhost" (.getDomain uri))
   (do
     #_(ws-repl/connect "ws://localhost:9001" :verbose true)
     (figw/watch-and-reload
      ;; :websocket-url "ws://localhost:3449/figwheel-ws" default
      :jsload-callback (fn [] (print "reloaded")))))
-
-
-
-;; --- DATABASE ---
-
-(defn get-bookmarks [stage]
-  (when stage nil))

 ;; --- HELPER FUNCTIONS ---
@@ -74,6 +65,7 @@
   {[:.url-text] (do-> (set-attr :href url)
                       (content (if (= "" title) url title)))
    [:.url-ts] (content (.toLocaleString ts))})
+

 (deftemplate bookmarks "templates/bookmarks.html"
@@ -116,9 +108,8 @@
               :get-user-bookmarks (om/transact! app :bookmarks (fn [old] data))
               :add-bookmark (om/transact! app :bookmarks (fn [old] (into data old)))
               :unknown)
-            (if in
-              (println "WARNING: Socket connection lost!")
-              (recur (<! out)))))))
+            (if-let [package (<! out)]
+              (recur package))))))
     om/IRenderState
     (render-state [this state]
       (bookmarks (:bookmarks app) owner state))))


C views: Pull apart bind-and-set-attr

C views: Pull apart bind-and-set-attr

I don't why I had mashed together binding text inputs to the database
and giving them other attributes. Maybe I had overlooked do->? Anyway,
pull them apart now, because it makes writing the doc/ documentation
easier.

--- src/cljs/theatralia/views.cljs
+++ src/cljs/theatralia/views.cljs
@@ -52,19 +52,15 @@

 ;;;; Fn for dealing with text input fields

-;; TODO: Pull apart bind-and-set-attr. (RM 2015-09-01)
-(defn bind-and-set-attr
-  "Binds a text input field to the given kv-area in the app-db and adds the
-  ATTRS to the text input's existing attributes."
-  [[kv-handle kv-ratom] & attrs]
-  {:pre [(even? (count attrs))]}
+(defn bind-to-kv-area
+  "Binds a text input field to the given kv-area in the app-db."
+  [[kv-handle kv-ratom]]
   (fn [node]
     (let [id (keyword (plumbing/safe-get-in node [:attrs :id]))
-          default-attrs
+          attrs
           [:value (get @kv-ratom id "")
            :onChange #(rf/dispatch [:kv-area/set kv-handle id (value %)])]]
-      ((apply kioo/set-attr
-              (concat default-attrs attrs)) node))))
+      ((apply kioo/set-attr attrs) node))))

 ;;;; Search view
@@ -96,10 +92,10 @@
     (fn search-view-infn []
       (kioo/component "templates/sandbox.html" [:#search-field]
         {[:#searchInput]
-         (bind-and-set-attr kv-area
-                            :onKeyDown
-                            #(when (= (.-key %) "Enter")
-                               (dispatch-kv [:search/submitted kv-area])))
+         (kioo/do->
+           (bind-to-kv-area kv-area)
+           (kioo/set-attr :onKeyDown #(when (= (.-key %) "Enter")
+                                        (dispatch-kv [:search/submitted kv-area]))))

          [:#submit]
          (kioo/set-attr :onClick #(dispatch-kv [:search/submitted
@@ -170,7 +166,7 @@
            :onClick (fn [e]
                       (.preventDefault e)
                       (dispatch-kv [:add-material/submit kv-area])))
-         [:.simple-input] (bind-and-set-attr kv-area)
+         [:.simple-input] (bind-to-kv-area kv-area)
          [:#tag-list-group] (kioo/substitute [tag-inputs-view])}))))


Adds ^:private metadata to a few defs.

Adds ^:private metadata to a few defs.

--- src/clojure/clj_chess/game.clj
+++ src/clojure/clj_chess/game.clj
@@ -4,7 +4,7 @@
   (:require [clojure.zip :as zip]
             [clj-chess.board :as board]))

-(defonce counter (atom 0))
+(defonce ^:private counter (atom 0))

 (defn- generate-id
   "Generates a unique ID for freshly generated nodes."
@@ -63,9 +63,9 @@
                                              (move-function board move))
                        :node-id (generate-id)})))

-(def zip-add-san-move #(zip-add-move %1 board/move-from-san %2))
-(def zip-add-uci-move #(zip-add-move %1 board/move-from-uci %2) )
-(def zip-add-plain-move #(zip-add-move %2 (fn [_ m] m) %2))
+(def ^:private zip-add-san-move #(zip-add-move %1 board/move-from-san %2))
+(def ^:private zip-add-uci-move #(zip-add-move %1 board/move-from-uci %2))
+(def ^:private zip-add-plain-move #(zip-add-move %2 (fn [_ m] m) %2))

 (defn- zip-add-key-value-pair
   [zipper key value]


[netty] Add pre- and post-configure functions for ServerBootstrap

--- modules/netty/src/modular/netty.clj
+++ modules/netty/src/modular/netty.clj
@@ -15,7 +15,7 @@
      first and get to process messages before handlers of lower
      priority."))

- (defrecord NettyServer [port so-options]
+ (defrecord NettyServer [port options]
    component/Lifecycle
    (start [this]

@@ -29,10 +29,13 @@
        (when (empty? handlers)
          (throw (ex-info "No netty handler dependencies on server" {:component this})))

-       (let [boss-group (NioEventLoopGroup.)
-             worker-group (NioEventLoopGroup.)]
+       (let [boss-group     (NioEventLoopGroup.)
+             worker-group   (NioEventLoopGroup.)
+             pre-configure  (get options :pre-configure  identity)
+             post-configure (get options :post-configure identity)]
          (let [b (ServerBootstrap.)]
            (-> b
+               pre-configure
                (.group boss-group worker-group)
                (.channel NioServerSocketChannel)
                (.childHandler
@@ -40,8 +43,9 @@
                   (initChannel [ch]
                     ;;(debugf "Initializing channel with handlers: %s" (vec handlers))
                     (-> ch (.pipeline) (.addLast (into-array ChannelHandler (map (fn [f] (if (fn? f) (f) f)) handlers)))))))
-               (.option ChannelOption/SO_BACKLOG (int (or (:so-backlog so-options) 128)))
-               (.childOption ChannelOption/SO_KEEPALIVE (or (:so-keepalive so-options) true)))
+               (.option ChannelOption/SO_BACKLOG (int (or (:so-backlog options) 128)))
+               (.childOption ChannelOption/SO_KEEPALIVE (or (:so-keepalive options) true))
+               post-configure)

            (assoc this
              :channel (.bind b port)


tidy paren

tidy paren

--- src/overtone/sc/machinery/server/connection.clj
+++ src/overtone/sc/machinery/server/connection.clj
@@ -8,8 +8,7 @@
         [overtone.sc.machinery defaults]
         [overtone.sc.machinery.server comms]
         [overtone.osc]
-        [overtone.osc.decode :only [osc-decode-packet]]
-)
+        [overtone.osc.decode :only [osc-decode-packet]])
   (:require [overtone.util.log :as log]))

 (defonce server-thread*       (ref nil))


support hoplon files

support hoplon files


Better poller implementation.

Better poller implementation.


fix(clojure): set database connection pool size to 300

--- technologies/clojure/src/benchmark/contacts.clj
+++ technologies/clojure/src/benchmark/contacts.clj
@@ -11,7 +11,7 @@
                   :database (System/getenv "Contacts_DatabaseName")
                   :username (System/getenv "Contacts_DatabaseUsername")
                   :password (System/getenv "Contacts_DatabasePassword")
-                  :pool-size 10}))
+                  :pool-size 300}))

 (defn create-json-response [status body]
   {


filter out transaction annotations

filter out transaction annotations

--- src/dato/web_peer/outgoing.clj
+++ src/dato/web_peer/outgoing.clj
@@ -19,7 +19,10 @@
   (instance? java.util.UUID (e->guid (:v datom))))

 (defn cant-broadcast-reason [datom e->guid db-before db-after cust]
-  (cond (not (have-guid? datom e->guid))
+  (cond (= (:e datom) (:tx datom))
+        :transaction-annotation
+
+        (not (have-guid? datom e->guid))
         :missing-guid

         (and false ;; (dsu/ref-attr? db-after (:a datom))


Moved constants to top of let block.

Moved constants to top of let block.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -175,42 +175,38 @@
      "</div>"]))

 (defn vis-svg-actxs [vis positions deltas]
-  ["<defs>"
-   "<marker id='triangle'"
-   " viewBox='0 0 10 10' refX='0' refY='5'"
-   " markerUnits='strokeWidth'"
-   " markerWidth='8' markerHeight='6'"
-   " orient='auto'>"
-   " <path d='M 0 0 L 10 5 L 0 10 z'/>"
-   "</defs>"
-   (mapv (fn [actx-actx-info]
-           (let [[actx actx-info] actx-actx-info
-                 actx-id (last actx)
-                 actx-position (+ 0.5 (get positions actx-id))
-                 wait-chs (:wait-chs actx-info)
-                 chs (:chs vis)
-                 line-height 21]
-             (mapv (fn [kv]
-                     (let [[ch wait-kind] kv
-                           ch-info (get chs ch)
-                           ch-id (:id ch-info)
-                           ch-position (+ 0.5 (get positions ch-id))
-                           stroke-width (if (some #(and (= (:delta %) wait-kind)
-                                                        (= (:actx %) actx)
-                                                        (= (:ch %) ch)) deltas)
-                                          1.5
-                                          1)]
-                       (if (= :put wait-kind)
-                         ["<line x1='500' y1='" (* actx-position line-height)
-                          "' x2='600' y2='" (* ch-position line-height)
-                          "' stroke='green' stroke-width='" stroke-width
-                          "' marker-end='url(#triangle)'/>"]
-                         ["<line x1='600' y1='" (* ch-position line-height)
-                          "' x2='500' y2='" (* actx-position line-height)
-                          "' stroke='red' stroke-width='" stroke-width
-                          "' marker-end='url(#triangle)'/>"])))
-                   wait-chs)))
-         (:actxs vis))])
+  (let [line-height 21
+        stroke-width 1]
+    ["<defs>"
+     "<marker id='triangle'"
+     " viewBox='0 0 10 10' refX='0' refY='5'"
+     " markerUnits='strokeWidth'"
+     " markerWidth='8' markerHeight='6'"
+     " orient='auto'>"
+     " <path d='M 0 0 L 10 5 L 0 10 z'/>"
+     "</defs>"
+     (map (fn [actx-actx-info]
+            (let [[actx actx-info] actx-actx-info
+                  actx-id (last actx)
+                  actx-position (+ 0.5 (get positions actx-id))
+                  wait-chs (:wait-chs actx-info)
+                  chs (:chs vis)]
+              (mapv (fn [kv]
+                      (let [[ch wait-kind] kv
+                            ch-info (get chs ch)
+                            ch-id (:id ch-info)
+                            ch-position (+ 0.5 (get positions ch-id))]
+                        (if (= :put wait-kind)
+                          ["<line x1='500' y1='" (* actx-position line-height)
+                           "' x2='600' y2='" (* ch-position line-height)
+                           "' stroke='green' stroke-width='" stroke-width
+                           "' marker-end='url(#triangle)'/>"]
+                          ["<line x1='600' y1='" (* ch-position line-height)
+                           "' x2='500' y2='" (* actx-position line-height)
+                           "' stroke='red' stroke-width='" stroke-width
+                           "' marker-end='url(#triangle)'/>"])))
+                    wait-chs)))
+          (:actxs vis))]))

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


Wrap spec check into clojure.test

Wrap spec check into clojure.test

--- test/onyx/generative/acking_daemon_gen_test.clj
+++ test/onyx/generative/acking_daemon_gen_test.clj
@@ -176,4 +176,5 @@
    :real/setup #'a/init-state
    :initial-state (fn [ack-state] {:real-state ack-state :model-state {}})})

-(is (specification-correct? acking-daemon-spec))
+(deftest acking-darmon-test
+  (is (specification-correct? acking-daemon-spec)))


(maint) Test code should reflect what is being tested (#284)

(maint) Test code should reflect what is being tested

--- test/puppetlabs/trapperkeeper/services_test.clj
+++ test/puppetlabs/trapperkeeper/services_test.clj
@@ -360,11 +360,14 @@
                      (service1-fn [this] "FOO!"))
           service2 (service Service2
                      [[:Service1 service1-fn]]
-                     (init [this context] (service1-fn) context)
-                     (service2-fn [this] "service2"))
+                     (init [this context] (assoc context
+                                                 :injected-fn-result
+                                                 (service1-fn)))
+                     (service2-fn [this]
+                                  ((svcs/service-context this) :injected-fn-result)))
           app (bootstrap-services-with-empty-config [service1 service2])
           s2  (app/get-service app :Service2)]
-      (is (= "service2" (service2-fn s2))))))
+      (is (= "FOO!" (service2-fn s2))))))

 (defprotocol Service4
   (service4-fn1 [this])


fix logo link

fix logo link

--- src/jarkeeper/views/common.clj
+++ src/jarkeeper/views/common.clj
@@ -36,4 +36,4 @@
 (defn header []
   [:header.header.row
    [:div
-    [:a {:href "http://www.jarkeeper.com"}[:div.logo]]]])
+    [:a {:href "https://jarkeeper.com"}[:div.logo]]]])


Change circle.env/env to a function and add support for RACK_ENV.

--- src/circle/env.clj
+++ src/circle/env.clj
@@ -5,26 +5,33 @@
   (:require [clojure.string :as str])
   (:use [clojure.contrib.except :only (throw-if-not)]))

-(def env (or (keyword (System/getenv "RAILS_ENV")) :development))
+(def env-var nil)
+
+(defn env []
+  (or
+   env-var
+   (keyword (System/getenv "RAILS_ENV"))
+   (keyword (System/getenv "RACK_ENV"))
+   :development))

 (defn production? []
-  (= env :production))
+  (= (env) :production))
 (defn staging? []
-  (= env :staging))
+  (= (env) :staging))
 (defn test? []
-  (= env :test))
+  (= (env) :test))
 (defn development? []
-  (= env :development))
+  (= (env) :development))

 (defn validate-env []
-  (throw-if-not (= 1 (count (filter true? [(production?) (staging?) (test?) (development?)]))) "Unexpected environment: %s" (str env)))
+  (throw-if-not (= 1 (count (filter true? [(production?) (staging?) (test?) (development?)]))) "Unexpected environment: %s" (str (env))))

 (validate-env)

 (defn set-env
   "Takes a string, a rails environment setting"
   [rails-env]
-  (alter-var-root (var env) (constantly (keyword rails-env)))
+  (alter-var-root (var env-var) (constantly (keyword rails-env)))
   (validate-env))

 (when (or (production?) (staging?))


Add document_date field to Document record

--- src-cljs/pepa/data.cljs
+++ src-cljs/pepa/data.cljs
@@ -8,7 +8,7 @@
    [cljs.core.async.macros :refer [go-loop]]))

 (defrecord Page [id rotation render-status dpi])
-(defrecord Document [id title pages created modified notes])
+(defrecord Document [id title pages created modified document_date notes])

 (defrecord State [documents navigation tags upload seqs])


Add an extra sleep

Add an extra sleep

--- atlasdb-jepsen-tests/src/jepsen/atlasdb.clj
+++ atlasdb-jepsen-tests/src/jepsen/atlasdb.clj
@@ -34,6 +34,7 @@
         (c/exec :env "JAVA_HOME=/usr/lib/jvm/java-8-oracle" "/atlasdb-timelock-server/service/bin/init.sh" "start")
         (info node "Waiting until timelock cluster is ready")
         (TimestampClient/waitUntilHostReady (name node))
+        (Thread/sleep (* 1000 10))
         (TimestampClient/waitUntilTimestampClusterReady '("n1" "n2" "n3" "n4" "n5"))))

     (teardown! [_ _ node]


lein ring uberwar ignores servlet-api jars

--- src/leiningen/ring/uberwar.clj
+++ src/leiningen/ring/uberwar.clj
@@ -11,7 +11,9 @@
   (->> (:library-path project)
        (io/file)
        (.listFiles)
-       (filter #(.endsWith (str %) ".jar"))))
+       (filter #(.endsWith (str %) ".jar"))
+       ;; Servlet container will have it's own servlet-api implementation
+       (remove #(.startsWith (.getName %) "servlet-api-"))))

 (defn jar-entries [war project]
   (doseq [jar-file (jar-dependencies project)]


Comment out bidi routes protector

Comment out bidi routes protector

Doesn't compile

--- src/cylon/core.clj
+++ src/cylon/core.clj
@@ -445,7 +445,7 @@
    [:protection-system]))

-(defrecord ProtectedBidiRingHandlerProvider []
+#_(defrecord ProtectedBidiRingHandlerProvider []
   component/Lifecycle
   (start [this]
     (let [protector (get-in this [:protection-system :protector])]
@@ -465,7 +465,7 @@
       (-> routes bidi/make-handler
           (wrap-routes routes)))))

-(defn new-protected-bidi-ring-handler-provider
+#_(defn new-protected-bidi-ring-handler-provider
   "Constructor for a ring handler provider that amalgamates all bidi
   routes provided by components in the system."
   []


flesh out component instrumentation

flesh out component instrumentation

--- frontend/instrumentation.cljs
+++ frontend/instrumentation.cljs
@@ -1,7 +1,14 @@
 (ns frontend.instrumentation
-  (:require [frontend.state :as state]
+  (:require [cljs-time.core :as time]
+            [cljs-time.format :as time-format]
+            [dommy.core :as dommy]
+            [frontend.components.key-queue :as keyq]
+            [frontend.datetime :as datetime]
+            [frontend.state :as state]
             [frontend.utils :as utils :include-macros true]
-            [om.core :as om :include-macros true]))
+            [om.core :as om :include-macros true]
+            [om.dom :as dom :include-macros true])
+  (:use-macros [dommy.macros :only [node sel sel1]]))

 (defn wrap-api-instrumentation [handler api-data]
   (fn [state]
@@ -21,10 +28,103 @@
           (utils/merror e)
           state)))))

+(def component-stats (atom {}))
+
+(defn react-id [x]
+  (let [id (.-_rootNodeID x)]
+    (assert id)
+    id))
+
 (def instrumentation-methods
   (om/specify-state-methods!
-   (clj->js (update-in om/pure-methods [:componentWillUpdate] (fn [f]
-                                                                (fn [next-props next-state]
-                                                                  (this-as this
-                                                                           (js/console.log "updating" (.getDisplayName this))
-                                                                           (.call f this next-props next-state))))))))
+   (-> om/pure-methods
+       (update-in [:componentWillUpdate]
+                  (fn [f]
+                    (fn [next-props next-state]
+                      (this-as this
+                        (let [dname ((aget this "getDisplayName"))]
+                          (swap! component-stats update-in [(react-id this)] merge {:display-name dname
+                                                                                :last-will-update (time/now)}))
+                        (.call f this next-props next-state)))))
+       (update-in [:componentDidUpdate]
+                  (fn [f]
+                    (fn [prev-props prev-state]
+                      (this-as this
+                        (swap! component-stats update-in [(react-id this)]
+                               (fn [stats]
+                                 (let [now (time/now)]
+                                   (-> stats
+                                       (assoc :last-did-update now)
+                                       (update-in [:render-ms] (fnil conj [])
+                                                  (if (time/after? now (:last-will-update stats))
+                                                    (time/in-millis (time/interval (:last-will-update stats) now))
+                                                    0))))))
+                        (.call f this prev-props prev-state)))))
+       (clj->js))))
+
+(defn avg [coll]
+  (/ (reduce + coll)
+     (count coll)))
+
+(defn std-dev [coll]
+  (let [a (avg coll)]
+    (Math/sqrt (avg (map #(Math/pow (- % a) 2) coll)))))
+
+(defn stats-view [data owner]
+  (om/component
+   (dom/figure nil
+     (om/build keyq/KeyboardHandler {}
+               {:opts {:keymap (atom {["ctrl+k"] #(om/transact! data (constantly {}))
+                                      ["ctrl+j"] #(om/update-state! owner :shown? not)})}})
+
+     (when (om/get-state owner :shown?)
+       (let [stats (map (fn [[display-name renders]]
+                          (let [times (mapcat :render-ms renders)]
+                            {:display-name (or display-name "Unknown")
+                             :render-count (count times)
+                             :last-will-update (last (sort (map :last-will-update renders)))
+                             :last-render-ms (last (:render-ms (last (sort-by :last-did-update renders))))
+                             :average-render-ms (when (seq times) (int (avg times)))
+                             :max-render-ms (when (seq times) (apply max times))
+                             :min-render-ms (when (seq times) (apply min times))
+                             :std-dev (when (seq times) (int (std-dev times)))}))
+                        (reduce (fn [acc [react-id data]]
+                                  (update-in acc [(:display-name data)] (fnil conj []) data))
+                                {} data))]
+         (dom/div #js {:className "admin-stats"}
+           (dom/table nil
+             (dom/caption nil "Component render stats, sorted by last update. Clicks go right through like it's not there. Ctrl+j to toggle, Ctrl+k to clear.")
+             (dom/thead nil
+               (dom/tr nil
+                 (dom/th nil "component")
+                 (dom/th #js {:className "number"} "count")
+                 (dom/th #js {:className "number"} "last-update")
+                 (dom/th #js {:className "number"} "last-ms")
+                 (dom/th #js {:className "number"} "average-ms")
+                 (dom/th #js {:className "number"} "max-ms")
+                 (dom/th #js {:className "number"} "min-ms")
+                 (dom/th #js {:className "number"} "std-ms")))
+             (apply dom/tbody nil
+                    (for [{:keys [display-name last-will-update average-render-ms
+                                  max-render-ms min-render-ms std-dev render-count
+                                  last-render-ms] :as stat} (reverse (sort-by :last-will-update stats))]
+                      (dom/tr nil
+                        (dom/td nil display-name)
+                        (dom/td #js {:className "number" } render-count)
+                        (dom/td #js {:className "number" }
+                          (when last-will-update
+                            (time-format/unparse (time-format/formatters :hour-minute-second)
+                                                 last-will-update)))
+                        (dom/td #js {:className "number" } last-render-ms)
+                        (dom/td #js {:className "number" } average-render-ms)
+                        (dom/td #js {:className "number" } max-render-ms)
+                        (dom/td #js {:className "number" } min-render-ms)
+                        (dom/td #js {:className "number" } std-dev)))))))))))
+
+(defn setup-component-stats! []
+  (let [stats-node (node [:div.om-instrumentation])]
+    (dommy/append! (sel1 :body) stats-node)
+    (om/root
+     stats-view
+     component-stats
+     {:target stats-node})))


Fix var name.

Fix var name.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -106,7 +106,7 @@
                          "no-op" (create-no-op-proc-fns pipeline-length)
                          "factorial" [(fn [i _] (factorial i))]
                          "factorial-inc" (create-factorial-proc-fns pipeline-length)
-                         "opennlp-single-inc" opennlp-single-sentence-direct-test-fn
+                         "opennlp-single-inc" opennlp-single-sentence-inc-test-fns
                          "pcap-clj-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-clj-map)]
                                           [(fn [i _] (pcap-fn i))])
                          "pcap-java-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-java-map)]


more log/debug logging

more log/debug logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -224,15 +224,17 @@
                        (assoc-in candidate-parent [:head] head))))
            (lightning-bolts model spec depth max-depth (rest candidate-parents))))
         []))
-    (let [lexemes (shufflefn (get-lexemes model spec))]
-      (if (empty? lexemes)
-        (log/debug (str "lightning-bolts: no lexemes at depth: " depth
-                        " for spec: " (dag_unify.core/strip-refs spec)))
-        (log/debug (str "lightning-bolts at depth: " depth
-                        " first lexeme:" "'"
-                        ((:morph model) (first lexemes))
-                        "'")))
-      lexemes)))
+    (do
+      (log/debug (str "looking for lexemes with spec:" (dag_unify.core/strip-refs spec)))
+      (let [lexemes (shufflefn (get-lexemes model spec))]
+        (if (empty? lexemes)
+          (log/debug (str "lightning-bolts: no lexemes at depth: " depth
+                          " for spec: " (dag_unify.core/strip-refs spec)))
+          (log/debug (str "lightning-bolts at depth: " depth
+                          " first lexeme:" "'"
+                          ((:morph model) (first lexemes))
+                          "'")))
+        lexemes))))

 (defn add-comps-to-bolt
   "bolt + paths => trees"


some edits @donnitazen

some edits @donnitazen

--- src/belhiccup/pages.clj
+++ src/belhiccup/pages.clj
@@ -1,134 +1,104 @@
 (ns belhiccup.pages
   (:require
     [hiccup.core :as hc]
-    [hiccup.page :as hp]))
+    [hiccup.page :as hp]
+    [belhiccup.articles :as art]))
+
+(defn- head
+  [title]
+  [:head
+   [:title title]
+   [:meta {:charset "utf-8"}]
+   [:link
+    {:rel "stylesheet"
+     :href
+     "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap.min.css"}]
+   [:link
+    {:rel "stylesheet" :href
+     "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap-theme.min.css"}]
+   [:link
+    {:rel "stylesheet" :href
+     "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/js/bootstrap.min.js"}]])
+
+(defn- header
+  []
+  [:header
+   [:ul {:class "nav nav-pills"}
+    [:li {:role "presentation"}
+     [:a {:href "/"} "Belhiccup"]]
+    [:li {:role "presentation"}
+     [:a {:href "/articles"} "Articles"]]]])
+
+(defn- footer
+  []
+  [:div {:class "panel-footer"}
+   [:div {:class "col-md-3"}
+    [:a {:href "/contact"} "Contact Me"]]])
+
+(defn- body
+  [anything]
+  [:body {:class "container"}
+   [:div {:class "row"}
+    (header)]
+   anything
+   [:div {:class "row"}
+    (footer)]])

 (defn home
   []
+  (hp/html5 (head "Belhiccup - Home")
+            (body [:div {:class "row"}
+                   [:div {:class "jumbotron"}
+                    [:h1 "This should be a cool jumbo pictures"]]
+                   [:p "body"]])))
+
+(defn contact
+  []
   (hp/html5
-    [:head
-     [:meta {:charset "utf-8"}]
-     (hp/include-css "/css/normalize.css")
-     (hp/include-css "/css/foundation.min.css")]
-    [:body
-     [:center
-      [:h1 "Helloooow world!"]]]))
+   (head "Belhiccup - Contact")
+   (body [:div {:class "row"}
+          [:p "just call"]])))

-(defn- head
+(defn map-all-articles
   []
-  (hc/html [:head
-            [:meta {:charset "utf-8"}]
-            (hp/include-css "/css/normalize.css")
-            (hp/include-css "/css/foundation.min.css")
-            ]))
+  (for [art (art/read-article-file "articles.edn")]
+    [:li {:role "presentation"}
+     [:a {:href (str "/article/" (art :article-id))}
+      (art :title)]]))

-(defn- header
+(defn articles
   []
-  (hc/html [:header {:class "large-12"}
-            [:nav {:class "top-bar"}
-             [:ul
-              [:li {:class "name"}
-               [:h2
-                [:a {:href "/"} "Logo"]]]
-              ]
-             [:section
-              [:ul {:class "left"}
-               [:li
-                [:a {:href "/article"} "Articles"]]]
-              ]]]))
+  (hp/html5
+   (head "Belhiccup All Articles")
+   (body [:div {:class "row"}
+          [:div {:class "col-md-2"}
+           [:ul {:class "nav nav-pills nav-stacked"}
+            (map-all-articles)]]
+          [:div {:class "col-md-10"}
+           [:h3 "Some cool quotes to seize the day"]
+           [:button {:type "submit"
+                     :class "btn btn-default"}
+            "Add an article"]]])))

-(defn- asset-js
-  []
-  (hc/html (hp/include-js "/js/vendor/jquery.js")
-           (hp/include-js "/js/vendor/fastclick.js")
-           (hp/include-js "/js/foundation.min.js")
-           (hp/include-js "/js/app.js")))

-(defn- footer
-  []
-  (hc/html [:footer {:class ".two.columns"}
-            [:hr]
-            [:p
-             [:a {:href "/contact"} "Contact Us"]]
-            [:p "Copyright 2015 Beleje can be Cute as well"]]))
-
-(defn- body
-  []
-  (hc/html [:div {:class "large-12 columns"}
-            [:h1 "Aloha"]
-            [:div {:class "large-12 columns"}
-             [:h1 "My Friends' Photographs"]
-             (map cute-pic-space
-                  ["pic-title-1" "pic-title-2" "pic-title-3"]
-                  ["pic 1" "pic 2" "pic 3"])]
-            [:div {:class "large-12 columns"}
-             [:h1 "My Friends' Bank Accounts"]]]))
-
-(defn- cute-pic-space
-  [title image]
-  (hc/html
-    [:div.large-4.column
-     [:h4 title]
-     [:p image]]))
+(defn article
+  [id]
+  (let [the-article (art/show-one-article id)]
+    (println the-article)
+    (hp/html5
+     (head (str "article #" id))
+     (body [:div {:class "row"}
+            [:div {:class "col-md-2"}
+             [:ul {:class "nav nav-pills nav-stacked"}
+              (map-all-articles)]]
+            [:div {:class "col-md-10"}
+             [:h2 (str "Title: " (the-article :title))]
+             [:br]
+             [:h4 (str "Article #" (the-article :article-id))]
+             [:br]
+             [:h5 (str "Content: " (the-article :text))]
+             [:br]]]))))

-(defn home
-  [] (hp/html5 (head)
-               [:body {:class "row"}
-                (header)
-                (body)
-                (footer)
-                (asset-js)
-                ]))

-(defn contact
-  [] (hp/html5 (head)
-               [:body {:class "row"}
-                (header)
-                [:center
-                 [:p "Contact me plzzzz"]]
-                (footer)
-                (asset-js)]))
-
-(defn read-article-file
-  [filename]
-  (->> (read-string (slurp (str "resources/data/" filename)))))
-
-(defn show-all-articles
-  [id title]
-  (hc/html [:li
-            [:a {:href (str "/article/" id)}
-             title]]))
-
-(defn show-one-article
-  [id]
-  (-> (read-article-file "articles.edn")
-       (get-in [(dec (read-string id))])))
-
-(defn articles
-  []
-  (hp/html5 (head)
-            [:body {:class "row"}
-             (header)
-             [:ul
-              (->> (read-article-file "articles.edn")
-                   (map #(show-all-articles (% :article-id) (% :title)) ))]
-             (footer)
-             (asset-js)]))
-
-(defn article
-  [id]
-  (let [the-article (show-one-article id)]
-    (hp/html5 (head)
-              [:body {:class "row"}
-               (header)
-               [:div {:class "large-6 columns"}
-                [:h3  (str "Title: " (the-article :title))]
-                [:h4 (str "Number: " (the-article :article-id))]
-                [:h5 (str "Content: \n" (the-article :text))]]
-               (footer)
-               (asset-js)])))
-
-
-


(SERVER-2795) Fix CSR DELETE API

(SERVER-2795) Fix CSR DELETE API

This commit fixes a misplaced parenthesis that accidentally removed the
API for deleting a CSR.

--- src/clj/puppetlabs/services/ca/certificate_authority_core.clj
+++ src/clj/puppetlabs/services/ca/certificate_authority_core.clj
@@ -341,9 +341,9 @@
         (GET [""] [subject]
           (handle-get-certificate-request subject ca-settings))
         (PUT [""] [subject :as {body :body}]
-          (handle-put-certificate-request! subject body ca-settings)))
+          (handle-put-certificate-request! subject body ca-settings))
         (DELETE [""] [subject]
-          (handle-delete-certificate-request! subject ca-settings))
+          (handle-delete-certificate-request! subject ca-settings)))
       (GET ["/certificate_revocation_list/" :ignored-node-name] request
         (handle-get-certificate-revocation-list request ca-settings)))
     (comidi/not-found "Not Found")))


Add missing exclude on hash ns.

Add missing exclude on hash ns.

--- src/buddy/core/hash.clj
+++ src/buddy/core/hash.clj
@@ -15,7 +15,7 @@
 (ns buddy.core.hash
   "Basic crypto primitives that used for more high
   level abstractions."
-  (:refer-clojure :exclude [update])
+  (:refer-clojure :exclude [update reset!])
   (:require [buddy.core.codecs :refer :all]
             [clojure.java.io :as io])
   (:import org.bouncycastle.crypto.Digest


Revamped asplan, where we don't need a hierarchy for flat, and we assign parents before searching through vals.

--- src/exp/asplan.clj
+++ src/exp/asplan.clj
@@ -2,7 +2,8 @@
   (:require [edu.berkeley.ai.util :as util]
             [edu.berkeley.ai.util  [graphs :as graphs] ]
             [exp [env :as env]  [hierarchy :as hierarchy]
-                 [sas :as sas] [sas-analysis :as sas-analysis]]))
+                 [sas :as sas] [sas-analysis :as sas-analysis]])
+  (:import [java.util HashMap]))

 ; For now, pretend analysis is free, just brute-force it.
@@ -24,6 +25,9 @@

 ;; TODO: also look at using landmarks to structure search ?
 ; (but where's the state abstraction?)
+
+; TODO: ideally, we should avoid cyclies in the value of effect-var,
+ ; NOT in whole state-abstracted states.

 ;; NOTE: greedy should come in when we choose a parent for a var.
 ; If some parent can use current var RIGHT NOW, should assign to it, not branch.
@@ -68,21 +72,23 @@
      {(action-var evar) factored-primitive}
      reward)))

-(defn make-fire-action-action [{:keys [name precond-map effect-map reward] :as factored-primitive}]
-  (let [[evar eval] (util/safe-singleton (seq effect-map))]
-    (env/FactoredPrimitive
-     [::Fire name]
-     (into precond-map
-           (cons [(action-var evar) factored-primitive]
-                 (for [[pvar pval] (dissoc precond-map evar)]
-                   [(parent-var pvar evar) true])))
-     (into effect-map
-           (cons [(action-var evar) nil]
-                 (apply concat
+
+(comment ;; Not actually needed -- use below instead.
+  (defn make-fire-action-action [{:keys [name precond-map effect-map reward] :as factored-primitive}]
+   (let [[evar eval] (util/safe-singleton (seq effect-map))]
+     (env/FactoredPrimitive
+      [::Fire name]
+      (into precond-map
+            (cons [(action-var evar) factored-primitive]
                   (for [[pvar pval] (dissoc precond-map evar)]
-                    [[(parent-var pvar evar) false]
-                     [(free-var evar) true]]))))
-     0)))
+                    [(parent-var pvar evar) true])))
+      (into effect-map
+            (cons [(action-var evar) nil]
+                  (apply concat
+                         (for [[pvar pval] (dissoc precond-map evar)]
+                           [[(parent-var pvar evar) false]
+                            [(free-var evar) true]]))))
+      0))))

 (defn make-set-parent-var-action [p-var c-var]
   (env/FactoredPrimitive
@@ -92,249 +98,155 @@
    0))

+; Try to make an action that greedily fires the action scheduled on effect-var,
+; effectively representing a composition of set-parent and fire-action actions.
+(defn make-greedy-fire-action [s effect-var]
+  (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
+          (->> effect-var action-var (env/get-var s))
+        precond-vars (keys (dissoc precond-map effect-var))
+        [free-pv unfree-pv] (util/separate #(env/get-var s (free-var %)) precond-vars)]
+    (when (and (env/state-matches-map? s precond-map)
+               (every? #(env/get-var s (parent-var % effect-var)) unfree-pv))
+        (assert (every? #(nil? (env/get-var s (action-var %))) precond-vars))
+        (env/FactoredPrimitive
+         [::GreedyFire name]
+         (into precond-map
+               (concat [[(action-var effect-var) factored-primitive]]
+                       (for [v free-pv]   [(free-var v)              true])
+                       (for [v unfree-pv] [(parent-var v effect-var) true])))
+         (into effect-map
+               (concat [[(action-var effect-var) nil]]
+                       (for [v unfree-pv] [(free-var v)              true])
+                       (for [v unfree-pv] [(parent-var v effect-var) false])))
+         0))))
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Flat Hierarchy HLAs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Primitive Environment ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-
-; TODO: ideally, we should avoid cyclies in the value of effect-var,
- ; NOT in whole state-abstracted states.
-
-;; TODO: add a way to stop, when we reach the right var val.
-
-;; TODO: make sure top-down setup is right, e.g., we always add a target
-; action, then we can work on the precondition
-
-;; TODO: is there an invariant that whenever a var is "truly active" it
-; has an active var, or is at right val?  If so, we need to enforce this as
-; we activate a top-down var, since it'll appear dead.
-
-
-; Simplest way to express mechanics:
-;  If any action can greedily fire,
-;    fire it.
-;  Else, if any vars without actions but with explicit child with action and wrong value,
-;    add a directed action.
-;  Else, if any vars without actions or explicit children but have child with action,
-;    activate precondition
-;  Else, if any var without action but with explicit parent,
-;    add an undirected action.
-
-;  Schematics:
-;  a => A  goes to  A => A  or a -> a
-;  a -> A  goes to  a => A
-;  a => a  goes to  a => A
-;  A => a  is not allowed ?
-
-
-
-(defn current-child [hierarchy s p-var]
-  (some #(env/get-var s (parent-var p-var %))
-        (util/safe-get-in hierarchy [:child-var-map p-var])))
-
-(defn possible-next-actions-to [hierarchy var c-val d-val]
-  (apply concat
-    (map (util/safe-get-in hierarchy [:dtgs var c-val])
-         ((:acyclic-edges-fn hierarchy) var c-val d-val))))
-
-(defn possible-next-actions [hierarchy var c-val]
-  (apply concat (vals (util/safe-get-in hierarchy [:dtgs var c-val]))))
-
-; Add any applicable action, using the target val if available.
-; If not, goal is to ease deadlock by using a parent.
-; TODO: use parent commitments to decide where to head ?
-
-; Ideally, we stop as soon as we've used up at least one parent.
-; One idea is just to stop after each action.
-; This means we must take care when doing top-down; activation may
-; not be required.
-(comment
-(deftype AddSomeActionHLA [hierarchy effect-var]
-  env/Action
-   (action-name [] [::AddSomeAction effect-var])
-   (primitive?  [] false)
-  env/ContextualAction
-   (precondition-context [s]
-     (let [cc (util/make-safe (current-child hierarchy s effect-var))]
-       #{effect-var (parent-var effect-var cc) (action-var cc)}))
-  hierarchy/HighLevelAction
-   (immediate-refinements- [s]
-     (assert (not (env/get-var s (action-var effect-var))))
-     (let [cc    (util/make-safe (current-child hierarchy s effect-var))
-           c-val (env/get-var s effect-var)]
-       (if-let [ca (env/get-var s (action-var cc))] ;; driven bottom-up?
-         (let [d-val (util/safe-get-in ca :precond-map effect-var)]
-           (if (= c-val d-val)
-               [[]])
-             (for [a (possible-next-action-to hierarchy effect-var c-val d-val)]
-               [(make-add-action-action a)]))
-         (for [a (possible-next-action hierarchy effect-var c-val)]
-           [(make-add-action-action a)]))))
-   (cycle-level-           [s] nil))
- ;)
-
-; Choose a parent for a var; assumes any greedy vars have already
-; fired, so all parents are allowed.  Prereq for adding actions on a var.
-(deftype ActivateVarHLA [hierarchy effect-var]
-  env/Action
-   (action-name [] [::ActivateVar effect-var])
-   (primitive?  [] false)
-  env/ContextualAction
-   (precondition-context [s] #{})
-  hierarchy/HighLevelAction
-   (immediate-refinements- [s]
-     (assert (env/get-var s (free-var effect-var)))
-     (let [asa (AddSomeActionHLA hierarchy effect-var)]
-      (for [c (util/safe-get-in hierarchy [:child-var-map effect-var])]
-        [(make-set-parent-var-action effect-var c) asa])))
-   (cycle-level-           [s] nil))
-
-
-;; TODO: assert is wrong.?
-
-(defn make-greedy-fire-plan
-  "Return an HLA to greedily fire, or nil if cannot greedily fire."
-  [hierarchy s effect-var]
-  (let [a            (->> effect-var action-var (env/get-var s))
-        _            (assert a)
-        pm           (:precond-map a)
-        precond-vars (keys (dissoc pm effect-var))
-        [free-pv unfree-pv] (util/separate #(env/get-var s (free-var %)) precond-vars)]
-    (when (and (env/state-matches-map? s pm)
-               (every? #(env/get-var s (parent-var % effect-var)) unfree-pv))
-      (assert (every? #(nil? (env/get-var s (action-var %))) precond-vars))
-      (let [fire (make-fire-action-action a)]
-        [(hierarchy/SimpleHLA [::GreedyFire ]
-          (env/precondition-context fire s)
-          [(conj (vec (for [p free-pv] (make-set-parent-var-action p effect-var)))
-                 fire
-                 (AddSomeActionHLA hierarchy effect-var))])]))))
-
-(defn make-a-greedy-fire-plan [hierarchy s]
-  (some #(make-greedy-fire-plan hierarchy s %)
-        (filter #(env/get-var s (action-var %))
-                (util/safe-get hierarchy :vars))))
-
-
-(defn bottom-up-supported-vars [hierarchy s]
-  (mapcat (fn [v]
-            (when-let [a (env/get-var s (action-var v))]
-              (for [[var val] (:precond-map a)
-                    :when (not (= (env/get-var s var) val))]
-                var)))
-          (util/safe-get hierarchy :vars)))
-
-(defn top-down-supported-vars [hierarchy s]
-  (for [vp (util/safe-get hierarchy :vars)
-        vc (util/safe-get-in hierarchy [:child-var-map vp])
-        :when (env/get-var s (parent-var vp vc))]
-    vc))
-
-(defn choose-open-var
-  "Choose a var to start changing.  Var must be open, i.e. parent-var and action-var both nil.
-   Var should be supported, either
-     -from below by open precondition of action on potential parent-var, or
-     -from above by parent-var link to this var."
-  [hierarchy s]
-  (first (filter #(env/get-var s (free-var %))
-                 (concat (bottom-up-supported-vars hierarchy s)
-                         (top-down-supported-vars hierarchy s)))))
-
-(deftype FlatASPlanHLA [hierarchy name pc] :as this
-  env/Action
-   (action-name [] name)
-   (primitive?  [] false)
-  env/ContextualAction
-   (precondition-context [s] pc)
-  hierarchy/HighLevelAction
-   (immediate-refinements- [s]
-     (if-let [g (make-a-greedy-fire-plan hierarchy s)] [(conj (vec g) this)]
-      (if-let [v (choose-open-var hierarchy s)] [[(ActivateVarHLA hierarchy v) this]]
-        [[]])))
-   (cycle-level-           [s] nil))
-
-(defn make-flat-asplan-hla [hierarchy full-context]
-  (FlatASPlanHLA hierarchy [::FlatASPlan] full-context))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;; Flat Hierarchy precomputations ;;;;;;;;;;;;;;;;;;;;;;;
-
-;; TODO: cutoff when top-down and bottom-up meet, don't match ?
-
-;; TODO: note, should be able to use acylic dtgs for, e.g., single parent.
-
-;; TODO: Take advantage of "greedy-chain" condition, don't assign
-;   val to parent too high up the chain too early.
-
-;; Memoized partial computations to speed up acylic edge generation.
-(def #^HashMap *forward-reachability-cache* nil)
-(def #^HashMap *backward-reachability-cache* nil)
-
-(defn forward-reachable-nodes-and-preds [#^HashMap cache simple-dtgs var-name from-val]
-  (util/cache-with cache [:forward var-name from-val]
-    (graphs/compute-reachable-nodes-and-necessary-predecessors
-     (util/safe-get simple-dtgs var-name) from-val)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn backward-reachable-nodes-and-preds [#^HashMap cache simple-dtgs var-name to-val]
   (util/cache-with cache [:backward var-name to-val]
     (graphs/compute-reachable-nodes-and-necessary-predecessors
      (map reverse (util/safe-get simple-dtgs var-name)) to-val)))

-(defn get-possibly-acyclic-edges
-  "Return a list of edges, where those provably on no acyclic s-t path have been eliminated.
-   Do so in polynomial time, possibly missing some always-cyclic edges."
-  [cache simple-dtgs var from-val to-val]
-  (let [forward-sets  (forward-reachable-nodes-and-preds cache simple-dtgs var from-val)
-        backward-sets (backward-reachable-nodes-and-preds cache simple-dtgs var to-val)]
-    (filter
-     (fn [[a b]]
-       (let [f (forward-sets a)
-             b (backward-sets b)]
-         (and f b (empty? (clojure.set/intersection f b)))))
-     (util/safe-get simple-dtgs var))))
-
-
-(defn get-child-var-map [sas-problem]
-  (let [causal-graph (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))]
-    (assert (graphs/dag? causal-graph))
-    (util/map-vals #(map second %) (util/group-by first causal-graph))))
-
-; Cannot be used iwth safe-get...
-;(deftype ASPlanFlatHierarchy [sas-problem vars dtgs child-var-map possible-next-map])
-
-(defn make-asplan-env [sas-problem child-var-map dtgs]
-  (reify env/Env
-   (initial-state []
-     (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs)))
-   (actions-fn    [] :no-actions-fn)
-   (goal-fn       [] (env/goal-fn sas-problem))))
-
-(defn make-asplan-flat-henv [sas-problem]
-  (let [child-var-map (get-child-var-map sas-problem)
+(defn possibly-acyclic-successors
+  "Return a list of successors of cur-val, which can potentially lead to dst-val
+   without a cycle."
+  [cache simple-dtgs var cur-val dst-val]
+  (let [backward-sets (backward-reachable-nodes-and-preds cache simple-dtgs var dst-val)]
+    (for [[s t] (util/safe-get simple-dtgs var)
+          :when (and (= s cur-val) (not (contains? (backward-sets t) s)))]
+      t)))
+
+; TODO: take reduced arcs into account, etc.
+(defn activation-actions
+  "Return a list of activation actions for var v, ideally which are supported by
+   current state; i.e., should take reduced arcs into account, etc. "
+  [s child-map v]
+  (for [c (util/safe-get child-map v)]
+    (make-set-parent-var-action v c)))
+
+(defn current-child [s child-var-map p-var]
+  (when-not (env/get-var s (free-var p-var))
+    (some #(env/get-var s (parent-var p-var %))
+          (child-var-map p-var))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions fn, actual env ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Simplest way to express mechanics (in order of preference):
+
+;  Schematics:
+;  a* => A   goes to a* -> a   (greedy fire)
+;  a => A    goes to  A => A   (bottom-up action)
+;  a -> A    goes to  a => A   (bottom-up activate)
+;  a => a => goes to => A =>   (top-down action)
+;  a => a -> goes to a => a => (top-down activate)
+
+; Ideally, should prefer top-most top-down, bottom-most bottom-up, or something...
+
+
+;; We make this a real type to make accessing precomputed stuff easier...
+(deftype ASPlanEnv [init actions-fn g-map]
+  env/Env
+    (initial-state [] init)
+    (actions-fn    [] actions-fn)
+    (goal-fn       [] #(when (env/state-matches-map? % g-map) (env/solution-and-reward %)))
+  env/FactoredEnv
+    (goal-map      [] g-map))
+
+(defn make-asplan-env [sas-problem]
+  (let [causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
+        child-var-map (util/map-vals #(map second %) (util/group-by first causal-graph))
+        vars          (keys (:vars sas-problem))
         dtgs          (sas-analysis/domain-transition-graphs sas-problem)
         simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
-        reach-cache   (HashMap.)
-        env           (make-asplan-env sas-problem child-var-map dtgs)]
-    (hierarchy/SimpleHierarchicalEnv
-     env
-     [(make-flat-asplan-hla
-       {:type ASPlanFlatHierarchy
-        :sas-problem      sas-problem
-        :vars             (keys (:vars sas-problem))
-        :dtgs             dtgs
-        :child-var-map    child-var-map
-        :acyclic-edges-fn (partial get-possibly-acylic-edges cache simple-dtgs)}
-       (env/current-context (env/initial-state env)))])))
+        acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
+    (assert (graphs/dag? causal-graph))
+    (ASPlanEnv
+     (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
+     (fn asplan-actions [s]
+       (let [[aa-vars na-vars] (split-with #(env/get-var s (action-var %)) vars)
+             aa-parent-edges   (for [av aa-vars
+                                      :let [pm (:precond-map (env/get-var s (action-var av)))]
+                                      pv    (remove #{av} (keys pm))
+                                      :when (and (not (env/get-var s (action-var pv)))
+                                                 (not (= (pm pv) (env/get-var s pv))))]
+                                  [pv av])
+             na-tuples         (for [nav na-vars
+                                     :let  [child (current-child s child-var-map nav)]
+                                     :when (and child (not (env/get-var s (action-var child))))]
+                                 [nav child])]
+        (util/cond-let [x]
+          ;; Greedy action -- all preconditions satisfied and not assigned elsewhere
+          (some #(make-greedy-fire-action s %) aa-vars)
+            [x]
+
+          ;; Active bottom-up var -- assigned, needs its value changed.
+          (util/find-first (fn [[pv cv]] (env/get-var s (parent-var pv cv))) aa-parent-edges)
+            (let [[pv cv] x,
+                  p-val (env/get-var s pv)
+                  d-val (util/safe-get-in (env/get-var s (action-var cv)) [:precond-map pv])]
+              (apply concat (map (get-in dtgs [pv p-val]) (acyclic-succ-fn pv p-val d-val))))
+
+          ;; Inactive bottom-up var -- needs to be assigned.
+          (first aa-parent-edges)
+            (activation-actions s child-var-map (first x))
+
+          ;; Active top-down var -- add actions
+          (util/find-first #(not (env/get-var s (free-var %))) (map second na-tuples))
+            (apply concat (vals (util/safe-get-in dtgs [x (env/get-var s x)])))
+
+          ;; Inactive top-down var -- activate it
+          (first (map second na-tuples))
+            (activation-actions s child-var-map x))))
+     (env/goal-map sas-problem))))

 (defn asplan-solution-name [sol]
-  (map second (filter #(= (first %) ::Fire) (map env/action-name sol))))
+  (map second (filter #(= (first %) ::GreedyFire) (map env/action-name sol))))

 (defn asplan-solution-pair-name [[sol rew]]
   [(asplan-solution-name sol) rew])

+
+
+;; TODO: cutoff when top-down and bottom-up meet, don't match ?
+
+;; TODO: Take advantage of "greedy-chain" condition, don't assign
+
+
 ; (use '[exp env hierarchy taxi-infinite ucs asplan hierarchical-incremental-search] 'edu.berkeley.ai.util)
 ; (let [e (make-random-infinite-taxi-sas2 1 2 1 2)] (println (run-counted #(uniform-cost-search e))) (println (run-counted #(asplan-solution-pair-name (debug 0 (sahucs-fast-flat (make-asplan-henv e )))))))

+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; First attempt: "Skip" hierarchy ;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; OK, now we need a hierarchy.    Problems:
@@ -390,9 +302,7 @@
 ; What you lose: always have to fully explore var, if it has multiple parents.

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;; First attempt: "Skip" hierarchy ;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+

 ;; TODO: deal with parents that are not relevant.  (i.e., propagate next-sets).


Document defconsts

Document defconsts

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -53,6 +53,9 @@
 (assert (#{0 1} (.sodium_init sodium)))

 (defmacro defconsts
+  "Given constant names (syms) in the C pseudo-namespace corresponding
+  to the current namespace, call the corresponding libsodium function
+  the get the constants and assign them to vars."
   [consts]
   (let [prefix (-> *ns* ns-name str (s/split #"\.") rest vec)]
     `(do


white listing gce and digital ocean

white listing gce and digital ocean

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

 (def whitelist
   [[:proxmox :nodes] [:proxmox :ostemplates]
-   [:docker :nodes]
+   [:docker :nodes] [:gce :ostemplates] [:digital-ocean]
    [:vcenter :ostemplates] [:aws] [:physical] [:openstack]])

 (defn sanitized-envs


Fixes #464 - flow conditions :flow/from -> :all didn't compile properly.

--- src/onyx/peer/task_compile.clj
+++ src/onyx/peer/task_compile.clj
@@ -10,7 +10,7 @@
             [clj-tuple :as t]))

 (defn only-relevant-branches [flow task]
-  (filter #(or (= (:flow/from %) task) (= :all %)) flow))
+  (filter #(or (= (:flow/from %) task) (= :all (:flow/from %))) flow))

 (defn compile-flow-conditions [flow-conditions task-name f]
   (let [conditions (filter f (only-relevant-branches flow-conditions task-name))]


Jonathan/Brydon mis-named main

Jonathan/Brydon mis-named main

--- src/checkin/handler.clj
+++ src/checkin/handler.clj
@@ -46,5 +46,5 @@
         log-request
         (auth/authentication-middleware))))

-(defn main- [& args]
+(defn -main [& args]
   (run-jetty app {:port 3000}))


Update story extraction to specify types to extract as literals.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -75,8 +75,8 @@
         env (assoc raw-env :ctx (name-into-objs (:ctx raw-env)))
         ctx (interpreter/resolve- (:ctx env) env)

-        rooms (extract-by-class ctx (:type (get types "room")))
-        player (val (first (extract-by-class ctx (:type (get types "_player")))))]
+        rooms (extract-by-class ctx isla.story.Room)
+        player (val (first (extract-by-class ctx isla.story.Player)))]
     (Story. player rooms)))

 (defn run-command [story command-str]


Add Recording Type Import of Form Defs

Add Recording Type Import of Form Defs

--- src/lens/parse.clj
+++ src/lens/parse.clj
@@ -25,7 +25,7 @@
   (fn [loc] (xml1-> loc :TranslatedText text-with-line-breaks)))

 (defn- desc [loc]
-  (str/trim (xml1-> loc :Description (first-translated-text))))
+  (some-> (xml1-> loc :Description (first-translated-text)) str/trim))

 (defn- question [loc]
   (xml1-> loc :Question (first-translated-text)))
@@ -33,6 +33,9 @@
 (defn- keywords [loc]
   (let [kws (set (map str/trim (xml-> loc :Keyword text)))]
     (when (seq kws) kws)))
+
+(defn- recording-type [loc]
+  (some-> (xml1-> loc :Recording-Type text) str/trim))

 ;; ---- Form Ref --------------------------------------------------------------

@@ -76,7 +79,8 @@
        :id (oid form-def)
        :name (xml1-> form-def (attr :Name))}
       (assoc-when :desc (desc form-def))
-      (assoc-when :keywords (keywords form-def))))
+      (assoc-when :keywords (keywords form-def))
+      (assoc-when :recording-type (recording-type form-def))))

 (defn parse-form-def! [ch form-def]
   (>!! ch (parse-form-def-head form-def))


add date

add date

--- src/clj/jsconf/core.clj
+++ src/clj/jsconf/core.clj
@@ -72,6 +72,7 @@
                  (swap! state assoc-in [:connected] (get new-state "dev"))))

     (swap! state assoc-in [:connected] (-> figwheel-system get-connections (get "dev")))
+    (swap! state assoc-in [:dt] (java.util.Date.))

     this)
   (stop [{:keys [state-server] :as this}]


CLJS-673: support *print-level*

CLJS-673: support *print-level*

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -35,6 +35,7 @@
 (def ^:dynamic *print-meta* false)
 (def ^:dynamic *print-dup* false)
 (def ^:dynamic *print-length* nil)
+(def ^:dynamic *print-level* nil)

 (defn- pr-opts []
   {:flush-on-newline *flush-on-newline*
@@ -6627,18 +6628,22 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing ;;;;;;;;;;;;;;;;

 (defn pr-sequential-writer [writer print-one begin sep end opts coll]
-  (-write writer begin)
-  (when (seq coll)
-    (print-one (first coll) writer opts))
-  (loop [coll (next coll) n (:print-length opts)]
-    (when (and coll (or (nil? n) (not (zero? n))))
-      (-write writer sep)
-      (print-one (first coll) writer opts)
-      (recur (next coll) (dec n))))
-  (when (:print-length opts)
-    (-write writer sep)
-    (print-one "..." writer opts))
-  (-write writer end))
+  (binding [*print-level* (when-not (nil? *print-level*) (dec *print-level*))]
+    (if (and (not (nil? *print-level*)) (neg? *print-level*))
+      (-write writer "#")
+      (do
+        (-write writer begin)
+        (when (seq coll)
+          (print-one (first coll) writer opts))
+        (loop [coll (next coll) n (:print-length opts)]
+          (when (and coll (or (nil? n) (not (zero? n))))
+            (-write writer sep)
+            (print-one (first coll) writer opts)
+            (recur (next coll) (dec n))))
+        (when (:print-length opts)
+          (-write writer sep)
+          (print-one "..." writer opts))
+        (-write writer end)))))

 (defn write-all [writer & ss]
   (doseq [s ss]
@@ -6822,6 +6827,16 @@
   (when *print-newline*
     (newline (pr-opts))))

+(defn print-map [m print-one writer opts]
+  (pr-sequential-writer
+    writer
+    (fn [e w opts]
+      (do (print-one (key e) w opts)
+          (-write w \space)
+          (print-one (val e) w opts)))
+    "{" ", " "}"
+    opts (seq m)))
+
 (extend-protocol IPrintWithWriter
   LazySeq
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
@@ -6873,8 +6888,7 @@

   ObjMap
   (-pr-writer [coll writer opts]
-    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
-      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+    (print-map coll pr-writer writer opts))

   KeySeq
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
@@ -6887,18 +6901,15 @@

   PersistentArrayMap
   (-pr-writer [coll writer opts]
-    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
-      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+    (print-map coll pr-writer writer opts))

   PersistentHashMap
   (-pr-writer [coll writer opts]
-    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
-      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+    (print-map coll pr-writer writer opts))

   PersistentTreeMap
   (-pr-writer [coll writer opts]
-    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
-      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+    (print-map coll pr-writer writer opts))

   PersistentHashSet
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll))


* src/cljs/cljs/core.cljs: Cons is not ICounted

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1418,14 +1418,7 @@
   (-hash [coll] (caching-hash coll hash-coll __hash))

   ISeqable
-  (-seq [coll] coll)
-
-  ICounted
-  (-count [coll]
-    (loop [s (seq coll) n 0]
-      (if s
-        (recur (next s) (inc n))
-        n))))
+  (-seq [coll] coll))

 (defn cons
   "Returns a new seq where x is the first element and seq is the rest."


* src/cljs/jiyi/core.cljs: Got rid of one stupid useless div and changed   height a little

--- src/cljs/jiyi/core.cljs
+++ src/cljs/jiyi/core.cljs
@@ -162,7 +162,7 @@

 (defn RCard [user]
   (let [revealed? (atom false)
-        reveal-div-pos (anim/interpolate-if revealed? -300 60)]
+        reveal-div-pos (anim/interpolate-if revealed? -300 70)]
     (fn [user]
       (let [{:keys [id photo name title dept]} user]
         [:div {:class "z-depth-2"
@@ -178,16 +178,11 @@
           (when @revealed?
             [:div.row {:style {:margin-bottom 0}}
              [:div  {:style {:position :absolute
-                             :bottom @reveal-div-pos
-                             :background :white
-                             :width 520
-                             :height 220
-                             :opacity 0.6}}]
-
-             [:div  {:style {:position :absolute
-                             :bottom @reveal-div-pos
-                             :width 520
-                             :height 220}}
+                             :bottom @reveal-div-pos
+                             :background-color "rgba(255,255,255,0.6)"
+                             :width 510
+                             :height 250
+                             :padding-bottom 10}}
               [:p
                [:h1 name]
                [:h5 title]
@@ -292,9 +287,6 @@
         search-results (atom [])
         search-channel (chan)
         <search-user-delayed (debounce search-channel 300)]
-    #_(add-watch search-results :search-results
-                 (fn  [k r o n]
-                   (prn k n)))
     (go-loop []
       (let [keyword (<! <search-user-delayed)
             result (<! (<search-user keyword))]


Fixed import style on nanomsg module.

Fixed import style on nanomsg module.

--- src/clojure/nanomsg.clj
+++ src/clojure/nanomsg.clj
@@ -12,13 +12,21 @@
   If you want send your more complex data types, create
   a new pair of send/recv functions that serializes and
   deserializers data before send and after receive."
-  (:import (nanomsg.pubsub PubSocket SubSocket)
-           (nanomsg.reqrep ReqSocket RepSocket)
-           (nanomsg.pipeline PushSocket PullSocket)
-           (nanomsg.pair PairSocket)
-           (nanomsg.bus BusSocket)
-           (nanomsg ISocket Socket Nanomsg Device)
-           (nanomsg.async IAsyncCallback AsyncSocket))
+  (:import nanomsg.pubsub.PubSocket
+           nanomsg.pubsub.SubSocket
+           nanomsg.reqrep.ReqSocket
+           nanomsg.reqrep.RepSocket
+           nanomsg.pipeline.PushSocket
+           nanomsg.pipeline.PullSocket
+           nanomsg.pair.PairSocket
+           nanomsg.bus.BusSocket
+           nanomsg.Socket
+           nanomsg.Nanomsg
+           nanomsg.Device
+           nanomsg.async.IAsyncCallback
+           nanomsg.async.AsyncSocket
+           clojure.lang.Keyword
+           clojure.lang.IFn)
   (:require [clojure.core.async :refer [chan put!]]))

 (def ^:static ^:private supported-sockets


Added tcp client test code to scratch.

Added tcp client test code to scratch.


used load-file instead of hand-written read-file

--- src/mapfs/core.clj
+++ src/mapfs/core.clj
@@ -292,22 +292,13 @@
     (slurp f)
     ))

-(defn read-file
-  "Sources in a file by reading/evaluating it as clojure code."
-  [filename]
-  (let [pbr (java.io.PushbackReader. (java.io.StringReader. (slurp filename)))]
-    (loop [o (read pbr false nil)]
-      (when o
-        (eval o)
-        (recur (read pbr false nil))))))
-
 (defn- read-mapfsrc []
   "Initialize mapfs with ~/.mapfsrc if it exists"
   (let [rcfilename (str (System/getProperty "user.home") java.io.File/separator ".mapfsrc")
         f (java.io.File. rcfilename) ]
     (when (.exists f)
       (println "evaluating .mapfsrc: " rcfilename)
-      (read-file rcfilename))))
+      (load-file rcfilename))))

 (defn- mprint [s]
   (if (string? s)


Print message on likely error.

Print message on likely error.

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -456,7 +456,11 @@
     (let [option ((parsing/make-option-arglist-parser [:dirs :dir] [:interval :each]
                                                       [:stop :pause] [:resume])
                   args)]
-      (cond (:stop? option)
+
+      (cond (not (empty? (:true-args option)))
+            (println (color/fail "Did you mean to put the arguments after `:dirs`?"))
+
+            (:stop? option)
             (scheduling/stop :autotest)

             (:resume? option)


add install native task

add install native task


separate bodies from houses into thair own map keys so they'll be easier to handle later

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -16,20 +16,21 @@
         jd (utc-to-jd (:utc want))
         flag (. SweConst SEFLG_SPEED)]
     (merge
-      (into {}
-        (for [i (flatten [(:bodies want)])]
-          (let [what (if (known? i) (lookup i) i)
-                res (double-array 6)
-                err (StringBuffer.)
-                rc (.swe_calc_ut sw
-                                 jd
-                                 what
-                                 flag
-                                 res
-                                 err)]
-            {(lookup what) {:lon (aget res 0)
-                            :lat (aget res 1)
-                            :sdd (aget res 3)}})))
+      {:bodies
+        (into {}
+          (for [i (flatten [(:bodies want)])]
+            (let [what (if (known? i) (lookup i) i)
+                  res (double-array 6)
+                  err (StringBuffer.)
+                  rc (.swe_calc_ut sw
+                                   jd
+                                   what
+                                   flag
+                                   res
+                                   err)]
+              {(lookup what) {:lon (aget res 0)
+                              :lat (aget res 1)
+                              :sdd (aget res 3)}})))}
       (if (not (empty? (:angles want)))
         (let [cusps (double-array 13)
               ascmc (double-array 10)
@@ -41,4 +42,4 @@
                               (int (:houses want))
                               cusps
                               ascmc)]
-          (zipmap (range 1 13) (rest cusps)))))))
+          {:houses (zipmap (range 1 13) (rest cusps))})))))


Removed code comment.

Removed code comment.

--- src/cmr/opendap/errors.clj
+++ src/cmr/opendap/errors.clj
@@ -92,8 +92,6 @@
   (remove nil? (map (fn [[check-fn value msg]] (when (check-fn value) msg))
                     msgs)))

-;; XXX Add universal function for checking HTTP status code
-
 (defn get-errors
   [data]
   (or (:errors data)