increase request endorsement link size

increase request endorsement link size

--- src/cljs/salava/badge/ui/social.cljs
+++ src/cljs/salava/badge/ui/social.cljs
@@ -133,7 +133,7 @@
             [:div.row.panel-title {:id "endorsebadge" :style {:margin-bottom "auto" :margin-top "10px"}}
              [:div.col-md-12.request-link [:a {:href "#"
                                                :on-click #(mo/open-modal [:badge :requestendorsement] {:state state :reload-fn (do (toggle-panel panel-identity visible-area-atom) (fn [] (get-pending-requests dataatom state)))})}
-                                           [:span [:i {:class (str "fa fa-fw " hand-icon)}] (t :badge/Requestendorsement)]]]]]
+                                           [:span {:style {:font-size "14.5px" :font-weight "600"}} [:i {:class (str "fa fa-fw " hand-icon)}] (t :badge/Requestendorsement)]]]]]
            (when (= @(cursor state [:visible-area]) panel-identity)
              [:div.panel-body.endorsements
               #_[:div.col-md-12.request-link {:id "endorsebadge"} [:a {:href "#"


Doubled max points

Doubled max points

--- src/clojush/problems/software/wc.clj
+++ src/clojush/problems/software/wc.clj
@@ -334,7 +334,7 @@
 (def argmap
   {:error-function (wc-error-function wc-data-domains)
    :atom-generators wc-atom-generators
-   :max-points 2000
+   :max-points 4000
    :max-genome-size-in-initial-program 400
    :evalpush-limit 2000
    :population-size 1000


working on a choose-n algorithm

working on a choose-n algorithm

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -592,4 +592,30 @@
                                               :subcat '()}}))))]
     (is (= 50 (count (take 50 (repeatedly to-run)))))))

-
+(defn over-vals [key vals]
+  (map (fn [val]
+         {key val})
+       vals))
+
+
+(def as [{:a 1}{:a 2}])
+(def bs [{:b 4}{:b 5}])
+(def cs [{:c 6}{:c 7}{:c 8}])
+
+(defn foo [n]
+  (take n
+        (->> as
+             (mapcat (fn [a]
+                       (->> bs
+                            (mapcat (fn [b]
+                                      (->> cs
+                                           (map (fn [c]
+                                                  (->> c
+                                                       (reduce merge b)
+                                                       (reduce merge a)))))))))))))
+
+
+
+
+
+


support file and dir as destination in cake.file/cp

--- src/cake/file.clj
+++ src/cake/file.clj
@@ -62,7 +62,9 @@

 (defn cp [from to & opts]
   (ant Copy
-    (into-map opts :file from :tofile to)))
+    (into-map opts :file from
+              (if (directory? to)
+                :todir, :tofile) to)))

 (defn mv [from to & opts]
   (ant Move


500 on exception

500 on exception

--- src/caws/core.clj
+++ src/caws/core.clj
@@ -203,8 +203,15 @@
                                          *in-channel in-chan
                                          *path path
                                          *response-code nil]
-                                 (next)))
-                              ))
+                                 (try
+                                  (next)
+                                  (catch Exception e
+                                    (>! out-chan 500)
+                                    (>! out-chan :body)
+                                    (>! out-chan (str e))
+                                    (>! out-chan :end))
+                                  ))))
+                            )
                           (recur (rest prefixes))
                           )
                         ))))]


Test that shows failing behavior for external mutations.

--- clojure/grade-school/grade_school_test.clj
+++ clojure/grade-school/grade_school_test.clj
@@ -41,5 +41,12 @@
              (school/add "Kyle" 3)
              (school/sorted)))))

+(deftest add-students-avoids-external-mutation
+  (is (= {3 ["Chelsea"] 7 ["Logan"]}
+         (-> db
+             (assoc 2 ["John"])
+             (school/add "Chelsea" 3)
+             (assoc 4 ["Judie"])
+             (school/add "Logan" 7)))))
+
 (run-tests)
-


fix filename cljsdoc error

fix filename cljsdoc error

--- src/main/cljs_api_gen/cljsdoc/validate.clj
+++ src/main/cljs_api_gen/cljsdoc/validate.clj
@@ -243,13 +243,13 @@
   "All error detectors, each producing error messages if problem found."
   [(make-multi-version required-sections-error-msg)
    (make-multi-version unrecognized-sections-error-msg)
-   (make-multi-version filename-error-msg)
    (make-multi-version signatures-error-msg)
    (make-multi-version type-error-msg)
    (make-multi-version examples-error-msg!)
    (make-multi-version symbol-unknown-error-msg)
    (make-multi-version related-missing-error-msg)
    ;; (make-multi-version duplicate-sections-error-msg)
+   filename-error-msg
    unrecognized-versions-error-msg
    ])


finish updating existing tests to use new db fns

--- test/navigator_test.clj
+++ test/navigator_test.clj
@@ -33,20 +33,22 @@
                               :comp/status :comp.status/active
                               :comp/id-sk "jeep"})))))

-#_
 (deftest update-comps
-  (is (n-tl/ensure-tx (navigator/create-competency
+  (is (n-tl/ensure-tx (navigator/tx-entity
                        (:db-conn nt-config/system)
-                       "can I update?"
-                       "v1"
-                       :comp.status/active
-                       :comp/id-sk "yeep")))
-  (is (n-tl/ensure-tx (navigator/update-competency
+                       {:db/id (d/tempid :db.part/user)
+                        :comp/name "can I update?"
+                        :comp/version "v1"
+                        :comp/status :comp.status/active
+                        :comp/id-sk "yeep"}
+                       :comp)))
+  (is (n-tl/ensure-tx (navigator/tx-update-entity
                        (:db-conn nt-config/system)
                        {:comp/name "can I update?"
                         :comp/version "v1"
                         :comp/status :comp.status/active
-                        :db/id [:comp/id-sk "yeep"]}))))
+                        :db/id [:comp/id-sk "yeep"]}
+                       :comp))))

 (comment
   (map #(keys (deref %))


Improve error messages on recorded notification

Fixes #26

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -111,27 +111,28 @@
                 ;; periodical_number will be wrong
                 (dissoc :production_type :periodical_number))
             production (prod/find-by-productnumber product_number)]
-        (cond
-          (empty? production)
-          [(format "Non-existing product number %s" product_number)]
-          (not= "structured" (:state production))
-          [(format "Production %s is not structured (%s instead)"
-                   product_number (:state production))]
-          (not (prod/manifest? production))
-          [(format "Production %s has no DAISY Export in %s"
-                   product_number (path/manifest-path production))]
-          :else
-          ;; check if the exported production is even valid
-          ;; for validation purposes pretend there is only one volume. At
-          ;; this stage the number of volumes just indicates that there
-          ;; should be a split into that many volumes. The volumes aren't
-          ;; actually there yet
-          (let [errors (prod/manifest-validate (assoc production :volumes 1))]
-            (if (seq errors)
-              errors
-              (-> production
-                  (merge new-production)
-                  prod/set-state-recorded!))))))))
+        (let [{:keys [id state]} production]
+          (cond
+            (empty? production)
+            [(format "Non-existing product number %s" product_number)]
+            (not= "structured" state)
+            [(format "Production %s (%s) is not structured (%s instead)"
+                     id product_number state)]
+            (not (prod/manifest? production))
+            [(format "Production %s (%s) has no DAISY Export in %s"
+                     id product_number (path/manifest-path production))]
+            :else
+            ;; check if the exported production is even valid
+            ;; for validation purposes pretend there is only one volume. At
+            ;; this stage the number of volumes just indicates that there
+            ;; should be a split into that many volumes. The volumes aren't
+            ;; actually there yet
+            (let [errors (prod/manifest-validate (assoc production :volumes 1))]
+              (if (seq errors)
+                errors
+                (-> production
+                    (merge new-production)
+                    prod/set-state-recorded!)))))))))

 (defn import-status-request
   "Import a status request from file `f`"


logging seed at the beginning

logging seed at the beginning

--- src/flax/core.clj
+++ src/flax/core.clj
@@ -439,9 +439,11 @@
       (if-not dc-ctor
         ;; we can't proceed without any way of resolving the location of the program
         (die (format "Constructor for data connector `%s` not found" (-> config :data-connector)))
-        (let [effective (java.util.Date.
-                          (or (:effective config)
-                              (-> (java.util.Date.) .getTime)))
+        (let [effective (let [effective (java.util.Date.
+                                          (or (:effective config)
+                                              (-> (java.util.Date.) .getTime)))]
+                          (log logger :info (str "Seed: " (.getTime effective)))
+                          effective)
               return (run-program (assoc config ;; This timestamp is also intended to be used (via .getTime)
                                                 ;; as a seed for any pseudorandom number generation, so that
                                                 ;; randomized testing can be retested as deterministically


s/error/info/

s/error/info/

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -190,7 +190,7 @@
                    10
                    (repeatedly #(let [foo (generate {:synsem {:sem {:pred :be-called}}})]
                                   (is (not (= "" (fo foo))))
-                                  (log/error (str "fo: " (fo foo)))
+                                  (log/info (str "fo: " (fo foo)))
                                   (fo foo)))))))))


+(deftest no-failed-bolts)

+(deftest no-failed-bolts)

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -177,3 +177,23 @@
                                   :pred :cane}}})]
     (is (not (nil? result)))
     (is (= "Juana's red dog" (fo result)))))
+
+(deftest no-failed-bolts
+  (let [result
+        (->>
+         (repeatedly #(println
+                       (let [generated
+                             (generate
+                              {:comp {:synsem {:pronoun true}}
+                               :modified false
+                               :synsem {:sem {:pred :wash
+                                              :mod nil
+                                              :reflexive true}}}
+                              :model medium)]
+                         {:f (fo generated :from-language "it")
+                          :sem (get-in generated [:synsem :sem :mod])})))
+         (take 5))]
+    (= (count result) 5)))
+
+
+


add test for "gestiscono" (boot stem 3rd person plural)

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -272,6 +272,16 @@
   (is (not (empty?
             (:parses (first (parse "io sono a casa")))))))

