Implement special cases for where conditions on the record id.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -2,7 +2,7 @@
   (use (fleetdb util)))

 (defn init []
-  {:rmap {}
+  {:rmap (sorted-map)
    :imap {}})

 (def- conj-op?
@@ -141,13 +141,19 @@
     (fn [spec index] (index-delete index spec record))))

 (defn- root-plan [db [attr dir :as order]]
-  (if (and order (index-get db {:on attr}))
-    {:action  :index-scan
-     :attr    attr
-     :dir     dir
-     :ordered true}
-    {:action  :db-scan
-     :ordered false}))
+  (cond
+    (= attr :id)
+      {:action  :rmap-scan
+       :dir     dir
+       :ordered true}
+    (and order (index-get db {:on attr}))
+      {:action  :index-scan
+       :attr    attr
+       :dir     dir
+       :ordered true}
+    :no-index
+      {:action  :db-scan
+       :ordered false}))

 (defn- filter-plan [source where]
   (if-not where
@@ -179,36 +185,58 @@
       ; when reasonable index and order -> may be suboptimal, but reasonable
       (= := op)
         (let [[attr aval] wrest]
-          (if (index-get db {:on attr})
-            {:action  :index-lookup
-             :attr    attr
-             :aval    aval
-             :ordered false}
-            (root-filter-plan db where order)))
+          (cond
+            (= attr :id)
+              {:action  :rmap-lookup
+               :id      aval
+               :ordered false}
+            (index-get db {:on attr})
+              {:action  :index-lookup
+               :attr    attr
+               :aval    aval
+               :ordered false}
+            :no-index
+              (root-filter-plan db where order)))

       ; as above
       (= :in op)
         (let [[attr in] wrest]
-          (if (index-get db {:on attr})
-            {:action  :index-multilookup
-             :attr    attr
-             :in      in
-             :ordered false}
-            (root-filter-plan db where order)))
+          (cond
+            (= attr :id)
+              {:action  :rmap-multilookup
+               :ids     in
+               :ordered false}
+            (index-get db {:on attr})
+              {:action  :index-multilookup
+               :attr    attr
+               :in      in
+               :ordered false}
+            :no-index
+              (root-filter-plan db where order)))

       ; hmm
       (range-op? op)
         (let [[attr aval] wrest]
-          (if (index-get db {:on attr})
-            (let [[oattr odir] order
-                  ordered      (= attr oattr)]
-              {:action  :index-range
-               :attr    attr
-               :dir     (if ordered oattr)
-               :op      op
-               :aval    aval
-               :ordered ordered})
-            (root-filter-plan db where order)))
+          (cond
+            (= attr :id)
+              (let [[oattr odir] order
+                    ordered      (= :id oattr)]
+                {:action  :rmap-range
+                 :dir     (if ordered oattr)
+                 :op      op
+                 :idval   aval
+                 :ordered ordered})
+            (index-get db {:on attr})
+              (let [[oattr odir] order
+                    ordered      (= attr oattr)]
+                {:action  :index-range
+                 :attr    attr
+                 :dir     (if ordered oattr)
+                 :op      op
+                 :aval    aval
+                 :ordered ordered})
+            :no-index
+              (root-filter-plan db where order)))

       ; when no indexes use root-filter-plan -> optimal
       ; when some reasonable, most selective first index -> probably optimal
@@ -229,7 +257,7 @@
            :source  sub-plans})

       :else
