[up|fix] Dynamic calc for events parst, considering fees & rest goods.

--- src/ombs/dbold.clj
+++ src/ombs/dbold.clj
@@ -86,13 +86,30 @@
   (sql/update events (sql/set-fields {:status (statuses s)})
               (sql/where {:name ename :date date})) )

+(declare subtract-feesed-parts)
 (defn get-events []
+  "Return list of events, and it actual count of event"
+  ;First of all, we select events from it table and join for each rest(actual)
+  ;parts Then we update each event elent: substract from each count of parts,
+  ;that hang in fees some events haven't parts, and after join it's have nil
+  ;parts. So we need fix before substract
   (map
-    #(update % :parts f/nil-fix)
+    #(update % :parts
+             (comp (partial subtract-feesed-parts (:id %)) f/nil-fix))
     (sql/select events
-                (sql/fields :name :date :price :author :status )
-                (sql/with goods (sql/fields [:rest :parts]))
-                )))
+                (sql/fields :id :name :date :price :author :status)
+                (sql/with goods (sql/fields [:rest :parts])))))
+
+(defn subtract-feesed-parts [eid parts]
+  "Substract from given parts, founded parts in active(all) fees."
+  (assert (not= nil parts) "Can't subtract-feesed-parts from nil")
+  (- parts
+     (-> (sql/select fees (sql/fields :sum)
+                     (sql/where {:events_id eid})
+                     (sql/aggregate (sum :parts) :sum))
+         (first)
+         (:sum)
+         (f/nil-fix))))

 (defn get-active-events []
   (sql/select events


Use piped writers; getting closer to multi-line input

--- src/reply/core.clj
+++ src/reply/core.clj
@@ -6,9 +6,8 @@
            [scala.tools.jline.console.history FileHistory]
            [java.io File]))

-; TODO: allow multi-line input
 (defn actual-read [input request-prompt request-exit]
-  (binding [*in* (clojure.lang.LineNumberingPushbackReader. (java.io.StringReader. input))]
+  (binding [*in* (clojure.lang.LineNumberingPushbackReader. input)]
     (clojure.main/repl-read request-prompt request-exit)))

 (def main-thread (Thread/currentThread))
@@ -27,31 +26,47 @@
 (defn get-prompt [ns]
   (format "%s=> " (ns-name ns)))

+(def output-pipe (java.io.PipedWriter.))
+(def input-pipe (java.io.PipedReader. output-pipe))
+
+(defn clear-jline-buffer []
+  (-> (.getCursorBuffer jline-reader)
+      (.clear)))
+
 (defn handle-ctrl-c [signal]
   (println "^C")
   (.interrupt main-thread)
-  (-> (.getCursorBuffer jline-reader)
-      (.clear))
-  (print (get-prompt @current-repl-ns))
+  (clear-jline-buffer)
   (flush))

 (defn jline-read [request-prompt request-exit]
   (try
     (.setPrompt jline-reader (get-prompt *ns*))
     (reset! current-repl-ns *ns*)
-    (let [input (.readLine jline-reader)]
-      (cond (not input)
-              request-exit
-            (every? #(Character/isWhitespace %) input)
-              request-prompt
-            :else
-              (do
-                (Thread/interrupted) ; just to clear the status
-                (actual-read input request-prompt request-exit))))
+    (let [future-input (future
+                         ; TODO: need to loop here to read multiple lines
+                         (try
+                            (let [string-input (.readLine jline-reader)]
+                              (if string-input
+                                (do
+                                  (doseq [c (map int (.getBytes string-input))]
+                                    (.write output-pipe c)
+                                    (.flush output-pipe))
+                                  (.write output-pipe (int \newline)))
+                                (.close output-pipe)))
+                         (catch Throwable e
+                           (prn e)
+                           (throw e))))
+          _ @future-input
+          input input-pipe]
+        (do
+          (Thread/interrupted) ; just to clear the status
+          (actual-read input-pipe request-prompt request-exit)))
     (catch InterruptedException e
-      (-> (.getCursorBuffer jline-reader)
-          (.clear))
-      (request-prompt))))
+      (clear-jline-buffer)
+      request-prompt)
+    (catch Throwable e
+      (prn e))))

 (defn -main [& args]
   (set-break-handler! handle-ctrl-c)
@@ -59,5 +74,7 @@
   (repl :read jline-read
         :prompt (constantly ""))

+  (shutdown-agents)
+
   (.flush (.getHistory jline-reader)))


do not force compile before building a jar

--- tasks.clj
+++ tasks.clj
@@ -1,5 +1,5 @@
 (ns user
-  (:use [cake.core :only [deftask]]
+  (:use [cake.core :only [deftask remove-dep!]]
         [cake.file :only [file rm rmdir]]
         [cake.project :only [log]]
         [cake.ant :only [ant args env add-zipfileset]]
@@ -52,3 +52,5 @@
          (add-zipfileset {:src (str dest "/lib/tokyocabinet.jar") :includes "**/*.class"}))
     (rm (file dest "lib/tokyocabinet.jar"))
     (rmdir (file dest "lib/pkgconfig"))))
+
+(remove-dep! jar compile)


Adjust wording

Adjust wording

Correct grammatical error in comments.

Fixes onyx-platform/learn-onyx#7

--- src/workshop/challenge_3_0.clj
+++ src/workshop/challenge_3_0.clj
@@ -79,7 +79,7 @@
         (map #(%2 (str %1)) name)
         (apply str))})

-;; Usually, it's a good idea to take a apply one or more transformations
+;; Usually, it's a good idea to apply one or more transformations
 ;; to the map's keys and return the entire map. That way, each function
 ;; can simply pass through keys that it doesn't need to know about.
 (defn exclaim [segment]
@@ -118,4 +118,4 @@

    {:lifecycle/task :write-segments
     :lifecycle/calls :onyx.plugin.core-async/writer-calls
-    :onyx/doc "core.async plugin base lifecycle"}])+    :onyx/doc "core.async plugin base lifecycle"}])


reading km:s correctly back

reading km:s correctly back


Add `of-nanos`

Add `of-nanos`

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -574,6 +574,14 @@
     :weeks (cljc.java-time.period/of-weeks n)
     :months (cljc.java-time.period/of-months n)
     :years (cljc.java-time.period/of-years n)))
+
+;; Durations. Convenience functions to create durations of specific
+;; units.
+
+(defn of-nanos
+  "Takes a java.lang.Long n and returns a duration of n nanoseconds."
+  [n]
+  (new-duration n :nanos))

 ;; Coercions


small fix to platform detection

small fix to platform detection

--- src/spekl_package_manager/package.clj
+++ src/spekl_package_manager/package.clj
@@ -107,7 +107,7 @@
   (not (= nil (o :one-of))))

 (defn my-platform? [o]
-  (or (= util/get-my-platform (o :platform)) (= (o :platform "all"))))
+  (or (= (util/get-my-platform) (o :platform)) (= (o :platform) "all")))

 (defn is-dep? [o] (and (not (is-one-of? o)) (my-platform? o)))


extract leap, telemetry and keys at the beginning

--- src/sormilla/gui.clj
+++ src/sormilla/gui.clj
@@ -33,7 +33,7 @@
 (key->status! 32 :space)

 (defn render [^Graphics2D g ^long w ^long h]
-  (let [s      @status
+  (let [{:keys [leap telemetry keys]} @status
         w2     (/ w 2.0)
         w6     (/ w 6.0)
         h2     (/ h 2.0)
@@ -48,7 +48,7 @@

     ; status
     (.setColor g key-color)
-    (let [{:keys [left right up down space]} (:keys s)]
+    (let [{:keys [left right up down space]} keys]
       (when left   (.fill g (swing/->shape w6 h2 (* 2 w6) (* 2 h6) (* 2 w6) (* 4 h6))))
       (when right  (.fill g (swing/->shape (* 5 w6) h2 (* 4 w6) (* 2 h6) (* 4 w6) (* 4 h6))))
       (when up     (.fill g (swing/->shape w2 h6 (* 4 w6) (* 2 h6) (* 2 w6) (* 2 h6))))
@@ -68,9 +68,9 @@
     (doseq [y (range (/ h 50) h (/ h 50))] (.drawLine g (- w2 5) y (+ w2 5) y))

     ; draw "aim"
-    (when-let [leap (:leap s)]
+    (when leap
       ; draw quality boxes
-      (let [quality (get-in s [:leap :quality] 0)]
+      (let [quality (:quality leap)]
         (.setColor g (nth quality-colors quality))
         (doseq [y (range 5)]
           (when (>= y quality) (.setColor g hud-lo-color))
@@ -92,10 +92,10 @@
           (.drawLine g 0 -2000 0 2000))))

     ; draw telemetry
-    (when-let [{:keys [pitch yaw roll alt vel-x vel-y vel-z control-state battery-percent]} (:telemetry s)]
+    (when-let [{:keys [pitch yaw roll alt vel-x vel-y vel-z control-state battery-percent]} telemetry]
       (with-transforms g
         (.setColor g telemetry-color)
-        (.drawString g (str control-state) 10 20)
+        (.drawString g (str (name control-state)) 10 20)
         (.drawString g (str "bat: " battery-percent "%") 10 40)
         (.drawString g (format "yaw: %5.1f pitch: %5.1f roll: %5.1f alt: %8.3f" yaw pitch roll alt) 10 60)
         (.drawString g (format "x: %5.1f y: %5.1f z: %5.1f" vel-x vel-y vel-z) 10 80)


Events are now retrieved.

Events are now retrieved.

--- src/vertigo/core.clj
+++ src/vertigo/core.clj
@@ -17,16 +17,18 @@
     [:tr
       [:th "Date"]
       [:th "Comedy"]
-      [:th "Action"]
-      [:th "Drama"]
+      [:th "Action/Adventure/Sci-fi/Fantasy"]
+      [:th "Drama/Romance"]
+      [:th "Thriller/Horror"]
       [:th "Others"]]
     (for [{date           :date
            shows-by-genre :shows-by-genre} shows]
       [:tr
         [:td date]
         [:td (map render-show (:comedy shows-by-genre))]
-        [:td (map render-show (:action shows-by-genre))]
-        [:td (map render-show (:drama shows-by-genre))]
+        [:td (map render-show (:action-adventure-scifi-fantasy shows-by-genre))]
+        [:td (map render-show (:drama-romance shows-by-genre))]
+        [:td (map render-show (:thriller-horror shows-by-genre))]
         [:td (map render-show (:other shows-by-genre))]])])

 (defn calendar [shows]
@@ -62,8 +64,10 @@
       (fn [{genres :genres}]
         (condp some genres
           #{"Komedia"} :comedy
-          #{"Draama"} :drama
-          #{"Toiminta"} :action
+          #{"Toiminta" "Seikkailu" "Sci-fi" "Fantasia"}
+            :action-adventure-scifi-fantasy
+          #{"Draama" "Romantiikka"} :drama-romance
+          #{"Jännitys" "Kauhu"} :thriller-horror
           :other))
       shows)))

@@ -93,6 +97,19 @@
                      (swap! events-db assoc event-id new-event)
                      event-id)}))))

+(defn retrieve-all-distinct-event-ids-for-stored-shows []
+  (distinct (map
+              :event-id
+              (flatten
+                (for [{shows :shows-by-genre}
+                        (apply-on-whole-week retrieve-shows-by-date)]
+                  (vals shows))))))
+
+(defn retrieve-all-events-for-stored-shows []
+  (map
+    retrieve-event
+    (retrieve-all-distinct-event-ids-for-stored-shows)))
+
 (defn retrieve-and-store-shows-from-finnkino [date]
   (let [formatted-date (unparse (formatter "dd.MM.yyyy") date)
         new-shows
@@ -109,8 +126,14 @@
 (defroutes handler
   (GET "/" []
     (views/calendar (apply-on-whole-week retrieve-shows-by-date)))
+  (GET "/:id" [id]
+    (views/movie (retrieve-movie id))
   (GET "/execute-batch" []
-    (apply-on-whole-week retrieve-and-store-shows-from-finnkino)))
+    (if (and
+          (apply-on-whole-week retrieve-and-store-shows-from-finnkino)
+          (retrieve-all-events-for-stored-shows))
+      "success"
+      "failure")))

 (run-jetty handler {:port 8080 :join? false})


Add method for running server.

Add method for running server.

--- src/quil_site/core.clj
+++ src/quil_site/core.clj
@@ -26,6 +26,9 @@
       json/wrap-json-response
       stacktrace/wrap-stacktrace))

+(defn run []
+  (run-jetty handler {:port 8080}))
+
 (comment

  (def server (run-jetty #(handler %) {:port 8080 :join? false}))


Simplified calls to `apply`.

Simplified calls to `apply`.

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -338,7 +338,7 @@
   "
   {:api-docs/heading "Subscriptions"}
   [query-id & args]
-  (apply subs/reg-sub (into [query-id] args)))
+  (apply subs/reg-sub query-id args))

 (defn subscribe
   "Given a `query` vector, returns a Reagent `reaction` which will, over
@@ -795,7 +795,7 @@
   "
   {:api-docs/heading "Interceptors"}
   [f out-path & in-paths]
-  (apply std-interceptors/on-changes (into [f out-path] in-paths)))
+  (apply std-interceptors/on-changes f out-path in-paths))

 (defn reg-global-interceptor
@@ -971,7 +971,7 @@
   "
   {:api-docs/heading "Logging"}
   [level & args]
-  (apply loggers/console (into [level] args)))
+  (apply loggers/console level args))

 ;; -- unit testing ------------------------------------------------------------


Better comment

Better comment

--- src/re_frame/core.cljs
+++ src/re_frame/core.cljs
@@ -71,6 +71,12 @@
 ;;   (defn my-fn [& args]  (post-it-somewhere (apply str args)))
 ;;   (re-frame.core/set-loggers!  {:warn my-fn :log my-fn})    ;; I should override the rest of them too.
 (def set-loggers! loggers/set-loggers!)
+
+;; If you are writing an extension to re-frame, like perhaps
+;; an effeects handler, you may want to use re-frame logging.
+;;
+;; usage:  (console :error "this is bad: " a-variable " and " anotherv)
+;;         (console :warn "possible breach of containment wall at: " dt)
 (def console loggers/console)


Add delete-revision method to remove a specific revision of a give section. Update the company accordingly in case we are removing the latest or the last revision of the given topic.

--- src/open_company/resources/section.clj
+++ src/open_company/resources/section.clj
@@ -121,6 +121,42 @@
         (common/update-resource conn table-name primary-key original-revision completed-revision updated-at))
       false))))

