Test for complicated Haley interactions with start/end of turns.

--- src/clj/test/cards-identities.clj
+++ src/clj/test/cards-identities.clj
@@ -94,6 +94,56 @@
     (let [eli (get-ice state :archives 0)]
       (core/rez state :corp eli)
       (is (= 5 (:current-strength (refresh eli))) "Eli 1.0 at 5 strength"))))
+
+(deftest hayley-kaplan
+  "Hayley Kaplan - Complicated install triggers at end of opponent's turn"
+  (do-game
+    (new-game
+      (default-corp)
+      (make-deck "Hayley Kaplan: Universal Scholar" [(qty "Street Peddler" 1) (qty "Daily Casts" 1) (qty "Gang Sign" 3)
+                                                     (qty "Clone Chip" 1) (qty "Multithreader" 2) (qty "Study Guide" 1)]))
+    (take-credits state :corp)
+    (starting-hand state :runner ["Street Peddler" "Daily Casts" "Clone Chip" "Multithreader" "Multithreader"
+                                  "Study Guide"])
+    (trash-from-hand state :runner "Multithreader")
+    (play-from-hand state :runner "Street Peddler")
+    (prompt-choice :runner "No")
+    (play-from-hand state :runner "Clone Chip")
+    (play-from-hand state :runner "Study Guide")
+    (take-credits state :runner)
+    (core/gain state :runner :credit 7)
+    (core/request-phase-32 state :runner nil)
+    (core/end-turn state :corp nil)
+    (is (not (:end-turn @state)) "Corp turn has not ended")
+    (card-ability state :runner (-> (get-runner) :rig :hardware first) 0)
+    (prompt-select :runner (first (:discard (get-runner))))
+    (prompt-choice :runner "Yes")
+    (prompt-select :runner (find-card "Multithreader" (:hand (get-runner))))
+    (let [sg (-> (get-runner) :rig :program first)
+          mt1 (-> (get-runner) :rig :program second)
+          mt2 (-> (get-runner) :rig :program next second)
+          sp (-> (get-runner) :rig :resource first)]
+      (is (and sp sg mt1 mt2) "Street Peddler, Study Guide and 2x Multithreaders installed")
+      (card-ability state :runner mt1 0)
+      (card-ability state :runner mt1 0)
+      (card-ability state :runner mt2 0)
+      (card-ability state :runner mt2 0)
+      (card-ability state :runner sg 1)
+      (card-ability state :runner sg 1)
+      (is (= 2 (:current-strength (refresh sg))) "Study Guide at strength 2")
+      (is (= 0 (:rec-counter (refresh mt1))) "Multithreader credits spent")
+      (prompt-choice :runner "Done")
+      (prompt-choice :corp "Done")
+      (is (:end-turn @state) "Corp turn ended")
+      (card-ability state :runner sp 0)
+      (prompt-card :runner (first (:hosted sp)))
+      (prompt-choice :runner "Yes")
+      (prompt-select :runner (find-card "Daily Casts" (:hand (get-runner))))
+      (is (find-card "Daily Casts" (:resource (:rig (get-runner)))) "Daily Casts installed by Haley")
+      (is (= 0 (:credit (get-runner))) "Runner has 0 credits before start of turn")
+      (core/start-turn state :runner nil)
+      (is (= 2 (:credit (get-runner))) "Runner has 2 credits after start of turn")
+      (is (= 2 (:rec-counter (refresh mt1))) "Multithreaders regained credits"))))

 (deftest iain-stirling-credits
   "Iain Stirling - Gain 2 credits when behind"


fix header text when no schema

fix header text when no schema

--- src/cljs/gc_api_browser/core.cljs
+++ src/cljs/gc_api_browser/core.cljs
@@ -17,12 +17,11 @@

 (def init-app-state
   {:history           []
-   :request           {:text    "Restman"
-                       :url     nil
+   :request           {:url     nil
                        :method  "GET"
                        :body    nil
                        :headers {}}
-   :text              nil
+   :text              "Restman"
    :selected-resource nil
    :selected-action   nil
    :schema            nil


デバッグ用の時間を送信していたのを削除

デバッグ用の時間を送信していたのを削除

--- src/clojure/com/illiichi/main.clj
+++ src/clojure/com/illiichi/main.clj
@@ -25,12 +25,10 @@
     (send-off stack mean)))
 (defn send-every [id interval host port]
   (letfn [(task []
-            (let [client (osc-client host port)] (apply osc-send client (str "/" id) (concat [(now)] @acc-stack @rotate-stack)))
-            ;; (apply osc-send client (str "/" id) (concat [(now)] [-0.74782043082746, 5.3259560276466, 8.299258563232] [0.21574099701674, -0.18960481184636, -0.74130249528735] ))
-            ;; (apply osc-send client (str "/" id) [(now) -0.74782043082746, 5.3259560276466, 8.299258563232 0.21574099701674, -0.18960481184636, -0.74130249528735])
-            ;; (let [client (osc-client host port)] (osc-send client (str "/" id) (now) -0.74782043082746, 5.3259560276466, 8.299258563232 0.21574099701674, -0.18960481184636, -0.74130249528735))
-            (for [stack [acc-stack rotate-stack]] (send stack (fn [_] [])))
-            )]
+            (let [client (osc-client host port)]
+              ;; (apply osc-send client (str "/" id) (concat [(now)] @acc-stack @rotate-stack))
+              (apply osc-send client (str "/" id) (concat @acc-stack @rotate-stack)))
+            (for [stack [acc-stack rotate-stack]] (send stack (fn [_] []))))]
     (every interval task my-pool)))

 (defn push-vector [stack vals]


Fix mis-named protocol function names.

Fix mis-named protocol function names.

--- src/clojure/parkour/mapreduce.clj
+++ src/clojure/parkour/mapreduce.clj
@@ -110,13 +110,13 @@
   (keyvals [source] source)
   (keys [source] (r/map first source))
   (vals [source] (r/map second source))
-  (keyvalgroups
+  (keyvalgroups*
     ([source] (pr/keyvalgroups = source))
     ([source pred] (pr/keyvalgroups pred source)))
-  (keygroups
+  (keygroups*
     ([source] (pr/keygroups = source))
     ([source pred] (pr/keygroups pred source)))
-  (valgroups
+  (valgroups*
     ([source] (pr/valgroups = source))
     ([source pred] (pr/valgroups pred source))))


Shape metadata is too awesome to be experimental.

--- src/clojure/parkour/mapreduce.clj
+++ src/clojure/parkour/mapreduce.clj
@@ -132,10 +132,9 @@
   "Task function adapter for collection-function-like functions.  The adapted
 function `v` should accept conf-provided arguments followed by the (unwrapped)
 input tuple source, and should return a reducible collection of output tuples.
-
-Experimental: if `v` has metadata for the `::mr/source-as` or `::mr/sink-as`
-keys, the function input and/or output will be re-shaped as specified via the
-associated metadata value."
+If `v` has metadata for the `::mr/source-as` or `::mr/sink-as` keys, the
+function input and/or output will be re-shaped as specified via the associated
+metadata value."
   [v]
   (let [m (meta v)
         source-as (or (some->> m ::source-as (partial source-as)) identity)


Remove pr-str payload

Remove pr-str payload

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -142,7 +142,7 @@
                                                 :fillOpacity "0.25"
                                                 :strokeDasharray "5,5"
                                                 :strokeWidth 1)))))
-                                (dom/text #js {:x 15
+                                #_(dom/text #js {:x 15
                                                :y 15} (pr-str (dissoc payload :layers)))]
                                [(when (cameras/guidelines-enabled? payload)
                                   ;; TODO: Render guidelines


don't use println on frontend

don't use println on frontend

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -39,7 +39,7 @@

 (defmethod svg-element :default
   [layer]
-  (print "No svg element for " layer))
+  (utils/mlog "No svg element for " layer))

 (defn maybe-add-selected [svg-layer layer]
   (if (:selected? layer)


fix panning while holding arrow tool

fix panning while holding arrow tool

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -737,7 +737,6 @@
     (render [_]
       (let [cast! (om/get-shared owner :cast!)
             [rx ry] (om/get-state owner :mouse-pos)
-            camera (cursors/observe-camera owner)
             center (layers/center layer)]
         (dom/g #js {:className "arrow-handle-group"}
           (when (and rx ry)
@@ -749,6 +748,7 @@
                              :y2 ry
                              :markerEnd "url(#arrow-point)"})))
           (svg-element (assoc layer
+                              :key (str (:db/id layer) "-handler")
                               :className (str "arrow-handle "
                                               (when (om/get-state owner :hovered?)
                                                 "hovered "))
@@ -764,7 +764,8 @@
                                              (om/set-state! owner
                                                             :mouse-pos
                                                             (apply cameras/screen->point
-                                                                   camera
+                                                                   ;; bad idea in general, but without this panning is completely broken
+                                                                   (:camera @(om/get-shared owner :_app-state-do-not-use))
                                                                    (cameras/screen-event-coords e))))
                               :onMouseDown (fn [e]
                                              (utils/stop-event e)
@@ -778,7 +779,8 @@
                                                   {:dest layer
                                                    :x (first (cameras/screen-event-coords e))
                                                    :y (second (cameras/screen-event-coords e))}))))
-          (svg-element (assoc layer :className "arrow-outline")))))))
+          (svg-element (assoc layer :className "arrow-outline"
+                              :key (str (:db/id layer) "-outline"))))))))

 (defn arrows [app owner]
   (reify


prevent arrows from rendering twice

prevent arrows from rendering twice

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -800,13 +800,14 @@
                                                                          :layer/end-x (:layer/current-x layer)
                                                                          :layer/end-y (:layer/current-y layer))))
                                       {} (mapcat :layers (vals (cursors/observe-subscriber-layers owner))))
-            pointer-datoms (concat (seq (d/datoms db :aevt :layer/points-to))
-                                   (mapcat (fn [l]
-                                             (map (fn [p] {:e (:db/id l) :v (:db/id p)})
-                                                  (:layer/points-to l)))
-                                           (filter :layer/points-to
-                                                   (concat (:layers drawing)
-                                                           (vals subscriber-layers)))))
+            pointer-datoms (set (concat (map (fn [d] {:e (:e d) :v (:v d)})
+                                             (d/datoms db :aevt :layer/points-to))
+                                        (mapcat (fn [l]
+                                                  (map (fn [p] {:e (:db/id l) :v (:db/id p)})
+                                                       (:layer/points-to l)))
+                                                (filter :layer/points-to
+                                                        (concat (:layers drawing)
+                                                                (vals subscriber-layers))))))

             selected-eids (:selected-eids (cursors/observe-selected-eids owner))


Add AWS/Azure subnavs

Add AWS/Azure subnavs

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -226,7 +226,13 @@
              :jobs {:path "/jobs"
                     :title "Jobs"}
              :press {:path "/press"
-                     :title "Press"}}]
+                     :title "Press"}}
+            {:enterprise {:path "/enterprise"
+                          :title "Overview"}
+             :azure {:path "/enterprise/azure"
+                     :title "Azure"}
+             :aws {:path "/enterprise/aws"
+                   :title "AWS"}}]
            nav-point)])))))

 (defn inner-header [app owner]


Do not re(initialize) repository

Do not re(initialize) repository

--- src/cider_ci/repository/repositories.clj
+++ src/cider_ci/repository/repositories.clj
@@ -131,9 +131,8 @@
            (if (fs/exists? path)
              (git-fetch repository path)
              (git-initialize repository))))
-       (catch Exception _
-         (git-initialize repository))))
-
+       (catch Exception e
+         (logging/warn (thrown/stringify e)))))

 ;### Submit actions through agent #############################################
 (defn git-update-is-due? [repository git-repository]


replicate behavior of Main from Java example

--- src/clj/storm/starter/clj/word_count.clj
+++ src/clj/storm/starter/clj/word_count.clj
@@ -65,10 +65,16 @@
     (.shutdown cluster)
     ))

