Drop browser caching middleware

Drop browser caching middleware

In a production setup you would more typically let your static assets be
served up by a separate server like nginx, and let that one handle
caching headers.

--- src/leiningen/new/chestnut/project.clj
+++ src/leiningen/new/chestnut/project.clj
@@ -8,7 +8,6 @@
                  [org.clojure/clojurescript "1.7.189" :scope "provided"]
                  [ring "1.4.0"]
                  [ring/ring-defaults "0.1.5"]
-                 [slester/ring-browser-caching "0.1.1"]
                  [bk/ring-gzip "0.1.1"]
                  [compojure "1.4.0"]
                  [org.omcljs/om "1.0.0-alpha28"]
@@ -58,21 +57,22 @@

   :auto {"sassc"  {:file-pattern  #"\.(scss)$"}}{{/sass?}}

-  :profiles {:dev {:dependencies [[figwheel "0.5.0-2"]
-                                  [figwheel-sidecar "0.5.0-2"]
-                                  [com.cemerick/piggieback "0.2.1"]
-                                  [org.clojure/tools.nrepl "0.2.12"]{{{project-dev-deps}}}]
+  :profiles {:dev
+             {:dependencies [[figwheel "0.5.0-2"]
+                             [figwheel-sidecar "0.5.0-2"]
+                             [com.cemerick/piggieback "0.2.1"]
+                             [org.clojure/tools.nrepl "0.2.12"]{{{project-dev-deps}}}]

-                   :plugins [[lein-figwheel "0.5.0-2"]{{{project-dev-plugins}}}]}
+              :plugins [[lein-figwheel "0.5.0-2"]{{{project-dev-plugins}}}]}

-             :uberjar {:source-paths ^:replace ["src/clj" "env/prod/clj"]
-                       :hooks [{{{project-uberjar-hooks}}}]
-                       :env {:browser-caching {"text/javascript" 604800
-                                               "text/html" 0}}
-                       :omit-source true
-                       :aot :all
-                       :cljsbuild {:builds {:app
-                                            {:source-paths ^:replace ["src/cljs" "env/prod/cljs"]
-                                             :compiler
-                                             {:optimizations :advanced
-                                              :pretty-print false}}}}}})
+             :uberjar
+             {:source-paths ^:replace ["src/clj"]
+              :hooks [{{{project-uberjar-hooks}}}]
+              :omit-source true
+              :aot :all
+              :cljsbuild {:builds
+                          [{:id "app"
+                            :source-paths ^:replace ["src/cljs"]
+                            :compiler
+                            {:optimizations :advanced
+                             :pretty-print false}}]}}})


cljs-repl does not require :repl-env keyword

--- src/leiningen/new/cljs_app/project.clj
+++ src/leiningen/new/cljs_app/project.clj
@@ -18,7 +18,7 @@
   :injections [(require '[cemerick.piggieback :refer [cljs-repl]]
                         '[weasel.repl.websocket :refer [repl-env]])
                (defn browser-repl []
-                 (cljs-repl :repl-env (repl-env :ip "0.0.0.0" :port 9001)))]
+                 (cljs-repl (repl-env :ip "0.0.0.0" :port 9001)))]
   ;; ===========================================================================

   :aliases {"server" ["trampoline" "simpleton" "8080" "file" ":from" "resources"]}


Don't play keys when scrolling [first janky version]

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -27,7 +27,6 @@
         (fn []
           (-> "sin" timbre .play .pause)
           (set! (.-ontouchstart js/document) nil))))
-

 (defn piano-key-width
   [{piano-keys :piano-keys w :w}]
@@ -114,10 +113,10 @@
     {:piano-keys (into (sorted-map) (map-indexed (fn [i freq] [freq {:n i :on? false}])
                                                  scale))
      :notes ()
-     :w 0 :h 0 :sound-ready false
+     :w 0 :h 0
+     :sound-ready false
      :px-per-ms 0.1
-     ;; :cur-touches {}
-     :scrolling? false
+     :scrolling-touch-id nil
      :start start
      :playhead start}))

@@ -163,10 +162,6 @@
     instrument
     (add-synths-to-instrument instrument)))

-(defn filter-type
-  [type touches]
-  (filter (fn [t] (= (t :type) type)) touches))
-
 (defn reduce-val->>
   [f coll val]
   (reduce f val coll))
@@ -196,65 +191,30 @@
         (assoc :notes (map (fn [n] (if (note-off? n) (assoc n :off playhead) n)) notes))
         (->> (reduce-val->> stop-piano-key (->> notes (filter note-off?) (map :freq)))))))

-;; (defn x-distance
-;;   [{{end-x :x} :position :as t} instrument]
-;;   (- (get-in instrument [:cur-touches (t :touch-id) :position :x]) end-x))
-
-;; (defn y-distance
-;;   [{{end-y :y} :position :as t} instrument]
-;;   (- (get-in instrument [:cur-touches (t :touch-id) :position :y]) end-y))
-
 (defn distance
   [{x1 :x y1 :y} {x2 :x y2 :y}]
   (.sqrt js/Math (+ (.pow js/Math (- x2 x1) 2) (.pow js/Math (- y2 y1) 2))))

-;; (defn filter-scroll-touches
-;;   [touches instrument]
-;;   (filter (fn [t] (> (.abs js/Math (distance t instrument)) 10))
-;;           (filter-type "touchmove" touches)))
-
-;; (defn record-touches
-;;   [touches instrument]
-;;   (let [starts (filter-type "touchstart" touches)
-;;         moves (filter-type "touchmove" touches)
-;;         ends (filter-type "touchend" touches)]
-;;     (-> instrument
-;;         (update-in [:cur-touches] into (map vector (map :touch-id starts) starts))
-;;         (update-in [:cur-touches] into (map vector (map :touch-id moves) moves))
-;;         (update-in [:cur-touches] (fn [c] (apply dissoc c (map :touch-id ends)))))))
-
 (defn scroll
   [touch {playhead :playhead px-per-ms :px-per-ms :as instrument}]
-  ;; #_(-> instrument
-  ;;     ;; (assoc :scrolling? true)
-  ;;   (assoc :playhead (+ playhead (/ (touch :y-distance) px-per-ms))))
-  ;; (assoc instrument :scrolling? false)
-  (assoc instrument :playhead (+ playhead (/ (touch :y-distance) px-per-ms))))
-
-;; (defn delete-scrolled-notes
-;;   [scroll-touches {notes :notes :as instrument}]
-;;   (let [scroll-touch-ids (set (map :touch-id scroll-touches))
-;;         delete-notes (group-by (fn [t] (and (nil? (t :off))
-;;                                             (contains? scroll-touch-ids (t :touch-id))))
-;;                                notes)]
-;;     (-> instrument
-;;         (assoc :notes (get delete-notes false))
-;;         (->> (reduce-val->> stop-piano-key (map :freq (get delete-notes true)))))))
-
-;; (defn handle-scrolling
-;;   [touches instrument]
-;;   (let [scroll-touches (filter-scroll-touches touches instrument)]
-;;     (->> instrument
-;;          (scroll scroll-touches)
-;;          (delete-scrolled-notes scroll-touches)
-;;          (record-touches touches))))
+  (-> instrument
+      (assoc :scroll-touch-id (touch :touch-id))
+      (assoc :playhead (+ playhead (/ (touch :y-distance) px-per-ms)))))
+
+(defn stop-scroll
+  [touch instrument]
+  (if (= (touch :touch-id) (instrument :scroll-touch-id))
+    (assoc instrument :scroll-touch-id nil)
+    instrument))

 (defn fire-touch-on-instrument
   [touch instrument]
   (condp = (touch :type)
     "touchstart" (start-note touch instrument)
     "touchmove" (scroll touch instrument)
-    "touchend" (end-notes touch instrument)))
+    "touchend" (->> instrument
+                    (end-notes touch)
+                    (stop-scroll touch))))

 (defn update-size [instrument canvas-id]
   (let [{w :w h :h :as window-size} (util/get-window-size)]
@@ -265,12 +225,6 @@
 (defn touches
   [canvas-id type]
   (mapcat< touch-data->touches (util/listen (dom/getElement canvas-id) type)))
-
-;; (defn create-touch-input-channel
-;;   [canvas-id]
-;;   (async/merge [(touches canvas-id :touchstart)
-;;                 (touches canvas-id :touchend)
-;;                 (touches canvas-id :touchmove)]))

 (defn scroll?
   [scroll-state cur-t]
@@ -349,14 +303,9 @@
               (recur (handle-touch v touch-state))))))
     out-c))

-;; (defn scroll-touches-chan
-;;   [canvas-id]
-;;   (touches canvas-id :touchmove))
-
-
 (defn step-time
   [instrument delta]
-  (if (not (instrument :scrolling?))
+  (if (not (instrument :scroll-touch-id))
     (assoc instrument :playhead (+ (instrument :playhead) delta))
     instrument))


Update intro.cljs

Update intro.cljs

--- src/prais2/intro.cljs
+++ src/prais2/intro.cljs
@@ -138,10 +138,10 @@

     [:p "The national audit body (NICOR) uses a statistical formula to combine data on these risk factors for all the children a hospital has treated over the previous three years giving a " [:b "predicted range"] " for the overall proportion of survivors for that specific hospital and time period. The audit body then compares the survival rate achieved by a hospital with its predicted range."]

-    [:p "If that hospital’s survival rate is within the ‘predicted range’, its results are in line with what we expect."]
+    [:p "If that hospital’s survival rate is within the ‘predicted range’, its results are in line with what we expect. For more information about how the NHS monitors survival rates see the 'Everything Else' section."]
     [:.bg-danger {:style {:border-radius "3px" :border "1px solid #DDD"}}
      [:p
-      "IMPORTANT! The predicted range depends on the types of patients treated at that hospital over that time period – so each hospital will have a different predicted range and its predicted range will vary from year to year!"]
+      "IMPORTANT! The predicted range depends on the types of patients treated at that hospital over that time period – so each hospital will have a different predicted range and its predicted range will vary from year to year."]
      [:p
       "That is why we only compare a hospital’s survival rate to its predicted range (from the statistical formula) and not to survival rates at other hospitals."]]]])


Some thoughts about a replacement for background prerequisites.

--- test/as_documentation/t_assumptions.clj
+++ test/as_documentation/t_assumptions.clj
@@ -2,44 +2,115 @@
   (:use midje.sweet
         midje.test-util))

