Refactor deps task.

Refactor deps task.

--- src/leiningen/deps.clj
+++ src/leiningen/deps.clj
@@ -3,10 +3,9 @@
   (:require [lancet])
   (:use [leiningen.pom :only [default-repos make-dependency]]
         [clojure.contrib.io :only [file delete-file-recursively]])
-  (:import [org.apache.maven.artifact.ant Authentication
-                                          DependenciesTask
-                                          RemoteRepository]
-           org.apache.maven.settings.Server
+  (:import [org.apache.maven.artifact.ant
+            Authentication DependenciesTask RemoteRepository]
+           [org.apache.maven.settings Server]
            [org.apache.tools.ant.util FlatFileNameMapper]))

 ;; Add symlinking to Lancet's toolbox.
@@ -45,27 +44,28 @@
     repo))

 (defn get-repository-list [project]
-  (concat
-   (if (:omit-default-repositories project)
-     {}
-     default-repos)
-   (:repositories project)))
+  (merge (when-not (:omit-default-repositories project) default-repos)
+         (:repositories project)))
+
+(defn- make-deps-task [project deps-set]
+  (let [deps-task (DependenciesTask.)]
+    (.setBasedir lancet/ant-project (:root project))
+    (.setFilesetId deps-task "dependency.fileset")
+    (.setProject deps-task lancet/ant-project)
+    (.setPathId deps-task (:name project))
+    (doseq [r (map make-repository (get-repository-list project))]
+      (.addConfiguredRemoteRepository deps-task r))
+    (doseq [dep (project deps-set)]
+      (.addDependency deps-task (make-dependency dep)))
+    deps-task))

 (defn deps
   "Download and install all :dependencies listed in project.clj.
 With an argument it will skip development dependencies."
-  ([project skip-dev set]
+  ([project skip-dev deps-set]
      (when-not (:disable-implicit-clean project)
        (delete-file-recursively (:library-path project) true))
-     (let [deps-task (DependenciesTask.)]
-       (.setBasedir lancet/ant-project (:root project))
-       (.setFilesetId deps-task "dependency.fileset")
-       (.setProject deps-task lancet/ant-project)
-       (.setPathId deps-task (:name project))
-       (doseq [r (map make-repository (get-repository-list project))]
-         (.addConfiguredRemoteRepository deps-task r))
-       (doseq [dep (project set)]
-         (.addDependency deps-task (make-dependency dep)))
+     (let [deps-task (make-deps-task project deps-set)]
        (.execute deps-task)
        (.mkdirs (file (:library-path project)))
        (copy-dependencies (:jar-behavior project)


Introduce repo-dbs to share lazily-loaded voom dbs among operations

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -465,18 +465,17 @@
        (map (fn [info]
               (-> info
                   (dissoc :gitdir)
-                  (assoc :repo (-> (remotes (:gitdir info)) :origin :fetch))
                   (update-in [:sha] #(subs (str % "--------") 0 7)))))
        (sort-by :ctime)
        (print-table [:repo :path :proj :version :branch :ctime :sha]))
   (newline))

-(defn fresh-version [[prj ver :as dep]]
+(defn fresh-version [repo-dbs [prj ver :as dep]]
   (if-let [voom-meta (-> dep meta :voom)]
     (let [voom-meta (merge {:allow-snaps false, :freshen true} voom-meta)]
       (if (not (:freshen voom-meta))
         dep
-        (let [groups (->> (newest-voom-ver-by-spec prj voom-meta)
+        (let [groups (->> (newest-voom-ver-by-spec repo-dbs prj voom-meta)
                           (map #(assoc % :voom-ver (format-voom-ver %)))
                           (group-by :voom-ver))]
           (case (count groups)
@@ -507,6 +506,7 @@
           input-str
           replacement-map))

+(declare all-repo-dbs)
 (defn freshen
   "Modify dependency versions in this project.clj based on what's available in $VOOM_REPOS

@@ -531,7 +531,8 @@
     (fetch-all))
   (let [prj-file-name (str (:root project) "/project.clj")
         old-deps (:dependencies project)
-        desired-new-deps (doall (map #(fresh-version %) old-deps))]
+        repo-dbs (all-repo-dbs)
+        desired-new-deps (doall (map #(fresh-version repo-dbs %) old-deps))]
     (doseq [[[prj old-ver] [_ new-ver]] (map list old-deps desired-new-deps)]
       (println (format "%-40s" prj)
                (str old-ver
@@ -612,21 +613,20 @@
               (sh "rm" "-rf" checkout))))

 (defn box-repo-add
-  [{:keys [gitdir branch sha proj path]}]
+  [{:keys [repo gitdir branch sha proj path]}]
   (if-let [bdir (find-box)]
     (let [sha (str sha)
           pname (-> (str proj)
                     (s/replace #"/" "--"))
           pdir (adj-path bdir pname)
           checkout (adj-path bdir task-dir pname)
-          g {:gitdir checkout}
-          remote (-> (remotes gitdir) :origin :fetch)]
+          g {:gitdir checkout}]
       (when (and (.exists ^File checkout)
-                 (not= remote (-> (remotes (:gitdir g)) :origin :fetch)))
+                 (not= repo (-> (remotes (:gitdir g)) :origin :fetch)))
         (safe-delete-repo checkout pdir))
       (if (.exists ^File checkout)
         (git g "fetch")
-        (git {} "clone" remote "--refer" gitdir checkout))
+        (git {} "clone" repo "--refer" gitdir checkout))
       (git g "checkout" sha) ; must detach head for update...
       (git g "branch" "-f" branch sha)
       (git g "checkout" branch)
@@ -651,10 +651,11 @@
 (defn box-add
   "Add a lein project to this box"
   [proj & adeps]
-  (let [deps (fold-args-as-meta (map edn/read-string adeps))]
+  (let [repo-dbs (all-repo-dbs)
+        deps (fold-args-as-meta (map edn/read-string adeps))]
     (ensure-deps-repos deps)
     (doseq [dep deps
-            :let [repo-infos (newest-voom-ver-by-spec dep (-> dep meta :voom))]]
+            :let [repo-infos (newest-voom-ver-by-spec repo-dbs dep (-> dep meta :voom))]]
       (println "box adding" (str (-> dep meta :voom)) dep)
       (case (count repo-infos)
         0 (throw (ex-info "Could not find matching projects" {:dep dep}))
@@ -1019,7 +1020,7 @@
                (add-git-facts gitdir))]
     (when (::dirty (meta db))
       (write-git-db db gitdir))
-    db))
+    (assoc db :gitdir gitdir)))

 (defn update-repo-dbs
   "Update voom dbs for all git repos in $VOOM_REPOS.
@@ -1027,6 +1028,13 @@
   Example: lein voom update-repo-dbs"
   [_]
   (time (p-repos (fn [p] (updated-git-db p)))))
+
+(defn all-repo-dbs
+  []
+  (into {}
+        (for [dir (all-repos-dirs)]
+          [(-> ^File dir .getName (.getBytes "UTF-8") ^bytes b64/decode (String. "UTF-8"))
+           (delay (updated-git-db dir))])))

 ;; ===== latest version querying =====

@@ -1047,14 +1055,14 @@
   - g. narrow proj dir changes to candidates by finding proj dir changes
        with no childer proj dir changes in this set
 "
-  [name-spec {:keys [sha version-mvn repo branch path allow-snaps]
-              :or {allow-snaps true, sha (l/lvar)}}]
-  (for [gitdir (all-repos-dirs)
-        :when (or (nil? repo) (= repo (-> (remotes gitdir) :origin :fetch)))
+  [repo-dbs name-spec {:keys [sha version-mvn repo branch path allow-snaps]
+                       :or {allow-snaps true, sha (l/lvar)}}]
+  (for [found-repo (keys repo-dbs)
+        :when (or (nil? repo) (= repo found-repo))
         :let [sha (if (string? sha)
                     (sha/mk sha)
                     sha)
-              {:keys [shabam pldb]} (updated-git-db gitdir)
+              {:keys [shabam pldb gitdir]} (deref (get repo-dbs found-repo))
               proj-names (if (.contains (str name-spec) "/")
                            [name-spec]
                            (map symbol
@@ -1111,6 +1119,7 @@
      :path found-path
      :proj proj-name
      :gitdir gitdir
+     :repo found-repo
      :branch found-branch}))

 (defn help


Add progress reporting during db updating

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -974,28 +974,35 @@
                 (fn [db [name sha]]
                   (pldb/db-fact db r-branch name sha))
                 db new-branches)]
-        (reduce
-         (fn [db {:keys [sha ctime tree parents]}]
-           (let [bsha (sha/mk sha)
-                 db (pldb/db-fact db r-commit
-                                  bsha
-                                  (Date. (* 1000 (Long/parseLong ctime)))
-                                  (sha/mk tree))]
-             (reduce (fn [db parent]
-                       (pldb/db-fact db r-commit-parent bsha (sha/mk parent)))
-                     db parents)))
-         db (apply git-commits gitdir log-args))))))
+        (->> (apply git-commits gitdir log-args)
+             (report-progress (str gitdir " commits (step 1/3)"))
+             (reduce
+              (fn [db {:keys [sha ctime tree parents]}]
+                (let [bsha (sha/mk sha)
+                      db (pldb/db-fact db r-commit
+                                       bsha
+                                       (Date. (* 1000 (Long/parseLong ctime)))
+                                       (sha/mk tree))]
+                  (reduce (fn [db parent]
+                            (pldb/db-fact db r-commit-parent bsha (sha/mk parent)))
+                          db parents)))
+              db))))))

 (defn add-r-trees
   [db gitdir]
   (let [trees (set (vdb/get-column db r-commit 2))
         read-trees (vdb/get-column db r-tree 0)
-        tree-shas (apply disj trees read-trees)]
+        tree-shas (apply disj trees read-trees)
+        t (new-throttle
+           (fn [i]
+             (printf (str "\r%s (step 2/3) %d trees to read.....") (str gitdir) i)
+             (flush)))]
     (if (empty? tree-shas)
       db ;; nothing to do
       (loop [db (vary-meta db assoc ::dirty true)
              tree-shas tree-shas]
+        (throttled t (count tree-shas))
         (if (empty? tree-shas)
           db ;; done
           (let [tree (first tree-shas)
@@ -1026,18 +1033,20 @@
         blobs-to-read (apply disj (set proj-blobs) read-blobs)]
     (if (empty? blobs-to-read)
       db
-      (reduce
-       (fn [db blob-sha]
-         (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
-           (let [proj-name (symbol (:group proj) (:name proj))
-                 has-snaps? (some #(.contains ^String % "-SNAPSHOT")
-                                  (map second (:dependencies proj)))
-                 [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
-             (pldb/db-fact db r-proj blob-sha proj-name
-                           vmajor vminor vinc vqual has-snaps?))
-           (pldb/db-fact db r-proj blob-sha nil nil nil nil nil nil)))
-       (vary-meta db assoc ::dirty true)
-       blobs-to-read))))
+      (->>
+       blobs-to-read
+       (report-progress (str gitdir " project files (step 3/3)"))
+       (reduce
+        (fn [db blob-sha]
+          (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
+            (let [proj-name (symbol (:group proj) (:name proj))
+                  has-snaps? (some #(.contains ^String % "-SNAPSHOT")
+                                   (map second (:dependencies proj)))
+                  [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
+              (pldb/db-fact db r-proj blob-sha proj-name
+                            vmajor vminor vinc vqual has-snaps?))
+            (pldb/db-fact db r-proj blob-sha nil nil nil nil nil nil)))
+        (vary-meta db assoc ::dirty true))))))

 (def voomdb-header "voom-db-0")

@@ -1047,6 +1056,7 @@

 (defn read-git-db
   [gitdir]
+  (println "Reading" (str gitdir))
   (let [file (git-db-file gitdir)
         [header & reldata] (-> file
                                io/input-stream


Rework :box-add argument handling.

Rework :box-add argument handling.

The new handling mechanism will apply quoted maps of constraints to
subsequent project names.

For example:

 lein voom :box-add '{:branch "master"}' my-organization/my-project

This lets us express :branch, :repo, :path and :version constraints on
a specified project.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -4,6 +4,7 @@
             [clojure.pprint :refer [pprint print-table]]
             [clojure.java.io :as io]
             [clojure.set :as set]
+            [clojure.edn :as edn]
             [leiningen.core.project :as project]
             [leiningen.core.main :as lmain]
             [org.satta.glob :refer [glob]]
@@ -421,13 +422,13 @@
    (update-in [:proj] (fnil #(s/replace % #"%" "/") :NOT_FOUND))))

 (defn newest-voom-ver-by-spec
-  [proj-name ver-spec {:keys [repo branch path]}]
+  [proj-name {:keys [version repo branch path]}]

   (for [gitdir (all-repos-dirs)
         :when (or (nil? repo) (= repo (-> (remotes gitdir) :origin :fetch)))
         :let [ptn (s/join "--" ["voom"
                                 (str (namespace proj-name) "%" (name proj-name))
-                                (str ver-spec "*")])
+                                (str (or version "") "*")])
               tags (set (:lines (git {:gitdir gitdir} "tag" "--list" ptn)))
               tspecs (if (= tags [""])
                        []
@@ -609,18 +610,30 @@
       (sh "ln" "-s" (adj-path checkout path) pdir))
     (println "Can't find box")))

+(defn fold-args-as-meta
+  [adeps]
+  (loop [deps [] [fdep & rdeps] adeps]
+    (if (seq rdeps)
+      (if (map? fdep)
+        (let [[ndep & rdeps] rdeps]
+          (recur (conj deps (with-meta ndep fdep)) rdeps))
+        (recur (conj deps fdep) rdeps))
+      deps)))
+
 (defn box-add
-  [proj & deps]
+  [proj & adeps]
   (tag-all-repos)
-  (doseq [dep deps]
-    (let [full-projs (resolve-short-proj (name dep))
-          full-projs (map symbol full-projs)
-          repo-infos (mapcat #(newest-voom-ver-by-spec % "" {}) full-projs)]
-      (if (< 1 (count repo-infos))
-        (do
-          (print "Multiple projects / locations match" (str \" dep \"\:))
-          (print-repo-infos repo-infos))
-        (box-repo-add (first repo-infos))))))
+  (doseq [:let [deps (fold-args-as-meta adeps)]
+          dep deps
+          :let [full-projs (resolve-short-proj (pr-str dep))
+                full-projs (map symbol full-projs)
+                repo-infos (mapcat #(newest-voom-ver-by-spec % (meta dep)) full-projs)]]
+    (case (count repo-infos)
+      0 (throw (ex-info "Could not find matching projects" {:dep dep}))
+      1 (box-repo-add (first repo-infos))
+      (do
+        (print "Multiple projects / locations match" (str \" dep \"\:))
+        (print-repo-infos repo-infos)))))

 ;; === lein entrypoint ===

@@ -650,8 +663,9 @@
     lein voom [:long-sha] :print
     lein voom :parse <version-str>"
   [project & args]
-  (let [[kstrs sargs] (split-with #(.startsWith ^String % ":") args)
-        kargset (set (map #(keyword (subs % 1)) kstrs))
+  (let [symargs (map edn/read-string args)
+        [kargs sargs] (split-with keyword? symargs)
+        kargset (set kargs)
         long-sha (kargset :long-sha)
         new-project (delay (update-proj-version project long-sha))]
     ;; TODO throw exception if upstream doesn't contain this commit :no-upstream


fix: avoid wrong Java equality semantics for collections

--- src/datascript/impl/entity.cljc
+++ src/datascript/impl/entity.cljc
@@ -124,6 +124,7 @@
       [Object
        (toString [e]      (pr-str (assoc @cache :db/id eid)))
        (hashCode [e]      (hash eid)) ; db?
+       (equals [e o]      (equiv-entity e o))

        clojure.lang.Seqable
        (seq [e]           (touch e) (seq @cache))


specify that mappify-ugen and simplify-ugen are for debugging or visualisation

--- src/overtone/sc/machinery/ugen/sc_ugen.clj
+++ src/overtone/sc/machinery/ugen/sc_ugen.clj
@@ -87,7 +87,8 @@

 (defn mappify-ugen
   "Converts all nested SCUgen records into maps creating a data
-   structure that can play more nicely with Clojure's functions"
+   structure that can play more nicely with Clojure's functions.
+   For debugging or visualising a ugen tree."
   [scug]
   (if (map? scug)
     (assoc
@@ -95,7 +96,8 @@
     scug))

 (defn simplify-ugen
-  "Turns SCUgen-tree into a simple map of maps and removes all specs"
+  "Turns SCUgen-tree into a simple map of maps and removes all specs.
+   For debugging or visualising a ugen tree."
   [scug]
   (if (map? scug)
     (assoc


Removed canone alla quarta because it's moved to goldberg.

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -1,130 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Canon Fodder - Chris Ford                    ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ns overtunes.songs.canone-alla-quarta
-  (:use
-    [overtone.live :only [at now stop]]
-    [overtone.inst.sampled-piano :only [sampled-piano] :rename {sampled-piano piano#}]))
-
-(defn play# [notes]
-  (let [play-at# (fn [[ms midi]] (at ms (piano# midi)))]
-    (->> notes (map play-at#) dorun)))
-
-(defn even-melody# [pitches]
-  (let [times (reductions + (cons (now) (repeat 300)))
-        notes (map vector times pitches)]
-    (play# notes)
-    notes))
-
-;(piano# 50)
-;(even-melody# (range 60 73))
-
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Scale                                        ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn sum-n [series n] (reduce + (take n series)))
-(defn => [value & fs] (reduce #(%2 %1) value fs))
-
-(defn scale [intervals]
-  #(if-not (neg? %)
-     (sum-n (cycle intervals) %)
-     (=> % - (scale (reverse intervals)) -)))
-
-(def major (scale [2 2 1 2 2 2 1]))
-(def minor (scale [2 1 2 2 1 2 2]))
-(def g-major (comp (partial + 74) major))
-
-;(major 2)
-;(minor 2)
-;(even-melody# (let [key (comp (partial + 67) major), rest -100]
-;         (map key [0 1 2 0 0 1 2 0 2 3 4 rest 2 3 4 rest])))
-
-
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Structure                                    ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn run [[from to & tos]]
-    (if to
-      (concat
-        (if (<= from to)
-          (range from to)
-          (reverse (range (inc to) (inc from))))
-        (run (cons to tos)))
-      [from]))
-
-;(even-melody# (map g-major
-;            (run [0 7 0])
-;            ))
-
-(defn accumulate [series] (reductions + (cons 0 series)))
-(def repeats (partial mapcat #(apply repeat %)))
-(def runs (partial mapcat run))
-
-
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Melody                                       ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def melody
-  (let [call
-          [(repeats [[2 1/4] [1 1/2] [14 1/4] [1 3/2]])
-          (runs [[0 -1 3 0] [4] [1 8]])]
-        response
-          [(repeats [[10 1/4] [1 1/2] [2 1/4] [1 9/4]])
-          (runs [[7 -1 0] [0 -3]])]
-        development
-          [(repeats [[1 3/4] [12 1/4] [1 1/2] [1 1] [1 1/2] [12 1/4] [1 3]])
-          (runs [[4] [4] [2 -3] [-1 -2] [0] [3 5] [1] [1] [1 2] [-1 1 -1] [5 0]])]
-        line
-          (map concat call response development)]
-    (map vector (accumulate (nth line 0)) (nth line 1))))
-
-(def bassline
-  (let [triples (partial mapcat #(repeat 3 %))]
-    (map vector
-       (accumulate (repeats [[21 1] [12 1/4]]))
-       (concat (triples (runs [[0 -3] [-5 -3]])) (run [12 0])))))
-
-;melody
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Canone alla quarta - Johann Sebastian Bach   ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn bpm [beats] (fn [beat] (-> beat (/ beats) (* 60) (* 1000))))
-(defn skew [k f] (fn [points] (map #(update-in % [k] f) points)))
-(defn shift [point] (fn [points] (map #(->> % (map + point) vec) points)))
-
-(defn canone-alla-quarta# []
-  (let [[timing pitch] [0 1]
-        [tempo start] [(bpm 90) (now)]
-        in-time #(=> % (skew timing tempo) (shift [start 0]))
-        in-key (skew pitch g-major)
-        play-now# #(=> % in-key in-time play#)]
-
-    (=> bassline (shift [0 -7]) play-now#)
-    (=> melody (shift [1/2 0]) play-now#)
-    (=> melody (skew pitch -) (shift [7/2 -3]) play-now#)))
-
-;((bpm 120) 2)
-;(canone-alla-quarta#)
-
-
-
-
-;(stop)


(maint) set message expiry on generated messages

Some of our generated responses were either using the default message expiry
(the unix epoch), or the empty string.

Here we standardise on expiring 3 seconds in the future.  This is
a magic number that should be revisited.

--- src/puppetlabs/cthun/connection_states.clj
+++ src/puppetlabs/cthun/connection_states.clj
@@ -112,10 +112,10 @@
                   :targets targets}
           reply (-> (message/make-message)
                     (assoc :id (ks/uuid)
-                           :expires ""
                            :targets [(:sender message)]
                            :message_type "http://puppetlabs.com/destination_report"
                            :sender "cth://server")
+                    (message/set-expiry 3 :seconds)
                     (message/set-json-data report))]
       (s/validate validation/DestinationReport report)
       (process-client-message nil nil reply))))
@@ -215,6 +215,7 @@
                       (assoc :message_type "http://puppetlabs.com/associate_response"
                              :targets [ (:sender request) ]
                              :sender "cth:///server")
+                      (message/set-expiry 3 :seconds)
                       (message/set-json-data response))]
       (jetty-adapter/send! ws (message/encode message))
       (if (not (:success response))
@@ -230,10 +231,10 @@
           response-data {:uris uris}
           response (-> (message/make-message)
                        (assoc :id (ks/uuid)
-                              :expires ""
                               :endpoints [(get-in @connection-map [ws :uri])]
                               :message_type "http://puppetlabs.com/inventory_response"
                               :sender "cth:///server")
+                       (message/set-expiry 3 :seconds)
                        (message/set-json-data response-data))]
       (s/validate validation/InventoryResponse response-data)
       (process-client-message host ws response))))


Removed dependency on api.AcquisitionEngine

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@12084 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -29,8 +29,7 @@
                                                     make-property-sequences]])
   (:require [clojure.set]
             [org.micromanager.mm :as mm])
-  (:import [org.micromanager.api AcquisitionEngine]
-           [org.micromanager.acquisition MMAcquisition
+  (:import [org.micromanager.acquisition MMAcquisition
                                          SequenceSettings
                                          TaggedImageQueue]
            [org.micromanager.navigation PositionList]


remove references to image cache in acq engine

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9546 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -31,9 +31,9 @@
   (:import [org.micromanager AcqControlDlg MMStudioMainFrame]
            [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
            [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcq TaggedImageQueue
-                                         ProcessorStack SequenceSettings MMImageCache
+                                         ProcessorStack SequenceSettings
                                          MMAcquisition
-                                         TaggedImageStorageRam VirtualAcquisitionDisplay]
+                                         TaggedImageStorageRam]
            [org.micromanager.utils ReportingUtils]
            [mmcorej TaggedImage Configuration Metadata]
            [java.util.prefs Preferences]
@@ -818,8 +818,7 @@
       (let [live-acq (LiveAcq. mmc out-queue-2 (:summary-metadata @(.state this))
                                (:save settings) acq-eng gui)]
         (swap! (.state this) assoc
-               :display live-acq
-               :image-cache (.getImageCache live-acq))
+               :display live-acq)
         (.start live-acq)
         (.getAcquisitionName live-acq)))))

@@ -873,10 +872,6 @@
 (defn -clearRunnables [this]
   (reset! attached-runnables (vec nil)))

-
-(defn -getImageCache [this]
-  (:image-cache @(.state this)))
-
 ;; testing

 (defn create-acq-eng []


fix command input placeholder position on real iOS device

--- src/status_im/chat/styles/input/input.cljs
+++ src/status_im/chat/styles/input/input.cljs
@@ -73,7 +73,9 @@
    :android             {:left (+ 15 left)
                          :top  -1}
    :ios                 {:line-height min-input-height
-                         :left        (+ 9 left)}})
+                         :left        (+ 3 left)
+                         :top 0
+                         :padding-top -3}})

 (defnstyle input-password-text [left]
   {:min-width           200


set image max width to avoid overflow (#13211)

squashed and merged

--- src/status_im/ui/screens/status/views.cljs
+++ src/status_im/ui/screens/status/views.cljs
@@ -33,7 +33,9 @@
   (let [width (reagent/atom nil)]
     (fn [uri show-close?]
       [react/view {:style               {:width         @width
+                                         :align-items   :center
                                          :height        image-max-dimension
+                                         :max-width     :100%
                                          :overflow      :hidden
                                          :opacity       (if @width 1 0)
                                          :border-radius 16


Use plain array instead of set for tracking watched atoms

Turns out to be much, much faster in most cases

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -6,15 +6,16 @@

 (declare ^:dynamic *ratom-context*)
 (defonce cached-reactions {})
-
-(defn ^boolean reactive? []
-  (not (nil? *ratom-context*)))
-
 (defonce ^boolean debug false)
 (defonce ^boolean silent false)
 (defonce generation 0)
-
 (defonce -running (clojure.core/atom 0))
+
+(defn ^boolean reactive? []
+  (not (nil? *ratom-context*)))
+
+
+;;; Utilities

 (defn running []
   (+ @-running
@@ -39,20 +40,28 @@

 (defn- notify-deref-watcher! [derefable]
   (when-some [obj *ratom-context*]
-    (let [captured (.-cljsCaptured obj)]
-      (set! (.-cljsCaptured obj)
-            (if (nil? captured)
-              (let [old (.-watching obj)]
-                (if (and (== 1 (count old))
-                         (identical? derefable (first old)))
-                  ;; Optimize common case of one deref
-                  old
-                  #{derefable}))
-              (conj captured derefable))))))
+    (let [c (.-cljsCaptured obj)]
+      (if (nil? c)
+        (set! (.-cljsCaptured obj) (array derefable))
+        (when (== -1 (.indexOf c derefable))
+          (.push c derefable)))))
+  nil)
+
+(defn- ^number arr-len [x]
+  (if (nil? x) 0 (alength x)))
+
+(defn- ^boolean arr-eq [x y]
+  (let [len (arr-len x)]
+    (and (== len (arr-len y))
+         (loop [i 0]
+           (or (== i len)
+               (if (identical? (aget x i) (aget y i))
+                 (recur (inc i))
+                 false))))))

 (def reaction-counter 0)

-(defn reaction-key [r]
+(defn- reaction-key [r]
   (if-some [k (.-reaction-id r)]
     k
     (->> reaction-counter inc
@@ -83,6 +92,7 @@
   (-write writer (str "#<" s " "))
   (pr-writer (binding [*ratom-context* nil] (-deref a)) writer opts)
   (-write writer ">"))
+

 ;;; Atom

@@ -340,12 +350,17 @@

   (_check-clean [this]
     (when (== dirtyness maybe-dirty)
-      (let [ar auto-run]
+      (let [ar auto-run
+            len (arr-len watching)]
         (set! auto-run nil)
-        (doseq [w watching :while (== dirtyness maybe-dirty)]
-          (when (and (instance? Reaction w)
-                     (false? (._check-clean w)))
-            (._try-run w this)))
+        (loop [i 0]
+          (when (< i len)
+            (let [w (aget watching i)]
+              (when (and (instance? Reaction w)
+                         (false? (._check-clean w)))
+                (._try-run w this)))
+            (when (== dirtyness maybe-dirty)
+              (recur (inc i)))))
         (set! auto-run ar))
       (when (== dirtyness maybe-dirty)
         (set! dirtyness clean)))
@@ -369,10 +384,12 @@

   (_update-watching [this derefed]
     (doseq [w derefed]
-      (when-not (contains? watching w)
+      (when (or (nil? watching)
+                (== -1 (.indexOf watching w)))
         (-add-watch w this handle-reaction-change)))
     (doseq [w watching]
-      (when-not (contains? derefed w)
+      (when (or (nil? derefed)
+                (== -1 (.indexOf derefed w)))
         (-remove-watch w this)))
     (set! watching derefed)
     nil)
@@ -394,7 +411,7 @@
     (let [oldstate state
           res (capture-derefed f this)
           derefed (-captured this)]
-      (when (not= derefed watching)
+      (when-not (arr-eq derefed watching)
         (._update-watching this derefed))
       (set! dirtyness clean)
       (when-not nocache?


delete commented-out code (#1493)

delete commented-out code (#1493)

--- src/cljs/main/broadfcui/page/workspace/summary/acl_editor.cljs
+++ src/cljs/main/broadfcui/page/workspace/summary/acl_editor.cljs
@@ -187,9 +187,6 @@
                              (map #(dissoc % :read-only?))
                              (map #(update % :email clojure.string/trim))
                              (remove (comp empty? :email)))
-           ;; grant-filtered-acl (if (common/access-greater-than-equal-to? (:user-access-level props) "OWNER")
-           ;;                     filtered-acl
-           ;;                     (map #(dissoc % :canShare) filtered-acl))
            new-emails (set/difference (set (map :email filtered-acl))
                                       (:initial-acl-emails @locals))
            fails (->> (:non-project-owner-acl-vec @state) count range


refactor to fetch issue keys and failfast with bang fns

--- src/gh_waiting_room/service.clj
+++ src/gh_waiting_room/service.clj
@@ -43,8 +43,9 @@

 (defn- issue-filter
   [issue]
-  (and (not (get-in issue [:repository :private]))
-   (re-find (issue-url-regex) (str (:html_url issue)))
+  (and
+   (not (get-in issue [:repository :private]))
+   (re-find (issue-url-regex) (get! issue :html_url))
    (if gh-hide-labels
      (not (some
            (set gh-hide-labels)
@@ -55,23 +56,28 @@
   []
   (swap! db assoc :issues (my-issues (api-options))))

-(defn- ->issue [{body :body :as issue}]
+(defn get! [m k]
+  (or (get m k) (throw (ex-info "No value found for key in map" {:map m :key k}))))
+
+(defn get-in! [m ks]
+  (or (get-in m ks) (throw (ex-info "No value found for nested keys in map" {:map m :keys ks}))))
+
+(defn- ->issue [issue]
   {:name (format "%s#%s"
-          (or (get-in issue [:repository :full_name])
-              (throw (ex-info "No full name given for issue" {:issue issue})))
-          (:number issue))
+                 (get-in! issue [:repository :full_name])
+                 (get! issue :number))
    :type (if (get-in issue [:pull_request :html_url]) "pull request" "issue")
-   :url (:html_url issue)
-   :comments (:comments issue)
-   :title (:title issue)
-   :desc (if (re-find #"^\s*$" body)
-           ""
-           (str (re-find #"^.{0,100}(?=\s|$)" body)
-                (if (> (count body) 100) " ..." "")))
-   :user (or (get-in issue [:repository :owner :login])
-             (throw (ex-info "No user found for issue" {:issue issue})))
-   :repo-name (get-in issue [:repository :name])
-   :created (or (re-find #"\d{4}-\d\d-\d\d"(:created_at issue))
+   :url (get! issue :html_url)
+   :comments (get! issue :comments)
+   :title (get! issue :title)
+   :desc (let [body (get! issue :body)]
+           (if (re-find #"^\s*$" body)
+             ""
+             (str (re-find #"^.{0,100}(?=\s|$)" body)
+                  (if (> (count body) 100) " ..." ""))))
+   :user (get-in! issue [:repository :owner :login])
+   :repo-name (get-in! issue [:repository :name])
+   :created (or (re-find #"\d{4}-\d\d-\d\d"(get! issue :created_at))
                 (throw (ex-info "Failed to parse date from an issue" {:issue issue})))})

 (defn- viewable-issues []
@@ -88,12 +94,6 @@
    (render-resource "public/index.mustache"
                     {:github-user (gh-user)
                      :issues (viewable-issues)})))
-
-(defn get! [m k]
-  (or (get m k) (throw (ex-info "No value found for key in map" {:map m :key k}))))
-
-(defn get-in! [m ks]
-  (or (get-in m ks) (throw (ex-info "No value found for nested keys in map" {:map m :keys ks}))))

 ; TODO: can this come from url-for?
 (defn- full-url-for [path]


reuse gh-user

reuse gh-user

--- src/gh_waiting_room/service.clj
+++ src/gh_waiting_room/service.clj
@@ -71,7 +71,7 @@
   (when-not (seq (:issues @db)) (fetch-gh-issues))
   (ring-resp/response
    (render-resource "public/index.mustache"
-                    {:github-user (or (System/getenv "GITHUB_USER") "FIXME")
+                    {:github-user (gh-user)
                      :issues (->> (:issues @db)
                                   (filter issue-filter)
                                   (map ->issue)


fixes https://github.com/status-im/status-react/issues/1325

--- src/status_im/data_store/contacts.cljs
+++ src/status_im/data_store/contacts.cljs
@@ -29,7 +29,7 @@
 (defn save
   [{:keys [whisper-identity pending?] :as contact}]
   (let [{pending-db? :pending?
-         :as         contact-db} (data-store/get-by-id whisper-identity)
+         :as         contact-db} (get-by-id whisper-identity)
         contact' (-> contact
                      (assoc :pending? (boolean (if contact-db
                                                  (if (nil? pending?) pending-db? pending?)


Disables Server header (#244)

Disables Server header (#244)

--- waiter/src/waiter/main.clj
+++ waiter/src/waiter/main.clj
@@ -86,7 +86,8 @@
                                         :join? false
                                         :max-threads 250
                                         :port port
-                                        :request-header-size 32768})]
+                                        :request-header-size 32768
+                                        :send-server-version? false})]
                     (server/run-jetty options)))})

 (defn start-waiter [config-file]


OO: Allow statement of specific app-state key when integrating OSM data

--- src/hatti/ona/post_process.cljs
+++ src/hatti/ona/post_process.cljs
@@ -51,12 +51,12 @@
                    :tags tags}})))))

 (defn integrate-osm-data!
-  [app-state form osm-xml]
+  [app-state form osm-xml app-state-keys]
   "Given some data post-processed from the ona server (ie, containing _id, _rank),
    and a string of osm-xml, produce a version with relevant osm data injected in."
   (let [osm-fields (filter forms/osm? form)]
     (when-not (empty? osm-fields)
-      (let [data (get-in app-state [:map-page :data])
+      (let [data (get-in app-state app-state-keys)
             osm-data (osm-id->osm-data data form osm-xml)
             osm-val->osm-id #(re-find #"[-]?[0-9]+" %)
             osm-val->osm-data (fn [osm-val]
@@ -76,7 +76,8 @@
                           (update-in datum [osm-key] osm-val->osm-data))))]

         (doseq [osm-field osm-fields]
-          (shared/transact-app-data! app-state (updater (:full-name osm-field))))))))
+          (transact-app-state! app-state app-state-keys
+                               (updater (:full-name osm-field))))))))

 ;; IMAGE POST-PROCESSING
 (defn url-obj [media-obj]


Re-use same logic as ugens - now synths insts and ugens all use the same arg handling logic.

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -250,22 +250,6 @@
   []
   (str "anon-" (next-id :anonymous-synth)))

-(defn merge-args
-  "Combine args passed to trigger synth/inst with known arg names. This allows
-  standard args followed by named args. For example, if the inst has the
-  arg-names [\"a\" \"b\" \"c\" \"d\"] then the user may trigger it with the
-  following args: [1 2 :d 4] which will result with an arg-name to arg binding
-  of {:a 1 :b 2 :d 4}"
-  [arg-names args]
-  (loop [arg-names arg-names
-         args args
-         result {}]
-    (cond (keyword? (first args)) (merge result (apply hash-map args))
-          (empty? args) result
-          :else (recur (rest arg-names)
-                       (rest args)
-                       (assoc result (keyword (first arg-names)) (first args))))))
-
 (defn synth-player
   "Returns a player function for a named synth.  Used by (synth ...)
   internally, but can be used to generate a player for a pre-compiled
@@ -299,7 +283,7 @@
                                       (isa? (type %) :overtone.sc.sample/sample))
                                 (:id %) %) args)

-          arg-map       (merge-args arg-names args)]
+          arg-map       (arg-mapper args arg-names {})]
       (player arg-map))))

 (defn- normalize-synth-args


Generate Passenger Name Record for reservation.

--- src/vacation2/main.clj
+++ src/vacation2/main.clj
@@ -1,5 +1,6 @@
 (ns vacation2.main
   (:gen-class)
+  (:import java.util.Base64)
   (:require [clojure.string]
             [clojure.tools.cli]
             [util :refer :all]))
@@ -90,7 +91,13 @@
               (ref {:id i :seats (rand-seats) :price (rand-price)})))]
     {:reservations
       (for [i (range n-reservations)]
-        (ref {:id i :fulfilled? false :total 0}))
+        (ref {:id          i
+              :status      :unprocessed ; :unprocessed|:in-process|:processed
+              :destination (str (rand-int 100)) ; 1 of 100 locations
+              ; Note: the concept of destination does not exist in the original
+              ; vacation benchmark. We introduce it, to generate PNRs.
+              :pnr         nil
+              :total       0}))
      :cars    (generate-relation)
      :flights (generate-relation)
      :rooms   (generate-relation)}))
@@ -106,7 +113,7 @@
       (sort-by (comp :price deref))
       (first))))

-(defn reserve [reservation relation n-seats]
+(defn reserve-relation [reservation relation n-seats]
   "Reserve `n-seats` on `relation`, for `reservation`.

   Decreases the number of seats in `relation`, and updates the total in
@@ -114,6 +121,31 @@
   (dosync
     (alter relation update :seats - n-seats)
     (alter reservation update :total + (:price @relation))))
+
+(defn- str->base64 [data]
+  (.encodeToString (Base64/getEncoder) (.getBytes data)))
+
+(defn- base64->str [data]
+  (String. (.decode (Base64/getDecoder) data)))
+
+(defn generate-pnr [reservation]
+  "Generate Passenger Name Record (PNR).
+  The generated PNR is fake, but based on the information described on
+  Wikipedia.
+
+  https://en.wikipedia.org/wiki/Passenger_name_record"
+  (let [name-of-passenger (:id @reservation)
+        info-travel-agent "vacation-benchmark"
+        ticket-number     (rand-int 10000)
+        itinerary         (:destination @reservation)
+        timestamp         (System/currentTimeMillis)
+        data              (clojure.string/join "//"
+                             [name-of-passenger
+                              info-travel-agent
+                              ticket-number
+                              itinerary
+                              timestamp])]
+    (str->base64 data)))

 (defn process-reservation
   [reservation
@@ -125,12 +157,14 @@
   (dosync
     (let [found-car    (look-for-seats (random-subset n-queries cars) 1)
           found-flight (look-for-seats (random-subset n-queries flights) 1)
-          found-room   (look-for-seats (random-subset n-queries rooms) 1)]
-      (when found-car    (reserve reservation found-car 1))
-      (when found-flight (reserve reservation found-flight 1))
-      (when found-room   (reserve reservation found-room 1))
-      (alter reservation assoc :fulfilled?
-        (some? (or found-car found-flight found-room))))))
+          found-room   (look-for-seats (random-subset n-queries rooms) 1)
+          pnr          (generate-pnr reservation)]
+      (when found-car    (reserve-relation reservation found-car 1))
+      (when found-flight (reserve-relation reservation found-flight 1))
+      (when found-room   (reserve-relation reservation found-room 1))
+      (alter reservation assoc
+        :status true
+        :pnr    pnr))))
 ; TODO: add some logging

 ; BEHAVIORS


Skeleton prod with db connection

Skeleton prod with db connection

--- src/pasmo_outreach/server/routes/core.clj
+++ src/pasmo_outreach/server/routes/core.clj
@@ -1,8 +1,9 @@
 (ns pasmo-outreach.server.routes.core
-  (:require [compojure.core :refer [defroutes GET]]))
+  (:require [compojure.core :refer [defroutes GET]]
+            [pasmo-outreach.server.db.users :as user-db]))

 (def json-resp {:headers {"Content-Type" "application/json"}})

 (defroutes sample-routes
-  (GET "/sample" req (assoc json-resp :body [1 2 3 4])))
+  (GET "/sample" req (assoc json-resp :body (user-db/all))))


Remove unnecessary parentheses.

Remove unnecessary parentheses.

--- src/pepa/web/handlers.clj
+++ src/pepa/web/handlers.clj
@@ -20,7 +20,7 @@

             [liberator.core :refer [defresource]]
             [liberator.representation :refer [as-response]]
-            [io.clojure.liberator-transit]
+            io.clojure.liberator-transit

             [immutant.web.async :as async-web]
             [clojure.core.async :as async :refer [go <!]])


add prefix for reflinks to fix relative URLs for cross-refs

--- src/main/cljs_api_gen/write.clj
+++ src/main/cljs_api_gen/write.clj
@@ -115,16 +115,20 @@
 ;; symbol links in markdown
 ;;--------------------------------------------------------------------------------

+(def ^:dynamic *reflink-prefix* "")
+
 (defn resolve-reflink
   [[whole-match full-name]]
   (if-let [item (get-in *result* [:symbols full-name])]
-    (str "[`" (get-short-display-name item) "`](" (encode/encode-fullname full-name) ".md)")
+    (let [path (str *reflink-prefix* (encode/encode-fullname full-name) ".md")]
+      (str "[`" (get-short-display-name item) "`](" path ")"))
     whole-match))

 (defn resolve-named-reflink
   [[whole-match full-name]]
   (if (contains? (:symbols *result*) full-name)
-    (str "](" (encode/encode-fullname full-name) ".md)")
+    (let [path (str *reflink-prefix* (encode/encode-fullname full-name) ".md")]
+      (str "](" path ")"))
     whole-match))

 (defn resolve-reflinks
@@ -282,14 +286,14 @@
   (when full-name
     (let [item (get-in *result* [:symbols full-name])
           display (get-full-display-name item)
-          link (str (encode/encode-fullname full-name) ".md")]
+          link (str *reflink-prefix* (encode/encode-fullname full-name) ".md")]
       (cond-> (str "[`" display "`](" link ")")
          (:removed item) md-strikethru))))

 (defn add-related-links
   [{:keys [related] :as item}]
   (if related
-    (let [symbols (map ref-link related)]
+    (let [symbols (doall (map ref-link related))]
       (assoc item :related {:symbols symbols}))
     item))

@@ -304,31 +308,32 @@
   (-> item
       (update-in [:description] resolve-reflinks)
       (update-in [:examples] (fn [examples]
-                               (map #(update-in % [:content] resolve-reflinks) examples)))))
+                               (doall (map #(update-in % [:content] resolve-reflinks) examples))))))

 (defn ref-file-data
   [item]
-  (-> item
-      (assoc
-        :full-name (:full-name item)
-        :moved (ref-link (:moved item))
-        :display-name (cond-> (md-escape (get-full-display-name item))
-                        (:removed item) md-strikethru)
-        :data (with-out-str (pprint item))
-        :history (map history-change-shield (:history item))
-        :signature (let [sigs (:signature item)]
-                     (when (and (sequential? sigs) (pos? (count sigs)))
-                       {:sigs (map #(hash-map :name (cond-> (md-escape (:name item))
-                                                      (= "type" (:type item)) (str "."))
-                                              :args (sig-args %))
-                                   sigs)}))
-        :clj-symbol (make-clj-ref item)
-        :cljsdoc-path (str cljsdoc-dir "/" (:full-name-encode item) ".cljsdoc"))
-      (add-external-doc-links)
-      (add-syntax-usage)
-      (add-related-links)
-      (add-source-extras)
-      (resolve-all-reflinks)))
+  (binding [*reflink-prefix* "../"] ;; assuming we are in a symbol's parent dir <ns>
+    (-> item
+        (assoc
+          :full-name (:full-name item)
+          :moved (ref-link (:moved item))
+          :display-name (cond-> (md-escape (get-full-display-name item))
+                          (:removed item) md-strikethru)
+          :data (with-out-str (pprint item))
+          :history (map history-change-shield (:history item))
+          :signature (let [sigs (:signature item)]
+                       (when (and (sequential? sigs) (pos? (count sigs)))
+                         {:sigs (map #(hash-map :name (cond-> (md-escape (:name item))
+                                                        (= "type" (:type item)) (str "."))
+                                                :args (sig-args %))
+                                     sigs)}))
+          :clj-symbol (make-clj-ref item)
+          :cljsdoc-path (str cljsdoc-dir "/" (:full-name-encode item) ".cljsdoc"))
+        (add-external-doc-links)
+        (add-syntax-usage)
+        (add-related-links)
+        (add-source-extras)
+        (resolve-all-reflinks))))

 (defn dump-ref-file!
   [item]


Fix map resizing.

Fix map resizing.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -84,6 +84,7 @@

 (defn map-size [{:keys [vertices]}]
   (->> vertices
+       (vals)
        (map second)
        (apply map max)
        (map + [50 50])))
@@ -105,8 +106,7 @@
 (defn draw-world [world-state]
   (dommy/replace! (dommy.core/sel1 :#forsvg)
                   (crate/html [:div#forsvg
-                               ;(make-svg (map-size world-state)
-                               (make-svg [2000 2000]
+                               (make-svg (map-size world-state)
                                          (make-edges world-state)
                                          (make-vertices world-state))])))


Adjust ns and main to new AOT compilation

* gorilla.clj (main): renamed to -main

--- src/de/kotka/gorilla.clj
+++ src/de/kotka/gorilla.clj
@@ -21,6 +21,7 @@
 ; THE SOFTWARE.

 (clojure.core/ns de.kotka.gorilla
+  (:gen-class)
   (:use [clojure.contrib.fcase :only (case)])
   (:import
      (clojure.lang RT Compiler Compiler$CompilerException LispReader
@@ -156,7 +157,7 @@
     (handle-connection conn)
     (recur server)))

-(defn main
+(defn -main
   [& _]
   (let [address (InetAddress/getByName "localhost")
         server  (new ServerSocket 10123 0 address)]


Remake to send posts one-by-one as they are fetched

--- src/ecregister/posts.clj
+++ src/ecregister/posts.clj
@@ -80,18 +80,21 @@
     (map #(conj % [:published (published? %)]) (take-until (complement published?) posts))))

 (defn fetch-unpublished-aw-posts [fa-post out-chan]
-  (go-loop [page 1 unpub []]
+  (go-loop [page 1]
            (prn "fetching posts for page " page)
            (if-let [posts (extract-aw-posts (<! (get-html (str "http://advaitaworld.com/blog/free-away/page" page))))]
-             (let [marked (mark-published posts fa-post)]
-               (if (:published (last marked))
-                 (put! out-chan [(concat unpub (drop-last marked)) page])
+             (let [marked (mark-published posts fa-post)
+                   has-published? (:published (last marked))
+                   unpublished (if has-published? (drop-last marked) marked)]
+               ;; spit all unpub posts on this page into channel
+               (doseq [post unpublished]
+                      (put! out-chan post))
+               (if has-published?
+                 (put! out-chan :end)
                  (if (< page max-page-depth)
-                   (recur (inc page) (concat unpub marked))  ;; no published posts on this page return
-                   (put! out-chan [:error page]))
-                 )
-               )
-             (put! out-chan [:error page]))))
+                   (recur (inc page))  ;; no published posts on this page return
+                   (put! out-chan :error))))
+             (put! out-chan :error))))

 (defn fetch-latest-fa-post [out-chan]
   "Fetches a data about two most recent posts - in articles and in poetry categories, outputs to passed channel"
@@ -114,7 +117,8 @@
 ;;   (prn "Launched fetching")
 ;;   (let [fa-post (<!! tc)]
 ;;     (fetch-unpublished-aw-posts fa-post tc)
-;;     (prn (<!! tc))
-;;     )
-
-;;   )
+;;     (loop []
+;;       (let [p (<!! tc)]
+;;         (when (not= p :end)
+;;           (prn p)
+;;           (recur))))))


map zoom fix for datasets that contain -ve, +ve lat,lng values.

--- src/hatti/map/utils.cljs
+++ src/hatti/map/utils.cljs
@@ -222,7 +222,11 @@
   (let [map-bounds (.getBounds leaflet-map)
         layer-bounds (.getBounds feature-layer)]
     (.invalidateSize leaflet-map false)
-    (when-not (.contains map-bounds layer-bounds)
+    ;; Re-fitting to bounds should happen if the map is more zoomed out
+    ;; than the data. The 0 get-zoom is an additional constraint for
+    ;; datasets that cross the axes (contain both -ve, +ve lat,lngs)
+    (when (or (zero? (.getZoom leaflet-map))
+              (not (.contains layer-bounds map-bounds)))
       (.fitBounds leaflet-map layer-bounds))))

 (defn- load-geo-json


RR: fix "First icon is a clock, for submission time" test

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -245,7 +245,7 @@
                 :or   {relabel? true}}]
   (let [meta-fields (filter meta? flat-form)
         include-extra-sub-details (if with-submission-details?
-                                    #(into % extra-submission-details)
+                                    #(into (vec %) extra-submission-details)
                                     identity)
         relabel (if relabel? relabel-meta-field identity)]
     (->> meta-fields


Add media-attachment css class

Add media-attachment css class

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -197,7 +197,9 @@
    both in the numeric category"
   [field]
   (cond
-    (text? field)        "column-string"
+    (text? field)        (if (= (get field :full-name) "_media_all_received")
+                           "column-string media-attachment"
+                           "column-string")
     (numeric? field)     "column-numeric"
     (time-based? field)  "column-datetime"
     (categorical? field) "column-categorical"
@@ -240,13 +242,13 @@
 (defn infor-icon-component
   "Returns an infor icon with a tooltip message"
   [answer & {:keys [media-count total-media]}]
-  (format "%s
-
-
Total media files expected :  %s
-

-
Total media files received :  %s
-
"
-          answer total-media media-count))
+  (str "" answer
+       "
+
+
Total media files expected : "
+       total-media "

+
Total media files received : " media-count
+       "
"))

 (defn format-answer
   "String representation for a particular field datapoint (answer).


adding debugging line for testing because staging is behaving differently than my local dev

--- src/vip/data_processor/validation/zip.clj
+++ src/vip/data_processor/validation/zip.clj
@@ -31,6 +31,7 @@
         size (get-uncompressed-size zip-file)
         tmp-dir (Files/createTempDirectory "vip-extracted-feed"
                                            (into-array FileAttribute []))]
+    (log/info "zipfile size: " size)
     (if (> size max-zipfile-size)
       (-> (too-big-msg size max-zipfile-size)
           (ex-info {:msg (too-big-msg size max-zipfile-size)


Fix assoc of `model` instead of `input-text`

Had the wrong in the state, causing crashes in the demo app

--- src/re_com/typeahead.cljs
+++ src/re_com/typeahead.cljs
@@ -148,7 +148,7 @@
     (update-model state input-text)
     :else (-> state
               ;; if nothing was actually selected, then view should be the unchanged value
-              (assoc :input-text model)
+              (assoc :input-text input-text)
               clear-suggestions)))

 (defn- change-data-source


Fixed server background threads

Fixed server background threads

--- src/webapp/server/fns.clj
+++ src/webapp/server/fns.clj
@@ -148,9 +148,10 @@
 (defn main-init [

                  ]
-  (check-timer)
-  (start-conns)
-  )
+  (do
+    (start-conns)
+    (check-timer)
+    ))

 (defn create-session[{:keys [init-state browser]}]
   (let [


Turns down iterations again.

Turns down iterations again.

--- test/onyx/generative/apply_fn_gen_test.clj
+++ test/onyx/generative/apply_fn_gen_test.clj
@@ -21,7 +21,7 @@
 (deftest singe-segment-return
   (checking
    "A single returned segment attaches to its root"
-   (times 30)
+   (times 15)
    [input (gen-segment)
     output (segment-map)]
    (let [f (fn [segment] output)
@@ -34,7 +34,7 @@
 (deftest multi-segment-return
   (checking
    "Multiple segments can be returned, attached to their root"
-   (times 30)
+   (times 15)
    [input (gen-segment)
     output (gen/vector (segment-map))]
    (let [f (fn [segment] output)
@@ -47,7 +47,7 @@
 (deftest multi-batch-size-single-rets
   (checking
    "It generalizes with a bigger batch size for single returns"
-   (times 30)
+   (times 15)
    ;; Uses a unique mapping of keys to values to look up an
    ;; input for an output with no collisions.
    [input (gen/vector (gen/hash-map
@@ -69,7 +69,7 @@
 (deftest parameterized-functions
   (checking
    "Functions can be parameterized via the event map"
-   (times 30)
+   (times 15)
    [input (gen/vector (gen-segment))
     params (gen/vector (gen/resize 10 gen/any))]
    (let [f (fn [& args] {:result (or (butlast args) [])})
@@ -81,7 +81,7 @@
 (deftest throws-exception
   (checking
    "Functions that throw exceptions pass the exception object back"
-   (times 30)
+   (times 15)
    [input (gen/vector (gen-segment))]
    (let [f (fn [segment] (throw (ex-info "exception" {:val 42})))
          event {:onyx.core/batch input}
@@ -95,7 +95,7 @@
 (deftest bulk-functions
   (checking
    "Bulk functions call the function, but always return their inputs"
-   (times 30)
+   (times 15)
    [input (gen/not-empty (gen/vector (gen-segment)))
     output (gen/resize 10 gen/any)]
    (let [called? (atom false)


Don't force id

Don't force id

--- src/lobos/migrations.clj
+++ src/lobos/migrations.clj
@@ -23,7 +23,7 @@

 (defmigration add-basic-types
               (up [] (sql/insert! (lobos.config/db) :types
-                                  {:id 1 :name "Unknown"}
+                                  {:name "Unknown"}
                                   {:name "Bar"}
                                   {:name "Pub"}
                                   {:name "Take Away"} ))


Add another pipe test

Add another pipe test

--- test/jest/method_test.clj
+++ test/jest/method_test.clj
@@ -66,3 +66,9 @@
     ["(filter even? y)"]))

+ (deftest method-pipe-test-2
+   (test-code
+    "range(0, 10)->filter(even?)->apply(sum);"
+    ["(apply sum (filter even? (range 0 10)))"]))
+
+


Fixes #1180 Cleanup navigation stack when creating public group

--- src/status_im/new_group/handlers.cljs
+++ src/status_im/new_group/handlers.cljs
@@ -116,7 +116,8 @@

 (register-handler :create-new-public-group
   (after (fn [_ [_ topic]]
-           (dispatch [:navigation-replace :chat topic])))
+           (dispatch [:navigate-to-clean :chat-list])
+           (dispatch [:navigate-to :chat topic])))
   (u/side-effect!
     (fn [db [_ topic]]
       (let [exists? (boolean (get-in db [:chats topic]))


add id-sk-with-origin in schema def

add id-sk-with-origin in schema def

--- src/navigator/schema.clj
+++ src/navigator/schema.clj
@@ -2,50 +2,47 @@
   (:require [datomic-schematode.constraints :as constraints]))

 (def schema
-  [{:namespace :comp
-    :attrs [[:id-sk :string "Shared key for 3rd parties" :db.unique/identity]
-            [:name :string :indexed] ; not null
-            [:description :string :indexed]
-            [:version :string]               ; not null
-            [:status :enum [:active :archived :preactive]] ; not null
-            [:tags :ref :many]]
-    :dbfns [(constraints/unique :comp :name :version)]}
-   {:namespace :comp-tag
-    :attrs [[:name :string :indexed] ; not null
-            [:description :string]
-            [:version :string]     ; not null
-            [:type :string :indexed] ; not null
-            [:isrequestable :boolean] ; default f
-            [:icon :uri]
-            [:status :enum [:active :archived]] ; not null
-            [:isfinal :boolean] ; default f
-            [:disp-ctxs :ref :many]
-            [:child-tags :ref :many]
-            [:child-perf-asmts :ref :many]
-            [:child-comps :ref :many]]
-    :dbfns [(constraints/unique :comp-tag :name :version)]}
-   {:namespace :comp-tag-disp-ctx
-    :attr [[:name :string]]}
-   {:namespace :perf-asmt
-    :attrs [[:id-sk :string "Shared key from 3rd parties"]
-            [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
-            [:name :string]
-            [:version :string] ; not null
+  [[:comp {:attrs [[:id-sk :string "Shared key for 3rd parties" :db.unique/identity]
+                   [:name :string :indexed] ; not null
+                   [:description :string :indexed]
+                   [:version :string]               ; not null
+                   [:status :enum [:active :archived :preactive]] ; not null
+                   [:tags :ref :many]]
+           :dbfns [(constraints/unique :comp :name :version)]}]
+   [:comp-tag {:attrs [[:name :string :indexed] ; not null
+                       [:description :string]
+                       [:version :string]     ; not null
+                       [:type :string :indexed] ; not null
+                       [:isrequestable :boolean] ; default f
+                       [:icon :uri]
+                       [:status :enum [:active :archived]] ; not null
+                       [:isfinal :boolean] ; default f
+                       [:disp-ctxs :ref :many]
+                       [:child-tags :ref :many]
+                       [:child-perf-asmts :ref :many]
+                       [:child-comps :ref :many]]
+               :dbfns [(constraints/unique :comp-tag :name :version)]}]
+   [:comp-tag-disp-ctx {:attr [[:name :string]]}]
+   [:perf-asmt {:attrs [[:id-sk :string "Shared key from 3rd parties"]
+                        [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
+                        [:id-sk-with-origin :string "Combined id-sk and id-sk-origin" :db.unique/identity]
+                        [:name :string]
+                        [:version :string] ; not null

-            ;; Example types: :project :course-competency ... TODO: enum?
-            [:type :string] ; not null
-            [:duration-rating-days :bigint]
-            [:comps :ref :many]
-            [:credit-value-numerator :bigint]
-            [:credit-value-denominator :bigint]]
-    :dbfns [(constraints/unique :perf-asmt :name :version :type)
-            (constraints/unique :perf-asmt :id-sk :id-sk-origin)]}
-   {:namespace :task
-    :attrs [[:id-sk :string]
-            [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
-            [:name :string]
-            [:version :string]
-            [:description :string]
+                        ;; Example types: :project :course-competency ... TODO: enum?
+                        [:type :string] ; not null
+                        [:duration-rating-days :bigint]
+                        [:comps :ref :many]
+                        [:credit-value-numerator :bigint]
+                        [:credit-value-denominator :bigint]]
+               :dbfns [(constraints/unique :perf-asmt :name :version :type)
+                       (constraints/unique :perf-asmt :id-sk :id-sk-origin)]}]
+   [:task {:attrs [[:id-sk :string]
+                   [:id-sk-origin :keyword] ; e.g., :moodle, :show-evidence, etc.
+                   [:id-sk-with-origin :string "Combined id-sk and id-sk-origin" :db.unique/identity]
+                   [:name :string]
+                   [:version :string]
+                   [:description :string]

             ;; TODO: is this correct?
             [:comps :ref :many]]


do not render title if it's nil

do not render title if it's nil

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -67,8 +67,10 @@
       (when image-url (topic-image image-url))
        [:tr
         [:th {:class "small-12 large-12 columns first last"}
-          (spacer 24)
-          [:p {:class "topic-title"} (s/upper-case (:title topic))]
+          (when (:title topic)
+            (spacer 24))
+          (when (:title topic)
+            [:p {:class "topic-title"} (s/upper-case (:title topic))])
           (spacer 1)
           [:p {:class "topic-headline"} (:headline topic)]
           (when body? (spacer 2))
@@ -153,8 +155,10 @@
     [:table {:class "row topic"}
       [:tr
         [:th {:class "small-12 large-12 columns first last"}
-          (spacer 24)
-          [:p {:class "topic-title"} (s/upper-case (:title topic))]
+          (when (:title topic)
+            (spacer 24))
+          (when (:title topic)
+            [:p {:class "topic-title"} (s/upper-case (:title topic))])
           (spacer 1)
           [:p {:class "topic-headline"} (:headline topic)]
           (when body? (spacer 2))


updating collection-resource-test to make it platform-independent

As edn output formatting uses (prn-str) the length of the content it produces will be platform-dependent due to the platform-specific newline it appends to the end of the produced string.

--- test/yada/collection_resource_test.clj
+++ test/yada/collection_resource_test.clj
@@ -2,25 +2,27 @@

 (ns yada.collection-resource-test
   (:require
-   [clojure.set :as set]
-   [clojure.test :refer :all]
-   [clojure.tools.logging :refer :all]
-   [clojure.pprint :refer [pprint]]
-   [ring.mock.request :as mock]
-   [clojure.java.io :as io]
-   [clj-time.core :as time]
-   [clj-time.coerce :refer [to-date]]
-   [ring.util.time :refer (parse-date format-date)]
-   [yada.representation :as rep]
-   [yada.test.util :refer (to-string)]
-   [yada.yada :refer [yada]]))
+    [clojure.set :as set]
+    [clojure.test :refer :all]
+    [clojure.tools.logging :refer :all]
+    [clojure.pprint :refer [pprint]]
+    [ring.mock.request :as mock]
+    [clojure.java.io :as io]
+    [clj-time.core :as time]
+    [clj-time.coerce :refer [to-date]]
+    [ring.util.time :refer (parse-date format-date)]
+    [yada.representation :as rep]
+    [yada.test.util :refer (to-string)]
+    [yada.yada :refer [yada]]
+    [clojure.edn :as edn]))

 (defn yesterday []
   (time/minus (time/now) (time/days 1)))

 (deftest map-resource-test
   (testing "map"
-    (let [handler (time/do-at (yesterday) (yada {:name "Frank"}))
+    (let [test-map {:name "Frank"}
+          handler (time/do-at (yesterday) (yada test-map))
           request (mock/request :get "/")
           response @(handler request)
           last-modified (some-> response :headers (get "last-modified") parse-date)]
@@ -30,12 +32,13 @@

       (is (= 200 (:status response)))
       (is (= {"content-type" "application/edn"
-              "content-length" 16} (select-keys (:headers response) ["content-type" "content-length"])))
+              "content-length" (count (prn-str test-map))}
+             (select-keys (:headers response) ["content-type" "content-length"])))
       (is (instance? java.nio.HeapByteBuffer (:body response)))
+      (is (= test-map
+             (-> response :body to-string edn/read-string)))

       (let [request (merge (mock/request :get "/")
                            {:headers {"if-modified-since" (format-date (to-date (time/now)))}})
             response @(handler request)]
         (is (= 304 (:status response)))))))
-
-


Use dyncfg in core module

Use dyncfg in core module


cleaner

cleaner

--- exercism/clojure/phone-number/src/phone_number.clj
+++ exercism/clojure/phone-number/src/phone_number.clj
@@ -1,9 +1,7 @@
 (ns phone-number
   (:require [clojure.string :as str]))

-(defrecord PhoneNumber [area exchange line])
-
-(defn- validate [s]
+(defn number [s]
   (let [c (str/replace s #"\D" "")
         n (count c)]
     (cond
@@ -11,32 +9,8 @@
       (and (= 11 n) (str/starts-with? c "1")) (subs c 1)
       :else "0000000000")))

-(defn- parse [s]
-  (->> s
-       (re-find #"(\d{3})(\d{3})(\d{4})")
-       rest
-       (apply ->PhoneNumber)))
+(defn area-code [s]
+  (subs (number s) 0 3))

-(defn- to-phone-number [s]
-  (-> s validate parse))
-
-(defn- flat [p]
-  (let [a (:area p)
-        e (:exchange p)
-        l (:line p)]
-    (str a e l)))
-
-(defn- formatted [p]
-  (let [a (:area p)
-        e (:exchange p)
-        l (:line p)]
-    (format "(%s) %s-%s" a e l)))
-
-(defn number [s]
-  (-> s to-phone-number flat))
-
-(defn area-code [s]
-  (-> s to-phone-number :area))
-
-(defn pretty-print [s] s
-  (-> s to-phone-number formatted))
+(defn pretty-print [s]
+  (str/replace (number s) #"(\d{3})(\d{3})(\d{4})" "($1) $2-$3"))


debugger: added comment

debugger: added comment

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -376,7 +376,7 @@
          [:div (pr-str action)])]

       (when enabled?
-        [:div {:style    {:display          "flex"
+        [:div {:style    {:display          "flex"          ; for text centering
                           :margin-left      "5px"
                           :border-radius    "3px"
                           :cursor           "pointer"


Исправление..

Исправление..

--- radiolamp-6P3/project.clj
+++ radiolamp-6P3/project.clj
@@ -20,7 +20,7 @@
                  [clj-time "0.12.0"]

                  ;;[org.postgresql/postgresql "9.4.1211"]
-                 [postgresql "9.4-1206-jdbc41"]
+                 [org.postgresql/postgresql "9.4-1206-jdbc41"]
                  [korma "0.4.2"]


16-20

--- src/sandbox/4clojure.clj
+++ src/sandbox/4clojure.clj
@@ -44,3 +44,19 @@

 ;;15 Double Down
 (partial * 2)
+
+
+;;16 Hello World
+#(str "Hello, " % "!")
+
+;;17 Sequences: map
+'(6 7 8)
+
+;;18 Sequences: filter
+[6 7]
+
+;;19 Last Element
+#(if (empty? (rest %)) (first %) (recur (rest %)))
+
+;;20 Penultimate Element
+#(if (empty? (rest(rest %))) (first %) (recur (rest %)))


db fixes

db fixes

--- src-clj/acha/db.clj
+++ src-clj/acha/db.clj
@@ -105,11 +105,11 @@
     order by timestamp asc limit 1"])))

 (defn- try-to-update [repo]
-  (update! db :repo {:timestamp "datetime('now')"}
+  (update! db :repo {:timestamp (.toLocaleString (java.util.Date.))}
     ["id = ? and timestamp = ?" (:id repo) (:timestamp repo)]))

 (defn get-next-repo-to-process []
-  (let [repo (get-next-repo)]
+  (when-let [repo (get-next-repo)]
     (if (try-to-update repo) repo [])))

 (defn insert-achievement [body]


update iterates through rockets and bumps them up one on the x axis, its a start

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -21,11 +21,17 @@
         new-rocket {:pos-x (rand-int (aget game-world :width))
                     :pos-y (aget game-world :height)
                     :angle (- 45 (rand-int 90))}]
-    (aset game-world :rockets
-      (conj rockets new-rocket))))
+    (aset game-world
+      :rockets (conj rockets new-rocket))))

 (defn update [game-world]
-  (.log js/console "update"))
+  (aset game-world
+    :rockets (map
+               (fn [r]
+                 {:pos-x (get r :pos-x)
+                  :pos-y (- (get r :pos-y) 1)
+                  :angle (get r :angle)})
+               (aget game-world :rockets))))

 (defn clear-for-frame [graphics-context]
   (let [canvas (aget graphics-context "canvas")


add old ref schedule for today

add old ref schedule for today

--- src/ceres_collector/scheduler.clj
+++ src/ceres_collector/scheduler.clj
@@ -44,6 +44,7 @@
               ["Users" (create-backup-job "Users")]
               ["Htmls" (create-backup-job "Htmls")]
               ["Urls" (create-backup-job "Urls")]
+              ["Refs" (create-backup-job "Refs")]
               ["Tags" (create-backup-job "Tags")]
               ["Mentions" (create-backup-job "Mentions")]
               ["Sources" (create-backup-job "Sources")]


Add information about ratings order

Add information about ratings order

--- src/clj/chili_dog_night/views.clj
+++ src/clj/chili_dog_night/views.clj
@@ -203,6 +203,7 @@
            [:p "The order below has been determined via random head to head voting. Each film is given an initial base rating that is updated per the "
             (el/link-to "https://en.wikipedia.org/wiki/Elo_rating_system" "Elo rating system")
             ". That is to say adjustments are made to winner and loser based on the expected result versus the actual result for any given dual."]
+           [:p "They films are ordered from worst to least worst (best)."]
            [:ol
             (map #(vec [:li (film-citation %)]) media)]]))


improve error handling in calculate function

--- src/clj/ikea_clojure_cup/pack.clj
+++ src/clj/ikea_clojure_cup/pack.clj
@@ -33,8 +33,8 @@
                                     (conj v (map #(assoc % :id (count v) :name name) packages)))
                                   []
                                   products))
-        items (cs/join "," (map package->string packages))
-        url (format "http://www.packit4me.com/api/call/raw?bins=%s&items=%s" bins items)
+        items (when (seq packages) (cs/join "," (map package->string packages)))
+        url (format "http://www.packit4me.com/api/call/raw?bins=%s&items=%s" bins (or items "0:0:0:0x0x0"))
         response (http-kit/post url)
         packing-details (json/read-str (:body @response) :key-fn keyword)
         requested-items-count (count packages)
@@ -62,7 +62,7 @@
       (cs/replace #"createLegend\(container\);" "")))

 (defn preview [bins items]
-  (let [response (http-kit/post (format "http://www.packit4me.com/api/call/preview?bins=%s&items=%s&binId=0" bins items))]
+  (let [response (http-kit/post (format "http://www.packit4me.com/api/call/preview?bins=%s&items=%s&binId=0" bins (if (seq items) items "0:0:0:0x0x0")))]
     (transform-preview (:body @response))))


Uniformaze board name

Uniformaze board name

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -63,7 +63,7 @@
 (defn- get-stash
   "Gets the current stash"
   [game]
-  (get-in game ["battle" "stash" (get-in game ["viewed-by" "player-code"])]))
+  (get-in game ["board" "stash" (get-in game ["viewed-by" "player-code"])]))

 (defn- game-stash
   "Shows the current stash if available"
@@ -106,7 +106,7 @@
   "Renders a board's cell"
   [game x y]
   (let [coordCode (str "[" x " " y "]")
-        element (get-in game ["battle" "elements" coordCode])
+        element (get-in game ["board" "elements" coordCode])
         css (get-element-css game element)]
     (dom/td #js {:className css}
       (dom/p #js {:className "boardCoords"} coordCode)
@@ -177,7 +177,7 @@
         current-action (state/get-state :processing-action)
         new-actions (conj actions current-action)
         current-game (state/get-state :game-data)
-        updated-game (assoc current-game "battle" (or (get data "p2-focused-board") (get data "board")))]
+        updated-game (assoc current-game "board" (or (get data "p2-focused-board") (get data "board")))]
     (println updated-game)
     (state/set-state :game-data updated-game)
     (state/set-state :current-actions new-actions)
@@ -188,6 +188,17 @@
   "Error loading action"
   []
   (state/set-state :processing-action nil))
+
+(defn- game-deployed
+  "After the game was deployed"
+  [data]
+  (println (state/get-state :game-data))
+  (println "--game deployed")
+  (println data)
+  (state/set-state :game-data data)
+  (state/set-state :current-actions nil)
+  (state/set-state :processing-action nil)
+    )

 (defn- deploy-game
   "Deploys a game"
@@ -201,7 +212,7 @@
     (state/set-state :processing-action actions)
     (PUT url {:params {:actions actions}
               :format :json
-              :handler action-added
+              :handler game-deployed
               :error-handler error-loading-action})))

 (defn- add-action
@@ -236,8 +247,8 @@
   (let [player-code (get-in state [:game-data "viewed-by" "player-code"])]
     (cond
       (state :processing-action) "disabled"
-      (not= "deploy" (get-in state [:original-game-data "battle" "state"])) "disabled"
-      (empty? (get-in state [:game-data "battle" "stash" player-code])) ""
+      (not= "deploy" (get-in state [:original-game-data "board" "state"])) "disabled"
+      (empty? (get-in state [:game-data "board" "stash" player-code])) ""
       :else "disabled")))

 (defn- render-action-console


only trigger by 'p' no modify keys

only trigger by 'p' no modify keys

--- src/cljs/github_omnibar/core.cljs
+++ src/cljs/github_omnibar/core.cljs
@@ -144,7 +144,12 @@
   (r/render [omnibar] (.getElementById js/document "omnibar")))

 (.append (js/$ "body") (js/$ "

"))
-(.keydown (js/$ js/document) (fn [e]
-                               (if (and (= 80 (.-which e)) (= "BODY" (.-nodeName (.-target e))))
-                                 (swap! omni-data assoc :display true))))
+(.keypress (js/$ js/document)
+          (fn [e]
+            (if (and (= 112 (.-which e))
+                     (not (.-ctrlKey e))
+                     (not (.-metaKey e))
+                     (not (.-altKey e))
+                     (= "BODY" (.-nodeName (.-target e))))
+              (swap! omni-data assoc :display true))))
 (mount-root)


Sort the games list so open games show first, then games in progress.

--- src/cljs/netrunner/gamelobby.cljs
+++ src/cljs/netrunner/gamelobby.cljs
@@ -31,7 +31,10 @@
         (case (:type msg)
           "game" (do (swap! app-state assoc :gameid (:gameid msg))
                      (when (:started msg) (launch-game nil)))
-          "games" (do (swap! app-state assoc :games (sort-by :date > (vals (:games msg))))
+          "games" (do (swap! app-state assoc :games
+                             (sort-by #(vec (map (assoc % :started (not (:started %)))
+                                                 [:started :date]))
+                                      > (vals (:games msg))))
                       (when-let [sound (:notification msg)]
                         (when-not (:gameid @app-state)
                           (.play (.getElementById js/document sound)))))


Fix bug when state is discarded after number click.

--- src/cljs/nonojure/puzzleview.cljs
+++ src/cljs/nonojure/puzzleview.cljs
@@ -347,7 +347,7 @@
                      :mouseenter-cell (handle-mouse-enter-on-cell evt state)
                      :mouseup-cell (check-solution (stop-dragging state))
                      :mouseleave-board (cancel-dragging state)
-                     :number-click (handle-number-click evt)
+                     :number-click (do (handle-number-click evt) state)
                      :clear (do (clear-puzzle) initial-state)
                      :mouseleave-drawing-board (do (highlight-row-col -1 -1) state)
                      (do (log (str "Unknown event: " event-type)) state))]


Add case default for unhandled sente events

--- src/cljs/onyx_dashboard/core.cljs
+++ src/cljs/onyx_dashboard/core.cljs
@@ -36,7 +36,8 @@
       :chsk/state (when (:first-open? msg)
                     (chsk-send! [:deployment/get-listing])
                     (swap! app-state assoc :ready? true)
-                    (println "First opened: " event)))))
+                    (println "First opened:" event))
+      (println "Unhandled event:" event))))

 (sente/start-chsk-router! ch-chsk sente-event-handler)


refactor move

refactor move

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -31,13 +31,13 @@
   (or (nil? cell) (= cell :empty) (= cell :wall)))

 (defn- walk-dir
-  [[x y] [dx dy]]
+  [[dx dy] [x y]]
   [(+ x dx) (+ y dy)])

 (defn- available-cells-by-dir
   "Indicates the convertible cells when clicking at [x y]"  ;; TODO - Refactor & Test
-  [board initial-coord direction]
-  (loop [coord (walk-dir initial-coord direction)
+  [board init-coord next-coord]
+  (loop [coord (next-coord init-coord)
          looser nil
          taken []]
     (let [cell (board/get-cell-at board coord)]
@@ -45,11 +45,12 @@
         (is-not-convertible? cell) nil                        ;; No move: reached end and only 1 type of cell
         (and looser (not= looser cell)) {:winner cell         ;; Who wins the cells
                                          :looser looser       ;; Who looses the cells
-                                         :point initial-coord ;; The move performed
+                                         :point init-coord    ;; The move performed
                                          :taken taken}        ;; The cells taken
         :else (recur
-                (walk-dir coord direction)
-                cell (conj taken coord)))
+                (next-coord coord)
+                cell
+                (conj taken coord)))
       )))

 (defn- available-conversions-at
@@ -57,7 +58,7 @@
   [board point]
   (eduction
     (keep #(available-cells-by-dir board point %))
-    cst/directions))
+    (map #(partial walk-dir %) cst/directions)))

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


simplify move

simplify move

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -91,7 +91,5 @@
 (defn apply-conversion
   "Apply a move onto the board, yielding a new board"
   [board move]
-  (reduce
-    #(assoc-in %1 %2 (:winner move))
-    board
-    (:taken move)))
+  (let [updates (map vector (:taken move) (repeat (:winner move)))]
+    (board/update-cells board updates)))


calc mods

calc mods

--- src/clojush/experimental/calc.clj
+++ src/clojush/experimental/calc.clj
@@ -83,6 +83,7 @@
 (def button-entrypoints
   (zipmap buttons (iterate #(+ % 100) 0)))

+
 ; button-entrypoints

 (define-registered
@@ -189,7 +190,7 @@
   ;;   determine errors from float and boolean stacks
   (let [correct 0.0
         incorrect 1000000000.0
-        first-run-result (run-push (remove-noops program)
+        first-run-result (run-push program ;(remove-noops program)
                                    (tag-before-entry-points (make-push-state)))
         initialized-push-state (push-item
                                    0.0
@@ -204,13 +205,19 @@
                                    ;(println "TEST:" t)
                                    ;(println "FINAL STATE:" push-state)
                                    (if (not (number? top))
-                                     [incorrect incorrect]
-                                      (if (== top target)
+                                     [incorrect
+                                      ;incorrect
+                                      ]
+                                      (if ;(== top target)
+                                        (< (Math/abs (- top target)) 0.00001)
                                         ;; correct
-                                        [correct correct]
+                                        [correct
+                                         ;correct
+                                         ]
                                         ;incorrect
                                         [(Math/abs (- top target))
-                                         (float (levenshtein-distance (str top) (str target)))]))
+                                         ;(float (levenshtein-distance (str top) (str target)))
+                                         ]))
                                     ;;
                                     ;; error signal error
                                     #_(if (nth t 2)
@@ -241,7 +248,7 @@
                        (for [t (vals button-entrypoints)]
                          (fn [] (symbol (str "tag_exec_" (str t)))))
                        [(tagged-instruction-erc)]
-                       (repeat 46 'code_noop)
+                       ;(repeat 46 'code_noop)
                        '(boolean_and
                           boolean_dup
                           boolean_eq
@@ -453,7 +460,7 @@
    ;:use-historically-assessed-hardness true ;; just to print them!
    ;:decimation-ratio 0.01
    ;:tournament-size 1
-   :population-size 500 ;200 ;50
+   :population-size 1000 ;200 ;50
    :max-generations 10001
    :evalpush-limit 3000
    :tag-limit 10000
@@ -465,9 +472,9 @@
    :simplification-probability 0
    :reproduction-simplifications 10
    :ultra-probability 1.0
-   :ultra-alternation-rate 0.001
+   :ultra-alternation-rate 0.005
    :ultra-alignment-deviation 5
-   :ultra-mutation-rate 0.01
+   :ultra-mutation-rate 0.005
    :deletion-mutation-probability 0
    :parentheses-addition-mutation-probability 0
    :tagging-mutation-probability 0
@@ -479,5 +486,6 @@
    :pop-when-tagging true
    :report-simplifications 0
    :print-history false
-   :use-bushy-code true
+   ;:use-bushy-code true
+   :use-ultra-no-paren-mutation true
   })


Finished first implementation of generators

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

--- src/conexp/contrib/generators.clj
+++ src/conexp/contrib/generators.clj
@@ -1,5 +1,4 @@
 (ns conexp.contrib.generators
-  (:use [clojure.contrib.macro-utils :only (macrolet)])
   (:use [clojure.contrib.def])
   (:import [java.util.concurrent SynchronousQueue]
 	   [java.util NoSuchElementException]))
@@ -28,18 +27,29 @@
 ;;                  (for [i (range x)]
 ;;                    (yield i)))
 ;;                100)
-;;   -> () ; or even nothing (?)
-;; but this does
+;;   -> ()
+;; but this does:
 ;;   (generate-by (fn runner [x]
 ;;                  (doseq [i (range x)]
 ;;                    (yield i)))
 ;;                100)
 ;;   -> (0 1 2 3 ...)

-(set! *warn-on-reflection* true)
+;; Note: Normally generators are "function" returning different values
+;; on different calls (hence they are not functions, actually). Here
+;; generators are thought of as functions returning "function" which
+;; generate the different values. These functions also throw
+;; NoSuchElementExceptions when there is nothing left to
+;; generate. (See also iterators)

-(defmacro make-generator
-  ""
+
+;; Generators
+
+(defmacro- make-generator
+  "Creates a generator from the given function definition, which may
+  use the function \"yield\". The result may be called with arguments
+  to give a function returning all yielded values on subsequent
+  calls."
   [function]
   `(fn [& args#]
      (let [#^SynchronousQueue queue# (SynchronousQueue.),
@@ -61,15 +71,16 @@
 		(java.util.NoSuchElementException. "No more elements to generate."))
 	       next#)))))))

-(defmacro defg
-  ""
-  [name args & body] ; enable docstrings?
+(defmacro- defg
+  "Globally def'ines a generator. When given some arguments a function
+  is returned yielding all \"yield\"ed values on subsequent calls."
+  [name args & body]
   `(defn ~name [& args#]
      (let [gen# (make-generator (fn ~name ~args ~@body))]
        (apply gen# args#))))

-(defn generate
-  ""
+(defn- generate
+  "Collects all values generated by the generator into a lazy sequence."
   [generator]
   (let [eos (gensym),
 	runner (fn runner []
@@ -84,8 +95,34 @@
     (runner)))

 (defmacro generate-by
-  ""
+  "Colletcs all values \"yield\"ed by the function. The definition of
+  function may use the special function \"yield\" with an additional
+  argument. All these values are than collected into a lazy sequence.
+
+  Example:
+
+    (generate-by (fn [x]
+                   (doseq [i (range x)]
+                     (yield i)))
+                 5)
+
+    -> (0 1 2 3 4)
+
+  Note that you have to call yield explicitly. When you wrap a call to
+  yield into a lazy sequence this call may not be done at all. For example
+
+    (generate-by (fn [x]
+                   (for [i (range x)]
+                     (yield i)))
+                 5)
+
+    -> ()"
   [function & args]
-  `(generate (apply (make-generator ~function) '~args)))
+  `(generate ((make-generator ~function) ~@args)))
+
+
+;; Coroutines
+
+

 nil


Adds proper use of vendor prefix for match-parent.

This will generate CSS with prefixed and non-prefixed match-parent rules for list-items' alignment. This is supported in most modern browsers, only Safari requires a vendor prefix.

--- src/day8/re_frame_10x/styles.cljs
+++ src/day8/re_frame_10x/styles.cljs
@@ -124,8 +124,10 @@
      :box-sizing         "border-box"
      :margin-top         "3px"}]

-   [:li {:display    "list-item"
-         :text-align "-webkit-match-parent"}]
+   [:li {:display "list-item"}]
+   [:li
+    ^{:prefix true :vendors [:webkit]}
+    {:text-align "match-parent" }]

    [:table :thead :tbody :tfoot :tr :th :td
     {:display                           "block"


Optimization: allow `compare-and-set` to use hash comparisons for any arb data

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -248,18 +248,25 @@
   (let [script-val (encore/slurp-resource "lua/misc/cas_val.lua")
         script-sha (encore/slurp-resource "lua/misc/cas_sha.lua")]
     (fn [k old-val new-val]
-      (case old-val
+      (if (= old-val :redis/nx)
         ;; Could also do with
         ;; sha = redis.sha1hex(nil) = "da39a3ee5e6b4b0d3255bfef95601890afd80709"
         ;;    != redis.sha1hex(<serialized-nil>):
-        :redis/nx (setnx k new-val)
-        (if-let [sha ; Can only hash for string vals; only worth doing for large ones
-                 (when (and (string? new-val) (> (count new-val) 40))
-                   (str-sha new-val))]
-          (lua script-sha {:k k} {:old-val-sha sha :new-val new-val})
-          (lua script-val {:k k} {:old-val old-val :new-val new-val}))))))
-
-(comment (wcar {} (del "cas-k") (compare-and-set "cas-k" :redis/nx 1)))
+        (setnx k new-val)
+        (let [bs-old-val    (protocol/coerce-bs old-val)
+              just-use-val? (< (count bs-old-val) 40) #_false
+              ?sha
+              (when-not just-use-val?
+                (org.apache.commons.codec.digest.DigestUtils/sha1Hex
+                  ^bytes bs-old-val))]
+          (if-let [sha ?sha]
+            (lua script-sha {:k k} {:old-val-sha sha :new-val new-val})
+            (lua script-val {:k k} {:old-val old-val :new-val new-val})))))))
+
+(comment
+  (wcar {} (del "cas-k") (compare-and-set "cas-k" :redis/nx [:foo]))
+  (wcar {} (compare-and-set "cas-k" [:foo] [:bar]))
+  (wcar {} (get "cas-k")))

 ;;;


`wcar` docstring housekeeping

`wcar` docstring housekeeping

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -15,9 +15,9 @@
 (encore/defalias with-replies protocol/with-replies)

 (defmacro wcar
-  "Evaluates body in the context of a thread-bound pooled connection to Redis
-  server. Sends Redis commands to server as pipeline and returns the server's
-  response. Releases connection back to pool when done.
+  "Evaluates body in the context of a fresh thread-bound pooled connection to
+  Redis server. Sends Redis commands to server as pipeline and returns the
+  server's response. Releases connection back to pool when done.

   `conn-opts` arg is a map with connection pool and spec options:
     {:pool {} :spec {:host \"127.0.0.1\" :port 6379}} ; Default
@@ -28,9 +28,11 @@
                      :db 3}}

   A `nil` or `{}` `conn-opts` will use defaults. A `:none` pool can be used
-  to skip connection pooling.
+  to skip connection pooling (not recommended).
   For other pool options, Ref. http://goo.gl/e1p1h3,
-                               http://goo.gl/Sz4uN1 (defaults)."
+                               http://goo.gl/Sz4uN1 (defaults).
+
+  See also `with-replies`."
   {:arglists '([conn-opts :as-pipeline & body] [conn-opts & body])}
   ;; [conn-opts & [s1 & sn :as sigs]]
   [conn-opts & sigs]


Allow client-opts to specify 'region'

Allow client-opts to specify 'region'

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -151,7 +151,7 @@
     (db-client* {:creds my-AWSCredentials-instance}),
     etc."
   (memoize
-   (fn [{:keys [client endpoint] :as client-opts}]
+   (fn [{:keys [client endpoint region] :as client-opts}]
      (if (empty? client-opts)
        (AmazonDynamoDBClient.) ; Default client
        (let [[^AWSCredentials aws-creds
@@ -160,7 +160,8 @@
          (doto-cond [g (cond client client
                              provider (AmazonDynamoDBClient. provider client-config)
                              :else (AmazonDynamoDBClient. aws-creds client-config))]
-           endpoint (.setEndpoint g)))))))
+           endpoint (.setEndpoint g)
+           region (.setRegion g)))))))

 (def ^:private db-streams-client*
   "Returns a new AmazonDynamoDBStreamsClient instance for the given client opts:
@@ -168,7 +169,7 @@
     (db-streams-client* {:access-key \"<AWS_DYNAMODB_ACCESS_KEY>\"
                          :secret-key \"<AWS_DYNAMODB_SECRET_KEY>\"}), etc."
   (memoize
-    (fn [{:keys [client endpoint] :as client-opts}]
+    (fn [{:keys [client endpoint region] :as client-opts}]
       (if (empty? client-opts)
         (AmazonDynamoDBStreamsClient.) ; Default client
         (let [[^AWSCredentials aws-creds
@@ -177,7 +178,8 @@
           (doto-cond [g (cond client client
                               provider (AmazonDynamoDBStreamsClient. provider client-config)
                               :else (AmazonDynamoDBStreamsClient. aws-creds client-config))]
-            endpoint (.setEndpoint g)))))))
+            endpoint (.setEndpoint g)
+            region (.setRegion g)))))))

 (defn- db-client ^AmazonDynamoDB [client-opts] (db-client* client-opts))
 (defn- db-streams-client ^AmazonDynamoDBStreams [client-opts] (db-streams-client* client-opts))