-(defn -main [name]
+(defn submit-topology! [name]
   (StormSubmitter/submitTopology
    name
    {TOPOLOGY-DEBUG true
     TOPOLOGY-WORKERS 3}
    (mk-topology)))

+(defn -main
+  ([]
+   (run-local!))
+  ([name]
+   (submit-topology! name)))
+


fix toolbar group menu hashing

fix toolbar group menu hashing

--- src/cljs/swarmpit/component/toolbar.cljs
+++ src/cljs/swarmpit/component/toolbar.cljs
@@ -3,7 +3,8 @@
             [material.components :as comp]
             [swarmpit.component.state :as state]
             [sablono.core :refer-macros [html]]
-            [rum.core :as rum]))
+            [rum.core :as rum]
+            [cuerdas.core :as str]))

 (rum/defc menu-popper < rum/reactive [items-hash items anchorKey menuOpenKey]
   (let [moreAnchorEl (state/react (conj state/form-state-cursor anchorKey))
@@ -42,7 +43,7 @@
                           :key     (str "cmmit-" items-hash "-" (:name %))} (:name %))) items))))))))))

 (rum/defc menu < rum/static [items]
-  (let [items-hash (hash items)
+  (let [items-hash (hash (str/join (map :name items)))
         anchorKey (keyword (str "anchor-key-" items-hash))
         menuOpenKey (keyword (str "menu-key-" items-hash))
         main-action (first (filter #(= true (:main %)) items))


Fixed bug in uniform-float-mutation (would never mutate).

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -169,12 +169,13 @@
                              (if (float? const)
                                (assoc token
                                  :instruction
-                                 (perturb-with-gaussian-noise uniform-mutation-float-gaussian-standard-deviation const))
+                                 (perturb-with-gaussian-noise
+                                   uniform-mutation-float-gaussian-standard-deviation const))
                                token)))
         token-mutator (fn [token]
                         (if (< (lrand) uniform-mutation-constant-tweak-rate)
-                          (constant-mutator token))
-                        token)
+                          (constant-mutator token)
+                          token))
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)


Fixed bug in uniform-string-mutation (would never mutate).

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -220,7 +220,8 @@
   (let [string-tweak (fn [st]
                        (apply str (map (fn [c]
                                          (if (< (lrand) uniform-mutation-string-char-change-rate)
-                                           (lrand-nth (concat ["\n" "\t"] (map (comp str char) (range 32 127))))
+                                           (lrand-nth (concat ["\n" "\t"]
+                                                              (map (comp str char) (range 32 127))))
                                            c))
                                        st)))
         constant-mutator (fn [token]
@@ -230,8 +231,8 @@
                                token)))
         token-mutator (fn [token]
                         (if (< (lrand) uniform-mutation-rate)
-                          (constant-mutator token))
-                        token)
+                          (constant-mutator token)
+                          token))
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)


split out color-palette and make it dynamic

--- src/com/billpiel/sayid/string_output.clj
+++ src/com/billpiel/sayid/string_output.clj
@@ -20,10 +20,12 @@
                                                            :class-delimiter [:cyan]
                                                            :class-name      [:cyan]}}))

+(def ^:dynamic *color-palette* [1 3 2 6 5])
+
 (defn apply-color-palette
   [n]
-  (nth [1 3 2 6 5]
-       (mod n 5)))
+  (nth *color-palette*
+       (mod n (count *color-palette*))))

 (defn color-code
   [& {:keys [fg bg fg* bg* bold]}]


Cleanup.

Cleanup.

--- src/com/lemondronor/orbital_detector.clj
+++ src/com/lemondronor/orbital_detector.clj
@@ -19,10 +19,10 @@

 (defn segment-bearing [a b]
   (geo/bearing
-   (:lat (:position a))
-   (:lon (:position a))
-   (:lat (:position b))
-   (:lon (:position b))))
+   (:lat a)
+   (:lon a)
+   (:lat b)
+   (:lon b)))

 (defn turn-angle [a b c]
@@ -60,6 +60,16 @@
     (filter #(< (total-track-angle %) (* Math/PI -2.0)) potential-orbits)))

+(defn orbits [track]
+  (let [track (map #(assoc % :pos (geo/point (:lat %) (:lon %)))
+                   track)]
+    (loop [orbits []
+           track (map #(assoc % :pos (geo/point (:lat %) (:lon %)))
+                      track)]
+      ())))
+
+
+

 ;; (defn turn-direction [a b c]
 ;;   (let [delta (bearing-delta a b c)]


heatmap tested with different ratios

heatmap tested with different ratios

--- src/clj/ux_analyzer/heatmap_improved.clj
+++ src/clj/ux_analyzer/heatmap_improved.clj
@@ -3,6 +3,7 @@
            [mikera.image.colours :as img-colours]
            [mikera.image.spectrum :as img-spectrum]
            [mikera.image.filters :as img-filters]))
+

 (defn init-heat-map
   [width height]
@@ -11,12 +12,14 @@
    :height height
    :max-val 0})

+
 (defn update-in-hm
   [hm [y x] fnc]
   (let [v (get-in hm [:points y x] 0)
         max-val (:max-val hm)]
    (-> (assoc-in hm [:points y x] (fnc v))
        (assoc :max-val (max max-val (fnc v))))))
+

 (defn dist
   [x1 y1 x2 y2]
@@ -25,45 +28,52 @@
                 (* (- y1 y2)
                    (- y1 y2)))))

-(defn valid?
-  [[y x] height width]
-  (and (>= y 0) (>= x 0)
-       (< y height) (< x width)))

 (defn area
-  [[cy cx] radius]
-  (for [y (range (- cy radius)
-                 (+ cy radius 1))
-        x (range (- cx radius)
-                 (+ cx radius 1))
-        :when (<= (dist y x cy cx) radius)]
-   [y x]))
+  [[cy cx] radius width height]
+  (let [min-y (max (- cy radius) 0)
+        min-x (max (- cx radius) 0)
+        max-y (min (+ cy radius 1) height)
+        max-x (min (+ cx radius 1) width)]
+   (for [y (range min-y max-y)
+         x (range min-x max-x)
+         :when (<= (dist y x cy cx) radius)]
+    [y x])))

-(defn generate-random-clicks
+(defn- generate-random-clicks
   [w count]
   (partition 2 (take count (repeatedly #(rand-int w)))))

-(def coords (generate-random-clicks 100 500))
-(def hm (init-heat-map 100 100))
-(def complete-hm (->> coords
-                      (map #(area % 3))
-                      (reduce into)
-                      (filter #(valid? % 100 100))
-                      (reduce #(update-in-hm %1 %2 inc) hm)))
-
-(defn normalize
+(defn- normalize
   [v max]
   (/ v max))

-(def hm-img (img-core/new-image 100 100))
-(for [y (range 100)
-      x (range 100)
-      :let [v (get-in complete-hm [:points y x] 0)]]
-  (img-core/set-pixel hm-img y x
-                       (img-spectrum/heatmap (normalize v (:max-val complete-hm)))))
+(defn populate-hm
+  [hm coords radius]
+  (->> coords
+       (map #(area % radius (:width hm) (:height hm)))
+       (reduce into)
+       (reduce #(update-in-hm %1 %2 inc) hm)))

-(img-core/show (img-core/filter-image hm-img (img-filters/blur)) :zoom 5)

+(defn populate-img
+  [hm]
+  (let [hm-img (img-core/new-image (:width hm) (:height hm))]
+   (doall (for [y (range (:height hm))
+                x (range (:width hm))
+                :let [v (get-in hm [:points y x] 0)]]
+            (img-core/set-pixel hm-img x y
+                                 (img-spectrum/heatmap (normalize v (:max-val hm))))))
+   (img-core/filter-image hm-img (img-filters/box-blur 3 3 :iterations 5))))
+
+
+(defn create-heatmap-img
+  [coords width height]
+  (-> (init-heat-map width height)
+      (populate-hm coords 10)
+      (populate-img)))
+
+; (img-core/show (create-heatmap-img (generate-random-clicks 900 9000) 1440 900) :zoom 1)


accept tokens \n \t , space as separators

--- src/cljs/gointermod/search/handlers.cljs
+++ src/cljs/gointermod/search/handlers.cljs
@@ -119,13 +119,22 @@
     (assoc-in [:multi-mine-aggregate source] (aggregate-by-orthologue mapped-results))))
 ))

+(defn search-token-fixer-upper "accept any separator, so long as it's newling, tab, space, or comma. Yeast will need special treatment."
+  [term]
+  (clojure.string/escape term
+    {"\n" ","
+     ";"  ","
+     " "  ","
+     "\t" ","
+}))
+
 (re-frame/register-handler
   ;;What do we do when a search button is pressed? This.
   :perform-search
   (fn [db [_ _]]
     ;asynchronously query all dem mines and add the results to the db
     (go
-      (comms/query-all-selected-organisms (:selected-organism db) (:search-term db)))
+      (comms/query-all-selected-organisms (:selected-organism db) (search-token-fixer-upper (:search-term db))))
     (re-frame/dispatch [:initialised])
     (dissoc db :multi-mine-results :multi-mine-aggregate :go-terms :go-ontology)))

@@ -135,7 +144,6 @@
  (fn [db [_ _]]
   (assoc db :initialised true)
   ))
-

 (re-frame/register-handler
  ;;saves the most recent query xml to be associated with a given organism


Add :checks-autoconstructing diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1101,6 +1101,14 @@
       (and (not= child-size (count parent1-genome))
            (not= child-size (count parent2-genome))))))

+(defn checks-autoconstructing-diversifying?
+  [ind argmap]
+  (assoc in :diversifying
+    (some (fn [instruction-map]
+            (and (= (:instruction instruction-map) 'genome_autoconstructing)
+                 (not (:silent instruction-map))))
+          (:genome ind))))
+
 (defn diversifying?
   "Returns ind with :diversifying set to true if it staisfies all test
   specified in (:autoconstructive-diversification-test argmap), or false
@@ -1130,6 +1138,7 @@
                 :different-errors different-errors-diversifying?
                 :new-instruction-diversifying new-instruction-diversifying?
                 :new-size-diversifying new-size-diversifying?
+                :checks-autoconstructing checks-autoconstructing-diversifying?
                 :none (fn [ind argmap] i))
               i
               argmap)


Further refactoring for new nesting approach.

--- src/dsbdp/data_processing_dsl.clj
+++ src/dsbdp/data_processing_dsl.clj
@@ -46,6 +46,25 @@
             :default (conj v data-proc-def-element)))
         [] data-processing-definition))))

+(defn cond-rule-expr?
+  [rule-expression]
+  (and
+    (vector? rule-expression)
+    (every? list? (butlast (take-nth 2 rule-expression)))
+    (every?
+      vector?
+        (butlast
+          (take-nth
+            2
+            (rest rule-expression))))))
+
+(defn prefix-rule-name
+  [rule-name nesting-level]
+  (if
+    (> 1 nesting-level)
+    rule-name
+    (symbol (str "__" nesting-level "_" rule-name))))
+
 (declare create-let-expression)

 (defn- create-bindings-vector
@@ -56,9 +75,7 @@
             rule-expression (second rule)]
         (cond
           (list? rule-expression) (conj v
-                                    (if (> 1 nesting-level)
-                                      (first rule)
-                                      (symbol (str "__" nesting-level "_" rule-name)))
+                                    (prefix-rule-name rule-name nesting-level)
                                     (create-proc-sub-fn rule-expression input))
           (and
             (vector? rule-expression)
@@ -74,34 +91,32 @@
                                                     body-creation-fn
                                                     output
                                                     (inc nesting-level))))