+
+(deftest gestiscono
+  (let [result
+        (take 5 (repeatedly #(generate {:synsem {:sem {:subj {:pred :loro} :pred :manage  :tense :present}}})))]
+    (count (map (fn [each]
+                  (is (= "loro gestiscono" (fo each))))
+                (map :surface
+                     result)))))
+
+
 (deftest casa-generate
   (let [result (generate
                 {:synsem {:cat :verb


Added tree traverser that will check a structure of nodes (like [:atom :ws :is :ws {:value [:atom]}] against an AST output by the parser.

* Added test for "age is 1".
* Added test for "age is x".
* Fuck, Clojure is beautiful.

--- test/isla/test/core.clj
+++ test/isla/test/core.clj
@@ -18,18 +18,37 @@
                ;; :comment
                ))

-(defn get-content [ast]
-  (get ast :content))

-(defn get-first-statement [ast]
-  (get-content (first (get-content ast))))
+(defmulti check-ast (fn [_ expected] (class expected)))

-(defn check-tag-seq [ast tags]
-  (doseq [[ast-node expected-tag] (map vector ast tags)]
-    (is (= (get ast-node :tag) expected-tag))))
+(defmethod check-ast java.util.Map [actual expected]
+  (def actual-tag (:tag actual))
+  (is (contains? expected actual-tag)) ;; check parent
+  (check-ast (:content actual) (actual-tag expected))) ;; recurse sub tree
+
+(defmethod check-ast java.util.List [actual expected]
+  (doseq [[actual-node expected-tag] (map vector actual expected)]
+    (check-ast actual-node expected-tag)))
+
+(defmethod check-ast clojure.lang.Keyword [actual expected]
+  (is (= (:tag actual) expected)))
+
+

 ;; assignment tests

-(deftest assignment
-  (check-tag-seq (get-first-statement (isla-parser "atom is 1"))
-                 [:atom :ws :is :ws :value]))+(deftest assignment-number
+  (check-ast (isla-parser "age is 1")
+             {:root
+              [{:assignment
+                [:atom :ws :is :ws {:value
+                                    [:number]}]}]})
+  )
+
+(deftest assignment-variable
+  (check-ast (isla-parser "age is x")
+             {:root
+              [{:assignment
+                [:atom :ws :is :ws {:value
+                                    [:atom]}]}]})
+  )


add client ip address to logs

add client ip address to logs

--- src/org/zalando/stups/friboo/system/http.clj
+++ src/org/zalando/stups/friboo/system/http.clj
@@ -25,6 +25,24 @@
   [request]
   (apply merge (map (fn [[k v]] v) (:parameters request))))

+(defn add-ip-log-context
+  "Adds the :client context to log statements."
+  [handler]
+  (fn [request]
+    (log/log-with
+      ; TODO make loadbalancer/proxy aware (forward-for header)
+      {:ip (:remote-addr request)}
+      (handler request))))
+
+(defn add-user-log-context
+  "Adds the :user context to log statements."
+  [handler]
+  (fn [request]
+    (log/log-with
+      ; TODO add user information, noop currently
+      {}
+      (handler request))))
+
 (defn start-component
   "Starts the http component."
   [component definition mapper-fn]
@@ -36,13 +54,15 @@
     (do
       (log/info "starting HTTP daemon for API" definition)
       (let [handler (-> (s1st/swagger-executor :mappers [mapper-fn])
+                        (add-user-log-context)
                         (s1st/swagger-security)
                         (s1st/swagger-validator)
                         (s1st/swagger-parser)
                         (s1st/swagger-discovery)
                         (s1st/swagger-mapper ::s1st/yaml-cp definition
                                              :cors-origin (-> component :configuration :cors-origin))
-                        (wrap-params))]
+                        (wrap-params)
+                        (add-ip-log-context))]

         (assoc component :httpd (jetty/run-jetty handler (merge (:configuration component)
                                                                 {:join? false})))))))


cleanup phrasing more

cleanup phrasing more

--- src/pc/views/blog/blue_ocean_made_of_ink.clj
+++ src/pc/views/blog/blue_ocean_made_of_ink.clj
@@ -2,65 +2,64 @@

 (defn blue-ocean-made-of-ink []
   {:title "Our blue ocean is made of ink."
-   :blurb "For every single designer or developer using an app to prototype their product, there's at least a thousand using pen and paper..."
+   :blurb "For every single designer or developer using an app to prototype their product, there's a thousand using pen and paper..."
    :author "Danny"
    :body
    (list
     [:article
      [:p "Following our unexpected "
          [:a {:href "/blog/product-hunt-wake-up-call"} "Product Hunt launch"]
-         ", we've been receiving a lot of feedback.
-         When it's positive I'm inspired, and when it's critical I'm motivated.
-         We've even received encouragement from founders of more popular prototyping tools.
-         This type of praise often brings up the question, “Aren't they competition?”"]]
+         ", we've received a lot of feedback from users.
+         I've found the positive comments to be inspiring, and critical ones motivating.
+         We've even been receiving encouragement from founders of more popular prototyping apps.
+         This type of praise begs the question, “Aren't they competition?”"]]

     [:article
      [:blockquote "Our true competition is not the small trickle of non-Tesla electric cars being produced, but rather the enormous flood of gasoline cars pouring out of the world's factories every day."]]

     [:article
-     [:p "Elon Musk wrote that on "
-         [:a {:href "http://www.teslamotors.com/blog/all-our-patent-are-belong-you"} "Telsa's blog"]
+     [:p "Elon Musk "
+         [:a {:href "http://www.teslamotors.com/blog/all-our-patent-are-belong-you"} "said that about Telsa"]
          " last year.
-         We're lucky enough to stand on the shores of a similar ocean.
-         For every single designer or developer using an app to prototype their product, there's at least a thousand using pen and paper."]]
+         Prototyping stands on similar shores.
+         For every single designer or developer using an app to prototype their product, there's a thousand using pen and paper."]]

     [:article
      [:h3 "Can we compete with paper?"]
      [:p "I don't handwrite letters, I won't pay bills with checks, and I never unfold maps to get around.
-         So why is pen and paper still so ingrained in the prototyping process?
-         In my experience prototyping designs on paper is often based on a desire for more discipline—and this is where Precursor will compete.
-         The inherent discipline with pen and paper makes it simple, efficient, and accessible."]]
+         So why is pen and paper still so utterly ingrained in the traditional design process?
+         In my case, it's often tied to a desire for more discipline.
+         Its constraints make pen and paper simple, efficient, and accessible.
+         So that's where we'll start."]]

     [:article
      [:h3 "Simplicity—a good start."]
-     [:p "No tool is simpler than pen and paper.
-         It requires almost no conscious effort.
-         Competing here means creating a minimum level of cognitive load.
-         To avoid gratuity we interface only when necessary and omit common customization options.
-         These constraints help us focus on productive interactions.
-         E.g., when all shapes are white we can colorize collaborators and create instant recognition."]]
+     [:p "Pen and paper demands no conscious effort.
+         So competing here requires a minimum level of cognitive load.
+         This is why we only interface sparingly and omit common customization options.
+         Our constraints focus effort on productive behaviors.
+         E.g., monotone shapes make emphasizing collaborator activity simple with color."]]

     [:article
      [:h3 "Efficiency—almost there."]
-     [:p "This could be pen and paper's greatest strength.
-         I've always returned to paper after finding that other prototyping tools are too slow.
-         By contrast, I've been using Precursor in my normal workflow for months and I can't remember when I last reached for a pen.
-         I save time that's better spent polishing designs in production.
-         I'm close to eliminating pen and paper from my own process entirely."]]
+    [:p "I often retreat to pen and paper after finding other prototyping tools to be unwieldy.
+        By contrast, Precursor's agility has kept me from reaching for a pen for months.
+        Its precision helps me review old prototypes even after I've forgotten the context.
+        I save time early in my design process so I can polish more in production."]]

     [:article
      [:h3 "Accessibility—done."]
      [:p "Collaboration is the Precursor flagship.
          Handing someone a notebook is easy, but no easier than handing them a phone or a tablet.
-         Precursor can even connect collaborators all over the world.
-         Within seconds an entire product team can be communicating and designing the same wireframe in real time."]]
+         Precursor takes it even further by connecting collaborators around the world.
+         Entire product teams can be communicating and designing concepts together in real time, within seconds."]]

     [:article
      [:h3 "We're more productive without pen and paper."]
-     [:p "Paper is inevitably going to be lost, damaged, or forgotten.
-         I justified this to myself by assuming my prototypes were disposable, but I've never actually found this to be true.
-         Every time I look back through my early prototypes on Precursor, I learn something new about my process.
+     [:p "Paper inevitably gets damaged or forgotten.
+         I justified that to myself by looking at my sketches disposable, but I haven't actually found this to be true.
+         Whenever I scroll through past prototypes on Precursor, I learn something new about my process.
          Consider the implications of a system like that for a moment.
-         Imagine being able to recall every drawing, sketch, or doodle you ever scratched on a piece of paper.
+         Imagine recalling every drawing or doodle you ever scratched on a piece of paper.
          How amazing would that be?"]]
     )})


require java-time.data ns in the core ns

--- src/java_time.clj
+++ src/java_time.clj
@@ -3,7 +3,7 @@
   (:require [java-time.potemkin.namespaces :as potemkin]
             [java-time.util :as jt.u]
             [java-time core properties temporal amount zone single-field local chrono
-             convert sugar seqs adjuster interval format joda clock pre-java8 mock]))
+             convert sugar seqs adjuster interval format joda clock pre-java8 mock data]))

 (potemkin/import-vars
   [java-time.clock


fix q15 tmp

fix q15 tmp


Correct wording

Correct wording

--- src/juzi/core.clj
+++ src/juzi/core.clj
@@ -32,10 +32,10 @@
           (println)
           (println "Answer:" pi (when zh (str "(" zh ")")))
           (println)
-          (println "Were you correct? [y/n]")
+          (println "Were you correct ? [y/n]")
           (let [i (.readCharacter cr)]
             (clear-screen)
             (if (= \y (char i))
               (recur (s/mark-passed s id))
               (recur s))))
-        (println "You have passed all the words! Gōngxǐ. Zàijiàn.")))))
+        (println "Finish! Gōngxǐ. Zàijiàn.")))))


write attributes once

write attributes once

--- src/navigator.clj
+++ src/navigator.clj
@@ -9,8 +9,10 @@
 (def updatable-fields
   {:comp [:comp/description :comp/status :comp/tags]})

-(def valid-fields
-  {:comp [:comp/id-sk :comp/name :comp/description :comp/version :comp/status :comp/tags]})
+(def write-once-fields
+  {:comp [:comp/id-sk :comp/name :comp/version]})
+
+(def valid-fields (merge-with concat write-once-fields updatable-fields))

 ;; TODO: use https://github.com/rkneufeld/conformity ... in schematode. But noting it here. :-)
 (defn init! [system]


Simplify re-frame syntax/sugar

Simplify re-frame syntax/sugar

--- client/src/cljs/receipts_client/views.cljs
+++ client/src/cljs/receipts_client/views.cljs
@@ -26,13 +26,17 @@
 (def tight-field-width "11rem")
 (def field-width "14rem")

+
+;; Nice sugar from https://lambdaisland.com/blog/11-02-2017-re-frame-form-1-subscriptions
+(def <sub (comp deref re-frame/subscribe))
+(def >evt re-frame/dispatch)
+
 (defn app-title []
-  (let [name (re-frame/subscribe [:name])
-        server (re-frame/subscribe [:server])]
-    (fn []
-      [re-com/title
-       :label (str @name (when (= @server :development) " (local test server)"))
-       :level :level1])))
+  [re-com/title
+   :label (str (<sub [:name])
+               (when (= (<sub [:server]) :development)
+                 " (local test server)"))
+   :level :level1] )

 (defn panel-title [label]
   [re-com/title :label label :level :level1])
@@ -51,7 +55,7 @@
    :label label
    :tooltip tooltip
    :on-click #(if (vector? dispatch)
-                (re-frame/dispatch dispatch)
+                (>evt dispatch)
                 (dispatch))])

 (defn labelled [label error component]
@@ -122,19 +126,17 @@
       :or {model-key-fn identity
            schema-id-key schema-key
            schema-label-key schema-key}}]
-  (let [current-receipt (re-frame/subscribe [:current-receipt])
-        schema (re-frame/subscribe [subs-key])]
-    [(if multiple? re-com/selection-list re-com/single-dropdown)
-     :width field-width
-     :model ((if multiple? (partial into #{}) identity)
-             (field-key @current-receipt))
-     :choices (mapv (fn [{id schema-id-key
-                          label schema-label-key}]
-                      {:id id :label label})
-                    (if filter-fn
-                      (filter filter-fn @schema)
-                      @schema))
-     :on-change #(re-frame/dispatch [:edit-current-receipt field-key %])]))
+  [(if multiple? re-com/selection-list re-com/single-dropdown)
+   :width field-width
+   :model ((if multiple? (partial into #{}) identity)
+           (field-key (<sub [:current-receipt])))
+   :choices (mapv (fn [{id schema-id-key
+                        label schema-label-key}]
+                    {:id id :label label})
+                  (if filter-fn
+                    (filter filter-fn (<sub [subs-key]))
+                    (<sub [subs-key])))
+   :on-change #(>evt [:edit-current-receipt field-key %])])

 (defn login-panel []
@@ -178,78 +180,75 @@
   (struct/valid? receipt complete-receipt))

 (defn receipt-page []
-  (let [current-receipt (re-frame/subscribe [:current-receipt])]
-    (fn []
-      (let [validation-errors (first (validate-receipt @current-receipt))]
-        [re-com/v-box
-         :gap tight-gap
-         :children
-         [[labelled "Paid by"
-           (:purchase/paymentMethod validation-errors)
-           [dropdown :multiple? false
-            :field-key :purchase/paymentMethod
-            :subs-key :payment-methods
-            :schema-id-key :paymentMethod/abbrev
-            :schema-label-key :paymentMethod/name]]
-          [labelled "Date"
-           (:purchase/date validation-errors)
-           [date-time-picker
-            :model (or (:purchase/date @current-receipt) (time/now))
-            :on-change #(re-frame/dispatch [:edit-current-receipt :purchase/date %])]]
-          [labelled "Price"
-           (:purchase/price validation-errors)
-           [re-com/input-text
-            :width field-width
-            :model (or (:purchase/price @current-receipt) "0.00")
-            :on-change #(re-frame/dispatch [:edit-current-receipt :purchase/price %])
-            :change-on-blur? false
-            :attr {:type "number"
-                   :step "0.01"}]]
-          [labelled "Category"
-           (:purchase/category validation-errors)
-           [dropdown :multiple? false
-            :field-key :purchase/category
-            :subs-key :categories
-            :schema-key :category/name]]
-          [labelled "Vendor"
-           (:purchase/vendor validation-errors)
-           [dropdown :multiple? false
-            :field-key :purchase/vendor
-            :subs-key :vendors
-            :schema-key :vendor/name
-            :filter-fn #(some #{(:purchase/category @current-receipt)} (:vendor/category %))]]
-          [labelled "Comment"
-           (:purchase/comment validation-errors)
-           [re-com/input-text
-            :width field-width
-            :model (or (:purchase/comment @current-receipt) "")
-            :on-change #(re-frame/dispatch [:edit-current-receipt :purchase/comment %])
-            :attr {:type "text"}]]
-          [labelled "For Whom"
-           (:purchase/forWhom validation-errors)
-           [dropdown :multiple? true
-            :field-key :purchase/forWhom
-            :subs-key :users
-            :filter-fn :user/isConsumer
-            :schema-label-key :user/name
-            :schema-id-key :user/abbrev]]
-          [re-com/gap :size std-gap]
-          [re-com/h-box
-           :children
-           [[re-com/button
-             :disabled? (not (valid-receipt? @current-receipt))
-             :on-click #(re-frame/dispatch [:submit-receipt @current-receipt])
-             :label "Submit Receipt"]]]]]))))
+  (let [receipt (<sub [:current-receipt])
+        validation-errors (first (validate-receipt receipt))]
+    [re-com/v-box
+     :gap tight-gap
+     :children
+     [[labelled "Paid by"
+       (:purchase/paymentMethod validation-errors)
+       [dropdown :multiple? false
+        :field-key :purchase/paymentMethod
+        :subs-key :payment-methods
+        :schema-id-key :paymentMethod/abbrev
+        :schema-label-key :paymentMethod/name]]
+      [labelled "Date"
+       (:purchase/date validation-errors)
+       [date-time-picker
+        :model (or (:purchase/date receipt) (time/now))
+        :on-change #(>evt [:edit-current-receipt :purchase/date %])]]
+      [labelled "Price"
+       (:purchase/price validation-errors)
+       [re-com/input-text
+        :width field-width
+        :model (or (:purchase/price receipt) "0.00")
+        :on-change #(>evt [:edit-current-receipt :purchase/price %])
+        :change-on-blur? false
+        :attr {:type "number"
+               :step "0.01"}]]
+      [labelled "Category"
+       (:purchase/category validation-errors)
+       [dropdown :multiple? false
+        :field-key :purchase/category
+        :subs-key :categories
+        :schema-key :category/name]]
+      [labelled "Vendor"
+       (:purchase/vendor validation-errors)
+       [dropdown :multiple? false
+        :field-key :purchase/vendor
+        :subs-key :vendors
+        :schema-key :vendor/name
+        :filter-fn #(some #{(:purchase/category receipt)} (:vendor/category %))]]
+      [labelled "Comment"
+       (:purchase/comment validation-errors)
+       [re-com/input-text
+        :width field-width
+        :model (or (:purchase/comment receipt) "")
+        :on-change #(>evt [:edit-current-receipt :purchase/comment %])
+        :attr {:type "text"}]]
+      [labelled "For Whom"
+       (:purchase/forWhom validation-errors)
+       [dropdown :multiple? true
+        :field-key :purchase/forWhom
+        :subs-key :users
+        :filter-fn :user/isConsumer
+        :schema-label-key :user/name
+        :schema-id-key :user/abbrev]]
+      [re-com/gap :size std-gap]
+      [re-com/h-box
+       :children
+       [[re-com/button
+         :disabled? (not (valid-receipt? receipt))
+         :on-click #(>evt [:submit-receipt receipt])
+         :label "Submit Receipt"]]]]]))

 (defn home-panel []
-  (let [user (re-frame/subscribe [:user])]
-    (fn []
-      (if (:user/isEditor @user)
-        [re-com/v-box
-         :gap title-gap
-         :children [(panel-title "New Receipt")
-                    [receipt-page]]]
-        [login-panel]))))
+  (if (:user/isEditor (<sub [:user]))
+    [re-com/v-box
+     :gap title-gap
+     :children [(panel-title "New Receipt")
+                [receipt-page]]]
+    [login-panel]))

 (defn add-user []
   (let [new-user (reagent/atom {})]
@@ -293,7 +292,7 @@
                                 {:id :user/isConsumer :label "Consumer"}]
                       :model (or (:permissions @new-user) #{})
                       :on-change #(swap! new-user assoc :permissions %)]]
-                    [button #(do (re-frame/dispatch [:add-user @new-user])
+                    [button #(do (>evt [:add-user @new-user])
                                  (reset! new-user {}))
                      "Add User" "Create a new user"]]]))))

@@ -323,7 +322,7 @@
                     :model vendor
                     :on-change #(reset! vendor %)
                     :width field-width]]
-                  [button #(do (re-frame/dispatch [:add-vendor @category @vendor])
+                  [button #(do (>evt [:add-vendor @category @vendor])
                                (reset! vendor ""))
                    "Add Vendor" "Create a new vendor"]]])))

@@ -368,27 +367,25 @@
         [login-panel]))))

 (defn about-panel []
-  (let [about-server (re-frame/subscribe [:about-server])]
-    (fn []
-      [re-com/v-box
-       :gap title-gap
-       :children [(panel-title "About")
-                  [:div
-                   [:p "Third iteration of a simple receipts management program."]
-                   [:p "This time, my focus is on learning Vase, Datomic, and Pedestal."]
-                   [:h4 "Status"]
-                   [:p (goog.string/format "Currently holding %d purchases." (or (:purchases-count @about-server) 0))]
-                   [:h4 (goog.string/format "Version %s" (:version @about-server))]
-                   [:h5 "Includes libraries:"]
-                   [:small
-                    [:ul
-                     (map (fn [[dependency version]]
-                            ^{:key dependency}[:li (goog.string/format "%s:%s" dependency version)])
-                          (sort-by first (:dependencies @about-server)))]]
-                   [:p
-                    [:em "Copyright (c) 2017, David Goldfarb <deg@degel.com>"]
-                    [:br]
-                    [:em "Portions copyright 2013-2016."]]]]])))
+  [re-com/v-box
+   :gap title-gap
+   :children [(panel-title "About")
+              [:div
+               [:p "Third iteration of a simple receipts management program."]
+               [:p "This time, my focus is on learning Vase, Datomic, and Pedestal."]
+               [:h4 "Status"]
+               [:p (goog.string/format "Currently holding %d purchases." (or (:purchases-count (<sub [:about-server])) 0))]
+               [:h4 (goog.string/format "Version %s" (:version (<sub [:about-server])))]
+               [:h5 "Includes libraries:"]
+               [:small
+                [:ul
+                 (map (fn [[dependency version]]
+                        ^{:key dependency}[:li (goog.string/format "%s:%s" dependency version)])
+                      (sort-by first (:dependencies (<sub [:about-server]))))]]
+               [:p
+                [:em "Copyright (c) 2017, David Goldfarb <deg@degel.com>"]
+                [:br]
+                [:em "Portions copyright 2013-2016."]]]]])

 (def date-format (time-format/formatter "ddMMMyy"))
 (def time-format (time-format/formatter "HH:mm:ss"))
@@ -401,7 +398,7 @@
     :price (let [[currency amount] value
                  symbol (case currency
                           "USD" "$"
-                          "EU" "\u20AC"
+                          "EU"  "\u20AC"
                           "GBP" "\u00A3"
                           "NIS" "\u20AA"
                           "?")]
@@ -440,25 +437,21 @@
    :disabled? true])

 (defn history-panel []
-  (let [user (re-frame/subscribe [:user])
-        history (re-frame/subscribe [:history])
-        csv (re-frame/subscribe [:history-csv])]
-    (fn []
-      (if @user
-        (let [consumer? (:user/isConsumer @user)
-              editor? (:user/isEditor @user)
-              admin? (:user/isAdmin @user)]
-          [re-com/v-box
-           :gap title-gap
-           :children [(panel-title "History")
-                      [re-com/scroller
-                       :scroll :auto
-                       :child [history-table @history]]
-                      (when admin?
-                        [history-csv @csv])
-                      [re-com/h-box
-                       :children [(button [:get-history] "Refresh History" "Load history from server")]]]])
-        [login-panel]))))
+  (if (<sub [:user])
+    (let [consumer? (:user/isConsumer (<sub [:user]))
+          editor? (:user/isEditor (<sub [:user]))
+          admin? (:user/isAdmin (<sub [:user]))]
+      [re-com/v-box
+       :gap title-gap
+       :children [(panel-title "History")
+                  [re-com/scroller
+                   :scroll :auto
+                   :child [history-table (<sub [:history])]]
+                  (when admin?
+                    [history-csv (<sub [:history-csv])])
+                  [re-com/h-box
+                   :children [(button [:get-history] "Refresh History" "Load history from server")]]]])
+    [login-panel]))

 (defn formatted-schema [title schema-part only-dynamic?]
   [re-com/v-box
@@ -472,16 +465,13 @@
                           schema-part))]]])

 (defn config-panel []
-  (let [server (re-frame/subscribe [:server])
-        user (re-frame/subscribe [:user])
-        schema (re-frame/subscribe [:schema])
-        verbose? (reagent/atom false)
+  (let [verbose? (reagent/atom false)
         entities (reagent/atom "")]
     (fn []
-      (let [email (:user/email @user)
-            consumer? (:user/isConsumer @user)
-            editor? (:user/isEditor @user)
-            admin? (:user/isAdmin @user)]
+      (let [email (:user/email (<sub [:user]))
+            consumer? (:user/isConsumer (<sub [:user]))
+            editor? (:user/isEditor (<sub [:user]))
+            admin? (:user/isAdmin (<sub [:user]))]
         [re-com/v-box
          :gap title-gap
          :children [(panel-title "Setup")
@@ -498,8 +488,8 @@
                         :choices [{:id :production :label "production"}
                                   {:id :development :label "development"}]
                         :width tight-field-width
-                        :model @server
-                        :on-change #(re-frame/dispatch [:set-server %])]])
+                        :model (<sub [:server])
+                        :on-change #(>evt [:set-server %])]])
                     (when admin?
                       [re-com/v-box
                        :align :end
@@ -518,16 +508,17 @@
                      :on-change #(reset! verbose? %)
                      :label "Show all?")
                     (when admin?
-                      (formatted-schema "Users" (:users @schema) (not @verbose?)))
-                    (formatted-schema "Payment Methods" (:payment-methods @schema) (not @verbose?))
-                    (formatted-schema "Currencies" (:currencies @schema) (not @verbose?))
-                    (formatted-schema "Categories" (:categories @schema) (not @verbose?))
-                    (formatted-schema "Vendors" (:vendors @schema) (not @verbose?))]]))))
+                      (formatted-schema "Users" (:users (<sub [:schema])) (not @verbose?)))
+                    (formatted-schema "Payment Methods" (:payment-methods (<sub [:schema])) (not @verbose?))
+                    (formatted-schema "Currencies" (:currencies (<sub [:schema])) (not @verbose?))
+                    (formatted-schema "Categories" (:categories (<sub [:schema])) (not @verbose?))
+                    (formatted-schema "Vendors" (:vendors (<sub [:schema])) (not @verbose?))]]))))

 (defn setup-panel []
-  (let [credentials (re-frame/subscribe [:credentials])]
-    (fn []
-      (if @credentials [config-panel] [login-panel]))))
+  (if (<sub [:credentials])
+    [config-panel]
+    [login-panel]))
+

 (defn wrap-page [page]
   [re-com/border
@@ -544,20 +535,15 @@
            {:id :setup   :label "setup"     :panel (wrap-page [setup-panel])}])

 (defn tab-panel []
-  (let [page (re-frame/subscribe [:page])]
-    (fn []
-      (:panel (or (first (filter #(= (:id %) @page)
-                                 tabs))
-                  :home-panel)))))
+  (:panel (or (first (filter #(= (:id %) (<sub [:page]))
+                             tabs))
+              :home-panel)))

 (defn tabs-row []
-  (let [page (re-frame/subscribe [:page])
-        server (re-frame/subscribe [:server])]
-    (fn []
-      [re-com/horizontal-pill-tabs
-       :tabs tabs
-       :model (or @page :home)
-       :on-change #(routes/goto-page % @server)])))
+  [re-com/horizontal-pill-tabs
+   :tabs tabs
+   :model (or (<sub [:page]) :home)
+   :on-change #(routes/goto-page % (<sub [:server]))])

 (defn main-panel []
   (let [schema (re-frame/subscribe [:schema])]
@@ -565,7 +551,7 @@
       ;; [TODO] This gets the schema once when the program starts. This is probably wrong:
       ;; - I don't know if this is called at the best time or place
       ;; - No mechanism to get changed schema; especially, e.g., if a client is open for many days
-      (re-frame/dispatch [:update-credentials])
+      (>evt [:update-credentials])
       [re-com/v-box
        :children [[app-title]
                   [tabs-row]


(PDB-5161) engine/unsupported-fields: rely on parse-field

Rely on parse-field rather than is-dotted-projection?.

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -2558,13 +2558,19 @@

 (declare push-down-context)

+(defn- valid-dotted-field?
+  [field allowed-json-extract?]
+  (let [[top & path] (parse/parse-field field)]
+    (and (seq path) (allowed-json-extract? (:name top)))))
+
 (defn unsupported-fields
   [field allowed-fields allowed-json-extracts]
-  (let [supported-calls (set (map #(vector "function" %) (keys pdb-fns->pg-fns)))]
-    (remove #(or (contains? (set allowed-fields) %)
-                 (contains? supported-calls (take 2 %))
-                 (and (is-dotted-projection? %)
-                      (contains? (set allowed-json-extracts) (first (str/split % #"\.")))))
+  (let [allowed-json-extract? (set allowed-json-extracts)
+        allowed-field? (set allowed-fields)
+        supported-call? (set (map #(vector "function" %) (keys pdb-fns->pg-fns)))]
+    (remove #(or (allowed-field? %)
+                 (supported-call? (take 2 %))
+                 (valid-dotted-field? % allowed-json-extract?))
             (ks/as-collection field))))

 (defn validate-query-operation-fields


Reorder test assertions

Reorder test assertions

--- src/test/cljc/mikron/runtime/core_test2.cljc
+++ src/test/cljc/mikron/runtime/core_test2.cljc
@@ -22,9 +22,10 @@
            (tc.gen/tuple (tc.gen/return (macrowbar/eval `(mikron/schema ~schema
                                                            :processor-types #{:pack :unpack :valid?})))
                          (test-generator.value/value-generator schema))))]
-      (let [value' (mikron/with-buffer buffer
-                     (->> value (mikron/pack schema)
-                                (mikron/unpack schema)))]
-        (and (mikron/valid? schema value)
-             (mikron/valid? schema value')
-             (test-util/equal? value value'))))))
+      (and (mikron/valid? schema value)
+           (let [value' (mikron/with-buffer buffer
+                          (->> value
+                               (mikron/pack schema)
+                               (mikron/unpack schema)))]
+             (and (mikron/valid? schema value')
+                  (test-util/equal? value value')))))))


adds support for incremental output of completed tasks in the simulator (#1006)

--- scheduler/test/cook/test/simulator.clj
+++ scheduler/test/cook/test/simulator.clj
@@ -22,7 +22,8 @@
             [cook.test.testutil :refer (restore-fresh-database! poll-until)]
             [datomic.api :as d]
             [plumbing.core :refer (map-vals map-keys map-from-vals)])
-  (:import org.apache.curator.framework.CuratorFrameworkFactory
+  (:import java.util.Date
+           org.apache.curator.framework.CuratorFrameworkFactory
            org.apache.curator.framework.state.ConnectionStateListener
            org.apache.curator.retry.BoundedExponentialBackoffRetry
            org.joda.time.DateTimeUtils)
@@ -42,8 +43,8 @@
   ([]
    (setup-test-curator-framework 2282))
   ([zk-port]
-   ;; Copied from src/cook/components
-   ;; TODO: don't copy from components
+    ;; Copied from src/cook/components
+    ;; TODO: don't copy from components
    (let [retry-policy (BoundedExponentialBackoffRetry. 100 120000 10)
          ;; The 180s session and 30s connection timeouts were pulled from a google group
          ;; recommendation
@@ -191,15 +192,15 @@

 (defn dump-jobs-to-csv
   "Given a mesos db, dump a csv with a row per task"
-  [task-ents file]
+  [task-ents file & {:keys [add-headers append] :or {add-headers true append false}}]
   ;; Use snake case to make it easier for downstream tools to consume
   (let [headers [:job_id :instance_id :group_id :submit_time_ms :mesos_start_time_ms :start_time_ms
                  :end_time_ms :hostname :slave_id :status :reason :user :mem :cpus :job_name
                  :requested_run_time :expected_run_time :requested_status]
         tasks (map generate-task-trace-map task-ents)]
-    (with-open [out-file (io/writer file)]
+    (with-open [out-file (io/writer file :append append)]
       (csv/write-csv out-file
-                     (concat [(mapv name headers)]
+                     (concat (when add-headers [(mapv name headers)])
                              (map (apply juxt headers) tasks))))))

 (defn pull-all-task-ents
@@ -209,6 +210,19 @@
               :where
               [?i :instance/task-id _]]
             mesos-db)
+       (map (partial d/entity mesos-db))))
+
+(defn pull-all-task-ents-completed-in-time-range
+  "Returns a seq of task entities from the db for the specified time range."
+  [mesos-db start-time-inc end-time-exc]
+  (->> (d/q '[:find [?i ...]
+              :in $ ?st ?et
+              :where
+              [?i :instance/task-id _]
+              [?i :instance/end-time ?t]
+              [(>= ?t ?st)]
+              [(< ?t ?et)]]
+            mesos-db start-time-inc end-time-exc)
        (map (partial d/entity mesos-db))))

 (defn submit-job
@@ -280,7 +294,20 @@
   [coll]
   (= coll (sort coll)))

-()
+(defn- write-completed-tasks
+  "Writes completed tasks between start-time and current-time to the temp-out-trace-file."
+  [mesos-db time-ms-between-incremental-output temp-out-trace-file simulation-start-time start-time current-time]
+  (log/info "Starting temporary output iteration" start-time "to" current-time)
+  (let [start-date (Date. ^long start-time)
+        end-date (Date. ^long current-time)
+        completed-task-ents (pull-all-task-ents-completed-in-time-range mesos-db start-date end-date)]
+    (if (seq completed-task-ents)
+      (do
+        (log/info "Writing" (count completed-task-ents) "tasks to temporary output for simulation time" current-time)
+        (dump-jobs-to-csv completed-task-ents temp-out-trace-file
+                          :add-headers (= start-time simulation-start-time)
+                          :append true))
+      (log/info "No completed tasks in last" time-ms-between-incremental-output "ms"))))

 ;; TODO need way of setting share
 (defn simulate
@@ -290,7 +317,7 @@
    The start simulation time is the min submit time in the trace.

    Returns a list of the task entities run"
-  [mesos-hosts trace cycle-step-ms config]
+  [mesos-hosts trace cycle-step-ms config temp-out-trace-file]
   (let [simulation-time (-> trace first :submit-time-ms)
         mesos-datomic-conn (restore-fresh-database! (get config :datomic-url "datomic:mem://mock-mesos"))
         offer-trigger-chan (async/chan)
@@ -307,6 +334,7 @@
                                               :complete-trigger-chan complete-trigger-chan
                                               :state-atom state-atom))
         config (merge {:shares [{:user "default" :mem 4000.0 :cpus 4.0 :gpus 1.0}]
+                       :time-ms-between-incremental-output (-> 10 t/minutes t/in-millis)
                        :time-ms-between-optimizer-calls (-> 3 t/minutes t/in-millis)
                        :time-ms-between-rebalancing (-> 30 t/minutes t/in-millis)}
                       config)
@@ -325,12 +353,34 @@
                                                  :straggler-trigger-chan (async/chan)
                                                  :lingering-task-trigger-chan (async/chan)
                                                  :cancelled-task-trigger-chan (async/chan)}})
-        {:keys [time-ms-between-optimizer-calls time-ms-between-rebalancing]} config]
+        {:keys [time-ms-between-incremental-output time-ms-between-optimizer-calls time-ms-between-rebalancing]} config]
+    ;; launch a thread to perform incremental writes of completed jobs
+    (when temp-out-trace-file
+      (let [last-start-time-atom (atom simulation-time)
+            write-thread (Thread.
+                           ^Runnable
+                           (fn write-completed-tasks-runner []
+                             (while true
+                               (Thread/sleep time-ms-between-incremental-output)
+                               (try
+                                 (let [start-time @last-start-time-atom
+                                       current-time (.getMillis (t/now))
+                                       mesos-db (d/db mesos-datomic-conn)]
+                                   (write-completed-tasks
+                                     mesos-db time-ms-between-incremental-output temp-out-trace-file
+                                     simulation-time start-time current-time)
+                                   (reset! last-start-time-atom current-time))
+                                 (catch Throwable ex
+                                   (log/error ex "Error writing incremental completed job output!"))))))]
+        (log/info "Temporary output will be updated every" time-ms-between-incremental-output "ms")
+        (.setDaemon write-thread true)
+        (.start write-thread)))
     ;; We are setting time to enable us to have deterministic runs
     ;; of the simulator while hooking into the scheduler as non-invasively
     ;; as possible. A longer explanation can be found in the simulator dev docs.
     (DateTimeUtils/setCurrentMillisFixed simulation-time)
-    (log/info "Starting simulation.")
+    (log/info "Starting simulation at" simulation-time)
+    ;; launch the simulator
     (with-cook-scheduler
       mesos-datomic-conn
       make-mesos-driver-fn
@@ -515,11 +565,12 @@
                    {})
           cycle-step-ms (or cycle-step-ms (:cycle-step-ms config))
           _ (when-not cycle-step-ms
-              (throw (ex-info "Must configure cycle-step-ms on command line or config file")))
+              (throw (ex-info "Must configure cycle-step-ms on command line or config file" {})))
           task-ents (simulate hosts
                               (cheshire/parse-stream (clojure.java.io/reader trace-file) true)
                               cycle-step-ms
-                              config)]
+                              config
+                              (str out-trace-file ".temp-" (System/nanoTime)))]
       (println "tasks run: " (count task-ents))
       (dump-jobs-to-csv task-ents out-trace-file)
       (println "Done writing trace")
@@ -647,8 +698,8 @@
         config {:shares [{:cpus (/ host-cpus 10) :gpus 1.0 :mem (/ host-mem 10) :user "default"}]
                 :scheduler-config {:rebalancer-config {:max-preemption 1.0}
                                    :fenzo-config {:fenzo-max-jobs-considered 200}}}
-        out-trace-a (simulate hosts jobs cycle-step-ms config)
-        out-trace-b (simulate hosts jobs cycle-step-ms config)]
+        out-trace-a (simulate hosts jobs cycle-step-ms config nil)
+        out-trace-b (simulate hosts jobs cycle-step-ms config nil)]
     (is (> (count out-trace-a) 0))
     (is (> (count out-trace-b) 0))
     (is (traces-equivalent? out-trace-a out-trace-b)


Minor profiles.clj reorganization.

Minor profiles.clj reorganization.

--- profiles.clj
+++ profiles.clj
@@ -1,6 +1,16 @@
 {:dev
  {:global-vars {*warn-on-reflection* false}
   :source-paths ["dev"]
+  :dependencies [[clj-http "1.1.2"]
+                 [aleph "0.4.0" :exclusions [io.netty/netty-all]]
+                 [org.clojure/tools.namespace "0.2.11"]
+                 [ring/ring-core "1.4.0" :exclusions [javax.servlet/servlet-api
+                                                      org.clojure/clojure
+                                                      clj-time]]]
+  :plugins [[lein-ancient "0.6.7" :exclusions [org.clojure/tools.reader]]]}
+
+ :doc
+ {:plugins [[funcool/codeina "0.3.0"]]
   :codeina {:sources ["src/clojure"]
             :exclude [catacumba.impl.context
                       catacumba.impl.atomic
@@ -27,14 +37,7 @@
             :reader :clojure
             :target "doc/dist/latest/api"
             :src-uri "http://github.com/funcool/catacumba/blob/master/"
-            :src-uri-prefix "#L"}
-  :plugins [[funcool/codeina "0.3.0"]
-            [lein-ancient "0.6.7" :exclusions [org.clojure/tools.reader]]]
-  :dependencies [[clj-http "1.1.2"]
-                 [aleph "0.4.0" :exclusions [io.netty/netty-all]]
-                 [org.clojure/tools.namespace "0.2.11"]
-                 [ring/ring-core "1.4.0"
-                  :exclusions [javax.servlet/servlet-api clj-time org.clojure/clojure]]]}
+            :src-uri-prefix "#L"}}

  :bench
  [:dev
@@ -43,6 +46,8 @@
                         "-Xmx4g"
                         "-Xms4g"]
    :main ^:skip-aot bench}]
+
+ :1.8 {:dependencies [[org.clojure/clojure "1.8.0-beta1"]]}

  ;; Examples
  :examples
@@ -79,6 +84,5 @@
   {:source-paths ["examples/website/src"]
    :resource-paths ["examples/website/resources"]
    :main ^:skip-aot website.core}]
-
  }


adapt to jedis 2.6

adapt to jedis 2.6

--- src/org/spootnik/fleet/transport/redis.clj
+++ src/org/spootnik/fleet/transport/redis.clj
@@ -26,17 +26,17 @@
                   (:host decoded))))))))

 (defn rpool
-  [{:keys [host port timeout max-active max-idle max-wait]
-    :or {max-active 5
-         max-wait   200
+  [{:keys [host port timeout max-idle max-total]
+    :or {max-wait   200
+         max-idle   5
+         max-total  10
          timeout    200
          host       "localhost"
          port       6379}}]
   (-> (doto (redis.clients.jedis.JedisPoolConfig.)
-        (.setMaxActive max-active)
-        (.setMaxIdle (or max-idle max-active))
+        (.setMaxIdle max-idle)
         (.setTestOnBorrow true)
-        (.setMaxWait max-wait))
+        (.setMaxWaitMillis max-wait))
       (redis.clients.jedis.JedisPool. host port timeout)))

 (defn rpublish


Update reader.clj

Update reader.clj

--- src/yaml/reader.clj
+++ src/yaml/reader.clj
@@ -1,5 +1,4 @@
 (ns yaml.reader
- (:require [clojure.java.io :as io])
  (:import (org.yaml.snakeyaml Yaml)))

 (def ^:dynamic *keywordize* true)


add some tests

add some tests

--- test/clj/backtype/storm/integration_test.clj
+++ test/clj/backtype/storm/integration_test.clj
@@ -1,6 +1,7 @@
 (ns backtype.storm.integration-test
   (:use [clojure test])
   (:import [backtype.storm.topology TopologyBuilder])
+  (:import [backtype.storm.generated InvalidTopologyException])
   (:import [backtype.storm.testing TestWordCounter TestWordSpout TestGlobalCount TestAggregatesCounter TestConfBolt])
   (:use [backtype.storm bootstrap testing])
   (:use [backtype.storm.daemon common])
@@ -98,6 +99,39 @@
         (is (= [[1] [2] [3] [4]]
                (read-tuples results "4")))
         ))))
+
+(defn mk-validate-topology-1 []
+  (thrift/mk-topology
+                    {"1" (thrift/mk-spout-spec (TestWordSpout. true) :parallelism-hint 3)}
+                    {"2" (thrift/mk-bolt-spec {"1" ["word"]} (TestWordCounter.) :parallelism-hint 4)}))
+
+(defn mk-invalidate-topology-1 []
+  (thrift/mk-topology
+                    {"1" (thrift/mk-spout-spec (TestWordSpout. true) :parallelism-hint 3)}
+                    {"2" (thrift/mk-bolt-spec {"3" ["word"]} (TestWordCounter.) :parallelism-hint 4)}))
+
+(defn mk-invalidate-topology-2 []
+  (thrift/mk-topology
+                    {"1" (thrift/mk-spout-spec (TestWordSpout. true) :parallelism-hint 3)}
+                    {"2" (thrift/mk-bolt-spec {"1" ["non-exists-field"]} (TestWordCounter.) :parallelism-hint 4)}))
+
+(defn try-complete-wc-topology [cluster topology]
+  (try (do
+         (complete-topology cluster
+                            topology
+                            :mock-sources {"1" [["nathan"] ["bob"] ["joey"] ["nathan"]]}
+                            :storm-conf {TOPOLOGY-WORKERS 2})
+         false)
+       (catch InvalidTopologyException e true)))
+
+(deftest test-validate-topology-structure
+  (with-simulated-time-local-cluster [cluster :supervisors 4]
+    (let [any-error1? (try-complete-wc-topology cluster (mk-validate-topology-1))
+          any-error2? (try-complete-wc-topology cluster (mk-invalidate-topology-1))
+          any-error3? (try-complete-wc-topology cluster (mk-invalidate-topology-2))]
+      (is (= any-error1? false))
+      (is (= any-error2? true))
+      (is (= any-error3? true)))))

 (defbolt identity-bolt ["num"]
   [tuple collector]


added test that component specific configs in clojure dsl work correctly

--- test/clj/backtype/storm/integration_test.clj
+++ test/clj/backtype/storm/integration_test.clj
@@ -457,6 +457,39 @@
             ))
      )))

+(defbolt conf-query-bolt ["conf" "val"] {:prepare true :params [conf] :conf conf}
+  [conf context collector]
+  (bolt
+   (execute [tuple]
+            (let [name (.getValue tuple 0)]
+              (emit-bolt! collector [name (get conf name)] :anchor tuple))
+            )))
+
+(deftest test-component-specific-config-clojure
+  (with-simulated-time-local-cluster [cluster]
+    (let [topology (topology {"1" (spout-spec (TestPlannerSpout. (Fields. ["conf"])))
+                              }
+                             {"2" (bolt-spec {"1" :shuffle}
+                                             (conf-query-bolt {"fake.config" 1
+                                                               TOPOLOGY-MAX-TASK-PARALLELISM 2
+                                                               TOPOLOGY-MAX-SPOUT-PENDING 10})
+                                             :conf {TOPOLOGY-MAX-SPOUT-PENDING 3})
+                              })
+          results (complete-topology cluster
+                                     topology
+                                     :storm-conf {TOPOLOGY-MAX-TASK-PARALLELISM 10}
+                                     :mock-sources {"1" [["fake.config"]
+                                                         [TOPOLOGY-MAX-TASK-PARALLELISM]
+                                                         [TOPOLOGY-MAX-SPOUT-PENDING]
+                                                         ]})]
+      (is (= {"fake.config" 1
+              TOPOLOGY-MAX-TASK-PARALLELISM 2
+              TOPOLOGY-MAX-SPOUT-PENDING 3}
+             (->> (read-tuples results "2")
+                  (apply concat)
+                  (apply hash-map))
+             )))))
+
 (deftest test-acking-branching-complex
   ;; test acking with branching in the topology
   )


More fixes for 1.2.16

More fixes for 1.2.16

--- test/clojurewerkz/cassaforte/schema_test.clj
+++ test/clojurewerkz/cassaforte/schema_test.clj
@@ -43,7 +43,9 @@
     (is (= "org.apache.cassandra.db.marshal.UTF8Type"
            (get-in columns [1 :validator])))

-    (is (= 3 (count columns)))))
+    (is (or
+         (= 2 (count columns)) ;; Cassandra versions
+         (= 3 (count columns))))))

 (defn changes-by
   [f f2 n]


Correctly support status for ALL actions...

--- src/aerobio/actions.clj
+++ src/aerobio/actions.clj
@@ -89,50 +89,53 @@
 #_(->> (cmn/exp-ids) (map #(cmn/get-exp-info % :stats)))
 (defmethod action :rerun
   [_ eid params get-toolinfo template]
-  (let [status (atom "starting...")
+  (let [status (atom {:done []})
         {:keys [user cmd phase modifier compfile]} params
         rep (if modifier :rep nil)
         outdir (cmn/get-exp-info eid :out)

         exp (cmn/get-exp-info eid :exp)
         user (get-mail-recipient user)]
-
-    (cmn/launch-action
-     eid user
-     get-toolinfo template
-     :action phase
-     :rep rep
-     :compfile compfile
-     :status status)))
+    {:status status
+     :fut (cmn/launch-action
+           eid user
+           get-toolinfo template
+           :action phase
+           :rep rep
+           :compfile compfile
+           :status status)}))

 (defmethod action :compare
   [_ eid params get-toolinfo template]
-  (let [status (atom "starting...")
+  (let [status (atom {:done []})
         exp (cmn/get-exp-info eid :exp)
         {:keys [user cmd phase modifier compfile]} params
         recipient (pams/get-params [:email (keyword user)])]
-    (cmn/run-comparison
-     exp eid recipient compfile get-toolinfo template status)))
+    {:status status
+     :fut (cmn/run-comparison
+           exp eid recipient compfile get-toolinfo template status)}))

 (defmethod action :xcompare
   [_ eid params get-toolinfo template]
-  (let [status (atom "starting...")
+  (let [status (atom {:done []})
         exp (cmn/get-exp-info eid :exp)
         {:keys [user cmd phase modifier compfile]} params
         user (get-mail-recipient user)]
-    (cmn/run-comparison
-     exp eid user compfile get-toolinfo template status)))
+    {:status status
+     :fut (cmn/run-comparison
+           exp eid user compfile get-toolinfo template status)}))

 (defmethod action :aggregate
   [_ eid params get-toolinfo template]
-  (let [status (atom "starting...")
+  (let [status (atom {:done []})
         exp (cmn/get-exp-info eid :exp)
         {:keys [user cmd phase modifier compfile]} params
         recipient (pams/get-params [:email (keyword user)])]
-    (htts/run-aggregation
-     eid recipient compfile get-toolinfo template status)))
+    {:status status
+     :fut (htts/run-aggregation
+           eid recipient compfile get-toolinfo template status)}))

 (comment


turn off expensive logging

turn off expensive logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -100,9 +100,12 @@

      (remove #(= :fail %)))))

+(def expensive-logging false)
+
 (defn unify-and-log [a b model]
   (let [result (unify a b)]
-    (when (and (not (= :fail a)) (not (= :fail b)))
+    (when (and (not (= :fail a)) (not (= :fail b))
+               expensive-logging)
       (if (= :fail result)
         (let [message (str "failed to unify:( "
                            "  a: " ((:morph-ps model) a) ","
@@ -117,7 +120,7 @@
         (log/debug (str "unify(" ((:morph-ps model) a)
                         " , " ((:morph-ps model) b) ") => "
                         ((:morph-ps model) result)))))
-      result))
+    result))

 (defn comp-path-to-complements
   "return a lazy sequence of bolts for all possible complements


experimenting with spec

experimenting with spec

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -6,7 +6,7 @@
             [clojure.repl :refer [source dir doc]]
             [clojure.spec :as s]
             [clojure.spec.gen :as gen]
-            [clojure.walk :refer [keywordize-keys]]))
+            [clojure.set :refer [subset?]]))

 (defmacro dbg [body]
   `(let [x# ~body]
@@ -31,7 +31,7 @@
     (if-let
       [e (res "error")]
       (throw (IllegalStateException. e))
-      (keywordize-keys (res "result")))))
+      (res "result"))))

 (def hex-string? (partial re-matches #"[0-9a-fA-F]+"))
@@ -146,13 +146,14 @@
 (def-rpc setnetworkactive b)

 ;== Rawtransactions ==
-(s/def :unq/txid-opt
-  (s/keys :req-un [::txid ::vout]))
-(s/def :unq/address-amount
-  (s/keys :req-un [::address ::amount]))
-
-
-;TODO (s/fdef createrawtransaction :args (s/cat :txids (s/* :unq/txid-opt) :addresses :unq/address-amount))
+(s/def ::txid-opt (s/and map? #(subset? #{"txid" "vout"} (into #{} (keys %))) #(string? (% "txid")) #(integer? (% "vout"))))
+(s/def ::txid-opts (s/* ::txid-opt))
+(s/def ::address-amount (s/and map? #(every? string? (keys %)) #(every? double? (vals %))))
+(s/fdef createrawtransaction
+        :args (s/alt
+                :no-lock (s/cat :input ::txid-opts, :output ::address-amount)
+                :lock (s/cat :input ::txid-opts, :output ::address-amount, :locktime integer?))
+        :ret ::hex-string)
 (def-rpc-opt createrawtransaction 2 txids addresses locktime)

 (def-rpc decoderawtransaction hexstring)


Added an '-m' option to the run task that makes it behave similarly to the lein run task. The obvious caveat is that it'll run in the cake JVM. Not necessarily a caveat either though, since it'll execute immediately.

--- src/cake/tasks/eval.clj
+++ src/cake/tasks/eval.clj
@@ -32,11 +32,16 @@

 (deftask run #{compile-java}
   "Execute a script in the project jvm."
-  {[script] :run}
-  (bake [script (with-root *pwd* (str (file script)))
-         args   (rest (drop-while (partial not= script) *args*))]
-        (binding [*command-line-args* args]
-          (load-file script))))
+  {[script] :run m :m}
+  (if m
+    (bake [main (:main *project*)
+           args (remove #{"run" "-m"} *args*)]
+          (require main)
+          (-> (str main "/-main") symbol resolve (apply args)))
+    (bake [script (with-root *pwd* (str (file script)))
+           args   (rest (drop-while (partial not= script) *args*))]
+          (binding [*command-line-args* args]
+            (load-file *fi)))))

 (deftask repl #{compile-java}
   "Start an interactive shell with history and tab completion."


adding assertion back

adding assertion back

--- src/celestial/tasks.clj
+++ src/celestial/tasks.clj
@@ -20,7 +20,7 @@
      (.delete ct)
      (.create ct)
      (.start ct)
-     ;(assert (= (.status ct) "running"))
+     (assert (= (.status ct) "running"))
      (info "done system setup"))))

 (defn puppetize [{:keys [server module] :as spec} ]


Minor bug on drawarea.

Minor bug on drawarea.

--- src/uxbox/ui/workspace/drawarea.cljs
+++ src/uxbox/ui/workspace/drawarea.cljs
@@ -36,7 +36,7 @@
   [own]
   (let [shape (rum/react drawing-shape)
         position (rum/react drawing-position)]
-    (when shape
+    (when (and shape position)
       (-> (assoc shape :drawing? true)
           (geom/resize position)
           (uusc/render-shape identity)))))


Fix for lack of identity coercion

Fix for lack of identity coercion

For java.nio.file.Path

--- src/yada/resources/file_resource.clj
+++ src/yada/resources/file_resource.clj
@@ -155,7 +155,11 @@
   java.io.File
   (as-path [f] (when f (.toPath f)))
   String
-  (as-path [f] (when f (as-path (io/file f)))))
+  (as-path [s] (when s (as-path (io/file s))))
+  java.nio.file.Path
+  (as-path [p] p)
+  nil
+  (as-path [f] nil))

 (defn safe-relative-path
   "Given a parent java.nio.file.Path, return a child that is


use ~/.lein/cache/lein-protobuf instead of hijacking ~/.m2

--- lein-protobuf/src/leiningen/protobuf.clj
+++ lein-protobuf/src/leiningen/protobuf.clj
@@ -4,6 +4,7 @@
         [leiningen.help :only [help-for]]
         [leiningen.javac :only [javac]]
         [leiningen.core.eval :only [get-os]]
+        [leiningen.core.user :only [leiningen-home]]
         [robert.hooke :only [add-hook]])
   (:require [clojure.java.io :as io]
             [fs.core :as fs]
@@ -12,7 +13,7 @@
   (:import java.util.zip.ZipFile))

 (def version "2.3.0")
-(def cache   (format "%s/.m2/src/com/google/protobuf/%s" (System/getProperty "user.home") version))
+(def cache   (str (leiningen-home) "/cache/lein-protobuf"))
 (def zipfile (format "protobuf-%s.zip" version))
 (def srcdir  (format "%s/protobuf-%s" cache version))
 (def protoc  (format "%s/src/protoc" srcdir))


Adding sample key handlers for Q/W.

Adding sample key handlers for Q/W.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -1,12 +1,16 @@
 ; :mode=clojure:

 (ns hello
-    (:use
-        [goog.dom :only [appendChild createDom createTextNode removeChildren]]
-        [goog.events :only [listen]]
-        [goog.events.EventType :only [CLICK]]
-        [goog.graphics :only [createGraphics Stroke SolidFill Path]]
-        [goog :only [Timer]]
+    (:require
+        [goog.Timer :as Timer]
+        [goog.dom :as dom]
+        [goog.events :as events]
+        [goog.events.EventType :as EventType]
+        [goog.events.KeyCodes :as KeyCodes]
+        [goog.graphics :as graphics]
+        [goog.graphics.Stroke :as Stroke]
+        [goog.graphics.SolidFill :as SolidFill]
+        [goog.graphics.Path :as Path]
         ))

 (def my-code-url "https://github.com/pauldoo/scratch/blob/master/ClojureScript/hello.cljs")
@@ -114,38 +118,48 @@
         (fn [{keys :keys}]
             {:keys
                 (cond
-                    (= (.type event) goog.events.EventType/KEYUP)
+                    (= (.type event) EventType/KEYUP)
                         (disj keys (.keyCode event))
-                    (= (.type event) goog.events.EventType/KEYDOWN)
+                    (= (.type event) EventType/KEYDOWN)
                         (conj keys (.keyCode event))
                     :else keys)})))

-(defn tick-imp [state tick-step]
-    (assoc state :nodes
-        (update-node-positions
-            (update-node-velocities
-                (:nodes state)
-                (calculate-all-node-forces (:nodes state) (:springs state))
-                tick-step)
-            tick-step)))
+(defn tick-imp [state tick-step input-state]
+    (assoc state
+        :springs
+            (let [modifier (cond
+                    ((:keys input-state) KeyCodes/Q) 0.99
+                    ((:keys input-state) KeyCodes/W) 1.01
+                    :else 1.0)]
+                (map (fn [s]
+                    (assoc s :rest-length
+                        (* modifier (:rest-length s))))
+                        (:springs state)))
+        :nodes
+            (update-node-positions
+                (update-node-velocities
+                    (:nodes state)
+                    (calculate-all-node-forces (:nodes state) (:springs state))
+                    tick-step)
+                tick-step)))

 (defn tick [game-state-ref input-state] (do
-    (swap! game-state-ref #(tick-imp % tick-step))))
+    (swap! game-state-ref #(tick-imp % tick-step input-state))))

 (defn world-to-screen [[x y]]
     [x (- 275 y)])

 (defn draw-line [g x1 y1 x2 y2]
     (.drawPath g
-        (let [p (Path.)] (do
+        (let [p (goog.graphics.Path.)] (do
             (.moveTo p x1 y1)
             (.lineTo p x2 y2)
             p))
-        (Stroke. 1 "green") nil))
+        (goog.graphics.Stroke. 1 "green") nil))

 (defn rerender [canvas-element game-state]
     (let [
-        graphics (goog.graphics/createGraphics 400 300)
+        graphics (graphics/createGraphics 400 300)
         {nodes :nodes springs :springs} game-state]
         (do
             (apply draw-line graphics (apply concat (map world-to-screen [[0 0] [400 0]])))
@@ -157,9 +171,9 @@
                         (draw-line graphics x1 y1 x2 y2))) springs))
             (dorun (map
                 (fn [{p :pos}] (let [[x y] (world-to-screen p)]
-                    (.drawCircle graphics x y 3 (Stroke. 2 "green") (SolidFill. "yellow"))))
+                    (.drawCircle graphics x y 3 (goog.graphics.Stroke. 2 "green") (goog.graphics.SolidFill. "yellow"))))
                 (vals nodes)))
-            (goog.dom/removeChildren canvas-element)
+            (dom/removeChildren canvas-element)
             (.render graphics canvas-element)
             )))

@@ -167,26 +181,26 @@
     (let [
         game-state-ref (atom initial-game-state)
         input-state-ref (atom {:keys (set)})
-        canvas (goog.dom/createDom "div" {} "")
-        button (goog.dom/createDom "button" {} "Click!")
-        tick-timer (Timer. (Math/round (* 1000 tick-step)))
-        render-timer (Timer. (Math/round (* 1000 render-step)))
+        canvas (dom/createDom "div" {} "")
+        button (dom/createDom "button" {} "Click!")
+        tick-timer (goog.Timer. (Math/round (* 1000 tick-step)))
+        render-timer (goog.Timer. (Math/round (* 1000 render-step)))
         ]
         (do
             (. tick-timer (start))
             (. render-timer (start))
-            (dorun (map (partial apply goog.events/listen) [
-                [button goog.events.EventType/CLICK (partial input-event input-state-ref)]
-                [document.body goog.events.EventType/KEYDOWN (partial input-event input-state-ref) true]
-                [document.body goog.events.EventType/KEYUP (partial input-event input-state-ref) true]
-                [tick-timer goog.Timer/TICK #(tick game-state-ref (deref input-state-ref))]
-                [render-timer goog.Timer/TICK #(rerender canvas (deref game-state-ref))]]))
-            (goog.dom/appendChild document.body (goog.dom/createDom "div" {}
-                (goog.dom/createDom "h1" {} "Work in progress..")
-                (goog.dom/createDom "div" {} "Try clicking the button, or pressing keys.")
-                (goog.dom/createDom "div" {}
-                    (goog.dom/createTextNode "My code lives here: ")
-                    (goog.dom/createDom "a" (.strobj {"href" my-code-url}) my-code-url))
+            (dorun (map (partial apply events/listen) [
+                [button EventType/CLICK (partial input-event input-state-ref)]
+                [document.body EventType/KEYDOWN (partial input-event input-state-ref) true]
+                [document.body EventType/KEYUP (partial input-event input-state-ref) true]
+                [tick-timer Timer/TICK #(tick game-state-ref (deref input-state-ref))]
+                [render-timer Timer/TICK #(rerender canvas (deref game-state-ref))]]))
+            (dom/appendChild document.body (dom/createDom "div" {}
+                (dom/createDom "h1" {} "Work in progress..")
+                (dom/createDom "div" {} "Try clicking the button, or pressing keys.")
+                (dom/createDom "div" {}
+                    (dom/createTextNode "My code lives here: ")
+                    (dom/createDom "a" (.strobj {"href" my-code-url}) my-code-url))
                 button
                 canvas)))))


Track which keys are being held down.

Track which keys are being held down.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -8,12 +8,19 @@
         ))

 (def pos (atom 0))
+(def keys-pressed (atom (set)))

 (defn print-to-log [v]
     (.log js/console v))

-(defn foobar [canvas y event] (do
-    (print-to-log event)
+(defn foobar [t canvas y event] (do
+    (cond
+        (= t :up)
+            (swap! keys-pressed disj (.keyCode event))
+        (= t :down)
+            (swap! keys-pressed conj (.keyCode event))
+        :else
+            nil)
     (let [ctx (.getContext canvas "2d")
         x (swap! pos inc)]
         (do
@@ -33,9 +40,9 @@
             }) "")
         button (goog.dom/createDom "button" {} "Click!")]
         (do
-            (goog.events/listen button goog.events.EventType/CLICK (partial foobar canvas 100))
-            (goog.events/listen document.body goog.events.EventType/KEYDOWN (partial foobar canvas 50) true)
-            (goog.events/listen document.body goog.events.EventType/KEYUP (partial foobar canvas 150) true)
+            (goog.events/listen button goog.events.EventType/CLICK (partial foobar :click canvas 100))
+            (goog.events/listen document.body goog.events.EventType/KEYDOWN (partial foobar :down canvas 50) true)
+            (goog.events/listen document.body goog.events.EventType/KEYUP (partial foobar :up canvas 150) true)
             (dorun (map (partial goog.dom/appendChild document.body)
                 [(goog.dom/createDom "h1" {} "Hello!") canvas button])))))


fix utils path

fix utils path

--- internal/utils/project.clj
+++ internal/utils/project.clj
@@ -1,4 +1,4 @@
-(defn ver [] (-> "../samsara.version" slurp .trim))
+(defn ver [] (-> "../../samsara.version" slurp .trim))

 (defproject samsara/samsara-utils (ver)
   :description "Common utilities from Samsara's project"


Look for Canary ClojureScript version

Look for Canary ClojureScript version

--- planck-cljs/project.clj
+++ planck-cljs/project.clj
@@ -1,6 +1,7 @@
+(def clojurescript-version (or (System/getenv "CANARY_CLOJURESCRIPT_VERSION") "1.9.660"))
 (defproject planck "0.1.0"
   :profiles {:dev
-             {:dependencies [[org.clojure/clojurescript ~(or (System/getenv "CLOJURESCRIPT_VERSION") "1.9.660")]
+             {:dependencies [[org.clojure/clojurescript ~clojurescript-version]
                              [org.clojure/test.check "0.10.0-alpha2"]
                              [tubular "1.0.0"]]
               :source-paths ["dev"]}
@@ -9,7 +10,7 @@
              :build-commit
              {}}
   :dependencies [[org.clojure/clojure "1.8.0"]
-                 [org.clojure/clojurescript ~(or (System/getenv "CLOJURESCRIPT_VERSION") "1.9.660")]
+                 [org.clojure/clojurescript ~clojurescript-version]
                  [org.clojure/test.check "0.10.0-alpha2"]
                  [org.clojure/tools.reader "1.0.0"]
                  [com.cognitect/transit-clj "0.8.300"]


Add TODO for prefetch

Add TODO for prefetch

--- src/tree/core.clj
+++ src/tree/core.clj
@@ -171,6 +171,8 @@
   "Given a node on a path, find's that node's right successor node"
   [path]
   ;(clojure.pprint/pprint path)
+  ;TODO this function would benefit from a prefetching hint
+  ;     to keep the next several sibs in mem
   (when-let [common-parent-path
              (backtrack-up-path-until
                path


Fixed failing test.

Fixed failing test.

--- test/clj/cmr/client/tests/common/const.clj
+++ test/clj/cmr/client/tests/common/const.clj
@@ -4,4 +4,4 @@
    [cmr.client.common.const :as const]))

 (deftest default-environment-type
-  (is (= :prod const/default-environment-type)))
+  (is (= :local const/default-environment-type)))


Bump storm version.

Bump storm version.


remove backtick

remove backtick


[WM] Try an experimental datomic-toolbox version

...that puts the connection into an atom to avoid calling
datomic.api/connect more than once. I want to see if this has an impact
on the intermittent ~5 second delays we've been seeing and traced to the
datomic-toolbox.core/db calls (which used to call datomic.api/connect
every time, relying on its supposed caching mechanism).


Bump to 0.1.0

Bump to 0.1.0


Fix project.clj typo.

Fix project.clj typo.


add output dir as well

add output dir as well


Release version 0.10.0.0-beta5.

Release version 0.10.0.0-beta5.


🚨 Run tests with --illegal-access=deny

🚨 Run tests with --illegal-access=deny

Why:
- The same option is used also in production
- JVM used to give a warning:

WARNING: Illegal reflective access by org.xnio.nio.NioXnio$2 (file:/Users/esko/.m2/repository/org/jboss/xnio/xnio-nio/3.3.6.Final/xnio-nio-3.3.6.Final.jar) to constructor sun.nio.ch.KQueueSelectorProvider()
WARNING: Please consider reporting this to the maintainers of org.xnio.nio.NioXnio$2
WARNING: Use --illegal-access=warn to enable warnings of further illegal reflective access operations
WARNING: All illegal access operations will be denied in a future release


Full stack with data-specs

Full stack with data-specs

--- examples/ring-swagger/src/example/server.clj
+++ examples/ring-swagger/src/example/server.clj
@@ -2,13 +2,11 @@
   (:require [reitit.ring :as ring]
             [reitit.swagger :as swagger]
             [reitit.swagger-ui :as swagger-ui]
-            [reitit.ring.coercion :as rrc]
-            [reitit.coercion.spec :as spec]
-            [reitit.coercion.schema :as schema]
+            [reitit.ring.coercion :as coercion]
+            [reitit.coercion.spec]
             [reitit.ring.middleware.muuntaja :as muuntaja]
-
-            [schema.core :refer [Int]]
-
+            [reitit.ring.middleware.exception :as exception]
+            [ring.middleware.params :as params]
             [ring.adapter.jetty :as jetty]
             [ring.middleware.params]
             [muuntaja.core :as m]))
@@ -16,16 +14,13 @@
 (def app
   (ring/ring-handler
     (ring/router
-      ["/api"
-
-       ["/swagger.json"
+      [["/swagger.json"
         {:get {:no-doc true
                :swagger {:info {:title "my-api"}}
                :handler (swagger/create-swagger-handler)}}]

-       ["/spec"
-        {:coercion spec/coercion
-         :swagger {:tags ["spec"]}}
+       ["/math"
+        {:swagger {:tags ["math"]}}

         ["/plus"
          {:get {:summary "plus with spec query parameters"
@@ -39,36 +34,26 @@
                  :responses {200 {:body {:total int?}}}
                  :handler (fn [{{{:keys [x y]} :body} :parameters}]
                             {:status 200
-                             :body {:total (+ x y)}})}}]]
-
-       ["/schema"
-        {:coercion schema/coercion
-         :swagger {:tags ["schema"]}}
-
-        ["/plus"
-         {:get {:summary "plus with schema query parameters"
-                :parameters {:query {:x Int, :y Int}}
-                :responses {200 {:body {:total Int}}}
-                :handler (fn [{{{:keys [x y]} :query} :parameters}]
-                           {:status 200
-                            :body {:total (+ x y)}})}
-          :post {:summary "plus with schema body parameters"
-                 :parameters {:body {:x Int, :y Int}}
-                 :responses {200 {:body {:total Int}}}
-                 :handler (fn [{{{:keys [x y]} :body} :parameters}]
-                            {:status 200
                              :body {:total (+ x y)}})}}]]]

-      {:data {:muuntaja m/instance
-              :middleware [ring.middleware.params/wrap-params
-                           muuntaja/format-middleware
-                           swagger/swagger-feature
-                           rrc/coerce-exceptions-middleware
-                           rrc/coerce-request-middleware
-                           rrc/coerce-response-middleware]}})
+      {:data {:coercion reitit.coercion.spec/coercion
+              :muuntaja m/instance
+              :middleware [;; query-params & form-params
+                           params/wrap-params
+                           ;; content-negotiation
+                           muuntaja/format-negotiate-middleware
+                           ;; encoding response body
+                           muuntaja/format-response-middleware
+                           ;; exception handling
+                           exception/exception-middleware
+                           ;; decoding request body
+                           muuntaja/format-request-middleware
+                           ;; coercing response bodys
+                           coercion/coerce-response-middleware
+                           ;; coercing request parameters
+                           coercion/coerce-request-middleware]}})
     (ring/routes
-      (swagger-ui/create-swagger-ui-handler
-        {:path "/", :url "/api/swagger.json"})
+      (swagger-ui/create-swagger-ui-handler {:path "/"})
       (ring/create-default-handler))))

 (defn start []


fix symbol collision by preferring most recently parsed form (cljs over clj due to parse order)

--- src/core.clj
+++ src/core.clj
@@ -670,7 +670,8 @@
   [item]
   (let [filename (str (item-filename item) ".cljsdoc")
         cljsdoc-content (make-cljsdoc item)]
-    (spit filename cljsdoc-content :append true)))
+    (spit filename cljsdoc-content) ;; use `:append true` to see overwrites
+    ))

 (defn dump-api-docs!
   [api]


Add print-method preference

Add print-method preference

--- src/tick/core.clj
+++ src/tick/core.clj
@@ -563,6 +563,7 @@
   (clock [_] @*clock))

 (prefer-method print-method clojure.lang.IPersistentMap clojure.lang.IDeref)
+(prefer-method print-method java.util.Map clojure.lang.IDeref)

 (defn atom
   ([clk] (->AtomicClock (clojure.core/atom clk)))


block tags do, in fact, need their contents to be parsed

--- src/clabango/parser.clj
+++ src/clabango/parser.clj
@@ -164,14 +164,18 @@
                                                           context)]
                (concat (if-not (coll? s-or-nodes)
                          (parse s-or-nodes new-context)
-                         ;; TODO: determine if this reparsing is necessary?
-                         s-or-nodes #_(ast->parsed s-or-nodes new-context))
+                         ;; TODO: this will go all the way to realizing vars
+                         ;; which is probably too much, for instance if the
+                         ;; block tag wants to set something in the context
+                         ;; and then include another template, does realizing
+                         ;; vars here break that or make it possible?
+                         (ast->parsed s-or-nodes new-context))
                        (interpret-tags rest-ast context))))
            (let [[s-or-nodes new-context] (template-tag (:tag-name node) [node]
                                                         context)]
              (concat (if-not (coll? s-or-nodes)
                        (parse s-or-nodes new-context)
-                       s-or-nodes #_(ast->parsed s-or-nodes new-context))
+                       (ast->parsed s-or-nodes new-context))
                      (interpret-tags (rest ast) new-context)))))
        (cons node (interpret-tags (rest ast) context))))))


Removed unused pool statistics function.

--- src/clj_ldap/client.clj
+++ src/clj_ldap/client.clj
@@ -8,7 +8,6 @@
             LDAPConnection
             ResultCode
             LDAPConnectionPool
-            LDAPConnectionPoolStatistics
             LDAPException
             Attribute
             Entry
@@ -324,11 +323,6 @@
       (connect-to-hosts options)
       (connect-to-host options))))

-(defn connection-pool-stats
-  [connection-pool]
-  (let [statistics (.LDAPConnectionPoolStatistics connection-pool)]
-  (.toString statistics)))
-
 (defn get-connection
   "Retrieves an LDAP connection from the pool."
   [connection-pool]
@@ -346,7 +340,7 @@
    If called with an LDAP connection, and the bind request is successful,
    it will change the identity of that connection."
     [connection bind-dn password]
-    (.bind connection (bind-request {:bind-dn bind-dn :password password})))
+    (.bind connection bind-dn password))

 (defn get
   "If successful, returns a map containing the entry for the given DN.
@@ -404,7 +398,7 @@
 (defn modify-password
   "Creates a new password modify extended request that will attempt to change
    the password of the currently-authenticated user, or another user if their
-   DN is provided."
+   DN is provided and the caller has the required authorisation."
   ([connection new]
     (let [request (PasswordModifyExtendedRequest. new)]
       (.processExtendedOperation connection request)))


Always cast arg of fill/stroke to float. Fix #331.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -1706,7 +1706,7 @@
    (cond (vector? gray) (apply fill gray)
          (nil? gray) (no-fill)
          true (do
-                (.fill (current-graphics) gray)
+                (.fill (current-graphics) (float gray))
                 (save-current-fill [gray]))))

   ([gray alpha]
@@ -4112,7 +4112,7 @@
    (cond (vector? gray) (apply stroke gray)
          (nil? gray) (no-stroke)
          true (do
-                (.stroke (current-graphics)  gray)
+                (.stroke (current-graphics)  (float gray))
                 (save-current-stroke [gray]))))
   ([gray alpha]
    (.stroke (current-graphics) (float gray) (float alpha))


Refinements to the chart and initial drawing utils, basic chart layout

--- src/cljs/aved/core.cljs
+++ src/cljs/aved/core.cljs
@@ -44,10 +44,33 @@
     (.subscribe (fn [xysin]
                   (.log js/console (str xysin)))))

-(defn fill-rect [x y color]
+
+;;ctx.beginPath();
+;;ctx.arc(100,75,50,0,2*Math.PI);
+;;ctx.stroke(); ;; draws the border line
+;; arc (x, y, radius, start angle[rad], ending angle[rad])
+(defn fill-circle [x y color size]
+  (set! (.-fillStyle ctx) color)
+  (set! (.-lineWidth ctx) 0)
+  (.beginPath ctx)
+  (.arc ctx x y size 0 (* 2 Math/PI))
+  (.fill ctx)
+  )
+
+(fill-circle 300 300 "red" 20)
+(fill-circle 300 300 "yellow" 10)
+(fill-circle 300 300 "blue" 5)
+
+(defn fill-rect [x y color pixel]
   (set! (.-fillStyle ctx) color)
   (.fillRect ctx x y 2 2))

+;; fill rect for 1 pixel size
+(defn fill-rect1 [x y color]
+  (fill-rect x y color 1))
+
+(defn fill-rect2 [x y color]
+  (fill-rect x y color 2))

 (def color (.map sine-wave
@@ -70,20 +93,12 @@

 (def mouse-click (from-event canvas "click"))

-(def cycle-color
-  (tconcat (.takeUntil red mouse-click)
-          (defer #(tconcat (.takeUntil blue mouse-click)
-                          cycle-color))))
-
-(-> (.zip sine-wave cycle-color #(vector % %2))
-    (.take 600)
-    (.subscribe (fn [[{:keys [x y]} color]]
-                  (fill-rect x y color))))
+(def mouse-over (from-event canvas "over"))

 (defn write-text []
   (set! (.-font ctx) "20px Arial")
   (set! (.-fillStyle ctx) "white")
-  (.fillText ctx "Drugs" 530 780))
+  (.fillText ctx "Drugs" 780 780))

 (write-text)

@@ -108,8 +123,42 @@
 (defn write-coordinate-labels []
   ())

-
 (write-rotated-text)

 (.log js/console "test new line ")
 (.log js/console (str "Math.PI value:" Math/PI))
+
+;;     context.beginPath();
+;;      context.moveTo(100, 150);
+;;      context.lineTo(450, 50);
+;;      context.stroke();
+(defn draw-line [x1 y1 x2 y2]
+  (.beginPath ctx)
+  (.moveTo ctx x1 y1)
+  (.lineTo ctx x2 y2)
+  (set! (.-strokeStyle ctx) "#B4B4B4")
+  (.stroke ctx))
+
+(def horizontal-grid-lines [{:x1 1450 :y1 600 :x2 150 :y2 600}])
+(def vertical-grid-lines [{:x1 200 :y1 650 :x2 200 :y2 50 }])
+(def horizontal-lines 6)
+(def vertical-lines 13)
+
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
+  (do
+    (.log js/console (str "x1=" x1 " y1=" y1 " x2=" x2 " y2=" y2))
+    (draw-line x1 y1 x2 y2)))
+
+;;
+;; draw the horizontal grid lines
+;;
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} horizontal-grid-lines]
+  (dotimes [n horizontal-lines] (.log js/console "Index: " n)
+           (draw-line x1 (- y1 (* n 100)) x2 (- y2 (* n 100)))))
+
+;;
+;; draw the vertical grid lines
+;;
+(doseq [{x1 :x1 y1 :y1 x2 :x2 y2 :y2} vertical-grid-lines]
+  (dotimes [n vertical-lines] (.log js/console "Index: " n)
+           (draw-line (+ x1 (* n 100)) y1 (+ x2 (* n 100)) y2)))