+(defn delete-revision
+  "
+  Given the company slug, section name, optional revision timestamp and an updated section property map, update an
+  exising section revision, returning the property map for the resource or `false`.
+  "
+  [conn company-slug section-name original-timestamp user]
+  {:pre [(map? conn)
+         (or (string? company-slug) (keyword? company-slug))
+         (or (string? section-name) (keyword? section-name))
+         (or (string? original-timestamp) (keyword? original-timestamp))
+         (map? user)]}
+  (let [original-company (company/get-company conn company-slug) ; company before the update
+        company-revision ((keyword section-name) original-company) ; current section in the company
+        all-revisions (get-revisions conn company-slug section-name)
+        filtered-revisions (sort #(compare (:created-at %2) (:created-at %1)) (filter #(not= (:created-at %) original-timestamp) all-revisions))
+        update-sections? (zero? (count filtered-revisions)) ; are we removing the last revision of this section?
+        update-company-section? (= (:updated-at company-revision) original-timestamp) ; are we removing the latest revision
+        original-sections (:sections original-company)
+        updated-sections (if update-sections?
+                           ; if we are removing the last section, remove the section from the list of sections
+                           (filter #(not= (name section-name) (name %)) original-sections)
+                           original-sections)
+        sectioned-company (assoc original-company :sections updated-sections)
+        updated-company (if update-company-section?
+                          ; if we are removing the latest revision, replace the section in company with the previous revision
+                          (assoc sectioned-company (keyword section-name) (dissoc (first filtered-revisions) :placeholder :company-slug :section-name))
+                          (when update-sections?
+                            ; if we are removing the last revision remove the section from the company too
+                            (dissoc sectioned-company section-name)))]
+    (if (= (:org-id original-company) (:org-id user)) ; user is valid to do this update
+      (do
+        (when (or update-sections? update-company-section?)
+          (company/update-company conn company-slug updated-company))
+        (common/delete-resource conn common/section-table-name "company-slug-section-name-updated-at" [company-slug section-name original-timestamp]))
+      false)))
+
 ;; ----- Section CRUD -----

 (defun get-section


async-queue: better docstring example

async-queue: better docstring example

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -218,10 +218,18 @@

   Example:

-  (let [graph (async-queue! :graphite {:queue-size 100}
-                            (graphite {:host ...}))]
+  (let [downstream (batch 100 1/10
+                          (async-queue! :agg {:queue-size     1e3
+                                              :core-pool-size 4
+                                              :max-pool-size  32}
+                            (forward
+                              (riemann.client/tcp-client
+                                :host \"127.0.0.1\"))))]
     (streams
-      (where ... graph)))"
+      ...
+      ; Forward all events downstream to the aggregator.
+      (where (service #\"^riemann.*\")
+        downstream)))"
   [name threadpool-service-opts & children]
   (let [s (service! (service/threadpool-service name threadpool-service-opts))]
     (apply execute-on s children)))


remove a comment

remove a comment

--- src/s7p/master/web.clj
+++ src/s7p/master/web.clj
@@ -126,7 +126,6 @@

 (defn -main [& args]
   (let [context (zmq/zcontext 1)
-        ;; somehow cannot use with-open
         in-file (io/reader (first args))
         pub (doto (zmq/socket context :pub)
               (zmq/bind config/command-addr))


Parse string instead of using Integer

Parse string instead of using Integer

--- src/server/clojure_template/server.clj
+++ src/server/clojure_template/server.clj
@@ -22,5 +22,5 @@
       wrap-gzip))

 (defn -main [& [port]]
-  (let [port (Integer. (or port (env :port) 3000))]
+  (let [port (read-string (or port (env :port) 3000))]
     (run-jetty http-handler {:port port :join? false})))


Bug fixes for user validation

Bug fixes for user validation

--- src/sdos_site/user.clj
+++ src/sdos_site/user.clj
@@ -169,15 +169,18 @@
   [req]
   (let [submitted-key (-> req :request-params :validation-key)
         db (:db req)]
-    (if (users/validate-key db submitted-key)
-      (let [username (-> req :session :user :username)
-            body (view/success-page (str "Email validated."))]
-        (if username
-          (let [session (:session req)
-                updated-user (users/get-by-username db username)]
-            {:session (assoc-in [:session :user] updated-user)
-             :body body})
-          body))
+    (if-let [user (users/get-by-validation-key db submitted-key)]
+      (if (users/set-validated db user)
+        (let [session-user (-> req :session :user)
+              body (view/success-page (str "Email validated."))]
+          (if (= (:id user) (:id session-user))
+            (let [session (:session req)]
+              {:session (assoc-in [:session :user :validated] true)
+               :body body})
+            body))
+        (layout/error-template (get-settings req)
+                               "Sorry, unable to validate email address at this
+                                time."))
       (layout/error-template (get-settings req)
                              "Sorry, email validation key not found."))))


Prefer require over use in sessions.clj.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -1,20 +1,20 @@
 (ns shale.sessions
-  (:require [clj-webdriver.remote.driver :as remote-webdriver]
+  (:require [clojure.set :refer [rename-keys]]
+            [clojure.string :as string]
+            [clojure.walk :refer :all]
+            [clojure.core.match :refer [match]]
+            [clj-dns.core :refer [dns-lookup]]
+            [clj-webdriver.remote.driver :as remote-webdriver]
+            [clj-webdriver.taxi :refer [current-url quit]]
             [taoensso.carmine :as car]
-            [clojure.string :as string]
             [org.bovinegenius  [exploding-fish :as uri]]
-            [shale.nodes :as nodes]
             [schema.core :as s]
             [camel-snake-kebab.core :refer :all]
             [taoensso.timbre :as timblre :refer [info warn error]]
-            [clojure.core.match :refer [match]])
-  (:use shale.utils
-        shale.redis
-        clojure.walk
-        [shale.webdriver :only [new-webdriver resume-webdriver to-async]]
-        [clj-webdriver.taxi :only [current-url quit]]
-        [clj-dns.core :only [dns-lookup]]
-        [clojure.set :only [rename-keys]])
+            [shale.nodes :as nodes]
+            [shale.utils :refer :all]
+            [shale.redis :refer :all]
+            [shale.webdriver :refer [new-webdriver resume-webdriver to-async]])
   (:import org.openqa.selenium.WebDriverException
            org.xbill.DNS.Type))


when removing a user from a room, be sure to also delete the room if it has no more users

--- src/subrosa/client.clj
+++ src/subrosa/client.clj
@@ -124,13 +124,18 @@
     (alter db add-tuple :room {:name room-name
                                :topic nil})))

+(defn maybe-delete-room! [room-name]
+  (when (seq (select @db :user-in-room {:room-name room-name}))
+    (alter db remove-tuple :room {:room-name room-name})))
+
 (defn add-nick-to-room! [nick room-name]
   (when-not (nick-in-room? nick room-name)
     (maybe-create-room! room-name)
     (alter db add-tuple :user-in-room {:user-nick nick :room-name room-name})))

 (defn remove-nick-from-room! [nick room-name]
-  (alter db remove-tuple :user-in-room {:user-nick nick :room-name room-name}))
+  (alter db remove-tuple :user-in-room {:user-nick nick :room-name room-name})
+  (maybe-delete-room! room-name))

 (defn topic-for-room [room-name]
   (:topic (room-for-name room-name)))


Update login to first login, then change view #13


plan plan

plan plan

--- statspop/src/statspop/math/stats.cljs
+++ statspop/src/statspop/math/stats.cljs
@@ -70,3 +70,5 @@
          distro-mean (:mean opts 0)
          distro-sd (:sd opts 1)]
      (z->p z-stat distro-mean distro-sd tail))))
+
+;; just need to add chi-square statistic + hypothesis test (and maybe f stuff) + maybe two-sample t and z then actually test these against known values --- devcards yo.


Using reduce to have ts closure capture.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -55,6 +55,11 @@
          (map (fn [[k v]] (dom/li nil (str k "=" v)))
               (get-in app [:snapshots ss-ts] nil))))

+(defn event-focus [snapshot-ts event-ts]
+  (println :event-focus snapshot-ts event-ts))
+(defn event-blur [snapshot-ts event-ts]
+  (println :event-blur snapshot-ts event-ts))
+
 (defn init-roots [app-state]
   (om/root
    (fn [app owner]
@@ -67,21 +72,25 @@
   (om/root
    (fn [app owner]
      (apply dom/ul nil
-            (loop [events (:events app)
-                   last-snapshot-ts nil
-                   acc []]
-              (if-let [[ts kind args] (first events)]
+            (second
+             (reduce
+              (fn [[last-snapshot-ts res] [ts kind args]]
                 (if (= kind :snapshot)
-                  (recur (rest events) ts
-                         (conj acc
-                               (dom/li nil
-                                       (str ts)
-                                       (render-snapshot app owner ts))))
-                  (recur (rest events) last-snapshot-ts
-                         (conj acc
-                               (dom/li nil
-                                       (str ts (pr-str args))))))
-                acc))))
+                  [ts
+                   (conj res
+                         (dom/li #js {:onMouseEnter #(event-focus ts nil)
+                                      :onMouseLeave #(event-blur ts nil)}
+                                 (str ts)
+                                 (render-snapshot app owner ts)))]
+                  [last-snapshot-ts
+                   (conj res
+                         (dom/li #js {:onMouseEnter
+                                      #(event-focus last-snapshot-ts ts)
+                                      :onMouseLeave
+                                      #(event-blur last-snapshot-ts ts)}
+                                 (str ts (pr-str args))))]))
+              [nil []]
+              (:events app)))))
    app-state
    {:target (. js/document (getElementById "events"))})


Compute initial-lane-state from initial-server-state.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -13,6 +13,11 @@
                        :users {"admin" {:pswd "password"}}}
             "_lobby" {:default-user "_anon"
                       :users {"_anon" {:pswd ""}}}}})