-          (and
-            (vector? rule-expression)
-            (every? list? (butlast (take-nth 2 rule-expression)))
-            (every?
-              vector?
-                (butlast
-                  (take-nth
-                    2
-                    (rest rule-expression))))) (do
-                                                 (println "FOOOOOOOOOOOOOOOO")
-                                                 (pprint rule-expression)
-                                                 (println "")
-                                                 (let [x (reduce
-                                                           (fn [vect v]
-                                                             (cond
-                                                               (or (list? v)
-                                                                   (keyword? v)) (conj vect v)
-                                                               (vector? v) (conj vect
-                                                                                (create-let-expression input v body-creation-fn output (inc nesting-level)))
-                                                               :default (do
-                                                                          (println "Unknown rule expression part:" v)
-                                                                          vect)))
-                                                           ['clojure.core/cond]
-                                                           rule-expression)]
-                                                   (println "BAAAAARRRRRRRRRRRR")
-                                                   (pprint x)
-                                                   (println "BLAH")
-                                                   (conj v rule-name (into '() (reverse x)))))
+          (cond-rule-expr? rule-expression) (do
+                                              (println "FOOOOOOOOOOOOOOOO")
+                                              (pprint rule-expression)
+                                              (println "")
+                                              (let [cond-expr (reduce
+                                                                (fn [vect v]
+                                                                  (cond
+                                                                    (or (list? v)
+                                                                        (keyword? v)) (conj vect v)
+                                                                    (vector? v) (conj vect
+                                                                                (create-let-expression
+                                                                                input
+                                                                                v
+                                                                                body-creation-fn
+                                                                                output
+                                                                                (inc nesting-level)))
+                                                                    :default (do
+                                                                               (println "Unknown rule expression part:" v)
+                                                                               vect)))
+                                                                ['clojure.core/cond]
+                                                                rule-expression)]
+                                                (println "BAAAAARRRRRRRRRRRR")
+                                                (pprint cond-expr)
+                                                (println "BLAH")
+                                                (pprint (into '() (reverse cond-expr)))
+                                                (conj v (prefix-rule-name rule-name nesting-level) (into '() (reverse cond-expr)))))
           :default (println "Binding: unknown element for rule:" (str rule)))))
     []
     rules))
@@ -156,8 +171,9 @@
                                                   `(assoc
                                                      ~(name (first rule))
                                                      ~(reverse (into '() (create-let-body-vec-clj-map-out (second rule) nil (inc nesting-level)))))))
+;        (cond-rule-expr? (second rule))
         :default (do (println "Clj Map Body: unknown element for rule:" (str rule))
-                     (throw (RuntimeException. "Clj Map Body: unknown element for rule"))
+                     ;(throw (RuntimeException. "Clj Map Body: unknown element for rule"))
                      )))
     (if (nil? output)
       '[-> {}]


minor qb additions

minor qb additions

--- src/grafter/rdf/ontologies/qb.clj
+++ src/grafter/rdf/ontologies/qb.clj
@@ -6,3 +6,5 @@
 (def qb:dataSet (qb "dataSet"))

 (def qb:Observation (qb "Observation"))
+
+(def qb:DataStructureDefinition (qb "DataStructureDefinition"))


Make fixtures register a macro and register by var instead of fn.

--- src/incise/once/fixtures/core.clj
+++ src/incise/once/fixtures/core.clj
@@ -4,12 +4,12 @@

 (defonce fixtures (atom {}))

-(defn register
+(defmacro register
   "Register a fixture for once with the given rank. Rank should be a number. The
   higher the number the later the fixture is executed. (A fixture with rank 0
   would be the first thing to execute.)"
   [fixture & [rank]]
-  (swap! fixtures assoc fixture (or rank 750)))
+  `(swap! fixtures assoc (var ~fixture) (or ~rank 750)))

 (defn- generate-thunk [thunk fixture]
   (fn [] (fixture thunk)))


remove redundant code.

remove redundant code.

--- src/kixi/hecuba/api/templates.clj
+++ src/kixi/hecuba/api/templates.clj
@@ -149,15 +149,14 @@
           username  (sec/session-username session)
           auth      (sec/current-authentication session)
           uuid      (uuid)
-          item      [:src-name "downloads" :dest :download :type :measurements :entity_id entity_id]
+          item      {:src-name "downloads" :dest :download :type :measurements :entity_id entity_id}
           location  (format uploads-status-resource-path username uuid)]
       (if data?
-        (do  (pipe/submit-item pipe (assoc item
-                                      :uuid (str username "/" uuid)
-                                      :auth (:auth ctx)))
-             {:response {:status 202
-                         :headers {"Location" location}
-                         :body "Accepted"}})
+        (do (pipe/submit-item pipe (assoc item
+                                     :uuid (str username "/" uuid)))
+            {:response {:status 202
+                        :headers {"Location" location}
+                        :body "Accepted"}})
         (ring-response {:headers {"Content-Disposition" (str "attachment; filename=" entity_id "_template.csv")}
                         :body (util/render-items ctx (measurements-download/get-header store entity_id))})))))


should minify foreign libs under :simple as  well

--- src/main/clojure/cljs/closure.clj
+++ src/main/clojure/cljs/closure.clj
@@ -1420,7 +1420,7 @@

 (defn foreign-deps-str [opts sources]
   (letfn [(to-js-str [ijs]
-            (let [url (or (and (= (:optimizations opts) :advanced)
+            (let [url (or (and (#{:advanced :simple} (:optimizations opts))
                                (:url-min ijs))
                           (:url ijs))]
               (slurp url)))]


don't fail when trying to delete an AOT .class file

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -150,11 +150,18 @@

 (defn remove-class-files [path]
   (when (fs/existsSync path)
-    (doseq [file (fs/readdirSync path)
+    ;; shadow-cljs - error ENOENT: no such file or directory, unlink '...'
+    ;; I have no idea how readdir can find a file but then not find it when
+    ;; trying to delete it?
+    (doseq [file (into [] (fs/readdirSync path))
             :let [file (path/resolve path file)]]
       (cond
         (str/ends-with? file ".class")
-        (fs/unlinkSync file)
+        (when (fs/existsSync file)
+          (try
+            (fs/unlinkSync file)
+            (catch :default e
+              (prn [:failed-to-delete file]))))

         (is-directory? file)
         (remove-class-files file)


Fix handling of plain 'SNAPSHOT' version

--- src/leiningen/ancient/artifact/check.clj
+++ src/leiningen/ancient/artifact/check.clj
@@ -9,7 +9,7 @@
   [{:keys [id version]} [_ _ & {:keys [upgrade upgrade?] :or {upgrade []}}]]
   (if (or (false? upgrade)
           (false? upgrade?)
-          (contains? #{[["snapshot"]]
+          (contains? #{[[] ["snapshot"]]
                        [["release"]]
                        [["latest"]]}
                      version))


Add  extend `sesame-rdf-type->type` to java.net.URI

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -273,6 +273,9 @@
   java.net.URI
   (->sesame-rdf-type [this]
     (URIImpl. (.toString this)))
+
+  (sesame-rdf-type->type [this]
+    this)

   java.net.URL
   (->sesame-rdf-type [this]


fix browser overrides disabling package requires

--- src/main/shadow/build/npm.clj
+++ src/main/shadow/build/npm.clj
@@ -362,14 +362,22 @@
     ;; FIXME: do node libs ever have nested things?
     ;; path/foo would not be overridden by path
     :else
-    (let [override (get node-libs-browser require)]
-
+    (let [browser-override
+          (and require-from
+               (let [{:keys [browser-overrides] :as require-from-pkg}
+                     (find-package-for-file npm require-from)]
+                 (get browser-overrides require)))
+
+          override
+          (if (some? browser-override)
+            browser-override
+            (get node-libs-browser require))]
       (cond
+        (false? override)
+        false
+
         (nil? override)
         (find-package-require npm require)
-
-        (false? override)
-        empty-rc

         ;; "foo":"bar"
         :else
@@ -597,56 +605,63 @@
          (string? require)
          (map? require-ctx)]}

-  (when-let [file (find-file npm require-from require)]
-
-    (let [{:keys [browser-overrides package-dir] :as pkg}
-          (find-package-for-file npm file)
-
-          ;; the package may have "browser":{"./a":"./b"} overrides
-          override
-          (when (and pkg (seq browser-overrides))
-            (let [package-path
-                  (.toPath package-dir)
-
-                  rel-name
-                  (str "./" (.relativize package-path (.toPath file)))]
-
-              ;; FIXME: I'm almost certain that browser allows overriding without extension
-              ;; "./lib/some-file":"./lib/some-other-file"
-              (get browser-overrides rel-name)))]
-
-      (cond
-        ;; good to go, no browser overrides
-        (nil? override)
-        (get-file-info npm file)
-
-        ;; disabled require
-        (false? override)
-        empty-rc
-
-        ;; FIXME: is "./lib/some-file.js":"some-package" allowed?
-        ;; currently assumes its always a file in the package itself
-        (string? override)
-        (let [override-file
-              (-> (io/file package-dir override)
-                  (.getCanonicalFile))]
-
-          (when-not (.exists override-file)
-            (throw (ex-info "override to file that doesn't exist"
-                     {:tag ::invalid-override
-                      :require-from require-from
-                      :require require
-                      :file file
-                      :override override
-                      :override-file override-file})))
-          (get-file-info npm override-file))
-
-        :else
-        (throw (ex-info "invalid override"
-                 {:tag ::invalid-override
-                  :package-dir package-dir
-                  :require require
-                  :override override}))))))
+  (let [file (find-file npm require-from require)]
+    (cond
+      (nil? file)
+      nil
+
+      (false? file)
+      empty-rc
+
+      :else
+      (let [{:keys [browser-overrides package-dir] :as pkg}
+            (find-package-for-file npm file)
+
+            ;; the package may have "browser":{"./a":"./b"} overrides
+            override
+            (when (and pkg (seq browser-overrides))
+              (let [package-path
+                    (.toPath package-dir)
+
+                    rel-name
+                    (str "./" (.relativize package-path (.toPath file)))]
+
+                ;; FIXME: I'm almost certain that browser allows overriding without extension
+                ;; "./lib/some-file":"./lib/some-other-file"
+                (get browser-overrides rel-name)))]
+
+        (cond
+          ;; good to go, no browser overrides
+          (nil? override)
+          (get-file-info npm file)
+
+          ;; disabled require
+          (false? override)
+          empty-rc
+
+          ;; FIXME: is "./lib/some-file.js":"some-package" allowed?
+          ;; currently assumes its always a file in the package itself
+          (string? override)
+          (let [override-file
+                (-> (io/file package-dir override)
+                    (.getCanonicalFile))]
+
+            (when-not (.exists override-file)
+              (throw (ex-info "override to file that doesn't exist"
+                       {:tag ::invalid-override
+                        :require-from require-from
+                        :require require
+                        :file file
+                        :override override
+                        :override-file override-file})))
+            (get-file-info npm override-file))
+
+          :else
+          (throw (ex-info "invalid override"
+                   {:tag ::invalid-override
+                    :package-dir package-dir
+                    :require require
+                    :override override})))))))

 (defn find-resource
   [{:keys [project-dir] :as npm} ^File require-from ^String require require-ctx]


Update HATEOAS link for entry publish.

Update HATEOAS link for entry publish.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -53,7 +53,7 @@

 (defn- publish-link [org-slug board-slug entry-uuid]
   (hateoas/link-map "publish" hateoas/POST (str (url org-slug board-slug entry-uuid) "/publish")
-    {:content-type mt/share-request-media-type
+    {:content-type mt/entry-media-type
      :accept mt/entry-media-type}))

 (defn- share-link [org-slug board-slug entry-uuid]


Fix a typo in the entity-backrefs documentation

--- src/main/workflo/macros/entity/refs.cljc
+++ src/main/workflo/macros/entity/refs.cljc
@@ -53,7 +53,7 @@

 (defn entity-backrefs
   "Returns all references to an entity from other entities. The result
-   is a map that maps attribute names (e.g. `:post/author`) to refernce
+   is a map that maps attribute names (e.g. `:post/author`) to reference
    infos (e.g. `{:entity 'post :many? true}`."
   [entity-name]
   (get-in @+refmap+ [entity-name :backrefs]))


🔊 Log projection refreshes

🔊 Log projection refreshes

--- src/territory_bro/projections.clj
+++ src/territory_bro/projections.clj
@@ -3,13 +3,15 @@
 ;; The license text is at http://www.apache.org/licenses/LICENSE-2.0

 (ns territory-bro.projections
-  (:require [mount.core :as mount]
+  (:require [clojure.tools.logging :as log]
+            [mount.core :as mount]
             [territory-bro.congregation :as congregation]
             [territory-bro.db :as db]
             [territory-bro.event-store :as event-store]
             [territory-bro.gis-user :as gis-user]
             [territory-bro.poller :as poller])
-  (:import (java.util.concurrent Executors ScheduledExecutorService TimeUnit)))
+  (:import (com.google.common.util.concurrent ThreadFactoryBuilder)
+           (java.util.concurrent Executors ScheduledExecutorService TimeUnit)))

 (mount/defstate cache
   :start (atom {:last-event nil
@@ -33,7 +35,9 @@
         updated (apply-new-events conn cached)]
     (when-not (identical? cached updated)
       ;; with concurrent requests, only one of them will update the cache
-      (compare-and-set! cache cached updated))))
+      (when (compare-and-set! cache cached updated)
+        (log/info "Updated from revision" (:event/global-revision (:last-event cached))
+                  "to" (:event/global-revision (:last-event updated)))))))

 (defn cached-state []
   (:state @cache))
@@ -59,7 +63,10 @@

 (mount/defstate scheduled-refresh
-  :start (doto (Executors/newScheduledThreadPool 1)
+  :start (doto (Executors/newScheduledThreadPool 1 (-> (ThreadFactoryBuilder.)
+                                                       (.setNameFormat "territory-bro.projections/scheduled-refresh")
+                                                       (.setDaemon true)
+                                                       (.build)))
            (.scheduleWithFixedDelay refresh-async! 0 60 TimeUnit/SECONDS))
   :stop (.shutdown ^ScheduledExecutorService scheduled-refresh))


(TK-131) Remove precondition from `configure-logger!`

Previously, the `configure-logger!` function had a precondition asserting that
the `logging-conf` argument passed to it matched one of five different types.
The argument is passed through to the `doConfigure` method for the
JoranConfigurator class.

The benefit to having the precondition is a more explicit error message in the
case where `logging-conf` is of a type that `doConfigure` doesn't accept.
However, the downside to this is that we have to have a long list of all the
possibilities, which we previously got wrong, thereby artificially
constraining what could be used to configure logging. Thus, this commit
removes the precondition completely and updates the relevant docstring.

With this change, the error message if an argument of incorrect
type is used is not very informative:

    java.lang.IllegalArgumentException: No matching method found: doConfigure
    for class ch.qos.logback.classic.joran.JoranConfigurator

However, in order for someone to encounter this, they would have to be
configuring logging from code, not from a config file, and could reasonably be
expected to already be looking at the documentation for JoranConfigurator, or
to be able to familiarize themselves with this easily.

--- src/puppetlabs/trapperkeeper/logging.clj
+++ src/puppetlabs/trapperkeeper/logging.clj
@@ -73,9 +73,13 @@
        (.setLevel root level)))))

 (defn configure-logger!
-  "Reconfigures the current logger based on the supplied configuration."
+  "Reconfigures the current logger based on the supplied configuration.
+
+  Supplied configuration can be a file path, url, file, InputStream, or
+  InputSource. It is passed along unchanged to `doConfigure` for
+  JoranConfigurator. For more information, see the documentation for
+  ch.qos.logback.core.classic.joran.JoranConfigurator."
   [logging-conf]
-  {:pre [(#{String java.io.File java.net.URL java.io.InputStream org.xml.sax.InputSource} (type logging-conf))]}
   (let [configurator (JoranConfigurator.)
         context      (LoggerFactory/getILoggerFactory)]
     (.setContext configurator (LoggerFactory/getILoggerFactory))
@@ -83,9 +87,11 @@
     (.doConfigure configurator logging-conf)))

 (defn configure-logging!
-  "Takes a file path, url, file, or InputStream which can define how to
-  configure the logging system.
-
+  "Takes a file path, url, file, InputStream, or InputSource which can
+  define how to configure the logging system. This is passed unchanged
+  to the `doConfigure` method for the underlying JoranConfigurator
+  class.
+
   Also takes an optional `debug` flag which turns on debug logging."
   ([logging-conf]
    (configure-logging! logging-conf false))


a whole new world

a whole new world

--- ros/angelic_planning/src/ros/world.clj
+++ ros/angelic_planning/src/ros/world.clj
@@ -403,7 +403,7 @@
 	      :height 0.2}
     "bottle2" {:xyz [16.3 27.0 0.85] :rpy [0 0 0] :def (get-odwalla)
 	     :type :movable :on "table" :goal nil #_["endtable"] #_["table" (make-xy-region [16.21 16.8] [26.2 26.5])] :height 0.2}
-    "bottle3" {:xyz [12.2 26.1 0.70] :rpy [0 0 0] :def (get-odwalla)
+    "bottle3" {:xyz [12.4 26.1 0.70] :rpy [0 0 0] :def (get-odwalla)
 	     :type :movable :on "endtable" :goal ["table" ] :height 0.2}
     }
       d3-res d2-res d2-pad))


temporary fix for slow chats with long ens names

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/chat/utils.cljs
+++ src/status_im/ui/screens/chat/utils.cljs
@@ -14,12 +14,13 @@
 (defn format-author [alias style name]
   (let [additional-styles (style false)]
     (if name
-      [react/text {:number-of-lines 1
-                   :style (merge {:color       colors/blue
-                                  :font-size   13
-                                  :line-height 18
-                                  :font-weight "500"} additional-styles)}
-       (str "@" (or (stateofus/username name) name))]
+      (let [name (subs name 0 80)]
+        [react/text {:number-of-lines 2
+                     :style (merge {:color       colors/blue
+                                    :font-size   13
+                                    :line-height 18
+                                    :font-weight "500"} additional-styles)}
+         (str "@" (or (stateofus/username name) name))])
       [react/text {:style (merge {:color       colors/gray
                                   :font-size   12
                                   :line-height 18
@@ -36,7 +37,7 @@
     (or (and (= from current-public-key)
              [react/text {:style (style true)}
               (str reply-symbol (i18n/label :t/You))])
-        (format-author reply-name style false))))
+        (format-author (subs reply-name 0 80) style false))))

 (def ^:private styling->prop
   {:bold      {:style {:font-weight "700"}}


Add up! and make a few aesthetic changes

--- src/play_clj/core_cameras.clj
+++ src/play_clj/core_cameras.clj
@@ -169,9 +169,9 @@
   ([object x-val y-val]
     (position! object x-val y-val nil))
   ([object x-val y-val z-val]
-    (when x-val (x! object x-val))
-    (when y-val (y! object y-val))
-    (when z-val (z! object z-val))))
+    (some->> x-val (x! object))
+    (some->> y-val (y! object))
+    (some->> z-val (z! object))))

 (defn direction
   "Returns the direction of the camera in `screen`."
@@ -181,15 +181,25 @@

 (defn direction!
   "Sets the direction of the camera in `screen`."
-  [screen x y z]
-  (let [^Camera camera (u/get-obj screen :camera)]
-    (.lookAt camera x y z)
+  [screen x-val y-val z-val]
+  (let [^Camera camera (u/get-obj screen :camera)]
+    (.lookAt camera x-val y-val z-val)
     (.update camera)))

 (defn up [screen]
   "Returns the up vector of the camera in `screen`."
   (let [^Camera camera (u/get-obj screen :camera)]
     (. camera up)))
+
+(defn up!
+  "Sets the up vector of the camera in `screen`."
+  [screen x-val y-val z-val]
+  (let [^Camera camera (u/get-obj screen :camera)
+        ^Vector3 up-vec (up screen)]
+    (some->> x-val (x! up-vec))
+    (some->> y-val (y! up-vec))
+    (some->> z-val (z! up-vec))
+    (.update camera)))

 (defn near
   "Returns the near clipping plane distance of the camera in `screen`."


Add Source validations to v5 validations

--- src/vip/data_processor/validation/v5.clj
+++ src/vip/data_processor/validation/v5.clj
@@ -2,7 +2,8 @@
   (:require [vip.data-processor.validation.v5.candidate :as candidate]
             [vip.data-processor.validation.v5.email :as email]
             [vip.data-processor.validation.v5.id :as id]
-            [vip.data-processor.validation.v5.precinct :as precinct]))
+            [vip.data-processor.validation.v5.precinct :as precinct]
+            [vip.data-processor.validation.v5.source :as source]))

 (def validations
   [candidate/validate-no-missing-ballot-names
@@ -12,4 +13,9 @@
    id/validate-unique-ids
    id/validate-no-missing-ids
    precinct/validate-no-missing-names
-   precinct/validate-no-missing-locality-ids])
+   precinct/validate-no-missing-locality-ids
+   source/validate-one-source
+   source/validate-name
+   source/validate-date-time
+   source/validate-vip-id
+   source/validate-vip-id-valid-fips])


Made login panel buttons the right colors

--- src/webapp/client/views/login_panel.cljs
+++ src/webapp/client/views/login_panel.cljs
@@ -38,12 +38,12 @@
           <input type='checkbox'> Remember me
         </label>"

-        "<button id='login-button' type='button' class='btn' onclick='return false;
+        "<button id='login-button' type='button' class='btn btn-primary' onclick='return false;
                  style='margin-left: 10px;'>Login</button>"

         (el :button {
                      :type "button"
-                     :class "btn"
+                     :class "btn btn-info"
                      :style "margin-left: 10px;"
                      :text "Cancel"
                      :onclick #(do-action "show login panel")})
@@ -64,12 +64,12 @@

        "<input  id='password-button' type='password' class='input-small' placeholder='Password'>"

-       "<button id='login-button' type='button' class='btn' onclick='return false;'
+       "<button id='login-button' type='button' class='btn btn-primary' onclick='return false;'
                 style='margin-left: 10px;'>Sign up</button>"

        (el :button {
                      :type "button"
-                     :class "btn"
+                     :class "btn btn-info"
                      :style "margin-left: 10px;"
                      :text "Cancel"
                      :onclick #(do-action "show login panel")})
@@ -83,7 +83,7 @@
         (el :button
                           {:id    "login-button"
                            :style "margin: 5px; "
-                           :class "btn"
+                           :class "btn btn-default"
                            :text "login"
                            :onclick #(swap-section
                                                 ($ :#top-right)
@@ -92,7 +92,7 @@
         (el :button
                           {:id    "signup-button"
                            :style "margin: 5px;"
-                           :class "btn"
+                           :class "btn btn-default"
                            :text "Sign up"
                            :onclick #(swap-section
                                                 ($ :#top-right)


Use render-svg on render icons on the library.

--- src/uxbox/ui/dashboard/icons.cljs
+++ src/uxbox/ui/dashboard/icons.cljs
@@ -111,7 +111,7 @@
         [:div.dashboard-grid-content
          (for [icon (:icons coll)]
            [:div.grid-item.small-item.project-th {}
-            [:span.grid-item-image #_i/toggle (shapes/render icon)]
+            [:span.grid-item-image #_i/toggle (shapes/-render-svg icon nil)]
             [:h3 (:name icon)]
             #_[:div.project-th-actions
              [:div.project-th-icon.edit i/pencil]


Clean up stop to have clearer arglists.

Clean up stop to have clearer arglists.

--- scheduling/src/immutant/scheduling.clj
+++ scheduling/src/immutant/scheduling.clj
@@ -84,19 +84,20 @@
   map returned from a schedule call. If there are no jobs remaining on
   the scheduler the scheduler itself is stopped. Returns true if a job
   was actually removed."
-  [options & rest]
-  (let [options (-> (cons options rest)
-                  u/kwargs-or-map->map
-                  keywordize-keys
-                  (validate-options schedule "stop"))
-        ids (:ids options {(scheduler options)
-                           [(:id options)]})
-        stopped? (some boolean (doall (for [[s ids] ids, id ids]
-                                        (.unschedule s (name id)))))]
-    (doseq [scheduler (keys ids)]
-      (when (empty? (.scheduledJobs scheduler))
-        (.stop scheduler)))
-    stopped?))
+  ([key value & key-values]
+     (stop (apply hash-map key value key-values)))
+  ([options]
+      (let [options (-> options
+                      keywordize-keys
+                      (validate-options schedule "stop"))
+            ids (:ids options {(scheduler options)
+                               [(:id options)]})
+            stopped? (some boolean (doall (for [[s ids] ids, id ids]
+                                            (.unschedule s (name id)))))]
+        (doseq [scheduler (keys ids)]
+          (when (empty? (.scheduledJobs scheduler))
+            (.stop scheduler)))
+        stopped?)))

 (defoption in
   "Takes a duration after which the job will fire, e.g. (in 5 :minutes)")


more route colors

more route colors

--- src-cljs/flatride/frontend.cljs
+++ src-cljs/flatride/frontend.cljs
@@ -20,7 +20,7 @@
           "disableDefaultUI" true
           "center" (window/google.maps.LatLng. 45 45)))

-(def stroke-colors ["red" "green" "blue"])
+(def stroke-colors ["red" "green" "blue" "yellow" "purple"])

 (defn display-routes [routes-data]
   (doseq [route (:routes-data routes-data)]


Neanderthal vs ND4J vol 3.

Neanderthal vs ND4J vol 3.

--- examples/benchmarks/src/benchmarks/neanderthal_vs_nd4j.clj
+++ examples/benchmarks/src/benchmarks/neanderthal_vs_nd4j.clj
@@ -84,12 +84,12 @@
       (do (.mmul ^INDArray m1 ^INDArray m2)
           true))))
   ([m k1 k2 k3 k4 k5 n]
-   (with-release [m1 (Nd4j/rand ^int m ^int k1)
-                  m2 (Nd4j/rand ^int k1 ^int k2)
-                  m3 (Nd4j/rand ^int k2 ^int k3)
-                  m4 (Nd4j/rand ^int k3 ^int k4)
-                  m5 (Nd4j/rand ^int k4 ^int k5)
-                  m6 (Nd4j/rand ^int k5 ^int n)]
+   (let [m1 (Nd4j/rand ^int m ^int k1)
+         m2 (Nd4j/rand ^int k1 ^int k2)
+         m3 (Nd4j/rand ^int k2 ^int k3)
+         m4 (Nd4j/rand ^int k3 ^int k4)
+         m5 (Nd4j/rand ^int k4 ^int k5)
+         m6 (Nd4j/rand ^int k5 ^int n)]
      (quick-bench
       (do (.mmul ^INDArray m1
                  (.mmul ^INDArray m2
@@ -99,12 +99,12 @@
           true)))))

 (defn time-nd4j-mmul [m k1 k2 k3 k4 k5 n]
-  (with-release [m1 (Nd4j/rand \f ^int m ^int k1)
-                 m2 (Nd4j/rand \f ^int k1 ^int k2)
-                 m3 (Nd4j/rand \f ^int k2 ^int k3)
-                 m4 (Nd4j/rand \f ^int k3 ^int k4)
-                 m5 (Nd4j/rand \f ^int k4 ^int k5)
-                 m6 (Nd4j/rand \f ^int k5 ^int n)]
+  (let [m1 (Nd4j/rand \f ^int m ^int k1)
+        m2 (Nd4j/rand \f ^int k1 ^int k2)
+        m3 (Nd4j/rand \f ^int k2 ^int k3)
+        m4 (Nd4j/rand \f ^int k3 ^int k4)
+        m5 (Nd4j/rand \f ^int k4 ^int k5)
+        m6 (Nd4j/rand \f ^int k5 ^int n)]
     (time
      (do (.mmul ^INDArray m1
                 (.mmul ^INDArray m2
@@ -112,3 +112,37 @@
                               (.mmul ^INDArray m4
                                      (.mmul ^INDArray m5 ^INDArray m6)) )))
          true))))
+
+;; Vol 3
+
+(defn bench-nd4j-mm-forwards [m k1 k2 k3 k4 k5 n]
+  (let [m1 (Nd4j/rand ^int m ^int k1)
+        m2 (Nd4j/rand ^int k1 ^int k2)
+        m3 (Nd4j/rand ^int k2 ^int k3)
+        m4 (Nd4j/rand ^int k3 ^int k4)
+        m5 (Nd4j/rand ^int k4 ^int k5)
+        m6 (Nd4j/rand ^int k5 ^int n)]
+    (quick-bench
+     (do (-> ^INDArray m1
+             (.mmul ^INDArray m2)
+             (.mmul ^INDArray m3)
+             (.mmul ^INDArray m4)
+             (.mmul ^INDArray m5)
+             (.mmul ^INDArray m6))
+         true))))
+
+(defn time-nd4j-mm-forwards [m k1 k2 k3 k4 k5 n]
+  (let [m1 (Nd4j/rand ^int m ^int k1)
+        m2 (Nd4j/rand ^int k1 ^int k2)
+        m3 (Nd4j/rand ^int k2 ^int k3)
+        m4 (Nd4j/rand ^int k3 ^int k4)
+        m5 (Nd4j/rand ^int k4 ^int k5)
+        m6 (Nd4j/rand ^int k5 ^int n)]
+    (time
+     (do (-> ^INDArray m1
+             (.mmul ^INDArray m2)
+             (.mmul ^INDArray m3)
+             (.mmul ^INDArray m4)
+             (.mmul ^INDArray m5)
+             (.mmul ^INDArray m6))
+         true))))


Deleting function is added.

Deleting function is added.

--- src/sweet_crossplane/core.clj
+++ src/sweet_crossplane/core.clj
@@ -713,6 +713,11 @@
   (layout (string/capitalize (dog-mission/translate :edit-view-title (dog-mission/translate entity-class-key)))
           (input-form-panel entity-class-key entity radial-mount-errors :patch (<< "/~(name entity-class-key)/~(:key entity)") :update)))

+(defn back-to-index-view
+  [entity-class-key]
+  (layout ""
+          (javascript-tag (<< "$.crossplane.goToWithMethodAndParams('~(to-uri (<< \"/~(name entity-class-key)\"))', 'get', ~(json/write-str (base64-decode (get-in *request* [:params :index-params]))));"))))
+
 ;; Controllers.

 (defmulti condition
@@ -798,8 +803,8 @@
   (->> (database-data @database-schema *transaction* entity-class-key ($= :key entity-key))
        (database      @database-schema)))

-(defn save-entity!
-  [entity-class-key database entity-key view-fn]
+(defn create-or-update-entity!
+  [entity-class-key database entity-key new-or-edit-view-fn]
   (let [entity-class-schema (entity-class-schema entity-class-key)
         database            (->> (reduce (fn [database property-key]
                                            (if (some #{property-key} (inputtable-property-keys entity-class-key))
@@ -815,11 +820,17 @@
                                          database
                                          (input-property-keys entity-class-key)))]
     (if (not-empty (get-in *request* [:entity-param-errors]))
-      (view-fn entity-class-key (get-in database [entity-class-key entity-key]))
-      (if-let [radial-mount-errors (not-empty (get-in (radial-mount/validate @database-schema database) [entity-class-key entity-key]))]
-        (view-fn entity-class-key (get-in database [entity-class-key entity-key]) radial-mount-errors)
-        (do (save! @database-schema database *transaction*)
-            (layout "" (javascript-tag (<< "$.crossplane.goToWithMethodAndParams('~(to-uri (<< \"/~(name entity-class-key)\"))', 'get', ~(json/write-str (base64-decode (get-in *request* [:params :index-params]))));"))))))))
+      (new-or-edit-view-fn entity-class-key (get-in database [entity-class-key entity-key]))
+      (do nil  ; TODO: ここに、ユーザー・コードでのデータ更新処理を入れる。
+          (if-let [radial-mount-errors (not-empty (get-in (radial-mount/validate @database-schema database) [entity-class-key entity-key]))]
+            (new-or-edit-view-fn entity-class-key (get-in database [entity-class-key entity-key]) radial-mount-errors)
+            (do (save! @database-schema database *transaction*)
+                (back-to-index-view entity-class-key)))))))
+
+(defn delete-entity!
+  [entity-class-key database entity-key]
+  (save! @database-schema (dissoc-in database [entity-class-key entity-key]) *transaction*)
+  (back-to-index-view entity-class-key))

 (defn index-controller
   [entity-class-key uri-parameters]
@@ -839,7 +850,7 @@
 (defn create-controller
   [entity-class-key uri-parameters]
   (with-db-transaction'
-    (save-entity! entity-class-key (database @database-schema) (new-key) new-view)))
+    (create-or-update-entity! entity-class-key (database @database-schema) (new-key) new-view)))

 (defn edit-controller
   [entity-class-key uri-parameters]
@@ -851,12 +862,13 @@
   [entity-class-key uri-parameters]
   (with-db-transaction'
     (let [entity-key (UUID/fromString (:key uri-parameters))]
-      (save-entity! entity-class-key (entity-contained-database entity-class-key entity-key) entity-key edit-view))))
+      (create-or-update-entity! entity-class-key (entity-contained-database entity-class-key entity-key) entity-key edit-view))))

 (defn destroy-controller
   [entity-class-key uri-parameters]
-  (layout "" (list [:p "destroy"]
-                   (link-to-with-method-and-params {:class "btn btn-default"} (to-uri (<< "/~(name entity-class-key)")) :get (base64-decode (get-in *request* [:params :index-params])) (string/capitalize (dog-mission/translate :back))))))
+  (with-db-transaction'
+    (let [entity-key (UUID/fromString (:key uri-parameters))]
+      (delete-entity! entity-class-key (entity-contained-database entity-class-key entity-key) entity-key))))

 ;; Rouring.


remove unused code

remove unused code

--- server/src/gratefulplace/db/manage.clj
+++ server/src/gratefulplace/db/manage.clj
@@ -113,12 +113,4 @@
 (defn reload
   []
   (delete)
-  (migrate))
-
-(defn pref-update-transactions
-  []
-  (map
-   (fn [ent]
-     {:db/id (:db/id ent)
-      :user/preferences ["receive-watch-notifications" "receive-new-topic-notifications"]})
-   (db/all [:user/receive-watch-notifications true])))+  (migrate))


adding export for advanced compilation

adding export for advanced compilation

--- resources/leiningen/new/closp/cljs/core.cljs
+++ resources/leiningen/new/closp/cljs/core.cljs
@@ -12,6 +12,6 @@
       [child "Foo Bar"])

-(defn main []
+(defn ^:export main []
       (cljx/foo-cljx "hello from js")
       (reagent/render-component (fn [] [childcaller]) (h/get-elem "app")))


Inject-configuration: test for NPE etc.

Inject-configuration: test for NPE etc.

--- test/emender_jenkins/middleware_test.clj
+++ test/emender_jenkins/middleware_test.clj
@@ -45,3 +45,22 @@
                 {:configuration :cfg} (function {})
                 {:configuration :cfg :foo :bar} (function {:foo :bar})))))

+(deftest test-inject-confuguration-2
+    "Check the behaviour of function emender-jenkins.middleware/inject-configuration."
+    (testing "The function emender-jenkins.middleware/inject-configuration."
+        (let [function (inject-configuration (fn [x] nil) :cfg)]
+            (are [x y] (= x y)
+                nil (function nil)
+                nil (function {})
+                nil (function {:foo :bar})
+                nil (function {:foo :bar :baz :bar})))))
+
+(deftest test-inject-confuguration-not-NPE
+    "Check the behaviour of function emender-jenkins.middleware/inject-configuration."
+    (testing "The function emender-jenkins.middleware/inject-configuration."
+        (let [function (inject-configuration (fn [x] x) nil)]
+            (are [x y] (= x y)
+                {:configuration nil} (function nil)
+                {:configuration nil} (function {})
+                {:configuration nil :foo :bar} (function {:foo :bar})))))
+


load test-data parses to valid Crate timestamp

--- test/metabase/test/data/crate.clj
+++ test/metabase/test/data/crate.clj
@@ -5,7 +5,8 @@
             (metabase.test.data [generic-sql :as generic]
                                 [interface :as i])
             [metabase.driver.generic-sql :as sql]
-            [clojure.java.jdbc :as jdbc])
+            [clojure.java.jdbc :as jdbc]
+            [metabase.util :as u])
   (:import metabase.driver.crate.CrateDriver))

 (def ^:private ^:const field-base-type->sql-type
@@ -20,25 +21,32 @@
    :TextField       "string"
    :TimeField       "timestamp"})

+
+(defn- timestamp->CrateDateTime
+  [value]
+  (if (= (instance? java.sql.Timestamp value) true)
+    (.getTime (u/->Timestamp value))
+    value))
+
 (defn- escape-field-names
   "Escape the field-name keys in ROW-OR-ROWS."
   [row-or-rows]
   (if (sequential? row-or-rows)
     (map escape-field-names row-or-rows)
     (into {} (for [[k v] row-or-rows]
-               {(sql/escape-field-name k) v}))))
+               {(sql/escape-field-name k) (timestamp->CrateDateTime v)}))))

 (defn- make-load-data-fn
   "Create a `load-data!` function. This creates a function to actually insert a row or rows, wraps it with any WRAP-INSERT-FNS,
    the calls the resulting function with the rows to insert."
   [& wrap-insert-fns]
   (fn [driver dbdef tabledef]
-    (let [insert! (fn [row-or-rows]
-                    (apply jdbc/insert!
-                           (generic/database->spec driver :db dbdef)
-                           (keyword (get tabledef :table-name))
-                           :transaction? false
-                           (escape-field-names row-or-rows)))
+    (let [insert!   ((apply comp wrap-insert-fns) (fn [row-or-rows]
+                                                    (apply jdbc/insert!
+                                                           (generic/database->spec driver :db dbdef)
+                                                           (keyword (get tabledef :table-name))
+                                                           :transaction? false
+                                                           (escape-field-names row-or-rows))))
           rows      (apply list (generic/load-data-get-rows driver dbdef tabledef))]
       (insert! rows))))

@@ -56,7 +64,7 @@
           :create-db-sql             (constantly nil)
           :add-fk-sql                (constantly nil)
           :drop-db-if-exists-sql     (constantly nil)
-          :load-data!                (make-load-data-fn)})
+          :load-data!                (make-load-data-fn generic/load-data-add-ids)})
   i/IDatasetLoader
   (merge generic/IDatasetLoaderMixin
          {:database->connection-details database->connection-details


[CS WR] zip up the final xml

[CS WR] zip up the final xml

--- src/vip/data_processor/s3.clj
+++ src/vip/data_processor/s3.clj
@@ -4,8 +4,12 @@
             [turbovote.resource-config :refer [config]]
             [korma.core :as korma]
             [clojure.string :refer [join]])
-  (:import [java.nio.file Files CopyOption StandardCopyOption]
-           [java.nio.file.attribute FileAttribute]))
+  (:import [java.io File]
+           [java.nio.file Files CopyOption StandardCopyOption]
+           [java.nio.file.attribute FileAttribute]
+           [net.lingala.zip4j.core ZipFile]
+           [net.lingala.zip4j.model ZipParameters]
+           [net.lingala.zip4j.util Zip4jConstants]))

 (defn- get-object [key]
   (s3/get-object (config :aws :creds)
@@ -47,7 +51,13 @@
 (defn upload-to-s3
   "Uploads the generated xml file to the specified S3 bucket."
   [ctx]
-  (let [new-filename (xml-filename ctx)]
-    (put-object (str "processed-feeds/" new-filename)
-                (.toFile (:xml-output-file ctx)))
-    (assoc ctx :generated-xml-filename new-filename)))
+  (let [zip-filename (str (xml-filename ctx) ".zip")
+        xml-file (-> ctx :xml-output-file .toFile)
+        zip-file (ZipFile. zip-filename)
+        zip-params (doto (ZipParameters.)
+                     (.setCompressionLevel
+                      Zip4jConstants/DEFLATE_LEVEL_NORMAL))]
+    (.createZipFile zip-file xml-file zip-params)
+    (put-object (str "processed-feeds/" zip-filename)
+                (File. zip-filename))
+    (assoc ctx :generated-xml-filename zip-filename)))


Pulse and cummulative graphs on user page

--- src/arachnida/html_renderer.clj
+++ src/arachnida/html_renderer.clj
@@ -3,6 +3,7 @@
 (require '[hiccup.core         :as hiccup])
 (require '[hiccup.page         :as page])
 (require '[hiccup.form         :as form])
+(require '[clj-flotr.generator :as flotr])

 (require '[arachnida.config    :as config])

@@ -98,8 +99,12 @@
         ] ; </body>
     ))

+(defn week-td
+    [selected-author week-stat data]
+    [:td [:a {:href (str "/author-week?name=" selected-author "&week=" (:week week-stat))} data]])
+
 (defn render-author-page
-    [author-name statistic]
+    [author-name statistic weeks-stat selected-week week-graph-data cummulative-graph-data]
     (page/xhtml
         (render-html-header)
         [:body
@@ -117,6 +122,38 @@
                     [:tr [:td "Changed files:"]
                          [:td (:files_changed statistic)]]
                 ]
+                [:h3 "Week stat"]
+                (flotr/line-chart "weeks statistic" "800px" "300px" week-graph-data
+                                  :horizontal-lines true
+                                  :vertical-lines true
+                                  :show-legend true
+                                  :legend-positon "sw")
+                [:h3 "Cummulative"]
+                (flotr/line-chart "cummulative statistic" "800px" "300px" cummulative-graph-data
+                                  :horizontal-lines true
+                                  :vertical-lines true
+                                  :show-legend true
+                                  :legend-positon "sw")
+                [:table {:class "table table-condensed table-hover table-bordered" :rules "all"}
+                    [:tr [:th {:colspan 3} "Week statistic"]]
+                    [:tr [:th "Week"] [:th "From"] [:th "To"] [:th {:colspan "4"} "Statistic"]]
+                    [:tr [:th " "] [:th " "] [:th " "]
+                         [:th "Commits"]
+                         [:th "Files"]
+                         [:th "Insertions"]
+                         [:th "Deletions"]]
+                (for [week-stat weeks-stat]
+                    [:tr
+                         (if (= (str (:week week-stat)) selected-week) {:style "background-color:yellow"})
+                         (week-td author-name week-stat (:week week-stat))
+                         (week-td author-name week-stat (:first-day week-stat))
+                         (week-td author-name week-stat (:last-day week-stat))
+                         [:td {:style "text-align:right"} (:commits-count (:stat-for-author week-stat))]
+                         [:td {:style "text-align:right"} (:files-changed (:stat-for-author week-stat))]
+                         [:td {:style "text-align:right"} (:insertions (:stat-for-author week-stat))]
+                         [:td {:style "text-align:right"} (:deletions (:stat-for-author week-stat))]
+                     ])
+                ]
                 [:br][:br][:br][:br]
                 (render-html-footer)
             ] ; </div class="container">


suggested implementations

suggested implementations

--- practice/alfa.clj
+++ practice/alfa.clj
@@ -7,6 +7,15 @@
     (if (= la -1)
       lb
       (recur (dec la) (conj lb (nth b la))))))
+
+(defn take$$ [n ls]
+  (loop [i 1 res [] raw ls]
+        (if (> i n)
+            res
+            (recur (inc i)
+                   (conj res (first raw))
+                   (rest ls)))))
+

 ;; Reimplementing Clojure in pure recursion
 ;; last, butlast, keep, map, take, take-while, remove, drop, drop-while, distinct, range, for


+:morph-ps

+:morph-ps

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -623,6 +623,7 @@
        :language "it"
        :language-keyword :italiano
        :morph fo
+       :morph-ps (fn [arg] (fo-ps1 arg))
        :lookup (fn [arg]
                  (analyze arg lexicon))
        :enrich enrich
@@ -720,6 +721,7 @@
                                    (morph-walk-tree tree))))
        :language "it"
        :language-keyword :italiano
+       :morph-ps (fn [arg] (fo-ps1 arg))
        :morph fo
        :lookup (fn [arg]
                  (analyze arg lexicon))


remove unnecessary and confusing {:synsem {:mod}} stuff

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -217,33 +217,29 @@

                    ;; nbar where head (noun) is first ('h' in h11)
                    (unifyc h11-comp-subcat-1
-                           (let [is-propernoun? (atom :top)
-                                 head-synsem {:cat :noun
-                                              :modified true
-                                              :propernoun is-propernoun?}]
+                           (let [is-propernoun? (atom :top)]
                              {:comp {:phrasal false ;; rathole prevention ;; TODO: see if this can be removed.
-                                     :synsem {:cat :adjective
-                                              :mod head-synsem}}
+                                     :synsem {:cat :adjective}}
                               :head {:phrasal false
                                      :synsem {:modified false ;; TODO: document what purpose :modified serves (if any: if none, remove).
                                               :propernoun is-propernoun?}}
                               :rule "nbar1"
-                              :synsem head-synsem}))
+                              :synsem {:cat :noun
+                                       :modified true
+                                       :propernoun is-propernoun?}}))

                    ;; nbar where complement (adjective) is first ('c' in c11)
                    (unifyc c11-comp-subcat-1
-                           (let [is-propernoun? (atom :top)
-                                 head-synsem {:cat :noun
-                                              :modified true
-                                              :propernoun is-propernoun?}]
+                           (let [is-propernoun? (atom :top)]
                              {:comp {:phrasal false ;; rathole prevention ;; TODO: see if this can be removed.
-                                     :synsem {:cat :adjective
-                                              :mod head-synsem}}
+                                     :synsem {:cat :adjective}}
                               :head {:phrasal false
                                      :synsem {:modified false ;; rathole prevention: as above, try to remove if possible
                                               :propernoun is-propernoun?}}
                               :rule "nbar2"
-                              :synsem head-synsem}))
+                              :synsem {:cat :noun
+                                       :modified true
+                                       :propernoun is-propernoun?}}))

                    (unifyc c10
                            comp-specs-head


remove more atoms

remove more atoms

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -182,31 +182,17 @@

    "alto"
    [;; non-comparative:
-    (let [subject-sem (atom {:human true}) ;; only humans can be tall.
-          subject-agr (atom :top)]
-      {:unify [adjective non-comparative-adjective]
-       :synsem {:cat :adjective
-                :sem {:pred :alto
-                      :comparative false
-                      :arg1 subject-sem
-                      :human true}
-                :subcat {:1 {:cat :det
-                             :agr subject-agr
-                             :sem subject-sem}
-                         :2 '()}}})
+    {:unify [adjective non-comparative-adjective]
+     :synsem {:cat :adjective
+              :sem {:pred :alto
+                    :comparative false
+                    :human true}}} ;; only humans can be tall.
+
     ;; comparative:
-    (let [complement-complement-sem (atom {:human true}) ;; only humans can be tall.
-          complement-sem (atom {:pred :di
-                               :mod complement-complement-sem})
-          subject-sem (atom {:human true})] ;; only humans can be tall.
-      {:unify [adjective comparative]
+    {:unify [adjective comparative]
        :synsem {:sem {:pred :alto
-                      :arg1 subject-sem
-                      :arg2 complement-complement-sem}
-                :subcat {:1 {:cat :noun
-                             :sem subject-sem}
-                         :2 {:cat :prep
-                             :sem complement-sem}}}})]
+                      :arg1 {:human true}
+                      :arg2 {:human true}}}}]

      "alzarsi" {:unify [reflexive]
                 :synsem {:sem {:pred :get-up
@@ -1645,7 +1631,6 @@
                    :comparative false
                    :physical-object true
                    :human false}}}
-
    "noi"
    [{:synsem {:cat :noun
               :pronoun true


cleanup

cleanup

--- src/bonews_rest/scraper/threads.clj
+++ src/bonews_rest/scraper/threads.clj
@@ -95,7 +95,7 @@
                         :bulbs      (bulbs/get-data        reply-url)
                         :url        reply-url
                         :post-time  @(get-reply-post-time  cols)
-                        :user       (utils/get-user-id user-url)}]]
+                        :user       (utils/get-user-id     user-url)}]]
     replies)))

 (defn get-users-data
@@ -122,11 +122,11 @@
       {
         :thread   (get-thread-data   rows thread-id)
         :replies  replies
-        :users    (distinct (conj (get-users-data rows) (flatten
-                    (filter (comp not empty?)
+        :users    (distinct (conj (get-users-data rows)
+                    (flatten
                       (for [reply replies
                         :let [users (:users (:bulbs reply))]]
-                      users)))))
+                      users))))
       }))
   ([subforum-id thread-id]
     (let [url    (get-thread-url     subforum-id thread-id)


Comment out dead code, midje was attempting to load it.

--- src/circleci/backend/config.clj
+++ src/circleci/backend/config.clj
@@ -1,45 +1,45 @@
-(ns circleci.backend.config
-  (:require [clj-yaml.core :as yaml])
-  (:use [arohner.utils :only (fold)]))
+;; (ns circleci.backend.config
+;;   (:require [clj-yaml.core :as yaml])
+;;   (:use [arohner.utils :only (fold)]))

-;; fns for loading config files
+;; ;; fns for loading config files

-(defn read-file [path]
-  (clj-yaml.core/parse-string (slurp path)))
+;; (defn read-file [path]
+;;   (clj-yaml.core/parse-string (slurp path)))

-(defn parse-actions)
+;; (defn parse-action)

-(defn key->map?
-  "returns true if this form is a keyword mapping to map"
-  [form]
-  (and (= 2 (count form)) (keyword? (first form)) (map? (second form?))))
+;; (defn key->map?
+;;   "returns true if this form is a keyword mapping to map"
+;;   [form]
+;;   (and (= 2 (count form)) (keyword? (first form)) (map? (second form))))

-(defn parse-actions [actions]
-  (->>
-   (for [action actions]
-     (if (key->map? action)
-       [(first action) (parse-action (second action))]
-       (println "unrecognized action:" action)))
-   (into {})))
+;; (defn parse-actions [actions]
+;;   (->>
+;;    (for [action actions]
+;;      (if (key->map? action)
+;;        [(first action) (parse-action (second action))]
+;;        (println "unrecognized action:" action)))
+;;    (into {})))

-(defn parse-project-form [project form]
-  (let [form-name (first form)
-        body (second form)]
-    (condp = form-name
-      :environment (update-in project [:environment] (parse-environment body))
-      :actions (update-in project [:actions] (parse-actions body))
-      (println "unrecognized form: " form-name))))
+;; (defn parse-project-form [project form]
+;;   (let [form-name (first form)
+;;         body (second form)]
+;;     (condp = form-name
+;;       :environment (update-in project [:environment] (parse-environment body))
+;;       :actions (update-in project [:actions] (parse-actions body))
+;;       (println "unrecognized form: " form-name))))

-(defn parse-project [project]
-  (fold [project {}] [form project]
-    (if (key->map? form)
-      (parse-project-form project form)
-      (println "unrecognized form in project:" form))))
+;; (defn parse-project [project]
+;;   (fold [project {}] [form project]
+;;     (if (key->map? form)
+;;       (parse-project-form project form)
+;;       (println "unrecognized form in project:" form))))

-(defn parse-config [yaml]
-  (fold [config {}] [form yaml]
-    (if (key->map? form)
-      (update-in config [:projects (first form)] (parse-project form))
-      (println "unrecognized form at top level:" form))))
+;; (defn parse-config [yaml]
+;;   (fold [config {}] [form yaml]
+;;     (if (key->map? form)
+;;       (update-in config [:projects (first form)] (parse-project form))
+;;       (println "unrecognized form at top level:" form))))

-(defmulti parse-form dispatch-form)+;; (defmulti parse-form dispatch-form)


Add the missing post route for editorials

--- src/clj/catalog/routes/home.clj
+++ src/clj/catalog/routes/home.clj
@@ -60,9 +60,15 @@

     ;; Editorials
     ["/editorial/:fmt"
-      {:get {:parameters {:path {:year ::year :issue ::issue :fmt ::format}}
-             :handler (fn [{{{:keys [year issue fmt]} :path} :parameters :as r}]
-                        (views/editorial-form r fmt year issue))}}]
+     {:name ::editorial
+      :get {:parameters {:path {:year ::year :issue ::issue :fmt ::format}}
+            :handler (fn [{{{:keys [year issue fmt]} :path} :parameters :as r}]
+                       (views/editorial-form r fmt year issue))}
+      :post {:parameters {:path {:year ::year :issue ::issue :fmt ::format}
+                          :form {:editorial string? :recommended string?}}
+             :handler (fn [{{{:keys [year issue fmt]} :path
+                             {:keys [editorial recommended]} :form} :parameters :as r}]
+                       (views/editorial r fmt year issue editorial recommended))}}]

     ;; Upload catalog data
     ["/upload"


Removed obsolete binding in Copycat

Removed obsolete binding in Copycat

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -61,8 +61,6 @@
                    :effect (effect (draw :runner))}}}

    "Copycat"
