Updated Mirror Image for behaviors

Updated Mirror Image for behaviors

--- src/clojush/problems/software/mirror_image.clj
+++ src/clojush/problems/software/mirror_image.clj
@@ -94,38 +94,6 @@
                 (= (first %) (vec (reverse (second %)))))
        inputs))

-(defn make-mirror-image-error-function-from-cases
-  [train-cases test-cases]
-  (fn the-actual-mirror-image-error-function
-    ([program]
-      (the-actual-mirror-image-error-function program :train))
-    ([program data-cases] ;; data-cases should be :train or :test
-                          (the-actual-mirror-image-error-function program data-cases false))
-    ([program data-cases print-outputs]
-      (let [behavior (atom '())
-            errors (doall
-                     (for [[[input1 input2] correct-output] (case data-cases
-                                                              :train train-cases
-                                                              :test test-cases
-                                                              [])]
-                       (let [final-state (run-push program
-                                                   (->> (make-push-state)
-                                                     (push-item input2 :input)
-                                                     (push-item input1 :input)))
-                             result (top-item :boolean final-state)]
-                         (when print-outputs
-                           (println (format "Correct output: %5b | Program output: %s" correct-output (str result))))
-                         ; Record the behavior
-                         (when @global-print-behavioral-diversity
-                           (swap! behavior conj result))
-                         ; Error is boolean error
-                         (if (= result correct-output)
-                           0
-                           1))))]
-        (when @global-print-behavioral-diversity
-          (swap! population-behaviors conj @behavior))
-        errors))))
-
 (defn get-mirror-image-train-and-test
   "Returns the train and test cases."
   [data-domains]
@@ -135,6 +103,46 @@
 ; Define train and test cases
 (def mirror-image-train-and-test-cases
   (get-mirror-image-train-and-test mirror-image-data-domains))
+
+(defn mirror-image-evaluate-program-for-behaviors
+  "Evaluates the program on the given list of cases.
+   Returns the behaviors, a list of the outputs of the program on the inputs."
+  [program cases]
+  (doall
+   (for [[[input1 input2] output] cases]
+     (let [final-state (run-push program
+                                 (->> (make-push-state)
+                                      (push-item input2 :input)
+                                      (push-item input1 :input)))]
+       (top-item :boolean final-state)))))
+
+(defn mirror-image-errors-from-behaviors
+  "Takes a list of behaviors across the list of cases and finds the error
+   for each of those behaviors, returning an error vector."
+  [behaviors cases]
+  (map (fn [result correct-output]
+         (if (= result correct-output)
+           0
+           1))
+       behaviors
+       (map second cases)))
+
+(defn mirror-image-error-function
+  "The error function. Takes an individual as input,
+   and returns that individual with :errors and :behaviors set."
+  ([individual]
+   (mirror-image-error-function individual :train))
+  ([individual data-cases] ;; data-cases should be :train or :test
+   (let [cases (case data-cases
+                 :train (first mirror-image-train-and-test-cases)
+                 :test (second mirror-image-train-and-test-cases)
+                 [])
+         behaviors (mirror-image-evaluate-program-for-behaviors (:program individual)
+                                                                 cases)
+         errors (mirror-image-errors-from-behaviors behaviors cases)]
+     (cond
+       (= data-cases :train) (assoc individual :behaviors behaviors :errors errors)
+       (= data-cases :test) (assoc individual :test-errors errors)))))

 (defn mirror-image-initial-report
   [argmap]
@@ -149,7 +157,8 @@
   "Custom generational report."
   [best population generation error-function report-simplifications]
   (let [best-program (not-lazy (:program best))
-        best-test-errors (error-function best-program :test)
+        best-with-test (error-function best :test)
+        best-test-errors (:test-errors best-with-test)
         best-total-test-error (apply +' best-test-errors)]
     (println ";;******************************")
     (printf ";; -*- Mirror Image problem report - generation %s\n" generation)(flush)
@@ -162,7 +171,10 @@
         (println (format "Test Case  %3d | Error: %s" i (str error)))))
     (println ";;------------------------------")
     (println "Outputs of best individual on training cases:")
-    (error-function best-program :train true)
+    (doseq [[correct-output result] (map vector
+                                         (map second (first mirror-image-train-and-test-cases))
+                                         (:behaviors best))]
+      (println (format "Correct output: %5b | Program output: %s" correct-output (str result))))
     (println ";;******************************")
     )) ;; To do validation, could have this function return an altered best individual
        ;; with total-error > 0 if it had error of zero on train but not on validation
@@ -171,8 +183,7 @@

 ; Define the argmap
 (def argmap
-  {:error-function (make-mirror-image-error-function-from-cases (first mirror-image-train-and-test-cases)
-                                                                (second mirror-image-train-and-test-cases))
+  {:error-function mirror-image-error-function
    :atom-generators mirror-image-atom-generators
    :max-points 1200
    :max-genome-size-in-initial-program 150
@@ -190,7 +201,6 @@
    :uniform-mutation-rate 0.01
    :problem-specific-report mirror-image-report
    :problem-specific-initial-report mirror-image-initial-report
-   :print-behavioral-diversity true
    :report-simplifications 0
    :final-report-simplifications 5000
    :max-error 1


STORM-2101: fixes npe in compute-executors in nimbus

--- storm-core/src/clj/org/apache/storm/daemon/nimbus.clj
+++ storm-core/src/clj/org/apache/storm/daemon/nimbus.clj
@@ -637,16 +637,17 @@
         storm-conf (read-storm-conf-as-nimbus storm-id blob-store)
         topology (read-storm-topology-as-nimbus storm-id blob-store)
         task->component (get-clojurified-task-info topology storm-conf)]
-    (->> (StormCommon/stormTaskInfo topology storm-conf)
-         (Utils/reverseMap)
-         clojurify-structure
-         (map-val sort)
-         ((fn [ & maps ] (Utils/joinMaps (into-array Map (into [component->executors] maps)))))
-         (clojurify-structure)
-         (map-val (partial apply (fn part-fixed [a b] (Utils/partitionFixed a b))))
-         (mapcat second)
-         (map to-executor-id)
-         )))
+    (if (nil? component->executors)
+      []
+      (->> (StormCommon/stormTaskInfo topology storm-conf)
+           (Utils/reverseMap)
+           clojurify-structure
+           (map-val sort)
+           ((fn [ & maps ] (Utils/joinMaps (into-array Map (into [component->executors] maps)))))
+           (clojurify-structure)
+           (map-val (partial apply (fn part-fixed [a b] (Utils/partitionFixed a b))))
+           (mapcat second)
+           (map to-executor-id)))))

 (defn- compute-executor->component [nimbus storm-id]
   (let [conf (:conf nimbus)


(PDB-3427) Ignore order of resource_events in generative tests

The database can return these in arbitrary orders, at times.

--- test/puppetlabs/puppetdb/generative/submit_command.clj
+++ test/puppetlabs/puppetdb/generative/submit_command.clj
@@ -76,7 +76,8 @@
               (-> row
                   (update :logs #(json/parse (str %) true))
                   (update :metrics #(json/parse (str %) true))
-                  (update :resource_events #(json/parse (str %) true)))))))
+                  (update :resource_events #(json/parse (str %) true))
+                  (update-in [:resource_events :data] #(into #{} %)))))))

 (defn all-nodes [db]
   (qeng/stream-query-result :v4


Get rid of commented out code

Get rid of commented out code


use a tooltip for not creator

use a tooltip for not creator

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -293,44 +293,45 @@
           (case cant-edit-reason
             :no-private-docs-flag
             [:div.vein.make.stick
-             (common/icon (if private? :lock :globe))
              [:a {:href "/pricing"}
-              "Start your trial to create private docs"]]
-            :not-creator
-            [:div.vein.make.stick
-             (common/icon (if private? :lock :globe))
-             "Only the creator can change privacy"]
+              "Start your trial to create private docs"]
+             (common/icon (if private? :lock :globe))]
+
             [:form.privacy-select.vein.make.stick
-             [:input.privacy-radio
-              {:type "radio"
-               :hidden "true"
-               :id "privacy-public"
-               :name "privacy"
-               :checked (not private?)
-               :onChange #(if cant-edit-reason
-                            (utils/stop-event %)
-                            (cast! :document-privacy-changed
-                                   {:doc-id doc-id
-                                    :setting :document.privacy/public}))}]
-             [:label.privacy-label
-              {:for "privacy-public"
-               :role "button"}
+             [:input.privacy-radio {:type "radio"
+                                    :hidden "true"
+                                    :id "privacy-public"
+                                    :name "privacy"
+                                    :checked (not private?)
+                                    :disabled (boolean cant-edit-reason)
+                                    :onChange #(if cant-edit-reason
+                                                 (utils/stop-event %)
+                                                 (cast! :document-privacy-changed
+                                                        {:doc-id doc-id
+                                                         :setting :document.privacy/public}))}]
+             [:label.privacy-label {:class (when cant-edit-reason "disabled")
+                                    :for "privacy-public"
+                                    :role "button"
+                                    :data-top (when (= :not-creator cant-edit-reason)
+                                                "Only the creator can change privacy.")}
               (common/icon :globe)
               [:span "Public"]]
-             [:input.privacy-radio
-              {:type "radio"
-               :hidden "true"
-               :id "privacy-private"
-               :name "privacy"
-               :checked private?
-               :onChange #(if cant-edit-reason
-                            (utils/stop-event %)
-                            (cast! :document-privacy-changed
-                                   {:doc-id doc-id
-                                    :setting :document.privacy/private}))}]
-             [:label.privacy-label
-              {:for "privacy-private"
-               :role "button"}
+             [:input.privacy-radio {:type "radio"
+                                    :hidden "true"
+                                    :id "privacy-private"
+                                    :name "privacy"
+                                    :checked private?
+                                    :disabled (boolean cant-edit-reason)
+                                    :onChange #(if cant-edit-reason
+                                                 (utils/stop-event %)
+                                                 (cast! :document-privacy-changed
+                                                        {:doc-id doc-id
+                                                         :setting :document.privacy/private}))}]
+             [:label.privacy-label {:class (when cant-edit-reason "disabled")
+                                    :for "privacy-private"
+                                    :role "button"
+                                    :data-top (when (= :not-creator cant-edit-reason)
+                                                "Only the creator can change privacy.")}
               (common/icon :lock)
               [:span "Private"]]])])))))


CMR-2808 Allow UserType as well as Group guid for creating ACLs

--- transmit-lib/src/cmr/transmit/echo/soap/access_control.clj
+++ transmit-lib/src/cmr/transmit/echo/soap/access_control.clj
@@ -13,8 +13,11 @@
   ;; vector with no element name string causes an error, but a sequence of vectors works properly.
   ;; Update this if we think of a better way.
   (seq [["ns3:Sid"
-          ["ns3:GroupSid"
-            ["ns3:GroupGuid" group-guid]]]
+          (if (or (= group-guid "GUEST") (= group-guid "REGISTERED"))
+            ["ns3:UserAuthorizationTypeSid"
+              ["ns3:UserAuthorizationType" group-guid]]
+            ["ns3:GroupSid"
+              ["ns3:GroupGuid" group-guid]])]
         ["ns3:Permissions" (soap/item-list permissions)]]))

 (defn generate-system-access-control-list


save via CMD-s keyboard shortcut

save via CMD-s keyboard shortcut

--- iwaswhere-web/src/cljs/iwaswhere_web/markdown.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/markdown.cljs
@@ -45,9 +45,18 @@
         update-temp-fn (fn [ev]
                          (let [cursor-pos {:cursor-pos (.-anchorOffset (.getSelection js/window))}
                                updated (with-meta (merge entry (h/parse-entry (get-content ev))) cursor-pos)]
-                           (put-fn [:update/temp-entry {:timestamp ts :updated updated}])))]
+                           (put-fn [:update/temp-entry {:timestamp ts :updated updated}])))
+        on-keydown-fn (fn [ev] (let [key-code (.. ev -keyCode)
+                                     meta-key (.. ev -metaKey)]
+                                 (when (and meta-key (= key-code 83))
+                                   (put-fn [:text-entry/update temp-entry])
+                                   (.preventDefault ev)))
+                        )]
     [:div.edit-md
-     [:pre [:code {:content-editable true :on-input update-temp-fn} md-string]]
+     [:pre [:code {:content-editable true
+                   :on-input         update-temp-fn
+                   :on-key-down      on-keydown-fn}
+            md-string]]
      (when temp-entry
        (let [cursor-pos (:cursor-pos (meta temp-entry))
              md (:md temp-entry)


Fix project add behavior. Hive modal. Fix order of projects.

--- src/cljs/hatnik/web/client/z_actions.cljs
+++ src/cljs/hatnik/web/client/z_actions.cljs
@@ -22,25 +22,30 @@
             :async true
             :success callback}))

+(defn common-update-callback [msg data reply]
+  (let [resp (js->clj reply)]
+    (if (= "ok" (get resp "result"))
+      (state/update-all-view)
+      (js/alert msg))))
+
 (defn create-new-project-callback [name reply]
   (let [resp (js->clj reply)]
     (when (= "ok" (get resp "result"))
-      (state/add-new-project (get resp "id") name))))
+      (state/update-all-view))))

 (defn send-new-project-request []
   (let [name (.-value (.getElementById js/document "project-name-input"))]
     (if (= "" name)
       (js/alert "Project name must be not empty!")
-      (ajax  "/api/projects" "POST" {:name name} #(create-new-project-callback name %)))))
+      (do
+        (.modal ($ :#iModalProject) "hide")
+        (ajax  "/api/projects" "POST" {:name name} #(create-new-project-callback name %))))))

 (defn create-new-email-action-callback [data reply]
   (let [resp (js->clj reply)]
     (when (= "ok" (get resp "result"))
-      (state/update-project-actions (assoc data
-                                      "id" (get resp "id")
-                                      "last-processed-version" (get rest "last-processed-version"))))))
-
+      (state/update-all-view))))

 (defn send-new-email-action [project-id]
   (let [artifact (get-data-from-input "artifact-input")
@@ -83,13 +88,6 @@
       (ajax "/api/actions/test" "POST" data
             (wrap-error-alert (fn [e]))))))

-
-(defn common-update-callback [msg data reply]
-  (let [resp (js->clj reply)]
-    (if (= "ok" (get resp "result"))
-      (state/update-all-view)
-      (js/alert msg))))
-
 (defn update-email-action [project-id action-id]
     (let [artifact (get-data-from-input "artifact-input")
           email (get-data-from-input "emain-input")
@@ -112,15 +110,12 @@
          data (wrap-error-alert
                #(common-update-callback "Action don't updated!" data %)))))))

-
 (defn delete-action [action-id]
   (.modal ($ :#iModal) "hide")
   (ajax
    (str "/api/actions/" action-id) "DELETE"
    {} (wrap-error-alert
        #(common-update-callback "Action don't deleted!" {} %))))
-
-

 (defn delete-project []
   (let [project-id (:current-project (deref state/app-state))]


(PE-4808) Changed `ns-comment` to `netscape-comment`

This commit changes the name of the `ns-comment` function to
`netscape-comment` in hopes of making its purpose more obvious.

--- src/clj/puppetlabs/master/certificate_authority.clj
+++ src/clj/puppetlabs/master/certificate_authority.clj
@@ -66,7 +66,7 @@
   "The parent OID for all Puppet Labs specific X.509 certificate extensions."
   "1.3.6.1.4.1.34380.1")

-(def ns-comment
+(def netscape-comment
   "Standard value applied to the Netscape Comment extension for certificates"
   "Puppet Server Internal Certificate")

@@ -240,7 +240,7 @@
    ca-serial :- (schema/pred number?)
    ca-public-key :- (schema/pred utils/public-key?)]
   [(utils/netscape-comment
-     ns-comment)
+     netscape-comment)
    (utils/authority-key-identifier
      ca-name ca-serial false)
    (utils/basic-constraints-for-ca)
@@ -309,7 +309,7 @@
                                (conj dns-alt-names-list master-certname) false))
         alt-names-ext-list (if alt-names-ext [alt-names-ext] [])
         base-ext-list      [(utils/netscape-comment
-                              ns-comment)
+                              netscape-comment)
                             (utils/authority-key-identifier
                               ca-public-key false)
                             (utils/basic-constraints-for-non-ca true)
@@ -535,7 +535,7 @@
         csr-ext-list (filter-authorized-extensions
                        (utils/get-extensions csr))
         base-ext-list [(utils/netscape-comment
-                         ns-comment)
+                         netscape-comment)
                        (utils/authority-key-identifier
                          capub false)
                        (utils/basic-constraints-for-non-ca true)


Adjust orchestration path for new location

--- src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
@@ -148,7 +148,7 @@
                          (call-external-object-method :getAuthResponse)
                          (aget "access_token"))]
     (ajax (assoc
-           arg-map :url (str "/api" path)
+           arg-map :url (str "/service/api" path)
            :headers (merge {"Authorization" (str "Bearer " access-token)}
                            (:headers arg-map))))))


Fix tuple-of

Fix tuple-of

--- src/clojure/clojurewerkz/cassaforte/query/types.clj
+++ src/clojure/clojurewerkz/cassaforte/query/types.clj
@@ -1,5 +1,5 @@
 (ns clojurewerkz.cassaforte.query.types
-  (:import [com.datastax.driver.core TupleType DataType]))
+  (:import [com.datastax.driver.core TupleType DataType ProtocolVersion CodecRegistry]))

 ;;
 ;; Types
@@ -48,7 +48,8 @@
   (DataType/map (get primitive-types key-type)
                 (get primitive-types value-type)))

+;; FIXME should be using cluster instance and cluster.metadata.newTupleType instead
 (defn tuple-of
-  [types values]
-  (.newValue (TupleType/of (into-array (map #(get primitive-types %) types)))
+  [^ProtocolVersion protocol-version types values]
+  (.newValue (TupleType/of protocol-version CodecRegistry/DEFAULT_INSTANCE ((into-array (map #(get primitive-types %) types))))
              (object-array values)))


fix generation of large numbers of measurements.

Continues the previous commit to Work around lazyness vs loop/recur.

--- src/kixi/hecuba/data/measurements/download.clj
+++ src/kixi/hecuba/data/measurements/download.clj
@@ -81,8 +81,8 @@
 (defn indexes-of [v xs]
   (set (keep-indexed (fn [i x] (when (= x v) i)) xs)))

-(defn measurements->columns [ms]
-  (map (fn [[{:keys [timestamp value]} & more]] (apply vector timestamp value (map :value more))) ms))
+(defn measurements->columns [[{:keys [timestamp value]} & more]]
+  (apply vector timestamp value (map :value more)))

 (defn filled-measurements [measurements out]
   (let [sentinel         (Object.)
@@ -104,8 +104,9 @@
                                                        (assoc x :timestamp row-timestamp)
                                                        (hash-map :timestamp row-timestamp :value nil))) row)
                 fns            (map-indexed (fn [i _] (if (has-data? i) next-or-sentinel identity)) row)
-                step           (fn [xs] (map (fn [f v] (f v)) fns xs))]
-            (csv/write-csv out (map measurements->columns out-row))
+                step           (fn [xs] (map (fn [f v] (f v)) fns xs))
+                cols           (measurements->columns out-row)]
+            (csv/write-csv out [cols])
             (recur (step ms))))))))


implement js* parsing

implement js* parsing

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -13,7 +13,7 @@
              :as ana
              :refer [analyze analyze-in-env]
              :rename {analyze -analyze}]
-            [clojure.tools.analyzer.utils :refer [resolve-var ctx]]
+            [clojure.tools.analyzer.utils :refer [resolve-var ctx -source-info]]
             cljs.tagged-literals)
   (:import cljs.tagged_literals.JSValue))

@@ -143,6 +143,29 @@
   [form env]
   (parse-type :defrecord form env))

+;; no ~{foo} support since cljs itself doesn't use it anywhere
+(defmethod parse 'js*
+  [[_ jsform & args :as form] env]
+  (when-not (string? jsform)
+    (throw (ex-info "Invalid js* form"
+                    (merge {:form form}
+                           (-source-info form env)))))
+  (let [segs  (loop [segs [] ^String s jsform]
+                (let [idx (.indexOf s "~{")]
+                  (if (= -1 idx)
+                    (conj segs s)
+                    (recur (conj segs (subs s 0 idx))
+                           (subs s (inc (.indexOf s "}" idx)))))))
+        exprs (mapv (analyze-in-env (ctx env :expr)) args)]
+    (merge
+     {:op       :js
+      :env      env
+      :form     form
+      :segs     segs}
+     (when args
+       {:args     exprs
+        :children [:args]}))))
+
 (defn analyze
   ([form] (analyze form (empty-env) {}))
   ([form env] (analyze form env {}))


"Solved the problem of not enough fixed..."

...in the source of my endless misery - the Tags.

--- lambda-blog/src/lambda_blog/templates/archives.clj
+++ lambda-blog/src/lambda_blog/templates/archives.clj
@@ -6,9 +6,9 @@

 (defn archive-entry
   "Creates a single row of the archives table containing various entry details."
-  [{:keys [path path-to-root summary tags timestamp title]}]
+  [path-to-root {:keys [path summary tags timestamp title]}]
   (tr (td (format-time "YYYY-MM-dd HH:mm" timestamp))
-      (td (a {:href (pathcat path)} title))
+      (td (a {:href (pathcat path-to-root path)} title))
       (td (separate-with " "
                          (map #(a {:class :tag
                                    :href (pathcat path-to-root (:path %))}
@@ -18,7 +18,7 @@

 (defn archives
   "Creates an HTML page containing a table of `entries`."
-  [{:keys [entries] :as ent}]
+  [{:keys [entries path-to-root] :as ent}]
   (page
    (fn [_]
      [(-> "Archives" h1 text-centered row panel)
@@ -28,7 +28,7 @@
                              (th (span "Tags"))
                              (th {:class [:hidden-xs :hidden-sm]}
                                  (span "Summary"))))
-                  (tbody (map archive-entry
+                  (tbody (map (partial archive-entry path-to-root)
                               (reverse (sort-by :timestamp entries))))))
       (p {:class [:hidden-xs :hidden-sm]}
          (warning-label "ProTip:")


fix typo in made with post

fix typo in made with post

--- src/pc/views/blog/ideas_are_made_with_precursor.clj
+++ src/pc/views/blog/ideas_are_made_with_precursor.clj
@@ -112,7 +112,7 @@

     [:article
      [:h3 "I'd wear that."]
-     [:p  "To thank them for showing off their work, everyone featured today will recieve a free t-shirt displaying their unique designs. "]
+     [:p  "To thank them for showing off their work, everyone featured today will receive a free t-shirt displaying their unique designs. "]
      [:p  "Got something interesting, made with " [:a {:href "/new" :title "Make something."} "Precursor"] "? "]
      [:p  "Tweet " [:a {:href "https://twitter.com/PrecursorApp"} "@PrecursorApp"] " and include #madewithprecursor. "
           " I'll send you a one-of-a-kind shirt for free, if we feature it next time! "]]


Rewrite for-all docstrings even more

Rewrite for-all docstrings even more

Addresses TCHECK-121.

--- src/main/clojure/clojure/test/check/properties.cljc
+++ src/main/clojure/clojure/test/check/properties.cljc
@@ -42,15 +42,15 @@
        :args args})))

 (defn for-all*
-  "Creates a property (properties are also generators). A property
-  is a generator that generates the result of applying the function
-  under test with the realized arguments. Once realized, the arguments
-  will be applied to `function` with `apply`.
+  "A function version of `for-all`. Takes a sequence of N generators
+  and a function of N args, and returns a property that calls the
+  function with generated values and tests the return value for
+  truthiness, like with `for-all`.

   Example:

-  (for-all* [gen/int gen/int] (fn [a b] (>= (+ a b) a)))
-  "
+  (for-all* [gen/large-integer gen/large-integer]
+            (fn [a b] (>= (+ a b) a)))"
   [args function]
   (gen/fmap
    (apply-gen function)
@@ -65,16 +65,27 @@
   (map second (partition 2 bindings)))

 (defmacro for-all
-  "Macro sugar for `for-all*`. `for-all` uses `let`-style bindings
-  for the generated values. Note that when using multiple bindings,
-  the earlier bindings are not visible to the later bindings.
+  "Returns a property, which is the combination of some generators and
+  an assertion that should be true for all generated values. Properties
+  can be used with `quick-check` or `defspec`.

-  Returns a property.
+  `for-all` takes a `let`-style bindings vector, where the right-hand
+  side of each binding is a generator.

-  Examples
+  The body should be an expression of the generated values that will
+  be tested for truthiness. Exceptions in the body will be caught and
+  treated as failures.

-  (for-all [a gen/int
-            b gen/int]
+  When there are multiple binding pairs, the earlier pairs are not
+  visible to the later pairs.
+
+  If there are multiple body expressions, all but the last one are
+  executed for side effects, as with `do`.
+
+  Example:
+
+  (for-all [a gen/large-integer
+            b gen/large-integer]
     (>= (+ a b) a))"
   [bindings & body]
   `(for-all* ~(vec (binding-gens bindings))


Log a message if no :init or immutant.clj provided [IMMUTANT-5]

--- modules/core/src/main/clojure/immutant/runtime.clj
+++ modules/core/src/main/clojure/immutant/runtime.clj
@@ -24,16 +24,19 @@
   (:require [clojure.tools.logging :as log]))

 (defn require-and-invoke [namespaced-fn & [args]]
+  "Takes a string of the form \"namespace/fn\", requires the namespace, then invokes fn"
   (apply (util/require-and-intern namespaced-fn) args))

 (defn initialize [init-fn]
+  "Attempts to initialize the app by calling an init-fn (if given) or, lacking that, tries to load an immutant.clj from the app-root"
   (let [config-file (io/file (registry/fetch "app-root") "immutant.clj")
         config-exists (.exists config-file)]
     (if init-fn
       (do
         (if config-exists
-          (log/warn "immutant.clj found in" (registry/fetch "app-name") ", but you specified an init fn; ignoring immutant.clj"))
+          (log/warn "immutant.clj found in" (registry/fetch "app-name") ", but you specified an :init fn; ignoring immutant.clj"))
         (require-and-invoke init-fn))
       (if config-exists
-        (load-file (.getAbsolutePath config-file))))))
+        (load-file (.getAbsolutePath config-file))
+        (log/warn "no immutant.clj found in" (registry/fetch "app-name") "and you specified no init fn; no app initialization will be performed")))))


construct git repo cljs-api-docs as tool output containing versioned docs (close #2)

--- src/core.clj
+++ src/core.clj
@@ -13,6 +13,8 @@

 ;; location of the clojure & clojurescript repos to parse
 (def repo-dir "repos")
+
+(def docs-repo-dir "cljs-api-docs")

 ;; location of the documents generated by this program
 (def ^:dynamic *output-dir* nil)
@@ -91,14 +93,17 @@
         versions (split-lines (:out sh-return))]
     versions))

-(defn get-versions-since
+(defn get-version-num
+  [v]
+  (Integer/parseInt (subs v 1)))
+
+(defn get-versions-to-parse
   [latest]
   (let [versions (get-repo-versions)]
     (if-not latest
-      versions
-      (let [get-num #(Integer/parseInt (subs % 1))
-            latest-num (get-num latest)]
-        (filter #(> (get-num %) latest-num) versions)))))
+      [nil versions]
+      (let [latest-num (get-version-num latest)]
+        (split-with #(<= (get-version-num %) latest-num) versions)))))

 (defn checkout-version!
   [v]
@@ -110,6 +115,48 @@
         strip-path (subs path (inc (count repo)))]
     (str "https://github.com/clojure/" repo "/blob/" version "/" strip-path
          "#L" start-line "-L" end-line)))
+
+(defn git-docs-repo!
+  [& args]
+  (apply sh "git" (concat args [:dir docs-repo-dir])))
+
+(defn make-docs-repo!
+  []
+  (when-not (exists? docs-repo-dir)
+    (mkdir docs-repo-dir)
+    (git-docs-repo! "init")))
+
+(defn docs-repo-has-version?
+  [v]
+  (let [result (git-docs-repo! "rev-parse" v)
+        present? (zero? (:exit result))]
+    present?))
+
+(defn docs-repo-out-of-sync!
+  [msg]
+  (println "\nERROR: docs-repo out of sync with symbol-history.")
+  (println "  " msg)
+  (println "   You will need to delete symbol-history and docs-repo and start the tool again.")
+  (System/exit 1))
+
+(defn verify-docs-repo-sync!
+  [past-versions versions]
+  (doseq [version past-versions]
+    (when-not (docs-repo-has-version? version)
+      (docs-repo-out-of-sync! (str version " has no tag"))))
+  (doseq [version versions]
+    (when (docs-repo-has-version? version)
+      (docs-repo-out-of-sync! (str version " already has tag")))))
+
+(defn clear-docs-repo!
+  [msg]
+  (git-docs-repo! "rm" "-rf" "."))
+
+(defn commit-docs-repo!
+  [version]
+  (git-docs-repo! "add" ".")
+  (git-docs-repo! "commit" "-m" version)
+  (git-docs-repo! "tag" version))

 ;;------------------------------------------------------------
 ;; Repo Helpers
@@ -577,16 +624,20 @@
   (println "\nCloning or updating repos...")
   (clone-or-fetch-repos)

-  (mkdir "output")
+  (make-docs-repo!)

   (let [[latest history] (get-symbol-history)
-        versions (get-versions-since latest)]
+        [past-versions versions] (get-versions-to-parse latest)]
+
+    (println "\nVerifying docs-repo is in sync with symbol-history...")
+    (verify-docs-repo-sync! past-versions versions)
+
     (doseq [version versions]

       (println "\nChecking out" version "...")
       (checkout-version! version)

-      (binding [*output-dir* (str "output/" version)
+      (binding [*output-dir* docs-repo-dir
                 *repo-version* {"clojurescript" version
                                 "clojure" (get-repo-version "clojure")}]

@@ -594,6 +645,8 @@
         (let [parsed (parse-all)
               symbols (set (map :full-name parsed))]

+          (clear-docs-repo! version)
+
           (println "\nWriting updated history to" history-filename "...")
           (mkdir *output-dir*)
           (update-history! history version symbols)
@@ -601,7 +654,9 @@
           (println "\nWriting docs to" *output-dir*)
           (mkdir (str *output-dir* "/" docs-dir))
           (let [parsed (attach-history-to-items parsed (:version-map @history))]
-            (dump-api-docs! parsed)))
+            (dump-api-docs! parsed))
+
+          (commit-docs-repo! version))

         (println "\nDone."))))


Added file-seq cljs implementation

Added file-seq cljs implementation

--- planck-cljs/src/planck/core.cljs
+++ planck-cljs/src/planck/core.cljs
@@ -302,3 +302,8 @@
           (catch :default e
             (set! *e e)
             (print-error e)))))))
+
+(defn file-seq
+  "A tree seq on PLKFiles"
+  [dir]
+  (js/PLANCK_IO_FILESEQ dir))


Revert "WIP on source mapping"

Revert "WIP on source mapping"

This reverts commit 7f6891952314b2754bb86446bf390d3cdba6884d.

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -505,18 +505,17 @@

 (defn- caching-js-eval
   [{:keys [path name source cache]}]
-  (let [source (str (form-compiled-by-string (form-build-affecting-options)) "\n" source)]
-    (when (and path cache (:cache-path @app-env))
-      (js/PLANCK_CACHE (cache-prefix-for-path path (is-macros? cache))
-        source
-        (cljs->transit-json cache)
-        (cljs->transit-json (get-in @planck.repl/st [:source-maps name]))))
-    (if (and (not (empty? path))
-          (not= "Expression" path))
-      (let [exception (js/PLANCK_EVAL (str "\n" source) (file-url (js-path-for-name name)))]
-        (when exception
-          (throw exception)))
-      (js/eval source))))
+  (when (and path source cache (:cache-path @app-env))
+    (js/PLANCK_CACHE (cache-prefix-for-path path (is-macros? cache))
+      (str (form-compiled-by-string (form-build-affecting-options)) "\n" source)
+      (cljs->transit-json cache)
+      (cljs->transit-json (get-in @planck.repl/st [:source-maps name]))))
+  (if (and (not (empty? path))
+           (not= "Expression" path))
+    (let [exception (js/PLANCK_EVAL source (file-url (js-path-for-name name)))]
+      (when exception
+        (throw exception)))
+    (js/eval source)))

 (defn- extension->lang
   [extension]
@@ -580,7 +579,7 @@
       (when (and sourcemap-json name)
         (swap! st assoc-in [:source-maps name] (transit-json->cljs sourcemap-json)))
       (when-not (skip-load-js? name)
-        (js/PLANCK_EVAL (str "\n" js-source) (file-url (add-suffix path ".js"))))
+        (js/PLANCK_EVAL js-source (file-url (add-suffix path ".js"))))
       (merge {:lang   :js
               :source ""}
         (when cache-json


Eliminate unnecessary workaround for loading

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -310,10 +310,8 @@
                 (when (and precompiled-js cache-json)
                   (when (:verbose @app-env)
                     (println-verbose "Loading precompiled JS and analysis cache for" full-path))
-                  ; cljs.js won't load dependent namespaces, so instead we let Closure do it
-                  (js/goog.require (s/replace path #"/" "."))
                   {:lang   :js
-                   :source ""                               ; Intentionally pass empty source
+                   :source precompiled-js
                    :cache  (transit-json->cljs cache-json)})))))
       :loaded)))


Change to idiomatic predicate name

Change to idiomatic predicate name

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -899,7 +899,7 @@
          (ex-cause error))
     ex-cause))

-(defn- is-reader-or-analysis?
+(defn- reader-or-analysis?
   "Indicates if an exception is a reader or analysis exception."
   [e]
   (and (instance? ExceptionInfo e)
@@ -976,7 +976,7 @@
   (when (and (instance? ExceptionInfo error)
              (= could-not-eval-expr (ex-message error)))
     (when-let [cause (ex-cause error)]
-      (when (is-reader-or-analysis? cause)
+      (when (reader-or-analysis? cause)
         (when-let [column (:column (ex-data cause))]
           (form-indicator column current-ns))))))

@@ -995,7 +995,7 @@
   ([error include-stacktrace? printed-message]
    (print-error-column-indicator error)
    (let [error (skip-cljsjs-eval-error error)
-         roa? (is-reader-or-analysis? error)
+         roa? (reader-or-analysis? error)
          include-stacktrace? (or (= include-stacktrace? :pst)
                                  (and include-stacktrace?
                                       (not roa?)))


Use .readLine instead of .readCharacter

Use .readLine instead of .readCharacter

--- src/multi_repl/core.clj
+++ src/multi_repl/core.clj
@@ -52,50 +52,29 @@
   (-> (new-repl ["python" "-u" "python-repl.py"])
       (component/start)))

-(defn parse-input [input]
-  (print-err "valid-input?" input)
-  (cond
-    (= input [27 91 65])           :up
-    (= input [27 91 66])           :down
-    (= input [27 91 67])           :right
-    (= input [27 91 68])           :left
-    (= input [127])                :backspace
-    (= input [101 120 105 116 13]) :exit
-    (= (last input) 13)            (->> input
-                                        (map char)
-                                        (apply str)
-                                        clojure.string/trim)
-    :else                          false))
+(defn read-line [reader]
+  (-> (.readLine reader)
+      clojure.string/trim))

-(defn read-input [reader]
-  (loop [buffer [(.readCharacter reader)]]
-    (if-let [parsed (parse-input buffer)]
-      parsed
-      (do (print-flush (char (last buffer)))
-          (recur (conj buffer (.readCharacter reader)))))))
+(defmulti run-line (fn [repl line] line))

-(defmulti run-input (fn [repl input]
-                      (if (keyword? input) input :string)))
-
-(defmethod run-input :default [repl input]
-  (println "\nUNKNOWN INPUT:" input))
-
-(defmethod run-input :exit [repl _]
+(defmethod run-line "exit" [repl _]
   (component/stop repl)
   (System/exit 0))

-(defmethod run-input :string [repl input]
-  (let [{:keys [error result]} (eval-in-repl repl input)]
+(defmethod run-line :default [repl line]
+  (let [{:keys [error result]} (eval-in-repl repl line)]
     (if error
-      (println "\nERROR:" error)
-      (println "\n" result))))
+      (println "ERROR:" error)
+      (println result))))

 (defn -main [& args]
   (let [repl (start-python-repl)
-        reader (ConsoleReader.)]
-    (print-flush "> ")
-    (loop [input (read-input reader)]
-      (print-err "input" input)
-      (run-input repl input)
-      (print-flush "> ")
-      (recur (read-input reader)))))
+        reader (ConsoleReader.)
+        out (PrintWriter. (.getOutput reader))]
+    (.setPrompt reader "> ")
+    (loop [line (read-line reader)]
+      (print-err "line" line)
+      (run-line repl line)
+      (.flush out)
+      (recur (read-line reader)))))


rename initial index to wbxxx_v0

rename initial index to wbxxx_v0

--- src/wb_es/bulk/core.clj
+++ src/wb_es/bulk/core.clj
@@ -103,7 +103,7 @@

 (defn run [& {:keys [db]
               :or {db (d/db datomic-conn)}}]
-  (let [index-id (format "%s_tmp" release-id)]
+  (let [index-id (format "%s_v0" release-id)]
     (do
       (create-index index-id :default-index true)
       (let [n-threads 4


reformat

reformat

--- src/zombie_run/core.clj
+++ src/zombie_run/core.clj
@@ -80,9 +80,13 @@

 (defn- attack-target [terrain attacker-pos target-pos target-type]
   (if (weapon/weapon-is-ready? (get-in terrain [attacker-pos :weapon]))
-    (let [terrain (update-in terrain [attacker-pos :weapon] weapon/weapon-reset-recharge)]
+    (let [terrain (update-in terrain
+                             [attacker-pos :weapon]
+                             weapon/weapon-reset-recharge)]
       (if (terrain-has-type? terrain target-pos target-type)
-        (damage-terrain terrain target-pos (weapon/weapon-attack (get-in terrain [attacker-pos :weapon])))
+        (damage-terrain terrain
+                        target-pos
+                        (weapon/weapon-attack (get-in terrain [attacker-pos :weapon])))
         terrain))
     terrain))


set version ids

set version ids

--- migae-test/project.clj
+++ migae-test/project.clj
@@ -9,9 +9,9 @@
           :id "migae-test"
           ;; GAE version ID
           ;; using '-' prefix on version nbr forces user to customize
-          :version  {:dev "-0-1-0"
-                     :test "-0-1-0"
-                     :prod "-0-1-0"}
+          :version  {:dev "0-1-0"
+                     :test "0-1-1"
+                     :prod "1-0-0"}
           :filters [{:filter "reload_filter"
                      :ns "migae-test.reload-filter"
                      :class "migae_test.reload_filter"}]


put back event channels

put back event channels

--- examples/lesson-carousel-starter-kit/src/carousel/core.cljs
+++ examples/lesson-carousel-starter-kit/src/carousel/core.cljs
@@ -158,10 +158,10 @@
         context (.. FamousEngine (createScene "body"))

         back-node (first children)
-                                        ;back-clicks (events->chan back-node "tap")
+        back-clicks (events->chan back-node "tap")

         next-node (second children)
-                                        ;next-clicks (events->chan next-node "tap")
+        next-clicks (events->chan next-node "tap")

                                         ;pages (create-pages root-node simulation)

@@ -185,7 +185,7 @@
                                                                              (+ dotWidth spacing)))
                                                                        0
                                                                        0)))))})
-        ]
+        current-index (atom 0)]
     (.. dot-container-node (addComponent resize))
     (.. context (addChild root-node))

@@ -198,35 +198,35 @@
                                         ;                                           (.. (:anchor new-page) (set 0 0 0))
                                         ;                                           (.. (:quaternion new-page) (set 1 0 0 0)))))

-                                        ;(go
-                                        ;  (while true
-                                        ;         (let [[v channel] (alts! [back-clicks next-clicks])]
-                                        ;              (cond
-                                        ;                (= channel back-clicks) (do
-                                        ;                                          (println "back" @current-index)
-                                        ;                                          (swap! current-index dec)
-                                        ;                                          )
-                                        ;                (= channel next-clicks) (do
-                                        ;                                          (println "next" @current-index)
-                                        ;                                          (swap! current-index inc)
-                                        ;                                          )))))
-
-                                        ;(.. FamousEngine (requestUpdate (clj->js {:onUpdate (fn [time]
-                                        ;                                                        (.. simulation (update time))
-                                        ;                                                        (doseq [page pages
-                                        ;                                                                :let [physics-transform (.. simulation (getTransform (:box page)))
-                                        ;                                                                      p (.. physics-transform -position)
-                                        ;                                                                      r (.. physics-transform -rotation)
-                                        ;                                                                      node (:node page)]]
-                                        ;                                                               (.. node
-                                        ;                                                                   (setPosition (* 0 1446) 0 0)
-                                        ;                                                                   (setRotation (nth r 0) (nth r 1) (nth r 2) (nth r 3))
-                                        ;                                                                   )
-                                        ;                                                               )
-                                        ;
-                                        ;                                                        (this-as this
-                                        ;                                                                 (.. FamousEngine (requestUpdateOnNextTick this)))
-                                        ;                                                        )})))
+    (go
+      (while true
+        (let [[v channel] (alts! [back-clicks next-clicks])]
+          (cond
+            (= channel back-clicks) (do
+                                      (println "back" @current-index)
+                                      (swap! current-index dec)
+                                      )
+            (= channel next-clicks) (do
+                                      (println "next" @current-index)
+                                      (swap! current-index inc)
+                                      )))))
+
+    ;; (.. FamousEngine (requestUpdate (clj->js {:onUpdate (fn [time]
+    ;;                                                       (.. simulation (update time))
+    ;;                                                       (doseq [page pages
+    ;;                                                               :let [physics-transform (.. simulation (getTransform (:box page)))
+    ;;                                                                     p (.. physics-transform -position)
+    ;;                                                                     r (.. physics-transform -rotation)
+    ;;                                                                     node (:node page)]]
+    ;;                                                         (.. node
+    ;;                                                             (setPosition (* 0 1446) 0 0)
+    ;;                                                             (setRotation (nth r 0) (nth r 1) (nth r 2) (nth r 3))
+    ;;                                                             )
+    ;;                                                         )
+
+    ;;                                                       (this-as this
+    ;;                                                                (.. FamousEngine (requestUpdateOnNextTick this)))
+    ;;                                                       )})))
     )

   )


Fixed movement keys

Fixed movement keys

Works in Windows too.

--- src/asteroids/core.clj
+++ src/asteroids/core.clj
@@ -19,7 +19,8 @@
 (def point-size 8.5)
 (def ship-size 1.5)
 (def ship-life 3)
-(def turn-speed 4)
+(def ship-acceleration 1)
+(def ship-rotation-speed 4)
 (def shot-size (/ ship-size 10))
 (def shot-speed 2.5)
 (def shot-millis 400)
@@ -34,11 +35,10 @@
 (def turn-millis 40)

 (def actions {
-              (int \A) {:rotation (- turn-speed)}
-              (int \D) {:rotation turn-speed}
-              (int \W) {:acceleration 1}
+              (int \A) {:rotation (- ship-rotation-speed)}
+              (int \D) {:rotation ship-rotation-speed}
+              (int \W) {:acceleration ship-acceleration}
               (int \K) {:shoot true}
-              (int \R) {:repair true}
               (int \1) {:set-level 1}
               (int \2) {:set-level 2}
               (int \3) {:set-level 3}
@@ -141,7 +141,7 @@
    :shape                  [[-0.143 1.0] [0.143 1.0] [0.429 0.429] [1.0 0.143] [1.0 -1.0] [0.429 -0.714]
                             [0.143 -1.0] [-0.143 -1.0] [-0.429 -0.714] [-1.0 -1.0] [-1.0 0.143] [-0.429 0.429]]
    :color                  (Color. 160 160 150)
-   :paint-method fill-polygon
+   :paint-method           fill-polygon

    :cockpit-shape          [[-0.143 0.714] [0.143 0.714] [0.286 -0.143] [-0.286 -0.143]]
    :cockpit-color          (Color. 0 0 80)
@@ -156,6 +156,7 @@

    :direction              0
    :rotation-speed         0
+   :rotation               #{}

    :life                   ship-life
    :life-colors            [(Color. 255 0 0) (Color. 255 80 75) (Color. 250 160 75) (Color. 160 160 150)]
@@ -169,7 +170,7 @@
     :size           shot-size
     :shape          [[-1.0 -5.0] [1.0 -5.0] [0.0 1.0]]
     :color          (Color. 250 50 10)
-    :paint-method fill-polygon
+    :paint-method   fill-polygon

     :position       pos
     :speed          speed
@@ -206,7 +207,7 @@
       :size           (vary asteroid-size-variance size)
       :shape          shape
       :color          (Color. 250 240 (if debris? 150 20))
-      :paint-method draw-polygon
+      :paint-method   draw-polygon

       :position       position
       :speed          speed
@@ -326,19 +327,12 @@
 ; Actions
 ; ----------------------------------------------------------------------

-(defn repair-ship [ship]
-  "Repair method while input keys f*** up at start-up"
-  (assoc ship :rotation-speed 0
-              :acceleration 0
-              :shooting? false))
-
 (defn shoot [{:keys [shooting? shots millis-since-last-shot] :as ship}]
   (let [millis-since-last-shot (+ turn-millis millis-since-last-shot)
         shoots? (and shooting? (>= millis-since-last-shot shot-millis))
         shots (if shoots? (conj shots (create-shot ship)) shots)]
     (assoc ship :millis-since-last-shot (if shoots? 0 millis-since-last-shot)
-                :shots shots))
-  )
+                :shots shots)))

 (defn basic-move
   ([{:keys [direction rotation-speed speed acceleration position] :as object} wrap?]
@@ -379,16 +373,12 @@
        (map move)
        (filter (comp not nil?))))

-(defn turn [{:keys [rotation-speed] :as ship} rot]
-  (assoc ship :rotation-speed (+ rotation-speed rot)))
-
-(defn accelerate [{:keys [acceleration] :as ship} acc]
-  (assoc ship :acceleration (+ acceleration acc)
-              :collidable? true))
-
-(defn toggle-shooting [ship do-shoot?]
-  (assoc ship :shooting? do-shoot?
-              :collidable? true))
+(defn set-rotation [{rotation :rotation :as ship} value activate?]
+  (let [rotation (if activate?
+                   (conj rotation value)
+                   (disj rotation value))]
+    (assoc ship :rotation rotation
+                :rotation-speed (reduce + rotation))))

 ; ----------------------------------------------------------
 ; mutable model
@@ -407,14 +397,12 @@
       (ref-set asteroids asteroids*))))

 (defn do-action!
-  ([ship {:keys [rotation acceleration shoot repair] :as action} modifier]
-   (when rotation (dosync (alter ship turn (* modifier rotation))))
-   (when acceleration (dosync (alter ship accelerate (* modifier acceleration))))
-   (when shoot (dosync (alter ship toggle-shooting (> modifier 0))))
-   (when repair (dosync (alter ship repair-ship))))
+    ([ship {:keys [acceleration rotation shoot] :as action} activate?]
+   (when acceleration (dosync (alter ship assoc :acceleration (if activate? acceleration 0) :collidable? true)))
+   (when rotation (dosync (alter ship set-rotation rotation activate?)))
+   (when shoot (dosync (alter ship assoc :shooting? activate? :collidable? true))))
   ([ship action]
-   (do-action! ship action 1))
-  )
+   (do-action! ship action true)))

 (defn reset-game! [ship asteroids level increase-level?]
   (dosync
@@ -486,7 +474,7 @@
     (keyPressed [e]
       (do-action! ship (actions (.getKeyCode e))))
     (keyReleased [e]
-      (do-action! ship (actions (.getKeyCode e)) -1))
+      (do-action! ship (actions (.getKeyCode e)) false))
     (keyTyped [e])
     (getPreferredSize []
       (Dimension. (* (inc width) point-size)


Only start the server if model-connection is successful.

--- src/cadence/server.clj
+++ src/cadence/server.clj
@@ -32,10 +32,12 @@
   (try
     (model/connect storage)
     (catch java.io.IOException e
-      (println "ERROR: Could not connect to MongoDB."))
+      (println "ERROR: Could not connect to MongoDB.")
+      false)
     (catch java.lang.NullPointerException e
       (println "ERROR: Could not authenticate with Mongo. See config: \n\t"
-               (str (assoc storage :password "**********"))))))
+               (str (assoc storage :password "**********")))
+      false)))

 (def app
   "Create the application from its routes and middlewares."
@@ -60,15 +62,15 @@
   "Run the application."
   ([options]
    (state/compute)
-   (attempt-model-connection)
-   (let [assets-config {:cache-mode (state/get :mode)
-                        :engine (if (state/production?) :rhino :v8)
-                        :compress (state/production?)}]
-     (run-server (asset-pipeline (if (state/production?)
-                                   (-> app (wrap-force-ssl))
-                                   (-> app (wrap-stacktrace)))
-                                 assets-config)
-                 {:port (state/get :port)})))
+   (when (attempt-model-connection)
+     (let [assets-config {:cache-mode (state/get :mode)
+                          :engine (if (state/production?) :rhino :v8)
+                          :compress (state/production?)}]
+       (run-server (asset-pipeline (if (state/production?)
+                                     (-> app (wrap-force-ssl))
+                                     (-> app (wrap-stacktrace)))
+                                   assets-config)
+                   {:port (state/get :port)}))))
   ([] (-main {})))

 (defn defserver


Add failing test for body symbol renaming

--- test/cats/core_spec.cljc
+++ test/cats/core_spec.cljc
@@ -81,7 +81,16 @@
                       b (maybe/just 1)          ;; split 3
                       c (maybe/just 2)
                       d (maybe/just (+ a b c))] ;; split 4
-               d)))))
+               d))))
+
+  (t/testing "It renames the body symbols correctly"
+    (t/is (= (maybe/just 42)
+             (m/alet [x (maybe/just 5)
+                      y (maybe/just 6)
+                      x (maybe/just (inc x))
+                      y (maybe/just (inc y))]
+               (* x y)))))
+)

 (t/deftest sequence-tests
   (t/testing "It works with vectors"


Made net-addrs atom accessible.

Made net-addrs atom accessible.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -53,6 +53,8 @@
                                         :addr-override-xy #(get @addr-override-xy-g %))]
     (set-el-innerHTML target-el-id (apply str (flatten h)))
     addrs))
+
+(def net-addrs (atom {}))

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

@@ -131,7 +133,7 @@
     (swap! prog-evts #(vec (filter (fn [[s & _]] (<= s ts)) %)))
     (swap! prog-ss #(into {} (filter (fn [[s _]] (<= s ts)) %)))
     (set-el-innerHTML "reqs" (render-reqs-html (:reqs prog-frame)))
-    (render-net "net-main" (:net prog-frame) {})
+    (render-net "net-main" (:net prog-frame) @net-addrs)
     (on-prog-frame-blur)))

 ; -------------------------------------------------------------------
@@ -221,7 +223,6 @@
                           ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})
             net-actx (atom nil)
-            net-addrs (atom {})
             net-cb (fn [vis]
                      (when-let [net (get-in vis [:actxs @net-actx :loop-state])]
                        (when (not= net (:net @prog-curr))


Removed some debug println's.

Removed some debug println's.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -156,13 +156,10 @@
               (get-in app [:snapshots ss-ts] nil))))

 (defn event-focus [snapshot-ts event-ts]
-  (println :event-focus snapshot-ts event-ts)
   (when-let [ss (get-in @app-history [:snapshots snapshot-ts])]
-    (println "AAAAAAA" ss)
     (reset! app-world-hover ss)))

 (defn event-blur [snapshot-ts event-ts]
-  (println :event-blur snapshot-ts event-ts)
   (reset! app-world-hover nil))

 (defn render-events [app owner]


Notes on design of coll vs vbuckets, and coll metadata.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -18,10 +18,13 @@

     [coll-state (assoc m :status :invalid :status-info :invalid-op)]))

+; A coll can be used like a vbucket / partition.
+; Any coll-meta data is handled as just more entries in the coll,
+; somewhat like "dot files" in a filesystem.
+
 (defn make-coll [actx rev path kvs-mgr-ch]
   (let [coll-ch (achan actx)]
     (act coll-init actx
-         ; TODO: Have a kvs per shard instead of per coll.
          (let [res (areq coll-init kvs-mgr-ch {:op :kvs-open :name [path rev]})]
            (if (= (:status res) :ok)
              (state-loop actx [:coll path rev] coll-handler
@@ -30,7 +33,6 @@
              (do (println "make-coll kvs-open failed" res)
                  ; TODO: Should also consume any reqs that raced onto coll-ch.
                  (aclose coll-init coll-ch)))))
-    ; TODO: Add coll-meta cache to coll-state?
     {:rev rev
      :path path
      :coll-ch coll-ch


Allow user to coll-create on current realm/collset.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -64,7 +64,7 @@
    :cur-realm-collset "default"
    :cur-realm-collset-coll "default"
    :cur-user-realm "_lobby"
-   :cur-user "_anon"})
+   :cur-user "_anon"}) ; TODO: Need cur-coll, too.

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

@@ -118,8 +118,8 @@
         [server-state nil])

     "coll-create"
-    (if (and (= (:cur-user-realm m) "_system")
-             (= (:cur-user m) "admin"))
+    (if (or (= (:cur-user-realm m) (:cur-realm m))
+            (= (:cur-user-realm m) "_system"))
       (if (and (:key m) (re-matches #"^[a-zA-Z][a-zA-Z0-9_-]+" (:key m)))
         (if-let [colls (get-in server-state [:realms (:cur-realm m)
                                              :collsets (:cur-realm-collset m)


Fix extraneous s-exp

Fix extraneous s-exp

--- src/clj/ji/service.clj
+++ src/clj/ji/service.clj
@@ -71,7 +71,7 @@
         game-chan (go-game game-env)]
     (swap! game-envs assoc game-id game-env)
     (go (let [finshed-game (<! game-chan)]
-          (println ("GAME FINISH" finshed-game))
+          (println "GAME FINISH" finshed-game)
           (swap! game-envs dissoc (:id finshed-game))))
     game-env))


include type in pprint-and-return

include type in pprint-and-return

--- src/clj_money/util.clj
+++ src/clj_money/util.clj
@@ -74,6 +74,7 @@
   (println message)
   (when (meta value)
     (pprint {:meta (meta value)}))
+  (println "type " (type value))
   (pprint value)
   value)


Conditional load of probemaps.

Conditional load of probemaps.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -598,14 +598,23 @@
 ; kdb/transaction will create a closure of our parameters,
 ; so we can't pass in the matrix seq w/o blowing the heap. We
 ; pass in a function to return the seq, instead.
-(defn load-probemap [files metadata probes-fn]
-  (kdb/transaction
-    (let [probes (probes-fn)
-          pmid (merge-m-ent probemaps-meta metadata)
-          add-probe (partial add-probemap-probe pmid)]
-      (load-related-sources
-        probemap_sources :probemaps_id pmid (map fmt-time files))
-      (dorun (map add-probe probes)))))
+(defn load-probemap
+  "Load probemap file and metadata. Skips the data load if the file hashes are unchanged,
+  and 'force' is false."
+  ([files metadata probes-fn]
+   (load-probemap files metadata probes-fn false))
+
+  ([files metadata probes-fn force]
+   (kdb/transaction
+     (let [probes (probes-fn)
+           pmid (merge-m-ent probemaps-meta metadata)
+           add-probe (partial add-probemap-probe pmid)
+           files (map fmt-time files)]
+       (when (or force
+                 (not (= (set files) (set (related-sources probemaps pmid)))))
+         (load-related-sources
+           probemap_sources :probemaps_id pmid files)
+         (dorun (map add-probe probes)))))))

 (defn create-db [file]
   (kdb/create-db  {:classname "org.h2.Driver"


fixed some download bugs

fixed some download bugs

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -111,28 +111,23 @@
          (:music-info @app-state))
     0))

+(defn request-file-download [track-id]
+  (if (nil? (get (:music-files @app-state) track-id))
+    (do
+      (swap! app-state assoc :music-files (merge (:music-files @app-state)
+                                                 {track-id (new js/Blob)}))
+      (swap! app-state assoc :num-of-downloads (inc (:num-of-downloads @app-state)))
+      (.emit socket "file-download-request" track-id)
+      (println (str "Num of file downloads: " (:num-of-downloads @app-state))))))
+
+; TODO: reimplement this
 (defn get-next-track-to-download []
-  (letfn [(is-track-downloaded? [track-id]
-            (contains? (:music-files @app-state) track-id))]
-    (let [current-track-info (get-music-info-from-id (:current-track-id @app-state))]
-      (loop [track-num (+ (.-tracknum current-track-info) 1)
-             i 0]
-        (if (>= i (count (:music-info @app-state)))
-          nil
-          (if (< track-num (count (:music-info @app-state)))
-            (let [music-info (nth (:music-info @app-state) track-num)
-                  track-id (.-id music-info)]
-              (if-not (is-track-downloaded? track-id)
-                track-id
-                  (recur (+ 1 track-num)
-                         (+ 1 i))))
-              (recur 0
-                     (+ 1 i))))))))
+  nil)

 (defn request-new-track []
-  (let [id (get-next-track-to-download)]
-    (if-not (nil? id)
-      (.emit socket "file-download-request" id))))
+  (let [track-id (get-next-track-to-download)]
+    (if-not (nil? track-id)
+      (request-file-download track-id))))

 (defn pause []
   (player/pause)
@@ -142,7 +137,7 @@
   (.emit socket "resume"))

 (defn indices [pred coll]
-   (keep-indexed #(when (pred %2) %1) coll))
+  (keep-indexed #(when (pred %2) %1) coll))

 (defn get-current-track-num []
   (first (indices #(= (.-id %1) (:current-track-id @app-state))
@@ -200,7 +195,6 @@
   (fn [stream track-id file-size]
     (println "Download starting!")

-    (swap! app-state assoc :num-of-downloads (+ 1 (:num-of-downloads @app-state)))

     (.on stream "data"
       (fn [data-chunk]
@@ -210,9 +204,7 @@
           (swap! app-state assoc :download-progress (merge (:download-progress @app-state)
                                                            {track-id {:data-downloaded data-downloaded
                                                                       :file-size file-size}})))
-        (if (nil? (get (:music-files @app-state) track-id))
-          (swap! app-state assoc :music-files
-            (merge (:music-files @app-state) {track-id (new js/Blob)})))
+
         (swap! app-state assoc :music-files
           (merge (:music-files @app-state)
                  {track-id
@@ -221,7 +213,7 @@
     (.on stream "end"
       (fn []
         (println "Download complete!")
-        (swap! app-state assoc :num-of-downloads (- (:num-of-downloads @app-state) 1))
+        (swap! app-state assoc :num-of-downloads (dec (:num-of-downloads @app-state)))
         (swap! app-state assoc :download-progress (dissoc (:download-progress @app-state) track-id))

         (if (> (:download-slots @app-state) (:num-of-downloads @app-state))
@@ -249,7 +241,7 @@
         (player/destroy-track last-current-sound-id)))

       (if (nil? (get (:music-files @app-state) track-id))
-        (.emit socket "file-download-request" track-id)
+        (request-file-download track-id)
         (.emit socket "ready-to-start" sound-id))))

@@ -275,7 +267,7 @@
     (swap! app-state assoc :current-track-id current-track-id)
     (swap! app-state assoc :current-sound-id current-sound-id)

-    (.emit socket "file-download-request" current-track-id)))
+    (request-file-download current-track-id)))

 (.on socket "set-loop"
   (fn [looping?]


default fn should recieve a single arg

default fn should recieve a single arg

--- src/hooks/tinymasq.clj
+++ src/hooks/tinymasq.clj
@@ -57,5 +57,5 @@
  })

 (defn update-dns [{:keys [event workflow] :as args}]
-  ((get-in actions [workflow event] (fn [_ _] nil)) args))
+  ((get-in actions [workflow event] (fn [_] nil)) args))


Bump clojure version

Bump clojure version

--- jvm/project.clj
+++ jvm/project.clj
@@ -1,4 +1,4 @@
-(defproject com.parsely/streamparse "0.0.3-SNAPSHOT"
+(defproject com.parsely/streamparse "0.0.4-SNAPSHOT"
   :description "Command line utilities for the Python streamparse library needed for JVM/Thrift interop with Storm clusters."
   :url "https://github.com/Parsely/streamparse"
   :mailing-list {:name "streamparse"


moar troubleshooting!

moar troubleshooting!

--- src/kmc_booking/db.clj
+++ src/kmc_booking/db.clj
@@ -177,6 +177,8 @@
 			(gen-seats-data seat-schema))))

 (defn migrate__seats_for_judges! []
+	(drop-table! "seats")
+	(create-seats-table!)
 	(create-booking "ЖУРІ & передзамовлення" "-" [])
 	)


Remove unused 'robust-read-project (superceded by 'robust-read-project-blob

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -384,20 +384,6 @@
 ;; Shhh...
 (.setDynamic #'slurp)
 (.setDynamic #'load-file)
-(defn robust-read-project
-  [gitdir sha prj-path]
-  (try
-    ;; Hack to work around our crazy project.clj files
-    (binding [slurp (patch-fn slurp "{}")
-              load-file (patch-fn load-file {})]
-      (read-project gitdir sha prj-path))
-    (catch Exception e
-      ;; 128 means git complained about
-      ;; something. Probably a non-existant
-      ;; project.clj at this sha.
-      (when-not (= 128 (:exit (ex-data e)))
-        (println "Ignoring error:" (pr-str e)))
-      nil)))
 (defn robust-read-proj-blob
   [gitdir blob-sha]
   ;; Hack to work around crazy project.clj files


new port

new port

--- src/mediakeys/core.clj
+++ src/mediakeys/core.clj
@@ -16,7 +16,7 @@
         incoming-json (map< json/read-json incoming-messages)
         [changes change-errors] (split allowed? incoming-json)
         user-keys (keypress-events! changes)]
-  (doto (WebServers/createWebServer 8886)
+  (doto (WebServers/createWebServer 8888)
     (.add "/keypresses"
       (keypresses user-keys))
     (.add "/controls"


Remove testing file.

Remove testing file.

--- src/menus/testing.cljs
+++ src/menus/testing.cljs
@@ -1,5 +0,0 @@
-(ns cljs-node-webkt-examples.testing)
-
-(defn this-function []
-  (this-as this
-           (+ 4 5)))


very bad code

very bad code

--- 2018/day-7/src/day_7/core.clj
+++ 2018/day-7/src/day_7/core.clj
@@ -100,8 +100,9 @@

 (defn assoc-remaining-work
   [d c]
+  (println d c)
   (let [v (-> c first int (- 4))]
-    (assoc c v)))
+    (assoc d c v)))

 (defn count-seconds
   [ttl rw-count
@@ -110,19 +111,22 @@
    ready]
   (println "==== rw-count ====")
   (println rw-count)
+  (println "==== deps ====")
+  (clojure.pprint/pprint deps)
   (println "==== working ====")
   (println working)
   (println "==== finished ====")
-  (println finished)
+  (prn finished)
   (println "==== ready ====")
   (println ready)
-  (if (empty? ready)
+  (if (and (empty? ready) (empty? working))
     ttl
-    (let [[w' df'] (reduce
+    (let [dt (apply min (map second working))
+          [w' df'] (reduce
                      (fn [[d f] [k v]]
-                       (if (zero? (dec v))
+                       (if (zero? (- v dt))
                          [(dissoc d k) (conj f k)]
-                         [(assoc d k (dec v)) f]))
+                         [(assoc d k (- v dt)) f]))
                      [{} #{}]
                      working)
           f' (apply conj finished df')
@@ -136,19 +140,23 @@
                   deps
                   parent-groups)
           ready' (->>
-                   parent-groups
-                   (filter (comp empty? deps' second))
-                   (filter (comp not (partial contains? finished)))
-                   (filter (comp not (partial contains? (set ready))))
-                   set)
+                   (map second parent-groups)
+                   (mapcat vec)
+                   (filter (comp empty? deps')))
+          ready'' (->>
+                    ready'
+                    (filter (comp not (partial contains? finished)))
+                    (filter (comp not (partial contains? (set ready)))))
           rw-count' (+ rw-count (count df'))
           [nws ready4] (split-at rw-count' ready')
+          _ (println "ready':" ready')
+          _ (println "ready'':" ready'')
           w'' (reduce
                 assoc-remaining-work
                 w'
                 nws)]
       (recur
-        (inc ttl)
+        (+ ttl dt)
         rw-count'
         f'
         w''
@@ -170,6 +178,7 @@
               assoc-remaining-work
               {}
               working)
+            dependencies
             d-parents
             rdy')]
     v))


don't touch the cust entity

don't touch the cust entity

--- src/pc/models/cust.clj
+++ src/pc/models/cust.clj
@@ -30,26 +30,26 @@

 ;; TODO: maybe these should return an entity instead of touching?
 (defn find-by-google-sub [db google-sub]
-  (pcd/touch-one '{:find [?e] :in [$ ?sub]
-                   :where [[?e :google-account/sub ?sub]]}
-                 db google-sub))
+  (d/entity db (ffirst (d/q '{:find [?e] :in [$ ?sub]
+                              :where [[?e :google-account/sub ?sub]]}
+                            db google-sub))))

 (defn find-by-email [db email]
-  (pcd/touch-one '{:find [?e] :in [$ ?email]
-                   :where [[?e :cust/email ?email]]}
-                 db email))
+  (d/entity db (ffirst (d/q '{:find [?e] :in [$ ?email]
+                              :where [[?e :cust/email ?email]]}
+                            db email))))

 (defn find-by-uuid [db uuid]
-  (pcd/touch-one '{:find [?e] :in [$ ?uuid]
-                   :where [[?e :cust/uuid ?uuid]
-                           [?e :cust/email]]}
-                 db uuid))
+  (d/entity db (ffirst (d/q '{:find [?e] :in [$ ?uuid]
+                              :where [[?e :cust/uuid ?uuid]
+                                      [?e :cust/email]]}
+                            db uuid))))

 (defn find-by-http-session-key [db http-session-key]
-  (pcd/touch-one '{:find [?e] :in [$ ?key]
-                   :where [[?e :cust/http-session-key ?key]]}
-                 db http-session-key))
+  (d/entity db (ffirst (d/q '{:find [?e] :in [$ ?key]
+                              :where [[?e :cust/http-session-key ?key]]}
+                            db http-session-key))))

 (defn retract-session-key! [cust]
   @(d/transact (pcd/conn) [[:db/retract (:db/id cust) :cust/http-session-key (:cust/http-session-key cust)]]))
@@ -61,14 +61,13 @@
     (->> (d/resolve-tempid db-after
                            tempids
                            temp-id)
-         (d/entity db-after)
-         pcd/touch+)))
+         (d/entity db-after))))

 (defn update! [cust new-attrs]
   (let [{:keys [db-after]} @(d/transact (pcd/conn) (map (fn [[a v]]
                                                           [:db/add (:db/id cust) a v])
                                                         new-attrs))]
-    (pcd/touch+ (d/entity db-after (:db/id cust)))))
+    (d/entity db-after (:db/id cust))))

 (defn cust-count [db]
   (ffirst (q '{:find [(count ?t)]


verify that success result is a non-failure

--- src/preflex/either.clj
+++ src/preflex/either.clj
@@ -29,8 +29,10 @@

 (defn success
-  "Represent given result as success. If argument is a failure, then it is returned as it is."
-  ([result] result)
+  "Represent given result as success. If the argument is a failure, then throw exception."
+  ([result] (if (instance? Failure result)
+              (throw (IllegalArgumentException. "Cannot convert failure into success."))
+              result))
   ([]       nil))


Update documentation for `run-in-reaction`

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -59,9 +59,9 @@
     res))

 (defn- notify-deref-watcher!
-  "Add the ratom being derefed to the 'capture' field of *ratom-context* reaction.
-
-  *ratom-context* is available in the context. See in-context function which sets *ratom-context*"
+  "Add `derefed` to the `captured` field of `*ratom-context*`.
+
+  See also `in-context`"
   [derefed]
   (when-some [r *ratom-context*]
     (let [c (.-captured r)]
@@ -523,11 +523,13 @@

 (defn run-in-reaction
-  "Runs the function and returns the result.
-
-   If function referring to any ratoms, they are added in the 'watching' list of the
-   newly created reaction. Also, the new reaction is added to list of 'watches' of each
-   of the ratoms"
+  "Evaluates `f` and returns the result.  If `f` calls `deref` on any ratoms,
+   creates a new Reaction that watches those atoms and calls `run` whenever
+   any of those watched ratoms change.  Also, the new reaction is added to
+   list of 'watches' of each of the ratoms. The `run` parameter is a function
+   that should expect one argument.  It is passed `obj` when run.  The `opts`
+   are any options accepted by a Reaction and will be set on the newly created
+   Reaction. Sets the newly created Reaction to the `key` on `obj`."
   [f obj key run opts]
   (let [r temp-reaction
         res (deref-capture f r)]


Update database code to use new API

Update database code to use new API

--- common/clojure/nightweb/db.clj
+++ common/clojure/nightweb/db.clj
@@ -1,6 +1,6 @@
 (ns nightweb.db
   (:require [clojure.java.io :as java.io]
-            [clojure.java.jdbc.deprecated :as jdbc]
+            [clojure.java.jdbc :as jdbc]
             [nightweb.constants :as c]
             [nightweb.formats :as f]))

@@ -22,8 +22,15 @@
                          :type table
                          :title (f/escape-html (:title row))
                          :body (f/escape-html (:body row)))))
-       (doall)
-       (vec)))
+       doall
+       vec))
+
+(defn update-or-insert!
+  [db table set-map where-clause]
+  (let [rs (jdbc/update! db table set-map where-clause)]
+    (if (zero? (first rs))
+      (jdbc/insert! db table set-map)
+      rs)))

 ; initialization

@@ -31,25 +38,14 @@
   ([table-name] (check-table table-name "*"))
   ([table-name column-name]
    (try
-     (jdbc/with-connection
+     (jdbc/query
        @spec
-       (jdbc/with-query-results
-         rs
-         [(str "SELECT COUNT(" (name column-name) ") FROM " (name table-name))]
-         rs))
+       [(str "SELECT COUNT(" (name column-name) ") FROM " (name table-name))])
      (catch Exception e nil))))
-
-(defn create-index
-  [table-name columns]
-  (jdbc/do-commands
-    "CREATE ALIAS IF NOT EXISTS FT_INIT FOR \"org.h2.fulltext.FullText.init\";"
-    "CALL FT_INIT();"
-    (format "CALL FT_CREATE_INDEX('PUBLIC', '%s', '%s');"
-            table-name (clojure.string/join "," columns))))

 (defn create-generic-table
   [table-name]
-  (jdbc/create-table
+  (jdbc/create-table-ddl
     table-name
     [:id "BIGINT" "PRIMARY KEY AUTO_INCREMENT"]
     [:realuserhash "BINARY"]
@@ -64,29 +60,37 @@
     [:ptrtime "BIGINT"]
     [:status "BIGINT"]))

+(defn create-index
+  [table-name columns]
+  ["CREATE ALIAS IF NOT EXISTS FT_INIT FOR \"org.h2.fulltext.FullText.init\";"
+   "CALL FT_INIT();"
+   (format "CALL FT_CREATE_INDEX('PUBLIC', '%s', '%s');"
+           table-name (clojure.string/join "," columns))])
+
 (defn create-tables
   []
   (when-not (check-table :user)
-    (jdbc/with-connection
+    (apply jdbc/db-do-commands
+           (concat [@spec true (create-generic-table :user)]
+                   (create-index "USER" ["ID" "TITLE" "BODY"]))))
+  (when-not (check-table :post)
+    (apply jdbc/db-do-commands
+           (concat [@spec true (create-generic-table :post)]
+                   (create-index "POST" ["ID" "TITLE" "BODY"]))))
+  (when-not (check-table :pic)
+    (jdbc/db-do-commands
       @spec
-      (create-generic-table :user)
-      (create-index "USER" ["ID" "TITLE" "BODY"])))
-  (when-not (check-table :post)
-    (jdbc/with-connection
-      @spec
-      (create-generic-table :post)
-      (create-index "POST" ["ID" "TITLE" "BODY"])))
-  (when-not (check-table :pic)
-    (jdbc/with-connection
-      @spec
+      true
       (create-generic-table :pic)))
   (when-not (check-table :fav)
-    (jdbc/with-connection
+    (jdbc/db-do-commands
       @spec
+      true
       (create-generic-table :fav)))
   (when-not (check-table :tag)
-    (jdbc/with-connection
+    (jdbc/db-do-commands
       @spec
+      true
       (create-generic-table :tag))))

 (defn init-db
@@ -103,72 +107,61 @@

 (defn get-single-user-data
   [params]
-  (let [user-hash (:userhash params)]
-    (jdbc/with-connection
-      @spec
-      (jdbc/with-query-results
-        rs
-        ["SELECT * FROM user WHERE userhash = ?" user-hash]
-        (if-let [user (first (prepare-results rs :user))]
-          (dissoc user :time)
-          {:userhash user-hash :type :user})))))
+  (let [user-hash (:userhash params)
+        statement ["SELECT * FROM user WHERE userhash = ?" user-hash]
+        rs (jdbc/query @spec statement)]
+    (if-let [user (first (prepare-results rs :user))]
+      (dissoc user :time)
+      {:userhash user-hash :type :user})))

 (defn get-single-post-data
   [params]
   (let [user-hash (:userhash params)
-        create-time (:time params)]
-    (jdbc/with-connection
-      @spec
-      (jdbc/with-query-results
-        rs
-        ["SELECT * FROM post WHERE userhash = ? AND time = ? AND status = 1"
-         user-hash create-time]
-        (if-let [post (first (prepare-results rs :post))]
-          post
-          {:userhash user-hash :time create-time :type :post})))))
+        create-time (:time params)
+        statement ["SELECT * FROM post
+                    WHERE userhash = ? AND time = ? AND status = 1"
+                   user-hash create-time]
+        rs (jdbc/query @spec statement)]
+    (if-let [post (first (prepare-results rs :post))]
+      post
+      {:userhash user-hash :time create-time :type :post})))

 (defn get-post-data
   [params]
-  (let [user-hash (:userhash params)
-        page (:page params)]
-    (jdbc/with-connection
-      @spec
-      (jdbc/with-query-results
-        rs
-        [(paginate page
-                   "SELECT * FROM post
-                   WHERE userhash = ? AND status = 1 ORDER BY time DESC")
-         user-hash]
-        (prepare-results rs :post)))))
+  (let [page (:page params)
+        user-hash (:userhash params)
+        statement [(paginate page
+                             "SELECT * FROM post
+                              WHERE userhash = ? AND status = 1
+                              ORDER BY time DESC")
+                   user-hash]
+        rs (jdbc/query @spec statement)]
+    (prepare-results rs :post)))

 (defn get-single-fav-data
   ([params] (get-single-fav-data params @c/my-hash-bytes))
   ([params my-user-hash]
    (let [ptr-hash (:userhash params)
-         ptr-time (:time params)]
-     (jdbc/with-connection
-       @spec
-       (jdbc/with-query-results
-         rs
-         ["SELECT * FROM fav WHERE userhash = ? AND ptrhash = ? AND ptrtime IS ?"
-          my-user-hash ptr-hash ptr-time]
-         (first (prepare-results rs :fav)))))))
+         ptr-time (:time params)
+         statement ["SELECT * FROM fav
+                     WHERE userhash = ? AND ptrhash = ? AND ptrtime IS ?"
+                    ptr-hash ptr-time]
+         rs (jdbc/query @spec statement)]
+     (first (prepare-results rs :fav)))))

 (defn get-fav-data
   ([params] (get-fav-data params @c/my-hash-bytes))
   ([params my-user-hash]
-   (let [ptr-hash (:ptrhash params)]
-     (jdbc/with-connection
-       @spec
-       (jdbc/with-query-results
-         rs
-         ["SELECT * FROM fav WHERE ptrhash = ?
-          AND status = 1
-          AND (userhash IN
-          (SELECT ptrhash FROM fav WHERE userhash = ? AND status = 1)
-          OR userhash = ?)"
-          ptr-hash my-user-hash my-user-hash]
-         (prepare-results rs :fav))))))
+   (let [ptr-hash (:ptrhash params)
+         statement ["SELECT * FROM fav WHERE ptrhash = ?
+                     AND status = 1
+                     AND (userhash IN
+                     (SELECT ptrhash FROM fav
+                     WHERE userhash = ? AND status = 1)
+                     OR userhash = ?)"
+                    ptr-hash my-user-hash my-user-hash]
+         rs (jdbc/query @spec statement)]
+     (prepare-results rs :fav))))

 (defn get-category-data
   [params]
@@ -254,13 +247,11 @@
                                   ORDER BY count DESC"]
                            nil))]
     (when statement
-      (jdbc/with-connection
-        @spec
-        (jdbc/with-query-results
-          rs
-          (vec (concat [(paginate (:page params) (first statement))]
-                       (rest statement)))
-          (prepare-results rs (or sub-type data-type)))))))
+      (-> (jdbc/query
+            @spec
+            (vec (concat [(paginate (:page params) (first statement))]
+                         (rest statement))))
+          (prepare-results (or sub-type data-type))))))

 (defn get-single-tag-data
   [params]
@@ -280,35 +271,26 @@
                            LIMIT 1" tag]
                     nil)]
     (when statement
-      (jdbc/with-connection
-        @spec
-        (jdbc/with-query-results
-          rs
-          statement
-          (first (prepare-results rs :tag)))))))
+      (-> (jdbc/query @spec statement)
+          (prepare-results :tag)
+          first))))

 (defn get-pic-data
   ([params]
    (let [user-hash (:userhash params)
-         pic-hash (:pichash params)]
-     (jdbc/with-connection
-       @spec
-       (jdbc/with-query-results
-         rs
-         ["SELECT * FROM pic WHERE userhash = ? AND pichash = ?"
-          user-hash pic-hash]
-         (prepare-results rs :pic)))))
+         pic-hash (:pichash params)
+         statement ["SELECT * FROM pic WHERE userhash = ? AND pichash = ?"
+                    user-hash pic-hash]
+         rs (jdbc/query @spec statement)]
+     (prepare-results rs :pic)))
   ([params ptr-time paginate?]
    (let [user-hash (:userhash params)
-         page (:page params)]
-     (jdbc/with-connection
-       @spec
-       (jdbc/with-query-results
-         rs
-         [(let [sql "SELECT * FROM pic WHERE userhash = ? AND ptrtime IS ?"]
-            (if paginate? (paginate page sql) sql))
-          user-hash ptr-time]
-         (prepare-results rs :pic))))))
+         page (:page params)
+         sql "SELECT * FROM pic WHERE userhash = ? AND ptrtime IS ?"
+         statement [(if paginate? (paginate page sql) sql)
+                    user-hash ptr-time]
+         rs (jdbc/query @spec statement)]
+     (prepare-results rs :pic))))

 ; insertion / removal

@@ -317,45 +299,43 @@
   (let [tags (f/tags-decode (f/b-decode-string (get args "body")))
         pics (f/b-decode-list (get args "pics"))
         pic-hash (f/b-decode-bytes (get pics 0))]
-    (jdbc/with-connection
-      @spec
-      (jdbc/delete-rows
+    (jdbc/delete! @spec
+                  :tag
+                  ["userhash = ? AND ptrtime IS ? AND mtime < ?"
+                   user-hash ptr-time edit-time])
+    (doseq [tag tags]
+      (update-or-insert!
+        @spec
         :tag
-        ["userhash = ? AND ptrtime IS ? AND mtime < ?"
-         user-hash ptr-time edit-time])
-      (doseq [tag tags]
-        (jdbc/update-or-insert-values
-          :tag
-          ["title = ? AND userhash = ? AND ptrtime IS ?"
-           tag user-hash ptr-time]
-          {:realuserhash user-hash
-           :userhash user-hash
-           :title tag
-           :mtime edit-time
-           :ptrtime ptr-time
-           :pichash pic-hash})))
+        {:realuserhash user-hash
+         :userhash user-hash
+         :title tag
+         :mtime edit-time
+         :ptrtime ptr-time
+         :pichash pic-hash}
+        ["title = ? AND userhash = ? AND ptrtime IS ?"
+         tag user-hash ptr-time]))
     tags))

 (defn insert-pic-list
   [user-hash ptr-time edit-time args]
   (let [pics (f/b-decode-list (get args "pics"))]
-    (jdbc/with-connection
-      @spec
-      (jdbc/delete-rows
-        :pic
-        ["userhash = ? AND ptrtime IS ? AND mtime < ?"
-         user-hash ptr-time edit-time])
-      (doseq [pic pics]
-        (when-let [pic-hash (f/b-decode-bytes pic)]
-          (jdbc/update-or-insert-values
-            :pic
-            ["pichash = ? AND userhash = ? AND ptrtime IS ?"
-             pic-hash user-hash ptr-time]
-            {:realuserhash user-hash
-             :userhash user-hash
-             :pichash pic-hash
-             :mtime edit-time
-             :ptrtime ptr-time}))))
+    (jdbc/delete! @spec
+                  :pic
+                  ["userhash = ? AND ptrtime IS ? AND mtime < ?"
+                   user-hash ptr-time edit-time])
+    (doseq [pic pics]
+      (when-let [pic-hash (f/b-decode-bytes pic)]
+        (update-or-insert!
+          @spec
+          :pic
+          {:realuserhash user-hash
+           :userhash user-hash
+           :pichash pic-hash
+           :mtime edit-time
+           :ptrtime ptr-time}
+          ["pichash = ? AND userhash = ? AND ptrtime IS ?"
+           pic-hash user-hash ptr-time])))
     pics))

 (defn insert-profile
@@ -365,22 +345,22 @@
         tags (insert-tag-list user-hash nil edit-time args)]
     (when (and edit-time
                (<= edit-time (.getTime (java.util.Date.))))
-      (jdbc/with-connection
+      (update-or-insert!
         @spec
-        (jdbc/update-or-insert-values
-          :user
-          ["userhash = ?" user-hash]
-          {:realuserhash user-hash
-           :userhash user-hash
-           :title (f/b-decode-string (get args "title"))
-           :body (f/b-decode-string (get args "body"))
-           :mtime edit-time
-           :pichash (f/b-decode-bytes (get pics 0))
-           :status (f/b-decode-long (get args "status"))})
-        (jdbc/update-values
-          :user
-          ["userhash = ? AND time IS NULL" user-hash]
-          {:time (.getTime (java.util.Date.))})))))
+        :user
+        {:realuserhash user-hash
+         :userhash user-hash
+         :title (f/b-decode-string (get args "title"))
+         :body (f/b-decode-string (get args "body"))
+         :mtime edit-time
+         :pichash (f/b-decode-bytes (get pics 0))
+         :status (f/b-decode-long (get args "status"))}
+        ["userhash = ?" user-hash])
+      (jdbc/update!
+        @spec
+        :user
+        {:time (.getTime (java.util.Date.))}
+        ["userhash = ? AND time IS NULL" user-hash]))))

 (defn insert-post
   [user-hash post-time args]
@@ -391,21 +371,20 @@
                (<= post-time (.getTime (java.util.Date.)))
                edit-time
                (<= edit-time (.getTime (java.util.Date.))))
-      (jdbc/with-connection
+      (update-or-insert!
         @spec
-        (jdbc/update-or-insert-values
-          :post
-          ["userhash = ? AND time = ?" user-hash post-time]
-          {:realuserhash user-hash
-           :userhash user-hash
-           :body (f/b-decode-string (get args "body"))
-           :time post-time
-           :mtime edit-time
-           :pichash (f/b-decode-bytes (get pics 0))
-           :count (count pics)
-           :ptrhash (f/b-decode-bytes (get args "ptrhash"))
-           :ptrtime (f/b-decode-long (get args "ptrtime"))
-           :status (f/b-decode-long (get args "status"))})))))
+        :post
+        {:realuserhash user-hash
+         :userhash user-hash
+         :body (f/b-decode-string (get args "body"))
+         :time post-time
+         :mtime edit-time
+         :pichash (f/b-decode-bytes (get pics 0))
+         :count (count pics)
+         :ptrhash (f/b-decode-bytes (get args "ptrhash"))
+         :ptrtime (f/b-decode-long (get args "ptrtime"))
+         :status (f/b-decode-long (get args "status"))}
+        ["userhash = ? AND time = ?" user-hash post-time]))))

 (defn insert-fav
   [user-hash fav-time args]
@@ -417,19 +396,18 @@
                (<= fav-time (.getTime (java.util.Date.)))
                edit-time
                (<= edit-time (.getTime (java.util.Date.))))
-      (jdbc/with-connection
+      (update-or-insert!
         @spec
-        (jdbc/update-or-insert-values
-          :fav
-          ["userhash = ? AND ptrhash = ? AND ptrtime IS ?"
-           user-hash ptr-hash ptr-time]
-          {:realuserhash user-hash
-           :userhash user-hash
-           :time fav-time
-           :mtime edit-time
-           :ptrhash ptr-hash
-           :ptrtime ptr-time
-           :status (f/b-decode-long (get args "status"))})))))
+        :fav
+        {:realuserhash user-hash
+         :userhash user-hash
+         :time fav-time
+         :mtime edit-time
+         :ptrhash ptr-hash
+         :ptrtime ptr-time
+         :status (f/b-decode-long (get args "status"))}
+        ["userhash = ? AND ptrhash = ? AND ptrtime IS ?"
+         user-hash ptr-hash ptr-time]))))

 (defn insert-meta-data
   [user-hash data-map]
@@ -447,10 +425,8 @@

 (defn delete-user
   [user-hash]
-  (jdbc/with-connection
-    @spec
-    (jdbc/delete-rows :user ["userhash = ?" user-hash])
-    (jdbc/delete-rows :post ["userhash = ?" user-hash])
-    (jdbc/delete-rows :pic ["userhash = ?" user-hash])
-    (jdbc/delete-rows :fav ["userhash = ?" user-hash])
-    (jdbc/delete-rows :tag ["userhash = ?" user-hash])))
+  (jdbc/delete! @spec :user ["userhash = ?" user-hash])
+  (jdbc/delete! @spec :post ["userhash = ?" user-hash])
+  (jdbc/delete! @spec :pic ["userhash = ?" user-hash])
+  (jdbc/delete! @spec :fav ["userhash = ?" user-hash])
+  (jdbc/delete! @spec :tag ["userhash = ?" user-hash]))


Add precondition checks

Add precondition checks

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -14,33 +14,43 @@

 (defn sh
   [& args]
+  {:pre [(every? string? args)]}
   (.waitFor (.exec (Runtime/getRuntime) (string/join " " args))))

 (defn print-fn [opts]
+  {:pre [(map? opts)]}
   (or (:print-no-newline opts) print))

 (defn println-fn [opts]
+  {:pre [(map? opts)]}
   (or (:print opts) println))

 (defn flush-fn [opts]
+  {:pre [(map? opts)]}
   (or (:flush opts) flush))

 (defn set-logging-level [logger-name level]
+  {:pre [(string? logger-name) (instance? java.util.logging.Level level)]}
   (.setLevel (java.util.logging.Logger/getLogger logger-name) level))

 (def ambly-bonjour-name-prefix "Ambly ")

 (defn is-ambly-bonjour-name? [bonjour-name]
+  {:pre [(string? bonjour-name)]}
   (.startsWith bonjour-name ambly-bonjour-name-prefix))

 (defn bonjour-name->display-name
   [bonjour-name]
+  {:pre [(is-ambly-bonjour-name? bonjour-name)]
+   :post [(string? %)]}
   (subs bonjour-name (count ambly-bonjour-name-prefix)))

 (defn name-endpoint-map->choice-list [name-endpoint-map]
+  {:pre [(map? name-endpoint-map)]}
   (map vector (iterate inc 1) name-endpoint-map))

 (defn print-discovered-devices [name-endpoint-map opts]
+  {:pre [(map? name-endpoint-map) (map? opts)]}
   (if (empty? name-endpoint-map)
     ((println-fn opts) "(No devices)")
     (doseq [[choice-number [bonjour-name _]] (name-endpoint-map->choice-list name-endpoint-map)]
@@ -51,6 +61,7 @@
   a simple command-line UI letting user pick one, unless
   choose-first-discovered? is set to true in which case the UI is bypassed"
   [choose-first-discovered? opts]
+  {:pre [(map? opts)]}
   (let [reg-type "_http._tcp.local."
         name-endpoint-map (atom (sorted-map))
         mdns-service (JmDNS/create)
@@ -102,21 +113,29 @@
               (.removeServiceListener mdns-service reg-type service-listener)
               (.close mdns-service))))))))

-(defn socket [host port]
+(defn socket
+  [host port]
+  {:pre [(string? host) (number? port)]}
   (let [socket (doto (Socket. host port) (.setKeepAlive true))
         in     (io/reader socket)
         out    (io/writer socket)]
     {:socket socket :in in :out out}))

-(defn close-socket [s]
+(defn close-socket
+  [s]
+  {:pre [(map? s)]}
   (.close (:socket s)))

-(defn write [^BufferedWriter out ^String js]
+(defn write
+  [out js]
+  (:pre [(instance? BufferedWriter out) (string? js)])
   (.write out js)
   (.write out (int 0)) ;; terminator
   (.flush out))

-(defn read-messages [^BufferedReader in response-promise opts]
+(defn read-messages
+  [in response-promise opts]
+  {:pre [(instance? BufferedReader in) (map? opts)]}
   (loop [sb (StringBuilder.) c (.read in)]
     (cond
       (= c -1) (do
@@ -137,6 +156,7 @@
 (defn start-reading-messages
   "Starts a thread reading inbound messages."
   [repl-env opts]
+  {:pre [(map? repl-env) (map? opts)]}
   (.start
     (Thread.
       #(try
@@ -151,6 +171,7 @@
   "Parses a stack line into a frame representation, returning nil
   if parse failed."
   [stack-line opts]
+  {:pre [(string? stack-line) (map? opts)]}
   (let [[function file line column]
         (rest (re-matches #"(.*)@file:///(.*):([0-9]+):([0-9]+)"
                 stack-line))]
@@ -170,6 +191,8 @@
   The canonical stacktrace must be a vector of maps of the form
   {:file <string> :function <string> :line <integer> :column <integer>}."
   [raw-stacktrace opts]
+  {:pre  [string? (map? opts)]
+   :post [(vector? %)]}
   (->> raw-stacktrace
     string/split-lines
     (map #(stack-line->canonical-frame % opts))
@@ -179,6 +202,7 @@
 (defn jsc-eval
   "Evaluate a JavaScript string in the JSC REPL process."
   [repl-env js]
+  {:pre [(map? repl-env) (string? js)]}
   (let [{:keys [out]} @(:socket repl-env)
         response-promise (promise)]
     (reset! (:response-promise repl-env) response-promise)
@@ -222,6 +246,8 @@

 (defn- mount-webdav
   [repl-env bonjour-name endpoint-address endpoint-port]
+  {:pre [(map? repl-env) (is-ambly-bonjour-name? bonjour-name)
+         (string? endpoint-address) (number? endpoint-port)]}
   (let [webdav-mount-point (str "/Volumes/Ambly-" (format "%08X" (hash bonjour-name)))
         output-dir (io/file webdav-mount-point)]
     (when (.exists output-dir)
@@ -233,6 +259,7 @@

 (defn- set-up-socket
   [repl-env opts address port]
+  {:pre [(map? repl-env) (map? opts) (string? address) (number? port)]}
   (when-let [socket @(:socket repl-env)]
     (close-socket socket))
   (reset! (:socket repl-env)
@@ -242,6 +269,7 @@

 (defn setup
   [repl-env opts]
+  {:pre [(map? repl-env) (map? opts)]}
   (try
     (let [_ (set-logging-level "javax.jmdns" java.util.logging.Level/OFF)
           [bonjour-name endpoint] (discover-and-choose-device (:choose-first-discovered (:options repl-env)) opts)


add arg validations to get-or-create-session, matches-requirements

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -47,6 +47,8 @@
    (s/optional-key :browser-name) s/Str
    (s/optional-key :node)         Node})

+(def Capabilities {s/Any s/Any})
+
 (def Requirement
   "A schema for a session requirement."
   (s/either
@@ -95,7 +97,14 @@
   (let [u (if (string? url) (uri/uri url) url)]
     (assoc u :host (resolve-host (uri/host u)))))

+(def OldRequirements
+  {(s/optional-key :browser-name)  s/Str
+   (s/optional-key :reserved)      s/Bool
+   (s/optional-key :tags)          [s/Str]
+   (s/optional-key :node)          {:url s/Str}})
+
 (defn matches-requirements [session-model requirements]
+  (s/validate OldRequirements requirements)
   (let [exact-match-keys [:browser-name :reserved]
         resolved-nodes (map (comp str host-resolved-url)
                             (filter identity
@@ -240,6 +249,16 @@
         (car/sadd session-set-key session-id)
         (car/return (modify-session session-id defaulted-reqs))))))

+(def OldGetOrCreateArg
+  {(s/optional-key :browser-name)  s/Str
+   (s/optional-key :reserved)      s/Bool
+   (s/optional-key :tags)          [s/Str]
+   (s/optional-key :node)          {:url s/Str}
+   (s/optional-key :current-url)   s/Str
+   (s/optional-key :reserve-after-create)       s/Bool
+   (s/optional-key :extra-desired-capabilities) Capabilities
+   (s/optional-key :force-create)               s/Bool})
+
 (defn get-or-create-session
   [{:keys [browser-name
            node
@@ -257,30 +276,28 @@
          reserve-after-create nil
          force-create nil
          current-url nil}
-    :as requirements}]
-  (s/validate (s/maybe Node ) node)
-  (let [requirements (update-in requirements [:reserved] #(or % false))]
-
-    (with-car*
-      (car/return
-        (or
-          (if force-create
-            (create-session
-              (rename-keys requirements
-                           {:reserve-after-create :reserved})))
-          (if-let [candidate (->> (view-models nil)
-                                  (filter #(matches-requirements % requirements))
-                                  first)]
-            (if (or reserve-after-create current-url)
-              (modify-session (get candidate :id)
-                              (rename-keys
-                                (select-keys requirements
-                                             [:reserve-after-create
-                                              :current-url
-                                              :tags])
-                                {:reserve-after-create :reserved}))
-              candidate))
-          (create-session requirements))))))
+    :as arg}]
+  (s/validate OldGetOrCreateArg arg)
+  (with-car*
+    (car/return
+      (or
+        (if force-create
+          (create-session
+            (rename-keys arg
+                         {:reserve-after-create :reserved})))
+        (if-let [candidate (->> (view-models nil)
+                                (filter #(matches-requirements % (dissoc arg :reserve-after-create)))
+                                first)]
+          (if (or reserve-after-create current-url)
+            (modify-session (get candidate :id)
+                            (rename-keys
+                              (select-keys arg
+                                           [:reserve-after-create
+                                            :current-url
+                                            :tags])
+                              {:reserve-after-create :reserved}))
+            candidate))
+        (create-session arg)))))

 (defn resume-webdriver-from-id [session-id]
   (if-let [model (view-model session-id)]