-        (raise "where op " op " not recognized"))))
+        (raise (str "where op " op " not recognized")))))

 (defn- order-plan [source order]
   (if (or (not order) (:ordered source))
@@ -275,6 +303,10 @@
 (defmethod exec :db-scan [{:keys [rmap]} plan]
   (vals rmap))

+(defmethod exec :rmap-scan [{:keys [rmap]} {:keys [dir]}]
+  (let [seq-fn (if (= dir :asc) seq rseq)]
+    (map val (seq-fn rmap))))
+
 (defmethod exec :index-scan [db {:keys [attr dir]}]
   (let [index    (index-get db {:on attr})
         seq-fn   (if (= dir :asc) seq rseq)
@@ -287,27 +319,38 @@
         indexed (index aval)]
     (index-flatten1 indexed)))

+(defmethod exec :rmap-lookup [{:keys [rmap]} {:keys [id]}]
+  (get rmap id))
+
 (defmethod exec :index-multilookup [db {:keys [attr in]}]
   (let [index    (index-get db {:on attr})
         indexeds (map index in)]
     (index-flatten indexeds)))

+(defmethod exec :rmap-multilookup [{:keys [rmap]} {:keys [ids]}]
+  (map rmap ids))
+
 (def- one-sided-op-fns
   {:< < :<= <= :> > :>= >=})

 (def- two-sided-op-fns
   {:>< [> <] :>=< [>= <] :><= [> <=] :>=<= [>= <=]})

+(defn- index-range [index dir op ival]
+  (let [subseq-fn (if (= dir :asc) subseq rsubseq)
+        pairs     (if-let [op-fn (one-sided-op-fns op)]
+                    (subseq-fn index op-fn ival)
+                    (let [[op-fn1 op-fn2] (two-sided-op-fns op)
+                          [ival1  ival2]  ival]
+                      (subseq-fn index op-fn1 ival1 op-fn2 ival2)))]
+    (map val pairs)))
+
 (defmethod exec :index-range [db {:keys [attr dir op aval]}]
-  (let [index     (index-get db {:on attr})
-        subseq-fn (if (= dir :asc) subseq rsubseq)
-        pairs     (if-let [op-fn (one-sided-op-fns op)]
-                    (subseq-fn index op-fn aval)
-                    (let [[op-fn1 op-fn2] (two-sided-op-fns op)
-                          [aval1  aval2]   aval]
-                      (subseq-fn index op-fn1 aval1 op-fn2 aval2)))
-        indexeds  (map val pairs)]
-    (index-flatten indexeds)))
+  (let [index     (index-get db {:on attr})]
+    (index-flatten (index-range index dir op aval))))
+
+(defmethod exec :rmap-range [{:keys [rmap]} {:keys [dir op idval]}]
+  (index-range rmap dir op idval))

 (defmethod exec :union [db {:keys [source]}]
   (union-stream (map #(exec db %) source)))


Because whitespace matters in usage strings

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -205,7 +205,7 @@

 (defn -main
   "Usage: lein grim [src|:src|source|:source] <platform> <dst>
-  : lein grim [artifact|:artifact] <platform> <groupid> <artifactid> <version> <dst>
+     : lein grim [artifact|:artifact] <platform> <groupid> <artifactid> <version> <dst>

   In source mode, lein-grim traverses the source paths of the current project,
   enumerating and documenting all namespaces. This is intended for documenting


Comment change

Comment change

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -215,7 +215,7 @@
   and documenting the namespaces therein. This is intended for documenting
   projects such as clojure.core which may not exist as a covenient lein project
   but which do exist as artifacts."
-  [p-groupid p-artifactid p-version p-source-paths ;; provided by lein
+  [p-groupid p-artifactid p-version p-source-paths ;; provided by lein via profile
    mode-selector & args ;; user provided
    ]
   (case mode-selector


Sort migrations by version

Sort migrations by version

--- src/jupiter/core.clj
+++ src/jupiter/core.clj
@@ -29,7 +29,8 @@

 (defn- pending-migrations [datasource all-migrations]
   (let [applied-versions (set (jdbc/query datasource applied-versions-query))]
-    (filter #(not (applied-versions (select-keys % [:version]))) all-migrations)))
+    (sort-by #(:version %)
+             (filter #(not (applied-versions (select-keys % [:version]))) all-migrations))))

 (defn- migration-body [migration]
   [(slurp (:file migration))])


Fix opening file from osx file manager - close #2053

--- src/lt/objs/cli.cljs
+++ src/lt/objs/cli.cljs
@@ -43,8 +43,11 @@
   on first window since subsequent windows don't open path arguments."
   []
   (and (app/first-window?)
-       (or (seq (if js/process.env.LT_DEV_CLI (subvec argv 2) (rest argv)))
-           (seq open-files))))
+       ;; OSX adds an extra apple event argument to argv when opening a file from a
+       ;; file manager e.g. ["/path/to/electron" "-psn_0_12381134"]. Rather than add
+       ;; a brittle check to remove that argument, check open-files first
+       (or (seq open-files)
+           (seq (if js/process.env.LT_DEV_CLI (subvec argv 2) (rest argv))))))

 ;;*********************************************************
 ;; Behaviors


Tweaks to #1716

Tweaks to #1716

* Handle a file that has a ':'
* Remove line handling from open! - not needed since a user can't specify a line number from
  a file manager
* Revert back to :post-init trigger - works fine with latest
* Add :desc to behaviors

--- src/lt/objs/cli.cljs
+++ src/lt/objs/cli.cljs
@@ -26,8 +26,8 @@
           (parse argv))
       (js->clj :keywordize-keys true)))

-(defn open-paths [paths add?]
-  (doseq [[path line] paths
+(defn open-paths [path-line-pairs add?]
+  (doseq [[path line] path-line-pairs
           :when (not= path (.-execPath js/process))]
     (if (files/exists? path)
       (if (files/dir? path)
@@ -60,32 +60,33 @@
 ;;*********************************************************

 (behavior ::open-on-args
-                  :triggers #{:show}
+                  :triggers #{:post-init}
+                  :desc "App: Process commandline arguments"
                   :reaction (fn [this]
                               (when (args)
                                 (let [args-str (or (app/extract! (args-key (app/window-number)))
                                                    (first (app/args)))
                                       args (parse-args (rebuild-argv args-str))
-                                      paths-line-no (map #(string/split (files/resolve (:dir args) %) #":")
-                                                         (filter valid-path? (:_ args)))
-                                      paths (map first paths-line-no)
+                                      path-line-pairs (map #(let [[_ path line] (re-find #"^(.*?):?(\d+)?$" %)]
+                                                              [(files/resolve (:dir args) path) line])
+                                                           (filter valid-path? (:_ args)))
+                                      paths (map first path-line-pairs)
                                       open-dir? (some files/dir? paths)]
                                   (when open-dir?
                                     (object/merge! workspace/current-ws {:initialized? true}))
-                                  (open-paths paths-line-no (:add args))))))
+                                  (open-paths path-line-pairs (:add args))))))

 (behavior ::open!
                   :triggers #{:open!}
+                  :desc "App: Open a path from a file manager e.g. Finder"
                   :reaction (fn [this path]
                               (when (= (app/fetch :focusedWindow) (app/window-number))
                                 (let [args (parse-args (rebuild-argv path))
-                                      paths-line-no (map #(string/split (files/resolve (:dir args) %) #":")
-                                                         (filter valid-path? (:_ args)))
-                                      paths (map first paths-line-no)
+                                      paths (map #(files/resolve (:dir args) %) (filter valid-path? (:_ args)))
                                       open-dir? (some files/dir? paths)]
                                   (if (or (:new args)
                                           (and open-dir? (not (:add args))))
                                     (let [winid (inc (app/fetch :window-id))]
                                       (app/store! (args-key winid) path)
                                       (app/open-window))
-                                    (open-paths paths-line-no (:add args)))))))
+                                    (open-paths (map vector paths) (:add args)))))))


Only insert the kbyteSize meta node if encoded_size is not nil

--- src/mdr2/dtb/xml.clj
+++ src/mdr2/dtb/xml.clj
@@ -29,9 +29,13 @@

 (defn update-title-node [node v] (assoc-in node [:content] (list v)))

-(defn insert-kbytesize-node [node v]
-  (update-in node [:content] concat ; append
-             (list (xml/element :meta {:name "ncc:kByteSize" :content v}))))
+(defn insert-kbytesize-node [node value]
+  "Append a ncc:kByteSize meta element to `node` if the given `value`
+  is not nil"
+  (if value
+    (update-in node [:content] concat ; append
+               (list (xml/element :meta{:name "ncc:kByteSize" :content value})))
+    node))

 (defn insert-xmlns [node]
   (update-in node [:attrs] assoc :xmlns "http://www.w3.org/1999/xhtml"))


update figwheel-sidecar version

update figwheel-sidecar version

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -18,7 +18,7 @@
                           }
            :dependencies [ ;;[spyscope "0.1.6-SNAPSHOT"]
                           [com.cemerick/piggieback "0.2.1"]
-                          [figwheel-sidecar "0.5.3-1"]
+                          [figwheel-sidecar "0.5.4-6"]
                           [org.clojure/tools.namespace "0.2.10"]
                           ;;[clojure-complete "0.2.3"]
                           [leiningen #=(leiningen.core.main/leiningen-version)]


lein: update cider

lein: update cider

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,3 +1,3 @@
-{:user {:plugins [[cider/cider-nrepl "0.12.0"]]}
+{:user {:plugins [[cider/cider-nrepl "0.13.0"]]}
  :repl {:dependencies [[org.clojure/tools.nrepl "0.2.12"]]} ;emacs cider want specific repl <https://github.com/technomancy/leiningen/blob/master/doc/PROFILES.md#replacing-default-repl-dependencies>
  }


less blocky

less blocky

* don't call .accept in the master thread or we won't see config
  changes/shutdown rqs

* each backend needs a thread because it does blocking io

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -8,7 +8,7 @@
             [clojure.java.io :as io]
             [clojure.pprint :refer [pprint]]
             [clojure.core.async :as async
-             :refer [<! go chan >! close! alts!]]))
+             :refer [<! <!! go chan >! close! alts!]]))

 (defn server-socket
   "Opens a ServerSocketChannel listening on the specified TCP `port` then
@@ -62,9 +62,9 @@
   "a channel that accepts nio SocketChannels and relays the data being sent to them onto a new connection to host:port"
   [host port]
   (let [ch (chan)]
-    (go
+    (future
       (loop []
-        (let [socketchannel (<! ch)]
+        (let [socketchannel (.accept (<!! ch))]
           (when socketchannel
             (when (instance? SocketChannel socketchannel)
               (relay-to-backend socketchannel host port)
@@ -128,7 +128,7 @@
              config {}]
         (let [[val ch] (alts!
                         (conj
-                         (map #(vector (:chan %) :ready) backends)
+                         (map #(vector (:chan %) listener) backends)
                          config-ch
                          shutdown))]
           (cond (= ch config-ch)
@@ -140,6 +140,6 @@
                 (do (println "quit") (.close listener))

                 :else
-                (do (and listener (>! ch (.accept listener)))
+                (do (and listener (>! ch listener))
                     (recur backends listener config))))))
     shutdown))


docstring

docstring

--- src/merlion/etcd.clj
+++ src/merlion/etcd.clj
@@ -46,7 +46,9 @@
        get-http
        (map-from-etcd-response prefix)))

-(defn watch-prefix [prefix]
+(defn watch-prefix
+  "Returns a core.async channel which delivers a val whenever an etcd key under `prefix` is added/deleted/changed."
+  [prefix]
   (let [ch (chan)]
     (go
       (loop []


finish monoid

finish monoid

--- src/monad/monoid.clj
+++ src/monad/monoid.clj
@@ -1,17 +1,52 @@
 (ns monad.monoid)
+
+;;Simply put, Monoids describe types containing a binary function and an identity value
+;;monoid有一个不变元 任何这个类型的monoid和这个不变元进行mappend操作都不会改变自身的值
+;;比如+ *都是mappend, 0 1就是不变元
+
+(def addmempty (+))                                         ;; 0
+(def addappend +)
+(defn addconcat [ms]
+  (reduce addappend addmempty ms))
+
+(addappend 3 4)                                             ;; 7
+(addconcat [2 3 4])                                         ;; 9
+
+(defn plus-monoid
+  ([]
+   0)
+  ([a b]
+   (+ a b)))
+
+(plus-monoid) ;; 0 - same as mempty
+(plus-monoid 3 4) ;; 7 - same as mappend
+(reduce plus-monoid [2 3 4]) ;; 9 - when working with monoids, reduce is the same as mconcat
+
+(defn list-monoid
+  ([]
+   '())
+  ([a b]
+   (concat a b)))
+
+(list-monoid) ;; () - remember, same as mempty
+(list-monoid [1 2 3] [4 5 6]) ;; (1 2 3 4 5 6) - remember, same as mappend
+(reduce list-monoid [[1 2 3] [4 5 6] [7 8 9]]) ;; (1 2 3 4 5 6 7 8 9) - mconcat in action
+
+;;实现的更像haskell一点

 (defprotocol Monoid
   (mempty [m] "mempty :: m")
-  (mappend [m n] "mappend :: m -> m -> m")
-  (mconcat [nest] "mconcat :: [m] -> m"))
+  (mappend [m n] "mappend :: m -> m -> m"))

 (defrecord List [value]
   Monoid
   (mempty [m] (List. (list)))
   (mappend [m n]
-    (List. (concat (:value m) (:value n))))
-  (mconcat [nest]
-    (reduce mappend (mempty nest) (:value nest))))
+    (List. (apply concat (map :value [m n])))))
+
+(defn mconcat [m nest]
+  "mconcat :: [m] -> m"
+  (reduce mappend (mempty m) nest))

 (:value (mempty (List. '())))

@@ -21,7 +56,55 @@

 (mappend (mappend (mempty (List. '())) (List. (list 1 2 3))) (List. (list 4 5 6)))

-(:value (let [m (List. (list 1 2 3))
-              n (List. (list 4 5 6))
-              nest (List. (list m n))]
-          (mconcat nest)))
+(:value (let [nest (map ->List [(list 1 2 3) (list 4 5 6)])]
+          (mconcat (->List '()) nest)))
+
+(defrecord Product [value]
+  Monoid
+  (mempty [m] (Product. 1))
+  (mappend [m n]
+    (Product. (apply * (map :value [m n])))))
+
+(:value (mempty (Product. nil)))
+
+(:value (let [m (Product. 3)
+              n (Product. 9)]
+          (mappend m n)))
+
+(:value (let [nest (map ->Product [1 3 9])]
+          (mconcat (->Product 1) nest)))
+
+;;or is a macro and a macro is not a value just like fn so can not use apply here
+(defrecord Any [value]
+  Monoid
+  (mempty [m] (Any. false))
+  (mappend [m n]
+    (Any. (or (:value m) (:value n)))))
+
+(:value (mempty (->Any false)))
+
+(:value (let [m (->Any true)
+              n (->Any false)]
+          (mappend m n)))
+
+(:value (let [nest (map ->Any [false false true])]
+          (mconcat (->Any false) nest)))
+
+;;monoid law
+
+;;Identity
+;;Applying mappend to mempty and a monoid x should be the same as the original x monoid
+
+(let [x (->List (list 1 2 3))]
+  (= (mappend (mempty (->List '())) x)
+     (mappend x (mempty (->List '())))
+     x))
+
+;;Associativity结合律
+;;Applying mappend to a monoid x and the result of applying mappend to the monoids y and z should be the same as first applying mappend to the monoids x and y and then applying mappend to the resulting monoid and the monoid z
+
+(let [x (->List (list 1 2 3))
+      y (->List (list 4 5 6))
+      z (->List (list 7 8 9))]
+  (= (mappend x (mappend y z))
+     (mappend (mappend x y) z)))


Fix comparison so tests that fail actually fail

--- src/oi_lang/obj.cljs
+++ src/oi_lang/obj.cljs
@@ -61,7 +61,7 @@

 (defn oi-= [a b]
   (if (and (vector? a) (vector? b))
-    (every? oi-= (map vec a b))
+    (every? (fn [[a b]] (oi-= a b)) (map vector a b))
     (and (= (:type a) (:type b))
          (= (:value a) (:value b)))))


pprint-ns: (ns name\n) => (ns name)

pprint-ns: (ns name\n) => (ns name)

pprinting is surprisingly difficult!

--- src/refactor_nrepl/ns/pprint.clj
+++ src/refactor_nrepl/ns/pprint.clj
@@ -74,11 +74,12 @@
                     (not (or docstring? attrs?)) more
                     :else (rest more))]
     (-> (with-out-str
-          (printf "(ns %s\n" name)
+          (printf "(ns %s" name)
+          (if (or docstring? attrs? forms)
+            (println)
+            (print ")"))
           (when docstring? (printf "\"%s\"\n" docstring? ))
           (when attrs? (pprint attrs?))
-          (when-not forms
-            (print ")"))
           (dorun
            (map-indexed
             (fn [idx form]


added support for new paredit-open-curly command

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -235,7 +235,7 @@
 	                 "(defun f (x)\n  |)"
 	                "; (Foo.|"
 	                 "; (Foo.)|"}]
-	    ["["         :paredit-open-square
+      ["["         :paredit-open-square
                  {"(a b |c d)"  "(a b [|] c d)"
                   "(foo \"bar |baz\" quux)" "(foo \"bar [|baz\" quux)"}
                   {"(a b|c d)" "(a b [|] c d)"
@@ -246,6 +246,19 @@
                    "(a,| b)" "(a, [|] b)"
                    "(a,|b)" "(a, [|] b)"
                    "(a,|)" "(a, [|])"}]
+      ["{"         :paredit-open-curly ; this command does not exist in paredit AFAIK
+                 {"(a b |c d)"  "(a b {|} c d)"
+                  "(foo \"bar |baz\" quux)" "(foo \"bar {|baz\" quux)"}
+                  {"(a b|c d)" "(a b {|} c d)"
+                   "(|)" "({|})"
+                   "|" "{|}"
+                   "a|" "a {|}"
+                   "#|" "#{|}" ; specific to clojure sets
+                   "(a |,b)" "(a {|},b)"
+                   "(a,| b)" "(a, {|} b)"
+                   "(a,|b)" "(a, {|} b)"
+                   "(a,|)" "(a, {|})"
+                   }]
     ]
   ])

@@ -304,11 +317,14 @@
 (defmulti paredit (fn [k & args] k))

 (defn open-balanced
-  [[o c] {:keys [text offset length] :as t}]
+  [[o c] {:keys [text offset length] :as t}
+   chars-with-no-space-before chars-with-no-space-after]
   #_(prn "t:" t)
   (if (in-code? text offset)
-    (let [add-pre-space? (not (contains? (into *real-spaces* *open-brackets*) (previous-char t)))
-          add-post-space? (not (contains? (into *extended-spaces* *close-brackets*) (next-char t)))
+    (let [add-pre-space? (not (contains? chars-with-no-space-before
+                                         (previous-char t)))
+          add-post-space? (not (contains? chars-with-no-space-after
+                                          (next-char t)))
           ins-str (str (if add-pre-space? " " "")
                        (str o c)
                        (if add-post-space? " " ""))
@@ -322,13 +338,25 @@
   :paredit-open-round
   [cmd {:keys [text offset length] :as t}]
   #_(prn "t:" t)
-  (open-balanced [\( \)] t))
+  (open-balanced [\( \)] t
+    (into *real-spaces* *open-brackets*)
+    (into *extended-spaces* *close-brackets*)))

 (defmethod paredit
   :paredit-open-square
   [cmd {:keys [text offset length] :as t}]
   #_(prn "t:" t)
-  (open-balanced [\[ \]] t))
+  (open-balanced [\[ \]] t
+    (into *real-spaces* *open-brackets*)
+    (into *extended-spaces* *close-brackets*)))
+
+(defmethod paredit
+  :paredit-open-curly
+  [cmd {:keys [text offset length] :as t}]
+  #_(prn "t:" t)
+  (open-balanced [\{ \}] t
+    (conj (into *real-spaces* *open-brackets*) \#) ; add # for not inserting space before a set
+    (into *extended-spaces* *close-brackets*)))

 (defn test-command [title-prefix command]
   (testing (str title-prefix " " (second command) " (\"" (first command) "\")")


Fixed accel rate. Some precision issues will come up for sure. Also some bugs with interpenetration of walls, probably due to missing transitions. Food for thought. Probably need different gravity for the ascending phase of the jump and the falling phase. Also the linear inclusions are much larger than expected.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -29,9 +29,10 @@
 (defonce last-time nil)

 (defn kw [& args]
-  (keyword (string/join "-" (map #(if (or (symbol? %1) (keyword? %1) (string? %1))
-                                   (name %1)
-                                   (str %1))
+  (keyword (string/join "-" (map #(cond
+                                   (or (symbol? %1) (keyword? %1) (string? %1)) (name %1)
+                                   (number? %1) (str (.round js/Math %1))
+                                   :else (str %1))
                                  args))))

 (defn make-paired-states [a af b bf func]
@@ -116,7 +117,14 @@
         wall-others #{}
         fall-speed 64
         jump-speed 64
-        move-speed 32]
+        move-speed 32
+        jump-time 0.3
+        acc-interval (/ 1.0 30.0)
+        ground-move-acc (/ move-speed 8)
+        brake-acc (/ move-speed 4)
+        skid-acc (/ move-speed 6)
+        air-move-acc (/ ground-move-acc 2)
+        fall-acc (/ fall-speed 4)]
     (make-ha id
              {:x     x :y y
               :w     16 :h 16
@@ -177,10 +185,10 @@
                            ;moving -> moving (faster)
                            (when (< vx move-speed)
                              (make-edge
-                               (kw :moving dir (inc vx))
+                               (kw :moving dir (.min js/Math (+ vx ground-move-acc) move-speed))
                                [:and
                                 (non-bumping-guard dir walls wall-others)
-                                [:geq :acc-timer 0.05]]
+                                [:geq :acc-timer acc-interval]]
                                #{:required}
                                clear-timers))
                            ;moving -> jumping  (ascend controlled)
@@ -208,10 +216,10 @@
                                nil
                                #{:required}
                                clear-timers)
-                             ; braking -> slower breaking
+                             ; braking -> slower braking
                              [(make-edge
-                                (kw :braking dir (dec vx))
-                                [:geq :acc-timer 0.025]
+                                (kw :braking dir (.max js/Math 0 (- vx brake-acc)))
+                                [:geq :acc-timer acc-interval]
                                 #{:required}
                                 clear-timers)
                               ; braking -> skidding
@@ -256,17 +264,17 @@
                              nil
                              #{[:off #{opp}]}
                              clear-timers)
-                           (if (> vx 0)
+                           (if (> (- vx skid-acc) 0)
                              ; skidding -> skidding slower by deceleration
                              (make-edge
-                               (kw :skidding dir (dec vx))
-                               [:geq :acc-timer 0.05]
+                               (kw :skidding dir (.max js/Math 0 (- vx skid-acc)))
+                               [:geq :acc-timer acc-interval]
                                #{:required}
                                clear-timers)
                              ; skidding -> moving opp by deceleration through 0
                              (make-edge
-                               (kw :moving opp 1)
-                               [:geq :acc-timer 0.05]
+                               (kw :moving opp (.abs js/Math (- vx skid-acc)))
+                               [:geq :acc-timer acc-interval]
                                #{:required}
                                clear-timers)
                              )
@@ -297,7 +305,7 @@
                            ;  -> falling at apex
                            (make-edge
                              (kw :falling dir vx jump-speed)
-                             [:geq :jump-timer 0.4]
+                             [:geq :jump-timer jump-time]
                              #{:required}
                              clear-timers)
                            ; -> falling because of button release
@@ -309,19 +317,19 @@
                            ; -> accelerate right or left
                            (when (< vx move-speed)
                              (make-edge
-                               (kw :jumping dir (inc vx))
-                               [:geq :acc-timer 0.1]
+                               (kw :jumping dir (.min js/Math move-speed (+ vx air-move-acc)))
+                               [:geq :acc-timer acc-interval]
                                #{[:on #{dir}]}
                                clear-acc-timer))
-                           (if (= vx 0)
+                           (if (< (- vx air-move-acc) 0)
                              (make-edge
-                               (kw :jumping opp 1)
-                               [:geq :acc-timer 0.1]
+                               (kw :jumping opp (.abs js/Math (- vx air-move-acc)))
+                               [:geq :acc-timer acc-interval]
                                #{[:on #{opp}]}
                                clear-acc-timer)
                              (make-edge
-                               (kw :jumping dir (dec vx))
-                               [:geq :acc-timer 0.1]
+                               (kw :jumping dir (.min js/Math move-speed (- vx air-move-acc)))
+                               [:geq :acc-timer acc-interval]
                                #{[:on #{opp}]})))
                          ])
                       ]
@@ -331,12 +339,10 @@
                         (let [landed-state (if (= vx 0)
                                              (kw :idle dir)
                                              (kw :moving dir vx))
-                              turning-state-accelerating (if (= vx 0)
-                                                           (kw :falling opp 1 (dec vy))
-                                                           (kw :falling dir (dec vx) (dec vy)))
-                              turning-state-terminal (if (= vx 0)
-                                                       (kw :falling opp 1 vy)
-                                                       (kw :falling dir (dec vx) vy))]
+                              new-vy (.max js/Math (- fall-speed) (- vy fall-acc))
+                              turning-state (if (< (- vx air-move-acc) 0)
+                                (kw :falling opp (.abs js/Math (- vx air-move-acc)) new-vy)
+                                (kw :falling dir (- vx air-move-acc) new-vy))]
                           [(make-state
                              (kw :falling dir vx vy)
                              {:x vx
@@ -354,24 +360,26 @@
                                 ; falling on right timer no obstacle -> falling faster and accelerating right
                                 (when (< vx move-speed)
                                   (make-edge
-                                    (kw :falling dir (inc vx) (dec vy))
+                                    (kw :falling dir
+                                        (.min js/Math move-speed (+ vx air-move-acc))
+                                        new-vy)
                                     [:and
-                                     [:geq :acc-timer 0.005]
+                                     [:geq :acc-timer acc-interval]
                                      (non-bumping-guard opp walls wall-others)]
                                     #{[:on #{dir}] [:off #{opp}]}
                                     clear-timers))
                                 ; falling on left timer no obstacle -> falling faster and accelerating left, switch to opposite direction if vx-1 <= 0
                                 (make-edge
-                                  turning-state-accelerating
+                                  turning-state
                                   [:and
-                                   [:geq :acc-timer 0.005]
+                                   [:geq :acc-timer acc-interval]
                                    (non-bumping-guard dir walls wall-others)]
                                   #{[:on #{opp}] [:off #{dir}]}
                                   clear-timers)
                                 ; falling off right left timer -> falling faster and not accelerating
                                 (make-edge
-                                  (kw :falling dir vx (dec vy))
-                                  [:geq :acc-timer 0.005]
+                                  (kw :falling dir vx new-vy)
+                                  [:geq :acc-timer acc-interval]
                                   #{:required}
                                   clear-timers)
                                 ]
@@ -380,17 +388,17 @@
                                 ; falling on right timer no obstacle -> accelerating right
                                 (when (< vx move-speed)
                                   (make-edge
-                                    (kw :falling dir (inc vx) vy)
+                                    (kw :falling dir (.min js/Math move-speed (+ vx air-move-acc)) new-vy)
                                     [:and
-                                     [:geq :acc-timer 0.1]
+                                     [:geq :acc-timer acc-interval]
                                      (non-bumping-guard opp walls wall-others)]
                                     #{[:on #{dir}] [:off #{opp}]}
                                     clear-timers))
                                 ; falling on left timer no obstacle -> accelerating left, switch to opposite dir if vx-1 <= 0
                                 (make-edge
-                                  turning-state-terminal
+                                  turning-state
                                   [:and
-                                   [:geq :acc-timer 0.1]
+                                   [:geq :acc-timer acc-interval]
                                    (non-bumping-guard dir walls wall-others)]
                                   #{[:on #{opp}] [:off #{dir}]}
                                   clear-timers)


Replace vec map on mapv

Replace vec map on mapv

--- src/pot/core/bl.cljs
+++ src/pot/core/bl.cljs
@@ -48,11 +48,11 @@

 (defn process-board
   [board]
-  (vec (map (comp vec process-row) board)))
+  (mapv (comp vec process-row) board))

 (defn mirrorv-board
   [board]
-  (vec (map (comp vec reverse) board)))
+  (mapv (comp vec reverse) board))

 (defn transpose-board
   [board]


Remove test

Remove test

--- test/zaffre/animation/wrapper_test.cljc
+++ test/zaffre/animation/wrapper_test.cljc
@@ -1,51 +0,0 @@
-(ns zaffre.animation.wrapper-test
-  (:require
-    [zaffre.animation.wrapper :as zaw]
-    [clojure.test :refer :all]))
-
-
-(deftest merge-events-test
-  (are [in out] (= (apply zaw/merge-events in) out)
-    ;; base cases
-    [[]] []
-    (list '()) (list)
-    [[[0 nil]]] [[0 nil]]
-    ;; sinle event stream
-    [[[0 :a] [5 :b] [10 :c]]] [[0 :a] [5 :b] [10 :c]]
-    [[[5 :a] [5 :b] [10 :c]]] [[5 :a] [5 :b] [10 :c]]
-    ;; multiple event streams
-    [[] []]    []
-    [[[0 :a]]
-     [[1 :b]]] [[0 :a] [1 :b]]
-
-    ;; merge two event seqs
-    [[[0 :a]]
-        [[1 :b] [2 :c]]]   [[0 :a] [1 :b] [2 :c]]
-
-    [    [[1 :b]]
-      [[0 :a] [2 :c]]]     [[0 :a] [1 :b] [1 :c]]
-
-    [[[0 :a] [2 :c]]
-        [[1 :b]]]          [[0 :a] [1 :b] [1 :c]]
-
-    [[[5 :a]]
-     (zaw/delay-events 5 [[5 :b]])] [[5 :a] [5 :b]]
-  ))
-
-(deftest merge-infinite-events-test
-  (are [in n out] (= (take n (apply zaw/merge-events in)) out)
-    ;; sinle event stream
-    [(repeat [1 :a])]  3 [[1 :a] [1 :a] [1 :a]]
-    ;; multiple event streams
-
-    ;; merge two event seqs
-    [(cons [1 :a] (repeat [2 :a]))
-     (repeat [2 :b])]               5 [[1 :a] [1 :b] [1 :a] [1 :b] [1 :a]]
-
-    ;; merge three event seqs
-    [(cons [1 :a] (repeat [3 :a]))
-     (cons [2 :b] (repeat [3 :b]))
-     (repeat [3 :c])]               5 [[1 :a] [1 :b] [1 :c] [1 :a] [1 :b]]
-  ))
-
-


Correct spelling.

Correct spelling.

--- src/re_demo/gap.cljs
+++ src/re_demo/gap.cljs
@@ -26,8 +26,8 @@
                            :width    "450px"
                            :children [[title2 "Notes"]
                                       [status-text "Stable"]
-                                      [p "Introduces white space into layouts. Typically placed between the children of a v-box or h-box."]
-                                      [p "The white space added will be in the expected direction (i.e. horizontally for h-box or vertically for v-box)."]
+                                      [p "Introduces whitespace into layouts. Typically placed between the children of a v-box or h-box."]
+                                      [p "The whitespace added will be in the expected direction (i.e. horizontally for h-box or vertically for v-box)."]
                                       [args-table gap-args-desc]]]
                           [v-box
                            :children [[title2 "Demo #1"]
@@ -59,7 +59,7 @@
                                        {:style {:width "40em"}}
                                        "[h-box               ; <-- no :gap, so children seperated by 0px
  :children [[grey-box]
-            [gap :size \"10px\"]  ; <-- abolsolute gap
+            [gap :size \"10px\"]  ; <-- absolute gap
             [grey-box]        ; <-- pushed as far left as possible
             [gap :size \"1\"]   ; <-- grows as much as possible
             [grey-box]]]      ; <-- pushed as far right as possible"]


add bindings when processing report

add bindings when processing report

--- src/shuppet/core.clj
+++ src/shuppet/core.clj
@@ -65,10 +65,10 @@
   ((set (split (env :service-tooling-applications) #",")) name))

 (defn- process-report [report environment]
-  (doall
-   (map #(when (= :CreateLoadBalancer (:action %))
-           (sqs/announce-elb (:elb-name %) environment))
-        report))
+  (with-ent-bindings environment
+    (doseq [item report]
+      (when (= :CreateLoadBalancer (:action item))
+        (sqs/announce-elb (:elb-name item) environment))))
   report)

 (defn- *apply-config


Fix sneaky parens caught by humane-test-output

--- test/datascript/test/entity.cljc
+++ test/datascript/test/entity.cljc
@@ -29,7 +29,7 @@
     (is (= (into {} (d/entity db 2))
            {:name "Ivan", :sex "male", :aka #{"Z"}}))

-    (is (= (pr-str (d/entity db 1) "{:db/id 1}")))
+    (is (= (pr-str (d/entity db 1)) "{:db/id 1}"))
     (is (= (pr-str (let [e (d/entity db 1)] (:unknown e) e)) "{:db/id 1}"))
     ;; read back in to account for unordered-ness
     (is (= (edn/read-string (pr-str (let [e (d/entity db 1)] (:name e) e)))


CMR-5628 Updtes libraries to fix build

CMR-5628 Updtes libraries to fix build

--- cmr-exchange/service-bridge/project.clj
+++ cmr-exchange/service-bridge/project.clj
@@ -37,8 +37,8 @@
                  [gov.nasa.earthdata/cmr-sizing-plugin "0.3.4-SNAPSHOT"]
                  [http-kit "2.3.0"]
                  [markdown-clj "1.10.0"]
-                 [metosin/reitit-core "0.3.7"]
-                 [metosin/reitit-ring "0.3.7"]
+                 [metosin/reitit-core "0.3.9"]
+                 [metosin/reitit-ring "0.3.9"]
                  [metosin/ring-http-response "0.9.1"]
                  [org.clojure/clojure "1.10.1"]
                  [org.clojure/core.async "0.4.500"]


cleanup

cleanup

--- src/selmer/tags.clj
+++ src/selmer/tags.clj
@@ -62,14 +62,6 @@
     "false" false
     false   false
     true))
-
-(def if-operators
-  {"==" =
-   "!=" not=
-   "<" <
-   ">" >
-   "<=" <=
-   ">=" >=})

 (defn if-handler [[condition1 condition2] tag-content render rdr]
   " Handler of if-condition tags. Expects conditions, enclosed


Add Fedora-style key for SNC to known-hosts


texture too wide for mobile chipsets

texture too wide for mobile chipsets

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -68,7 +68,7 @@
                                     ))
 (defonce scroll-text
   (font/make-text "100 24px Indie Flower"
-                  ". .. ... Old School Demo on a New School platform??! This is Crispin, here, paying homage to the 8-bit and 16-bit wonderboxes of our childhoods. Commodore lives! All music, graphics and code in this homage by me! This will eventually be the index page for my game jam submissions. \"Alien Forest Explorer\" from Global Game Jam 2015, and \"Marty Funk\" and \"Monster Simulator?\" from Ludum Dare 32 and 33. These HTML5 games were all developed with free and open source software on a linux platform. I use pixi.js as the underlying framework but target it through infinitelives.pixi using clojurescript. If you haven't tried clojure or clojurescript you should definitely try them. This of course wouldn't have been possible without the work of so many other amazing people. Those involved in the creation of clojure and clojurescript, in pixi.js and in the many tools I use, like grafx2, OpenMPT and sfxr. A big shout out to Team Farnarkle and to the Inversion crew. Best wishes to everyone out there and enjoy the games! ...  .. .\n"))
+                  "Old School Demo on a New School platform??! Crispin, here, paying homage to the 8-bit and 16-bit wonderboxes of our childhood. Commodore lives! A big shout out to Team Farnarkle and to the Inversion crew. Best wishes to everyone out there and enjoy the games!\n"))

 ;;
 ;; font preloader channel


louder music

louder music

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -169,7 +169,7 @@
     (<! render!)

     (go (let [tune (<! (sound/load-sound "/sfx/splash-screen.ogg"))
-              [source gain] (sound/play-sound tune 0.4 true)
+              [source gain] (sound/play-sound tune 0.7 true)
               ])
         )


tidy up imports refactor test function name

--- src/crison/main.clj
+++ src/crison/main.clj
@@ -5,7 +5,6 @@
             [clj-time.local :as l]
             [environ.core :refer [env]]
             [clojure.test :refer :all]
-            ;[taoensso.truss :as truss :refer (have have! have?)]
             [webdriver.core :as wc]
             [webdriver.form :as wf])
   (:gen-class))
@@ -74,7 +73,7 @@
   ;(clojure.java.io/delete-file screenshot-file)
   )

-(deftest counselling
+(deftest tests
   (wc/resize driver {:width 1024 :height 800})
   (let [tests (read-string (slurp "resources/counselling-directory.edn"))]
     (doseq [x tests] (decode x))


Implement event broadcast from worker

Implement event broadcast from worker

--- src/worker/core.clj
+++ src/worker/core.clj
@@ -2,13 +2,22 @@
   (:gen-class)
   (:require [langohr.core :as rmq]
             [langohr.channel :as lch]
+            [langohr.exchange :as le]
             [langohr.queue :as lq]
             [langohr.basic :as lb]
             [langohr.consumers :as lc]
             [clojure.string :as s]
             [clojure.data.json :as json]))

-(def job-queue "jobs")
+(def jobs-q "jobs")
+(def events-x "events")
+
+(defn generate-id
+  "Generates random id"
+  []
+  (apply str (take 16 (repeatedly #(char (+ (rand 26) 65))))))
+
+(def worker-id (generate-id))

 (defn simulate-computation
   "Simulates a long-running CPU-intensive computation.
@@ -17,16 +26,27 @@
   (Thread/sleep 5)
   (s/reverse input))

+(defn emit-event
+  "Publishes a message to the events exchange"
+  [ch msg]
+  (->> msg
+       json/write-str
+       (lb/publish ch events-x "")))
+
 (defn handle-job
   "Handles job"
   [{:keys [input] :as job} ch delivery-tag]
-  (assoc job :result (simulate-computation input))
-  (lb/ack ch delivery-tag))
+  (let [result (conj job {:type "result"
+             :workerId worker-id
+             :result (simulate-computation input)})]
+    (lb/ack ch delivery-tag)
+    (emit-event ch result)))

 (defn print-job-info
   "Prints info"
   [{:keys [input jobId serverId clientId]}]
-  (println "Job received" "input:" input "jobId:" jobId "client:" clientId "server:" serverId))
+  (println "Job received" "input:" input "jobId:" jobId
+           "client:" clientId "server:" serverId))

 (defn to-json
   "Converts raw message payload to json"
@@ -46,7 +66,8 @@
   [& args]
   (with-open [conn (rmq/connect)]
     (let [ch (lch/open conn)]
-      (lq/declare ch job-queue {:durable true :auto-delete false})
+      (lq/declare ch jobs-q {:durable true :auto-delete false})
+      (le/fanout ch events-x {:durable false :auto-delete false})
       (lb/qos ch 1)
-      (println "Worker up. Waiting for jobs")
-      (lc/blocking-subscribe ch job-queue on-message))))
+      (println "Worker" worker-id "Waiting for jobs")
+      (lc/blocking-subscribe ch jobs-q on-message))))


Reorder code structure

Reorder code structure

* put app configuration at the beginning of the file
* put DB init at the end of file before starting the web server


Removed some cruft

Removed some cruft

--- src/polismath/conversation.clj
+++ src/polismath/conversation.clj
@@ -144,23 +144,6 @@

-
-
-(def unused-conv-targets
-  (merge
-   small-conv-update-graph
-   {
-    :repness     ; NOTE - repness is calculated on the client
-          (plmb/fnk [rating-mat group-clusters base-clusters]
-            (sort-by :id
-             (if (> (count group-clusters) 1)
-               (conv-repness
-                rating-mat
-                group-clusters
-                base-clusters))))
-    }))
-
-
 (defn partial-pca
   [mat pca indices & {:keys [n-comps iters learning-rate]
                       :or {n-comps 2 iters 10 learning-rate 0.01}}]


Changed defconstrainedtype constructor from `new-Foo` to `->Foo`

--- src/trammel/core.clj
+++ src/trammel/core.clj
@@ -273,7 +273,7 @@
   [name slots invariants & etc]
   (let [fields       (vec slots)
         ctor-name    (symbol (str name \.))
-        factory-name (symbol (str "new-" name))]
+        factory-name (symbol (str "->" name))]
     `(do
        (let [t# (deftype ~name ~fields ~@etc)]
          (defn ~(symbol (str name \?)) [r#]


Remove obsolete code path

Remove obsolete code path

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -187,6 +187,7 @@
 (def cached-wrapper (util/memoize-1 get-wrapper))

 (defn fn-to-class [f]
+  (assert (ifn? f) (str "Expected a function, not " (pr-str f)))
   (let [spec (meta f)
         withrender (assoc spec :component-function f)
         res (comp/create-class withrender)
@@ -200,9 +201,7 @@
     (let [cached-class (util/cached-react-class tag)]
       (if-not (nil? cached-class)
         cached-class
-        (if (.' js/React isValidElement tag)
-          (util/cache-react-class tag (wrap-component tag nil nil))
-          (fn-to-class tag))))))
+        (fn-to-class tag)))))

 (def cached-parse (util/memoize-1 parse-tag))


Allow for multiple keyword filters in for tag (#155)

--- src/selmer/tags.clj
+++ src/selmer/tags.clj
@@ -30,7 +30,10 @@

 (defn apply-filters [item filters context-map items]
   (reduce
-    (fn [value filter] (filter (assoc context-map items value)))
+    (fn [value filter]
+      (filter (assoc context-map
+                     (keyword items) value
+                     (name items) value)))
     item filters))

 (defn for-handler [args tag-content render rdr]


remove old comment

remove old comment

--- src/gangway/web.clj
+++ src/gangway/web.clj
@@ -14,7 +14,6 @@
   :post! (fn incoming!- [ctx]
           (let [rp (get-in ctx [:request :route-params])
                 qid (keyword (:qid rp))]
-            ;; TODO: assert in datomic to (1) have a complete queue log and (2) ensure idempotency
             (gw-publish/publish! qid (slurp (get-in ctx [:request :body]))))))

 (defresource hi-there


Added selector and transform for a user's name in the template as the heading of the user menu.

--- src/timber/core.clj
+++ src/timber/core.clj
@@ -27,6 +27,7 @@
   select/js-asset (asset/transform-script-src asset-uri-path)
   select/main-menu (html/content main-menu)
   select/user-menu (html/content user-menu)
+  select/user-name (html/content user-name)
   select/content (html/content page-content)

   select/link-template nil


Fixed resolve-uri docstrings

Fixed resolve-uri docstrings

--- src/hiccup/core.clj
+++ src/hiccup/core.clj
@@ -294,12 +294,14 @@
 (def *base-url* nil)

 (defmacro with-base-url
-  "Add a base-url that will be added to the output of the uri function."
+  "Add a base-url that will be added to the output of the resolve-uri function."
   [base-url & body]
   `(binding [*base-url* ~(str base-url "/")]
      ~@body))

 (defn resolve-uri
+  "If a base-url is set, returns a URL relative to the base. Otherwise, returns
+  the URL as-is."
   [uri]
   (if *base-url*
     (str (.resolve (URI. *base-url*) uri))


Oops, noise

Oops, noise

--- src/icecap/core.clj
+++ src/icecap/core.clj
@@ -25,4 +25,3 @@
   "Run the (development) server."
   [& args]
   (run))
-f


Refactor media ns with proper storage initialization.

--- src/uxbox/media.clj
+++ src/uxbox/media.clj
@@ -11,24 +11,17 @@
             [cuerdas.core :as str]
             [storages.core :as st]
             [storages.fs :refer (filesystem)]
-            [storages.misc :refer (hashed prefixed)]
+            [storages.misc :refer (hashed scoped)]
             [uxbox.config :refer (config)]))

-(defn- initialize-images-storage
-  [{:keys [basedir baseuri] :as config} prefix]
-  (-> (filesystem {:basedir basedir
-                   :baseuri baseuri})
-      (prefixed prefix)
-      (hashed)))
-
-(defn- initialize-thumbnails-storage
-  [{:keys [basedir baseuri] :as config} prefix]
-  (-> (filesystem {:basedir basedir
-                   :baseuri baseuri})
-      (prefixed prefix)))
+(defstate storage
+  :start (let [{:keys [basedir baseuri]} (:storage config)]
+           (filesystem {:basedir basedir :baseuri baseuri})))

 (defstate images-storage
-  :start (initialize-images-storage (:storage config) "images"))
+  :start (-> storage
+             (scoped "images")
+             (hashed)))

 (defstate thumbnails-storage
-  :start (initialize-thumbnails-storage (:storage config) "thumbnails"))
+  :start (scoped storage "thumbs"))


spec voke.input

spec voke.input

--- src/voke/input.cljs
+++ src/voke/input.cljs
@@ -1,16 +1,14 @@
 (ns voke.input
   (:require [cljs.spec :as s]
-            [clojure.set :refer [intersection difference]]
+            [clojure.set :refer [intersection difference subset?]]
             [clojure.string :refer [starts-with?]]
             [cljs.core.async :refer [chan <! put!]]
             [goog.events :as events]
             [plumbing.core :refer [safe-get-in]]
-            [voke.schemas :refer [Direction Entity IntendedDirection]]
             [voke.state :refer [update-entity!]]
             [voke.util :refer [in?]])
   (:import [goog.events KeyCodes])
-  (:require-macros [cljs.core.async.macros :refer [go-loop]]
-                   [schema.core :as sm]))
+  (:require-macros [cljs.core.async.macros :refer [go-loop]]))

 (def move-key-mappings {KeyCodes.W     :up
                         KeyCodes.A     :left
@@ -54,10 +52,10 @@
                                :left  Math/PI
                                :right 0})

-(sm/defn remove-conflicting-directions :- [IntendedDirection]
+(defn remove-conflicting-directions
   "Takes a seq of directions like #{:up :down :left} and returns a seq of directions
   where the pairs of conflicting directions - up+down, left+right - are stripped out if they're present."
-  [directions :- [IntendedDirection]]
+  [directions]
   (reduce (fn [directions conflicting-pair]
             (if (= (intersection directions conflicting-pair)
                    conflicting-pair)
@@ -66,37 +64,63 @@
           directions
           [#{:up :down} #{:left :right}]))

-(sm/defn human-controlled-entity-movement-directions
-  [entity :- Entity]
+(s/fdef remove-conflicting-directions
+  :args (s/cat :directions (s/coll-of :input/intended-direction))
+  :ret (s/coll-of :input/intended-direction)
+  :fn #(subset? (-> % :args :directions)
+                (% :ret)))
+
+(defn human-controlled-entity-movement-directions
+  [entity]
   (-> entity
-      (safe-get-in [:input :intended-move-direction])
+      (safe-get-in [:component/input :input/intended-move-direction])
       remove-conflicting-directions))

-(sm/defn intended-directions->angle :- Direction
-  [intended-directions :- [IntendedDirection]]
+(s/fdef human-controlled-entity-movement-directions
+  :args (s/and (s/cat :entity :entity/entity)
+               #(contains? (% :entity) :component/input))
+  :ret (s/coll-of :input/intended-direction))
+
+(defn intended-directions->angle
+  [intended-directions]
   (let [intended-direction-values (map direction-value-mappings intended-directions)]
     (Math/atan2 (apply + (map Math/sin intended-direction-values))
                 (apply + (map Math/cos intended-direction-values)))))

-(sm/defn update-move-direction :- Entity
-  [entity :- Entity]
+(s/fdef intended-directions->angle
+  :args (s/cat :intended-directions (s/coll-of :input/intended-direction))
+  :ret :geometry/direction)
+
+(defn update-move-direction
+  [entity]
   (let [intended-directions (human-controlled-entity-movement-directions entity)]
     (if (seq intended-directions)
       (assoc-in entity
-                [:motion :direction]
+                [:component/motion :motion/direction]
                 (intended-directions->angle intended-directions))
+      ; xxxx TODO come back and make sure i understand the semantics of :motion :direction being nil
       (assoc-in entity
-                [:motion :direction]
+                [:component/motion :motion/direction]
                 nil))))

-(sm/defn update-fire-direction :- Entity
-  [entity :- Entity]
-  (let [intended-direction (last (get-in entity [:input :intended-fire-direction]))]
+(s/fdef update-move-direction
+  :args (s/and (s/cat :entity :entity/entity)
+               #(contains? (% :entity) :component/input))
+  :ret :entity/entity)
+
+(defn update-fire-direction
+  [entity]
+  (let [intended-direction (last (get-in entity [:component/input :input/intended-fire-direction]))]
     (if intended-direction
       (assoc-in entity
-                [:weapon :fire-direction]
+                [:component/weapon :weapon/fire-direction]
                 (intended-directions->angle [intended-direction]))
-      (assoc-in entity [:weapon :fire-direction] nil))))
+      (assoc-in entity [:component/weapon :weapon/fire-direction] nil))))
+
+(s/fdef update-fire-direction
+  :args (s/and (s/cat :entity :entity/entity)
+               #(contains? (% :entity) :component/input))
+  :ret :entity/entity)

 ;;; Public

@@ -115,14 +139,14 @@

           (let [direction (msg :direction)
                 update-entity-args (case (msg :type)
-                                     :move-key-down [[:input :intended-move-direction] conj direction]
-                                     :move-key-up [[:input :intended-move-direction] disj direction]
-                                     :fire-key-down [[:input :intended-fire-direction]
+                                     :move-key-down [[:component/input :input/intended-move-direction] conj direction]
+                                     :move-key-up [[:component/input :input/intended-move-direction] disj direction]
+                                     :fire-key-down [[:component/input :input/intended-fire-direction]
                                                      (fn [fire-directions]
                                                        (if (in? fire-directions direction)
                                                          fire-directions
                                                          (conj fire-directions direction)))]
-                                     :fire-key-up [[:input :intended-fire-direction]
+                                     :fire-key-up [[:component/input :input/intended-fire-direction]
                                                    (fn [fire-directions]
                                                      (filterv #(not= direction %) fire-directions))])]


we're not using this

we're not using this


don't draw login button on mobile

don't draw login button on mobile

--- src-cljs/frontend/components/drawing.cljs
+++ src-cljs/frontend/components/drawing.cljs
@@ -224,7 +224,8 @@
     (did-mount [_]
       ;; TODO: would be nice to get this a different way :(
       (let [vw (.-width (goog.style/getSize (goog.dom/getElement "svg-canvas")))]
-        (run-animation owner (signup-animation document vw))))
+        (when (< 640 vw) ;; only if not on mobile
+          (run-animation owner (signup-animation document vw)))))
     om/IWillUnmount
     (will-unmount [_]
       (cleanup owner))


WIP better handling of state transitions.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -143,53 +143,71 @@
         :headers {"Accept" "application/edn"}
         :response-format :text}))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Property Details Helpers
 (defn flatten-device [device]
-  (println "Flattening: " device)
-  (let [device-keys (->> device keys (remove #(= % :readings)))
-            parent-device (select-keys device device-keys)
-            readings (:readings device)]
-        (map #(assoc % :parent-device parent-device) readings)))
+  (let [device-keys   (->> device keys (remove #(= % :readings)))
+        parent-device (select-keys device device-keys)
+        readings      (:readings device)]
+    (map #(assoc % :parent-device parent-device) readings)))

 (defn extract-sensors [devices]
-  (println "Devices to extract sensors from: " devices)
-  (let [sensors (vec (mapcat flatten-device devices))]
-    (println "Flattened sensors: " sensors)
-    sensors))
+  (vec (mapcat flatten-device devices)))
+
+(defn get-property-details [selected-property-id data]
+  (->>  data
+        :properties
+        :data
+        (filter #(= (:id %) selected-property-id))
+        first))
+
+(defn get-sensors [selected-property-id data]
+  (if selected-property-id
+    (if-let [property-details (get-property-details selected-property-id data)]
+      (extract-sensors (:devices property-details))
+      [])
+    []))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; History loop - this drives the fetches and clear downs
 (defn history-loop [history-channel data]
   (go-loop []
     (let [nav-event (<! history-channel)
-          {:keys [programmes projects properties]} (-> nav-event :args :ids)
+          history-status (-> nav-event :args :ids)
+          {:keys [programmes projects properties sensors]} history-status
           old-nav (:active-components @data)
           old-programmes (:programmes old-nav)
           old-projects (:projects old-nav)
           old-properties (:properties old-nav)]
       (println "Old Programmes: " old-programmes " Old Projects: " old-projects " Old Properties: " old-properties)
       (println "New Programmes: " programmes " New Projects: " projects " New Properties: " properties)
-      (println "New Active Components: " (-> nav-event :args :ids))

       ;; Clear down
       (when (or (nil? programmes)
                 (empty? (-> @data :programmes :data)))
         (println "Clearing projects.")
+        (om/update! data [:programmes :selected] nil)
         (om/update! data [:projects :data] [])
         (om/update! data [:projects :programme_id] nil)
         (fetch-programmes data))

       (when-not projects
         (println "Clearing properties.")
+        (om/update! data [:projects :selected] nil)
         (om/update! data [:properties :data] [])
         (om/update! data [:properties :project_id] nil))

       (when-not properties
         (println "Clearing devices, sensors and measurements.")
+        (om/update! data [:properties :selected] nil)
         (om/update! data [:property-details :data] {})
         (om/update! data [:property-details :property_id] nil)
         (om/update! data [:devices :data] [])
         (om/update! data [:sensors :data] [])
         (om/update! data [:measurements :data] []))
+
+      (when-not sensors
+        (om/update! data [:sensors :selected] nil))

       (when (and (not= programmes old-programmes)
                  programmes)
@@ -205,24 +223,16 @@
         (om/update! data [:properties :project_id] projects)
         (fetch-properties projects data))

-      ;; property handling is special as it gets a tree of data
       (when (and (not= properties old-properties)
                  properties)
         (println "Setting property details to: " properties)
-        (om/update! data [:properties :selected] properties)
-        (om/update! data [:property-details :property_id] properties)
-        ;; Handle flattened sensors
-        (let [property-details (->> @data
-                                    :properties
-                                    :data
-                                    (filter #(= (:id %) properties))
-                                    first)
-              devices (get property-details :devices [])]
-          (om/update! data [:property-details :data] property-details)
-          (om/update! data [:sensors :data] (extract-sensors devices))))
+        (om/update! data [:properties :selected] properties))
+
+      (when sensors
+        (om/update! data [:sensors :selected] sensors))

       ;; Update the new active components
-      (om/update! data :active-components (-> nav-event :args :ids)))
+      (om/update! data :active-components history-status))
     (recur)))

 (defn selected-range-change
@@ -496,17 +506,18 @@
   (reify
     om/IRender
     (render [_]
-      (let [sensors (:sensors data)
-            chart   (:chart data)
-            history (om/get-shared owner :history)
-            table-id "sensors-table"]
-
+      (let [sensors              (:sensors data)
+            selected-property-id (-> data :active-components :properties)
+            flattened-sensors    (get-sensors selected-property-id data)
+            chart                (:chart data)
+            history              (om/get-shared owner :history)
+            table-id             "sensors-table"]
         (html
          [:table {:className "table table-hover"}
           [:thead
            [:tr [:th "Type"] [:th "Unit"] [:th "Period"] [:th "Device"] [:th "Status"]]]
           [:tbody
-           (for [row (sort-by :type (-> sensors :data))]
+           (for [row (sort-by :type flattened-sensors)]
              (let [{:keys [device_id type unit period status]} row
                    id (str type "-" device_id)]
                [:tr {:onClick (fn [_ _]
@@ -582,9 +593,11 @@
   (reify
     om/IRender
     (render [_]
-      (let [property-details (-> data :property-details :data)
-            property_data (:property_data property-details)]
-        (html [:div {:class (str "col-md-12" (if (:property_id (:property-details data)) "" " hidden"))}
+      (let [selected-property-id (-> data :active-components :properties)
+            properties           (-> data :properties :data)
+            property-details     (get-property-details selected-property-id properties)
+            property_data        (:property_data property-details)]
+        (html [:div {:class (str "col-md-12" (if selected-property-id "" " hidden"))}
                [:h2 "Property Details"]
                (bs/panel
                 (:slug property-details)


Derive figwheel websocket url from document location

--- env/dev/cljs/gorilla_repl/dev.cljs
+++ env/dev/cljs/gorilla_repl/dev.cljs
@@ -2,8 +2,10 @@
   (:require [gorilla-repl.core :as core]
             [figwheel.client :as figwheel :include-macros true]
             [devtools.core :as devtools]
+            [clojure.string :refer [replace]]
             ;; [dirac.runtime]
-            [re-frisk.core :refer [enable-re-frisk!]]))
+            [re-frisk.core :refer [enable-re-frisk!]])
+  )

 (devtools/install!)
 ;; (dirac.runtime/install!)
@@ -12,7 +14,8 @@
 (enable-console-print!)

 (figwheel/watch-and-reload
-  :websocket-url "ws://localhost:3449/figwheel-ws"
+  :websocket-url (str (replace (.. js/document -location -origin) "http" "ws")
+                      "/figwheel-ws")
   :jsload-callback core/mount-root)

 (core/init!)


Adds Java interop and changes remove to checking set

--- 06-code-golf/tf-06.clj
+++ 06-code-golf/tf-06.clj
@@ -1,11 +1,9 @@
 ":";exec java -cp "$HOME/.m2/repository/org/clojure/clojure/1.5.1/clojure-1.5.1.jar" clojure.main $0 $*
-
-(require '[clojure.string :as s])

 (doseq [c (take 25
             (sort-by val >
               (frequencies
                 (remove
-                  #(some (partial = %) (s/split (slurp "../stop_words.txt") #","))
-                  (re-seq #"[a-z]{2,}" (s/lower-case (slurp (first *command-line-args*))))))))]
+                  #(contains? (set (.split (slurp "../stop_words.txt") ",")) %)
+                  (re-seq #"[a-z]{2,}" (.toLowerCase (slurp (first *command-line-args*))))))))]
   (printf "%s - %d\n" (first c) (nth c 1)))


Extract with-out-str-and-result

Extract with-out-str-and-result

--- test/desdemona/cli_test.clj
+++ test/desdemona/cli_test.clj
@@ -22,6 +22,13 @@
   [status]
   [::exited status])

+(defmacro with-out-str-and-result
+  [& body]
+  `(let [stdout# (StringWriter.)]
+     (binding [*out* stdout#]
+       (let [result# (do ~@body)]
+         [result# (str stdout#)]))))
+
 (defmacro with-fake-launcher-side-effects
   "Runs body with a fake exit, block-forever! and stdout.

@@ -34,10 +41,7 @@
   [& body]
   `(with-redefs [com.gfredericks.system-slash-exit/exit fake-exit
                  desdemona.launcher.utils/block-forever! fake-block-forever!]
-     (let [stdout# (StringWriter.)]
-       (binding [*out* stdout#]
-         (let [result# (do ~@body)]
-           [result# (str stdout#)])))))
+     (with-out-str-and-result ~@body)))

 (def ^:private usage-lines
   ["Usage:"


Minor bugfix.

Minor bugfix.

--- src/appengine_magic/services/memcache.clj
+++ src/appengine_magic/services/memcache.clj
@@ -61,7 +61,7 @@
   (let [service (get-memcache-service :namespace namespace)]
     (if millis-no-readd
         (if (sequential? key-or-keys)
-            (.deletAll service key-or-keys millis-no-readd)
+            (.deleteAll service key-or-keys millis-no-readd)
             (.delete service key-or-keys millis-no-readd))
         (if (sequential? key-or-keys)
             (.deleteAll service key-or-keys)


Fix requirements and test arguments

Fix requirements and test arguments

--- test/riemann/xymon_test.clj
+++ test/riemann/xymon_test.clj
@@ -7,7 +7,7 @@
 (logging/init)

 (deftest ^:xymon ^:integration xymon-test
-         (let [k (xymon)]
+         (let [k (xymon nil)]
            (k {:host "riemann.local"
                :service "xymon test"
                :state "green"
@@ -15,14 +15,14 @@
                :metric -2
                :time (unix-time)}))

-         (let [k (xymon)]
+         (let [k (xymon nil)]
            (k {:service "xymon test"
                :state "green"
                :description "all clear, uh, situation normal"
                :metric 3.14159
                :time (unix-time)}))

-         (let [k (xymon)]
+         (let [k (xymon nil)]
            (k {:host "riemann.local"
 	       :service "xymon test"
                :state "ok"
@@ -30,7 +30,7 @@
                :metric 3.14159
                :time (unix-time)}))

-         (let [k (xymon)]
+         (let [k (xymon nil)]
            (k {:host "no-service.riemann.local"
                :state "ok"
                :description "Missing service, not transmitted"


Focus tab on notification click

Focus tab on notification click

--- src-cljs/frontend/notifications.cljs
+++ src-cljs/frontend/notifications.cljs
@@ -14,6 +14,10 @@
        (.requestPermission)
        (.then callback))))

+(defn notification-on-click [event]
+  (.preventDefault event)
+  (.focus js/window))
+
 ;; Some notes about properties
 ;; - The title should be 32 characters MAX, note that if using system default,
 ;;   only 22 chars are visible on hover (because of resulting UI), so keep
@@ -23,11 +27,15 @@
 (defn notify [title properties]
   (when (and (notifications-granted?)
              (ld/feature-on? "web-notifications"))
-    (new js/Notification
-         title
-         (clj->js (merge
-                    properties
-                    {:lang "en"})))))
+    (set!
+      (.-onclick
+        (new js/Notification
+             title
+             (clj->js (merge
+                        properties
+                        {:lang "en"}))))
+      ;; TODO Maybe this should be a setting in the Web Notifications panel?
+      notification-on-click)))

 (defn status-icon-path [status-name]
   (utils/cdn-path (str "/img/email/"status-name"/icon@3x.png")))


Make notify more readable

Make notify more readable

--- src-cljs/frontend/notifications.cljs
+++ src-cljs/frontend/notifications.cljs
@@ -15,10 +15,6 @@
        (.requestPermission)
        (.then callback))))

-(defn notification-on-click [event]
-  (.preventDefault event)
-  (.focus js/window))
-
 ;; Some notes about properties
 ;; - The title should be 32 characters MAX, note that if using system default,
 ;;   only 22 chars are visible on hover (because of resulting UI), so keep
@@ -28,14 +24,18 @@
 (defn notify [title properties]
   (when (and (notifications-granted?)
              (ld/feature-on? "web-notifications"))
-    (-> (new js/Notification
-             title
-             (clj->js (merge
-                        properties
-                        {:lang "en"})))
-        (goog.events/listen
-          "click"
-          notification-on-click))))
+    (let [new-notification (js/Notification.
+                             title
+                             (clj->js (assoc
+                                        properties
+                                        :lang "en")))]
+      (goog.events/listen
+        new-notification
+        "click"
+        (fn [event]
+          (.preventDefault event)
+          (.focus js/window)
+          (.. event -target close))))))

 (defn status-icon-path [status-name]
   (utils/cdn-path (str "/img/email/"status-name"/icon@3x.png")))


Solved 5.16 - Chapter 5: COMPLETED :)

Solved 5.16 - Chapter 5: COMPLETED :)

--- src/fpinscala/strictness_and_laziness.clj
+++ src/fpinscala/strictness_and_laziness.clj
@@ -378,4 +378,29 @@
 (defn has-subsequence
   "Translation of hasSubsequence after exercise 5.15"
   [s sub]
-  (exists #(do (println %) (starts-with-fpins % sub)) (tails s)))+  (exists #(do (println %) (starts-with-fpins % sub)) (tails s)))
+
+;5.16
+;mine
+(defn scan-right
+  "scanRight from FPINS"
+  [z f s]
+  (fold-right (list z)
+              #(cons (fold-right z f %) %2)
+              (tails s)))
+;well I was on good track and knew that unfold won't work
+;as it generates left -> right :)
+;however, my solution although works, it is not "single-pass" so, it is not efficient
+;fpins
+(defn scan-right-fpins
+  "scanRight from FPINS - FPINS solution translation :)"
+  [z f s]
+  (second (fold-right [z (stream-cons z '())]
+              #(let [[x1 x2] %2 b (f % x1)]
+                [b (cons b x2)])
+              s)))
+;note though that given Clojure does not support lazy arg evaluation
+;and I don't know how to mimic them, translation is not necessary lazy
+;as fpins is
+
+;By this, Chapter 5 is completed :)


Include api badge

Include api badge

--- frontend/src/cruncher/views.cljs
+++ frontend/src/cruncher/views.cljs
@@ -7,6 +7,7 @@
             [cruncher.communication.main :as com]
             [cruncher.communication.progress :as progress]
             [cruncher.selections :as selections]
+            [cruncher.utils.status :as status]
             [cruncher.shredder.main :as shredder]
             [cruncher.utils.extensions]
             [cruncher.utils.lib :as lib]
@@ -165,6 +166,8 @@
                       (dom/div #js {:className "pull-right"}
                                (vlib/login-indicator (om/props this)))
                       (dom/h1 nil "Poké-Cruncher"))
+             (dom/div #js {:className "pull-right"}
+                      (dom/div nil (status/api-connected-badge {})))
              (dom/ul nil
                      (dom/li nil
                              "If you have 2-factor Auth enabled in your Google Account, please add an "


[hotfix] Remove redundant keyword conversion when validating CLI args

--- flink-jepsen/src/jepsen/flink/flink.clj
+++ flink-jepsen/src/jepsen/flink/flink.clj
@@ -126,13 +126,13 @@
                                                   (keys-as-allowed-values-help-text fn/nemesis-generator-factories))
                      :parse-fn keyword
                      :default :kill-task-managers
-                     :validate [#(fn/nemesis-generator-factories (keyword %))
+                     :validate [#(fn/nemesis-generator-factories %)
                                 (keys-as-allowed-values-help-text fn/nemesis-generator-factories)]]
                     [nil "--client-gen GEN" (str "Which client should be used?"
                                                  (keys-as-allowed-values-help-text client-gens))
                      :parse-fn keyword
                      :default :poll-job-running
-                     :validate [#(client-gens (keyword %))
+                     :validate [#(client-gens %)
                                 (keys-as-allowed-values-help-text client-gens)]]
                     [nil "--job-running-healthy-threshold TIMES" "Number of consecutive times the job must be running to be considered healthy."
                      :default 5


NEED REFACTORING T_T;;

NEED REFACTORING T_T;;

--- src/jjamppong/window/highlight_window.clj
+++ src/jjamppong/window/highlight_window.clj
@@ -41,7 +41,7 @@
 (defonce +ONCE+ (javafx.embed.swing.JFXPanel.))

 (definterface ItmHighlightFX
-  (update [item])
+  (update1 [item])
   (^{:tag void} on_check [^javafx.event.ActionEvent event])
   )

@@ -54,13 +54,14 @@
   javafx.fxml.Initializable
   (^{:tag void}
    initialize [self, ^URL fxmlFileLocation, ^ResourceBundle resources]
-   (println "===================================")
    )
+
   ItmHighlightFX
-  (update [this item]
+  (update1 [this item]
     (set! _item item)
     (.setSelected check_example (@item :is-selected))
     (.setText lbl_filter_string (str item)))
+
   (^{:tag void} on_check [this ^javafx.event.ActionEvent event]
    (swap! _item assoc :is-selected (.isSelected check_example))))

@@ -73,28 +74,25 @@
   (defn gen-cellfactory []
     (reify javafx.util.Callback
       (call [_ param]
-        (println "TTTT" [_ param])
         (proxy [javafx.scene.control.ListCell] []
-
           (updateItem [item is-empty]
             (proxy-super updateItem item is-empty)
             (if (or is-empty (nil? item))
               (.setGraphic this nil)
-              (if (or (nil? (.getGraphic this)))
-                (let [
-                      controller (gen-NodeController)
-                      loader (doto (FXMLLoader. fxml)
-                               (.setController controller))
-
-                      node (.load loader)]
-                  (.. this (setGraphic node))
-                  (println "XX1 " [item is-empty])
-                  (.. controller (update item))
-                  (println "XX2")
-                  (println "init")
-                  )
-                (println "FFFFFFFF")
-                ))))))))
+              (do
+                (when (nil? (.getUserData this))
+                  ;; (println "BBB:" (bean this))
+                  (.setUserData this 1)
+                  (let [controller (gen-NodeController)
+                        loader (doto (FXMLLoader. fxml)
+                                 (.setController controller))
+                        node (.load loader)]
+                    (.setUserData this {:node node :controller controller})))
+                (when (nil? (.getGraphic this))
+                  (let [{:keys [node controller]} (.getUserData this)]
+                    (-> this (.setGraphic node))
+                    (.update1 controller item)))))))))))
+

 (defn eeinit-listview [listview items]
@@ -164,8 +162,7 @@
                       getSelectionModel
                       getSelectedItems)]
      (println "[[[]]]" [(count selected) (count items)])
-     (doseq [s selected]
-       (.. items (remove s)))))
+     (.. items (removeAll selected))))

   (^{:tag void} on_btn_up [this ^javafx.event.ActionEvent event]
    (let [selected (.. list_highlight


:globe_with_meridians: FR value of language choice

Signed-off-by: mathieu.brunot <cbb78c9d6ecc8139b4697c3352cc1f1edbdf61d7@monogramm.io>

--- frontend/src/uxbox/main/locales/fr.cljs
+++ frontend/src/uxbox/main/locales/fr.cljs
@@ -120,8 +120,7 @@

    "settings.profile.profile-saved" "Profil enregistré avec succès !"
    "settings.profile.section-basic-data" "Nom, nom d'utilisateur et adresse email"
-   "settings.profile.section-i18n-data" nil ;; TODO
-
+   "settings.profile.section-i18n-data" "Langue par défaut"
    "settings.profile.your-name" "Votre nom complet"
    "settings.profile.your-username" "Votre nom d'utilisateur"
    "settings.profile.your-email" "Votre adresse email"
@@ -169,4 +168,6 @@

    "errors.network" "Impossible de se connecter au serveur principal."
    "errors.generic" "Quelque chose c'est mal passé."
-   "errors.conflict" "Conflit sur la sauvegarde des données, actualisez et réessayez."})
+   "errors.conflict" "Conflit sur la sauvegarde des données, actualisez et réessayez."
+
+})


Move upload buttons

Move upload buttons

--- src/airhead_frontend/components.cljs
+++ src/airhead_frontend/components.cljs
@@ -120,6 +120,26 @@

       error-msg)))

+(defn file-select-button [file-input-ref]
+  [:div.pure-button.pure-u-1-2
+   {:title "Select a file"
+    :on-click #(when @file-input-ref
+                 (.click @file-input-ref))}
+   [:i.fa.fa-folder-open]])
+
+(defn upload-button [form-ref]
+  [:div.pure-button.pure-button.pure-u-1-2
+   {:title "Upload"
+    :on-click #(when-let [form @form-ref]
+                 (let [up-chan      (req/upload! form)
+                       upload-state (r/cursor app-state [:uploads])]
+                   (go-loop []
+                            (when-let [delta (<! up-chan)]
+                              (swap! upload-state merge
+                                     {(hash up-chan) delta})
+                              (recur)))))}
+   [:i.fa.fa-upload]])
+
 (defn upload-section []
   (let [form-ref       (r/atom nil)
         file-input-ref (r/atom nil)]
@@ -134,24 +154,8 @@

        [:div.controller-box
         [:div.pure-button-group
-         [:div.pure-button.pure-u-1-2
-          {:title "Select a file"
-           :on-click #(when @file-input-ref
-                        (.click @file-input-ref))}
-          [:i.fa.fa-folder-open]]
-
-         [:div.pure-button.pure-button.pure-u-1-2
-          {:title "Upload"
-           :on-click #(when @file-input-ref
-                        (when-let [form @form-ref]
-                          (let [up-chan      (req/upload! form)
-                                upload-state (r/cursor app-state [:uploads])]
-                            (go-loop []
-                                     (when-let [delta (<! up-chan)]
-                                       (swap! upload-state merge
-                                              {(hash up-chan) delta})
-                                       (recur))))))}
-          [:i.fa.fa-upload]]]
+         [file-select-button file-input-ref]
+         [upload-button form-ref]]

         [:div
          [:i.fa.fa-file-o]


cleanup the scroll handler and add debounce

--- frontend/components/landing_b.cljs
+++ frontend/components/landing_b.cljs
@@ -22,7 +22,7 @@
                    [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                    [dommy.macros :refer [sel1 node]]))

-(defn mount-header-logo-scroll [owner]
+(defn mount-scroll-handler [owner]
   (let [logo (om/get-node owner "center-logo")
         cta (om/get-node owner "cta")
         nav-bkg (om/get-node owner "nav-bkg")
@@ -30,22 +30,29 @@
         nav-no-bkg (om/get-node owner "nav-no-bkg")
         first-fig-animate (om/get-node owner "first-fig-animate")
         second-fig-animate (om/get-node owner "second-fig-animate")
-        vh (.-height (goog.dom/getViewportSize))
-        scroll-callback #(do
-                           (om/set-state! owner [:header-logo-visible] (neg? (.-bottom (.getBoundingClientRect logo))))
-                           (om/set-state! owner [:header-cta-visible] (neg? (.-bottom (.getBoundingClientRect cta))))
-                           (om/set-state! owner [:header-bkg-visible] (< (.-bottom (.getBoundingClientRect nav-bkg)) 70))
-                           (om/set-state! owner [:header-cta-invisible] (< (.-top (.getBoundingClientRect no-cta)) vh))
-                           (om/set-state! owner [:header-bkg-invisible] (< (.-top (.getBoundingClientRect nav-no-bkg)) 70))
-                           (om/set-state! owner [:first-fig-animate] (< (.-bottom (.getBoundingClientRect first-fig-animate)) vh))
-                           (om/set-state! owner [:second-fig-animate] (< (.-bottom (.getBoundingClientRect second-fig-animate)) vh))
-                           (om/set-state! owner [:header-bkg-scroller] (min (js/Math.abs (.-top (.getBoundingClientRect nav-no-bkg)))
-                                                                            (js/Math.abs (- 70 (.-bottom (.getBoundingClientRect nav-bkg)))))))]
-    (om/set-state! owner [:browser-resize-key]
+        scroll-ch (om/get-state owner [:scroll-ch])
+        scroll-handler #(let [vh (.-height (goog.dom/getViewportSize))
+                              nav-height 70]
+                          ;; we could optimize these, but calculating this is surprisingly fast (less than 10 ms)
+                          (om/set-state! owner [:header-logo-visible] (neg? (.-bottom (.getBoundingClientRect logo))))
+                          (om/set-state! owner [:header-cta-visible] (neg? (.-bottom (.getBoundingClientRect cta))))
+                          (om/set-state! owner [:header-bkg-visible] (< (.-bottom (.getBoundingClientRect nav-bkg)) nav-height))
+                          (om/set-state! owner [:header-cta-invisible] (< (.-top (.getBoundingClientRect no-cta)) vh))
+                          (om/set-state! owner [:header-bkg-invisible] (< (.-top (.getBoundingClientRect nav-no-bkg)) nav-height))
+                          (om/set-state! owner [:first-fig-animate] (< (.-bottom (.getBoundingClientRect first-fig-animate)) vh))
+                          (om/set-state! owner [:second-fig-animate] (< (.-bottom (.getBoundingClientRect second-fig-animate)) vh))
+                          (om/set-state! owner [:header-bkg-scroller] (min (js/Math.abs (.-top (.getBoundingClientRect nav-no-bkg)))
+                                                                           (js/Math.abs (- nav-height (.-bottom (.getBoundingClientRect nav-bkg)))))))]
+    (om/set-state! owner [:scroll-key]
                    (goog.events/listen
                     js/window
                     "scroll"
-                    scroll-callback))))
+                    #(put! scroll-ch %)))
+    (go-loop []
+             (when-let [event (<! scroll-ch)]
+               (utils/swallow-errors (scroll-handler))
+               (recur)))
+    (scroll-handler)))

 (def circle-logo
   [:svg {:xmlns "http://www.w3.org/2000/svg" :x "0px" :y "0px" :viewBox "0 0 393 100" :enableBackground "new 0 0 393 100"}
@@ -165,7 +172,11 @@
   (reify
     om/IDidMount
     (did-mount [_]
-      (mount-header-logo-scroll owner))
+      (mount-scroll-handler owner))
+    om/IWillUnmount
+    (will-unmount [_]
+      (goog.events/unlistenByKey (om/get-state owner [:scroll-key]))
+      (close! (om/get-state owner [:scroll-ch])))
     om/IInitState
     (init-state [_]
       {:header-logo-visible false


cleanup

cleanup

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -13,10 +13,6 @@
   (concat
    nouns/replace-patterns
    verbs/replace-patterns))
-
-(declare analyze)
-(declare get-string)
-(declare suffix-of)

 (defn analyze [surface-form lexicon]
   "Analyze a single surface form into a set of lexical forms."


still try to show threads even if server load failed

since there may be some loaded threads anyway

--- src/braid/ui/views/pages/recent.cljs
+++ src/braid/ui/views/pages/recent.cljs
@@ -26,7 +26,7 @@
                          :messages))
                  reverse)]
         [:div.page.recent
-          [:div.title "Recent"]
-          (if @err
-            [:h2.error "Couldn't load recent threads: " @err]
-            [threads-view {:threads sorted-threads}])]))))
+         [:div.title "Recent"]
+         (when @err
+           [:h2.error "Couldn't load recent threads: " @err])
+         [threads-view {:threads sorted-threads}]]))))


Fix "ATM machine" duplication in docstring

--- src/caesium/magicnonce/secretbox.clj
+++ src/caesium/magicnonce/secretbox.clj
@@ -60,10 +60,11 @@
   "secretbox, with randomized prefix nonce.

   This is useful if you don't have an obvious nonce in your protocol
-  you can use. However, it does rely on having a cryptographically
-  secure CSPRNG available during encryption. It is *not* nonce-misuse
-  resistant. Unless you can't afford the minor performance penalty for
-  a nonce-misuse resistant scheme, consider using [[secretbox-nmr]].
+  you can use. However, it does rely on having cryptographically
+  strong randomness available during encryption. It is *not*
+  nonce-misuse resistant. Unless you can't afford the minor
+  performance penalty for a nonce-misuse resistant scheme, consider
+  using [[secretbox-nmr]].

   To decrypt, use [[decrypt]] or [[open]], depending on which argument
   order you prefer."


Very very very basic exception handling.

--- src/beats_playlist_export/core.clj
+++ src/beats_playlist_export/core.clj
@@ -12,7 +12,7 @@
         d))))

 (defn get-tracks [tracks]
-  (map #(let [track-meta (beats/track-get (:id %))]
+  (map #(let [track-meta (try (beats/track-get (:id %)) (catch Exception e {}))]
           (assoc % :artist (get-in track-meta [:data :artist_display_name])
                    :title (get-in track-meta [:data :title]))) tracks))


fix compile error

fix compile error

--- src/clj/neb/durability/serv/core.clj
+++ src/clj/neb/durability/serv/core.clj
@@ -68,8 +68,9 @@
     (try
       (let [^OutputStream appender @(get-in client [:appenders trunk-id])
             ^OutputStream new-appender (io/output-stream (str base-path trunk-id "-" timestamp ".mlog"))]
-        (a/>! log-reaper [appender -1 timestamp nil])       ;close orignal appender
-        (reset! (get-in client [:appenders trunk-id]) new-appender))
+        (reset! (get-in client [:appenders trunk-id]) new-appender)
+        ;close orignal appender
+        (a/>! log-reaper [appender -1 timestamp nil]))
       (finally
         (.unlock log-switch)))))

@@ -83,5 +84,5 @@

 (defn reape-log [^OutputStream appender act timestamp ^UUID cell-id & [data]]
   (if (neg? act)
-    (close-appender act)
+    (close-appender appender)
     (l/append appender act timestamp cell-id data)))


read log

read log

--- src/clj/neb/durability/serv/logs.clj
+++ src/clj/neb/durability/serv/logs.clj
@@ -15,5 +15,26 @@
       (.write (Ints/toByteArray (count data)))
       (.write data))))

+(defn read-bytes [reader byte-count]
+  (let [^bytes byte-arr (byte-array byte-count)]
+    (.read reader byte-arr)
+    byte-arr))
+
+(defn read-long [reader]
+  (Longs/fromByteArray (read-bytes reader 8)))
+
 (defn read-all-from-log [log-path process-fn]
-  (let [reader (io/input-stream log-path)]))+  (let [reader (io/input-stream log-path)]
+    (while (> (.available reader) 0)
+      (let [act (byte (.read reader))
+            has-body? (zero? act)
+            timestamp (read-long reader)
+            cell-id (UUID. (read-long reader) (read-long reader))
+            body-read? (when has-body? (atom false))
+            body-length (when has-body? (Ints/fromByteArray (read-bytes reader 4)))
+            read-body (when has-body?
+                        (fn []
+                          (reset! body-read? true)
+                          (read-bytes reader body-length)))]
+        (process-fn act timestamp cell-id read-body)
+        (if (and has-body? (not @body-read?)) (.skip reader body-length))))))


Rename `get-nr-days-in-timetable-day` to `timetable-day-get-nr-rows`

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -431,16 +431,16 @@
   (nth (timetable-get-day day) rowNum))

 ; Returns the total number of rows for a given day in the Timetable.
-(defmulti get-nr-rows-in-timetable-day number? :default false)
+(defmulti timetable-day-get-nr-rows number? :default false)

 ; Argument argument is a a 0-indexed integer representing the day, where
 ; 0 = Monday, 1 = Tuesday, until 4 = Friday
-(defmethod get-nr-rows-in-timetable-day true [day]
+(defmethod timetable-day-get-nr-rows true [day]
   [day]
   (count (timetable-get-day day)))

 ; Argument is a Timetable row returned by the `tiemtable-get-day-row` function
-(defmethod get-nr-rows-in-timetable-day false [ttDay]
+(defmethod timetable-day-get-nr-rows false [ttDay]
   (count ttDay))

 (def ^{:doc     "HTML string for the  elements in a
 on the Timetable
@@ -491,7 +491,7 @@
   (.append (nth HTML-Timetable day)
            ($ (str "
" Timetable-Row-TD-HTML-String "
")))
   ; Modify the rowspan of the  in the 0th row in the timetable
-  (let [nrRows (get-nr-rows-in-timetable-day day)
+  (let [nrRows (timetable-day-get-nr-rows day)
         thElem (.find (nth HTML-Timetable day) "tr > th")]
     (attr thElem "rowspan" nrRows)))

@@ -646,7 +646,7 @@
                   (update-in dayPartition [:nonEmptyRows] #(conj %1 rowIdx))))
             {:emptyRows [], :nonEmptyRows []}
             (map vector
-                 (range (get-nr-rows-in-timetable-day ttDay))
+                 (range (timetable-day-get-nr-rows ttDay))
                  ttDay))))

 (defn- create-lesson-div
@@ -682,7 +682,7 @@
                            :bgColorCssClass bgColorCssClass,
                            :isActuallySelected? isActuallySelected?)]
     ; Create new row if necessary
-    (if (= rowNum (get-nr-rows-in-timetable-day day))
+    (if (= rowNum (timetable-day-get-nr-rows day))
         (add-new-row-to-timetable-day! day))

     ; Update in-memory representation of timetable
@@ -1261,7 +1261,7 @@
                                      (range time-helper/TIME-INDEX-MIN
                                             (inc time-helper/TIME-INDEX-MAX))))}
         ; go through each row in the day, below the current row
-        (drop (inc rowNum) (range (get-nr-rows-in-timetable-day day)))))))
+        (drop (inc rowNum) (range (timetable-day-get-nr-rows day)))))))

 (defn- shift-lesson-to-row!
   "Shifts a lesson from its original row up to the given row.
@@ -1357,7 +1357,7 @@
   "Removes empty rows resulting from the removal of lessons on given days."
   [affectedDaysSet]
   (doseq [day affectedDaysSet]
-    (let [nrRows          (get-nr-rows-in-timetable-day day)
+    (let [nrRows          (timetable-day-get-nr-rows day)

           {:keys [emptyRows nonEmptyRows]}
           (timetable-day-get-empty-and-non-empty-rows day)
@@ -1490,7 +1490,7 @@
   []
   (.remove ($ ".lesson"))
   (doseq [day (range 5)]
-    (let [nrRows   (get-nr-rows-in-timetable-day day)
+    (let [nrRows   (timetable-day-get-nr-rows day)
           $dayElem (nth HTML-Timetable day)]
       ; Remove rows >= 2
       (doseq [rowIdx (reverse (range 2 nrRows))]


Reps number input initial exploring implementation

--- src/cljs/movement/pages/session.cljs
+++ src/cljs/movement/pages/session.cljs
@@ -136,75 +136,7 @@
       [:span "Legg ved bilde"]
       [:input {:id "upload" :className "upload" :type "file" :on-change #(preview-file)}]]]))

-
-
 ;;;;;; Components ;;;;;;
-(defn slider-component []
-  (let [data (atom 0)]
-    (fn [position-in-parts id r min max step]
-      [:div.pure-g
-       [:div.pure-u-1-5 @data]
-       [:input.pure-u-4-5
-        {:type        "range" :value @data :min min :max max :step step
-         :style       {:width "100%"}
-         :on-mouse-up #(session/assoc-in!
-                        [:movement-session :parts position-in-parts :movements id r] (int @data))
-         :on-change   #(reset! data (-> % .-target .-value))}]])))
-
-(defn rep-component [rep id position-in-parts]
-  (let [rep-clicked? (atom false)
-        has-data? (and rep (< 0 rep))]
-    (fn []
-      [:div
-       [:a.pure-button {:style    {:margin  "5px 5px 5px 5px"
-                                   :opacity (if has-data? 1 0.2)}
-                        :on-click #(handler-fn (reset! rep-clicked? (not @rep-clicked?)))} "Repetisjoner"]
-       (when @rep-clicked?
-         [slider-component position-in-parts id :rep 0 50 1])])))
-
-(defn distance-component [distance id position-in-parts]
-  (let [distance-clicked? (atom false)
-        has-data? (and distance (< 0 distance))]
-    (fn []
-      [:div
-       [:a.pure-button {:style    {:margin  "5px 5px 5px 5px"
-                                   :opacity (if has-data? 1 0.2)}
-                        :on-click #(handler-fn (reset! distance-clicked? (not @distance-clicked?)))} "Avstand"]
-       (when @distance-clicked?
-         [slider-component position-in-parts id :distance 0 400 5])])))
-
-(defn duration-component [duration id position-in-parts]
-  (let [duration-clicked? (atom false)
-        has-data? (and duration (< 0 duration))]
-    (fn []
-      [:div
-       [:a.pure-button {:style    {:margin  "5px 5px 5px 5px"
-                                   :opacity (if has-data? 1 0.2)}
-                        :on-click #(handler-fn (reset! duration-clicked? (not @duration-clicked?)))} "Tid"]
-       (when @duration-clicked?
-         [slider-component position-in-parts id :duration 0 1800 10])])))
-
-(defn weight-component [weight id position-in-parts]
-  (let [weight-clicked? (atom false)
-        has-data? (and weight (< 0 weight))]
-    (fn []
-      [:div
-       [:a.pure-button {:style    {:margin  "5px 5px 5px 5px"
-                                   :opacity (if has-data? 1 0.2)}
-                        :on-click #(handler-fn (reset! weight-clicked? (not @weight-clicked?)))} "Vekt"]
-       (when @weight-clicked?
-         [slider-component position-in-parts id :weight 0 200 2.5])])))
-
-(defn rest-component [rest id position-in-parts]
-  (let [rest-clicked? (atom false)
-        has-data? (and rest (< 0 rest))]
-    (fn []
-      [:div
-       [:a.pure-button {:style    {:margin  "5px 5px 5px 5px"
-                                   :opacity (if has-data? 1 0.2)}
-                        :on-click #(handler-fn (reset! rest-clicked? (not @rest-clicked?)))} "Hvile"]
-       (when @rest-clicked?
-         [slider-component position-in-parts id :rest 0 240 10])])))

 (defn r-component [{:keys [data name]}]
   [:div.pure-g {:style {:margin 'auto}}
@@ -217,8 +149,8 @@
   [{:keys [name image slot-category measurement previous next
            rep set performed-sets distance duration weight rest] :as m}
    part-number]
-  (let [;parts (session/get-in [:movement-session :parts])
-        ;position-in-parts (first (positions #{title} (map :title parts)))
+  (let [parts  (session/get-in [:movement-session :parts])
+        pos (positions #{m} (get parts part-number))
         expand (atom false)]
     (fn []
       [:div.pure-g.movement #_{:id (str "m-" id)}
@@ -282,12 +214,36 @@
                                       :onTouchEnd #(replace-movement % {:kw :next :movement m :part-number part-number}) :title "Bytt med vanskeligere"}
                [:i.fa.fa-arrow-up {:style {:color "#99cc99" :opacity 0.8}}]
                "Bytt med vanskeligere"])]
-           #_[:div.pure-g
-              [rep-component rep id position-in-parts]
-              [distance-component distance id position-in-parts]
-              [duration-component duration id position-in-parts]
-              [weight-component weight id position-in-parts]
-              [rest-component rest id position-in-parts]]])]])))
+           [:div.pure-g
+            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+             [:label "Repetisjoner"]
+             [:input {:style {:width 75}
+                      :type  "number" :value rep :min 0 :on-change (fn [v] (let [new-movement (assoc m :rep (int (-> v .-target .-value)))
+                                                                                new-part (assoc (get parts part-number) (int pos) new-movement)]
+                                                                             (session/assoc-in! [:movement-session :parts part-number] new-part)))}]]
+            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+             [:label "Avstand"]
+             [:input {:style {:width 75}
+                      :type "number" :value distance :min 0 :on-change #(pr "changed!")}]]
+            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+             [:label "Tid"]
+             [:input {:style {:width 75}
+                      :type "number" :value duration :min 0 :on-change #(pr "changed!")}]]
+            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+             [:label "Vekt"]
+             [:input {:style {:width 75}
+                      :type "number" :value weight :min 0 :on-change #(pr "changed!")}]]
+            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+             [:label "Hvile"]
+             [:input {:style {:width 75}
+                      :type "number" :value rest :min 0 :on-change #(pr "changed!")}]]
+
+
+            #_[rep-component rep m part-number]
+              #_[distance-component distance m part-number]
+              #_[duration-component duration m part-number]
+              #_[weight-component weight m part-number]
+              #_[rest-component rest m part-number]]])]])))

 (defn add-movement-component []
   (let [show-search-input? (atom false)]
@@ -370,9 +326,7 @@
         month (inc (.getMonth goog-date))
         month (if (> 10 month) (str 0 month) (str month))
         day (.getDate goog-date)
-        day (if (> 10 day) (str 0 day) (str day))
-        ;1996-12-19T16:39:57
-        ]
+        day (if (> 10 day) (str 0 day) (str day))]
     (str year "-" month "-" day)))

 (defn time-string []
@@ -385,7 +339,6 @@
     (str hours ":" minutes ":" seconds)))

 (defn date-component []
-  ;; Moment.js er aktuelt, spesielt for norsk støtte http://momentjs.com/
   (let [date-value (session/get-in [:movement-session :date])]
     (session/assoc-in! [:movement-session :date] date-value)
     [:input {:style     {:float 'right} :id "date" :name "date" :type "date"