-   (let [ice-index (fn [state i] (first (keep-indexed #(when (= (:cid %2) (:cid i)) %1)
-                                                      (get-in @state (cons :corp (:zone i))))))]
    {:abilities [{:req (req (and (:run @state)
                                 (:rezzed current-ice)))
                  :effect (req (let [icename (:title current-ice)]
@@ -76,7 +74,7 @@
                                                   (swap! state update-in [:run]
                                                          #(assoc % :position tgtndx :server [dest]))
                                                   (trash state side card {:cause :ability-cost})))}
-                                 card nil)))}]})
+                                 card nil)))}]}

    "Crescentus"
    {:abilities [{:req (req current-ice) :msg (msg "derez " (:title current-ice))


Prevent filling board w/ more cards than left in deck

--- src/clj/ji/service/game_env.clj
+++ src/clj/ji/service/game_env.clj
@@ -27,7 +27,7 @@
 (defn fill-board
   "Returns game after filling board to 12 cards"
   [{:keys [board deck] :as game}]
-  (let [num-add (- 12 (count board))]
+  (let [num-add (- (min 12 (count deck)) (count board))]
     (if (pos? num-add)
       (game/draw-cards num-add game)
       game)))


Removed unneeded atom

Removed unneeded atom

--- src/cljs/chatapp/websocket.cljs
+++ src/cljs/chatapp/websocket.cljs
@@ -1,7 +1,5 @@
 (ns chatapp.websocket
   (:require [re-frame.core :as re-frame]))
-
-(def socket (atom nil))

 (defn- onmessage [event]
   (re-frame/dispatch [:add-message {:style "received" :message (str "<<< " (.-data event))}]))
@@ -22,6 +20,4 @@
     (set! (.-onerror websocket) onerror)
     (set! (.-onopen websocket) onopen)
     (set! (.-onmessage websocket) onmessage)
-    (set! (.-onclose websocket) onclose)
-
-    (reset! socket websocket)))
+    (set! (.-onclose websocket) onclose)))


