Small fix

Small fix

--- src/cljs/salava/social/ui/dashboard.cljs
+++ src/cljs/salava/social/ui/dashboard.cljs
@@ -512,7 +512,7 @@
         service (-> (clojure.string/split service #"=") second)]
     (when (and service _)
      (do
-       (.push js/dataLayer (clj->js {:event "virtualPage" :vpv "app/user/register/complete" :registration-method (str service "-oauth")}))
+       (.push window.dataLayer (clj->js {:event "virtualPage" :vpv "app/user/register/complete" :registration-method (str service "-oauth")}))
        (.pushState js/history "" "dashboard" (path-for "/social"))))))

 (defn handler [site-navi]


fix message

fix message

--- src/cljs/swarmpit/component/message.cljs
+++ src/cljs/swarmpit/component/message.cljs
@@ -57,9 +57,10 @@

 (rum/defc message < rum/reactive []
   (let [{:keys [open type text]} (state/react message-cursor)]
-    (case type
-      :info (info-message text open)
-      :error (error-message text open))))
+    (comp/mui
+      (case type
+        :info (info-message text open)
+        :error (error-message text open)))))

 (defn mount!
   []


Changed some map to mapv in hopes of eliminating GC crashes.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -553,8 +553,8 @@
   [ind {:keys [uniform-deletion-rate maintain-ancestors] :as argmap}]
   (let [rate (number uniform-deletion-rate)
         new-genome (vec (filter identity
-                                (map #(if (< (lrand) rate) nil %)
-                                     (:genome ind))))]
+                                (mapv #(if (< (lrand) rate) nil %)
+                                      (:genome ind))))]
     (make-individual :genome new-genome
                      :history (:history ind)
                      :age (inc (:age ind))
@@ -572,12 +572,12 @@
   [ind {:keys [uniform-addition-rate maintain-ancestors atom-generators] :as argmap}]
   (let [rate (number uniform-addition-rate)
         new-genome (vec (apply concat
-                               (map #(if (< (lrand) rate)
-                                      (lshuffle [%
-                                                 (random-plush-instruction-map
-                                                   atom-generators argmap)])
-                                      [%])
-                                    (:genome ind))))]
+                               (mapv #(if (< (lrand) rate)
+                                        (lshuffle [%
+                                                   (random-plush-instruction-map
+                                                     atom-generators argmap)])
+                                        [%])
+                                     (:genome ind))))]
     (make-individual :genome new-genome
                      :history (:history ind)
                      :age (inc (:age ind))
@@ -601,15 +601,15 @@
                         0
                         (/ 1 (+ (/ 1 addition-rate) 1)))
         after-addition (vec (apply concat
-                                   (map #(if (< (lrand) addition-rate)
-                                           (lshuffle [%
-                                                      (random-plush-instruction-map
-                                                        atom-generators argmap)])
-                                           [%])
-                                        (:genome ind))))
+                                   (mapv #(if (< (lrand) addition-rate)
+                                            (lshuffle [%
+                                                       (random-plush-instruction-map
+                                                         atom-generators argmap)])
+                                            [%])
+                                         (:genome ind))))
         new-genome (vec (filter identity
-                                (map #(if (< (lrand) deletion-rate) nil %)
-                                     after-addition)))]
+                                (mapv #(if (< (lrand) deletion-rate) nil %)
+                                      after-addition)))]
     (make-individual :genome new-genome
                      :history (:history ind)
                      :age (inc (:age ind))
@@ -636,15 +636,15 @@
                         (/ 1 (+ (/ 1 combination-rate) 1)))
         after-combination (vec
                             (apply concat
-                                   (map (fn [g1 g2]
-                                          (if (< (lrand) combination-rate)
-                                            (lshuffle [g1 g2])
-                                            [g1]))
-                                        (:genome parent1)
-                                        (cycle (:genome parent2)))))
+                                   (mapv (fn [g1 g2]
+                                           (if (< (lrand) combination-rate)
+                                             (lshuffle [g1 g2])
+                                             [g1]))
+                                         (:genome parent1)
+                                         (cycle (:genome parent2)))))
         new-genome (vec (filter identity
-                                (map #(if (< (lrand) deletion-rate) nil %)
-                                     after-combination)))]
+                                (mapv #(if (< (lrand) deletion-rate) nil %)
+                                      after-combination)))]
     (make-individual :genome new-genome
                      :history (:history parent1)
                      :age ((age-combining-function argmap) parent1 parent2 new-genome)
@@ -736,12 +736,12 @@
                                           (repeat (- (count long-genome) (count short-genome))
                                                   'uniform-padding))
           new-genome (vec (remove-uniform-padding
-                            (map (fn [x1 x2]
-                                   (if (< (lrand) 0.5)
-                                     x1
-                                     x2))
-                                 short-genome-lengthened
-                                 long-genome)))]
+                            (mapv (fn [x1 x2]
+                                    (if (< (lrand) 0.5)
+                                      x1
+                                      x2))
+                                  short-genome-lengthened
+                                  long-genome)))]
       (make-individual :genome new-genome
                        :history (:history parent1)
                        :age ((age-combining-function argmap) parent1 parent2 new-genome)
@@ -1179,6 +1179,3 @@
         :is-random-replacement
         (if use-child false true)))))

-
-
-


I suck at markdown

I suck at markdown

--- caching/src/immutant/caching.clj
+++ caching/src/immutant/caching.clj
@@ -37,23 +37,23 @@
    [default] value. A negative value for any numeric option means
    \"unlimited\".

-   Durability: entries can persist to disk via the `:persist` option.
-   If set to `true`, cache entries will persist in the current
-   directory. Override this by setting `:persist` to a string naming
-   the desired directory.
+   Durability: entries can persist to disk via the :persist option. If
+   set to `true`, cache entries will persist in the current directory.
+   Override this by setting :persist to a string naming the desired
+   directory.

-     `:persist` If non-nil, data persists across server restarts in
-                a file store; a string value names the directory [nil]
+   * :persist - if non-nil, data persists across server restarts in a
+                file store; a string value names the directory [nil]

-   Eviction: turned off by default, `:max-entries` may be set to
+   Eviction: turned off by default, :max-entries may be set to
    mitigate the risk of memory exhaustion. When :persist is enabled,
    evicted entries are written to disk, so that the entries in the
    file store are a superset of those in RAM, transparently reloaded
    upon request.

-     `:max-entries` The maximum number of entries allowed in the cache [-1]
-     `:eviction`    How entries are evicted when `:max-entries` is exceeded [:none]
-                    one of `:none`, `:lru`, `:lirs`, or `:unordered`
+   * :max-entries - the maximum number of entries allowed in the cache [-1]
+   * :eviction - how entries are evicted when :max-entries is exceeded [:none]
+                 one of :none, :lru, :lirs, or :unordered

    Expiration: both time-to-live and max idle limits are supported.
    Values may be a number of milliseconds, a period keyword, or
@@ -61,34 +61,33 @@
    singular and plural versions of :second, :minute, :hour, :day, and
    :week are valid period keywords.

-     `:ttl`  The max time the entry will live before expiry [-1]
-     `:idle` The time after which an entry will expire if not accessed [-1]
+   * :ttl - the max time the entry will live before expiry [-1]
+   * :idle - the time after which an entry will expire if not accessed [-1]

-   Replication: the replication mode defaults to `:dist-sync` when
-   clustered. When not clustered, the value of `:mode` is ignored, and
-   the cache will be `:local`. Asynchronous replication may yield a
+   Replication: the replication mode defaults to :dist-sync when
+   clustered. When not clustered, the value of :mode is ignored, and
+   the cache will be :local. Asynchronous replication may yield a
    slight performance increase at the risk of potential cache
    inconsistency.

-     `:mode` Replication mode [:dist-sync or :local]
-             one of :local, :repl-sync, :repl-async,
-             :invalidation-sync, :invalidation-async,
-             :dist-sync, :dist-async
+   * :mode - replication mode [:dist-sync or :local] one of :local,
+             :repl-sync, :repl-async, :invalidation-sync,
+             :invalidation-async, :dist-sync, :dist-async

    Transactions: caches can participate in transactions when a
    TransactionManager is available.

-     `:transactional` Whether the cache is transactional [false]
-     `:locking`       Transactional locking schemes [:optimistic]
-                      one of :optimisitic or :pessimistic
+   * :transactional - whether the cache is transactional [false]
+   * :locking - transactional locking schemes [:optimistic]
+                one of :optimisitic or :pessimistic

    Advanced configuration: the options listed above are the most
    commonly configured, but Infinispan has many more buttons,
    switches, dials, knobs and levers. Call the {{builder}} function to
    create your own Configuration instance and pass it in via the
-   `:configuration` option.
+   :configuration option.

-     `:configuration` an org.infinispan.configuration.cache.Configuration instance"
+   * :configuration - an org.infinispan.configuration.cache.Configuration instance"
   ([name]
     (cache name {}))
   ([name k v & kvs]
@@ -104,11 +103,11 @@
 (set-valid-options! cache (opts->set Caching$CreateOption))

 (defn with-codec
-  "Returns a cache that stores/retrieves entries in the passed cache
-  using the passed codec. The default is `:none` but the following are
-  supported: `:edn`, `:json`, and `:fressian`. To use the latter two,
-  the `cheshire` and `org.clojure/data.fressian` libraries,
-  respectively, must be available on the classpath."
+  "Takes a cache and a keyword denoting a codec, and returns a new
+  cache that encodes/decodes entries in the original using that codec.
+  The following codecs are supported: `:none`, `:edn`, `:json`, and
+  `:fressian`. The latter two require additional dependencies:
+  `cheshire` and `org.clojure/data.fressian`, respectively."
   [cache codec]
   (.encodedWith (component)
     (lookup-codec codec)
@@ -138,7 +137,7 @@
   (boolean (.find (component) name)))

 (defn stop
-  "Removes a cache, allowing it to be reconfigured by the cache
+  "Removes a cache, allowing it to be reconfigured by the {{cache}}
   function."
   [cache-or-name]
   (if (instance? org.infinispan.Cache cache-or-name)
@@ -146,10 +145,20 @@
     (.stop (component) (name cache-or-name))))

 (defn builder
-  "For advanced use, call this function to obtain a fluent Infinispan
-  configuration builder. Set the desired options, and invoke its build
-  method, the result from which can be passed in the :configuration
-  option of the cache function."
+  "For advanced use, call this function to obtain a \"fluent
+  Infinispan configuration builder\". Set the desired options, and
+  invoke its build method, the result from which can be passed in the
+  :configuration option of the {{cache}} function. For example:
+
+  ```
+  (let [config (.. (builder :ttl [30 :minutes])
+                  clustering l1 (enabled true) build)]
+    (cache \"L1\" :configuration config))
+  ```
+
+  Note that builder takes the same options as {{cache}} so you can
+  concisely initialize it with Clojure, and use Java interop to set
+  the more esoteric options"
   [& options]
   (Config/builder (-> options
                     kwargs-or-map->map


Fix repo to clone in meta-pipeline

Fix repo to clone in meta-pipeline

--- src/lambdacd_pipeline/pipelines/meta.clj
+++ src/lambdacd_pipeline/pipelines/meta.clj
@@ -5,7 +5,7 @@
             [lambdacd-git.core :as core]
             [lambdacd.steps.shell :as shell]))

-(def repo "https://github.com/flosell/lambdacd-pipeline")
+(def repo "https://github.com/flosell/lambdacd-demo-pipeline.git")

 (defn wait-for-git [args ctx]
   (core/wait-for-git ctx repo


Clean before deploying jars

Clean before deploying jars

--- src/leiningen/pallet_release/release.clj
+++ src/leiningen/pallet_release/release.clj
@@ -137,4 +137,5 @@
   [project args]
   (git/checkout "master")
   (git/pull)
+  (lein/clean project)
   (lein/deploy project))


Renamed the vertices of the facet, they're ordered not named

--- src/main/clojure/stl_collector/model.clj
+++ src/main/clojure/stl_collector/model.clj
@@ -4,4 +4,4 @@
 (def Vertex [ (s/one Float "x") (s/one Float "y") (s/one Float "z")])

 (def Facet {:normal Vertex
-            :vertices [(s/one Vertex "xs") (s/one Vertex "ys") (s/one Vertex "zs")]})
+            :vertices [(s/one Vertex "1") (s/one Vertex "2") (s/one Vertex "3")]})


actually supply token when getting/releasing derivatives

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -91,8 +91,8 @@

 ;; RUM specific code ===========================================================

-(let [get-k     ":derivatives/get"
-      release-k ":derivatives/release"]
+(let [get-k     (str ::get)
+      release-k (str ::release)]

   (defn rum-derivatives
     "Given the passed spec add get!/release! derivative functions to
@@ -126,11 +126,11 @@
           :will-mount    (fn [s]
                            (let [get-drv! (-> s :rum/react-component (gobj/get "context") (gobj/get get-k))]
                              (assert get-drv! "No get! derivative function found in component context")
-                             (assoc-in s [::derivatives drv-k] (get-drv! drv-k))))
+                             (assoc-in s [::derivatives drv-k] (get-drv! drv-k token))))
           :will-unmount  (fn [s]
                            (let [release-drv! (-> s :rum/react-component (gobj/get "context") (gobj/get release-k))]
                              (assert release-drv! "No release! derivative function found in component context")
-                             (release-drv! drv-k)
+                             (release-drv! drv-k token)
                              (update s ::derivatives dissoc drv-k)))}))))

 (def ^:dynamic *derivatives* nil)