+
+(def initial-lane-state
+  (let [realm (:default-realm initial-server-state)]
+    {:realm realm
+     :user (get-in initial-server-state [:realms realm :default-user])}))

 (defn rq-authenticate [actx m]
   (act rq-authenticate actx
@@ -60,7 +65,7 @@

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

-(defn start-state-loop [actx name initial-state]
+(defn state-loop [actx name initial-state]
   (let [req-ch (achan actx)]
     (act-loop state-loop actx [name name state initial-state]
               (let [m (atake state-loop req-ch)]
@@ -79,14 +84,12 @@

 (defn kv-server [server-addr & ports]
   (let [world (:world (prog-base-now))
-        server-state-ch (start-state-loop world :server-state initial-server-state)
+        server-state-ch (state-loop world :server-state initial-server-state)
         lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)
-                          lane-state-ch (start-state-loop actx
-                                                          :lane-state {:realm "_lobby"
-                                                                       :user "_anon"})
+                          lane-state-ch (state-loop actx :lane-state initial-lane-state)
                           lane-state-cb (fn [is-req m lane-ext-state]
                                           (if is-req
                                             (if m


comments

comments

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -131,25 +131,29 @@
                                 [?thread :thread/id ?thread-id]]
                               (d/db *conn*)
                               (attrs :thread-id))
-        open-transactions (map (fn [user]
-                                 [:db/add user
-                                  :user/open-thread [:thread/id (attrs :thread-id)]])
-                               subscribed-users)
+        ; show thread for all users subscribed to thread
+        add-open-transactions (map (fn [user]
+                                     [:db/add user
+                                      :user/open-thread [:thread/id (attrs :thread-id)]])
+                                   subscribed-users)
+        ; upsert thread
         thread-data {:db/id (d/tempid :entities)
                      :thread/id (attrs :thread-id)}
+        ; upsert message
         msg-data {:db/id (d/tempid :entities)
                   :message/id (attrs :id)
                   :message/content (attrs :content)
                   :message/user [:user/id (attrs :user-id)]
                   :message/thread (:db/id thread-data)
                   :message/created-at (attrs :created-at)}
+        ; user who created message: show thread, subscribe to thread
         subscribe-data {:db/id [:user/id (attrs :user-id)]
                         :user/open-thread (thread-data :db/id)
                         :user/subscribed-thread (thread-data :db/id)}
         {:keys [db-after tempids]} @(d/transact *conn* (concat [thread-data
                                                                 msg-data
                                                                 subscribe-data]
-                                                               open-transactions))]
+                                                               add-open-transactions))]
     (->> (d/resolve-tempid db-after tempids (msg-data :db/id))
          (d/pull db-after '[:message/id
                             :message/content


scale down the handles when the circle is small

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -78,7 +78,13 @@
   (reify
     om/IRender
     (render [_]
-      (let [cast! (om/get-shared owner [:cast!])]
+      (let [cast! (om/get-shared owner [:cast!])
+            ;; easier than calcing width, b/c we can just multiply by 2
+            handle-offset (max 1
+                               (min 4
+                                    (int (/ (min (js/Math.abs (- (:layer/start-x layer) (:layer/end-x layer)))
+                                                 (js/Math.abs (- (:layer/start-y layer) (:layer/end-y layer))))
+                                            4))))]
         (apply dom/g #js {:className "edit-handles"}
                (for [[x y] (layers/endpoints layer)]
                  (dom/rect #js {:className (str "edit-handle "
@@ -88,10 +94,10 @@
                                                 (if (= y (max (:layer/start-y layer) (:layer/end-y layer)))
                                                   "bottom "
                                                   "top "))
-                                :x (- x 4)
-                                :y (- y 4)
-                                :width 8
-                                :height 8
+                                :x (- x handle-offset)
+                                :y (- y handle-offset)
+                                :width (* 2 handle-offset)
+                                :height (* 2 handle-offset)
                                 :onMouseDown #(do (.stopPropagation %)
                                                   (cast! :drawing-edited {:layer layer
                                                                           :x x


Hiding osx usage banner if plan doesn't have an osx portion to it.

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -330,6 +330,7 @@
            (when (and (feature/enabled? :ios-build-usage)
                       (= :build (:navigation-point app))
                       (project-model/feature-enabled? project :osx)
+                      (plan/osx? plan)
                       (plan/over-usage-threshold? plan plan/first-warning-threshold)
                       (plan/over-dismissed-level? plan (get-in app state/dismissed-osx-usage-level)))
              (om/build osx-usage-warning-banner plan))


Improve clearing of properties cursor.

Improve clearing of properties cursor.

--- src-cljs/kixi/hecuba/tabs/hierarchy.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy.cljs
@@ -149,7 +149,17 @@
                  properties)
         (log "Setting property details to: " properties)
         (om/update! data [:properties :selected] properties)
+        ;; Update datasets tab
+        (om/update! data [:properties :datasets :sensors] (data/fetch-sensors properties (:properties @data)))
+        (om/update! data [:properties :datasets :editable] (-> (filter #(= (:entity_id %) properties) (:data (:properties @data)))
+                                                               first
+                                                               :editable))
+        (data/fetch-datasets properties [:properties :datasets :datasets] data)
         (om/update! data [:properties :datasets :property-id] properties)
+        ;; Update upload and download statatus tab
+        (om/update! data [:properties :uploads :files] [])
+        (om/update! data [:properties :downloads :files] [])
+        ;; Update sensors tab
         (om/update! data [:properties :sensors :selected] #{})
         (om/update! data [:properties :sensors :alert] {})
         (om/update! data [:properties :chart :sensors] #{})


Changed interpretation of monks datasets inputs

--- src/clj/asols/data.clj
+++ src/clj/asols/data.clj
@@ -25,6 +25,14 @@
                  (entry [0 1] [0 1])]]
     (->Dataset entries entries 2 2)))

+(defn class-vec
+  [class-num classes-count]
+  {:pre [(> class-num 0)
+         (<= class-num classes-count)]}
+  (map
+    #(if (= % class-num) 1.0 0.0)
+    (range 1 (inc classes-count))))
+
 (defn parse-monks-dataset
   "
   All monks datasets has next attributes:
@@ -47,10 +55,16 @@
             (let [parsed-line (map #(Integer/parseInt %) (butlast line))
                   class-label (first parsed-line)
                   out-vec (if (zero? class-label) [1 0] [0 1])
-                  in-vec (rest parsed-line)]
+                  [a1 a2 a3 a4 a5 a6] (rest parsed-line)
+                  in-vec (vec (concat (class-vec a1 3)
+                                      (class-vec a2 3)
+                                      (class-vec a3 2)
+                                      (class-vec a4 3)
+                                      (class-vec a5 4)
+                                      (class-vec a6 2)))]
               (entry in-vec out-vec))))
         [train test] (map (comp vec read-file) [train-file test-file])]
-    (->Dataset train test 6 2)))
+    (->Dataset train test 17 2)))

 (def ^:private monks1
   "Problem:


new card implementations and fixes

new card implementations and fixes

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -572,6 +572,10 @@
                                     (+ c (count (filter (fn [ice] (and (has? ice :subtype "Code Gate")
                                                                       (:rezzed ice))) (:ices server)))))
                                   0 (flatten (seq (:servers corp))))))}
+
+   "Enhanced Vision"
+   {:events {:successful-run {:msg (msg "force the Corp to reveal " (:title (first (shuffle (:hand corp)))))
+                              :once :per-turn}}}

    "Eve Campaign"
    {:data {:counter 16}
@@ -677,6 +681,10 @@
    {:msg (msg "draw " (- (:max-hand-size runner) (count (:hand runner))) " cards")
     :effect (effect (draw (- (:max-hand-size runner) (count (:hand runner)))))}

+   "Genetic Resequencing"
+   {:choices {:req #(= (last (:zone %)) :scored)} :msg (msg "add 1 agenda counter on " (:title target))
+    :effect (effect (add-prop target :counter 1))}
+
    "Geothermal Fracking"
    {:data {:counter 2}
     :abilities [{:cost [:click 1] :counter-cost 1 :msg "gain 7 [Credits] and take 1 bad publicity"
@@ -896,7 +904,8 @@

    "Invasion of Privacy"
    {:trace {:base 2 :msg (msg "reveal the Runner's Grip")
-            :effect (req (doseq [c (:hand runner)] (move state side c :play-area false true)))
+            :effect (req (doseq [c (:hand runner)]
+                           (move state side c :play-area)))
             :unsuccessful {:msg "take 1 bad publicity" :effect (effect (gain :corp :bad-publicity 1))}}}

    "Isabel McGuire"


green

green

--- src/cloogling/core.clj
+++ src/cloogling/core.clj
@@ -4,13 +4,26 @@
 (defrecord entry [url title snippet])

+(defn create-entry
+  "create an entry record"
+  [x]
+  (try
+    (->entry (x "Url" ) (x "Title") (x "Description"))
+    (catch IllegalArgumentException e nil)
+    )
+  )
+
 (defn get-entries
   "Get results from json data retrieved from engine"
   [x]
-  (map (fn [x] (->entry (x "Url" ) (x "Title") (x "Description"))) (try
-                                                                     (-> x
-                                                                       json/read-str
-                                                                       (get-in ["d" "results"]))
-                                                                     (catch Exception e (empty nil))
-                                                                     )
-                                                                    ))
+  (remove nil? (map create-entry (try
+                                   (-> x
+                                       json/read-str
+                                       (get-in ["d" "results"]))
+                                   (catch Exception e (empty nil))
+                                   )
+                    ))
+  )
+
+
+


Use proper function for calculate the options position.

--- src/uxbox/ui/workspace/options.cljs
+++ src/uxbox/ui/workspace/options.cljs
@@ -45,7 +45,7 @@

 (defn- get-position
   [{:keys [page width] :as shape}]
-  (let [{:keys [x y]} (sh/resolve-position shape)
+  (let [{:keys [x y]} (sh/-outer-rect shape)
         vx (+ x width 50)
         vy (- y 50)]
     (viewportcoord->clientcoord page vx vy)))


Fixed wrong private method definition.

Fixed wrong private method definition.

--- core/src/main/clojure/stone/core.clj
+++ core/src/main/clojure/stone/core.clj
@@ -12,7 +12,7 @@

 (def ^:dynamic *default-granularity* 1)

-(defn -wrap-as-listener [fn]
+(defn- wrap-as-listener [fn]
   (reify Listener
     (onPublication [this previousTimestamp currentTimestamp value]
       (fn previousTimestamp currentTimestamp value))))
@@ -20,7 +20,7 @@
 (defn create-ts
   ([id listeners dispatcher] (create-ts id *default-granularity* listeners dispatcher))
   ([id granularity listeners dispatcher] (create-ts id granularity (Optional/absent) listeners dispatcher))
-  ([id granularity latestTimestamp listeners dispatcher] (TimeSeries. id granularity latestTimestamp (map -wrap-as-listener listeners) dispatcher)))
+  ([id granularity latestTimestamp listeners dispatcher] (TimeSeries. id granularity latestTimestamp (map wrap-as-listener listeners) dispatcher)))

 (defn beginning [^Reader reader]
   (.orNull (.beginning reader)))
@@ -40,23 +40,23 @@
 (defn during [^Reader reader before after]
   (lazy-pairs (.iterator (.during reader before after))))

-(defn -wrap-fn-as-consolidation-listener [fn]
+(defn- wrap-fn-as-consolidation-listener [fn]
   (reify ConsolidationListener
     (onConsolidation [this timestamp consolidates]
       (fn timestamp (vec consolidates)))))

-(defn -wrap-storage-as-consolidation-listener
-  ([storage] (-wrap-storage-as-consolidation-listener storage Loggers/BASE_LOGGER))
+(defn- wrap-storage-as-consolidation-listener
+  ([storage] (wrap-storage-as-consolidation-listener storage Loggers/BASE_LOGGER))
   ([storage logger] (Storages/asConsolidationListener storage logger)))

-(defn -wrap-as-consolidation-listener [x]
+(defn- wrap-as-consolidation-listener [x]
   (if (instance? Storage x)
-    (-wrap-storage-as-consolidation-listener x)
-    (-wrap-fn-as-consolidation-listener x)))
+    (wrap-storage-as-consolidation-listener x)
+    (wrap-fn-as-consolidation-listener x)))

 (defn window
   ([size consolidatorTypes] (window size consolidatorTypes '()))
-  ([size consolidatorTypes consolidationListeners] (Window. size consolidatorTypes (map -wrap-as-consolidation-listener consolidationListeners))))
+  ([size consolidatorTypes consolidationListeners] (Window. size consolidatorTypes (map wrap-as-consolidation-listener consolidationListeners))))

 (defn create-db
   [dispatcher storageFactory]


refactoring price tests

refactoring price tests

--- test-cljs/complico/test/prices.cljs
+++ test-cljs/complico/test/prices.cljs
@@ -2,9 +2,8 @@
   (:require-macros [cemerick.cljs.test
                     :refer (are is deftest with-test run-tests testing test-var)])
   (:use-macros
-   [dommy.macros :only [sel sel1]])
+   [dommy.macros :only [sel]])
   (:require
-   [dommy.core :as dommy]
    [complico.prices :as prices]
    [complico.dom-helper :as dom-helper]
    [hipo.interpreter :as hipo]
@@ -28,15 +27,6 @@
 (deftest find-prices-case-with-decimal
   (is (= (last (first (prices/find-prices "£300.00"))) "300.00")))

-(deftest correctly-finds-multiple-elems
-  (let [root-elem (hipo/create
-                [:body
-                  [:div
-                    [:ol]
-                    [:span]]])
-        found-elems (prices/find-elems root-elem)]
-    (is (= 2 (count found-elems)))))
-
 (defn create-test-dom [elem]
   (hipo/create [:body [elem]]))

@@ -44,17 +34,23 @@
   (are [elem] (-> elem (create-test-dom) (prices/find-elems) (count) (= 1))
    :div :span :li :a :p :em :td :strong))

+(defn dom-with-two-price-elems []
+  (hipo/create [:body [:div [:ol] [:span]]]))
+
+(deftest finds-multiple-allowed-price-elems
+  (is (= 2 (count (prices/find-elems (dom-with-two-price-elems))))))
+
 (defn confirm-text-was-set-to [actual-text expected-text]
   (is (= actual-text expected-text)))

 (defn confirm-text-remains [actual-text expected-text]
   (is (= actual-text expected-text)))

+(defn dom-with-price []
+  (hipo/create [:body [:div [:div "£0"]]]))
+
 (deftest replace-price-in-dom-should-correctly-replace-price
-  (let [root-elem (hipo/create
-          [:body
-            [:div
-              [:div "£0"]]])]
+  (let [root-elem (dom-with-price)]
     (prices/replace-prices-in-dom! root-elem)
     (-> root-elem
         (.-lastChild)


added a doubler test

added a doubler test

--- test/fogus/me/defcontract_tests.clj
+++ test/fogus/me/defcontract_tests.clj
@@ -12,5 +12,31 @@
 ;; remove this notice, or any other, from this software.

 (ns fogus.me.defcontract-tests
-  (:use [fogus.me.trammel :as ct]))
+  (:use [fogus.me.trammel :only [contract]])
+  (:use [clojure.test :only [deftest is]]))

+(def doubler-contract
+     (contract doubler
+       [x]
+       (requires
+         (pos? x))
+         (ensures
+          (= (* 2 x) %))
+       [x y]
+       (requires
+         (pos? x)
+         (pos? y))
+       (ensures
+         (= (* 2 (+ x y)) %))))
+
+(deftest doubler-test
+  (is (= 10 ((partial doubler-contract #(* 2 (+ %1 %2))) 2 3)))
+  (is (= 10 ((partial doubler-contract #(+ %1 %1 %2 %2)) 2 3)))
+  (is (= 10 ((partial doubler-contract #(* 2 %)) 5)))
+  (is (= 42
+         (try ((partial doubler-contract #(* 3 (+ %1 %2))) 2 3)
+              (catch Error e 42)))))
+
+(deftest contract-test
+  (doubler-test))
+


more cleanup

more cleanup

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -57,26 +57,27 @@
                                                    (set (:room-uploads-order new-state)))
         uploads (:uploads new-state)
         room-uploads-order (:room-uploads-order new-state)
+        upload-slots (:upload-slots new-state)
         active-uploads (active-uploads room-uploads-order uploads)
         inactive-uploads (inactive-uploads room-uploads-order uploads)
         unpaused-inactive-uploads (vec (remove #(:paused (uploads %)) inactive-uploads))]
     (cond
       (and (not (empty? new-upload-ids))
-           (< (count room-uploads-order) (:upload-slots new-state)))
+           (< (count room-uploads-order) upload-slots))
         (assoc new-state
                :uploads
                (assoc (:uploads new-state)
                       (first new-upload-ids)
-                      (start ((:uploads new-state) (first new-upload-ids)))))
+                      (start (uploads (first new-upload-ids)))))
       (and (and (not (empty? removed-upload-ids))
                 (not (empty? unpaused-inactive-uploads)))
            (< (count active-uploads)
-              (:upload-slots new-state)))
+              upload-slots))
         (assoc new-state
                :uploads
-               (assoc (:uploads new-state)
+               (assoc uploads
                       (first unpaused-inactive-uploads)
-                      (start ((:uploads new-state) (first unpaused-inactive-uploads)))))
+                      (start (uploads (first unpaused-inactive-uploads)))))
       :else new-state)))

 (defn upload-file! []


Split teams' standings tests

Split teams' standings tests

We'll need more tests for different "points from playoff spot" scenarios,
separating the tests will make it easier.

--- test/nhl_score_api/fetchers/nhlstats/game_scores_test.clj
+++ test/nhl_score_api/fetchers/nhlstats/game_scores_test.clj
@@ -2,7 +2,8 @@
   (:require [clojure.test :refer :all]
             [nhl-score-api.fetchers.nhlstats.game-scores :refer :all]
             [nhl-score-api.fetchers.nhlstats.latest-games :refer [filter-latest-games]]
-            [nhl-score-api.fetchers.nhlstats.resources :as resources]))
+            [nhl-score-api.fetchers.nhlstats.resources :as resources]
+            [nhl-score-api.utils :refer [fmap]]))

 (deftest game-score-json-parsing

@@ -254,24 +255,49 @@
               {"NYI" {:type "OT" :count 1} "VAN" {:type "OT" :count 1}}]
              streaks) "Parsed streaks")))

-  (testing "Parsing teams' standings"
-    (let [games (:games
-                  (parse-game-scores
-                    (filter-latest-games resources/games-finished-in-regulation-overtime-and-shootout)
-                    (:records resources/standings)))
-          standings (map #(:standings (:current-stats %)) games)]
-      (is (= 9
-             (count standings)) "Parsed standings count")
-      (is (= [{"CAR" {:league-rank "13" :points-from-playoff-spot "-1"} "NJD" {:league-rank "28" :points-from-playoff-spot "-15"}}
-              {"CGY" {:league-rank "2" :points-from-playoff-spot "+20"} "BOS" {:league-rank "4" :points-from-playoff-spot "+10"}}
-              {"PIT" {:league-rank "12" :points-from-playoff-spot "+1"} "WSH" {:league-rank "9" :points-from-playoff-spot "+5"}}
-              {"STL" {:league-rank "14" :points-from-playoff-spot "+6"} "OTT" {:league-rank "31" :points-from-playoff-spot "-22"}}
-              {"EDM" {:league-rank "27" :points-from-playoff-spot "-8"} "BUF" {:league-rank "17" :points-from-playoff-spot "-7"}}
-              {"FLA" {:league-rank "23" :points-from-playoff-spot "-11"} "WPG" {:league-rank "5" :points-from-playoff-spot "+15"}}
-              {"COL" {:league-rank "19" :points-from-playoff-spot "-1"} "MIN" {:league-rank "18" :points-from-playoff-spot "+1"}}
-              {"DAL" {:league-rank "16" :points-from-playoff-spot "+2"} "NSH" {:league-rank "7" :points-from-playoff-spot "+14"}}
-              {"NYI" {:league-rank "6" :points-from-playoff-spot "+7"} "VAN" {:league-rank "25" :points-from-playoff-spot "-4"}}]
-             standings) "Parsed standings")))
+  (testing "Parsing teams' league ranks"
+    (let [games (:games
+                  (parse-game-scores
+                    (filter-latest-games resources/games-finished-in-regulation-overtime-and-shootout)
+                    (:records resources/standings)))
+          standings (map #(:standings (:current-stats %)) games)
+          league-ranks (map
+                         #(fmap (fn [team-stats] (select-keys team-stats [:league-rank])) %)
+                         standings)]
+      (is (= 9
+             (count league-ranks)) "Parsed league ranks count")
+      (is (= [{"CAR" {:league-rank "13"} "NJD" {:league-rank "28"}}
+              {"CGY" {:league-rank "2"} "BOS" {:league-rank "4"}}
+              {"PIT" {:league-rank "12"} "WSH" {:league-rank "9"}}
+              {"STL" {:league-rank "14"} "OTT" {:league-rank "31"}}
+              {"EDM" {:league-rank "27"} "BUF" {:league-rank "17"}}
+              {"FLA" {:league-rank "23"} "WPG" {:league-rank "5"}}
+              {"COL" {:league-rank "19"} "MIN" {:league-rank "18"}}
+              {"DAL" {:league-rank "16"} "NSH" {:league-rank "7"}}
+              {"NYI" {:league-rank "6"} "VAN" {:league-rank "25"}}]
+             league-ranks) "Parsed league ranks")))
+
+  (testing "Parsing teams' points from playoff spot"
+    (let [games (:games
+                  (parse-game-scores
+                    (filter-latest-games resources/games-finished-in-regulation-overtime-and-shootout)
+                    (:records resources/standings)))
+          standings (map #(:standings (:current-stats %)) games)
+          points-from-playoff-spot (map
+                                     #(fmap (fn [team-stats] (select-keys team-stats [:points-from-playoff-spot])) %)
+                                     standings)]
+      (is (= 9
+             (count points-from-playoff-spot)) "Parsed points from playoff spot count")
+      (is (= [{"CAR" {:points-from-playoff-spot "-1"} "NJD" {:points-from-playoff-spot "-15"}}
+              {"CGY" {:points-from-playoff-spot "+20"} "BOS" {:points-from-playoff-spot "+10"}}
+              {"PIT" {:points-from-playoff-spot "+1"} "WSH" {:points-from-playoff-spot "+5"}}
+              {"STL" {:points-from-playoff-spot "+6"} "OTT" {:points-from-playoff-spot "-22"}}
+              {"EDM" {:points-from-playoff-spot "-8"} "BUF" {:points-from-playoff-spot "-7"}}
+              {"FLA" {:points-from-playoff-spot "-11"} "WPG" {:points-from-playoff-spot "+15"}}
+              {"COL" {:points-from-playoff-spot "-1"} "MIN" {:points-from-playoff-spot "+1"}}
+              {"DAL" {:points-from-playoff-spot "+2"} "NSH" {:points-from-playoff-spot "+14"}}
+              {"NYI" {:points-from-playoff-spot "+7"} "VAN" {:points-from-playoff-spot "-4"}}]
+             points-from-playoff-spot) "Parsed points from playoff spot")))

   (testing "Parsing teams' pre-game playoff records"
     (let [games (:games


Distinguish integer and floating-point values

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -28,9 +28,9 @@
       (.push arr o))
     arr))

-(defn spacer [& x] " ")
+(defn spacer [& _] " ")

-(defn nil-template [v]
+(defn nil-template [_]
   (template "span" "color: #808080" "nil"))

 (defn keyword-template [v]
@@ -39,8 +39,10 @@
 (defn symbol-template [v]
   (template "span" "color: #881391" (str v)))

-(defn integer-template [v]
-  (template "span" "color: #1C00CF" v))
+(defn number-template [v]
+  (if (integer? v)
+    (template "span" "color: #1C00CF" v)
+    (template "span" "color: #1C88CF" v)))

 (defn fn-template [v]
   (template "span" "color: #f00" (reference v) "fn"))
@@ -88,7 +90,7 @@
   (cond
     (nil? x) (nil-template x)
     (string? x) (string-template x)
-    (integer? x) (integer-template x)
+    (number? x) (number-template x)
     (keyword? x) (keyword-template x)
     (symbol? x) (symbol-template x)
     (fn? x) (fn-template x)
@@ -111,7 +113,7 @@
       (pr-str x)))

 (defn build-header [value]
-  (template "span" "background-color: #eff" (header-template value)))
+  (template "span" "background-color: #efe" (header-template value)))

 (defn header-hook [value]
   (if (cljs-value? value)


Fix clipboard

Fix clipboard

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -259,7 +259,7 @@
                (when (get-in data [:layout :add?])
                  (om/build add-element {}))
                (om/build nav/main data)
-               (om/build clipboard/view {})))))
+               (om/build clipboard/view data)))))

 (defn main-view [data]
   (reify om/IRender


Prettier html

Prettier html

--- src/varjocafe/view.clj
+++ src/varjocafe/view.clj
@@ -9,29 +9,35 @@

 (html/defsnippet date-cell "templates/layout.html" [:.date]
                  [date]
-                 [:.date] (html/content (.print date-format date)))
+                 [:.date] (html/content (.print date-format date))
+                 [:.date] (html/after "\n        "))

 (html/defsnippet food-line "templates/layout.html" [:.food]
                  [food]
-                 [:.food] (html/content (:name food)))
+                 [:.food] (html/content (:name food))
+                 [:.food] (html/after "\n            "))

 (html/defsnippet menu-cell "templates/layout.html" [:.menu]
                  [restaurant date]
                  [:.food] (html/clone-for [food (get-in restaurant [:menu date :data])]
-                                          (html/substitute (food-line food))))
+                                          (html/substitute (food-line food)))
+                 [:.menu] (html/after "\n        "))

 (html/defsnippet restaurant-row "templates/layout.html" [:.restaurant-row]
                  [restaurant dates]
                  [:.restaurant-name] (html/content (:name restaurant))
                  [:.menu] (html/clone-for [date dates]
-                                          (html/substitute (menu-cell restaurant date))))
+                                          (html/substitute (menu-cell restaurant date)))
+                 [:.restaurant-row] (html/after "\n"))

 (html/defsnippet area-restaurants "templates/layout.html" [#{:.area-row :.restaurant-row}]
                  [area dates]
                  [:.area-name] (html/set-attr :colspan (+ 1 (count dates)))
                  [:.area-name] (html/content (:name area))
                  [:.restaurant-row] (html/clone-for [restaurant (:restaurants area)]
-                                                    (html/substitute (restaurant-row restaurant dates))))
+                                                    (html/substitute (restaurant-row restaurant dates)))
+                 [:.restaurant-row] (html/before "\n    ")
+                 [:.area-row] (html/before "\n    "))

 (html/deftemplate layout "templates/layout.html"
                   [{:keys [dates areadata]}]


clearing require

clearing require

--- src/vc/validations.clj
+++ src/vc/validations.clj
@@ -13,9 +13,7 @@
   (:use
     [vc.vijava :only (disk-format-types)]
     [clojure.core.strint :only (<<)]
-    [subs.core :only (validate! combine validation when-not-nil)])
-  (:require
-    [celestial.validations :as cv]))
+    [subs.core :only (validate! combine validation when-not-nil)]))

 ; only when ip exists
 (def machine-networking


Problem 2

Problem 2

--- src/euler/euler001.clj
+++ src/euler/euler001.clj
@@ -53,28 +53,25 @@
   [b (+ a b)])

 (def fibs
-  "Lazy sequence of all Fibonacci numbers."
+  "**(Int)**
+  Lazy sequence of all Fibonacci numbers.
+  Using BigIntegers to prevent integer overflow"
   (map first (iterate fib-next [1 1])))

 (defn fib-nth
   "**Int -> Int**
-  Computes the nth element in the Fibonacci sequence."      ; overloaded function
-  ([n] (last (take n fibs)))                                       ; with one parameter
-
-  ([n p0 p1]                                                ; with three parameters
-   (if (= n 1N)
-     p1
-     (fib-nth (dec n) p1 (+ p0 p1)))))
+  Computes the nth element in the Fibonacci sequence."
+  ([n] (last (take n fibs))))

 (defn p002
   "**Int -> Int**
   Retrieve the sum of all even Fibonacci numbers up to n."
-  ([] (p002 4000000))                                   ; fun fact: the highest is already fib (33) = 3.524.578
-  ([n] (reduce +
-          (for [num (range 1N (inc n))
-                :let [fib-num (fib-nth num)]
-                :while (< fib-num n)
-                :when (even? fib-num)] fib-num))))
+  ([] (p002 (* 4 1000 1000)))                                   ; fun fact: the highest is already fib (33) = 3.524.578
+  ([n]
+    (->> fibs
+      (take-while #(< % n))
+      (filter even?)
+      (reduce +))))

 ; Lazy implementation
 (defn fib-lazy
@@ -85,7 +82,7 @@

 (defn p002-lazy [n]
   (->>
-   (fib-lazy)
+   fibs
    (take-while #(< % n))
    (filter even?)
    (reduce +)))


Namespace keywords

Namespace keywords

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -353,7 +353,7 @@
    (value-str type spec-name form in problems opts)
    expected))

-(defmethod expected-str :problem/value-group [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/value-group [_type spec-name val path problems opts]
   (let [problem (first problems)
         subproblems (:problems problem)
         grouped-subproblems (vals (group-by :expound.spec.problem/type subproblems))]
@@ -362,7 +362,7 @@
      (map #(expected-str2 % opts) grouped-subproblems))))

 ;; TODO - namespace to expound
-(defmethod value-str :problem/value-group [type spec-name val path problems opts]
+(defmethod value-str :expound.problem/value-group [type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)
         subproblems (:problems problem)
@@ -371,13 +371,13 @@

 (defn ^:private header [type]
   (case type
-    :problem/missing-spec
+    :expound.problem/missing-spec
     "Missing spec"

     "Spec failed"))

 ;; TODO - try a few different names here
-(defmethod problem-group-str :problem/value-group [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/value-group [type spec-name val path problems opts]
   ;; TODO - assert singleton
   (let [problem (first problems)
         subproblems (:problems problem)
@@ -405,7 +405,7 @@
      [problem]
      opts)))

-(defmethod expected-str :problem/alt-group [type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/alt-group [type spec-name val path problems opts]
   (let [subproblems (:problems (first problems))]
     (string/join
      "\n\nor value\n\n"
@@ -416,17 +416,17 @@
           (value-str type spec-name form in [problem] opts)
           (expected-str2 [problem] opts)))))))

-(defmethod problem-group-str :problem/alt-group [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/alt-group [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (printer/format
    "%s\n\n%s"
    (header-label "Spec failed")
    (expected-str _type spec-name val path problems opts)))

-(defmethod expected-str :problem/missing-key [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/missing-key [_type spec-name val path problems opts]
   (explain-missing-keys problems))

-(defmethod problem-group-str :problem/missing-key [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/missing-key [type spec-name val path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err "Spec failed"
               type
@@ -437,7 +437,7 @@
               opts
               (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/not-in-set [_type _spec-name _val _path problems _opts]
+(defmethod expected-str :expound.problem/not-in-set [_type _spec-name _val _path problems _opts]
   (let [combined-set (apply set/union (map :pred problems))]
     (printer/format
      "should be%s: %s"
@@ -449,7 +449,7 @@
                       (string/join ", "))
                  :good))))

-(defmethod problem-group-str :problem/not-in-set [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/not-in-set [type spec-name val path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err "Spec failed"
               type
@@ -460,20 +460,20 @@
               opts
               (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/missing-spec [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/missing-spec [_type spec-name val path problems opts]
   (str "with\n\n"
        (->> problems
             (map #(no-method spec-name val path %))
             (string/join "\n\nor with\n\n"))))

-(defmethod value-str :problem/missing-spec [_type spec-name val path problems opts]
+(defmethod value-str :expound.problem/missing-spec [_type spec-name val path problems opts]
   (printer/format
    "Cannot find spec for

  %s"
    (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))))

-(defmethod problem-group-str :problem/missing-spec [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/missing-spec [type spec-name val path problems opts]
   (printer/format
    "%s\n\n%s\n\n%s"
    (header-label "Missing spec")
@@ -498,38 +498,37 @@
     (:expound.spec.problem/type problem)

     (insufficient-input? failure problem)
-    ;; FIXME - make this namespaced to expound
-    :problem/insufficient-input
+    :expound.problem/insufficient-input

     (extra-input? failure problem)
-    :problem/extra-input
+    :expound.problem/extra-input

     (not-in-set? failure problem)
-    :problem/not-in-set
+    :expound.problem/not-in-set

     (missing-key? failure problem)
-    :problem/missing-key
+    :expound.problem/missing-key

     (missing-spec? failure problem)
-    :problem/missing-spec
+    :expound.problem/missing-spec

     (fspec-exception-failure? failure problem)
-    :problem/fspec-exception-failure
+    :expound.problem/fspec-exception-failure

     (fspec-ret-failure? failure problem)
-    :problem/fspec-ret-failure
+    :expound.problem/fspec-ret-failure

     (fspec-fn-failure? failure problem)
-    :problem/fspec-fn-failure
+    :expound.problem/fspec-fn-failure

     (check-ret-failure? failure problem)
-    :problem/check-ret-failure
+    :expound.problem/check-ret-failure

     (check-fn-failure? failure problem)
-    :problem/check-fn-failure
+    :expound.problem/check-fn-failure

     :else
-    :problem/unknown))
+    :expound.problem/unknown))

 ;;; TODO clean up
 (defn ^:private lcs [[x & xs] [y & ys]]
@@ -551,25 +550,25 @@
     (if (and
          (not (empty? prefix))
          (some? prefix)
-         (if (= :problem/alt-group (:expound.spec.problem/type grp1))
+         (if (= :expound.problem/alt-group (:expound.spec.problem/type grp1))
            true
            (not= prefix xs))
-         (if (= :problem/alt-group (:expound.spec.problem/type grp2))
+         (if (= :expound.problem/alt-group (:expound.spec.problem/type grp2))
            true
            (not= prefix ys)))
       grp1
       nil)))

 (defn ^:private alt-group [grp1 grp2]
-  {:expound.spec.problem/type :problem/alt-group
-   :path-prefix (lcs1 (:path-prefix grp1)
+  {:expound.spec.problem/type :expound.problem/alt-group
+   :path-prefix               (lcs1 (:path-prefix grp1)
                       (:path-prefix grp2))
-   :problems (into
-              (if (= :problem/alt-group (:expound.spec.problem/type grp1))
+   :problems                  (into
+              (if (= :expound.problem/alt-group (:expound.spec.problem/type grp1))
                 (:problems grp1)
                 [grp1])

-              (if (= :problem/alt-group (:expound.spec.problem/type grp2))
+              (if (= :expound.problem/alt-group (:expound.spec.problem/type grp2))
                 (:problems grp2)
                 [grp2]))})

@@ -577,8 +576,8 @@
   (walk/postwalk
    (fn [form]
      (if (and (map? form)
-              (contains? #{:problem/alt-group
-                           :problem/value-group} (:expound.spec.problem/type form))
+              (contains? #{:expound.problem/alt-group
+                           :expound.problem/value-group} (:expound.spec.problem/type form))
               (= 1 (count (:problems form))))
        (first (:problems form))
        form))
@@ -594,11 +593,11 @@
                                 vals
                                 (map (fn [grp]
                                        (if (= 1 (count grp))
-                                         {:expound.spec.problem/type :problem/value-group
+                                         {:expound.spec.problem/type :expound.problem/value-group

                                           :path-prefix               (:expound/path (first grp))
                                           :problems                  grp}
-                                         {:expound.spec.problem/type :problem/value-group
+                                         {:expound.spec.problem/type :expound.problem/value-group
                                           :path-prefix               (apply lcs1 (map :expound/path grp))
                                           :problems                  grp}))))]
     (->> grouped-by-in-path
@@ -617,7 +616,7 @@

 (declare annotate-1*) ;; TODO - remove

-(defmethod expected-str :problem/insufficient-input [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/insufficient-input [_type spec-name val path problems opts]
   (let [problem (first problems)]
     (printer/format
      "should have additional elements. The next element%s %s"
@@ -634,7 +633,7 @@
                     (let [in (-> prob :expound/in)]
                       (expected-str (-> prob :expound.spec.problem/type) :expound/no-spec-name non-matching-value in [prob] opts))))))))

-(defmethod problem-group-str :problem/insufficient-input [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/insufficient-input [type spec-name val path problems opts]
   (format-err "Syntax error"
               type
               spec-name
@@ -644,11 +643,11 @@
               opts
               (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/extra-input [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/extra-input [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   "has extra input")

-(defmethod problem-group-str :problem/extra-input [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/extra-input [type spec-name val path problems opts]
   (format-err "Syntax error"
               type
               spec-name
@@ -658,7 +657,7 @@
               opts
               (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/fspec-exception-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -672,7 +671,7 @@
      (printer/indent (pr-str (:reason problem)))
      (printer/indent (string/join ", " (:val problem))))))

-(defmethod problem-group-str :problem/fspec-exception-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-exception-failure [type spec-name val path problems opts]
   (format-err
    "Exception"
    type
@@ -683,7 +682,7 @@
    opts
    (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/fspec-ret-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -691,7 +690,7 @@
      (ansi/color (printer/indent (pr-str (:val problem))) :bad-value)
      (predicate-errors problems))))

-(defmethod problem-group-str :problem/fspec-ret-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-ret-failure [type spec-name val path problems opts]
   (format-err
    "Function spec failed"
    type
@@ -702,7 +701,7 @@
    opts
    (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/fspec-fn-failure [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/fspec-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -716,7 +715,7 @@
      (printer/indent (ansi/color (pr-str (:val problem)) :bad-value))
      (printer/indent (ansi/color (pr-pred (:pred problem) (:spec problem)) :good-pred)))))

-(defmethod problem-group-str :problem/fspec-fn-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-fn-failure [type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (format-err
    "Function spec failed"
@@ -728,7 +727,7 @@
    opts
    (expected-str type spec-name val path problems opts)))

-(defmethod expected-str :problem/check-fn-failure [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/check-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -742,7 +741,7 @@
      (printer/indent (ansi/color (pr-str (:val problem)) :bad-value))
      (printer/indent (ansi/color (pr-pred (:pred problem) (:spec problem)) :good-pred)))))

-(defmethod problem-group-str :problem/check-fn-failure [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/check-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (printer/format
    format-str
@@ -750,10 +749,10 @@
    (ansi/color (printer/indent (pr-str (:expound/check-fn-call (first problems)))) :bad-value)
    (expected-str _type spec-name val path problems opts)))

-(defmethod expected-str :problem/check-ret-failure [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/check-ret-failure [_type spec-name val path problems opts]
   (predicate-errors problems))

-(defmethod problem-group-str :problem/check-ret-failure [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/check-ret-failure [_type spec-name val path problems opts]
   (printer/format
    "%s

@@ -771,10 +770,10 @@
    (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
    (expected-str _type spec-name val path problems opts)))

-(defmethod expected-str :problem/unknown [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/unknown [_type spec-name val path problems opts]
   (predicate-errors problems))

-(defmethod problem-group-str :problem/unknown [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/unknown [type spec-name val path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err
    "Spec failed"


Fix React glicth due to DOM manipulation

--- src/front/ui/main.cljs
+++ src/front/ui/main.cljs
@@ -176,26 +176,27 @@

 (defn- render-to-dos
   [t p]
+  (let [project (state/get-project-by-id (:id p))
+        tasks   (filter #(not (:done %))
+                        (:tasks project))]
     (reagent/create-class
      {:component-did-mount (fn []
                              (-> ($ ".tasks.todos")
                                  (.sortable (clj->js {:items "> li"
                                                       :handle ".handle"
                                                       :update (fn [event ui]
-                                                                (js/setTimeout #(update-tasks-order (state/get-project-by-id (:id p))
-                                                                                (.-item ui))
-                                                                               1000))}))
+                                                                (update-tasks-order project
+                                                                                (.-item ui))
+                                                                (-> ($ ".tasks.todos")
+                                                                    (.sortable "cancel")))}))
                                  (.disableSelection)))
       :reagent-render (fn [tasks]
-                        (let [project (state/get-project-by-id (:id p))
-                              tasks   (filter #(not (:done %))
-                                              (:tasks project))]
-                          [:div
-                           [:ul.tasks.todos
-                            (doall (for [task tasks]
-                                     ^{:key (:id task)}
-                                     [render-todo
-                                      task]))]]))}))
+                        [:div
+                         [:ul.tasks.todos
+                          (doall (for [task tasks]
+                                   ^{:key (:id task)}
+                                   [render-todo
+                                    task]))]])})))

 (defn render-done
   [task]


formatted things better

formatted things better

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -197,4 +197,5 @@
 (.on socket "hotjoin-music-info"
   (fn [room-music-info]
     (swap! app-state assoc :music-info (.sort room-music-info
-                                              #(- (.-tracknum %1) (.-tracknum %2))))))
+                                              #(- (.-tracknum %1)
+                                                  (.-tracknum %2))))))


Added proper CLI implementation; discarding qualified versions unless desired.

--- src/leiningen/ancient.clj
+++ src/leiningen/ancient.clj
@@ -2,7 +2,8 @@
       :author "Yannick Scherer"}
   leiningen.ancient
   (:require [leiningen.core.project :as project :only [defaults]]
-            [clojure.data.xml :as xml :only [parse-str]]))
+            [clojure.data.xml :as xml :only [parse-str]]
+            [clojure.tools.cli :as cli :only [cli]]))

 ;; ## Utility Functions

@@ -103,15 +104,24 @@
   [v]
   (= (:qualifier v) "snapshot"))

+(defn- filter-versions
+  "Remove all versions that do not fit the given settings map."
+  [{:keys [allow-snapshots allow-qualified]} version-maps]
+  (let [v version-maps
+        v (if-not allow-snapshots (filter (complement snapshot?) v) v)
+        v (if-not allow-qualified (filter (comp nil? :qualifier) v) v)]
+    v))
+
 (defn latest-version
   "Get map of the latest available version in the given metadata XML
    string."
-  [mta]
-  (->> (version-seq mta)
-    (map version-map)
-    (filter (complement snapshot?))
-    (sort version-map-compare)
-    (last)))
+  ([mta] (latest-version mta nil))
+  ([mta settings]
+   (->> (version-seq mta)
+     (map version-map)
+     (filter-versions settings)
+     (sort version-map-compare)
+     (last))))

 ;; ## Project Map Inspection

@@ -141,12 +151,12 @@
 (defn- check-packages
   "Check the packages found at the given key in the project map.
    Will check the given repository urls for metadata."
-  [repos packages]
+  [repos packages settings]
   (let [retrieve! (partial retrieve-metadata! repos)]
     (doseq [{:keys [group-id artifact-id version] :as dep}
             (map dependency-map packages)]
       (when-let [mta (retrieve! group-id artifact-id)]
-        (when-let [latest (latest-version mta)]
+        (when-let [latest (latest-version mta settings)]
           (when (version-outdated? version latest)
             (println
               (str "[" (:dependency-str dep) " \"" (:version-str latest) "\"]")
@@ -155,16 +165,38 @@

 ;; ## CLI

-(def ^:private KEYS
-  "Mapping of command-line parameter to project map key
-   containing package vectors."
-  {":dependencies" [:dependencies]
-   ":plugins" [:plugins]
-   ":all" [:dependencies :plugins]})
+(defn parse-cli
+  "Parse Command Line, return map of Settings."
+  [args]
+  (let [data (first
+               (cli/cli
+                 (map #(.replace ^String % ":" "--") args)
+                 ["--dependencies" :flag true :default false]
+                 ["--all" :flag true :default false]
+                 ["--plugins" :flag true :default false]
+                 ["--allow-snapshots" :flag true :default false]
+                 ["--allow-qualified" :flag true :default false]
+                 ["--[no-]profiles" :flag true :default true]))]
+    (cond (:all data) (assoc data :dependencies true :plugins true :profiles true)
+          (:plugins data) data
+          :else (assoc data :dependencies true))))
+
+(defn collect-dependencies
+  "Take settings map created by `parse-cli` and create seq of dependency vectors."
+  [project settings]
+  (distinct
+    (concat
+      (when (:dependencies settings) (:dependencies project))
+      (when (:plugins settings) (:plugins project))
+      (when (:profiles settings)
+        (concat
+          (when (:dependencies settings) (mapcat :dependencies (vals (:profiles project))))
+          (when (:plugins settings) (mapcat :plugins (vals (:profiles project)))))))))

 (defn ^:no-project-needed ancient
   "Check your Projects for outdated Dependencies."
   [project & args]
-  (let [repos (get-repository-urls project)]
-    (doseq [k (distinct (mapcat KEYS (or (seq args) [":dependencies"])))]
-      (check-packages repos (get project k)))))
+  (let [settings (parse-cli args)
+        repos (get-repository-urls project)
+        deps (collect-dependencies project settings)]
+    (check-packages repos deps settings)))


Support uberjar out of non-default directories. Fixes #60.

--- src/leiningen/uberjar.clj
+++ src/leiningen/uberjar.clj
@@ -4,7 +4,7 @@
   (:use [clojure.zip :only [xml-zip]]
         [clojure.java.io :only [file copy]]
         [clojure.contrib.zip-filter.xml :only [xml-> tag=]]
-        [leiningen.jar :only [jar]])
+        [leiningen.jar :only [get-jar-filename jar]])
   (:import [java.util.zip ZipFile ZipOutputStream ZipEntry]
            [java.io File FileOutputStream PrintWriter]))

@@ -42,13 +42,15 @@
 the dependency jars. Suitable for standalone distribution."
   [project]
   (jar project)
-  (let [jarname-root  (str (:name project) \- (:version project))
-        standalone-filename (str jarname-root "-standalone.jar")]
-    (with-open [out (-> (file (:root project) standalone-filename)
+  (let [jarname-base  (str (:name project) \- (:version project))
+        standalone-base (str jarname-base "-standalone.jar")
+        standalone-filename (get-jar-filename project standalone-base)]
+    (with-open [out (-> (file standalone-filename)
                         (FileOutputStream.) (ZipOutputStream.))]
       (let [deps (->> (.listFiles (file (:library-path project)))
                       (filter #(.endsWith (.getName %) ".jar"))
-                      (cons (file (:root project) (str jarname-root ".jar"))))
+                      (cons (file (get-jar-filename
+                                   project (str jarname-base ".jar")))))
             [_ components] (reduce (partial include-dep out)
                                    [#{"META-INF/plexus/components.xml"} nil]
                                    deps)]
@@ -62,4 +64,4 @@
                          components}]})
             (.flush *out*))
           (.closeEntry out))))
-    (println "Created" (str jarname-root "-standalone.jar"))))
+    (println "Created" standalone-filename)))


simplified design spike by eliminating DSL wrapper object

--- test/push/design_spikes/dsl_macros.clj
+++ test/push/design_spikes/dsl_macros.clj
@@ -15,6 +15,7 @@
 ;;
 ; - `count-of [stackname :as local]`
 ;    store the number of items in `stackname` under key `local`
+;    raise an Exception if the stack doesn't exist
 ; - `consume [stackname]`
 ;    pop an item (and discard it) from `stackname`
 ;    raise an Exception if it's empty or undefined
@@ -45,6 +46,8 @@
 ; - `replace-stack [stackname new-stack]`
 ;    replace the indicated stack with a new list
 ;    raise an exception if it's undefined
+; - `calculate [fn :as local]
+;    save the result of `fn` under key `local`

 ;; And I THINK that supports all defined Push instructions I've ever seen....

@@ -61,52 +64,87 @@
   ([interpreter locals] (->PushDslState interpreter locals)))

+(defn store-local
+  "adds a local kv pair to an Interpreter's :local map"
+  [interpreter k v]
+  (if (nil? (:locals interpreter))
+    (assoc interpreter :locals {k v})
+    (assoc-in interpreter [:locals k] v)))
+
+
+(fact "store-local creates a :locals store if needed"
+  (:locals (make-interpreter)) => nil
+  (:locals (store-local (make-interpreter) :foo 8)) => {:foo 8})
+
+
+(fact "store-local amends an existing :locals store"
+  (let [foo (store-local (make-interpreter) :foo 8)]
+  (:locals (store-local foo :bar 9)) => {:foo 8, :bar 9}))
+
+
+(fact "store-local can overwrite an existing :locals value"
+  (let [foo (store-local (make-interpreter) :foo 8)]
+  (:locals (store-local foo :foo 999)) => {:foo 999}))
+
+
+(defn clear-locals
+  "deletes the :locals key from an Interpreter"
+  [interpreter]
+  (dissoc interpreter :locals))
+
+
+(fact "clear-locals returns a thing that's still an Interpreter"
+  (class (clear-locals (make-interpreter))) => push.interpreter.Interpreter
+  (let [foo (store-local (make-interpreter) :foo 8)]
+    (class (clear-locals foo)) => push.interpreter.Interpreter))
+
+
+(fact "clear-locals also does what it's supposed to do"
+  (let [foo (store-local (make-interpreter) :foo 8)]
+    (:locals (clear-locals foo)) => nil))
+
+
 (defn consume
-  [dslstep stack & {:keys [as]}]
-  (let [interpreter (:interpreter dslstep)
-        old-stack (get-stack interpreter stack)
-        old-locals (:locals dslstep)]
+  [interpreter stack & {:keys [as]}]
+  (let [old-stack (get-stack interpreter stack)]
     (if (empty? old-stack)
       (throw (Exception. (str "Push DSL Error: " stack " is empty")))
-      (make-PushDslState
+      (store-local
         (set-stack interpreter stack (pop old-stack))
-        (assoc old-locals as (first old-stack)))
-    )))
+          as
+          (first old-stack)))
+      ))

-(def sixier (make-PushDslState six-ints))
-
-
-(fact "consume returns a new PushDslState with a changed :interpreter and new locals"
-  (:locals (consume sixier :integer :as :int1)) => {:int1 6}
-  (get-stack (:interpreter (consume sixier :integer :as :int1)) :integer) => '(5 4 3 2 1))
+(fact "consume returns an :interpreter with new locals"
+  (:locals (consume six-ints :integer :as :int1)) => {:int1 6}
+  (get-stack (consume six-ints :integer :as :int1) :integer) => '(5 4 3 2 1))

 (fact "consume throws an exception if the stack is empty"
-  (:locals (consume sixier :boolean :as :nope)) => (throws #"Push DSL Error:"))
+  (:locals (consume six-ints :boolean :as :nope)) => (throws #"Push DSL Error:"))

 (fact "consume can be thread-firsted"
-  (let [two-popped (->  sixier
+  (let [two-popped (->  six-ints
                         (consume :integer :as :int1)
                         (consume :integer :as :int2))]
     (:locals two-popped) => {:int1 6, :int2 5}
-    (get-stack (:interpreter two-popped) :integer) => '(4 3 2 1)))
+    (get-stack two-popped :integer) => '(4 3 2 1)))

 (defn place
-  [dslstep stack args function]
-  (let [result (apply function (map (:locals dslstep) args))
-        interpreter (:interpreter dslstep)]
-    (assoc dslstep :interpreter (push-item interpreter stack result))))
+  [interpreter stack args function]
+  (let [result (apply function (map (:locals interpreter) args))]
+    (push-item interpreter stack result)))

 (fact "`place` will apply the specified inline function to the dslstate locals named"
-  (let [integer-add (-> sixier
+  (let [integer-added (-> six-ints
                         (consume :integer :as :int1)
                         (consume :integer :as :int2)
                         (place :integer [:int1 :int2] #(+ %1 %2)))]
-  (get-stack (:interpreter integer-add) :integer) => '(11 4 3 2 1))) ;;
+  (get-stack integer-added :integer) => '(11 4 3 2 1))) ;;

 ; (def-pushinstruction


Prevent "View Details" button from holding focus

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -79,6 +79,13 @@
 (defn center-detail-button! [detail-button]
   (let [width (-> detail-button .node .-offsetWidth)]
     (.style detail-button "margin-left" (str (/ width -2) "px"))))
+
+(defn prevent-focus-on-detail-button! [detail-button]
+  (.on detail-button "mouseup" #(-> detail-button .node .blur)))
+
+(defn setup-detail-button! [detail-button]
+  (center-detail-button! detail-button)
+  (prevent-focus-on-detail-button! detail-button))

 ;; Geometry

@@ -647,7 +654,7 @@
         current-state (atom (initial-state svg
                                            detail-button
                                            animation-subject))]
-    (center-detail-button! detail-button)
+    (setup-detail-button! detail-button)
     (sync-on-window-size! current-state)
     (load-graph "miserables.json"
                 (fn [graph]


expect "Latitude" display_name

expect "Latitude" display_name

--- test/metabase/api/meta/field_test.clj
+++ test/metabase/api/meta/field_test.clj
@@ -70,7 +70,7 @@
               :table_id        (id :venues)
               :special_type    "fk"
               :name            "LATITUDE"
-              :display_name    nil
+              :display_name    "Latitude"
               :updated_at      $
               :active          true
               :id              $


Delete test that is no longer required

Delete test that is no longer required

--- test/onyx/messaging/gen_pick_peer.clj
+++ test/onyx/messaging/gen_pick_peer.clj
@@ -1,34 +0,0 @@
-(ns onyx.messaging.gen-pick-peer
-  (:require [onyx.peer.operation :as operation]
-            [clojure.set :refer [intersection difference]]
-            [clojure.test.check :as tc]
-            [clojure.test.check.generators :as gen]
-            [clojure.test.check.properties :as prop]
-            [clojure.test :refer :all]
-            [com.gfredericks.test.chuck :refer [times]]
-            [com.gfredericks.test.chuck.clojure-test :refer [checking]]))
-
-(def peer-id-gen
-  (gen/fmap (fn [_]
-              (java.util.UUID/randomUUID))
-            (gen/return nil)))
-
-(deftest pick-peer-gen-test
-  (checking "peer should stably select candidates even when the peers to select from change"
-            (times 50)
-            [[id peer-ids n-select peers-to-add n-remove]
-             (gen/tuple
-               peer-id-gen
-               (gen/vector peer-id-gen)
-               gen/s-pos-int
-               (gen/vector peer-id-gen)
-               gen/s-pos-int)]
-
-            (let [selected-start (operation/select-n-peers id peer-ids n-select)
-                  peer-ids-after (drop n-remove (shuffle (concat peer-ids peers-to-add)))
-                  selected-after (operation/select-n-peers id peer-ids-after n-select)]
-
-              ;; Possible set of peer ids has changed by maximum the number of added + the number of removed
-              ;; The selection should not change any more than this
-              (<= (+ (count peers-to-add) n-remove)
-                  (count (difference (set selected-after) (set selected-start)))))))


Just add the middleware we need

Just add the middleware we need

--- src/mars_ogler/routes.clj
+++ src/mars_ogler/routes.clj
@@ -4,13 +4,18 @@
             [compojure.response :as response]
             [mars-ogler.views :as views])
   (:use [compojure.core :only [defroutes GET]]
-        [hiccup.middleware :only [wrap-base-url]]))
+        [ring.middleware cookies
+                         keyword-params
+                         params]))

 (defroutes the-routes
-  (GET "/" [& params :as req]
-    (views/filter-pics params))
+  (GET "/" [& params]
+    (views/pics params))
   (route/resources "/")
   (route/not-found "You have wandered into a maze of twisty passages, all alike"))

 (def handler
-  (-> (handler/site the-routes) wrap-base-url))
+  (-> the-routes
+    wrap-keyword-params
+    wrap-params
+    wrap-cookies))


better nil handling

better nil handling

--- src/mediakeys/hotkeys.clj
+++ src/mediakeys/hotkeys.clj
@@ -16,7 +16,9 @@
 (defn allowed? [change]
     (let [key-val (first change)
           [action hotkey] key-val]
-        (-> hotkey make-keystroke not-nil?)))
+        (if hotkey
+            (-> hotkey make-keystroke not-nil?)
+            false)))

 (defcurried flatmap< [f channel]
     (let [return (chan)]


Docs, formatting, cleanup

Docs, formatting, cleanup

--- src/clj/forma/hadoop/jobs/preprocess.clj
+++ src/clj/forma/hadoop/jobs/preprocess.clj
@@ -13,25 +13,25 @@

 (defn rain-chunker
   "Like `modis-chunker`, for NOAA PRECL data files."
-  [m-res chunk-size tile-seq path pail-path]
+  [m-res chunk-size tiles source-path sink-path]
   (with-fs-tmp [fs tmp-dir]
-    (let [file-tap  (io/hfs-wholefile path)
-          pix-tap   (p/pixel-generator tmp-dir m-res tile-seq)
+    (let [file-tap (io/hfs-wholefile source-path)
+          pix-tap (p/pixel-generator tmp-dir m-res tiles)
           ascii-map (:precl static/static-datasets)]
       (->> (r/rain-chunks m-res ascii-map chunk-size file-tap pix-tap)
-           (to-pail pail-path)))))
+           (to-pail sink-path)))))

 (defmain PreprocessRain
-  "See project wiki for example usage."
-  [path pail-path & countries]
-  (let [countries (map read-string countries)]
-    (rain-chunker "1000"
-                  static/chunk-size
-                  (apply tile-set countries)
-                  path
-                  pail-path)))
+  "The locations can be ISO keywords or [h v] tuples."
+  [source-path sink-path s-res & locations]
+  {:pre [(string? s-res)
+         locations]}
+  (let [tiles (apply tile-set (map read-string locations))
+        chunk-size static/chunk-size]
+    (rain-chunker s-res chunk-size tiles source-path sink-path)))

 (defn static-chunker
+  "m-res - MODIS resolution. "
   [m-res chunk-size tile-seq dataset agg ascii-path pail-path]
   (with-fs-tmp [_ tmp-dir]
     (let [line-tap (hfs-textline ascii-path)
@@ -41,8 +41,9 @@

 (defmain PreprocessStatic
   "See project wiki for example usage."
-  [dataset ascii-path output-path & countries]
-  (static-chunker "500"
+  [dataset ascii-path output-path s-res & countries]
+  {:pre [(string? s-res)]}
+  (static-chunker s-res
                   static/chunk-size
                   (->> countries
                        (map read-string)
@@ -55,14 +56,15 @@
 (defmain PreprocessAscii
   "TODO: This is only good for hansen datasets looking to be combined
   Tidy up. This needs to be combined with PreprocessStatic."
-  [dataset ascii-path pail-path & countries]
-  {:pre [(#{"hansen" "vcf"} dataset)]}
+  [dataset ascii-path pail-path s-res & countries]
+  {:pre [(#{"hansen" "vcf"} dataset)
+         (string? s-res)]}
   (with-fs-tmp [_ tmp-dir]
     (let [line-tap (hfs-textline ascii-path)
           pix-tap  (->> countries
                         (map read-string)
                         (apply tile-set)
-                        (p/pixel-generator tmp-dir "1000"))]
+                        (p/pixel-generator tmp-dir s-res))]
       (->> (s/static-modis-chunks static/chunk-size
                                   dataset
                                   ({"vcf" c/min "hansen" c/sum} dataset c/max)


Modal close button styles from bootstrap to tailwind

--- src/cljs/my_money/components/common.cljs
+++ src/cljs/my_money/components/common.cljs
@@ -1,6 +1,25 @@
 (ns my-money.components.common
   (:require [reagent.core :as r :refer-macros [with-let]]
             [my-money.components.button :refer [button]]))
+
+(def close-button-styles ["bg-transparent"
+                          "border-0"
+                          "appearance-none"
+                          "cursor-pointer"
+                          "text-xl"
+                          "font-bold"
+                          "opacity-50"
+                          "hover:opacity-75"
+                       ;    TODO: restore these when removing bootstrap
+                       ;   "py-4"
+                       ;   "my-4"
+                       ;   "mr-4"
+                       ;   "ml-auto"
+                          ])
+(defn close-button [{:keys [on-click]}]
+  [:button {:class close-button-styles
+            :on-click on-click}
+   "×"])

 (defn modal [header body footer close-fn]
   (with-let [_ (-> js/document
@@ -11,9 +30,7 @@
      [:div.modal-dialog.z-50.top-32
       [:div.modal-content
        [:div.modal-header [:span.modal-title.h5 header]
-        [:button.close {:type     "button"
-                        :on-click close-fn}
-         "×"]]
+        [close-button {:on-click close-fn}]]
        [:div.modal-body body]
        [:div.modal-footer footer]]]
      [:div.modal-backdrop.z-10.opacity-50 {:on-click close-fn}]]


small fix

small fix

--- src/cljs/salava/social/ui/dashboard.cljs
+++ src/cljs/salava/social/ui/dashboard.cljs
@@ -341,7 +341,7 @@
              [:i.fa.fa-map-marker.icon]
              [:div.text
               (when-not hidden? [:p.num (get-in @state [:gallery :map :all] 0)])
-              [:p.desc (t :location/Map)]]]]]]
+              [:p.desc (t :location/Map) ]]]]]]
          [:div.since-last-login]]]]]]]]))


Changed fotd-autoconstruction.

Changed fotd-autoconstruction.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1,3 +1,6 @@
+;; gorilla-repl.fileformat = 1
+
+;; @@
 (ns clojush.pushgp.genetic-operators
   (:use [clojush util random individual globals interpreter translate pushstate]
         clojush.instructions.tag
@@ -607,19 +610,22 @@
                        (produce-child-genome-by-autoconstruction
                          parent1-genome parent2-genome false argmap)
                        parent1-genome)
-        child-errors (if autoconstructive-improve-or-diversify
-                       (do
-                         (swap! evaluations-count inc)
-                         (error-function (translate-plush-genome-to-push-program
-                                           {:genome child-genome}
-                                           argmap)))
-                       nil)
-        variant (diversifying? child-genome argmap)
-        use-child (or variant
-                      (and autoconstructive-improve-or-diversify
-                           (some (fn [[child-error parent1-error parent2-error]]
-                                   (< child-error (min parent1-error parent2-error)))
-                                 (mapv vector child-errors (:errors parent1) (:errors parent2)))))
+        genome-error #(do (swap! evaluations-count inc)
+                        (error-function (translate-plush-genome-to-push-program
+                                          {:genome %}
+                                          argmap)))
+        ;child-errors (genome-error child-genome)
+        make-child #(produce-child-genome-by-autoconstruction % % false argmap)
+        gc1-errors (genome-error (make-child child-genome))
+        gc2-errors (genome-error (make-child child-genome))
+        use-child (and
+                    ;(not= child-errors (:errors parent1))
+                    ;(not= child-errors (:errors parent2))
+                    (not= gc1-errors gc2-errors)
+                    (not (some #{gc1-errors} [(:errors parent1) (:errors parent2)]))
+                    (not (some #{gc2-errors} [(:errors parent1) (:errors parent2)]))
+                    )
+
         new-genome (if use-child
                      child-genome
                      (random-plush-genome max-genome-size-in-initial-program atom-generators argmap))]
@@ -678,3 +684,5 @@
                                            (:ancestors parent1)))
         :is-random-replacement
         (if use-child false true))))
+
+;; @@


CMR-202: removed archive-center from field mappings in query_to_elastic.clj

--- src/cmr/search/data/query_to_elastic.clj
+++ src/cmr/search/data/query_to_elastic.clj
@@ -15,7 +15,6 @@
    :granule_ur :granule-ur
    :collection_concept_id :collection-concept-id
    :campaign :project-sn
-   :archive-center :archive-center
    :two_d_coordinate_system_name :two-d-coord-name})

 (defn query-field->elastic-field


Refactor

Refactor

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -104,6 +104,11 @@
                                       auth-visualisations-set)))
                (mapv :id)))

+(defn- auth-collections [tenant-conn auth-datasets auth-visualisations auth-dashboards]
+  (mapv :id (auth-collection-ids tenant-conn
+                                 {:dataset-ids auth-datasets
+                                  :visualisation-ids auth-visualisations
+                                  :dashboard-ids auth-dashboards})))
 (defn wrap-auth-datasets
   "Add to the request an auth-service protocol impl using flow-api check_permissions"
   [tenant-manager flow-api]
@@ -122,10 +127,7 @@
                                    auth-datasets (auth-datasets dss permissions)
                                    auth-visualisations (auth-visualisations tenant-conn (set auth-datasets))
                                    auth-dashboards (auth-dashboards tenant-conn (set auth-visualisations))
-                                   auth-collections (mapv :id (auth-collection-ids tenant-conn
-                                                                                {:dataset-ids auth-datasets
-                                                                                :visualisation-ids auth-visualisations
-                                                                                :dashboard-ids auth-dashboards}))]
+                                   auth-collections (auth-collections tenant-conn auth-datasets auth-visualisations auth-dashboards)]
                                {:auth-datasets       auth-datasets
                                 :auth-visualisations auth-visualisations
                                 :auth-dashboards auth-dashboards


Small change in permutation-context.clj

Small change in permutation-context.clj

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- doc/examples/permutation-context.clj
+++ doc/examples/permutation-context.clj
@@ -9,7 +9,7 @@
 (in-ns 'user)
 (use 'conexp.main)

-;;;
+;;; Context computation

 (defn context-crossover
   "For four given context ctx-{1,2,3,4} computes
@@ -19,9 +19,8 @@
      ctx-3 | ctx-4
   "
   [ctx-1 ctx-2 ctx-3 ctx-4]
-  (context-subposition
-   (context-apposition ctx-1 ctx-2)
-   (context-apposition ctx-3 ctx-4)))
+  (context-subposition (context-apposition ctx-1 ctx-2)
+                       (context-apposition ctx-3 ctx-4)))

 (defn L
   "Computes the context IL as in example 12."
@@ -44,7 +43,7 @@
 ;; Try it out!

 (count (concepts (K 1))) ;-> 1
-(count (concepts (K 5))) ;-> 120
+(count (concepts (reduce-context (K 5)))) ;-> 120

 ;;;