Refactor

Refactor

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -13,13 +13,13 @@
 ;; State
 (defonce app-state (atom {}))

-(defonce state-bound
+(defonce top-stories-bound
   (base/bind-top-stories! app-state [:top-stories]))

 ;; ------------------------
 ;; Components
 (defn comment [data]
-  (let [local (atom {:collapse-comments? true})]
+  (let [local (atom {:collapse-comments? false})]
     (fn [data]
       (let [{:keys [id by kids parent text type time score deleted]} data]
         (when-not deleted
@@ -38,7 +38,7 @@

 (defn story [data]
   (let [local (atom {:collapse? false
-                     :collapse-comments? true})]
+                     :collapse-comments? false})]
     (fn [data]
       (let [{:keys [id by title kids type time url score]} data]
         (if (:collapse? @local)


Add implementation for bytes[] on SecretKey protocol.

--- src/clojure/buddy/core/keys.clj
+++ src/clojure/buddy/core/keys.clj
@@ -13,13 +13,17 @@
 ;; limitations under the License.

 (ns buddy.core.keys
-  (:require [buddy.core.codecs :refer [str->bytes]]))
+  (:require [buddy.core.codecs :refer [str->bytes bytes->hex]]))

 (defprotocol SecretKey
   (key->bytes [key] "Normalize key to byte array")
   (key->str [key] "Normalize key String"))

 (extend-protocol SecretKey
+  (Class/forName "[B")
+  (key->bytes [it] it)
+  (key->str [it] (bytes->hex it))
+
   String
   (key->bytes [key] (str->bytes key))
   (key->str [key] key))


http-kit/clojure: Fix compiling main module in Clojure 1.8.0 under OpenBSD.

--- src/clojure/srcs/dnsresolvd.clj
+++ src/clojure/srcs/dnsresolvd.clj
@@ -17,6 +17,9 @@

     (:require
         [dnsresolvh         :as AUX]
+        [clojure.walk       :refer [
+            keywordize-keys
+        ]]
         [org.httpkit.server :refer [
             run-server
             with-channel
@@ -85,7 +88,7 @@
             (AUX/EMPTY-STRING)
     )]

-    (let [params (clojure.walk/keywordize-keys
+    (let [params (keywordize-keys
         (try
             (apply hash-map (clojure.string/split params- (AUX/PARAMS-SEPS)))
         (catch


made fuelo api call with sensible defaults

--- src/clojure_web_app/handler.clj
+++ src/clojure_web_app/handler.clj
@@ -15,7 +15,7 @@
             [environ.core :refer [env]]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]))

-(def production true)
+(def production (or (env :production) false))

 (defn location-by-ip [ip]
   (json/read-str ((client/get (format "http://freegeoip.net/json/%s" ip)) :body) :key-fn keyword))
@@ -25,15 +25,15 @@
     ((client/get "http://fuelo.net/api/near" {:query-params {:key      (env :fuelo-api-key)
                                                              :lat      lat
                                                              :lon      lon
-                                                             :limit    limit
-                                                             :distance distance
-                                                             :fuel     fuel}}) :body)))
+                                                             :limit    (or limit "10")
+                                                             :distance (or distance "10")
+                                                             :fuel     (or fuel "lpg")}}) :body)))
 (defroutes app-routes
            (GET "/user/:id" [id greeting]
              {:body {:userId   id
                      :greeting greeting}})
            (GET "/print-query-params" [& args] (response args))
-           (GET "/cheapest-near-me" [limit distance fuel]
+           (GET "/fuel-near-me" [limit distance fuel]
              (fn [request]
                (let [location (location-by-ip (if production
                                                 ((:headers request) "x-forwarded-for")


cleaning up

cleaning up

--- src/celestial/puppet_standalone.clj
+++ src/celestial/puppet_standalone.clj
@@ -27,6 +27,4 @@
         )
       )))

-#_(.apply-
-    (Standalone. {:host "192.168.5.203"} {:name "puppet-base-env" :src "/home/ronen/code/"}))


Removed deleted examples from top contribs calculation

--- src/clj/clojuredocs/pages/intro.clj
+++ src/clj/clojuredocs/pages/intro.clj
@@ -118,7 +118,7 @@

 (defn top-contribs []
   (let [scores (atom {})]
-    (doseq [{:keys [author _id]} (mon/fetch :examples)]
+    (doseq [{:keys [author _id]} (mon/fetch :examples :where {:deleted-at nil})]
       (let [editors (->> (mon/fetch :example-histories :where {:example-id _id})
                          (map :editor))]
         (swap! scores update-in [author] #(+ 4 (or % 0)))


add ability to prefix debug with a name

add ability to prefix debug with a name

--- src/clj/marceline/storm/trident.clj
+++ src/clj/marceline/storm/trident.clj
@@ -435,13 +435,15 @@
   (.name stream name-str))

 (defn debug
-  [stream]
+  [stream & [name]]
   (condp isa? (class stream)
     GroupedStream (debug (.toStream stream))
     TridentState (do (debug (.newValuesStream stream)) stream)
     (.each stream
            (.getOutputFields stream)
-           (Debug.))))
+           (if (not (nil? name))
+             (Debug. name)
+             (Debug.)))))

 (defn broadcast
   [stream]


Fix autoreloadcore

Fix autoreloadcore

--- src/clj/robinson/autoreloadcore.clj
+++ src/clj/robinson/autoreloadcore.clj
@@ -25,7 +25,7 @@
      (.setDaemon true)
      (.start))))

-(def done-chan (async/chan))
+(defonce done-chan (async/chan))

 (defn -main []
   (let [default-setup-fn (constantly {})
@@ -33,36 +33,42 @@
         get-setup-fn     (fn [] (if-let [f (resolve 'robinson.main/setup)] f default-setup-fn))
         get-tick-fn      (fn [] (if-let [f (resolve 'robinson.main/tick)] f default-tick-fn))]
     (start-nstracker)
-    ; on ticks, this loop will restart. If setup-fn changes,
-    ; the state will be reset through setup-fn but the screen will cary over.
-    (go-loop [setup-fn     (get-setup-fn)
-              setup-fn-var (var-get setup-fn)
-              state        (setup-fn nil)]
-      ; start with initial state from setup-fn
-      ; setup function changed? restart with new setup
-      (if (identical? (var-get (get-setup-fn)) setup-fn-var)
-        ; tick the old state through the tick-fn to get the new state
-        (let [new-state (try
-                          (let [keyin (or (when (= (rw/current-state state) :sleep)
-                                          \.)
-                                        (let [key-chan (aterminal/get-key-chan (state :screen))]
-                                          (log/info  "waiting for key-chan")
-                                          (async/<! key-chan)))]
-                             (if keyin
-                               ((get-tick-fn) state keyin)
-                               state))
-                          (catch Throwable e
-                            (log/error e)
-                            state))]
-          (if (nil? new-state)
-            (System/exit 0)
-            (recur setup-fn setup-fn-var new-state)))
-        ; setup function changed, restart with new setup
-        (let [setup-fn  (get-setup-fn)
-              setup-var (var-get setup-fn)
-              state     (setup-fn (get state :screen))]
-          (println "(Re)starting loop with new setup-fn")
-          (recur setup-fn setup-var state))))
-    (async/<!! done-chan)
-    (println "Core exiting")))
+    ; start with initial state from setup-fn
+    (loop [setup-fn     (get-setup-fn)
+           setup-fn-var (var-get setup-fn)]
+      (setup-fn
+        (fn [state]
+          ; on ticks, this loop will restart. If setup-fn changes,
+          ; the state will be reset through setup-fn but the screen will cary over.
+          (go-loop [state state]
+            ; start with initial state from setup-fn
+            ; setup function changed? restart with new setup
+             (when (identical? (var-get (get-setup-fn)) setup-fn-var)
+              (if (nil? state)
+                ;; nil state, exit
+                (do
+                  (log/info "Got nil state. Exiting.")
+                  (async/>! done-chan true)
+                  (System/exit 0))
+                ; tick the old state through the tick-fn to get the new state
+                (let [new-state (try
+                                  (let [keyin (if (= (rw/current-state state) :sleep)
+                                                  \.
+                                                (let [key-chan (aterminal/get-key-chan (state :screen))]
+                                                  (log/info  "waiting for key-chan")
+                                                  (async/<! key-chan)))]
+                                     (if keyin
+                                       ((get-tick-fn) state keyin)
+                                       state))
+                                  (catch Throwable e
+                                    (log/error e)
+                                    state))]
+                    (recur new-state)))))))
+      ; setup function changed, restart with new setup
+      (let [setup-fn  (get-setup-fn)
+            setup-var (var-get setup-fn)]
+        (println "(Re)starting loop with new setup-fn")
+        (recur setup-fn setup-var)))
+        (async/<!! done-chan)
+        (println "Core exiting")))


Fixed an issue with images not having sizes

--- src/clj/sbsk/components/crawler.clj
+++ src/clj/sbsk/components/crawler.clj
@@ -35,9 +35,11 @@
     (try
       (with-open [in (io/input-stream uri)
                   out (io/output-stream file)]
-        (io/copy in out)
-        (when-let [img (ImageIO/read file)]
-          [(.getWidth img) (.getHeight img)]))
+        (io/copy in out))
+      (if-let [img (ImageIO/read file)]
+        [(.getWidth img) (.getHeight img)]
+        (throw (Exception. (str "Couldn't create ImageIO!"))))
+      (catch Throwable e (log/warn (str "Failed to process dimensions for " uri " - " (.getMessage e))))
       (finally (fs/delete file)))))

 (defn coerce-time
@@ -75,6 +77,8 @@
                             {:query-params
                              (merge access-token
                                     {:fields "created_time,description,id,permalink_url,picture,title,embeddable,format"})})) true)]
+               (when (mod c 10)
+                 (log/debug "...page" c))
                (let [{:keys [data paging]} page
                      {:keys [next]} paging
                      next-data (concat a data)]
@@ -134,7 +138,6 @@
                             (do
                               (log/debug "Caching unseen tag:" tag)
                               (swap! tags assoc tag 1)))) (:tags md))
-          (log/debug "Adding metadata for" key-name)
           (assoc video :meta md))
         video))))

@@ -209,6 +212,7 @@
       (let [{:keys [app-id app-secret page-id]} facebook
             tags (atom (load-tags! database bucket-segments default-tags))
             md-keys (set (db/list-keys database metadata-bucket))
+            _ (log/debug "Fetching records...")
             records (->> (fetch app-id app-secret page-id)
                          (filter :embeddable)
                          (map scrub)


Add auto-play

Add auto-play

--- src/cljs/asciinema_player/core.cljs
+++ src/cljs/asciinema_player/core.cljs
@@ -18,6 +18,7 @@
          :lines snapshot
          :play-from 0
          :current-time 0
+         :autoplay false
          :speed 1.0}))

 (defn apply-changes [state changes]
@@ -193,4 +194,6 @@
         (process-event state dispatch event)
         (recur)))
     (reagent/render-component [view/player state dispatch] dom-node)
+    (when (:autoplay @state)
+      (dispatch [:toggle-play]))
     (clj->js {:toggle (fn [] true)})))


Use progress bar to represent current level.

--- src/cljs/munchkin_toolbox/core.cljs
+++ src/cljs/munchkin_toolbox/core.cljs
@@ -30,10 +30,15 @@
             {:class "btn btn-success btn-lg btn-block"
              :on-click #(put! level-changed-c ::dec)}
             "-"]]
-          [:div {:class "col-sm-2"}
-           [:span
-            {:class "btn btn-info btn-lg btn-block" :disabled "disabled"}
-            level]]
+          [:div {:class "col-sm-8"}
+           [:div {:class "progress"}
+            [:div {:class "progress-bar"
+                   :role "progressbar"
+                   :aria-valuenow level
+                   :aria-valuemin "0"
+                   :aria-valuemax "10"
+                   :style {:width (str (* level 10) "%")}}
+             level]]]
           [:div {:class "col-sm-2"}
            [:button
             {:class "btn btn-danger btn-lg btn-block"


added a temporary NAPDMWL check function, before NRDB updates

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -19,6 +19,13 @@

 (defn found? [query cards]
   (some #(if (= (.toLowerCase (:title %)) query) %) cards))
+
+(defn mostwanted? [card]
+  "Returns true if card is on Most Wanted NAPD list."
+  (let [napdmwl '("Cerberus \"Lady\" H1" "Clone Chip" "Desperado" "Parasite" "Prepaid VoicePAD"
+                   "Architect" "AstroScript Pilot Program" "Eli 1.0" "NAPD Contract" "SanSan City Grid")]
+    (some #(= (:title card) %) napdmwl))
+  )

 (defn influencelimit [identity]
   "Returns influence limit of an identity or INFINITY in case of draft IDs."


Changed model a bit

Changed model a bit

--- src/clojure_rest/model/document.clj
+++ src/clojure_rest/model/document.clj
@@ -4,4 +4,4 @@

 (defn document
   "Creates a new document record"
-  [{:keys [id_document title text]]})
+  [{:keys [id_document title text]}])


Use :discussion/main as entrypoint after posting a position

--- src/discuss/communication/main.cljs
+++ src/discuss/communication/main.cljs
@@ -14,6 +14,7 @@
   (search/remove-search-results!)
   (lib/hide-add-form!)
   (rint/request-references)
+  (lib/change-to-next-view!)
   (comlib/process-and-set-items-and-bubbles response))

@@ -54,6 +55,7 @@
   "Add new position, its reason and an optional reference to post it to the
   backend."
   [{:keys [position reason reference search/selected]}]
+  (lib/next-view! :discussion/main)
   (let [url (lib/get-current-slug)
         headers (merge {"Content-Type" "application/json"} (comlib/token-header))
         body {:position position
@@ -61,11 +63,3 @@
               :reference reference
               :origin (build-origin-body selected)}]
     (post-json url body process-url-handler headers)))
-
-
-;;;; Get things started!
-(defn init-with-references!
-  "Load discussion and initially get reference to include them in the discussion."
-  []
-  (rint/request-references)
-  (comlib/init!))


Directly inject sidebar to DOM body

Directly inject sidebar to DOM body

--- src/discuss/components/sidebar.cljs
+++ src/discuss/components/sidebar.cljs
@@ -12,12 +12,12 @@
   "Toggle visibility of sidebar."
   ([]
    (let [sidebar-dom (gdom/getElement id)
-         main-wrapper (gdom/getElement "main-wrapper")]
+         main-wrapper (first (gdom/getElementsByTagName "body"))]
      (lib/toggle-class sidebar-dom "active")
      (lib/toggle-class main-wrapper "active")))
   ([bool]
    (let [sidebar-dom (gdom/getElement id)
-         main-wrapper (gdom/getElement "main-wrapper")]
+         main-wrapper (first (gdom/getElementsByTagName "body"))]
      (lib/toggle-class sidebar-dom "active" bool)
      (lib/toggle-class main-wrapper "active" bool))))


a bit

a bit