@@ -150,12 +150,9 @@
   [state drv-k]
   (rum/react (get-ref state drv-k)))

-(def base (atom 0))
-
 (comment
-
-
-
+  (def base (atom 0))
+
   (def test-subman (subman (reactive-spec base)))

   ((:get! test-subman) :ainc "y")


fix old references using :system-config

fix old references using :system-config

was renamed to :user-config a while ago and missed renaming
these references.

--- src/main/shadow/cljs/devtools/server.clj
+++ src/main/shadow/cljs/devtools/server.clj
@@ -267,7 +267,7 @@

         disable-nrepl?
         (or (false? (:nrepl config))
-            (false? (get-in config [:system-config :nrepl])))
+            (false? (get-in config [:user-config :nrepl])))

         nrepl
         (when-not disable-nrepl?
@@ -363,7 +363,7 @@
     ;; this will clash with lein writing its own .nrepl-port so it is disabled by default
     (when (and nrepl
                (or (get-in config [:nrepl :write-port-file])
-                   (get-in config [:system-config :nrepl :write-port-file])))
+                   (get-in config [:user-config :nrepl :write-port-file])))
       (let [nrepl-port-file (io/file ".nrepl-port")]
         (spit nrepl-port-file (str (:port nrepl)))
         (swap! port-files-ref assoc :nrepl-port nrepl-port-file)


regexp quote searching for macros

regexp quote searching for macros

searching for prismatic.plubing/?> caused a crash because it contained
regex meta characters

--- src/refactor_nrepl/ns/dependencies.clj
+++ src/refactor_nrepl/ns/dependencies.clj
@@ -200,13 +200,15 @@
        (filter macro?)))

 (defn- macro-in-use? [file-content macro]
-  (when (-> macro
-            (str "\\b")
-            re-pattern
-            (re-find file-content)
-            empty?
-            not)
-    macro))
+  (let [m (java.util.regex.Pattern/quote (str macro))
+        before "(\\(?|,|`|'|\\s)\\s*"
+        after "\\s*\\)?"]
+    (when (-> (str before m after)
+              re-pattern
+              (re-find file-content)
+              empty?
+              not)
+      macro)))

 (defn- get-referred-macros [file-content libspecs]
   (remove nil? (flatten


Removed unused functions

Removed unused functions

--- src/research_clojure/runSimulation.clj
+++ src/research_clojure/runSimulation.clj
@@ -56,23 +56,6 @@
         [@grammar @grammarLearned (get @timeCourseVector 0) (get @timeCourseVector 1)]))

-(defn handle-request [sentences max_sentences]
-      (let [result (future (fn [] (doesChildLearnGrammar sentences max_sentences)))]
-        ; Do something else
-        (writeResults @result)))
-
-
-(defmacro enqueue
-   ([q concurrent-promise-name concurrent serialized]
-    `(let [~concurrent-promise-name (promise)]
-      (future (deliver ~concurrent-promise-name ~concurrent))
-       (deref ~q)
-      ~serialized
-      ~concurrent-promise-name))
-   ([concurrent-promise-name concurrent serialized]
-   `(enqueue (future) ~concurrent-promise-name ~concurrent ~serialized)))
-
-
 (defn runSimulation
   "max_eChildren number of eChildren will process
   max_sentences number of sentences."
@@ -83,5 +66,4 @@
       (recur (inc i) (conj results (doesChildLearnGrammar sentences max_sentences)))
       (writeResults results))))

-;(handle-request sentences max_sentences)
 ;(-> (enqueue grammar (doesChildLearnGrammar sentences max_sentences) (writeResults @grammar)))


Story ID: GEM-209 Summary: - Updating network to respond to XhrIo ERROR event

--- src/untangled/client/impl/network.cljs
+++ src/untangled/client/impl/network.cljs
@@ -32,9 +32,15 @@
     ;; Implies:  request was sent.
     ;; *Always* called if completed (even in the face of network errors).
     ;; Used to detect errors.