-(comment

-  (fact "text"
-    (examples-assume (alive? anything) => false)
-    ...cell... => dies?
-    (provided
-      (...)))
+;; (comment

-  (prerequisite-group [(all-status) => ?desired-status]
-    (status ...foo...) => ?desired-status
-    (status ...bar...) => ?desired-status
-    (status ...quux...) => ?desired-status)
+;; ;;; how to share prerequisites from other namespaces. Define a
+;; ;;; function and call it.
+
+;; (comment
+
+;;   (fact "something"
+;;     (assume-prerequisites (ping 1) => 200
+;;                           (ping "1") => 200
+;;                           (ping 'symbol) => 404)
+;;     (f 3) => 5
+;;     (provided ...))
+
+;;   (prerequisite-group [(only-numberish-values-succeed?) => true]
+;;     (ping 1) => 200
+;;     (ping "1") => 200
+;;     (ping 'symbol) => 404)
+
+;;   (fact "text"
+;;     (assume-prerequisite (only-numberish-values-succeed?) => true)
+;;     ...)
+

-  (fact "text"
-    (examples-assume (all-status) => :dead)

-    ...cell... => dies?
-    )
-
-  ;; Empty the log before every example
-
-  (to-ensure [@log => empty?]
-    (reset! log []))
-
-(fact "something"
-  (prerequisites (f 1) => 3
-                 (f 2) => 4)
-  (ensure-prerequisite (table :whatever) => full?)
-  (g 3) => 5
-  (provided
-    (f 3) => 1))
-
-(fact
-  (allow-assumption-here (table :whim) => full))
-
-(allow-assumption-here (clean database) => true)
-
-)
+;;   (prerequisite-group [(numberish-value-status) => ?desired-status]
+;;     (ping 1) => ?desired-status
+;;     (ping "1") => ?desired-status
+;;     (ping 'symbol) => 404)
+
+;;   (fact "text"
+;;     (assume-prerequisite (numberish-value-status) => 200)
+;;     ...)

+;;   (to-ensure [(log-contents) => ?checker]
+;;     (case ?checker
+;;       empty?        (reset! log [])
+;;       (contains 5)  (reset! log [1 2 5])))
+
+;;   (to-ensure [(log-contents) => ?checker]
+;;     (reset! log []))
+;;   (to-ensure [(log-contents) => (contains ?value)]
+;;     (reset! log (range 0 ?value)))
+
+
+;;   (fact
+;;     (ensure-prerequisite (horse-count) => 5
+;;                          (cow-count) => 5)
+;;     ...)
+
+;;   (to-ensure [(horse-count) => ?number]
+;;     (ensure-prerequisite (animal-count :species :horse) => ?number))
+
+
+;;   (to-ensure [(animal-count :species ?species) => ?number]
+;;     (dotimes [n ?number]
+;;       (create-animal :species ?species
+;;                      :name  (str "horse-" n))))
+
+
+
+;;   (to-ensure [(horses
+
+;;   (to-ensure [@log => empty?]
+;;     (reset! log []))
+
+;;   (fact
+;;     (ensure-prerequisite @log => empty?)
+;;   ;; Empty the log before every example
+;;   )
+
+
+;;   (fact
+;;     (f 1) => 2  ; log in undefined state
+;;     (ensure-prerequisite @log => empty?)
+;;     (f 1) => 2)  ; log is forced to be empty
+;;     ...)
+
+
+
+;;   (fact
+;;     (ensure-prerequisite-here @log => empty?))
+
+
+;;   (fact "big claim"
+;;     (assume-prerequisite (outer 1) => 5)
+;;     (fact "subclaim"
+;;       (assume-prerequisite (inner 1) => 5)
+;;       ;; examples here see both the inner and outer prerequisites
+;;       )
+;;     ;; An example here would see only the outer prerequisite.
+;;     (fact "another subclaim")
+;;       (assume-prerequisite (inner 1) => "55555555555555555555")
+;;       ;; examples here see both prerequisites, but note that
+;;       ;; `(inner 1)` returns a different value.
+;;       )
+
+;; )
+
+;; (fact "you can insert into the database"
+;;   (ensure-prerequisite-here (table :table) => empty?)
+;;   (insert :table, :greeting "hi", :person "mom!") => truthy
+;;   (let [matches (select :table, :greeting "hi")
+;;         match (first matches)]
+;;     (count matches) => 1
+;;     (:greeting match) => "hi"
+;;     (:person match) => "mom!"))
+
+;; )


wording

wording

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -57,7 +57,7 @@
   (impl/deferred))

 (defn promise
-  "The coerce based promise constructor. Creates a appropriate promise
+  "The coerce based promise constructor. Creates an appropriate promise
   instance depending on the provided value.

   If an executor is provided, it will be used to resolve this
@@ -181,7 +181,7 @@
   "Chains a computation `f` (function) to be executed when the promise
   `p` is successfully resolved.

-  Unlike `then` this does not performs automatic promise flattening.
+  Unlike `then`, this does not perform automatic promise flattening.
   This is designed to be used with `->>`."
   ([f p]
    (pt/-map (pt/-promise p) f))
@@ -190,7 +190,7 @@

 (defn mapcat
   "Chains a computation `f` (function) to be executed when the promise
-  `p` is successfully resolved. always expecting that `f` returns a
+  `p` is successfully resolved. `f` must return a
   promise that will be automatically unwrapped.

   This is just a stricter version of `then` with reversed arguments in
@@ -211,7 +211,7 @@

 (defn chain'
   "Chain variable number of computations to be executed serially. Unlike
-  `chain` does not flattens the return value of each step (probably
+  `chain` does not flatten the return value of each step (probably
   this is more performant than `chain`)."
   ([p f] (then' p f))
   ([p f & fs] (reduce pt/-map (pt/-promise p) (cons f fs))))


Minor change

Minor change

--- src/promesa/exec.cljc
+++ src/promesa/exec.cljc
@@ -140,7 +140,7 @@
           (clojure.lang.Var/resetThreadBindingFrame frame)
           (apply f x y z args))))))

-;; --- Public Api
+;; --- Public API

 (defn run!
   "Run the task in the provided executor."


Cosmetic changes to demo.

Cosmetic changes to demo.

--- src/re_demo/time.cljs
+++ src/re_demo/time.cljs
@@ -45,63 +45,70 @@

 (defn demo1
   []
-  (let [model (reagent/atom nil)]
+  (let [model (reagent/atom nil)
+        time-input-demo [time-input :model model]
+        time-input-code "[time-input :model model]"]
     (fn []
-      [v-box
-        :style {:font-size "small"}
-        :children [[:div.h4 "Time input - empty model"]
+      [:div {:style {:font-size "small"}}
+        [v-box
+          :children [[:div.h4 "Time input - empty model"]
+                     [:label "Usage -"]
+                     [:code time-input-code]
+                     [:ul
+                       [:li [:strong ":model"] " - atom on nil"]
+                       [:li [:strong ":minimum"] " - nil - (default 0)"]
+                       [:li [:strong ":maximum"] " - nil - (default 2359)"]]
+                     [:label "Demo -"]
+                     time-input-demo]]])))
+
+(defn demo2
+  []
+  (let [model  (reagent/atom 600)
+        time-input-demo  [time-input :model model :style {:border "none"}]
+        time-input-code "[time-input :model model :style {:border \"none\"}]"]
+    (fn []
+      [:div {:style {:font-size "small"}}
+        [v-box
+          :style {:font-size "small"}
+          :children [[:div.h4 "Time input - model: 600"]
                    [:label "Usage -"]
-                   [:code "[time-input :model (reagent/atom nil) :on-change #(reset! model %)]"]
+                   [:code time-input-code]
                    [:ul
-                     [:li [:strong ":model"] " - atom on nil"]
+                     [:li [:strong ":model"] " - atom on 600"]
+                     [:li [:strong ":style"] " - map with: {:border \"none\"}"]
                      [:li [:strong ":minimum"] " - nil - (default 0)"]
                      [:li [:strong ":maximum"] " - nil - (default 2359)"]]
                    [:label "Demo -"]
-                   [time-input :model model]]])))
-
-(defn demo2
-  []
-  (let [model  (reagent/atom 600)]
-    (fn []
-      [v-box
-        :style {:font-size "small"}
-        :children [[:div.h4 "Time input - model 600"]
-                   [:label "Usage -"]
-                   [:code "[time-input
-                      :model (reagent/atom 600)
-                      :on-change #(reset! model %)
-                      :style {:border \"none\"}]"]
-                   [:ul
-                     [:li [:strong ":model"] " - atom on 600"]
-                     [:li [:strong ":on-change"] " - update the model with the new value"]
-                     [:li [:strong ":minimum"] " - nil - (default 0)"]
-                     [:li [:strong ":maximum"] " - nil - (default 2359)"]]
-                   [:label "Demo -"]
-                   [time-input :model model :style {:border "none"}]]])))
+                   time-input-demo]]])))

 (defn demo3
   []
-  (let [model  (reagent/atom 0)]
+  (let [model  (reagent/atom 0)
+        time-input-demo  [time-input :model model :disabled true]
+        time-input-code "[time-input :model model :disabled true]"]
     (fn []
-      [v-box
-        :style {:font-size "small"}
-        :children [[:div.h4 "Disabled time input - model 0"]
+      [:div {:style {:font-size "small"}}
+        [v-box
+          :children [[:div.h4 "Disabled time input - model: 0"]
                    [:label "Usage -"]
-                   [:code "[time-input :model (reagent/atom 0) :disabled true]"]
+                   [:code time-input-code]
                    [:ul
                      [:li [:strong ":model"] " - atom on nil"]
+                     [:li [:strong ":disabled"] " - true"]
                      [:li [:strong ":minimum"] " - nil -(default 0)"]
                      [:li [:strong ":maximum"] " - nil - (default 2359)"]]
                    [:label "Demo -"]
-                   [time-input :model model :disabled true]]])))
+                   time-input-demo]]])))

 (defn demo4
   []
-  (let [model  (reagent/atom 900)]
+  (let [model  (reagent/atom 900)
+        time-input-demo  [time-input :model model :on-change #(reset! model %) :show-time-icon true]
+        time-input-code "[time-input :model model :on-change #(reset! model %) :show-time-icon true]"]
     (fn []
-      [v-box
-        :style {:font-size "small"}
-        :children [[:div.h4 "Time input with icon - model 900"]
+      [:div {:style {:font-size "small"}}
+        [v-box
+          :children [[:div.h4 "Time input with icon - model: 900"]
                    [:label "Usage -"]
                    [:code "[time-input
                              :model (reagent/atom 900)
@@ -113,21 +120,27 @@
                      [:li [:strong ":minimum"] " - (default) 0"]
                      [:li [:strong ":maximum"] " - (default) 2359"]]
                    [:label "Demo -"]
-                   [time-input :model model :on-change #(reset! model %) :show-time-icon true]]])))
+                   time-input-demo]]])))

 (defn demo5
   []
-  (let [model  (reagent/atom 900)]
+  (let [model  (reagent/atom 900)
+        time-input-demo [time-input
+                          :model model
+                          :on-change #(reset! model %)
+                          :minimum 600
+                          :maximum 2159]
+        time-input-code "[time-input
+                          :model model
+                          :on-change #(reset! model %)
+                          :minimum 600
+                          :maximum 2159]"]
     (fn []
-      [v-box
-        :style {:font-size "small"}
-        :children [[:div.h4 "Time input - model 900 - range 06:00-21:59"]
+      [:div {:style {:font-size "small"}}
+        [v-box
+          :children [[:div.h4 "Time input - model: 900 - range: 06:00-21:59"]
                    [:label "Usage -"]
-                   [:code "[time-input
-                             :model (reagent/atom 900)
-                             :on-change #(reset! model %)
-                             :minimum 600
-                             :maximum 2159]"]
+                   [:code time-input-code]
                    [:ul
                      [:li [:strong ":model"] " - atom on 900"]
                      [:li [:strong ":on-change"] " - update the model with the new value"]
@@ -135,11 +148,7 @@
                      [:li [:strong ":maximum"] " - 2159"]]
                    [:label "Demo -"]
                    [:p "Try typing a value outside the range."]
-                   [time-input
-                     :model model
-                     :on-change #(reset! model %)
-                     :minimum 600
-                     :maximum 2159]]])))
+                   time-input-demo]]])))

 (defn panel
   []


restore pause

restore pause


core: ->>

core: ->>

--- data/core.clj
+++ data/core.clj
@@ -1086,3 +1086,19 @@
                        (list form x))]
         (recur threaded (next forms)))
       x)))
+
+(defmacro ->>
+  "Threads the expr through the forms. Inserts x as the
+  last item in the first form, making a list of it if it is not a
+  list already. If there are more forms, inserts the first form as the
+  last item in second form, etc."
+  {:added "1.0"}
+  [x & forms]
+  (loop [x x, forms forms]
+    (if forms
+      (let [form (first forms)
+            threaded (if (seq? form)
+                       (with-meta `(~(first form) ~@(next form)  ~x) (meta form))
+                       (list form x))]
+        (recur threaded (next forms)))
+      x)))


fix up one missed hash-map->array-map

fix up one missed hash-map->array-map

--- src/main/clojure/clojure/data/json.clj
+++ src/main/clojure/clojure/data/json.clj
@@ -515,7 +515,7 @@
   "Pretty-prints JSON representation of x to *out*. Options are the
   same as for write except :value-fn, which is not supported."
   [x & options]
-  (let [opts (merge default-write-options (apply hash-map options))]
+  (let [opts (merge default-write-options (apply array-map options))]
     (pprint/with-pprint-dispatch #(pprint-dispatch % opts)
       (pprint/pprint x))))


Fix bugs

Fix bugs

--- src/specium/core.cljc
+++ src/specium/core.cljc
@@ -13,7 +13,7 @@
   (eval* x))

 (defn- resolve* [x]
-  #?(:clj (resolve x)
+  #?(:clj @(resolve x)
      :cljs (try
              ;; I'm not sure this is the right way to resolve a symbol
              ;; in CLJS
@@ -26,7 +26,7 @@
         :else (->spec* x)))

 (defmethod ->spec* `s/spec [[_ form]]
-  (s/spec-impl form (eval* form) nil nil))
+  (s/spec-impl form (->spec form) nil nil))

 (defmethod ->spec* `s/and [[_ & pred-forms]]
   (s/and-spec-impl pred-forms (mapv ->spec pred-forms) nil))


Small optimizations

Small optimizations

--- src/ulam/connect4.clj
+++ src/ulam/connect4.clj
@@ -29,21 +29,27 @@
 (empty? (valid-moves {:p1 #{35 36 37 38 39 40 41}}))

 (defn check-nw [pos bits]
-  (and (>= (mod pos 7) 3)
+  (and
+    (>= (mod pos 7) 3)
+    (< pos 21)
     (= 3 (count (clojure.set/intersection bits
                                           #{(+ pos 6) (+ pos 12) (+ pos 18)})))))

 (defn check-north [pos bits]
-  (= 3 (count (clojure.set/intersection bits
-                                        #{(+ pos 7) (+ pos 14) (+ pos 21)}))))
+  (and (< pos 21)
+    (= 3 (count (clojure.set/intersection bits
+                                          #{(+ pos 7) (+ pos 14) (+ pos 21)})))))

 (defn check-ne [pos bits]
-  (and (< (mod pos 7) 4)
+  (and
+    (< (mod pos 7) 4)
+    (< pos 21)
     (= 3 (count (clojure.set/intersection bits
                                           #{(+ pos 8) (+ pos 16) (+ pos 24)})))))

 (defn check-east [pos bits]
-  (and (< (mod pos 7) 4)
+  (and
+    (< (mod pos 7) 4)
     (= 3 (count (clojure.set/intersection bits
                                           #{(+ pos 1) (+ pos 2) (+ pos 3)})))))


Removes core_test.clj

Removes core_test.clj

--- test/the_little_clojurian/core_test.clj
+++ test/the_little_clojurian/core_test.clj
@@ -1,7 +0,0 @@
-(ns the-little-clojurian.core-test
-  (:require [clojure.test :refer :all]
-            [the-little-clojurian.core :refer :all]))
-
-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))


DRY up route configuration

DRY up route configuration

--- src/whatsoup/core.clj
+++ src/whatsoup/core.clj
@@ -40,10 +40,15 @@
                                        :* [:any-of :property/gemüse :property/fleisch]]
                                       ["Einlage" :* :property/knusprig]]}))

-
-(defn update-ingredient! [action ingredient-idx]
-  (when-let [recipe (session/get :recipe)]
-    (session/put! :recipe (web/handle-update action (:meal-generator system) recipe (Integer/parseInt ingredient-idx)))))
+(defn ingredient-route [action]
+  (GET [(str "/" (name action) "/:idx") :idx #"[0-9]+"] [idx]
+    (let [recipe (session/get :recipe)
+          mg (:meal-generator system)
+          ingredient-idx (Integer/parseInt idx)]
+      (when recipe
+        (->> (web/handle-update action mg recipe ingredient-idx)
+             (session/put! :recipe)))
+      (response/redirect "/"))))

 (defroutes app-routes
            (GET "/" []
@@ -54,15 +59,9 @@
            (GET "/new" []
              (session/put! :recipe (web/generate-meal (:meal-generator system) ex-recipe))
              (response/redirect "/"))
-           (GET ["/new/:ingredient-idx" :ingredient-idx #"[0-9]+"] [ingredient-idx]
-             (update-ingredient! :new ingredient-idx)
-             (response/redirect "/"))
-           (GET ["/add/:ingredient-idx" :ingredient-idx #"[0-9]+"] [ingredient-idx]
-             (update-ingredient! :add ingredient-idx)
-             (response/redirect "/"))
-           (GET ["/remove/:ingredient-idx" :ingredient-idx #"[0-9]+"] [ingredient-idx]
-             (update-ingredient! :remove ingredient-idx)
-             (response/redirect "/"))
+           (ingredient-route :new)
+           (ingredient-route :add)
+           (ingredient-route :remove)
            (GET "/about" [] (web/about-page))
            (route/not-found (web/handle-404)))


Avoid equality

Avoid equality

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -39,7 +39,7 @@
 (deftype Knowledge [^:mutable kind->name->fields->index ^:mutable state]
   Object
   (get-or-create-index [this kind name fields]
-                       (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+                       (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
                        (or (get-in kind->name->fields->index [kind name (vec fields)])
                            (let [index (btree/tree 10 (alength fields))]
                              (when-let [[other-fields other-index] (first (get-in kind->name->fields->index [kind name]))]
@@ -47,12 +47,12 @@
                              (set! kind->name->fields->index (assoc-in kind->name->fields->index [kind name (vec fields)] index))
                              index)))
   (ensure-index [this kind name default-fields]
-                (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+                (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
                 (if-let [fields->index (get-in kind->name->fields->index [kind name])]
                   (assert (= (set default-fields) (set (first (keys fields->index)))))
                   (.get-or-create-index this kind name default-fields)))
   (add-facts [this kind name fields facts]
-             (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+             (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
              (let [changed? false
                    indexes (get-in kind->name->fields->index [kind name])]
                (assert (seq indexes) (pr-str kind name))
@@ -61,7 +61,7 @@
                    (set!! changed? true)))
                changed?))
   (del-facts [this kind name fields facts]
-             (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+             (assert (or (identical? kind "know") (identical? kind "remember") (identical? kind "forget")) (pr-str kind))
              (let [changed? false
                    indexes (get-in kind->name->fields->index [kind name])]
                (assert (seq indexes) (pr-str kind name))


Fix for defined functions.

Fix for defined functions.

--- src/clj/minijava/gas.clj
+++ src/clj/minijava/gas.clj
@@ -30,7 +30,7 @@
 (deftype LABEL [lbl]
   clojure.lang.IPersistentMap
   Object
-  (toString [] (str "lbl_" lbl ":")))
+  (toString [] (str (if (number? lbl) "lbl_") lbl ":")))

 ;;movl %eax, %ebx copies the contents of %eax to %ebx
 (deftype movl [src dst]


added an api  method that corresponds to the endpoint found here https://developer.spotify.com/documentation/web-api/reference-beta/#endpoint-get-a-list-of-current-users-playlists

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -377,6 +377,15 @@
   Example: (get-a-list-of-a-users-playlists {:user_id \"elkalel\" :limit 50 :offset 50} \"BQBw-JtC..._7GvA\")"
   (api-get "users/user_id/playlists"))

+(def get-a-list-of-current-users-playlists
+  " Takes two arguments, a map m with query parameters and an oauth-token t.
+  There are no compulsary keys in m. Optional keys are :limit and :offset.
+  :limit is the maxium number of tracks to return, default is 20.
+  :offset is the index of the first track to return, default is 0.
+
+  Example: (get-a-list-of-current-users-playlists {:limit 50 :offset 50} \"BQBw-JtC..._7GvA\")"
+  (api-get "me/playlists"))
+
 ;TODO - Change this fields string to be a map?
 (def get-a-playlist
   " Takes two arguments, a map m with query parameters and an optional oauth-token t.


use easing fns

use easing fns

--- src/cljs/bardo/core.cljs
+++ src/cljs/bardo/core.cljs
@@ -4,7 +4,8 @@
              :refer [put! take! <! >! chan timeout sliding-buffer]
              :as async]
             [cljs-time.core :as t]
-            [cljs-time.coerce :as c]))
+            [cljs-time.coerce :as c]
+            [bardo.ease :refer [ease]]))

 (enable-console-print!)

@@ -19,8 +20,6 @@
         now (c/to-long (t/now))]
     (- now start)))

-(def ease-fns {:linear identity})
-
 (defn tween
   [state target]
   (fn [t]
@@ -28,11 +27,11 @@

 (defn transition
   ([state target] (transition state target 500))
-  ([state target duration] (transition state target duration :linear))
-  ([state target duration ease]
+  ([state target duration] (transition state target duration :cubic-in-out))
+  ([state target duration easing & ease-args]
      (let [out (chan)
            tween-fn (tween state target)
-           ease-fn (get ease-fns ease)
+           ease-fn (ease easing ease-args)
            start (t/now)
            speed-target 16
            speed-tolerance 1
@@ -41,7 +40,7 @@
                  last-time start
                  wait speed-target]
                 (let [since (time-since start)]
-                  (put! out (tween-fn t))
+                  (put! out (tween-fn (ease-fn t)))

                   (when (< since duration)


This works better, but still needs to be reworked

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -160,7 +160,7 @@
   (not (or (set? from)
            (and (= 'string from) (= 'array to)) ;; strings are indexable
            ('#{clj-nil clj clj-or-nil} to)
-           (contains? (hash-set to 'any 'clj-nil) from))))
+           (contains? (hash-set to 'clj-nil) from))))

 (declare emit-str)

@@ -795,7 +795,7 @@
        (emits f (when coerce? ".(CljsCoreIFn)") ".X_invoke_Arity" arity "(" (comma-sep args) ")"))

       ;; this is somewhat optimistic, the analyzer tags the expression based on the body of the fn, not the actual return type.
-      (when-not (= (:tag expr) (-> f :info :ret-tag))
+      (when-not (or native? has-primitives? (= :statement (:context env)) (= (:tag expr) (-> f :info :ret-tag)))
         (emits (go-unbox-no-emit (:tag expr) nil))))))

 (defn normalize-goog-ctor [ctor]


Experiment with :case-stagnation meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -208,7 +208,7 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
-              (if (not (:print-history argmap))
+              #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :case-stagnation"))
@@ -228,7 +228,26 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
-
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-stagnation"))
+                (if (empty? (rest (:history ind)))
+                  (vec (repeat (count (:errors ind)) 1000000))
+                  (vec (for [case-history (apply map list (:history ind))]
+                         (if (zero? (first case-history))
+                           -100000  ;; solved, improvement doesn't matter
+                           (let [improvements (mapv (fn [[newer-error older-error]]
+                                                      (if (< newer-error older-error)
+                                                        1.0
+                                                        (if (= newer-error older-error)
+                                                          1.0
+                                                          0.0)))
+                                                    (partition 2 1 case-history))
+                                 weights (take (count improvements)
+                                               (iterate (partial * (- 1 improvement-discount)) 1))
+                                 sum (reduce + (mapv * improvements weights))]
+                             (- sum)))))))
               ;
               (= cat :case-gens-since-improvement)
               (if (not (:print-history argmap))


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -727,7 +727,7 @@
                          (= e (max p1e p2e)) 5
                          :else 4)))
                 (vec (repeat (count (:errors ind)) 5)))
-              (if (and (:parent1-errors ind)
+              #_(if (and (:parent1-errors ind)
                        (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)
@@ -739,6 +739,16 @@
                          (= e (min p1e p2e)) 2
                          (< e (max p1e p2e)) 2
                          (= e (max p1e p2e)) 2
+                         :else 3)))
+                (vec (repeat (count (:errors ind)) 3)))
+              (if (:parent1-errors ind)
+                (vec (for [[e p1e] (mapv #(vector %1 %2)
+                                         (:errors ind)
+                                         (:parent1-errors ind))]
+                       (cond
+                         (zero? e) 0
+                         (< e p1e) 1
+                         (= e p1e) 2
                          :else 3)))
                 (vec (repeat (count (:errors ind)) 3)))
               ;


:bug: Fix `random-nonce` function (wrong params).

--- backend/vendor/sodi/src/sodi/prng.clj
+++ backend/vendor/sodi/src/sodi/prng.clj
@@ -34,5 +34,5 @@
   [^long numbytes]
   (let [buffer (ByteBuffer/allocate numbytes)]
     (.putLong buffer (System/currentTimeMillis))
-    (.put buffer (random-bytes (.remaining buffer) rng))
+    (.put buffer (random-bytes (.remaining buffer)))
     (.array buffer)))


Move (un)succesful-run into separate functions

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -219,6 +219,19 @@
    vals
    (some true?)))

+(defn successful-run
+  [world-state]
+  (let [inc-stats (partial merge-with + {:runs 1, :success 1})]
+    (-> world-state
+        reset-to-initial
+        (update-in [:stats] inc-stats))))
+
+
+(defn unsuccessful-run
+  [world-state]
+  (-> world-state
+      reset-to-initial
+      (update-in [:stats :runs] inc)))

 (defn move-randomly
   [world-state]
@@ -227,13 +240,10 @@
     (do
       (reset! ticker @interval)
       (if (any-target-flipped? world-state)
-        (update-in (reset-to-initial world-state)
-                   [:stats] (partial  merge-with + {:runs 1, :success 1}))
+        (successful-run world-state)
         (if-let [m (get-random-legal-move-name world-state)]
           (flip-update-edge m world-state)
-          (update-in (reset-to-initial world-state)
-                     [:stats :runs] inc)
-          )))
+          (unsuccessful-run world-state))))
     world-state))


Use handy util fns.

Use handy util fns.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -33,9 +33,9 @@
   (let [assignee (extract node [:c 0])
         type-identifier (interpret (extract node [:c 2]) env)]
     (if-let [type-hash (get (:types (:ctx env)) type-identifier)]
-      (let [new-ctx (assign (:ctx env) assignee (instantiate-type type-hash))]
+      (let [new-ctx (assign (:ctx env) assignee (story-utils/instantiate-type type-hash))]
         (nreturn new-ctx))
-      (throw (Exception. (str "I do not know what a " type-identifier " is."))))))
+      (utils/thr (str "I do not know what a " type-identifier " is.")))))

 (defmethod interpret :invocation [node env]
   (let [function (lookup-ref (interpret (extract node [:c 0]) env) env)
@@ -76,7 +76,7 @@
         current-slot-value (get (get ctx object-name) (keyword slot-name-str))]
     (if (nil? current-slot-value) ;; initial value of intended slot will never be nil
       (let [object-class (friendly-class (class (get ctx object-name)))]
-        (throw (Exception. (str object-class "s do not have a " slot-name-str "."))))
+        (utils/thr (str object-class "s do not have a " slot-name-str ".")))
       (assoc ctx object-name (assoc (get ctx object-name) (keyword slot-name-str) value)))))

 (defn nreturn
@@ -99,16 +99,8 @@
     (let [unrolled-ast (if (seq? ast) (vec ast) ast)]
       (if (contains? unrolled-ast nxt)
         (extract (get unrolled-ast nxt) (rest route))
-        (thr ["AST " unrolled-ast " does not have " nxt])))
+        (utils/thr ["AST " unrolled-ast " does not have " nxt])))
     ast))
-
-(defn instantiate-type [type-hash]
-  (clojure.lang.Reflector/invokeConstructor
-   (:type type-hash)
-   (to-array (:defaults type-hash))))
-
-(defn thr [pieces]
-  (throw (Exception. (apply str pieces))))

 (defn friendly-class [clazz]
   (last (str/split (str clazz) #"\.")))


fix plugins shouldn't require a restart when installed

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

--- src/lt/objs/plugins.cljs
+++ src/lt/objs/plugins.cljs
@@ -198,9 +198,9 @@
         (object/update! app/app [::plugins] assoc name {})
         (fetch-and-install (-> plugin :tar) name
                            (fn []
+                             (object/raise manager :refresh!)
                              (when cb
                                (cb true))
-                             (object/raise manager :refresh!)
                              )))
       (do
         (notifos/set-msg! (str name " is already installed"))


forgot to pass `classes-seen` in defui

forgot to pass `classes-seen` in defui

--- src/main/om_css/core.clj
+++ src/main/om_css/core.clj
@@ -190,7 +190,8 @@
         css-str (when style
                   (garden/css style))
         component-info {:ns-name ns-name
-                        :component-name (str name)}
+                        :component-name (str name)
+                        :classes classes}
         forms (reshape-defui forms component-info classes)
         name (cond-> name
                (-> name meta :once) (vary-meta assoc :once true))]


cleaner implementation of org update + make sure we are returning all relevant fields in members listing.

--- src/metabase/api/org.clj
+++ src/metabase/api/org.clj
@@ -31,15 +31,10 @@
     org))

 (defendpoint PUT "/:id" [id :as {body :body}]
-  ;; TODO - validations (email address must be unique)
   (let-404 [{:keys [can_write] :as org} (sel :one Org :id id)]
     (check-403 @can_write)
-    ;; TODO - how can we pass a useful error message in the 500 response on error?
-    (upd Org id
-      ;; TODO - find a way to make this cleaner.  we don't want to modify the value if it doesn't exist
-      :name (get body :name (:name org))
-      :description (get body :description (:description org))
-      :logo_url (get body :logo_url (:logo_url org)))
+    (check-500 (->> (util/select-non-nil-keys body :name :description :logo_url)
+                 (mapply upd Org id)))
     (sel :one Org :id id)))

@@ -61,11 +56,7 @@
   (let-404 [{:keys [can_read] :as org} (sel :one Org :id id)]
     (check-403 @can_read)
     (-> (sel :many OrgPerm :organization_id id)
-        (hydrate :user)
-        (->> (map (fn [org-perm]                                ; strip IDs for safety (?)
-                    (-> org-perm
-                        (dissoc :id :organization_id :user_id)
-                        (dissoc-in [:user :id] ))))))))
+        (hydrate :user :organization))))

 (defendpoint POST "/:org-id/members" [org-id :as {{:keys [first_name last_name email orgId admin]} :body}]


add id-sk-with-origin in schema def

add id-sk-with-origin in schema def

--- src/navigator/schema.clj
+++ src/navigator/schema.clj
@@ -25,6 +25,7 @@
    [:comp-tag-disp-ctx {:attr [[:name :string]]}]
    [:perf-asmt {:attrs [[:id-sk :string "Shared key from 3rd parties"]
                         [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
+                        [:id-sk-with-origin :string "Combined id-sk and id-sk-origin" :db.unique/identity]
                         [:name :string]
                         [:version :string] ; not null

@@ -38,6 +39,7 @@
                        (constraints/unique :perf-asmt :id-sk :id-sk-origin)]}]
    [:task {:attrs [[:id-sk :string]
                    [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
+                   [:id-sk-with-origin :string "Combined id-sk and id-sk-origin" :db.unique/identity]
                    [:name :string]
                    [:version :string]
                    [:description :string]


don't let people remove the dummy attrs (fixes undoing deletes)

--- src/pc/http/datomic2.clj
+++ src/pc/http/datomic2.clj
@@ -58,6 +58,7 @@
                               uuid-attrs (get-uuid-attrs db)
                               server-timestamp (java.util.Date.)]
                           (->> datoms
+                               (remove #(= :dummy (:a %)))
                                (filter (partial common/public? db))
                                (map pcd/datom->transaction)
                                (map (partial coerce-floats float-attrs))


Add :pred into state to express more flexible exit condition

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -6,11 +6,12 @@
 (s/def ::path (s/coll-of (s/or :keyword keyword? :int integer?)))
 (s/def ::val any?)
 (s/def ::in (s/coll-of (s/or :keyword keyword? :int integer?)))
+(s/def ::pred any?)
 (s/def ::spec-name keyword?)
 (s/def ::skip? boolean?)

 (s/def ::state
-  (s/keys :req-un [::spec ::path ::val ::in]
+  (s/keys :req-un [::spec ::path ::val ::in ::pred]
           :opt-un [::spec-name ::skip?]))

 (s/def ::succ (s/fspec :args (s/cat :arg ::state) :ret any?))
@@ -195,11 +196,11 @@
       (assoc state :spec-name spec)
       (dissoc state :spec-name))))

-(defn trace [{:keys [path in val] :as problem} spec value]
-  (letfn [(rec [{:keys [path] :as state} fail ret]
-            (if (empty? path)
+(defn trace [{:keys [path in val pred] :as problem} spec value]
+  (letfn [(rec [{:keys [spec] :as state} fail ret]
+            (if (or (= spec pred) (symbol? spec) (seq? spec))
               ret
-              (step state
+              (step (assoc state :pred pred)
                     (fn [{:keys [spec skip?] :as state'} fail]
                       (let [spec (if (keyword? spec) spec (second spec))
                             state' (normalize (assoc state' :spec spec))


Fix Unmatched delimiter: ).

Fix Unmatched delimiter: ).

--- src/statuses/routing.clj
+++ src/statuses/routing.clj
@@ -133,7 +133,7 @@
   (GET    [route/update-template, :id #"[0-9]+"]           [id :as r]     (page id r))
   (DELETE [route/update-template, :id #"[0-9]+"]           [id :as r]     (delete-entry id r))
   (GET    [route/update-replyform-template, :id #"[0-9]+"] [id :as r]     (replyform id r))
-  (GET    [route/conversation-template                     [id :as r]     (conversation id r))
+  (GET    route/conversation-template                      [id :as r]     (conversation id r))
   (GET    route/info-template                              []             info)
   (GET    route/too-long-template                          [length :as r] (too-long length r))
   (not-found "Not Found"))


Use offset from current time to construct measure

--- src/tenor/constructs.clj
+++ src/tenor/constructs.clj
@@ -59,7 +59,7 @@
   `(list 'at ~time (list ~player ~entity)))

 (defmacro construct-measure [measure-maps base-time player]
-  `(map #(construct-note (* (:pos %) ~base-time)
-                         ~player (:note %))
+  `(map #(construct-note (+ (now) (* (:pos %) ~base-time))
+                         '~player (:note %))
         ~measure-maps))


Bumps version to 1.51.1-SNAPSHOT

Bumps version to 1.51.1-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.51.0"
+(defproject cook "1.51.1-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Bumps version to 1.36.2

Bumps version to 1.36.2

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.36.1"
+(defproject cook "1.36.2-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Bumps version to 1.38.5-SNAPSHOT

Bumps version to 1.38.5-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.38.4"
+(defproject cook "1.38.5-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


remove dead code

remove dead code

--- src/babel/index.cljc
+++ src/babel/index.cljc
@@ -106,31 +106,6 @@
       (log/trace (str "comp-phrases of parent: " (label-of parent) " is empty.")))
     result))

-;; TODO: remove this: has already been removed in favor of (map-subset-by-path)
-;; TODO: document how this works and especially what 'phrase-constraint' means.
-(defn create-index [grammar lexicon phrase-constraint]
-  (let [lexicon (if (map? lexicon)
-                  (keys lexicon)
-                  lexicon)]
-    (log/info (str "create index with lexicon with size: " (count lexicon)))
-    (conj (build-lex-sch-index grammar
-                               (map (fn [lexeme]
-                                      (log/debug (str "trying(ci) lexeme: " lexeme))
-                                      (unify lexeme
-                                              {:phrasal false}))
-                                    lexicon)
-                               grammar)
-          {:phrase-constraints phrase-constraint
-           :phrases-for-spec
-           (spec-to-phrases
-            ;; TODO: make this list derivable from the grammar and /or lexicon.
-            (list {:synsem {}, :head {:synsem {}}, :phrasal true}
-                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:subcat {:2 {}, :1 {}}, :infl :present, :cat :verb, :sem {:tense :present}}, :phrasal false}, :phrasal true}
-                  {:synsem {:cat :verb}, :head {:synsem {:cat :verb, :infl {:not :past}, :subcat {:2 {:cat :noun, :subcat (), :pronoun true}, :1 {}}}, :phrasal false}, :phrasal true}
-                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:cat :verb, :infl :infinitive, :subcat {:2 {}, :1 {}}}, :phrasal false}, :phrasal true}
-                  )
-            grammar)})))
-
 (defn show-spec [spec]
   (cond (seq? spec)
         (map show-spec spec)
@@ -211,7 +186,6 @@
                              index-lexicon-on-paths)))]
     (log/debug (str "indexed size returned: " (count result) " for spec: " (strip-refs spec)))
     (if (and false (empty? result))
-      (throw (Exception. (str "oops: " (strip-refs spec)))))
-
+      (throw (Exception. (str "lookup-spec failed: " (strip-refs spec)))))
     result))


cast sql parameters to timestamps

cast sql parameters to timestamps

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -322,7 +322,8 @@
     (let [results (db/exec-raw [(str "SELECT count(*)
                                         FROM expression
                                        WHERE language=?
-                                         AND ((? IS NULL) OR (expression.created > ?::timestamp))
+                                         AND ((?::timestamp IS NULL) OR
+                                              (expression.created > ?::timestamp))
                                          AND active=true
                                          AND structure @> ?::jsonb "
                                      " LIMIT 1 ")
@@ -333,7 +334,8 @@
     (let [results (db/exec-raw [(str "SELECT surface,structure
                                         FROM expression
                                        WHERE language=?
-                                         AND ((? IS NULL) OR (expression.created > ?::timestamp))
+                                         AND ((?::timestamp IS NULL) OR
+                                              (expression.created > ?::timestamp))
                                          AND active=true
                                          AND structure @> ?::jsonb "
                                      " LIMIT 1 ")


ignore various special chars

ignore various special chars

--- src/blx/sortable.clj
+++ src/blx/sortable.clj
@@ -31,16 +31,23 @@
     (->> (line-seq rdr)
          (mapv parse-json))))

+(defn remove-special-chars [s]
+  ((fnil str/replace "") s #"[_-]" ""))
+
+(defn remove-spaces [s]
+  ((fnil str/replace "") s #" " ""))
+
 (defn prepare-product [product]
   (-> product
-      (update :product_name #(str/replace % #"[_-]" " "))))
+      (update :product_name (comp remove-spaces remove-special-chars))))

-
-; misfire: got "Samsung PL100" for listing "Samsung PL 120 purple"

 (defn longest-starting-match [a b]
-  (->> (map vector a b)
+  (->> [a b]
+       (map (comp remove-spaces remove-special-chars))
+       (map str/lower-case)
+       (apply map vector)
        (reduce (fn [match-len [a b]]
                  (if (= a b)
                    (inc match-len)
@@ -62,9 +69,20 @@
                                                            (:product_name %))
                                    %))
                      (sort-by first >)
-                     (filter #(> (first %) min-match-len))
+                     (filter (fn [[_ prod]]
+                               (if (:model prod)
+                                 (.contains (remove-special-chars (remove-spaces (:title listing)))
+                                            (remove-special-chars (remove-spaces (:model prod))))
+                                 true)))
+                     (filter #(> (first %)
+                                 ; Longer than just manufacturer name
+                                 (max min-match-len (count (:manufacturer listing)))))
                      (take 3))]
-    matches))
+    ; Do not allow ties
+    (when (and matches
+               (not= (first (first matches))
+                     (first (second matches))))
+      (first matches))))

 (defn match' [products listing]
   (println "Trying to match " listing)


Added nesting to args.

Added nesting to args.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -58,6 +58,9 @@
           ;; Maximum size of push programs and push code, as counted by points
           ;; in the program. 1/4 this limit is used as the limit for sizes of
           ;; Plush genomes.
+
+         :max-nested-depth 200
+          ;; Maximum nested depth of push code and other nested objects.

          :max-genome-size-in-initial-program 50
           ;; Maximum size of initial Plush genomes in generation 0. Keep in mind


Indexing bugfix. Simple sort on selects.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -88,14 +88,28 @@
     :else
       (raise "where op not recognized")))

+(defn- order-keyfn [attr dir]
+  (assert (#{:asc :dsc} dir))
+  (if (= dir :asc)
+    (fn [record-a record-b]
+      (compare (attr record-a) (attr record-b)))
+    (fn [record-a record-b]
+      (compare (attr record-b) (attr record-a)))))
+
+(defn- apply-order [records order]
+  (if-let [[attr dir] order]
+    (sort (order-keyfn attr dir) records)
+    records))
+
 (defn- apply-offset [records offset]
   (if offset (drop offset records) records))

 (defn- apply-limit [records limit]
   (if limit (take limit records) records))

-(defn- find-records [records {:keys [where offset limit]}]
+(defn- find-records [records {:keys [where order offset limit]}]
   (-> (filter (where-pred where) records)
+    (apply-order order)
     (apply-offset offset)
     (apply-limit limit)))

@@ -120,7 +134,7 @@
           (reduce
             (fn [[int-rmap int-imap] old-record]
               (let [new-record (merge-compact old-record with)
-                    aug-rmap   (assoc (:id old-record) new-record)
+                    aug-rmap   (assoc int-rmap (:id old-record) new-record)
                     aug-imap   (-> int-imap
                                  (indexes-delete old-record)
                                  (indexes-insert new-record))]


add the frame back in for new windows

add the frame back in for new windows

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

--- src/lt/objs/app.cljs
+++ src/lt/objs/app.cljs
@@ -38,7 +38,7 @@
                                                                      :new-instance true
                                                                      :min_height 400
                                                                      :min_width 400
-                                                                     :frame false
+                                                                     :frame true
                                                                      :show false}))]
     (set! (.-ltid w) id)
     w))


Separate async handler into different name so that the request will not fallback to sync handler

--- test/buddy/auth/accessrules_tests.clj
+++ test/buddy/auth/accessrules_tests.clj
@@ -53,10 +53,12 @@
 )

 (defn test-handler
-  ([req]
-   (http/response req))
-  ([req respond _]
-   (respond (test-handler req))))
+  [req]
+  (http/response req))
+
+(defn async-test-handler
+  [req respond _]
+  (respond (test-handler req)))

 (deftest restrict-test
   (testing "restrict handler 1"
@@ -65,7 +67,7 @@
       (is (= {:foo "bar"} (:body rsp)))))

   (testing "restrict async handler 1"
-    (let [handler (restrict test-handler {:handler {:or [ok fail]}})
+    (let [handler (restrict async-test-handler {:handler {:or [ok fail]}})
           req     {:foo "bar"}
           rsp     (promise)
           ex      (promise)]
@@ -78,7 +80,7 @@
       (is (thrown? clojure.lang.ExceptionInfo (handler {:foo "bar"})))))

   (testing "restrict async handler with failure 1"
-    (let [handler (restrict test-handler {:handler {:or [fail fail]}})
+    (let [handler (restrict async-test-handler {:handler {:or [fail fail]}})
           req     {:foo "bar"}
           rsp     (promise)
           ex      (promise)]
@@ -93,7 +95,7 @@
       (is (= 400 (:status rsp)))))

   (testing "restrict async handler with failure 2"
-    (let [handler (restrict test-handler {:handler {:or [fail fail]}})
+    (let [handler (restrict async-test-handler {:handler {:or [fail fail]}})
           req     {:msg "Failure message"}
           rsp     (promise)
           ex      (promise)]
@@ -110,7 +112,7 @@
       (is (= "onfail-test" (:body rsp)))))

   (testing "restrict async handlerw with failure and explicit on-error handler"
-    (let [handler (restrict test-handler
+    (let [handler (restrict async-test-handler
                             {:handler {:or [fail fail]}
                              :on-error (fn [req val] (http/response (str "onfail-" val)))})
           req     {:msg "test"}
@@ -129,7 +131,7 @@
       (is (= "/foobar" (get-in rsp [:headers "Location"])))))

   (testing "restrict async handlerw with failure and redirect"
-    (let [handler (restrict test-handler
+    (let [handler (restrict async-test-handler
                             {:handler {:or [fail fail]}
                              :redirect "/foobar"})
           req     {:msg "test"}
@@ -165,14 +167,28 @@
   (wrap-access-rules test-handler
                      (assoc params1 :policy :reject)))

+(def async-handler1
+  (wrap-access-rules async-test-handler
+                     (assoc params1 :policy :reject)))
+
 (def handler2
   (wrap-access-rules test-handler
                      (assoc params1
                        :policy :reject
                        :on-error on-error)))

+(def async-handler2
+  (wrap-access-rules async-test-handler
+                     (assoc params1
+                            :policy :reject
+                            :on-error on-error)))
+
 (def handler3
   (wrap-access-rules test-handler
+                     (assoc params2 :policy :reject)))
+
+(def async-handler3
+  (wrap-access-rules async-test-handler
                      (assoc params2 :policy :reject)))

 (deftest wrap-access-rules-test
@@ -184,7 +200,7 @@
     (let [req {:uri "/path1"}
           rsp (promise)
           ex  (promise)]
-      (handler1 req rsp ex)
+      (async-handler1 req rsp ex)
       (is (= {:uri "/path1"} (:body @rsp)))
       (is (not (realized? ex)))))

@@ -196,7 +212,7 @@
     (let [req {:uri "/path2"}
           rsp (promise)
           ex  (promise)]
-      (handler1 req rsp ex)
+      (async-handler1 req rsp ex)
       (is (= {:uri "/path2"} (:body @rsp)))
       (is (not (realized? ex)))))

@@ -207,7 +223,7 @@
     (let [req {:uri "/path3"}
           rsp (promise)
           ex  (promise)]
-      (handler1 req rsp ex)
+      (async-handler1 req rsp ex)
       (is (instance? clojure.lang.ExceptionInfo @ex))
       (is (not (realized? rsp)))))

@@ -218,7 +234,7 @@
     (let [req {:uri "/path4"}
           rsp (promise)
           ex  (promise)]
-      (handler1 req rsp ex)
+      (async-handler1 req rsp ex)
       (is (instance? clojure.lang.ExceptionInfo @ex))
       (is (not (realized? rsp)))))

@@ -231,7 +247,7 @@
     (let [req {:uri "/path3"}
           rsp (promise)
           ex  (promise)]
-      (handler2 req rsp ex)
+      (async-handler2 req rsp ex)
       (is (= 400 (:status @rsp)))
       (is (= {:uri "/path3" :match-params {}} (:body @rsp)))
       (is (not (realized? ex)))))
@@ -245,7 +261,7 @@
     (let [req {:uri "/path4"}
           rsp (promise)
           ex  (promise)]
-      (handler2 req rsp ex)
+      (async-handler2 req rsp ex)
       (is (= 400 (:status @rsp)))
       (is (= nil (:body @rsp)))
       (is (not (realized? ex)))))
@@ -260,7 +276,7 @@
     (let [req {:uri "/path1"}
           rsp (promise)
           ex  (promise)]
-      (handler3 req rsp ex)
+      (async-handler3 req rsp ex)
       (is (= {:uri "/path1"} (:body @rsp)))
       (is (not (realized? ex)))))

@@ -272,7 +288,7 @@
     (let [req {:uri "/path2"}
           rsp (promise)
           ex  (promise)]
-      (handler3 req rsp ex)
+      (async-handler3 req rsp ex)
       (is (= {:uri "/path2"} (:body @rsp)))
       (is (not (realized? ex)))))

@@ -286,7 +302,7 @@
     (let [req {:uri "/path/foobar" :body "Fail" :status 400 :headers {}}
           rsp (promise)
           ex  (promise)]
-      (handler3 req rsp ex)
+      (async-handler3 req rsp ex)
       (is (= 400 (:status @rsp)))
       (is (= {:param "foobar"} (:match-params @rsp)))
       (is (= "Fail" (:body @rsp)))
@@ -299,7 +315,7 @@
     (let [req {:uri "/path3"}
           rsp (promise)
           ex  (promise)]
-      (handler3 req rsp ex)
+      (async-handler3 req rsp ex)
       (is (instance? clojure.lang.ExceptionInfo @ex))
       (is (not (realized? rsp)))))

@@ -310,7 +326,7 @@
     (let [req {:uri "/path4"}
           rsp (promise)
           ex  (promise)]
-      (handler3 req rsp ex)
+      (async-handler3 req rsp ex)
       (is (instance? clojure.lang.ExceptionInfo @ex))
       (is (not (realized? rsp)))))
 )
@@ -323,12 +339,22 @@
              :request-method allowed}]
     :policy :reject}))

+(defn async-method-handler [type type-param allowed]
+  (wrap-access-rules
+   async-test-handler
+   {:rules [{type type-param
+             :handler ok
+             :request-method allowed}]
+    :policy :reject}))
+
 (deftest wrap-access-rules-method-test
   (let [allowed {:uri "/comments/1" :request-method :get}
         forbidden (assoc allowed :request-method :delete)]

     (testing "access rule pattern"
-      (let [method-handler (partial method-handler :pattern #"/comments/\d+")]
+      (let [method-handler (partial method-handler :pattern #"/comments/\d+")
+            async-method-handler (partial async-method-handler
+                                          :pattern #"/comments/\d+")]

         (testing "with keyword as allowed method"
           (let [handler (method-handler :get)]
@@ -336,7 +362,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with keyword as allowed method"
-          (let [handler (method-handler :get)]
+          (let [handler (async-method-handler :get)]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -354,7 +380,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with set of keywords as allowed method"
-          (let [handler (method-handler #{:get})]
+          (let [handler (async-method-handler #{:get})]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -371,7 +397,7 @@
             (is (= (:body (handler allowed)) allowed))))

         (testing "async with nil as allowed request method"
-          (let [handler (method-handler nil)
+          (let [handler (async-method-handler nil)
                 rsp     (promise)
                 ex      (promise)]
             (handler allowed rsp ex)
@@ -379,7 +405,9 @@
             (is (not (realized? ex)))))))

     (testing "access rule uri"
-      (let [method-handler (partial method-handler :uri "/comments/:id")]
+      (let [method-handler (partial method-handler :uri "/comments/:id")
+            async-method-handler (partial async-method-handler
+                                          :uri "/comments/:id")]

         (testing "with keyword as allowed method"
           (let [handler (method-handler :get)]
@@ -387,7 +415,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with keyword as allowed method"
-          (let [handler (method-handler :get)]
+          (let [handler (async-method-handler :get)]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -405,7 +433,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with set of keywords as allowed method"
-          (let [handler (method-handler #{:get})]
+          (let [handler (async-method-handler #{:get})]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -422,7 +450,7 @@
             (is (= (:body (handler allowed)) allowed))))

         (testing "async with nil as allowed request method"
-          (let [handler (method-handler nil)
+          (let [handler (async-method-handler nil)
                 rsp     (promise)
                 ex      (promise)]
             (handler allowed rsp ex)
@@ -430,7 +458,9 @@
             (is (not (realized? ex)))))))

     (testing "access rule uris"
-      (let [method-handler (partial method-handler :uris ["/comments/:id"])]
+      (let [method-handler (partial method-handler :uris ["/comments/:id"])
+            async-method-handler (partial async-method-handler
+                                          :uris ["/comments/:id"])]

         (testing "with keyword as allowed method"
           (let [handler (method-handler :get)]
@@ -438,7 +468,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with keyword as allowed method"
-          (let [handler (method-handler :get)]
+          (let [handler (async-method-handler :get)]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -456,7 +486,7 @@
             (is (thrown? clojure.lang.ExceptionInfo (handler forbidden)))))

         (testing "async with set of keywords as allowed method"
-          (let [handler (method-handler #{:get})]
+          (let [handler (async-method-handler #{:get})]
             (let [rsp (promise)
                   ex  (promise)]
               (handler allowed rsp ex)
@@ -473,7 +503,7 @@
             (is (= (:body (handler allowed)) allowed))))

         (testing "async with nil as allowed request method"
-          (let [handler (method-handler nil)
+          (let [handler (async-method-handler nil)
                 rsp     (promise)
                 ex      (promise)]
             (handler allowed rsp ex)


union tutorial works

union tutorial works

--- test/cellophane/om_tutorials_test.clj
+++ test/cellophane/om_tutorials_test.clj
@@ -296,4 +296,209 @@

")))))

-
+;; =============================================================================
+;; Queries with unions
+
+(def union-init-data
+  {:dashboard/items
+   [{:id 0 :type :dashboard/post
+     :author "Laura Smith"
+     :title "A Post!"
+     :content "Lorem ipsum dolor sit amet, quem atomorum te quo"
+     :favorites 0}
+    {:id 1 :type :dashboard/photo
+     :title "A Photo!"
+     :image "photo.jpg"
+     :caption "Lorem ipsum"
+     :favorites 0}
+    {:id 2 :type :dashboard/post
+     :author "Jim Jacobs"
+     :title "Another Post!"
+     :content "Lorem ipsum dolor sit amet, quem atomorum te quo"
+     :favorites 0}
+    {:id 3 :type :dashboard/graphic
+     :title "Charts and Stufff!"
+     :image "chart.jpg"
+     :favorites 0}
+    {:id 4 :type :dashboard/post
+     :author "May Fields"
+     :title "Yet Another Post!"
+     :content "Lorem ipsum dolor sit amet, quem atomorum te quo"
+     :favorites 0}]})
+
+(defui Post
+  static cellophane/IQuery
+  (query [this]
+    [:id :type :title :author :content])
+  Object
+  (render [this]
+    (let [{:keys [title author content] :as props} (cellophane/props this)]
+      (dom/div nil
+        (dom/h3 nil title)
+        (dom/h4 nil author)
+        (dom/p nil content)))))
+
+(def post (cellophane/factory Post))
+
+(defui Photo
+  static cellophane/IQuery
+  (query [this]
+    [:id :type :title :image :caption])
+  Object
+  (render [this]
+    (let [{:keys [title image caption]} (cellophane/props this)]
+      (dom/div nil
+        (dom/h3 nil (str "Photo: " title))
+        (dom/div nil image)
+        (dom/p nil "Caption: ")))))
+
+(def photo (cellophane/factory Photo))
+
+(defui Graphic
+  static cellophane/IQuery
+  (query [this]
+    [:id :type :title :image])
+  Object
+  (render [this]
+    (let [{:keys [title image]} (cellophane/props this)]
+      (dom/div nil
+        (dom/h3 nil (str "Graphic: " title))
+        (dom/div nil image)))))
+
+(def graphic (cellophane/factory Graphic))
+
+(defui DashboardItem
+  static cellophane/Ident
+  (ident [this {:keys [id type]}]
+    [type id])
+  static cellophane/IQuery
+  (query [this]
+    (zipmap
+      [:dashboard/post :dashboard/photo :dashboard/graphic]
+      (map #(conj % :favorites)
+        [(cellophane/get-query Post)
+         (cellophane/get-query Photo)
+         (cellophane/get-query Graphic)])))
+  Object
+  (render [this]
+    (let [{:keys [id type favorites] :as props} (cellophane/props this)]
+      (dom/li
+        #js {:style #js {:padding 10 :borderBottom "1px solid black"}}
+        (dom/div nil
+          (({:dashboard/post    post
+             :dashboard/photo   photo
+             :dashboard/graphic graphic} type)
+            (cellophane/props this)))
+        (dom/div nil
+          (dom/p nil (str "Favorites: " favorites))
+          (dom/button
+            #js {:onClick
+                 (fn [e]
+                   (cellophane/transact! this
+                     `[(dashboard/favorite {:ref [~type ~id]})]))}
+            "Favorite!"))))))
+
+(def dashboard-item (cellophane/factory DashboardItem))
+
+(defui Dashboard
+  static cellophane/IQuery
+  (query [this]
+    [{:dashboard/items (cellophane/get-query DashboardItem)}])
+  Object
+  (render [this]
+    (let [{:keys [dashboard/items]} (cellophane/props this)]
+      (apply dom/ul
+        #js {:style #js {:padding 0}}
+        (map dashboard-item items)))))
+
+(defmulti union-read cellophane/dispatch)
+
+(defmethod union-read :dashboard/items
+  [{:keys [state]} k _]
+  (let [st @state]
+    {:value (into [] (map #(get-in st %)) (get st k))}))
+
+(defmulti mutate cellophane/dispatch)
+
+(defmethod mutate 'dashboard/favorite
+  [{:keys [state]} k {:keys [ref]}]
+  {:action
+   (fn []
+     (swap! state update-in (conj ref :favorites) inc))})
+
+(def union-reconciler
+  (cellophane/reconciler
+    {:state  union-init-data
+     :parser (cellophane/parser {:read union-read :mutate mutate})}))
+
+
+(deftest test-unions-tutorial
+    (let [c (cellophane/add-root! union-reconciler Dashboard nil)]
+      (is (= (dom/render-to-str c)
+            (remove-whitespace
+              "

+

+

+

+
A Post!

+
Laura Smith

+
Lorem ipsum dolor sit amet, quem atomorum te quo

+

+

+

+
Favorites: 0

+                    <button data-reactid=\".0.$cellophane$om_tutorials_test$DashboardItem_[=2dashboard/items 0].1.1\">Favorite!</button>
+

+

+

+

+

+
Photo: A Photo!

+
photo.jpg

+
Caption:

+

+

+

+
Favorites: 0

+                    <button data-reactid=\".0.$cellophane$om_tutorials_test$DashboardItem_[=2dashboard/items 1].1.1\">Favorite!</button>
+

+

+

+

+

+
Another Post!

+
Jim Jacobs

+
Lorem ipsum dolor sit amet, quem atomorum te quo

+

+

+

+
Favorites: 0

+                    <button data-reactid=\".0.$cellophane$om_tutorials_test$DashboardItem_[=2dashboard/items 2].1.1\">Favorite!</button>
+

+

+

+

+

+
Graphic: Charts and Stufff!

+
chart.jpg

+

+

+

+
Favorites: 0

+                    <button data-reactid=\".0.$cellophane$om_tutorials_test$DashboardItem_[=2dashboard/items 3].1.1\">Favorite!</button>
+

+

+

+

+

+
Yet Another Post!

+
May Fields

+
Lorem ipsum dolor sit amet, quem atomorum te quo

+

+

+

+
Favorites: 0

+                    <button data-reactid=\".0.$cellophane$om_tutorials_test$DashboardItem_[=2dashboard/items 4].1.1\">Favorite!</button>
+

+

+
")))))


Test fix :wrench:

Test fix :wrench:

--- test/metabase/api/collection_test.clj
+++ test/metabase/api/collection_test.clj
@@ -12,7 +12,7 @@

 ;; check that we can get a basic list of collections
 (tu/expect-with-temp [Collection [collection]]
-  [(into {} collection)]
+  [(assoc (into {} collection) :can_write true)]
   ((user->client :crowberto) :get 200 "collection"))

 ;; check that we don't see collections if we don't have permissions for them


Fix another test.

Fix another test.

--- test/onyx/log/peer_rebalance_test.clj
+++ test/onyx/log/peer_rebalance_test.clj
@@ -4,6 +4,7 @@
             [onyx.system :refer [onyx-development-env]]
             [onyx.log.entry :refer [create-log-entry]]
             [onyx.extensions :as extensions]
+            [onyx.log.util :as util]
             [onyx.api :as api]
             [midje.sweet :refer :all]
             [zookeeper :as zk]))
@@ -19,18 +20,45 @@
 (def peer-opts
   {:inbox-capacity 1000
    :outbox-capacity 1000
-   :job-scheduler :onyx.job-scheduler/round-robin})
+   :job-scheduler :onyx.job-scheduler/round-robin
+   :state {:task-lifecycle-fn util/stub-task-lifecycle}})
+
+(def catalog-1
+  [{:onyx/name :a
+    :onyx/ident :hornetq/read-segments
+    :onyx/type :input
+    :onyx/medium :hornetq
+    :onyx/consumption :concurrent}
+
+   {:onyx/name :b
+    :onyx/ident :hornetq/write-segments
+    :onyx/type :output
+    :onyx/medium :hornetq
+    :onyx/consumption :concurrent}])
+
+(def catalog-2
+  [{:onyx/name :c
+    :onyx/ident :hornetq/read-segments
+    :onyx/type :input
+    :onyx/medium :hornetq
+    :onyx/consumption :concurrent}
+
+   {:onyx/name :d
+    :onyx/ident :hornetq/write-segments
+    :onyx/type :output
+    :onyx/medium :hornetq
+    :onyx/consumption :concurrent}])

 (def j1
   (onyx.api/submit-job (:log env)
                        {:workflow [[:a :b]]
-                        :catalog []
+                        :catalog catalog-1
                         :task-scheduler :onyx.task-scheduler/round-robin}))

 (def j2
   (onyx.api/submit-job (:log env)
                        {:workflow [[:c :d]]
-                        :catalog []
+                        :catalog catalog-2
                         :task-scheduler :onyx.task-scheduler/round-robin}))

 (def n-peers 12)
@@ -53,6 +81,8 @@
         (recur new-replica)
         new-replica))))

+(fact "the peers evenly balance" true => true)
+
 (def conn (zk/connect (:zookeeper/address (:zookeeper (:env config)))))

 (def id (last (:b (get (:allocations replica-1) j1))))
@@ -73,6 +103,8 @@
         (recur new-replica)
         new-replica))))

+(fact "the peers rebalance" true => true)
+
 (doseq [v-peer v-peers]
   (try
     ((:shutdown-fn v-peer))


fixing unit tests

fixing unit tests

--- test/vignette/util/thumbnail_test.clj
+++ test/vignette/util/thumbnail_test.clj
@@ -38,7 +38,7 @@
     (original->local ..original.. beach-map) => ..local..
     (original->thumbnail ..local.. beach-map) => ..thumb..
     (background-delete-file ..local..) => true
-    (create-stored-object ..thumb..) => ..object..)
+    (create-stored-object ..thumb.. & anything) => ..object..)

   (generate-thumbnail ..system.. beach-map) => (throws ExceptionInfo)
   (provided
@@ -65,8 +65,7 @@
        (provided
          (store ..system..) => ..store..
          (get-thumbnail ..store.. beach-map) => false
-         (generate-thumbnail ..system.. beach-map) => ..thumb..
-         (background-save-thumbnail ..store.. ..thumb.. beach-map) => true)
+         (generate-thumbnail ..system.. beach-map) => ..thumb..)

        ; generate new - fail
        (let [image-dne (assoc beach-map :original "doesnotexist.jpg")]
@@ -80,9 +79,7 @@
        (let [option-map (assoc-in beach-map [:options :replace] "true")]
          (get-or-generate-thumbnail ..system.. option-map) => ..new-thumb..
          (provided
-           (store ..system..) => ..store..
-           (generate-thumbnail ..system.. option-map) => ..new-thumb..
-           (background-save-thumbnail ..store.. ..new-thumb.. option-map) => true)))
+           (generate-thumbnail ..system.. option-map) => ..new-thumb..)))

 (facts :route-map->thumb-args
        (route-map->thumb-args beach-map) => (contains ["--height" "100" "--width" "100"


[#13355] Long time (5-15 sec) for loading chat messages (#13425)

https://github.com/status-im/status-go/compare/1bfde4c4cc69292875ae9fdc41a8b4bd29e95a7a...d35fab771a2dc44907768627ad862006483a7a18n

--- src/status_im/chat/models/loading.cljs
+++ src/status_im/chat/models/loading.cljs
@@ -67,10 +67,8 @@

 (fx/defn handle-mark-all-read-successful
   {:events [::mark-all-read-successful]}
-  [{:keys [db] :as cofx} chat-id]
-  (fx/merge cofx
-            {:db (mark-chat-all-read db chat-id)}
-            (notification-center/get-activity-center-notifications-count)))
+  [cofx]
+  (notification-center/get-activity-center-notifications-count cofx))

 (fx/defn handle-mark-all-read-in-community-successful
   {:events [::mark-all-read-in-community-successful]}
@@ -82,11 +80,12 @@
 (fx/defn handle-mark-all-read
   {:events [:chat.ui/mark-all-read-pressed :chat/mark-all-as-read]}
   [{db :db} chat-id]
-  {:clear-message-notifications  [[chat-id]
+  {:db (mark-chat-all-read db chat-id)
+   :clear-message-notifications  [[chat-id]
                                   (get-in db [:multiaccount :remote-push-notifications-enabled?])]
    ::json-rpc/call [{:method     "wakuext_markAllRead"
                      :params     [chat-id]
-                     :on-success #(re-frame/dispatch [::mark-all-read-successful chat-id])}]})
+                     :on-success #(re-frame/dispatch [::mark-all-read-successful])}]})

 (fx/defn handle-mark-mark-all-read-in-community
   {:events [:chat.ui/mark-all-read-in-community-pressed]}
@@ -157,8 +156,7 @@
         (when (or first-request cursor)
           (merge
            {:db (assoc-in db [:pagination-info chat-id :loading-messages?] true)}
-           {:utils/dispatch-later [{:ms 100 :dispatch [:load-more-reactions cursor chat-id]}
-                                   {:ms 100 :dispatch [::models.pin-message/load-pin-messages chat-id]}]}
+           {:utils/dispatch-later [{:ms 100 :dispatch [:load-more-reactions cursor chat-id]}]}
            (data-store.messages/messages-by-chat-id-rpc
             chat-id
             cursor
@@ -176,5 +174,7 @@
   (when-not (get-in db [:pagination-info chat-id :messages-initialized?])
     (fx/merge cofx
               {:db (assoc-in db [:pagination-info chat-id :messages-initialized?] now)
-               :utils/dispatch-later [{:ms 500 :dispatch [:chat.ui/mark-all-read-pressed chat-id]}]}
+               :utils/dispatch-later [{:ms 50 :dispatch [:chat.ui/mark-all-read-pressed chat-id]}
+                                      (when-not (get-in cofx [:db :chats chat-id :public?])
+                                        {:ms 100 :dispatch [::models.pin-message/load-pin-messages chat-id]})]}
               (load-more-messages chat-id true))))


added debug to meta.server

added debug to meta.server

--- src/meta/server.cljs
+++ src/meta/server.cljs
@@ -1,45 +1,66 @@
 (ns meta.server
-  (:require [feathers.app :as feathers]
+  (:require ["debug" :as dbg]
+            [feathers.app :as feathers]
             [meta.channels :as chan]))
+
+(def debug (dbg "degree9:meta:server"))

 (enable-console-print!)

-(def app (feathers/express (feathers/app)))
+(defn app []
+  (debug "Starting [meta] server")
+  (feathers/app))

 (defn with-defaults [app]
+  (debug "Loading server defaults")
   (-> app
+    feathers/express
     feathers/configuration
     feathers/json
     feathers/urlencoded
     feathers/static))

 (defn with-rest [app]
+  (debug "Loading server REST api")
   (-> app
     feathers/rest))

 (defn with-socketio [app]
+  (debug "Loading server SocketIO api")
   (-> app
     feathers/socketio))

 (defn with-authentication [app]
+  (debug "Loading server Authentication api")
   (-> app
     feathers/authentication))

 (defn with-channels [app]
+  (debug "Loading server Channels api")
   (-> app
     chan/join-anonymous))

 (defn using
-  ([path svc] (using app path svc))
-  ([app path svc] (.use app path svc)))
+  ([path svc]
+   (using app path svc))
+  ([app path svc]
+   (debug "Passing app.use call to feathers")
+   (.use app path svc)))

 (defn api
-  ([path svc hooks] (api app path svc hooks))
-  ([app path svc hooks] (feathers/api app path svc hooks)))
+  ([path svc hooks]
+   (api app path svc hooks))
+  ([app path svc hooks]
+   (debug "Passing app.api call to feathers")
+   (feathers/api app path svc hooks)))

 (defn listen
-  ([port] (listen app port))
-  ([app port] (.listen app port)))
+  ([port]
+   (listen app port))
+  ([app port]
+   (debug "Passing app.listen call to feathers")
+   (.listen app port)))

 (defn init! [fname]
+  (debug "Setting nodejs *main-cli-fn*")
   (set! *main-cli-fn* fname))


Add instantiate-with fn.  Creates instance of passed type name and shoves in passed keys and vals.

--- test/isla/test/story.clj
+++ test/isla/test/story.clj
@@ -3,6 +3,12 @@
   (:use [clojure.pprint])
   (:use [isla.story])
   (:require [isla.story-utils :as story-utils]))
+
+(defn instantiate-with [type-name & args]
+  (let [basic-obj (story-utils/instantiate-type (get types type-name))]
+    (if (> (count args) 1)
+      (apply assoc basic-obj args)
+      basic-obj)))

 ;; story creation


Use handy story-utils fns.

Use handy story-utils fns.

--- test/isla/test/story.clj
+++ test/isla/test/story.clj
@@ -2,7 +2,7 @@
   (:use [clojure.test])
   (:use [clojure.pprint])
   (:use [isla.story])
-  (:require [isla.interpreter :as interpreter]))
+  (:require [isla.story-utils :as story-utils]))

 ;; story creation

@@ -10,14 +10,14 @@
   (let [story-str (str "palace is a room")
         story (init-story story-str)]
     (is (= (get (:rooms story) "palace")
-           (assoc (interpreter/instantiate-type (get types "room"))
+           (assoc (story-utils/instantiate-type (get types "room"))
              :name "palace")))))

 (deftest test-player-alteration
   (let [story-str (str "my name is 'mary'")
         story (init-story story-str)]
     (is (= (:player story)
-           (assoc (interpreter/instantiate-type (get types "_player"))
+           (assoc (story-utils/instantiate-type (get types "_player"))
              :name "mary")))))

 (deftest test-room-alteration
@@ -26,7 +26,7 @@
                         palace summary is '" summary "'")
         story (init-story story-str)]
     (is (= (get (:rooms story) "palace")
-           (assoc (interpreter/instantiate-type (get types "room"))
+           (assoc (story-utils/instantiate-type (get types "room"))
              :name "palace" :summary summary)))))

 (deftest test-room-connection
@@ -35,10 +35,9 @@
                         palace exit is garden")
         story (init-story story-str)]
     (is (= (get (:rooms story) "palace")
-           (assoc (interpreter/instantiate-type (get types "room"))
+           (assoc (story-utils/instantiate-type (get types "room"))
              :name "palace"
-             :exit (interpreter/instantiate-type (get types "room")))))))
-
+             :exit (story-utils/instantiate-type (get types "room")))))))

 ;; story telling


[WR] include the generated xml filename in the results table

--- src/vip/data_processor/db/postgres.clj
+++ src/vip/data_processor/db/postgres.clj
@@ -32,7 +32,7 @@

 (defn complete-run [ctx]
   (let [id (:import-id ctx)
-        filename (:filename ctx)]
+        filename (:generated-xml-filename ctx)]
     (korma/update results
                   (korma/set-fields {:filename filename
                                      :complete true


tag request

tag request

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -58,6 +58,8 @@

 (defroutes app-routes
   (GET "/rest/v1/summary/:user" [user] (json-response (get-overall-summary user)))
+  (GET "/rest/v1/summary-tags/:user" [user] (json-response (get-overall-tags-summary user)))
+
   (GET "/rest/v1/summary/:user/:year" [user year] (json-response (get-year-summary-sport user (Integer. year))))
   (GET "/rest/v1/summary/:user/:year/:month" [user year month] (json-response (get-month-summary-sport user (Integer. year) (Integer. month))))


Added :paredit-forward-barf-sexp

Added :paredit-forward-barf-sexp

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -819,3 +819,48 @@
             ret)
           t))
       t)))
+
+;;; if there is a non-whitepace child
+;;; barf out the rightmost stuff up to first-rightmost-non-whitespace child
+
+(defmethod paredit
+  :paredit-forward-barf-sexp
+  [cmd {:keys #{parse-tree buffer}} {:keys [^String text offset length] :as t}]
+  ;; (with-important-memoized)
+  (if-let [rloc (-?> parse-tree (parsed-root-loc true))]
+    (let [[l r] (normalized-selection rloc offset length)
+          ;; TODO need to check if we are in a string (still slurp, but move end-quote)
+          starting-loc (if (*tag-closing-brackets* (loc-tag l))  ;; if on closing punct, must select parent differently
+                         (loc-for-offset rloc offset)
+                         (if-let [nl (z/up (parse-node l))]
+                           nl l))
+          ;; TODO we actually need non-puncts-to-left + whitepace until next sym
+          rightmost (-> starting-loc z/down z/rightmost z/left non-puncts-to-left)
+          more-non-puncts (-> (first rightmost) z/left non-puncts-to-left rest)
+          barfees (concat more-non-puncts rightmost)
+          barf-text (apply str (map loc-text barfees))
+          barf-start-loc (first barfees)
+          barf-so (start-offset barf-start-loc)
+          barf-eo (end-offset starting-loc)
+          text-to-replace (.substring text barf-so barf-eo)
+          close-punct (*tag-closing-brackets* (loc-tag starting-loc))
+          replace-text (str close-punct barf-text)
+          replace-length (.length text-to-replace)
+          replace-offset barf-so
+          ret (-> t
+                  (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
+                  (update-in [:modifs] conj {:offset replace-offset :length replace-length :text replace-text}))]
+      (printf "rightmost: '%s'
+more-non-puncts: '%s'
+barfees: '%s'
+text-to-replace: '%s'
+replace-text: '%s'
+text: '%s'"
+              (apply str (map loc-text rightmost))
+              (apply str (map loc-text more-non-puncts))
+              (apply str (map loc-text barfees))
+              text-to-replace
+              replace-text
+              (:text ret))
+      ret)
+    t))


hist planning

hist planning

--- statspop/src/statspop/charts/hist.cljs
+++ statspop/src/statspop/charts/hist.cljs
@@ -132,3 +132,7 @@
 ;; I should also use transducers to make this more efficient. Way too many intermediate collections in here now.

 ;; also I should later build the capacity to put multiple variables on one histogram.
+
+;; actually, multiple variables should be trivially easy.  Just pass in a vector of vectors as data, map hist-keys-series over it, and pull out that last nested vector.
+
+;; really issue is that I should require it to be normalized, say each to the range 0-1, for multiple histograms.  So maybe just a different function, or have make-histogram be multiple-arity?


remove some commented out code

remove some commented out code

--- test/wb_es/core_test.clj
+++ test/wb_es/core_test.clj
@@ -62,16 +62,6 @@
   (->> entities
        (map create-document)
        (apply index-doc)))
-
-;; (defn with-default-options
-;;   "create a new search func that "
-;;   [search-func]
-;;   (fn [& search-args]
-;;     (let [[q options] search-args]
-;;       (search-func es-base-url
-;;                    index-name
-;;                    q
-;;                    (or options {})))))

 (defn web-query
   "returns a function that submits a web query and parses its results"


Do not delete files on exit

Do not delete files on exit

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -50,7 +50,6 @@
       (if (not (.exists tmp-dir)) (.mkdirs tmp-dir))
       (with-open [file (java.io.File/createTempFile (str s "-") ".tmp" tmp-dir)
                   out (-> file io/output-stream)]
-        (.deleteOnExit file)
         (copy-stream in out)
         (let [path (.getAbsolutePath file)]
           (log/info (str "Saved lib to: " path))


Add tests for multirember.

Add tests for multirember.

--- test/little_clojurer/chapter3_test.clj
+++ test/little_clojurer/chapter3_test.clj
@@ -45,7 +45,10 @@

 (deftest multirember-test
   (testing
-    (is true)))
+    (is (= '() (multirember :a '(:a :a :a :a :a))))
+    (is (= '() (multirember :x '())))
+    (is (= '(:a :b :c) (multirember :x '(:a :b :c))))
+    (is (= '(:b :c :d) (multirember :a '(:a :b :a :c :a :a :d :a))))))

 (deftest multiinsertR-test


Trigger id must now be supplied.

Trigger id must now be supplied.

--- test/onyx/plugin/input_resume_test.clj
+++ test/onyx/plugin/input_resume_test.clj
@@ -31,6 +31,7 @@
                          :triggers [{:trigger/window-id :collect-segments
                                      :trigger/refinement :onyx.refinements/accumulating
                                      :trigger/fire-all-extents? true
+                                     :trigger/id :collect-trigger
                                      :trigger/on :onyx.triggers/segment
                                      :trigger/threshold [1 :elements]
                                      :trigger/sync ::update-atom!}]


refactored acceptance test to use pmap

refactored acceptance test to use pmap

--- test/push/interpreter/stress_tests.clj
+++ test/push/interpreter/stress_tests.clj
@@ -73,6 +73,23 @@

+(defn run-with-wordy-try-block
+  [interpreter]
+  (try
+    (do
+      (println (str (:counter (run interpreter 10000)))))
+    (catch Exception e
+      (do
+        (println
+          (str "caught exception: "
+             (.getMessage e)
+             " running "
+             (pr-str (:program interpreter)) "\n" (pr-str (:inputs interpreter))))
+          (throw (Exception. (.getMessage e)))))))
+
+
+;; actual tests; they will run hot!
+
 (future-fact "I can create 10000 random programs without an exception"
   :slow :acceptance
   (count (repeatedly 10000 #(random-program-interpreter 10 100))) => 10000)
@@ -106,25 +123,17 @@
                                   (throw (Exception. (.getMessage e)))))))) =not=> (throws))

+
+
 ;; the following monstrosity is an "acceptance test" for hand-running, at the moment.
 ;; it's intended to give a bit more info about the inevitable bugs that
 ;; only appear when random programs are executed by an interpreter, in a
 ;; bit more of a complex context; by the time you read this, it might be
 ;; commented out. If you want to run it, be warned it will spew all kinds
 ;; of literally random text to the STDOUT stream.
-(fact "I can create & run 10000 large random programs for 5000 steps each without an exception"
+(fact "I can create & run 10000 large random programs for up to 5000 steps each without an exception"
   :slow :acceptance
-  (dotimes [n 10000]
-    (let [rando (reset-interpreter (random-program-interpreter 10 1000))]
-      (try
-        (do
-          (println (str n " " (:counter (run rando 50000)))))
-        (catch Exception e
-          (do
-            (println
-              (str "caught exception: "
-                 (.getMessage e)
-                 " running "
-                 (pr-str (:program rando)) "\n" (pr-str (:inputs rando))))
-              (throw (Exception. (.getMessage e)))))))) =not=> (throws))
-
+  (let [my-interpreters
+    (repeatedly 10000 #(reset-interpreter (random-program-interpreter 10 1000))) ]
+      (doall (pmap run-with-wordy-try-block my-interpreters))
+    ))


Remove unnecessary function

Remove unnecessary function

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -21,15 +21,11 @@

 (defmethod create-entity TextureRegion
   [obj]
-  {:type :image :object obj :x 0 :y 0})
+  {:type :image :object obj})

 (defmethod create-entity Actor
   [obj]
-  {:type :actor :object obj :x 0 :y 0})
-
-(defn replace-entity
-  [old-entity new-entity]
-  (assoc old-entity :object (:object new-entity)))
+  {:type :actor :object obj})

 (load "core_2d")
 (load "core_global")


Upgrade the layers

Upgrade the layers

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -11,7 +11,11 @@
 (def black {:r 0 :g 0 :b 0})
 (def white {:r 1 :g 1 :b 1})

-(def leds (take 5 (repeat black)))
+(def leds (take 36 (repeat black)))
+
+(defn constrain
+  [start end n]
+  (min end (max start n)))

 (defn static-color [color]
   (fn [env leds]
@@ -33,11 +37,29 @@
            leds factors))))

 (defn pulse-brightness [{:keys [time] :as env} leds]
-  (let [scaled-time (/ time 10000)
-        brightness-factor (Math/sin scaled-time)]
+  (let [scaled-time (* 2 Math/PI (/ time 1000))
+        brightness-factor (+ 1/2
+                             (/ (Math/sin scaled-time) 2))]
     (map (fn [led]
            (fmap #(* % brightness-factor) led))
          leds)))
+
+(defn swimming-static-color
+  ([color length interval]
+   (swimming-static-color color length interval 0))
+
+  ([color length interval initial-offset]
+   (fn [{:keys [time] :as env} leds]
+     (let [leds (vec leds)
+           size (count leds)
+           last (dec size)
+           offset (+ initial-offset
+                     (int (Math/floor (* (inc size)
+                                         (/ (mod time interval) interval)))))
+           start (constrain 0 last (- offset length))]
+       (into [] (concat (subvec leds 0 start)
+                        (take (- offset start) (repeat color))
+                        (subvec leds (min last offset))))))))

 (defn apply-layers [layers env leds]
   (let [env-applied-layers (for [layer layers] (partial layer env))]
@@ -161,3 +183,4 @@
 (def renderer (:renderer started-system))

 (def displayer (:displayer started-system))
+


Modify ASTNode implementations for EscapedVariable and UnescapedVariable to the new call-lambda function for the pass-context extension.

--- src/stencil/core.clj
+++ src/stencil/core.clj
@@ -48,15 +48,19 @@
   (render [this ^StringBuilder sb context-stack]
     (if-let [value (context-get context-stack (:name this))]
       (if (instance? clojure.lang.Fn value)
-        (.append sb (html-escape (render-string (str (value))
-                                                (first context-stack))))
+        (.append sb (html-escape
+                     (render-string (str (call-lambda value
+                                                      (first context-stack)))
+                                    (first context-stack))))
         ;; Otherwise, just append its html-escaped value by default.
         (.append sb (html-escape value)))))
   stencil.ast.UnescapedVariable
   (render [this ^StringBuilder sb context-stack]
     (if-let [value (context-get context-stack (:name this))]
       (if (instance? clojure.lang.Fn value)
-        (.append sb (render-string (str (value)) (first context-stack)))
+        (.append sb (render-string (str (call-lambda value
+                                                     (first context-stack)))
+                                   (first context-stack)))
         ;; Otherwise, just append its value.
         (.append sb value)))))


Minor changes on default error handling.

--- src/uxbox/rstore.cljs
+++ src/uxbox/rstore.cljs
@@ -90,11 +90,19 @@

 (defn- on-error
   "A default error handler."
-  [e]
-  (uum/error (tr "errors.generic"))
-  (println "Unexpected error: " e)
-  (js/console.log (.-stack e))
-  (rx/throw e))
+  [error]
+  (cond
+    (and (:status error)
+         (:payload error)
+         (= (:status error) 403))
+    (emit! (uxbox.data.auth/logout))
+
+    :else
+    (do
+      (uum/error (tr "errors.generic"))
+      (println "Unexpected error: " error)
+      (js/console.log (.-stack error))
+      (rx/throw error))))

 (defn init
   "Initializes the stream event loop and