-    (if (zero? (.getStatus xhr-io))
-      (@error-callback {:type :network})
-      (@error-callback (cljs.reader/read-string (.getResponseText xhr-io)))))
+    (letfn [(log-and-dispatch-error [str error] (log/error str) (@error-callback error))]
+
+      (if (zero? (.getStatus xhr-io))
+        (log-and-dispatch-error
+          (str "UNTANGLED NETWORK ERROR: No connection established.")
+          {:type :network})
+        (log-and-dispatch-error
+          (str "SERVER ERROR CODE: " (.getStatus xhr-io))
+          (ct/read (t/reader) (.getResponseText xhr-io))))))

   UntangledNetwork
   (send [this edn ok err {:keys [headers]}]
@@ -52,7 +58,7 @@
                           :valid-data-callback (atom nil)
                           :error-callback      (atom nil)})]
     (events/listen xhrio (.-SUCCESS EventType) #(response-ok rv))
-    (events/listen xhrio (.-COMPLETE EventType) #(response-error rv))
+    (events/listen xhrio (.-ERROR EventType) #(response-error rv))
     rv))


Bump the deploy version

Bump the deploy version

--- src/circle/backend/project/circle.clj
+++ src/circle/backend/project/circle.clj
@@ -28,7 +28,7 @@
           :type :deploy
           :vcs-type :git
           :vcs-url "git@github.com:arohner/CircleCI.git"
-          :vcs-revision "2c24ff2bba2fd07ea7128195b4193eb2f1b2453d"
+          :vcs-revision "382279b1bd282f06a5aac1cbf5454cd7c997e45f"
           :num-nodes 1
           :lb-name "www"
           :group circle/circle-group


cljc implementation

cljc implementation

--- src/clj/sc_demo_page/statechart1.cljc
+++ src/clj/sc_demo_page/statechart1.cljc
@@ -1,26 +1,118 @@
 (ns sc-demo-page.statechart1
-  (:require [clojure.zip :as zip]))
+  (:require [clojure.zip :as zip]
+            [clojure.set :as set]))

 (defprotocol State
-  (initialize-state [this])
+  (initialize-statechart [this])
+  (initial-states [this])
   (substates [this])
-  (state-id [this]))
-
-(extend-protocol State
+  (state-id [this])
+  (state-type [this])
+  (state-transitions [this])
+  (entry-order [this])
+  (on-exit [this])
+  (on-enter [this])
+  (get-state [this id]))
+
+(defprotocol Transition
+  (trigger-event [this])
+  (target-state [this])
+  (source-state [this])
+  (internal? [this])
+  (on-trigger [this])
+  (applicable-transition? [this ctx]))
+
+(defn compound? [state]
+  (= (state-type state) :xor))
+
+(defn component? [state]
+  (= (state-type state) :and))
+
+(defn atomic? [state]
+  (not (or (compound? state)
+           (component? state))))
+
+
+(defn current-event [ctx]
+  (:current-event ctx))
+
+(defn current-event-id [ctx]
+  (first (current-event ctx)))
+
+(defn pop-event [ctx]
+  (let [event (-> ctx :internal-queue peek)]
+    (-> ctx
+        (assoc :current-event event)
+        (update :internal-queue pop))))
+
+(defn make-ctx [configuration fx event]
+  {:configuration  (->> configuration
+                        (filter atomic?)
+                        (into #{}))
+   :internal-queue (conj clojure.lang.PersistentQueue/EMPTY event)
+   :fx             fx})
+
+(extend-type
   clojure.lang.PersistentArrayMap
-  (initialize-state [this]
+
+  Transition
+  (trigger-event [this]
+    (:event this))
+  (target-state [this]
+    (get-state this (:target this)))
+  (source-state [this]
+    (get-state this (:source this)))
+  (internal? [this]
+    (:internal this false))
+  (on-trigger [this]
+    (:execute this))
+  (applicable-transition? [this ctx]
+    (let [event-id       (current-event-id ctx)
+          {:keys [condition]} this
+          trigger-event' (trigger-event this)]
+      (and (or (nil? trigger-event')
+               (= event-id trigger-event'))
+           (or (nil? condition)
+               (condition ctx)))))
+
+  State
+  (initialize-statechart [this]
     (case (:type this)
       :and
-      (mapcat initialize-state (vals (:states this)))
+      (mapcat initialize-statechart (vals (:states this)))

       :xor
-      [(get-in this [:states (:init this)])]
+      (initialize-statechart (get-in this [:states (:init this)]))

       [this]))
+  (initial-states [this]
+    (case (:type this)
+      :xor
+      (list (get-in this [:states (:init this)]))
+
+      :and
+      (vals (:states this))
+
+      (list)))
   (substates [this]
     (vals (:states this)))
   (state-id [this]
-    (:id this)))
+    (:id this))
+  (state-type [this]
+    (:type this))
+  (state-transitions [this]
+    (:transitions this))
+  (entry-order [this]
+    (:order this))
+  (on-exit [this]
+    (:exit this))
+  (on-enter [this]
+    (:enter this))
+  (get-state [this id]
+    (get (:state-index this) id)))
+
+(defn targetted-transition? [transition]
+  (some? (target-state transition)))

 (defn parent-id [state]
   (let [id (state-id state)]
@@ -32,30 +124,43 @@
                  (butlast)
                  vec))))

-(defn parent [state]
+(defn parent-state [state]
   (let [{:keys [state-index]} state]
     (get state-index (parent-id state))))
+
+(defn select-event-transitions [state event]
+  (concat (->> (state-transitions state)
+               (filter #(= (trigger-event %) event)))
+          (lazy-seq (if-some [parent (parent-state state)]
+                      (select-event-transitions parent event)))))
+
+(defn select-eventless-transitions [state]
+  (concat (->> (state-transitions state)
+               (filter #(nil? (trigger-event %))))
+          (lazy-seq (if-some [parent (parent-state state)]
+                      (select-eventless-transitions parent)))))

 (defn state-zip [state]
   (zip/zipper
     (constantly true)
     substates
     (fn [state] (prn "edit"))
-    state
-    ))
-
-(defn make-transitions [state]
-  (let [{:keys [id]} state]
-    (update state :transitions
-            (fn [transitions]
-              (->> transitions
-                   (map (fn [transition]
-                          (let [{:keys [target]} transition]
-                            (cond-> transition
-                              (keyword? target)
-                              (assoc :target (conj id target)))))))))))
-
-
+    state))
+
+(defn make-transitions [state state-index]
+  (let [{:keys [id transitions]} state]
+    (cond-> state
+            (some? transitions)
+            (update :transitions
+                    (fn [transitions]
+                      (->> transitions
+                           (mapv (fn [transition]
+                                   (let [{:keys [target]} transition]
+                                     (cond-> (assoc transition
+                                               :source id
+                                               :state-index state-index)
+                                             (keyword? target)
+                                             (assoc :target (conj id target))))))))))))

 (defn index-states [state]
   (loop [loc (state-zip state)
@@ -83,17 +188,239 @@
    (let [state-index (StatechartIndex. {})
          state       (make-statechart [] (assoc state :id []
                                                       :state-index state-index)
-                                      state-index)]
+                                      state-index
+                                      (volatile! 0))]
      (set-index state-index (index-states state))
      state))
-  ([path state state-index]
-   (-> (reduce-kv (fn [state id substate]
-                    (assoc-in state [:states id] (make-statechart (conj path id) substate state-index)))
-                  state
-                  (:states state))
-       (assoc :id path
-              :state-index state-index)
-       (make-transitions))))
+  ([path state state-index entry-order]
+   (let [order (vswap! entry-order inc)]
+     (-> (reduce-kv (fn [state id substate]
+                      (assoc-in state [:states id] (make-statechart (conj path id) substate state-index entry-order)))
+                    state
+                    (:states state))
+         (assoc :id path
+                :state-index state-index
+                :order order)
+         (make-transitions state-index)))))
+(defn effective-target-states [transition]
+  ; TODO Add history
+  (list (target-state transition)))
+
+(defn descendant? [child parent]
+  (let [parent-id (when parent
+                    (state-id parent))
+        child-id  (state-id child)]
+    (and
+      (< (count parent-id) (count child-id))
+      (= (->> (map vector child-id parent-id)
+              (take-while #(apply = %))
+              (map first))
+         parent-id))))
+
+(defn proper-ancestors [state1 cap-state]
+  (let [state1-id (state-id state1)
+        state2-id (when (some? cap-state)
+                    (state-id cap-state))]
+    (->> (range 0 (count state1-id))
+         (map #(subvec state1-id 0 %))
+         (reverse)
+         (take-while #(not= % state2-id))
+         (map #(get-state state1 %)))))
+
+(defn find-lcca [states]
+  (let [[head & tail] states]
+    (->> (proper-ancestors head nil)
+         (filter #(or (compound? %) (component? %)))
+         (filter (fn [ancestor]
+                   (every? #(descendant? % ancestor) tail)))
+         first)))
+
+(defn transition-domain [t]
+  ; TODO add internal type
+  (let [states (effective-target-states t)
+        source (source-state t)]
+    (cond
+
+      (empty? states)
+      nil
+
+      (and
+        (internal? t)
+        (compound? source)
+        (->> states
+             (every? #(descendant? % source))))
+      source
+
+      :else
+      (find-lcca (cons source states)))))
+
+(defn full-configuration [configuration]
+  (->> configuration
+       (mapcat #(cons % (proper-ancestors % nil)))
+       (distinct)))
+
+(defn transitions-exit-set [configuration enabled-transitions]
+  (let [configuration (full-configuration configuration)]
+    (->> enabled-transitions
+         (filter targetted-transition?)
+         (mapcat (fn [t]
+                   (let [domain (transition-domain t)]
+                     (->> configuration
+                          (filter #(descendant? % domain))))))
+         distinct)))
+
+(declare add-descendants)
+(defn add-ancestors [state ancestor]
+  (cons state (->> (proper-ancestors state ancestor)
+                   (mapcat (fn [anc]
+                             (cond-> [anc]
+                                     (component? anc)
+                                     (into (->> (substates anc)
+                                                (mapcat #(add-descendants %))))))))))
+(defn add-descendants [state]
+  (cons state (cond
+                (compound? state)
+                (-> (concat
+                      (mapcat #(add-descendants %) (initial-states state))
+                      (mapcat #(add-ancestors % state) (initial-states state)))
+                    distinct)
+
+                (component? state)
+                (-> (mapcat #(add-descendants %) (substates state))
+                    distinct))))
+
+(defn transitions-entry-set [transitions]
+  (->> transitions
+       (mapcat (fn [t]
+                 (let [ancestor               (transition-domain t)
+                       immediate-anc-children (->> (effective-target-states t)
+                                                   (map #(last (proper-ancestors % ancestor)))
+                                                   (remove nil?))
+                       other-children         (if (seq immediate-anc-children)
+                                                (set/difference (into #{} (substates ancestor))
+                                                                immediate-anc-children)
+                                                [])
+                       states                 (distinct (concat (add-descendants (target-state t))
+                                                                (->> (effective-target-states t)
+                                                                     (mapcat #(add-ancestors % ancestor)))
+                                                                ; this is different than scxml, we need to visit other children
+                                                                ; from transition domain, as they are exited in trasitions-exit-set
+                                                                (->> other-children
+                                                                     (mapcat #(add-descendants %)))))]
+                   states)))
+       (distinct)))
+
+(defn current-configuration [ctx]
+  (get-in ctx [:configuration]))
+
+(defn update-configuration [ctx f & args]
+  (-> (apply update-in ctx [:configuration] f args)
+      (update-in [:configuration] #(->> %
+                                        (filter atomic?)
+                                        (into #{})))))
+
+
+(defn invoke-executions [ctx executions]
+  (reduce (fn [ctx execution]
+            (execution ctx))
+          ctx
+          executions))
+
+(defn exit-states [ctx enabled-transitions]
+  (let [states-to-exit  (transitions-exit-set (current-configuration ctx) enabled-transitions)
+        exit-executions (->> states-to-exit
+                             (sort-by entry-order)
+                             (mapcat on-exit))]
+    (-> ctx
+        (update-configuration clojure.set/difference (into #{} states-to-exit))
+        (invoke-executions exit-executions))))
+
+(defn enter-states [ctx enabled-transitions]
+  (->> (transitions-entry-set enabled-transitions)
+       ; sort by entry order = document order
+       (sort-by entry-order)
+       (reduce (fn [ctx state]
+                 (-> ctx
+                     (update-configuration (fnil conj #{}) state)
+                     (invoke-executions (on-enter state))))
+               ctx)))
+
+(defn execute-transitions [ctx enabled-transitions]
+  (let [executions (->> enabled-transitions
+                        (mapcat on-trigger))]
+    (invoke-executions ctx executions)))
+
+(defn microstep [ctx enabled-transitions]
+  (-> ctx
+      (exit-states enabled-transitions)
+      (execute-transitions enabled-transitions)
+      (enter-states enabled-transitions)))
+
+
+
+(defn xf-conflicting-transitions [configuration]
+  (fn [xf]
+    (let [filtered-transitions (volatile! #{})]
+      (fn
+        ([]
+         (xf))
+        ([acc]
+         (->> @filtered-transitions
+              (reduce xf acc)
+              (xf)))
+        ([acc t1]
+         (let [transitions-to-remove (loop [filtered-transitions  @filtered-transitions
+                                            transitions-to-remove #{}]
+                                       (if-not (empty? filtered-transitions)
+                                         (let [t2 (first filtered-transitions)]
+                                           (if-not (empty? (clojure.set/intersection (into #{} (transitions-exit-set configuration [t1]))
+                                                                                (into #{} (transitions-exit-set configuration [t2]))))
+                                             (if (descendant? (:source t1) (:source t2))
+                                               (recur (rest filtered-transitions)
+                                                      (conj transitions-to-remove t2))
+                                               :preempted)))
+                                         transitions-to-remove))]
+           (if-not (= transitions-to-remove :preempted)
+             (vswap! filtered-transitions #(-> %
+                                               (clojure.set/difference transitions-to-remove)
+                                               (conj t1))))
+           acc))))))
+
+(defn remove-conflicting-transitions [configuration transitions]
+  (into [] (xf-conflicting-transitions configuration) transitions))
+
+(defn select-transitions [ctx select-transitions]
+  (->> (current-configuration ctx)
+       (filter atomic?)
+       (sort-by entry-order)
+       (map (fn [atomic-state]
+              (->> (select-transitions atomic-state)
+                   (filter #(applicable-transition? % ctx))
+                   first)))
+       (remove nil?)
+       distinct
+       (remove-conflicting-transitions (full-configuration (current-configuration ctx)))))
+
+(defn process-event [configuration fx event]
+  (let [ctx (loop [ctx (make-ctx configuration fx event)]
+              (if (seq (:internal-queue ctx))
+                (let [ctx (loop [ctx (pop-event ctx)
+                                 i 10]
+                            (let [enabled-transitions (select-transitions ctx select-eventless-transitions)]
+                              (cond
+                                (zero? i)
+                                (do (prn "exit") ctx)
+
+                                (not (empty? enabled-transitions))
+                                (recur (microstep ctx enabled-transitions)
+                                       (dec i))
+
+                                :else
+                                (let [value (select-transitions ctx #(select-event-transitions % (current-event-id ctx)))]
+                                  (microstep ctx value)))))]
+                  (recur ctx))
+                ctx))]
+    (select-keys ctx [:fx :configuration])))

 (comment
   (def statechart
@@ -112,4 +439,6 @@
                                   :target :home}
                                  {:event  :goto-betting
                                   :target :betting}]
-                   }}}))+                   }}})
+
+  )


Show response status code

Show response status code

--- src/cljs/gc_api_browser/response.cljs
+++ src/cljs/gc_api_browser/response.cljs
@@ -29,13 +29,15 @@
                               :float "left"}}
              (dom/code nil json-string))))

-(defn component [{:keys [body headers] :as resp} owner]
+(defn component [{:keys [body headers status] :as resp} owner]
   (reify
     om/IRender
     (render [_]
       (let [json-string (.stringify js/JSON (clj->js body) nil 2)]
         (dom/div #js {:className "well response"}
-                 (dom/h1 nil "Response")
+                 (dom/h1 nil "Response"
+                         (dom/small #js {:className "response-status"
+                                         :style #js {:margin-left "10px"}} status))
                  (render-headers headers)
                  (render-body body)
                  clearfix)))))


More cautiously check in local storage (#582)

This is related to #313 and this closes #581.

--- support/src/figwheel/client/utils.cljs
+++ support/src/figwheel/client/utils.cljs
@@ -131,13 +131,17 @@

 (defn persistent-config-get
   ([ky not-found]
-   (cond
-     (contains? @local-persistent-config ky)
-     (get @local-persistent-config ky)
-     (and (exists? js/localStorage) (.getItem js/localStorage (name ky)))
-     (let [v (read-string (.getItem js/localStorage (name ky)))]
-       (persistent-config-set! ky v)
-       v)
-     :else not-found))
+   (try
+     (cond
+       (contains? @local-persistent-config ky)
+       (get @local-persistent-config ky)
+       (and (exists? js/localStorage)
+            (.getItem js/localStorage (name ky)))
+       (let [v (read-string (.getItem js/localStorage (name ky)))]
+         (persistent-config-set! ky v)
+         v)
+       :else not-found)
+     (catch js/Error e
+       not-found)))
   ([ky]
    (persistent-config-get ky nil)))


Move property names to new style

Move property names to new style

--- src/leiningen/new/cljskel/project.clj
+++ src/leiningen/new/cljskel/project.clj
@@ -38,13 +38,13 @@
         :service-port "8080"
         :service-url "http://localhost:%s"
         :restdriver-port "8081"
-        :environment-entertainment-graphite-host ""
-        :environment-entertainment-graphite-port "8080"
-        :service-graphite-post-interval "1"
-        :service-graphite-post-unit "MINUTES"
-        :service-graphite-enabled "DISABLED"
-        :service-production "false"
-        :service-jetty-gracefulshutdown-millis "5000"}
+        :graphite-host ""
+        :graphite-port "8080"
+        :graphite-post-interval "1"
+        :graphite-post-unit "MINUTES"
+        :graphite-enabled "DISABLED"
+        :production "false"
+        :shutdown-timeout-millis "5000"}

   :lein-release {:release-tasks [:clean :uberjar :pom :rpm]}


Manually isolated (probably) all clj dependencies.

Went through the libs and looked for .clj files:
# for f in /nix/store/vk418d0gxg95abvd23hzksp9qzgyr0f2-containium/lib/*; do zipinfo $f |grep .clj; done |grep -v clojure |less

--- dev-resources/spec.clj
+++ dev-resources/spec.clj
@@ -21,6 +21,21 @@
            :isolates ["containium.*"
                       "org\\.httpkit.*"
                       "taoensso\\.nippy.*"
-                      "ring.*"]}
+                      "ring.*"
+                      "leiningen.*"
+                      "robert.hooke"
+                      "cemerick.pomegranate.*"
+                      "bultitude.core*"
+                      "dynapath.*"
+                      ; Alia system deps
+                      "qbits.*"
+                      "clj.time.*"
+                      "cljs.core.async.*"
+                      "lamina.*"
+                      "taoensso.nippy.*"
+                      "potemkin.*"
+                      "flatland.*"
+                      "useful.*"
+                      ]}
  :repl {:port 13337}
  :fs {:deployments "dev-resources/deployments"}}


Renamed function for clarity

Renamed function for clarity

--- src/puppetlabs/trapperkeeper/core.clj
+++ src/puppetlabs/trapperkeeper/core.clj
@@ -181,8 +181,8 @@
         perform-shutdown-fn   #(doseq [f @shutdown-fns] (f))
         shutdown-service      (service :shutdown-service
                                        {:depends  []
-                                        :provides [do-shutdown wait-for-shutdown shutdown-on-error]}
-                                       {:do-shutdown        #(do
+                                        :provides [request-shutdown wait-for-shutdown shutdown-on-error]}
+                                       {:request-shutdown   #(do
                                                                (perform-shutdown-fn)
                                                                (deliver shutdown-reason {:type :requested}))
                                         :wait-for-shutdown  #(deref shutdown-reason)
@@ -201,7 +201,7 @@
   "Perform shutdown on the application by calling all service shutdown hooks.
   Services will be shut down in dependency order."
   [^TrapperKeeperApp app]
-  ((get-service-fn app :shutdown-service :do-shutdown)))
+  ((get-service-fn app :shutdown-service :request-shutdown)))

 (defn- compile-graph
   "Given the merged map of services, compile it into a function suitable for instantiation.


arithmetic.clj: finished diagonalization function and did some cleanups

--- clojure/org/gavrog/clojure/arithmetic.clj
+++ clojure/org/gavrog/clojure/arithmetic.clj
@@ -11,8 +11,8 @@
   (loop [f (abs m), fm (sign m), g (abs n), gm 0]
     (if (zero? g)
       (if (zero? n)
-        [f [fm 0 gm 1]]
-        [f [fm (quot (- f (* fm m)) n) gm (quot (- (* gm m)) n)]])
+        [fm 0 gm 1]
+        [fm (quot (- f (* fm m)) n) gm (quot (- (* gm m)) n)])
       (let [x (quot f g)]
         (recur g gm (- f (* x g)) (- fm (* x gm)))))))

@@ -35,38 +35,44 @@
     (reduce (fn [a b] (if (neg? (compare a b)) a b)) (first xs) (rest xs))))

 (defn- clear-col [M rows cols]
-  (let [i0 (first rows)
-        j0 (first cols)]
+  (let [i0 (first rows), j0 (first cols)]
     (reduce (fn [M i]
-              (let [a (M [i0 j0]) b (M [i j0])]
+              (let [a (M [i0 j0]), b (M [i j0])]
                 (cond (and (not (zero? a)) (zero? (mod b a)))
                       (combine-rows M cols i0 i 1 0 (- (quot b a)) 1)

                       (not (zero? b))
-                      (let [[_ [f11 f12 f21 f22]] (gcdex a b)]
-                        (combine-rows M cols i0 i f11 f12 f21 f22))
+                      (apply combine-rows M cols i0 i (gcdex a b))

                       :else
                       M)))
+            M
             (rest rows))))

-(defn- clear-row [M rows cols])
+(defn- try-to-clear-row [M rows cols]
+  (let [i0 (first rows), j0 (first cols)]
+    (loop [M M, js (rest cols)]
+      (if-let [j (first js)]
+        (let [a (M [i0 j0]), b (M [i0 j])]
+          (cond (and (not (zero? a)) (zero? (mod b a)))
+                (recur (assoc M [i0 j] 0) (rest js))
+
+                (not (zero? b))
+                [(apply combine-cols M rows j0 j (gcdex a b)) true]
+
+                :else
+                (recur M (rest js))))
+        [M false]))))

 (defn- eliminate [M rows cols]
-  (let [M (clear-col M rows cols)
-        [M dirty] (clear-row M rows cols)]
-    (if dirty
-      (recur M rows cols)
-      M)))
+  (let [[M dirty] (try-to-clear-row (clear-col M rows cols) rows cols)]
+    (if dirty (recur M rows cols) M)))

 (defn diagonalized [M rows cols]
-  (if (or (empty? rows) (empty? cols))
-    M
-    (let [i0 (first rows)
-          j0 (first cols)
-          [_ ip jp] (smallest (for [i rows, j cols
-                                    :when (not (zero? (M [i j])))]
-                                [i j]))
-          M (combine-rows M cols i0 ip 0 1 1 0)
-          M (combine-cols M rows j0 jp 0 (sign (M [ip jp])) 1 0)]
-      (recur (eliminate M rows cols) (rest rows) (rest cols)))))
+  (if-let [[_ i j] (smallest (for [i rows, j cols
+                                   :when (not (zero? (M [i j])))]
+                               [(M [i j]) i j]))]
+    (let [M (combine-rows M cols (first rows) i 0 1 1 0)
+          M (combine-cols M rows (first cols) j 0 (sign (M [i j])) 1 0)]
+      (recur (eliminate M rows cols) (rest rows) (rest cols)))
+    M))


Updating time keeper documentation

Updating time keeper documentation

--- common-lib/src/cmr/common/time_keeper.clj
+++ common-lib/src/cmr/common/time_keeper.clj
@@ -8,13 +8,14 @@
   "Contains the current time to return if it is overriden."
   (atom nil))

-(defn set-current-time!
-  "Sets the current time. This should only be used for testing."
+(defn set-time-override!
+  "Sets the override time to the given time given. This should only be used for testing."
   [t]
   (reset! time-override t))

 (defn freeze-time!
-  "Sets the current time to whatever the real time is now."
+  "Sets the override time to the current real time. This 'freezes' the time so that it won't advance
+  until the advance time is called or the time is 'unfrozen' by calling clear-current-time!."
   []
   (set-current-time! (t/now)))


removing problematic test

removing problematic test

--- libs/di/test/di/core_test.clj
+++ libs/di/test/di/core_test.clj
@@ -35,14 +35,14 @@
 "When creating an injector, it comes loaded with certain resources, which can be overridden by the resource value map."

 "The function `time` returns the current time in milliseconds."
-(fact
- (let [$ (injector {})]
-   (with-dependencies!! $ [time]
-     (let [t1 (time)]
-       (async/<! (async/timeout 2))
-       (let [t2 (time)]
-         (> (- t2 t1) 0) => true
-         (<= (- t2 t1) 4) => true)))))
+(comment (fact
+          (let [$ (injector {})]
+            (with-dependencies!! $ [time]
+              (let [t1 (time)]
+                (async/<! (async/timeout 2))
+                (let [t2 (time)]
+                  (> (- t2 t1) 0) => true
+                  (<= (- t2 t1) 4) => true))))))

 "The function `format-time` formats a given timestamp in a human-readable form."
 (fact


Remove defgame from template

Remove defgame from template

--- desktop/resources/barebones-2d/core.clj
+++ desktop/resources/barebones-2d/core.clj
@@ -11,8 +11,3 @@
   (fn [screen entities]
     (clear!)
     (render! screen entities)))
-
-(defgame {{app-name}}
-  :on-create
-  (fn [this]
-    (set-screen! this main-screen)))


Correctly preview TSVs with carriage returns [GAWB-3256] (#1246)

--- src/cljs/main/broadfcui/page/workspace/data/import_data.cljs
+++ src/cljs/main/broadfcui/page/workspace/data/import_data.cljs
@@ -51,7 +51,7 @@
            (str "Previewing '" (.. (:file @state) -name) "':")
            [:div {:style {:overflow "auto" :maxHeight 200
                           :paddingBottom "0.5em" :textAlign "left"}}
-            [:pre {} file-contents]
+            [:pre {} (clojure.string/replace file-contents #"\r(?!\n)" "\r\n")] ; negative lookahead - match any \r except \r\n
             (when (> (.-size file) preview-limit)
               [:em {} "(file truncated for preview)"])]])
         (when (and file (not upload-result))


return just url from start-server

return just url from start-server

--- src/adzerk/boot_reload.clj
+++ src/adzerk/boot_reload.clj
@@ -27,9 +27,8 @@
   (let [{:keys [ip port]} (pod/with-call-in pod (adzerk.boot-reload.server/start ~opts))
         host              (cond ws-host ws-host (= ip "0.0.0.0") "localhost" :else ip)
         proto             (if secure? "wss" "ws")]
-    [(util/with-let [url (format "%s://%s:%d" proto host port)]
-       (util/info "Starting reload server on %s\n" url))
-     ws-host]))
+    (util/with-let [url (format "%s://%s:%d" proto host port)]
+      (util/info "Starting reload server on %s\n" url))))

 (defn- write-cljs! [f url ws-host on-jsload asset-host]
   (util/info "Writing %s to connect to %s...\n" (.getName f)
@@ -114,8 +113,8 @@
         prev-pre (atom nil)
         prev (atom nil)
         out  (doto (io/file src "adzerk" "boot_reload.cljs") io/make-parents)
-        [url ws-host] (start-server @pod {:ip ip :port port :ws-host ws-host :secure? secure
-                                    :open-file open-file})]
+        url  (start-server @pod {:ip ip :port port :ws-host ws-host :secure? secure
+                                 :open-file open-file})]
     (set-env! :source-paths #(conj % (.getPath src)))
     (write-cljs! out url ws-host on-jsload asset-host)
     (fn [next-task]


Split components

Split components

--- src/airhead_cljs/core.cljs
+++ src/airhead_cljs/core.cljs
@@ -16,7 +16,7 @@
 ;; Views

 (defn track-span [track]
-  (str (track "artist") " - " (track "title")))
+  [:span (str (track "artist") " - " (track "title"))])

 (defn playlist-section []
   (let [playlist (r/atom [])
@@ -32,6 +32,24 @@
   [:input {:type "button" :value "Enqueue"
            :on-click #(enqueue-track track)}])

+(defn query-input [query]
+  [:input {:type "text"
+           :value @query
+           :on-change #(reset! query
+                               (-> % .-target .-value))}])
+
+(defn tracks-list [tracks]
+  [:ul (for [track @tracks]
+         [:li
+          [enqueue-button track]
+          [track-span track]])])
+
+(defn upload-form []
+  [:form {:enc-type "multipart/form-data"
+          :method "POST" :action "/api/upload"}
+   [:input {:type "file" :name "track"}]
+   [:input {:type "submit" :value "Upload"}]])
+
 (defn tracks-section []
   (let [tracks (r/atom [])
         query (r/atom "")
@@ -43,30 +61,14 @@
     (fn []
       (js/setTimeout get-tracks 1000)
       [:div [:h2 "Tracks"]
-       [:input {:type "text"
-                :value @query
-                :on-change reset-query}]
-       [:ul (for [track @tracks]
-              [:li
-               (enqueue-button track)
-               (track-span track)])]])))
-
-(defn upload-form []
-  [:form {:enc-type "multipart/form-data"
-          :method "POST" :action "/api/upload"}
-   [:input {:type "file" :name "track"}]
-   [:input {:type "submit"}]])
-
-(defn upload-section []
-  [:div
-   [:h2 "Upload"]
-   [upload-form]])
+       [query-input query]
+       [tracks-list tracks]
+       [upload-form]])))

 (defn home-page []
   [:div [:h1 "Airhead"]
    [playlist-section]
-   [tracks-section]
-   [upload-section]])
+   [tracks-section]])

 ;; -------------------------
 ;; Initialize app


Bumps version to 1.42.4-SNAPSHOT

Bumps version to 1.42.4-SNAPSHOT

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


Improve data function doc-string printing

--- test/comic_reader/sites/test_util.clj
+++ test/comic_reader/sites/test_util.clj
@@ -125,8 +125,9 @@
                          (str "Site config "
                               "`" 'selector# "'"
                               " cannot be undefined.\n"
-                              "Should be: "
-                              (get-doc-string 'selector#)))
+                              "Should be:\n"
+                              (get-doc-string 'selector#)
+                              "\n"))

                      ~@(->> fn-keyword
                             (alg/topsort dependency-dag)


Add args to metric events.

Add args to metric events.

--- src/blocks/store/meter.clj
+++ src/blocks/store/meter.clj
@@ -169,6 +169,7 @@
            {:type ::method-time
             :label label
             :method method-kw
+            :args args
             :value @elapsed})))))


Prune unnecessary unwrapping from matrixify example.

--- examples/parkour/examples/matrixify.clj
+++ examples/parkour/examples/matrixify.clj
@@ -45,8 +45,9 @@
 (defn offsets
   "Build map of offsets from dseq of counts."
   [dseq]
-  (->> (r/map w/unwrap-all dseq) (into []) (sort-by first)
-       (reductions (fn [[_ t] [i n]] [(inc i) (+ t n)]) [0 0])
+  (->> dseq (into []) (sort-by first)
+       (reductions (fn [[_ t] [i n]]
+                     [(inc i) (+ t n)]) [0 0])
        (into {})))

 (defn absind


Give the recto page different margins

Give the recto page different margins

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -286,7 +286,7 @@
              :line-height "130%"
              :xml:lang "de"}
    [:fo:layout-master-set
-    (simple-page-master {:master-name "recto"})
+    (simple-page-master {:master-name "recto" :margin-left "35mm" :margin-right "15mm"})
     (simple-page-master {:master-name "verso"})
     [:fo:page-sequence-master {:master-name "main"}
      [:fo:repeatable-page-master-alternatives


Remove commented code.

Remove commented code.

--- src/cats/labs/manifold.clj
+++ src/cats/labs/manifold.clj
@@ -44,16 +44,6 @@
     (-fmap [_ f mv]
       (d/chain mv f))

-    ;; p/Semigroup
-    ;; (-mappend [_ sv sv']
-    ;;   (chain-chans sv sv'))
-
-    ;; p/Monoid
-    ;; (-mempty [_]
-    ;;   (let [c (a/chan)]
-    ;;     (a/close! c)
-    ;;     c))
-
     p/Applicative
     (-pure [_ v]
       (d/success-deferred v))


use store fn instead of direct atom access

--- src/chat/client/views.cljs
+++ src/chat/client/views.cljs
@@ -60,10 +60,8 @@
         (om/build groups-nav-view data)

         (dom/div #js {:className "header"}
-          (let [users (->> (@store/app-state :users)
-                           vals
-                           (remove (fn [user] (= (get-in @store/app-state [:session :user-id]) (user :id))))
-                           (filter (fn [u] (contains? (set (u :group-ids)) (@store/app-state :open-group-id)))))
+          (let [users (->> (store/users-in-open-group)
+                           (remove (fn [user] (= (get-in @store/app-state [:session :user-id]) (user :id)))))
                 users-online (->> users
                                   (filter (fn [user] (= :online (user :status)))))]
             (dom/div #js {:className "users"}


Fix a bad namespace

Fix a bad namespace

--- src/circle/backend/ec2.clj
+++ src/circle/backend/ec2.clj
@@ -297,7 +297,7 @@
        (= state :running) true
        (pos? timeout) (do (Thread/sleep (* sleep-interval 1000)) (recur (- timeout sleep-interval)))
        :else (try
-               (ec2/terminate-instances! instance-id)
+               (terminate-instances! instance-id)
                (finally
                 (throwf "instance %s didn't start within timeout" instance-id)))))))


retrieve gameboy color adjacency

retrieve gameboy color adjacency

--- src/client/game/paint.cljs
+++ src/client/game/paint.cljs
@@ -12,6 +12,10 @@

 (def tilemap-tengen (let [img (js/Image.)]
                       (aset img "src" "tilemap-tengen.png")
+                      img))
+
+(def tilemap-gameboy-color (let [img (js/Image.)]
+                      (aset img "src" "tilemap-gameboy-color.png")
                       img))

 (def tilemap (let [img (js/Image.)]
@@ -36,18 +40,26 @@
    })

 (defn get-image-region
-  "Get the tilemap and position for the image of the given cell value and level."
+  "Get the tilemap and position for the image of the given cell value and theme."
   [theme value]
-  (let [wrap-theme (mod theme 10)]
-    (if (= wrap-theme 2)
-      (let [[k a] (piece-type-adj value)
-            row (value-position k)
-            col a]
-        [tilemap-tengen row col])
-      (let [[k _] (piece-type-adj value)
-            row wrap-theme
-            col (value-position k)]
-        [tilemap row col]))
+  (let [wrap-theme (mod theme 10)
+        string-value (str value)]
+    (cond
+      (= wrap-theme 2)
+        (let [[k a] (piece-type-adj value)
+              row (value-position k)
+              col a]
+          [tilemap-tengen row col])
+      (and (= wrap-theme 7) (= (subs string-value 0 1) "I"))
+        (let [[k a] (piece-type-adj value)
+              row (value-position k)
+              col a]
+          [tilemap-gameboy-color row col])
+      :else
+        (let [[k _] (piece-type-adj value)
+              row wrap-theme
+              col (value-position k)]
+          [tilemap row col]))
     )
   )


Trace implementation. Bug fix in basic blocks.

--- src/clj/minijava/canon.clj
+++ src/clj/minijava/canon.clj
@@ -125,6 +125,7 @@
      (recur (rest lst) (cons (first lst) match))))

 (defn basic-blocks
+  "Takes a list of IR, and breaks into blocks w/ one entry and one exit."
   [[x & xs]]
   (let [nx (if (= (type x) :minijava.ir/Label)
              (list x)
@@ -133,6 +134,33 @@
     (if (seq rest)
       (cons (concat nx match) (basic-blocks rest))
       (if (or (= (type (last match)) :minijava.ir/Jump)
-              (= (type (last match)) :minijava.ir/Conditional))
+              (= (type (last match)) :minijava.ir/Conditional)
+              (= (type x) :minijava.ir/Jump)
+              (= (type x) :minijava.ir/Conditional))
         (list (concat nx match))
         (list (concat (concat nx match) (list (Jump (Name "done")))))))))
+
+;; TRACING
+
+(defn walk
+  "Returns a label to the immediate successor of blk."
+  [blk]
+  (let [lst (last blk)]
+    (case (type lst)
+      :minijava.ir/Jump        (Label (:lbl lst))
+      :minijava.ir/Conditional (Label (:f lst)))))
+
+;; right now I'm walking throught the blocks, trying to find match forward jumps
+;; or false conditionals. This could probably be improved.
+;; note: concat shouldn't be that expensive, it's only performed once we walk through
+;; the first list, amortizing the O(n) cost.
+(defn trace
+  "Rearranges blocks to limit distance of forward jumps and false conditionals."
+  [blks sorted]
+  (if (seq blks)
+    (let [next (walk (first blks))
+          [before after] (split-with #(not (= next (first %))) (rest blks))]
+      (if (seq after)
+        (trace (concat (rest after) before) (conj sorted (first blks) (first after)))
+        (trace before (conj sorted (first blks)))))
+    sorted))


Use <small> element in game status

Use <small> element in game status

"Cards Remaining" doesn't fit on a phone screen.

--- src/cljs/ji/ui/status.cljs
+++ src/cljs/ji/ui/status.cljs
@@ -18,12 +18,16 @@
 (deftemplate status-tmpl [last-set cards-remaining]
   [:div.row.collapse
    [:div.cards-remaining.columns
-    [:h5.subheader
-     "Cards Remaining: " [:span (or cards-remaining "?")]]]
-   [:div.last-set.columns
-    [:h5.subheader "Last Set: " (if last-set [:span (:player-id last-set)] "?")]
-    [:div.row.collapse
-     [:div.large-6.large-centered.columns (card/set-tmpl (:cards last-set))]]] ])
+    [:h5.subheader.hide-for-small
+     "Cards Remaining: " [:span (or cards-remaining "?")]]
+    [:h5.subheader.show-for-small
+     [:small "Cards Remaining: " [:span (or cards-remaining "?")]]]]
+   (if last-set
+     [:div.last-set.columns
+      [:h5.subheader.hide-for-small "Last Set: " [:span (:player-id last-set)]]
+      [:h5.subheader.show-for-small [:small "Last Set: " [:span (:player-id last-set)]]]
+      [:div.row.collapse
+       [:div.large-6.large-centered.columns (card/set-tmpl (:cards last-set))]]]) ])

 (defn go-status-ui [container ch]
   (go (loop []


Remove destructuring in load when it is not needed. Closes #23.

--- src/cljs/replumb/load.cljs
+++ src/cljs/replumb/load.cljs
@@ -5,13 +5,13 @@

 (defn js-default-load
   "This load function just calls: (cb nil)"
-  [{:keys [name macros path file] :as full} cb]
+  [_ cb]
   (cb nil))

 (defn js-fake-load
   "This load function just calls:
   (cb {:lang   :js
        :source \"\"})"
-  [{:keys [name macros path file] :as full} cb]
+  [_ cb]
   (cb {:lang   :js
        :source ""}))


start handling messages

start handling messages

--- src/cljs/skyport/core.cljs
+++ src/cljs/skyport/core.cljs
@@ -1,6 +1,6 @@
 (ns skyport.core
   (:require-macros [cljs.core.async.macros :refer (go go-loop)])
-  (:require [cljs.core.async :refer (<! >! put! chan close!)]
+  (:require [cljs.core.async :refer (<! chan close! map<)]
             [clojure.string :as str]
             [clojure.walk :refer [keywordize-keys]]
             [chord.client :as socket :refer (ws-ch)]
@@ -43,18 +43,52 @@
                     :position [12 0]}]
          :message "gamestate"}))

+(defn coords-to-pixel [[j k]]
+  [(+ X-OFFSET (* TILE-SIZE
+                  (/ 3 2)
+                  (+ 2 (- k j))))
+   (+ Y-OFFSET (* (/ TILE-SIZE 2)
+                  (js/Math.sqrt 3)
+                  (+ k (- j 2))))])
+

 (defmulti handle-action :type)

-(defmethod handle-action :direction ;; laser
-  [action]
-  )
-
-(defmethod handle-action :sequence    ;; droid
-  [action])
-
-(defmethod handle-action :coordinates ;; mortar
-  [action])
+(defmethod handle-action "laser"
+  [{:keys [from stop] :as action}]
+  (let [start (->> @state
+                  :players
+                  (drop-while (comp (partial not= from)
+                                    :name))
+                  first
+                  :position)]
+    (swap! state assoc :action
+           (assoc action
+             :start (coords-to-pixel start)
+             :stop (coords-to-pixel stop)))))
+
+(defmethod handle-action "droid"
+  [action]
+  (swap! state assoc :action action))
+
+(defmethod handle-action "mortar"
+  [action]
+  (swap! state assoc :action action))
+
+(defmethod handle-action "move"
+  [{:keys [direction from]}]
+  (let [[x y] (case direction
+                "up"         [-1 -1]
+                "left-up"    [ 0 -1]
+                "right-up"   [-1  0]
+                "down"       [ 1  1]
+                "left-down"  [ 1  0]
+                "right-down" [ 0  1])]
+    (swap! state update-in [:players]
+           (partial mapv (fn [{:keys [name position] :as player}]
+                           (if-not (= name from)
+                             player
+                             (assoc-in player [:position] (mapv + [x y] position))))))))

 (defmethod handle-action :default [_]
   ;; Do nothing.
@@ -78,9 +112,9 @@
   [action]
   (handle-action action))

-(defmethod handle-message! :default [_]
+(defmethod handle-message! :default [message]
   ;; Do nothing.
-  )
+  (println message))

@@ -99,13 +133,11 @@
   ;; connect again in a second.
   (if error
     (println error)
-    (loop [{:keys [message error]} (keywordize-keys
-                                    (<! ws-channel))]
+    (loop [{:keys [message error]} (<! ws-channel)]
       (if error
         (println "-- " error)
         (do
-          (println message)
-          (handle-message! message)
+          (handle-message! (keywordize-keys message))
           (recur (<! ws-channel))))))
   ;; wait 1 second before continuing.
   (<! (timeout 1000))
@@ -143,14 +175,6 @@
         (hexagon {:x x :y y :size size :class (tile-type label)})
         [:text {:x x :y y}
          label]]))))
-
-(defn coords-to-pixel [[j k]]
-  [(+ X-OFFSET (* TILE-SIZE
-                  (/ 3 2)
-                  (+ 2 (- k j))))
-   (+ Y-OFFSET (* (/ TILE-SIZE 2)
-                  (js/Math.sqrt 3)
-                  (+ k (- j 2))))])

 (defn damage-view [{:keys [x y text]} owner]
   (reify
@@ -173,12 +197,13 @@
          width 20
          angle (* (js/Math.atan2 x_d y_d)
                   (/ -180 js/Math.PI))]
-     [:rect
-      {:class "laser"
-       :x (- x_2 (/ width 2)) :y y_2
-       :width width :height height
-       :transform (str "rotate(" angle" " x_2 " " y_2 ")")
-       :fill "url(#laser-shot)"}])))
+     [:g
+      [:rect
+       {:class "laser"
+        :x (- x_2 (/ width 2)) :y y_2
+        :width width :height height
+        :transform (str "rotate(" angle" " x_2 " " y_2 ")")
+        :fill "url(#laser-shot)"}]])))

 (defn player-view [{:keys [name position text]} owner]
@@ -193,6 +218,19 @@
                     :cx x
                     :cy y
                     :r (/ TILE-SIZE 2)}]])))))
+
+(defmulti action-view :type)
+(defmethod action-view "laser"
+  [{:keys [start stop]}]
+  (laser-shot start stop))
+(defmethod action-view "droid"
+  [action]
+  (html [:g]))
+(defmethod action-view "mortar"
+  [action]
+  (html [:g]))
+(defmethod action-view :default [_]
+  (html [:g]))

 (defn world-view [state owner]
   (reify
@@ -216,7 +254,8 @@
                                          :y y
                                          :label (get-in data [j k])
                                          :size TILE-SIZE}))]
-           [:g (om/build-all player-view (:players state))]]])))))
+           [:g (om/build-all player-view (:players state))]
+           (om/build action-view (:action state))]])))))

 (defn weapon-interface-view [{:keys [name level]} owner]
   (reify


Update favicon href in html-doc

Update favicon href in html-doc

--- src/clojars/web/common.clj
+++ src/clojars/web/common.clj
@@ -99,9 +99,8 @@
             :title "Clojars"
             :href "/opensearch.xml"
             :rel "search"}]
-    [:link {:type "image/png"
-            :href "/favicon.png"
-            :rel "icon"}]
+    [:link {:href "/favicon.ico"
+            :rel "shortcut icon"}]
     (structured-data/meta-tags (assoc ctx :title (if title
                                                    title
                                                    "Clojars"))) ;; TODO: talk about whether we should refactor signature of html-doc


reformat swap! in assert checkpoint

reformat swap! in assert checkpoint

--- src/co/nclk/linen/core.clj
+++ src/co/nclk/linen/core.clj
@@ -87,7 +87,8 @@
         resolved (assoc-in resolved [:success :value] success)]

     (when (not (true? success))
-      (swap! (:failed? config) (fn [_] true))
+      (swap! (:failed? config)
+             (fn [_] true))
       (log :debug (with-out-str (clojure.pprint/pprint resolved)))
       (log :error (str "[" (:runid resolved) "] Failed.")))


Clean up bound

Clean up bound

--- higher/desktop/src-common/higher/core.clj
+++ higher/desktop/src-common/higher/core.clj
@@ -19,17 +19,15 @@
     :else entity))

 (defn bound [entity]
-  "reflects entity when hitting on of the game boundaries"
-  (let [bound-horizontally
-        (fn [entity] (if (or (< (:x entity) 0) (> (:x entity) (game :width)))
-                       (assoc entity :vx (- (:vx entity)))
-                       entity))
-        bound-vertically
-        (fn [entity] (if (or
-                          (and (< (:y entity) 0) (< (:vy entity) 0))
-                          (and (> (:y entity) (game :height)) (> (:vy entity) 0)))
-                       (assoc entity :vy (- (:vy entity)))
-                       entity))]
+  "reflects entity when hitting one of the game boundaries"
+  (let [should-reflect-horizontally? (or (< (:x entity) 0) (> (:x entity) (game :width)))
+        reflect-horizontally #(assoc % :vx (- (:vx %)))
+        bound-horizontally #(if should-reflect-horizontally? (reflect-horizontally %) %)
+        should-reflect-vertically? (or
+                                    (and (< (:y entity) 0) (< (:vy entity) 0))
+                                    (and (> (:y entity) (game :height)) (> (:vy entity) 0)))
+        reflect-vertically #(assoc % :vy (- (:vy %)))
+        bound-vertically #(if should-reflect-vertically? (reflect-vertically %) %)]
     (-> entity bound-horizontally bound-vertically)))

 (defscreen main-screen


Removed user specific data.

Removed user specific data.

--- profiles.clj
+++ profiles.clj
@@ -19,7 +19,7 @@
             :web-audience "http://localhost:3000"

             :verifier "https://verifier.login.persona.org/verify"
-            :db-subname "//localhost/staircase"
+            :db-subname "//localhost/staircase" }
  }
  :test {
         :bower-dependencies [[angular-scenario "~1.2.9"]


prevented unnecessary nesting

prevented unnecessary nesting

--- src/corpus_utils/bccwj.clj
+++ src/corpus_utils/bccwj.clj
@@ -214,7 +214,7 @@
                          (re-seq #"^\d\s" r) (Integer/parseInt (subs r 0 1))
                          (empty? r) nil
                           :else r))]
-                (assoc a basename {:annotations (zipmap header (map clean-record record))})))
+                (assoc a basename (zipmap header (map clean-record record)))))
             (fn [] {}))
            (next bccwj-meta-annotation-data)))]


Fix: Use defn instead of def

Fix: Use defn instead of def

Oops.

--- src/whitman/client.clj
+++ src/whitman/client.clj
@@ -1,4 +1,4 @@
 (ns whitman.client)

-(def format-url [url user]
+(defn format-url [url user]
   (format url user))


Memoize string splitting in render function

--- src/day8/re_frame_10x.cljs
+++ src/day8/re_frame_10x.cljs
@@ -44,13 +44,15 @@
       n
       "")))

+(def operation-name (memoize (fn [component] (last (str/split (component-path component) #" > ")))))
+
 (def static-fns
   {:render
    (fn mp-render []                                         ;; Monkeypatched render
      (this-as c
        (trace/with-trace {:op-type   :render
                           :tags      {:component-path (component-path c)}
-                          :operation (last (str/split (component-path c) #" > "))}
+                          :operation (operation-name c)}
                          (if util/*non-reactive*
                            (reagent.impl.component/do-render c)
                            (let [rat        ($ c :cljsRatom)


logelei-2 adapted to new functions

logelei-2 adapted to new functions

--- src/examples/logelei_2.clj
+++ src/examples/logelei_2.clj
@@ -63,8 +63,11 @@
         '(impl beutelaffen-oinken  ohrhörner-surren)
         ))

-
-(-> fml
-    transform-tseitin
-    generate-dimacs-clauses
+(let [tseit (transform-tseitin fml)
+      result (-> (:tseitin-formula tseit) generate-dimacs-clauses sat-solve)]
+  (retransform-tseitin result tseit))
+
+#_(-> fml
+     transform-tseitin
+     generate-dimacs-clauses
     sat-solve)


Log a bit more information when there's a failure checking Tyranitar properties

--- src/exploud/deployment.clj
+++ src/exploud/deployment.clj
@@ -346,10 +346,12 @@
     (tyr/deployment-params environment application hash)
     (tyr/launch-data environment application hash)
     (catch Exception e
+      (log/error "Failure checking Tyranitar files" e)
       (throw (ex-info "One or more Tyranitar files are invalid" {:type ::invalid-file
                                                                  :application application
                                                                  :environment environment
-                                                                 :hash hash})))))
+                                                                 :hash hash
+                                                                 :message (.getMessage e)})))))

 (defn prepare-deployment
   "Prepares a deployment of the `application` in an `environment` within the


Add event to select all checkboxes

Add event to select all checkboxes

--- src/hatti/views/table.cljs
+++ src/hatti/views/table.cljs
@@ -3,6 +3,7 @@
   (:require [chimera.js-interop :refer [safe-regex]]
             [chimera.urls :refer [last-url-param url]]
             [chimera.seq :refer [in?]]
+            [chimera.om.state :refer [transact!]]
             [chimera.string :refer [escape-for-type]]
             [clojure.string :refer [escape]]
             [cljs.core.async :refer [<! chan put! timeout]]
@@ -285,6 +286,9 @@
     ;; dataview / grid hookup
     (bind-external-sg-grid-event-handlers grid grid-event-handlers)
     (bind-external-sg-grid-dataview-handlers dataview dataview-event-handlers)
+    (.setSelectionModel grid
+                        (js/Slick.RowSelectionModel.
+                         (clj->js {:selectActiveRow false})))

     (.subscribe (.-onRowCountChanged dataview)
                 (fn [e args]
@@ -293,7 +297,42 @@
     (.subscribe (.-onRowsChanged dataview)
                 (fn [e args]
                   (.invalidateRows grid (aget args "rows"))
-                  (.render grid)))
+                  (.render grid)
+                  (select-rows-marked-to-be-deleted)
+                  (higlight-rows-marked-to-be-deleted grid)))
+    (.subscribe (.-onHeaderClick grid)
+                (fn [e args]
+                  (when (and (= (.. args -column -id) "actions")
+                             (= (.. e -target -type) "checkbox"))
+                    (let [target (.-target e)
+                          id (.-id target)
+                          checked? (.-checked target)
+                          delete-record-class-selector (str
+                                                        "."
+                                                        delete-record-class)
+                          total-rows-count (get-elements-count-by-selector
+                                            delete-record-class-selector)]
+                      (when (= select-unselect-all-records-id id)
+                        (let [records-to-be-deleted (.getElementsByClassName
+                                                     js/document
+                                                     delete-record-class)]
+
+                          (doseq [record records-to-be-deleted]
+                            (set! (.-checked record) checked?)
+                            (update-data-to-be-deleted-vector
+                             checked?
+                             (js/parseInt
+                              (.getAttribute record "data-id"))))
+
+                          (transact! shared/app-state
+                                     [:selected-table-rows]
+                                     #(if checked?
+                                        (range total-rows-count)
+                                        []))
+                          (.setSelectedRows
+                           grid
+                           (clj->js
+                            (:selected-table-rows @shared/app-state)))))))))
     ;; Double-click handlers
     (.subscribe (.-onDblClick grid)
                 (fn [e args]


The Clojure version is now more functional, no mutable state (and without any stack overflows).

--- prime.clj/src/prime/clj.clj
+++ prime.clj/src/prime/clj.clj
@@ -10,12 +10,17 @@
        (fn [y] (not= (mod x y) 0))
        (range 2 (math/ceil (math/sqrt x))))))

+(defn primes-iter [n, i, v]
+  (loop [cnt i acc v]
+    (if (= (count acc) n) acc
+      (recur (inc cnt) (if (prime? cnt) (conj acc cnt) acc)))))
+
+(defn primes [n]
+  (if
+    (zero? n) []
+    (primes-iter n 0 [])))
+

 (defn -main
   [& args]
-  (def v [])
-  (def i 0)
-  (while (< (count v) (Integer/parseInt (first args)))
-    (cond (prime? i) (def v (conj v i)))
-    (def i (inc i)))
-  (println v))
+  (println (primes (Integer/parseInt (first args)))))


Use contains? for set membership for readability

some or just set as a fn are equally valid but harder to parse
on first glance

--- src/lt/objs/workspace.cljs
+++ src/lt/objs/workspace.cljs
@@ -208,7 +208,7 @@
 (behavior ::add-file!
                   :triggers #{:add.file!}
                   :reaction (fn [this f]
-                              (if-not (some #{f} (:files @this))
+                              (if-not (contains? (set (:files @this)) f)
                                 (do
                                   (add! this :files f)
                                   (object/raise this :add f)
@@ -218,7 +218,7 @@
 (behavior ::add-folder!
                   :triggers #{:add.folder!}
                   :reaction (fn [this f]
-                              (if-not (some #{f} (:folders @this))
+                              (if-not (contains? (set (:folders @this)) f)
                                 (do
                                   (add! this :folders f)
                                   (object/raise this :add f)


(PE-7614) Update tk-jetty9 to 1.1.0 for pe-puppetserver 3.7.2

This patch updates the puppetserver dependency on tk-jetty9 to 1.1.0 for
Puppet Enterprise 3.7.2.

--- configs/pe-puppetserver/pe-puppetserver.clj
+++ configs/pe-puppetserver/pe-puppetserver.clj
@@ -2,7 +2,7 @@
   :description "Release artifacts for pe-puppetserver"
   :pedantic? :abort
   :dependencies [[puppetlabs/pe-puppet-server-extensions "{{{pe-puppet-server-version}}}"]
-                 [puppetlabs/trapperkeeper-webserver-jetty9 "0.9.0"]
+                 [puppetlabs/trapperkeeper-webserver-jetty9 "1.1.0"]
                  ;; There is a bug in leiningen that forces us to
                  ;; explicitly reference nrepl if we want it to be
                  ;; included in the uberjar.


add type hints

add type hints

--- dada-core/src/main/clojure/org/dada/web.clj
+++ dada-core/src/main/clojure/org/dada/web.clj
@@ -6,33 +6,36 @@
 	   Request Server]
 	  [org.eclipse.jetty.server.handler
 	   AbstractHandler]
+	  [java.io
+	   OutputStream]
 	  [javax.servlet.http
 	   HttpServletRequest HttpServletResponse])
  )

-(def *jetty* nil)
+(def #^Server *jetty* nil)

 (defn start-jetty [port]
   (let [jetty (Server. port)
 	handler (proxy [AbstractHandler] []
-		    (handle [#^String target
-			     #^Request base-request
-			     #^HttpServletRequest request
-			     #^HttpServletResponse response]
-			    (let [path (.getPathInfo base-request)
-				  name (.substring path (+ (.lastIndexOf path "/") 1))
-				  bytes (@*exported-classes* name)
-				  stream (.getOutputStream response)]
-			    (.setContentType response "application/binary")
-			    (.setContentLength response (count bytes))
-			    (.setStatus response 200)
-			      (println "Serving" name "=" bytes)
-			      (.write stream bytes)
-			      (.close stream))
-			    (.setHandled request true)))]
+		       (handle [#^String target
+				#^Request base-request
+				#^Request request
+				#^HttpServletResponse response]
+			       (let [path (.getPathInfo base-request)
+				     name (.substring path (+ (.lastIndexOf path "/") 1))
+				     #^"[B" bytes (@*exported-classes* name)
+				     #^OutputStream stream (.getOutputStream response)]
+				 (.setContentType response "application/binary")
+				 (.setContentLength response (count bytes))
+				 (.setStatus response 200)
+				 (println "Serving" request)
+				 (println "Serving" name "=" bytes)
+				 (.write stream bytes)
+				 (.close stream))
+			       (.setHandled request true)))]
     (.setHandler jetty handler)
-    (def *jetty* jetty)
+    (def #^Server *jetty* jetty)
     (.start jetty)))

 (defn stop-jetty []


support for global-state in a atom

support for global-state in a atom

--- core/src/samsara_core/kernel.clj
+++ core/src/samsara_core/kernel.clj
@@ -32,9 +32,10 @@
 ;;

 ;; runtime pipeline initialized by init-pipeline!
-(def ^:dynamic *config*       nil)
-(def ^:dynamic *dispatchers*  nil)
-(def           *store*        nil) ;; thread local only
+(def ^:dynamic *config*        nil)
+(def ^:dynamic *dispatchers*   nil)
+(def ^:dynamic *global-stores* nil) ;; thread local only
+(def ^:dynamic *stores*         nil) ;; thread local only

@@ -173,16 +174,30 @@
   "Takes an event in json format which contain an Tx-Log entry and
    it pushes the change to the running *kv-store*"
   [stream ^String event]
-  ;; this ugly stuff works because *store* is thread-local
+  ;; this ugly stuff works because *stores* is thread-local
   ;; TODO: make sure initialization adds all the streams
   (printf "STATE[%s] : %s\n" stream event)
-  (let [kv-store (get *store* stream)]
+  (let [kv-store (get *stores* stream)]
     (var-set kv-store
              (->> event
                   from-json
                   vector
                   (kv/restore (var-get kv-store))))))

+
+
+(defn global-kv-restore!
+  "Takes an event in json format which contain an Tx-Log entry and
+   it pushes the change to the running *global-stores*"
+  [stream ^String event]
+  (printf "GLOBAL[%s] : %s\n" stream event)
+  (let [txlog (->> event from-json vector)]
+    (swap! *global-stores*
+           update
+           stream
+           (fn [kvstore]
+             (kv/restore (or kvstore (kv/make-in-memory-kvstore))
+                         txlog)))))

 (defn process-dispatch
@@ -245,8 +260,8 @@
       ;; other messages are processed by the normal pipeline, however here
       ;; we need to emit the state messages as well.

-      ;; this ugly stuff works because *store* is thread-local
-      (let [kv-state (get *store* stream)
+      ;; this ugly stuff works because *stores* is thread-local
+      (let [kv-state (get *stores* stream)
             state    (var-get kv-state)
             [new-state rich-events] (pipeline state message)
             txlog     (kv/tx-log new-state)
@@ -270,6 +285,10 @@
   (fn [output-collector stream partition key message]
     (kv-restore! input-topic message)))

+(defn- compile-global-kv-state-handler [{:keys [input-topic state] :as stream}]
+  (fn [output-collector stream partition key message]
+    (global-kv-restore! input-topic message)))
+
 (defn- compile-state-topic-config [{:keys [state-topic state input-topic] :as stream}]
   (cond

@@ -279,7 +298,7 @@

     (= state :global)
     {input-topic {:topic-filter (compile-partition-filter stream)
-                  :handler (compile-kv-state-handler stream)}}
+                  :handler (compile-global-kv-state-handler stream)}}
     ))

@@ -299,7 +318,7 @@

 (defn init-stores [config]
   (let [streams (map :input-topic
-                     (filter (where [:or [:state = :partitioned] [:state = :global]])
+                     (filter (where [:state = :partitioned])
                              (:streams config)))
         _ (log/info "Initializing kv-store for the following streams: " streams)
         local-store (constantly (thread-local (kv/make-in-memory-kvstore)))]
@@ -308,9 +327,10 @@

 (defn init-pipeline! [config]
   (log/info "Initialize processors...")
-  (alter-var-root #'*config*       (constantly config))
-  (alter-var-root #'*store*        (constantly (init-stores config)))
-  (alter-var-root #'*dispatchers*  (constantly (compile-config config))))
+  (alter-var-root #'*config*        (constantly config))
+  (alter-var-root #'*stores*        (constantly (init-stores config)))
+  (alter-var-root #'*global-stores* (constantly (atom {})))
+  (alter-var-root #'*dispatchers*   (constantly (compile-config config))))

@@ -345,4 +365,11 @@

   (:output-topic-partition-fn stream)

+  *global-stores*
+
+  ((:handler (*dispatchers* "dimension1")) out-> "dimension1" 0 "ciao" "[\"ciao\",1,{\"a\":1}]")
+
+  (global-kv-restore! "dimension1" "[\"ciao\",1,{\"a\":1}]")
+
+
 )


Add docs and :weight-scale option to linear layer

--- cortex/src/cortex/nn/layers.cljc
+++ cortex/src/cortex/nn/layers.cljc
@@ -98,7 +98,11 @@

 (defn linear
   "Constructs a weighted linear transformation module using a dense matrix and bias vector.
-   Shape of input and output are determined by the weight matrix."
+   Shape of input and output are determined by the weight matrix.
+
+   Options available:
+    :l2-max-constraint = constraint to apply to l2 norm of rows (i.e. the vector of weights for each output)
+    :weight-scale      = factor to multiply the weights during initialisation (default 1.0)"
   ([weights bias]
     (linear weights bias nil))
   ([weights bias options]
@@ -108,6 +112,8 @@
           [n-outputs n-inputs] (m/shape weights)
           n-outputs (long n-outputs)
           n-inputs (long n-inputs)]
+      (if-let [weight-scale (:weight-scale options)]
+        (m/scale! weights weight-scale))
       (when-not (== n-outputs (m/dimension-count bias 0)) (error "Mismatched weight and bias shapes"))
       (-> wm
         (assoc :weight-gradient (util/empty-array [n-outputs n-inputs]))
@@ -115,7 +121,13 @@
         (assoc :input-gradient (util/empty-array [n-inputs]))))))

 (defn linear-layer
-  "Creates a linear layer with a new randomised weight matrix for the given number of inputs and outputs"
+  "Creates a linear layer with a new randomised weight matrix for the given number of inputs and outputs.
+
+   Options available:
+    :weights           = specify the weight matrix to use directly
+    :bias              = specify the bias vector to use directly
+    :l2-max-constraint = constraint to apply to l2 norm of rows (i.e. the vector of weights for each output)
+    :weight-scale      = factor to multiply the weights during initialisation (default 1.0)"
   ([n-inputs n-outputs & {:keys [weights bias l2-max-constraint] :as options}]
     (linear (or weights (util/weight-matrix n-outputs n-inputs))
             (or bias (util/empty-array [n-outputs]))


cache is clenaed from messages older than three weeks when stored

--- src/ontrail/newcomment.clj
+++ src/ontrail/newcomment.clj
@@ -85,17 +85,17 @@
   (let [active-time (time/minus (time/now) (time/minutes 25))]
     (filter #(time/after? (get-last-visit %) active-time) (mc/distinct ONUSER "username"))))

-(def max-age (* 1000 60 60 24 30))
-
-(defn clean-cache [comment-cache]
-  (let [now-millis (System/currentTimeMillis)]
-    (apply dissoc comment-cache
-      (filter identity (map #(if (> (- now-millis ((comp :ts comment-cache) %)) max-age) % nil)
-        (filter (partial not= :lastvisit) (keys comment-cache)))))))
+(defn dissoc-comment-keys [comment-cache]
+  (let [max-age (* 1000 60 60 24 21)
+        now-millis (System/currentTimeMillis)]
+    (filter identity
+      (map #(if (> (- now-millis ((comp :ts comment-cache) %)) max-age) % nil)
+        (filter (partial not= :lastvisit) (keys comment-cache))))))

 (defn store-cache [user]
-  (if (not= nil (@users-cache user))
-    (mc/update NCCACHE {:u user} {"$set" {:ref (deref (@users-cache user))}} :upsert true)))
+  (if-let [ucache (@users-cache user)]
+    (do (dosync (apply alter ucache dissoc (dissoc-comment-keys @ucache)))
+        (mc/update NCCACHE {:u user} {"$set" {:ref @ucache}} :upsert true))))

 (defn restore-cache [user]
   (let [cache (mc/find-one-as-map NCCACHE {:u user})]
@@ -107,5 +107,6 @@
     (.trace logger (str "Comment count cache stored " res " caches "))))

 (defn newcomment-cache-restore-all[]
-  (.info logger (str "Restored comment count cache for users " (count (map restore-cache (mc/distinct ONUSER "username" {}))))))
+  (.info logger (str "Restored comment count cache for users "
+    (count (map restore-cache (mc/distinct ONUSER "username" {}))))))


add :header and :samples to BufferOutStream

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -246,7 +246,7 @@
                     n-frames start-frame 0)
     :done))

-(defrecord BufferOutStream [id size n-channels rate allocated-on-server path open?])
+(defrecord BufferOutStream [id size n-channels header samples rate allocated-on-server path open?])

 (defn buffer-stream
   "Returns a buffer-stream which is similar to a regular buffer but may be used
@@ -283,6 +283,8 @@
     (map->BufferOutStream
      (assoc buf
        :path path
+       :header header
+       :samples samples
        :open? (atom true)))))

 (derive BufferOutStream ::buffer-out-stream)


update docstring

update docstring

--- src/overtone/sc/server.clj
+++ src/overtone/sc/server.clj
@@ -82,7 +82,8 @@

 (defn boot-external-server
   "Boot an external server by starting up an external process and connecting to
-  it."
+  it. Requires SuperCollider to be installed in the standard location for your
+  OS."
   ([] (boot :external (+ (rand-int 50000) 2000)))
   ([port] (boot :external port)))


change at macro docstring now that node ids aren't recycled.

--- src/overtone/sc/server.clj
+++ src/overtone/sc/server.clj
@@ -57,17 +57,13 @@

   Warning, all liveness and node blocking when not ready checks and
   functionality is disabled within the context of this macro. This means
-  that it's perfectly possible for you to be controlling a different
-  node than you expect to be controlling if your control message is
-  being executed in the future and in the meantime, the node you wished
-  to control has been terminated and another node has been created with
-  the same id (ids are recycled). "
+  that it's perfectly possible for the node you wish to control to either have
+  been since terminated or not had time to be initialised."
   [time-ms & body]
   `(binding [overtone.sc.dyn-vars/*inactive-node-modification-error*   :silent
              overtone.sc.dyn-vars/*inactive-buffer-modification-error* :silent
              overtone.sc.dyn-vars/*block-node-until-ready?*            false]
      (in-unested-osc-bundle @server-osc-peer* ~time-ms (do ~@body))))
-

 (defmacro snd-immediately
   [& body]


Plongeur view with MDL dashboard lite - first iteration

--- cljx/plongeur-cljs/src/plongeur/view.cljs
+++ cljx/plongeur-cljs/src/plongeur/view.cljs
@@ -25,15 +25,80 @@
   :on-mount   (fn [_ [id _] {:keys [sigma-ctrl]}] (go (>! sigma-ctrl (s/ctrl-update id))))
   :on-unmount (fn [_ [id _] {:keys [sigma-ctrl]}] (go (>! sigma-ctrl (s/ctrl-remove id))))
   [[id props] {:keys [drop-graph] :as intent-chans}]
-  (html [:section {:class "graph-section"}
-         [:button {:on-click #(go (>! drop-graph id))
-                   :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"} "delete " id]
-         [:div {:id    (graph-id id)
-                :class "graph"}]]))
+  (html [:div {:class-name "mdl-cell mdl-cell--6-col-desktop mdl-cell--6-col-tablet mdl-cell--6-col-phone"}
+         [:div {:class-name "mdl-card mdl-shadow--2dp"}
+
+          [:div {:class-name "mdl-card__supporting-text"}
+           [:div {:id (graph-id id)
+                  :class-name "graph"}]]
+
+          [:div {:class-name "mdl-card__title"}
+           [:button {:on-click   #(go (>! drop-graph id))
+                     :class-name "mdl-button mdl-js-button mdl-js-ripple-effect"} "delete " id]]
+
+          ]]))

 (defcomponent Root
   [state {:keys [add-graph debug] :as intent-chans}]
-  (html [:div {:id "plongeur-main"}
+
+  (html [:div {:id "plongeur-main"} ;; extra wrapper for MDL React bug
+
+         [:div {:id         "layout"
+                :class-name "mdl-layout mdl-js-layout mdl-layout--fixed-drawer mdl-layout--fixed-header is-small-screen"}
+
+          ;; HEADER
+
+          [:header {:class-name "mdl-layout__header"}
+           [:div {:class-name "mdl-layout__header-row"}
+            [:div {:class-name "mdl-layout-spacer"}]
+
+
+            ]]
+
+          ;; DRAWER
+
+          [:div {:class-name "mdl-layout__drawer"}
+           [:header {} "Plongeur"]
+           [:nav {:class-name "mdl-navigation"}
+            [:a {:class-name "mdl-navigation__link mdl-navigation__link--current"
+                 :href "index.html"}
+             [:i {:class-name "material-icons"
+                  :role       "presentation"} "dashboard"] "Dashboard"]
+            [:a {:class-name "mdl-navigation__link"
+                 :href "config.html"}
+             [:i {:class-name "material-icons"
+                  :role       "presentation"} "settings"] "Settings"]
+            [:a {:class-name "mdl-navigation__link"
+                 :href "config.html"}
+             [:i {:class-name "material-icons"
+                  :role       "presentation"} "reorder"] "Logs"]
+
+            [:div {:class-name "mdl-layout-spacer"}]
+
+            [:a {:class-name "mdl-navigation__link"
+                 :href "https://github.com/tmoerman/plongeur"
+                 :target "_blank"}
+             [:i {:class-name "material-icons"
+                  :role       "presentation"} "link"] "Github"]
+
+
+            ]]
+
+          ;; CONTENT
+
+          [:main {:class-name "mdl-layout__content"}
+           [:div {:class-name "mdl-grid mdl-grid--no-spacing"}
+
+            [:div {:class-name "mdl-grid mdl-cell mdl-cell--9-col-desktop mdl-cell--12-col-tablet mdl-cell--4-col-phone mdl-cell--top"}
+
+             (for [graph-state (m/graphs state)]
+               (Sigma graph-state intent-chans))
+
+             ]]]
+
+          ]])
+
+  #_(html [:div {:id "plongeur-main"}
          [:div {:id         "layout"
                 :class-name "demo-layout mdl-layout mdl-js-layout mdl-layout--fixed-drawer mdl-layout--fixed-header"}

@@ -57,7 +122,11 @@
             [:a {:class-name "mdl-navigation__link"
                  :href ""}
              [:i {:class-name "mdl-color-text--blue-grey-400 material-icons"
-                  :role "presentation"} "home"] "home"]]]
+                  :role "presentation"} "home"] "home"]
+            [:a {:class-name "mdl-navigation__link"
+                 :href ""}
+             [:i {:class-name "mdl-color-text--blue-grey-400 material-icons"
+                  :role "presentation"} "settings"] "settings"]]]

           [:main {:class-name "mdl-layout__content mdl-color--grey-100"}
            [:button {:on-click   #(go (>! debug :click))
@@ -67,7 +136,9 @@
            [:button {:on-click   #(go (>! add-graph :click))
                      :hidden     (>= (-> state :graphs count) 4)
                      :class-name "mdl-button mdl-js-button mdl-button--fab mdl-button--colored"}
-            [:i {:class-name "material-icons"} "add"]]]]]))
+            [:i {:class-name "material-icons"} "add"]]]]])
+
+              )

 (defn view
   "Returns a stream of view trees, represented as a core.async channel."


azulenoids.clj: eliminated all direct Java interop except with CombineTiles

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -53,16 +53,17 @@
     dsym))

 (def azul-syms
-  (let [raw (for [ds octa-syms o2t boundary-mappings]
-              (java-dsymbol (on-template ds o2t)))]
-    (for [ds (unique #(-> %1 .minimal .invariant) raw)]
-      (-> ds .dual .minimal .canonical))))
+  (let [raw (for [ds octa-syms
+                  o2t boundary-mappings]
+              (minimal (on-template ds o2t)))]
+    (for [ds (unique invariant raw)]
+      (-> ds dual canonical))))

 ;; Main entry point when used as a script

 (defn -main []
   (do
-    (doseq [ds azul-syms] (println (str ds)))
+    (doseq [ds azul-syms] (println ds))
     (println "#Generated:")
     (println "#   " (count octa-sets) "octagonal D-sets.")
     (println "#   " (count octa-syms) "octagonal D-symbols.")


selfudal2d.clj uses dsets.clj

selfudal2d.clj uses dsets.clj

--- clojure/org/gavrog/clojure/selfdual2d.clj
+++ clojure/org/gavrog/clojure/selfdual2d.clj
@@ -2,10 +2,9 @@
   (:use (org.gavrog.clojure
           [delaney]
           [generators :only [results]]
+          [dsets :only [dsets]]
           [branchings2d :only [branchings]]))
-  (:import (org.gavrog.jane.fpgroups SmallActionsIterator)
-           (org.gavrog.joss.dsyms.derived FundamentalGroup DSCover)
-           (org.gavrog.joss.tilings Tiling))
+  (:import (org.gavrog.joss.tilings Tiling))
   (:gen-class))

 (defn euclidean? [ds] (= (curvature ds 1) 0))
@@ -26,12 +25,6 @@
   (fn [& args]
     (reduce #(and %1 (apply %2 args)) true preds)))

-(defn d-sets [max-size]
-  (let [G (FundamentalGroup. (java-dsymbol "1:1,1,1"))]
-    (filter (andp self-dual? proto-euclidean?)
-            (map #(dsymbol (DSCover. G %))
-                 (SmallActionsIterator. (.getPresentation G) max-size false)))))
-
 (defn print-seq [xs format-item format-summary]
   (let [start-time (. System (nanoTime))
         n (count (for [x xs] (println (format-item x))))
@@ -42,7 +35,8 @@
 ;; All convex, self-dual, 2d euclidean tilings.
 (defn d-syms [max-size]
   (let [good? (andp self-dual? minimal? euclidean? convex?)]
-    (for [dset (d-sets max-size)
+    (for [dset (results (dsets 2 max-size))
+          :when (and (self-dual? dset) (proto-euclidean? dset))
           dsym (results (branchings dset))
           :when (good? dsym)]
     (canonical dsym))))


Fix find-doc implementation

Fix find-doc implementation

Copy Lumo’s:

anmonteiro/lumo@81caf3fc7e2d8a8558175a484c41ffeb1de28df2

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -1408,20 +1408,24 @@
                                     :arglists (seq sigs)}]))
                      (into {})))))))))

+(defn- namespace-doc [nspace]
+  (select-keys (get-in @st [::ana/namespaces nspace]) [:name :doc]))
+
 (defn- find-doc*
   [re-string-or-pattern]
   (let [re (re-pattern re-string-or-pattern)
-        sym-docs (sort-by first
-                   (mapcat (fn [ns]
-                             (map (juxt first (comp :doc second))
-                               (get-in @st [::ana/namespaces ns :defs])))
-                     (all-ns)))]
-    (doseq [[sym doc] sym-docs
-            :when (and doc
-                       (name sym)
-                       (or (re-find re doc)
-                           (re-find re (name sym))))]
-      (doc* sym))))
+        ms (concat (mapcat #(sort-by :name
+                              (map (fn [[k v]]
+                                     (assoc (:meta v) :name (symbol % k)))
+                                (get-in @st [::ana/namespaces % :defs])))
+                     (all-ns))
+             (map namespace-doc (all-ns))
+             (map special-doc (keys special-doc-map)))]
+    (doseq [m ms
+            :when (and (:doc m)
+                       (or (re-find re (:doc m))
+                           (re-find re (str (:name m)))))]
+      (doc* (:name m)))))

 (defn- source*
   [sym]


Changed some stuff with the whole setup thing.

--- src/petulant_life/main.clj
+++ src/petulant_life/main.clj
@@ -13,11 +13,14 @@
 (defn create []
   (Display/setDisplayMode (DisplayMode. width height))
   (Display/create)
+  (Display/setTitle "Petulant Life")

   (GL11/glMatrixMode GL11/GL_PROJECTION)
   (GL11/glLoadIdentity)
   (GL11/glOrtho 0 width height 0 -1 1)
-  (GL11/glMatrixMode GL11/GL_MODELVIEW))
+  (GL11/glMatrixMode GL11/GL_MODELVIEW)
+
+  (GL11/glClearColor 0.9 0.9 0.9 1))

 ; Cleaning up the LWJGL context.
 (defn destroy []


now lib preserves model metadata on dispatch-action

--- src/reagent_mvsa/core.cljs
+++ src/reagent_mvsa/core.cljs
@@ -11,13 +11,15 @@
       (-reset!
         [this new-value]
         (if (::force-reset? (meta new-value))
-          (original-reset-fn this (with-meta new-value nil))
+          (original-reset-fn this (with-meta new-value
+                                             (dissoc (meta new-value) ::force-reset?)))
           (assert nil (str "readonly atom cannot be reset to " (pr-str new-value))))))))

 (defn -force-reset!
   "Bypasses write protection of the specified readonly atom."
   [readonly-atom new-value]
-  (reset! readonly-atom (with-meta new-value {::force-reset? true})))
+  (reset! readonly-atom (with-meta new-value
+                                   (assoc (meta new-value) ::force-reset? true))))

 (defn app
   "Constructs an app from a spec map with keys: