Removing the query pretty printer.

Removing the query pretty printer.

--- src/cmr/search/services/query_walkers/query_pretty_printer.clj
+++ src/cmr/search/services/query_walkers/query_pretty_printer.clj
@@ -1,296 +0,0 @@
-(ns cmr.search.services.query-walkers.query-pretty-printer
-  "Changes the way queries and query conditions are pretty printed. Records that are pretty printed
-  do not include type information. This pretty prints the queries as a map with a type field
-  that contains the object class type. It also prints out the fields in the order they are defined
-  in the record."
-  (:require [cmr.common.services.errors :as errors]
-            [cmr.search.models.query :as qm]
-            [camel-snake-kebab :as csk]
-            [cmr.common.util :as util]
-            [clojure.pprint :as pprint])
-  (:import [cmr.search.models.query
-            Query
-            ConditionGroup
-            NestedCondition
-            TextCondition
-            StringCondition
-            StringsCondition
-            NegatedCondition
-            BooleanCondition
-            SpatialCondition
-            ScriptCondition
-            ExistCondition
-            MissingCondition
-            DateValueCondition
-            DateRangeCondition
-            NumericValueCondition
-            NumericRangeCondition
-            StringRangeCondition
-            TemporalCondition
-            OrbitNumberValueCondition
-            OrbitNumberRangeCondition
-            EquatorCrossingLongitudeValueCondition
-            EquatorCrossingLongitudeRangeCondition
-            EquatorCrossingDateCondition
-            CoordinateValueCondition
-            CoordinateRangeCondition
-            TwoDCoordinateCondition
-            TwoDCoordinateSystemCondition
-            CollectionQueryCondition
-            MatchAllCondition
-            MatchNoneCondition
-            AttributeNameCondition
-            AttributeValueCondition
-            AttributeRangeCondition]))
-
-(defprotocol MapifyQuery
-  (mapify
-    [c]
-    "Converts a record into a map with a :type key mapped to a simplfied name of the record class name"))
-
-(defn mapify-record
-  "Converts a record into a map with a :type key containing a simple name of the key. The map keys
-  are ordered to match the order defined in the record"
-  ([r]
-   (let [type-name (symbol (.getSimpleName ^Class (type r)))]
-     (util/remove-nil-keys (into {} (assoc r :type type-name)))))
-  ([fields r]
-   (let [type-name (symbol (.getSimpleName ^Class (type r)))
-         key-order-map (into {} (map-indexed #(vector %2 %1) (cons :type fields)))
-         sorted-by-key-order (sorted-map-by #(compare (key-order-map %1) (key-order-map %2)))]
-     (util/remove-nil-keys (into sorted-by-key-order (assoc r :type type-name))))))
-
-(comment
-
-  (def q (qm/query {:concept-type :granule :condition (qm/string-condition :foo "f")}))
-  (mapify-record (util/record-fields cmr.search.models.query.Query) q)
-  (mapify q)
-  (pprint/pprint q)
-
-  )
-
-
-(def query-types
-  [Query
-   ConditionGroup
-   CollectionQueryCondition
-   NegatedCondition
-   NestedCondition
-   TemporalCondition
-   TextCondition
-   StringCondition
-   StringsCondition
-   BooleanCondition
-   SpatialCondition
-   ScriptCondition
-   ExistCondition
-   MissingCondition
-   DateValueCondition
-   DateRangeCondition
-   NumericValueCondition
-   NumericRangeCondition
-   StringRangeCondition
-   OrbitNumberValueCondition
-   OrbitNumberRangeCondition
-   EquatorCrossingLongitudeValueCondition
-   EquatorCrossingLongitudeRangeCondition
-   EquatorCrossingDateCondition
-   CoordinateValueCondition
-   CoordinateRangeCondition
-   TwoDCoordinateCondition
-   TwoDCoordinateSystemCondition
-   MatchAllCondition
-   MatchNoneCondition
-   AttributeNameCondition
-   AttributeValueCondition
-   AttributeRangeCondition])
-
-(doseq [query-type query-types]
-  ;; Allows queries to be pretty printed using the mapify function
-  (.addMethod ^clojure.lang.MultiFn clojure.pprint/simple-dispatch
-              query-type
-              (fn [q]
-                (pprint/pprint (mapify q)))))
-
-
-(extend-protocol MapifyQuery
-  Query
-  (mapify
-    [q]
-    (mapify-record (util/record-fields Query)
-                   (update-in q [:condition] mapify)))
-
-  ConditionGroup
-  (mapify
-    [c]
-    (mapify-record (util/record-fields ConditionGroup)
-                   (update-in c [:conditions] #(map mapify %))))
-
-  CollectionQueryCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields CollectionQueryCondition)
-                   (update-in c [:condition] mapify)))
-
-  NegatedCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields NegatedCondition)
-                   (update-in c [:condition] mapify)))
-
-  NestedCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields NestedCondition)
-                   (update-in c [:condition] mapify)))
-
-  TemporalCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields TemporalCondition) c))
-
-  TextCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields TextCondition) c))
-
-  StringCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields StringCondition) c))
-
-  StringsCondition
-  (mapify
-    [c]
-
-    (let [c (if (> (count (:values c)) 6)
-              (update-in c [:values]
-                         (fn [values]
-                           [(first values) (second values)
-                            (str "... " (- (count values) 2) " values hidden ...")]))
-              c)]
-      (mapify-record (util/record-fields StringsCondition) c)))
-
-  BooleanCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields BooleanCondition) c))
-
-  SpatialCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields SpatialCondition) c))
-
-  ScriptCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields ScriptCondition) c))
-
-  ExistCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields ExistCondition) c))
-
-  MissingCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields MissingCondition) c))
-
-  DateValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields DateValueCondition) c))
-
-  DateRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields DateRangeCondition) c))
-
-  NumericValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields NumericValueCondition) c))
-
-  NumericRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields NumericRangeCondition) c))
-
-  StringRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields StringRangeCondition) c))
-
-  OrbitNumberValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields OrbitNumberValueCondition) c))
-
-  OrbitNumberRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields OrbitNumberRangeCondition) c))
-
-  CoordinateValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields CoordinateValueCondition) c))
-
-  CoordinateRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields CoordinateRangeCondition) c))
-
-  TwoDCoordinateCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields TwoDCoordinateCondition) c))
-
-  TwoDCoordinateSystemCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields TwoDCoordinateSystemCondition) c))
-
-  EquatorCrossingLongitudeValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields EquatorCrossingLongitudeValueCondition) c))
-
-  EquatorCrossingLongitudeRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields EquatorCrossingLongitudeRangeCondition) c))
-
-  EquatorCrossingDateCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields EquatorCrossingDateCondition) c))
-
-  MatchAllCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields MatchAllCondition) c))
-
-  MatchNoneCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields MatchNoneCondition) c))
-
-  AttributeNameCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields AttributeNameCondition) c))
-
-  AttributeValueCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields AttributeValueCondition) c))
-
-  AttributeRangeCondition
-  (mapify
-    [c]
-    (mapify-record (util/record-fields AttributeRangeCondition) c))
-
-  nil
-  (mapify [_] nil))
-


Change exception message and explanation to exception throw for tests

Signed-off-by: Ben Chapman <4ada7eac694dcb4b5475ac51d142ba919b54bb00@pivotal.io>

--- src/rabbitmq-broker/test/io/pivotal/pcf/rabbitmq/main_test.clj
+++ src/rabbitmq-broker/test/io/pivotal/pcf/rabbitmq/main_test.clj
@@ -8,9 +8,12 @@
   [^long status]
   (def FakeExitCalled status))

+; This exception is thrown to end the fake server
+; We could not find any other reasonable way to achieve
+; this. - (BC) (AS)
 (defn FakeServerStart
   [m]
-  (throw (Exception. "Something Terrible Happened")))
+  (throw (Exception. "End Of The TEST")))
   ; (Thread. (fn [] (prn "Started Fake Sever"))))

 (deftest initialization


Style fix

Style fix

--- test/caesium/crypto/box_test.clj
+++ test/caesium/crypto/box_test.clj
@@ -14,8 +14,7 @@
   (testing "generate public key from secret key"
     (is (let [kp1 (generate-keypair)
               kp2 (generate-keypair (:secret kp1))]
-          (array-eq (:public kp1)
-                    (:public kp2))))))
+          (array-eq (:public kp1) (:public kp2))))))

 (def nonce (v/hex-resource "vectors/box/nonce"))
 (def plaintext (v/hex-resource "vectors/box/plaintext"))


Verify test output exists prior to checking content.

--- test/parkour/word_count_test.clj
+++ test/parkour/word_count_test.clj
@@ -46,11 +46,15 @@
   (let [inpath (io/resource "word-count-input.txt")
         outpath (fs/path "tmp/word-count-output")
         outfs (fs/path-fs outpath)
-        _ (.delete outfs outpath true)]
-    (is (= true (run-word-count inpath outpath)))
+        _ (.delete outfs outpath true)
+        success? (run-word-count inpath outpath)
+        outfile (->> (fs/path outpath "part-*")
+                     (fs/path-glob outfs)
+                     first io/file)]
+    (is (= true success?))
+    (is (not (nil? outfile)))
     (is (= {"apple" 3, "banana" 2, "carrot" 1}
-           (with-open [adf (->> (fs/path outpath "part-*") (fs/path-glob outfs)
-                                first io/file avro/data-file-reader)]
+           (with-open [adf (avro/data-file-reader outfile)]
              (->> adf seq (into {})))))))

@@ -84,9 +88,13 @@
   (let [inpath (io/resource "word-count-input.txt")
         outpath (fs/path "tmp/word-distinct-output")
         outfs (fs/path-fs outpath)
-        _ (.delete outfs outpath true)]
-    (is (= true (run-word-distinct inpath outpath)))
+        _ (.delete outfs outpath true)
+        success? (run-word-distinct inpath outpath)
+        outfile (->> (fs/path outpath "part-*")
+                     (fs/path-glob outfs)
+                     first io/file)]
+    (is (= true success?))
+    (is (not (nil? outfile)))
     (is (= ["apple" "banana" "carrot"]
-           (with-open [adf (->> (fs/path outpath "part-*") (fs/path-glob outfs)
-                                first io/file avro/data-file-reader)]
+           (with-open [adf (avro/data-file-reader outfile)]
              (->> adf seq (into [])))))))


Use config.clj in iplayer-download-commnad.

--- src/beebster_clj/core.clj
+++ src/beebster_clj/core.clj
@@ -1,20 +1,26 @@
 (ns beebster-clj.core
-  (:import [java.lang.ProcessBuilder])
   (:require [compojure.route :as route]
-            [compojure.handler :as handler])
+            [compojure.handler :as handler]
+            [beebster-clj.config :as config])
   (:use [ring.adapter.jetty :only [run-jetty]]
         [clojure.java.shell :only [sh]]
         [clojure.string :as str :only [split-lines ]]
-        hiccup.core hiccup.util hiccup.page compojure.core ))
+        hiccup.core hiccup.util hiccup.page compojure.core))

-
+;; iplayer-command to use for searches. The use of --listformat reduces
+;; get_iplayer's output just to the desired information, in this case
+;; index, the url of the programmes thumbnail, and the programmes title,
+;; and in case of series, the episode number.
 (def iplayer-command
   ["get_iplayer" "--nocopyright" "--limitmatches" "50" "--listformat" "<index> <thumbnail> <name> <episode>"])
-;;
+

 (def iplayer-info
   ["get-iplayer" "-i"])

+
+;; keeping downloaded programmes longer than 30 days on your harddisk is not
+;; cool. Thus, get_iplayer asks you to delete old recordings.
 (def delete-string
   "These programmes should be deleted:")

@@ -67,11 +73,15 @@

 (defn iplayer-download-command
-  "concatenate index and mode to download command"
+  "Get values of terminal and download-destination from beebster-clj.config.clj.
+   By default, it uses gnome-terminal and $HOME/Videos. Then build a list
+   of commands for 'sh' to work on."
    [index mode]
-   (list "gnome-terminal"
-         (apply str "--working-directory=" (System/getenv "HOME") "/Videos")
-         "-e"  (apply str "get-iplayer" " --modes=" mode "1" " -g " index)))
+   (let [term (get config/config :terminal)
+         dir  (get config/config :download-folder)]
+     (list term
+           dir
+           "-e"  (apply str "get-iplayer" " --modes=" mode "1" " -g " index))))

 (defn get-url


enable sign up

enable sign up

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -7,6 +7,7 @@
             [frontend.components.shared :as shared]
             [frontend.state :as state]
             [frontend.stefon :as stefon]
+            [frontend.utils.github :refer [auth-url]]
             [frontend.utils :as utils :include-macros true]
             [om.core :as om :include-macros true])
   (:require-macros [frontend.utils :refer [defrender html]]))


add comment

add comment

--- src/babel/directory.cljc
+++ src/babel/directory.cljc
@@ -22,6 +22,8 @@
     (swap! (:es models) (fn [old-model] (delay (es/small))))
     (swap! (:fr models) (fn [old-model] (delay (fr/model))))
     (swap! (:it models) (fn [old-model] (delay (it/model))))
+    ;; (swap! (:it models) (fn [old-model] (delay (grammar/model-reloaded))))
+
     (swap! (:la models) (fn [old-model] (delay (la/model))))
     (log/info (str "refreshed models."))))


:sparkles: Navigate automatically to new created file

--- frontend/src/uxbox/main/data/dashboard.cljs
+++ frontend/src/uxbox/main/data/dashboard.cljs
@@ -364,7 +364,13 @@
             recent-project-files (get-in state [:recent-file-ids project-id] [])]
         (-> state
           (assoc-in [:files file-id] data)
-          (assoc-in [:recent-file-ids project-id] (conj recent-project-files file-id)))))))
+          (assoc-in [:recent-file-ids project-id] (conj recent-project-files file-id)))))
+
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (rx/of (rt/nav :workspace {:project-id (:project-id data)
+                                 :file-id (:id data)}
+                     {:page-id (first (:pages data))})))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


:sparkles: Change some workspace shortcuts

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -1499,19 +1499,19 @@
    "ctrl+shift+d" #(st/emit! (toggle-layout-flag :dynamic-alignment))
    "+" #(st/emit! (increase-zoom nil))
    "-" #(st/emit! (decrease-zoom nil))
-   "ctrl+g" #(st/emit! create-group)
-   "ctrl+shift+g" #(st/emit! remove-group)
+   "g" #(st/emit! create-group)
+   "shift+g" #(st/emit! remove-group)
    "shift+0" #(st/emit! reset-zoom)
    "shift+1" #(st/emit! zoom-to-fit-all)
    "shift+2" #(st/emit! zoom-to-selected-shape)
-   "ctrl+d" #(st/emit! duplicate-selected)
+   "d" #(st/emit! duplicate-selected)
    "ctrl+z" #(st/emit! dwc/undo)
    "ctrl+shift+z" #(st/emit! dwc/redo)
    "ctrl+y" #(st/emit! dwc/redo)
    "ctrl+q" #(st/emit! dwc/reinitialize-undo)
-   "ctrl+b" #(st/emit! (select-for-drawing :rect))
-   "ctrl+e" #(st/emit! (select-for-drawing :circle))
-   "ctrl+t" #(st/emit! (select-for-drawing :text))
+   "b" #(st/emit! (select-for-drawing :rect))
+   "e" #(st/emit! (select-for-drawing :circle))
+   "t" #(st/emit! (select-for-drawing :text))
    "ctrl+c" #(st/emit! copy-selected)
    "ctrl+v" #(st/emit! paste)
    "escape" #(st/emit! :interrupt deselect-all)


subscribe user to all tags when adding to group

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -134,11 +134,12 @@
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (when-let [user-id (get-in ring-req [:session :user-id])]
     (if-let [invite (db/with-conn (db/get-invite (?data :id)))]
-      (do
-        (db/with-conn
-          ; TODO: need to send group info to user
-          (db/user-add-to-group! user-id (invite :group-id))
-          (db/retract-invitation! (invite :id))))
+      (db/with-conn
+        (db/user-add-to-group! user-id (invite :group-id))
+        (db/user-subscribe-to-group-tags! user-id (invite :group-id))
+        (db/retract-invitation! (invite :id))
+        ; TODO: update users visible to user
+        (chsk-send! user-id [:chat/joined-group (db/get-group (invite :group-id))]))
       (timbre/warnf "User %s attempted to accept nonexistant invitaiton %s"
                     user-id (?data :id)))))


Added identity mutation to combined cases

--- src/clj/asols/solver.clj
+++ src/clj/asols/solver.clj
@@ -111,7 +111,9 @@
   [{m-opts :mutation-opts :as solver} net cases]
   (let [selected-cases (->> cases
                             (sort-cases)
-                            (take-while #(not= ::m/identity (:operation (:mutation %))))
+                            (reverse)
+                            (drop-while #(not= ::m/identity (:operation (:mutation %))))
+                            (reverse)
                             (take (:max-combined-count m-opts)))]
     (for [select-count (range 2 (inc (count selected-cases)))
           :let [merge-cases (take select-count selected-cases)
@@ -142,7 +144,10 @@
     (let [mutations (get-mutations solver net)
           progress-chan (make-progress-chan out-chan (count mutations))
           [cases ms-took] (solve-mutations solver net mutations tpool progress-chan)
-          [best-case & other-cases] (sort-cases (make-combined-cases solver net cases))]
+          combined-cases (make-combined-cases solver net cases)
+          [best-case & other-cases] (if (empty? combined-cases)
+                                      (filter #(= ::m/identity (:operation (:mutation %))) cases)
+                                      (sort-cases combined-cases))]
       (make-solving solver net best-case other-cases ms-took))
     (catch InterruptedException _
       (debug "Detected thread interrupt"))))


CLJS-876: merged sourcemap doesn't account for output-wrapper

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -905,7 +905,8 @@
               sources name
               (assoc opts
                 :preamble-line-count
-                (- (count (.split #"\r?\n" (make-preamble opts) -1)) 1)))))
+                (+ (- (count (.split #"\r?\n" (make-preamble opts) -1)) 1)
+                   (if (:output-wrapper opts) 1 0))))))
         source)
       (report-failure result))))

@@ -1072,7 +1073,8 @@
               {:source-map sm-name
                :preamble-line-count
                (if (= name :cljs-base)
-                 (- (count (.split #"\r?\n" (make-preamble opts) -1)) 1)
+                 (+ (- (count (.split #"\r?\n" (make-preamble opts) -1)) 1)
+                    (if (:output-wrapper opts) 1 0))
                  0)
                :foreign-deps-line-count
                (if fdeps-str


Actually retry failed slack posts

Actually retry failed slack posts

--- src/clj/tictag/slack.clj
+++ src/clj/tictag/slack.clj
@@ -26,30 +26,33 @@
 (defn method-url [m] (str slack-api-url m))

 (defn success? [resp]
-  (if (utils/success? resp)
-    (get-in resp [:body :ok])
-    (timbre/debug "Failed to send message" resp)))
+  (when (and (utils/success? resp)
+             (get-in resp [:body :ok]))
+    resp))

 (dh/defretrypolicy retry-policy
-  {:backoff-ms [250 5000]
-   :max-retries 8
-   :retry-if (fn [{:keys [error]} exception]
-               (when error
-                 (timbre/debugf "Retrying due to error: %s" (pr-str error)))
-               (when exception
-                 (timbre/debugf "Retrying due to exception: %s" (.getMessage exception)))
-               (or error exception))})
+  {:backoff-ms [11 1009]
+   :jitter-ms 0.1
+   :max-retries 8})
+

 (defn post [client cmd opts]
   (timbre/debug cmd)
-  (dh/with-retry {:policy retry-policy}
-    (let [resp (-> cmd
-                   (method-url)
-                   (http/post opts)
-                   (deref)
-                   (update :body json/parse-string true))]
-      (when (success? resp)
-        resp))))
+  (dh/with-retry {:policy retry-policy
+                  :on-retry (fn [_ e] (timbre/debug "Retry" cmd (.getMessage e)))
+                  :on-abort (fn [_ e] (timbre/error "Retries failed, aborting" cmd (.getMessage e)))}
+    (let [{:keys [error] :as response} (-> cmd
+                                           (method-url)
+                                           (http/post opts)
+                                           (deref 5000 {:error :timeout}))]
+      (when error
+        (throw (ex-info "HTTP Exception occurred" {:exception exception
+                                                   :cmd cmd
+                                                   :opts opts})))
+      (some-> response
+              (update :body json/parse-string true)
+              (success?)))))
+

 (defn im-open [client token user-id]
   (:body (post client "im.open" {:form-params {:token token :user user-id}})))


[core] extract atomic char vec swaps

[core] extract atomic char vec swaps

--- src/clj_dstream/core.clj
+++ src/clj_dstream/core.clj
@@ -314,18 +314,23 @@
                                         grids))]
        grids-w-new-label)))

+(defn update-char-vec-in-state! [state* pos-idx new-char-vec]
+  (p ::update-char-vec-in-state!
+     (swap! state* assoc-in [::grid-cells pos-idx] new-char-vec)))
+
 (defn update-grid-cells [state t]
   ;;TODO spec this
   (p ::update-grid-cells
      (let [lambda (get-in state [::properties ::lambda])
            state* (atom state)]
        (doseq [[pos-idx char-vec] (::grid-cells @state*)]
-         (swap! state* assoc-in
-                [::grid-cells pos-idx]
-                (update-char-vec-label
-                  {::char-vec   (update-char-vec-density char-vec t lambda false)
-                   ::properties (::properties state)
-                   ::t          t})))
+         (update-char-vec-in-state!
+           state*
+           pos-idx
+           (update-char-vec-label
+             {::char-vec   (update-char-vec-density char-vec t lambda false)
+              ::properties (::properties state)
+              ::t          t})))
        @state*)))

 (defn dense-grids->unique-clusters [state]
@@ -422,11 +427,7 @@
 (defn- step-nine! [current-cluster updated-state* pos-idx biggest-neighbor char-vec]
   (if (= "NO_CLASS" current-cluster)
     ;;step 10
-    (swap! updated-state* assoc-in [::grid-cells pos-idx]
-           (do
-             ;(log-it pos-idx ::move-grid-to-biggest-neighboring-cluster
-             ;        biggest-neighbor)
-             (assoc char-vec ::cluster biggest-neighbor)))
+    (update-char-vec-in-state! updated-state* pos-idx (assoc char-vec ::cluster biggest-neighbor))
     (swap! updated-state* assoc-in [::grid-cells]
            (merge (::grid-cells @updated-state*)
                   (if (> (cluster->size current-cluster @updated-state*)
@@ -448,8 +449,7 @@
   (when (= ::sparse (::label char-vec))
     (let [old-cluster (::cluster char-vec)]
       ;(log-it pos-idx ::sparse-label {:cluster old-cluster})
-      (swap! updated-state* assoc-in [::grid-cells pos-idx]
-             (assoc char-vec ::cluster "NO_CLASS"))
+      (update-char-vec-in-state! updated-state* pos-idx (assoc char-vec ::cluster "NO_CLASS"))
       (let [new-cluster (cluster->grid-cells old-cluster @updated-state*)]
         ;;step 6
         (when (and
@@ -472,12 +472,13 @@
     (when (and (not (= "NO_CLASS" current-cluster))
                (> (cluster->size current-cluster @updated-state*)
                   (cluster->size biggest-neighbor @updated-state*)))
-      (swap! updated-state* assoc-in [::grid-cells (first grid-w-biggest-neighbor)]
-             (do
-               (log-it pos-idx ::move-neighoring-grid-to-current-cluster
-                       {:from biggest-neighbor
-                        :to   current-cluster})
-               (assoc (second grid-w-biggest-neighbor) ::cluster current-cluster))))))
+      (update-char-vec-in-state!
+        updated-state*
+        (first grid-w-biggest-neighbor)
+        (assoc
+          (second grid-w-biggest-neighbor)
+          ::cluster
+          current-cluster)))))

 (defn adjust-clustering [state t]
   (log-it [state t] ::adjust-clustering [{:t t}])
@@ -556,12 +557,7 @@
                                                    (sort-by :cluster-size)
                                                    last)]
                      (when biggest
-                       (swap! updated-state* assoc-in [::grid-cells pos-idx]
-                              (do
-                                ;(log-it pos-idx ::move-current-grid-to-biggest-neighboring-cluster-ensuring-it-is-an-outside-grid
-                                ;        {:from (::cluster char-vec)
-                                ;         :to   (:cluster biggest)})
-                                (assoc char-vec ::cluster (:cluster biggest)))))))))))))
+                       (update-char-vec-in-state! updated-state* pos-idx (assoc char-vec ::cluster (:cluster biggest))))))))))))
     @updated-state*))

 (defn detect-and-remove-sporadic-grids [state t]


This code is pig ugly!

This code is pig ugly!

Added a localstorage, uploading and a counter.

One more thing to do now: Get the counter to reset to the default value
after the game is over.

This means having two stores: :total-time and :time-left

:total-time isn't altered, whereas :time-left is.

--- src/cljs/kenny/core.cljs
+++ src/cljs/kenny/core.cljs
@@ -1,6 +1,7 @@
 (ns kenny.core
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
+            [cognitect.transit :as transit]
             [alandipert.storage-atom :refer [local-storage load-local-storage]]
             [cljs.core.async :as async :refer[<! chan sliding-buffer put! close! timeout]])

@@ -65,6 +66,7 @@
                    :settings {:bounce [3]
                               :red-trampete [5]
                               :blue-trampete [3]
+                              :time [60]
                               }})

 (def app-state (local-storage (atom default-data) "game"))
@@ -198,6 +200,16 @@
     )
   )

+(defn time-up? [settings app hero]
+  (if (> 0 (first (get-in settings [:time])))
+    (merge hero {:life 0})
+    (do
+      (om/transact! app [:settings :time 0] (fn [old-time] (do
+                                                             (console-log old-time)
+                                                             (- old-time 0.04))))
+      hero
+          )))
+
 (defn game-over? [original-hero hero]
   (if (or (> 0 (get-in hero [:position :bottom]))
           (> 0 (get-in hero [:life])))
@@ -217,6 +229,7 @@
               bounce (get-in @app [:settings :bounce])
               red-trampete (get-in @app [:settings :red-trampete])
               blue-trampete (get-in @app [:settings :blue-trampete])
+              settings (get-in @app [:settings])
               new-hero (-> original-hero
                            grav
                            ((partial vertical-block original-hero))
@@ -226,6 +239,7 @@
                            ((partial on-blue-trampete? blue-trampete))
                            ((partial on-red-trampete? red-trampete))
                            spike-damage
+                           ((partial time-up? settings app))
                            ((partial home? original-hero))
                            ((partial game-over? original-hero))
                            )]
@@ -321,7 +335,7 @@
     (render-state [this state]
       (apply
        dom/tr nil
-       (om/build-all table-cell row {:init-state {:options [[0] [1] [2] [3] [4] [9]]}})))))
+       (om/build-all table-cell row {:init-state {:options [[0] [1] [2] [3] [4] [5]]}})))))

 (defn grid-table [grid owner]
   (reify
@@ -349,20 +363,85 @@
                                     (dom/th nil "Blue Trampoline")
                                     (om/build table-cell (:blue-trampete settings) {:init-state {:options (mapv (fn [i] [i]) (range 1 7))}})
                                     )
+                            (dom/tr nil
+                                    (dom/th nil "Spiel Dauer")
+                                    (om/build table-cell (:time settings) {:init-state {:options (mapv (fn [i] [i]) (range 30 61))}})
+                                    )
                             )

                  )
       ))
   )

+
+(def json-writer (transit/writer :json-verbose))
+
+(defn download-href []
+  (let [json (transit/write json-writer (load-local-storage "game"))]
+    (str "data:application/json;charset=utf-8," (clojure.string/replace json " " "\u00a0"))))
+
+(defn download-page [e]
+  (let [a-tag (.. e -target)]
+    (aset a-tag "download" "website.json")
+    (aset a-tag "href" (download-href))))
+
+(defn preview-or-tutorial [app]
+  (dom/li nil
+          (dom/button #js {:className "btn btn-success navbar-btn" :onClick (fn [e] (om/transact! app :show-help (fn [bool] (not bool))) false)}
+                 (if (app :show-help)
+                   "Website"
+                   "Tutorial"))))
+
+(defn update-storage [json]
+  (let [transit-reader (transit/reader :json)
+        user-data (transit/read transit-reader (clojure.string/replace json "\u00a0" " "))
+        ]
+    (swap! app-state (fn [_] user-data))
+    ))
+
+(defn handle-upload [e]
+  (let [file-field (.. e -target)
+        file (aget file-field "files" 0)
+        file-reader (js/FileReader.)
+        content (.readAsText file-reader file)]
+    (set! (.-onload file-reader) (fn [] (update-storage (aget file-reader "result"))))
+    false))
+
+(defn upload-menu-item []
+  (dom/li nil
+          (dom/div #js {:className "btn-file btn btn-success navbar-btn"}
+                   (dom/form #js {:method "post" :encType "multipart/form-data"}
+                             (dom/input #js {:type "file" :name "data" :className "file-input" :onChange handle-upload}))
+                   (dom/span nil "Hochladen")
+                   )))
+
+
+(defn reset-page [e]
+  (reset! app-state default-data)
+  false
+  )
+
 (defn design-view [app owner]
   (reify
     om/IRenderState
     (render-state [this state]
       (dom/div nil
+               (dom/h2 #js {:href "#"} "Menu")
+               (dom/ul nil
+                       (dom/li nil
+                               (dom/a #js {:href "#" :onClick download-page} "Herunterladen")
+                               )
+                       (dom/li nil
+                               (dom/a #js {:href "#" :onClick reset-page} "Zürucksetzen")
+                               )
+                       (dom/li nil
+                               (dom/form #js {:method "post" :encType "multipart/form-data"}
+                                         (dom/input #js {:type "file" :name "data" :className "file-input" :onChange handle-upload}))
+                               )
+                       )
                (dom/h2 nil "Der Raster")
                (om/build grid-table (:grid app))
-               (dom/h2 nil "Kenny")
+               (dom/h2 nil "Einstellungen")
                (om/build settings-form (:settings app))
                )
       )))
@@ -372,22 +451,26 @@
     om/IRender
     (render [this]
       (dom/div #js {:className "status-bar"}
+               (dom/span #js {:className "life"} (str "Time: " (ceil (first (get-in app [:settings :time])))))
                (dom/span #js {:className "life"} (str "Leben: " (get-in app [:hero :life]) "%"))
                (dom/button #js {:onClick (fn [e] (do
                                                    (om/transact! app [:hero] (fn [_] default-hero))
-                                                   (.. js/document (querySelector ".grid") (focus))
                                                    false))
+
                                 }
                            "Neu Starten")
                (dom/button #js {:onClick (fn [e] (do
                                                    (om/transact! app :design-game (fn [bool] (not bool)))
-                                                   (.. js/document (querySelector ".grid") (focus))
                                                    false
                                                    )
                                            )}
                            (if (app :design-game)
                              "Züruck"
                              "Entwerfen"))
+
+
+
+
                )))
   )


Comment out sente websockets for now. Start deckbuilder app on start.

--- src/cljs/sptcg/core.cljs
+++ src/cljs/sptcg/core.cljs
@@ -7,20 +7,13 @@
             [cljs.core.async :as async :refer (<! >! put! chan)]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [taoensso.sente :as sente :refer (cb-success?)])
+            [taoensso.sente :as sente :refer (cb-success?)]
+            [sptcg.deck-builder :as deck-builder])
   (:import [goog.net XhrIo]
            goog.net.EventType
            [goog.events EventType]))

 (enable-console-print!)
-
-(println "Hello world!")
-
-(let [{:keys [chsk ch-recv send-fn]}
-      (sente/make-channel-socket! "/chsk" {} {:type :auto})]
-  (def chsk       chsk)
-  (def ch-chsk    ch-recv)
-  (def chsk-send! send-fn))

 (defn- event-handler [[id data :as ev] _]
   (println "<!" id)
@@ -42,10 +35,18 @@
    [:chsk/recv  payload]   (logf "From server: %s"       payload)
    :else (logf "Unmatched <!: %s" id)))

-(let [ch-chsk   ch-chsk ; Chsk events (incl. async events from server)
+#_(let [{:keys [chsk ch-recv send-fn]}
+      (sente/make-channel-socket! "/chsk" {} {:type :auto})]
+  (def chsk       chsk)
+  (def ch-chsk    ch-recv)
+  (def chsk-send! send-fn))
+
+#_(let [ch-chsk   ch-chsk ; Chsk events (incl. async events from server)
       ch-ui     (chan)  ; Channel for your own UI events, etc. (optional)
       ch-merged (async/merge [ch-chsk ch-ui])]

   ;; Will start a core.async go loop to handle `event`s as they come in:

   (sente/start-chsk-router-loop! event-handler ch-merged))
+
+(deck-builder/start!)


Don't change orientation if same

Don't change orientation if same

--- src/chessground/ctrl.cljs
+++ src/chessground/ctrl.cljs
@@ -92,7 +92,9 @@
      (show/moved root orig dest (:last-move state)))])

 (defn set-orientation [state orientation]
-  (if (common/seq-contains? chess/colors orientation)
+  (if (and
+        (common/seq-contains? chess/colors orientation)
+        (not= orientation (:orientation state)))
     (let [new-state (assoc state :orientation orientation)]
       [new-state
        (fn [root chans] (show/board root new-state chans))])


some more descriptive statistics

some more descriptive statistics

--- src/clj/ceres/curator.clj
+++ src/clj/ceres/curator.clj
@@ -141,6 +141,12 @@
        (fn [node] (:reactions node))
        (fn [node new-children] (assoc-in node [:reactions] new-children))
        (Article. origin tweet (vec (pmap spread (into #{} merged-articles))))))))
+
+
+(defn compute-user-tree [name]
+  (let [user-tweets (mc/find-maps @db "tweets" (:user.screen_name name))
+        reactions (pmap spread user-tweets)]
+    reactions))

 (defn compute-dfs
@@ -379,35 +385,71 @@

-  (let [faz-hours (->> sum-faz
+  ;; publication time of day
+  (let [sz-hours (->> sum-sz
                        :pub-times
                        flatten
                        (map t/hour)
                        frequencies
                        (sort-by key <))]
-    (view (line-chart (keys pub-hours) (vals pub-hours))))
-
-
-  (let [delays (->>  sum-faz
+    (view (line-chart (keys sz-hours) (vals sz-hours))))
+
+
+  ;; reaction delay
+  (let [delays (->>  sum-sz
                      :delays
                      (remove #(= % 0))
                      (remove #(> % 600)))]
     (view (histogram delays :nbins 120)))

-  (let [hours-running (t/in-hours (t/interval (t/date-time 2014 7 2) (t/now)))
-        dates (take hours-running (p/periodic-seq (t/date-time 2014 7 2) (t/hours 1)))
-        tweet-count (map
-                     #(mc/count @db
-                                "tweets"
-                                {:created_at {$gte %
-                                              $lt (t/plus % (t/hours 1))}})
-                     dates)
-        days-since-start (range hours-running)]
-    (view (line-chart days-since-start tweet-count)))
-
+  ;; daily tweet counts
+  (let [days (t/in-days (t/interval (t/date-time 2014 8 1) (t/date-time 2014 9 15)))
+        dates (take days (p/periodic-seq (t/date-time 2014 8 1) (t/days 1)))
+        tweet-counts (map
+                      (fn [date]
+                        (->> sum-sz
+                             :pub-times
+                             flatten
+                             (filter #(and (t/after? % date) (t/before? % (t/plus date (t/days 1)))))
+                             count))
+                      dates)
+        ]
+    (view (line-chart (range 1 (inc days)) tweet-counts)))
+
+
+
+
+  ;; tweet counts
+  (let [days-running (t/in-days (t/interval (t/date-time 2014 7 2) (t/date-time 2014 9 15)))
+        dates (take days-running (p/periodic-seq (t/date-time 2014 7 2) (t/days 1)))
+        sz-tweet-count (map #(mc/count @db "tweets" {:user.screen_name "SZ" :created_at {$gte % $lt (t/plus % (t/days 1))}}) dates)
+        spon-tweet-count (map #(mc/count @db "tweets" {:user.screen_name "SPIEGELONLINE" :created_at {$gte % $lt (t/plus % (t/days 1))}}) dates)
+        faz-tweet-count (map #(mc/count @db "tweets" {:user.screen_name "FAZ_NET" :created_at {$gte % $lt (t/plus % (t/days 1))}}) dates)
+        bild-tweet-count (map #(mc/count @db "tweets" {:user.screen_name "BILD" :created_at {$gte % $lt (t/plus % (t/days 1))}}) dates)
+        tagesschau-tweet-count (map #(mc/count @db "tweets" {:user.screen_name "tagesschau" :created_at {$gte % $lt (t/plus % (t/days 1))}}) dates)
+        days-since-start (apply concat (repeat 5 (range days-running)))
+        ;; tweet-count-2 (loop [hours-list [] tweet-dist tweet-count] (if (empty? tweet-dist) hours-list (recur (conj hours-list (vec (take 24 tweet-dist))) (drop 24 tweet-dist))))
+        ;; avg-tweets-per-hour (map (fn [hour] (/ (reduce + (map (fn [count] (get count hour)) tweet-count-2)) (count tweet-count-2))) (range 24))
+        tweet-counts (concat sz-tweet-count spon-tweet-count faz-tweet-count bild-tweet-count tagesschau-tweet-count)
+        grouping (apply concat (map #(repeat (count sz-tweet-count) %) ["sz" "spon" "faz" "bild" "tagesschau"]))]
+    (view (line-chart days-since-start tweet-counts :legend true :group-by grouping)))
+
+  (let [days-running (t/in-hours (t/interval (t/date-time 2014 7 2) (t/date-time 2014 9 12)))
+        dates (take days-running (p/periodic-seq (t/date-time 2014 7 2) (t/hours 1)))
+        tweet-count (map #(mc/count @db "tweets" {:created_at {$gte % $lt (t/plus % (t/hours 1))}}) dates)
+        time (range days-running)
+        tweet-count-2 (loop [hours-list []
+                             tweet-dist tweet-count]
+                        (if (empty? tweet-dist)
+                          hours-list
+                          (recur (conj hours-list (vec (take 24 tweet-dist))) (drop 24 tweet-dist))))
+        avg-tweets-per-hour (map (fn [hour] (/ (reduce + (map (fn [count] (get count hour)) tweet-count-2)) (count tweet-count-2))) (range 24))]
+    (view (line-chart time tweet-count))
+    (view (line-chart (range 24) avg-tweets-per-hour)))

   ;; twitter-nlp
   ;; html compression
+
   )


fix busted cond case in cljs.analyzer/source-path

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1190,7 +1190,6 @@
   [x]
   (cond
    (instance? File x) (.getAbsolutePath ^File x)
-   (instance? java.net.URL x) (-> ^java.net.URL x .toURI File. .getAbsolutePath)
    :default (str x)))

 (defn forms-seq


CLJS-697: top-level symbol reference doesn't get an automatically
inserted ns-name

Add another resolve-var . case, check the current ns

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -331,11 +331,16 @@
                  lb (-> env :locals prefix)]
              (if lb
                {:name (symbol (str (:name lb) suffix))}
-               (if-let [full-ns (get-in @env/*compiler* [::namespaces (-> env :ns :name) :imports prefix])]
-                 {:name (symbol (str full-ns) suffix)}
-                 (merge (get-in @env/*compiler* [::namespaces prefix :defs (symbol suffix)])
-                   {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix))
-                    :ns prefix}))))
+               (let [cur-ns (-> env :ns :name)]
+                 (if-let [full-ns (get-in @env/*compiler* [::namespaces cur-ns :imports prefix])]
+                   {:name (symbol (str full-ns) suffix)}
+                   (if-let [info (get-in @env/*compiler* [::namespaces cur-ns :defs prefix])]
+                     (merge info
+                       {:name (symbol (str cur-ns) (str sym))
+                        :ns cur-ns})
+                     (merge (get-in @env/*compiler* [::namespaces prefix :defs (symbol suffix)])
+                       {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix))
+                        :ns prefix}))))))

            (get-in @env/*compiler* [::namespaces (-> env :ns :name) :uses sym])
            (let [full-ns (get-in @env/*compiler* [::namespaces (-> env :ns :name) :uses sym])]
@@ -354,8 +359,8 @@
              (when confirm
                (confirm env full-ns sym))
              (merge (get-in @env/*compiler* [::namespaces full-ns :defs sym])
-                    {:name (symbol (str full-ns) (str sym))
-                     :ns full-ns})))))))
+               {:name (symbol (str full-ns) (str sym))
+                :ns full-ns})))))))

 (defn resolve-existing-var [env sym]
   (if-not (-> sym meta ::no-resolve)


relax :import to validate w/ sequential? not vector?

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -836,11 +836,11 @@
                          (throw (error env (error-msg spec "Only [lib.ns :only (names)] specs supported in :use / :use-macros"))))
                        [lib :refer referred])
         parse-import-spec (fn parse-import-spec [spec]
-                            (when-not (or (and (vector? spec)
+                            (when-not (or (and (sequential? spec)
                                                (every? symbol? spec))
                                           (and (symbol? spec) (nil? (namespace spec))))
                               (throw (error env (error-msg spec "Only lib.ns.Ctor or [lib.ns Ctor*] spec supported in :import"))))
-                            (let [import-map (if (vector? spec)
+                            (let [import-map (if (sequential? spec)
                                                (->> (rest spec)
                                                  (map #(vector % (symbol (str (first spec) "." %))))
                                                  (into {}))


Use load instead of require to load core cljs macros

Loading now happens dynamically and once when the
analyzer is first ran.
Also provides macros to facilitate overriding of the
default path provided (defaults to cljs/core).

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -22,7 +22,6 @@
 (declare confirm-bindings)
 (declare munge)
 (declare ^:dynamic *cljs-file*)
-(require 'cljs.core)

 (def js-reserved
   #{"abstract" "boolean" "break" "byte" "case"
@@ -63,6 +62,33 @@
 (def ^:dynamic *unchecked-if* (atom false))
 (def ^:dynamic *cljs-static-fns* false)
 (def ^:dynamic *position* nil)
+(def ^:dynamic *cljs-macros-path* "/cljs/core")
+(def ^:dynamic *cljs-macros-is-classpath* true)
+(def  -cljs-macros-loaded (atom false))
+
+(defn load-core []
+  (when (not @-cljs-macros-loaded)
+    (reset! -cljs-macros-loaded true)
+    (if *cljs-macros-is-classpath*
+      (load *cljs-macros-path*)
+      (load-file *cljs-macros-path*))))
+
+(defmacro with-core-macros
+  [path & body]
+  `(do
+     (when (not= *cljs-macros-path* ~path)
+       (reset! -cljs-macros-loaded false))
+     (binding [*cljs-macros-path* ~path]
+       ~@body)))
+
+(defmacro with-core-macros-file
+  [path & body]
+  `(do
+     (when (not= *cljs-macros-path* ~path)
+       (reset! -cljs-macros-loaded false))
+     (binding [*cljs-macros-path* ~path
+               *cljs-macros-is-classpath* false]
+       ~@body)))

 (defn empty-env []
   {:ns (@namespaces *cljs-ns*) :context :statement :locals {}})
@@ -1308,7 +1334,7 @@
     (when (seq @deps)
       (analyze-deps @deps))
     (set! *cljs-ns* name)
-    (require 'cljs.core)
+    (load-core)
     (doseq [nsym (concat (vals requires-macros) (vals uses-macros))]
       (clojure.core/require nsym))
     (swap! namespaces #(-> %
@@ -1581,6 +1607,7 @@
      (let [form (if (instance? clojure.lang.LazySeq form)
                   (or (seq form) ())
                   form)]
+       (load-core)
        (cond
         (symbol? form) (analyze-symbol env form)
         (and (seq? form) (seq form)) (analyze-seq env form name)


* src/clj/cljs/compiler.clj: double check namespaces for :excludes and :use-macros in get-expander

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -1383,8 +1383,10 @@
 (defn get-expander [sym env]
   (let [mvar
         (when-not (or (-> env :locals sym)        ;locals hide macros
-                      (and (-> env :ns :excludes sym)
-                           (not (-> env :ns :uses-macros sym))))
+                      (and (or (-> env :ns :excludes sym)
+                               (get-in @namespaces [(-> env :ns :name) :excludes sym]))
+                           (not (or (-> env :ns :uses-macros sym)
+                                    (get-in @namespaces [(-> env :ns :name) :uses-macros sym])))))
           (if-let [nstr (namespace sym)]
             (when-let [ns (cond
                            (= "clojure.core" nstr) (find-ns 'cljs.core)


Add trips resource to routes

Add trips resource to routes

--- src/clj/gtfve/handler.clj
+++ src/clj/gtfve/handler.clj
@@ -4,10 +4,14 @@
             [ring.middleware.defaults :refer [site-defaults wrap-defaults]]
             [selmer.parser :refer [render-file]]
             [prone.middleware :refer [wrap-exceptions]]
-            [environ.core :refer [env]]))
+            [environ.core :refer [env]]
+            [gtfve.data.queries :as q]))

 (defroutes routes
   (GET "/" [] (render-file "templates/index.html" {:dev (env :dev?)}))
+  (GET "/trips" []
+      (fn [req]
+        {:status 200 :body (pr-str (q/trips)) :headers {"Content-Type" "application/edn"}}))
   (resources "/")
   (not-found "Not Found"))


add rf

add rf

--- src/cljam/algo/pileup.clj
+++ src/cljam/algo/pileup.clj
@@ -127,7 +127,8 @@
         ([acc]
          (-> acc
              (rf (persistent! @va))
-             (rf (persistent! @vb))))
+             (rf (persistent! @vb))
+             rf))
         ([acc x]
          (let [[a b] (transform-fn x)]
            (vswap! va conj! a)


Add start button.

Add start button.

--- src/cljs/beatha/core.cljs
+++ src/cljs/beatha/core.cljs
@@ -8,21 +8,23 @@
 (enable-console-print!)

 (def app-state (atom {:grid {:width 10 :height 10 :cells {}}
-                      :display {:width 600 :height 600}}))
+                      :display {:width 600 :height 600}
+                      :started false}))

 (defn cell-view
-  [cell owner]
+  [data owner]
   (reify
     om/IRenderState
     (render-state [_ {:keys [cell-state-changed x y]}]
-      (let [{:keys [width height state]} cell
+      (let [{:keys [width height state started]} data
             st #js {:width width :height height}]
         (dom/div #js {:style st
                       :className
                       (apply str
                              (interpose " " ["automaton-cell" (name state)]))
-                      :onClick #(put! cell-state-changed [x y])})))))
+                      :onClick #(when-not started
+                                  (put! cell-state-changed [x y]))})))))

 (defn grid-view
@@ -44,6 +46,7 @@
                                   cell-view
                                   (merge (get-in data [:grid :cells [x y]]
                                                  default-cell)
+                                         {:started (:started data)}
                                          {:width cell-width
                                           :height cell-height})
                                   {:init-state
@@ -68,20 +71,26 @@
   (reify
     om/IRenderState
     (render-state [_ {:keys [width height change-grid-dimensions] :as state}]
-      (dom/div
-       #js {:role "form" :className "automaton-grid-control"}
-       (dom/label nil "Grid width")
-       (dom/input
-        #js {:type "text" :className "form-control" :value width
-             :onChange #(handle-numeric-config-change % owner state :width)})
-       (dom/label nil "Grid height")
-       (dom/input
-        #js {:type "text" :className "form-control" :value height
-             :onChange #(handle-numeric-config-change % owner state :height)})
-       (dom/button
-        #js {:type "submit" :className "btn btn-primary btn-lg btn-block"
-             :onClick #(put! change-grid-dimensions [width height])}
-        "Reset grid")))))
+      (let [started (:started data)]
+        (dom/div
+         #js {:role "form" :className "automaton-grid-control"}
+         (dom/label nil "Grid width")
+         (dom/input
+          #js {:type "text" :className "form-control" :value width
+               :disabled started
+               :onChange
+               #(handle-numeric-config-change % owner state :width)})
+         (dom/label nil "Grid height")
+         (dom/input
+          #js {:type "text" :className "form-control" :value height
+               :disabled started
+               :onChange
+               #(handle-numeric-config-change % owner state :height)})
+         (dom/button
+          #js {:type "button" :className "btn btn-danger btn-lg btn-block"
+               :disabled started
+               :onClick #(put! change-grid-dimensions [width height])}
+          "Reset grid"))))))

 (defn display-config-view
@@ -90,20 +99,26 @@
     om/IRenderState
     (render-state [_ {:keys [width height change-display-dimensions]
                       :as state}]
-      (dom/div
-       #js {:role "form" :className "automaton-display-control"}
-       (dom/label nil "Display width")
-       (dom/input
-        #js {:type "text" :className "form-control" :value width
-             :onChange #(handle-numeric-config-change % owner state :width)})
-       (dom/label nil "Display height")
-       (dom/input
-        #js {:type "text" :className "form-control" :value height
-             :onChange #(handle-numeric-config-change % owner state :height)})
-       (dom/button
-        #js {:type "submit" :className "btn btn-primary btn-lg btn-block"
-             :onClick #(put! change-display-dimensions [width height])}
-        "Reset display")))))
+      (let [started (:started data)]
+        (dom/div
+         #js {:role "form" :className "automaton-display-control"}
+         (dom/label nil "Display width")
+         (dom/input
+          #js {:type "text" :className "form-control" :value width
+               :disabled started
+               :onChange
+               #(handle-numeric-config-change % owner state :width)})
+         (dom/label nil "Display height")
+         (dom/input
+          #js {:type "text" :className "form-control" :value height
+               :disabled started
+               :onChange
+               #(handle-numeric-config-change % owner state :height)})
+         (dom/button
+          #js {:type "button" :className "btn btn-warning btn-lg btn-block"
+               :disabled started
+               :onClick #(put! change-display-dimensions [width height])}
+          "Reset display"))))))

 (defn gen-app-view
@@ -114,12 +129,14 @@
       (init-state [_]
         {:change-grid-dimensions (chan)
          :change-display-dimensions (chan)
-         :cell-state-changed (chan)})
+         :cell-state-changed (chan)
+         :started (chan)})
       om/IWillMount
       (will-mount [_]
         (let [grid-c (om/get-state owner :change-grid-dimensions)
               display-c (om/get-state owner :change-display-dimensions)
-              cell-state-c (om/get-state owner :cell-state-changed)]
+              cell-state-c (om/get-state owner :cell-state-changed)
+              started-c (om/get-state owner :started)]
           (go (loop []
                 (let [[width height] (<! grid-c)]
                   (om/transact!
@@ -145,6 +162,10 @@
                            cell (assoc cell
                                   :state (a/next-state automaton-spec state))]
                        (assoc grid [x y] cell))))
+                  (recur))))
+          (go (loop []
+                (let [started (<! started-c)]
+                  (om/update! data :started started)
                   (recur))))))
       om/IRenderState
       (render-state [_ state]
@@ -169,7 +190,15 @@
                       {:init-state
                        (merge state
                               {:width (get-in data [:display :width])
-                               :height (get-in data [:display :height])})})))
+                               :height (get-in data [:display :height])})}))
+           (let [started (:started data)]
+             (dom/div
+              #js {:className "row"}
+              (dom/button
+               #js {:type "button"
+                    :className "btn btn-primary btn-lg btn-block"
+                    :onClick #(put! (:started state) (not started))}
+               (if-not started "Start" "Stop")))))
           (dom/div #js {:className "col-sm-10"}
                    (om/build grid-view
                              data


Fixed issue #49: Add following product/release: RHEL 6.7 HA.

--- src/clouseau/products.clj
+++ src/clouseau/products.clj
@@ -59,6 +59,11 @@
          :subprotocol "sqlite"
          :subname     "packages/rhel67/primary.sqlite"
      }]
+     ["RHEL 6.7 High Availability"
+        {:classname   "org.sqlite.JDBC"
+         :subprotocol "sqlite"
+         :subname     "packages/rhel67_ha/primary.sqlite"
+     }]
      ["RHEL 7"
         {:classname   "org.sqlite.JDBC"
          :subprotocol "sqlite"


Removed crypto library

Removed crypto library

--- src/compojure/crypto.clj
+++ src/compojure/crypto.clj
@@ -1,132 +0,0 @@
-;; Copyright (c) James Reeves. All rights reserved.
-;; The use and distribution terms for this software are covered by the Eclipse
-;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
-;; can be found in the file epl-v10.html at the root of this distribution. By
-;; using this software in any fashion, you are agreeing to be bound by the
-;; terms of this license. You must not remove this notice, or any other, from
-;; this software.
-
-(ns compojure.crypto
-  "Functions for cryptographically signing, verifying and encrypting data."
-  (:use compojure.encodings)
-  (:use clojure.contrib.def)
-  (:use clojure.contrib.java-utils)
-  (:import java.security.SecureRandom)
-  (:import javax.crypto.Cipher)
-  (:import javax.crypto.KeyGenerator)
-  (:import javax.crypto.Mac)
-  (:import javax.crypto.spec.SecretKeySpec)
-  (:import javax.crypto.spec.IvParameterSpec)
-  (:import java.util.UUID))
-
-(defvar hmac-defaults
-  {:algorithm "HmacSHA256"}
-  "Default options for HMACs.")
-
-(defvar encrypt-defaults
-  {:algorithm  "AES"
-   :key-size   128
-   :mode       "CBC"
-   :padding    "PKCS5Padding"}
-  "Default options for symmetric encryption.")
-
-(defn secure-random-bytes
-  "Returns a random byte array of the specified size. Can optionally supply
-   an PRNG algorithm (defaults is SHA1PRNG)."
-  ([size]
-    (secure-random-bytes size "SHA1PRNG"))
-  ([size algorithm]
-     (let [seed (make-array Byte/TYPE size)]
-       (.nextBytes (SecureRandom/getInstance algorithm) seed)
-       seed)))
-
-(defn gen-secret-key
-  "Generate a random secret key from a map of encryption options."
-  ([]
-    (gen-secret-key {}))
-  ([options]
-    (secure-random-bytes (/ (options :key-size) 8))))
-
-(defn gen-uuid
-  "Generate a random UUID."
-  []
-  (str (UUID/randomUUID)))
-
-(defn- to-bytes
-  "Converts its argument into an array of bytes."
-  [x]
-  (cond
-    (string? x)     (.getBytes x)
-    (sequential? x) (into-array Byte/TYPE x)
-    :else           x))
-
-(defn hmac-bytes
-  "Generate a HMAC byte array with the supplied key on a byte array of data.
-  Takes an optional map of cryptography options."
-  [options key data]
-  (let [options   (merge hmac-defaults options)
-        algorithm (options :algorithm)
-        hmac      (doto (Mac/getInstance algorithm)
-                    (.init (SecretKeySpec. key algorithm)))]
-    (.doFinal hmac data)))
-
-(defn hmac
-  "Generate a Basc64-encoded HMAC with the supplied key on a byte array or
-  string of data. Takes an optional map of cryptography options."
-  [options key data]
-  (base64-encode-bytes (hmac-bytes options key (to-bytes data))))
-
-(defn- make-algorithm
-  "Return an algorithm string suitable for JCE from a map of options."
-  [options]
-  (str "AES/" (options :mode) "/" (options :padding)))
-
-(defn- make-cipher
-  "Create an AES Cipher instance."
-  [options]
-  (Cipher/getInstance (make-algorithm options)))
-
-(defn encrypt-bytes
-  "Encrypts a byte array with the given key and encryption options."
-  [options key data]
-  (let [options    (merge encrypt-defaults options)
-        cipher     (make-cipher options)
-        secret-key (SecretKeySpec. key (options :algorithm))
-        iv         (secure-random-bytes (.getBlockSize cipher))]
-    (.init cipher Cipher/ENCRYPT_MODE secret-key (IvParameterSpec. iv))
-    (to-bytes (concat iv (.doFinal cipher data)))))
-
-(defn decrypt-bytes
-  "Decrypts a byte array with the given key and encryption options."
-  [options key data]
-  (let [options    (merge encrypt-defaults options)
-        cipher     (make-cipher options)
-        [iv data]  (split-at (.getBlockSize cipher) data)
-        iv-spec    (IvParameterSpec. (to-bytes iv))
-        secret-key (SecretKeySpec. key (options :algorithm))]
-    (.init cipher Cipher/DECRYPT_MODE secret-key iv-spec)
-    (.doFinal cipher (to-bytes data))))
-
-(defn encrypt
-  "Encrypts a string or byte array with the given key and encryption options."
-  [options key data]
-  (base64-encode-bytes (encrypt-bytes options key (to-bytes data))))
-
-(defn decrypt
-  "Base64 encodes and encrypts a string with the given key and algorithm."
-  [options key data]
-  (String. (decrypt-bytes options key (base64-decode-bytes data))))
-
-(defn seal
-  "Seal a data structure into a cryptographically secure string. Ensures no-one
-  looks at or tampers with the data inside."
-  [key data]
-  (let [data (encrypt {} key (marshal data))]
-    (str data "--" (hmac {} key data))))
-
-(defn unseal
-  "Read a cryptographically sealed data structure."
-  [key data]
-  (let [[data mac] (.split data "--")]
-    (if (= mac (hmac {} key data))
-      (unmarshal (decrypt {} key data)))))


Restrict Event DELETE route to developer capabilities (#803)

--- src/ctia/entity/event.clj
+++ src/ctia/entity/event.clj
@@ -158,7 +158,8 @@
      :can-patch? false
      :can-post? false
      :can-get-by-external-id? false
-     :search-capabilities :search-event})))
+     :search-capabilities :search-event
+     :delete-capabilities #{:delete-event :developer}})))

 (def event-entity
   {:new-spec map?


delete judgement with hooks

delete judgement with hooks

--- src/ctia/http/handler.clj
+++ src/ctia/http/handler.clj
@@ -426,7 +426,10 @@
         :header-params [api_key :- (s/maybe s/Str)]
         :summary "Deletes a Judgement"
         :capabilities #{:delete-judgement :admin}
-        (if (delete-judgement @judgement-store id)
+        (if (flows/delete-flow #(read-judgement @judgement-store %)
+                               #(delete-judgement @judgement-store %)
+                               :judgement
+                               id)
           (no-content)
           (not-found))))


Added ruby additional properties

Added ruby additional properties

--- src/ctia/task/codegen.clj
+++ src/ctia/task/codegen.clj
@@ -32,8 +32,14 @@
                      :title artifact-id
                      :titleLower artifact-id
                      :package artifact-id}
-   :java {}
-   :ruby {}})
+   :ruby {:gemName artifact-id
+          :gemVersion artifact-version
+          :gemHomepage "http://github.com/threatgrid/ctia"
+          :gemSummary description
+          :gemDescription description
+          :gemAuthor "Cisco Security Business Group -- Advanced Threat"
+          :gemAuthorEmail "cisco-intel-api-support@cisco.com"}
+   :java {}})

 (defn spec-uri
   "compose the full path of the swagger spec to generate from"
@@ -93,7 +99,7 @@
 (defn -main [output-dir]
   "invoke with lein run -m ctia.task.codegen <output-dir>"
   (setup)
-  (doseq [[lang props] (select-keys langs [:clojure])]
+  (doseq [[lang props] langs]
     (generate-language lang props output-dir))

   (println "done")


btset single-pass lookup and conj

btset single-pass lookup and conj

--- src/datascript/btset.cljs
+++ src/datascript/btset.cljs
@@ -42,10 +42,25 @@
         :else m))
     l))

-(defn ^number lookup-leaf [^array arr key]
+(defn ^number lookup-exact [^array arr key]
+  (let [arr-l (alength arr)
+        idx   (binary-search arr 0 (dec arr-l) key)]
+    (if (and (< idx arr-l)
+             (eq (aget arr idx) key))
+      idx
+      -1)))
+
+(defn ^number lookup-range [^array arr key]
+  (let [arr-l (alength arr)
+        idx   (binary-search arr 0 (dec arr-l) key)]
+    (if (== idx arr-l)
+      -1
+      idx)))
+
+(defn ^number lookup-insert-leaf [^array arr key]
   (binary-search arr 0 (- (alength arr) 1) key))

-(defn ^number lookup-node [^array arr key]
+(defn ^number lookup-insert-node [^array arr key]
   (binary-search arr 0 (- (alength arr) 2) key))

 (defn ^number -seek [set key]
@@ -53,8 +68,8 @@
          path  empty-path
          level (.-shift set)]
     (if (== 0 level)
-      (path-set path level (lookup-leaf (.-keys node) key))
-      (let [idx (lookup-node (.-keys node) key)]
+      (path-set path level (lookup-insert-leaf (.-keys node) key))
+      (let [idx (lookup-insert-node (.-keys node) key)]
         (recur (aget (.-pointers node) idx)
                (path-set path level idx)
                (- level level-shift))))))
@@ -70,7 +85,7 @@
                            ^number cut-to
                            ^number splice-from
                            ^number splice-to
-                           ^array  xs] ;; TODO slice + concat?
+                           ^array  xs]
   (let [arr-l   (alength arr)
         xs-l    (alength xs)
         l1      (- splice-from cut-from)
@@ -85,7 +100,7 @@
       (aset new-arr (+ i l1xs) (aget arr (+ splice-to i))))
     new-arr))

-(defn cut ;; TODO use Array.prototype.slice etc
+(defn cut
   (^array [^array arr ^number cut-from]
     (.slice arr cut-from))
   (^array [^array arr ^number cut-from ^number cut-to]
@@ -200,32 +215,30 @@
           ps (merge-n-split pointers (.-pointers next))]
       (return-array (Node. (aget ks 0) (aget ps 0))
                     (Node. (aget ks 1) (aget ps 1)))))
-
+
   (lookup [_ key]
-    (let [idx (binary-search keys 0 (dec (alength keys)) key)]
-      (if (== idx (alength keys))
-        -1
-        idx)))
-
-  (append [this path level key] ;; TODO figure out idx here
-    (let [idx   (path-get path level)
-          nodes (.append (aget pointers idx) path (- level level-shift) key)]
-      (if (identical? (aget nodes 0) (aget pointers idx))
-        #js [this]
+    (let [idx (lookup-range keys key)]
+      (when-not (== -1 idx)
+        (.lookup (aget pointers idx) key))))
+
+  (conj [this key]
+    (let [idx   (lookup-insert-node keys key)
+          nodes (.conj (aget pointers idx) key)]
+      (when nodes
         (let [new-keys     (check-n-splice keys     idx (inc idx) (.map nodes lim-key))
               new-pointers (splice         pointers idx (inc idx) nodes)]
           (if (<= (alength new-pointers) max-len)
-          ;; ok as is
-          #js [(Node. new-keys new-pointers)]
-          ;; gotta split it up
-          (let [middle  (half (alength new-pointers))]
-            #js [(Node. (cut new-keys     0 middle)
-                        (cut new-pointers 0 middle))
-                 (Node. (cut new-keys     middle)
-                        (cut new-pointers middle))]))))))
-
-  (disj [this ^number key root? left right]
-    (let [idx (.lookup this key)]
+            ;; ok as is
+            #js [(Node. new-keys new-pointers)]
+            ;; gotta split it up
+            (let [middle  (half (alength new-pointers))]
+              #js [(Node. (cut new-keys     0 middle)
+                          (cut new-pointers 0 middle))
+                   (Node. (cut new-keys     middle)
+                          (cut new-pointers middle))]))))))
+
+  (disj [this key root? left right]
+    (let [idx (lookup-range keys key)]
       (when-not (== -1 idx) ;; short-circuit, key not here
         (let [child       (aget pointers idx)
               left-child  (when (>= (dec idx) 0)                 (aget pointers (dec idx)))
@@ -254,19 +267,21 @@
                     (LeafNode. (aget ks 1)))))

   (lookup [_ key]
-    (let [idx (binary-search keys 0 (dec (alength keys)) key)]
-      (if (and (< idx (alength keys))
-                 (eq (aget keys idx) key))
-        idx
-        -1)))
-
-  (append [this ^number path _ key] ;; TODO figure out idx here
-    (let [idx    (path-get path 0)
+    (let [idx (lookup-exact keys key)]
+      (when-not (== -1 idx)
+        (aget keys idx))))
+
+  (conj [this key]
+    (let [idx    (lookup-insert-leaf keys key)
           keys-l (alength keys)]
       (cond
-        (eq key (aget keys idx)) ;; element already there
-          #js [this]
-        (== keys-l max-len) ;; splitting
+        ;; element already here
+        (and (< idx keys-l)
+             (eq key (aget keys idx)))
+          nil
+
+        ;; splitting
+        (== keys-l max-len)
           (let [middle (half (inc keys-l))]
             (if (> idx middle)
               ;; new key goes to the second half
@@ -275,12 +290,14 @@
               ;; new key goes to the first half
               #js [(LeafNode. (cut-n-splice keys 0 middle idx idx #js [key]))
                    (LeafNode. (cut keys middle keys-l))]))
-        :else ;; ok as is
+
+        ;; ok as is
+        :else
           #js [(LeafNode. (splice keys idx idx #js [key]))])))

-  (disj [this ^number key root? left right]
-    (let [idx (.lookup this key)]
-      (when-not (== -1 idx) ;; key not there
+  (disj [this key root? left right]
+    (let [idx (lookup-exact keys key)]
+      (when-not (== -1 idx) ;; key is here
         (let [new-keys (splice keys idx (inc idx) #js [])]
           (rotate (LeafNode. new-keys) root? left right))))))

@@ -291,20 +308,21 @@
       (recur (- level level-shift) (aget (.-pointers node) (path-get path level)))
       (.-keys node))))

-(defn key-for [set ^number path]
-  (let [keys (keys-for set path)
-        idx  (path-get path 0)]
-    (when (< idx (alength keys))
-      (aget keys idx))))
-
 (defn btset-conj [set key]
   (binding [*cmp* (.-comparator set)]
-    (let [roots (.append (.-root set) (-seek set key) (.-shift set) key)]
-      (if (== (alength roots) 1)
+    (let [roots (.conj (.-root set) key)]
+      (cond
+        ;; tree not changed
+        (nil? roots)
+          set
+
         ;; keeping single root
-        (BTSet. (aget roots 0) (.-shift set) *cmp*)
+        (== (alength roots) 1)
+          (BTSet. (aget roots 0) (.-shift set) *cmp*)
+
         ;; introducing new root
-        (BTSet. (Node. (.map roots lim-key) roots) (+ (.-shift set) level-shift) *cmp*)))))
+        :else
+          (BTSet. (Node. (.map roots lim-key) roots) (+ (.-shift set) level-shift) *cmp*)))))

 (defn btset-disj [set key]
   (binding [*cmp* (.-comparator set)]
@@ -400,8 +418,8 @@
   (-lookup [set k]
     (-lookup set k nil))
   (-lookup [set k not-found]
-    (let [found (key-for set (seek set k))]
-      (if (eq found k) found not-found)))
+    (binding [*cmp* (.-comparator set)]
+      (or (.lookup (.-root set) k) not-found)))

   ISeqable
   (-seq [this]
@@ -458,7 +476,7 @@
 ;; (def s0 (into (btset) (shuffle (range 10000))))
 ;; (reduce disj s0 (shuffle (range 9995)))

-(defn test-rand []
+(defn ^:export test-rand []
   (dotimes [i 20]
     (let [xs        (vec (repeatedly (rand-int 10000) #(rand-int 10000)))
           xs-sorted (distinct (sort xs))
@@ -477,14 +495,15 @@

 ;; perf

-(def test-matrix [:target    { ;; "sorted-set" (sorted-set)
+(def test-matrix [:target    { "sorted-set" (sorted-set)
                                "btset"      (btset)}
-                  ;; :distinct? [true false]
-;;                   :size    [100 500 1000 2000 5000 10000 20000 50000]
-                  :size      [100 500 20000]
+;;                   :distinct? [true false]
+                  :size    [100 500 1000 2000 5000 10000 20000 50000]
+;;                   :size      [100 500 20000]
                   :method    { "conj"    (fn [opts] (into (:target opts) (:range opts)))
-;;                                "lookup"  (fn [opts] (contains? (:set opts) (rand-int (:size opts))))
-;;                                "iterate" (fn [opts] (doseq [x (:set opts)] (+ 1 x)))
+                               "disj"    (fn [opts] (reduce disj (:set opts) (shuffle (:range opts))))
+                               "lookup"  (fn [opts] (contains? (:set opts) (rand-int (:size opts))))
+                               "iterate" (fn [opts] (doseq [x (:set opts)] (+ 1 x)))
                              }])

 (defn test-setup [opts]


deftag, defvariant, extend-variant

deftag, defvariant, extend-variant

--- src/detritus/variants.clj
+++ src/detritus/variants.clj
@@ -1,32 +1,63 @@
 (ns detritus.variants
   (:require [detritus.update :refer [take-when]]))

-(defmacro defvariant
-  "Defines a variant constructor with a namespace qualified tag, and keyword
-  named members. Preconditions on members may be specified by the pre-map.
+(defmacro deftag
+  "Defines a tagged value constructor with a namespace qualified keyword tag,
+  and a body map with keyword named members. Preconditions on members may be
+  specified by the pre-map as for clojure.core/defn.

-  Ex. (defvariant test \"A demo variant\" [a b]
+  Ex. (deftag test \"A demo variant\" [a b]
         {:pre [(number? a) (vector? b)]})"
   {:arglists '([name doc-string? attr-map? members pre-map?])}
   [vname & args]
   (let [;; Parse direct args
-        [?docstring args]    (take-when string? "" args)
-        [?attr-map args]     (take-when map? {} args)
-        [members args]       (take-when vector? nil args)
-        [?pre-map args] (take-when map? {} args)
+        [?docstring args] (take-when string? "" args)
+        [?attr-map args]  (take-when map? {} args)
+        [members args]    (take-when vector? nil args)
+        [?pre-map args]   (take-when map? {} args)

         ;; FIXME inline guards are a bad habit of mine
-        _                    (assert (vector? members) "Members is not a vector!")
-        _                    (assert (every? symbol? members) "Members may contain only symbols!")
+        _                 (assert (vector? members) "Members is not a vector!")
+        _                 (assert (every? symbol? members) "Members may contain only symbols!")

         ;; Build used datastructures
-        kw-members           (map (comp keyword name) members)
-        kw-tag               (keyword (name (ns-name *ns*))
-                                      (name vname))
-        ?attr-map            (assoc ?attr-map
-                                    :variant true
-                                    :variant/members kw-members
-                                    :variant/tag kw-tag)]
-  `(defn ~vname ~?docstring ~?attr-map ~members
-     ~?pre-map
-     [~kw-tag (hash-map ~@(interleave kw-members members))])))
+        kw-members        (mapv (comp keyword name) members)
+        kw-tag            (keyword (name (ns-name *ns*))
+                                   (name vname))
+        ?attr-map         (assoc ?attr-map
+                                 :variants/tag true
+                                 :tag/members  kw-members
+                                 :tag/tag      kw-tag)]
+    `(do (defn ~vname ~?docstring ~?attr-map ~members
+           ~?pre-map
+           [~kw-tag (hash-map ~@(interleave kw-members members))])
+         nil)))
+
+(defmacro defvariant [variant-name]
+  (let [pred-name    (symbol (str (name variant-name) "?"))
+        default-case (keyword (name (gensym)))]
+    `(do (defmulti ~pred-name first
+           :default ~default-case)
+         (defmulti ~variant-name first)
+         (alter-meta! (var ~variant-name)
+                      merge {:variants/variant true
+                             :variant/predicate (quote ~(symbol (name (ns-name *ns*))
+                                                                (name pred-name)))})
+         (defmethod ~pred-name ~default-case [& _#] false)
+         nil)))
+
+(defmacro extend-variant [name tag args & body]
+  (let [variant-var  (resolve name)
+        variant-meta (meta variant-var)
+        _            (assert (get variant-meta :variants/variant) "Tried to extend a non-variant!")
+        variant-pred (:variant/predicate variant-meta)
+        _            (assert variant-pred "Tried to extend a variant with no predicate!")
+        _            (resolve variant-pred)
+        tag-var      (resolve tag)
+        tag-meta     (meta tag-var)
+        _            (assert (:variants/tag tag-meta) "Tried to extend a variant on an unknown var!")
+        tag-keyword  (:tag/tag tag-meta)
+        _            (assert (keyword? tag-keyword) "Could not resolve the keyword for the given tag!")]
+    `(do (defmethod ~name         ~tag-keyword [[_# ~@args]] ~@body)
+         (defmethod ~variant-pred ~tag-keyword [& _#] true)
+         nil)))


in progress

in progress

--- src/epicea/typed/core.clj
+++ src/epicea/typed/core.clj
@@ -367,4 +367,13 @@
 (assert (= [:long [:value 9]]
            (compile-typed {} (parse 9) (fn [_ x] x))))

+(defn long-to-dynamic [[v x]]
+  (assert (= :value v))
+  x)
+
+(defn to-dynamic-expr [x] (:checked-get type-head)
+  (:long [x] (long-to-dynamic (access/get x type-body))))

+(assert (= 9 (to-dynamic-expr [:long [:value 9]])))
+
+


Adder dir listing to show relative key

Adder dir listing to show relative key

--- src/etcd_clojure/core.clj
+++ src/etcd_clojure/core.clj
@@ -43,7 +43,7 @@
         value (clojure.core/get json "value")]
     (if value
       value
-      (map #(clojure.core/get % "key") json))))
+      (map #(last (clojure.string/split (clojure.core/get % "key" json) #"/")) json))))

 (defn delete
   [key]


list: Use recursive=false default. Refs #10

--- src/etcd_clojure/core.clj
+++ src/etcd_clojure/core.clj
@@ -94,7 +94,7 @@

 (defn list
   "Lists the content of a directory"
-  [key & {:keys [recursive]}]
+  [key & {:keys [recursive] :or {recursive false}}]
   (let [url (str (base-url) "/keys/" key "?recursive=" recursive)]
     (map #(assoc {} :key (clojure.core/get % "key") :value (clojure.core/get % "value"))
          (api-get-in (get-json http/get url) ["node" "nodes"]))))


changed function name

changed function name

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -134,7 +134,7 @@
                     first-inactive-upload-id
                     (start-upload first-inactive-upload))))))

-(defn handle-unpause-while-started! [uploads uploads-order upload-slots active-uploads upload-id]
+(defn handle-unpause! [uploads uploads-order upload-slots active-uploads upload-id]
   (if (> (count (active-uploads uploads-order uploads))
           upload-slots)
     (let [uploads-order-after-id (uploads-after-id uploads-order upload-id)
@@ -178,7 +178,7 @@
                                    (= action :unpaused)
                                      (do
                                        (.pipe blob-stream stream)
-                                       (handle-unpause-while-started! uploads
+                                       (handle-unpause! uploads
                                                                       uploads-order
                                                                       upload-slots
                                                                       active-uploads


More REPL debugging code. Clean up messages.

--- src/gorilla_repl/core.clj
+++ src/gorilla_repl/core.clj
@@ -16,9 +16,17 @@
             [cemerick.drawbridge :as drawbridge])
   (:gen-class))

+;; useful for debugging the nREPL requests
+(defn print-req
+  [handler]
+  (fn [request]
+    (println (:params request))
+    (handler request)))
+
 ;; the handler function for repl requests
 (def ^:private drawbridge
   (-> (drawbridge/ring-handler)
+      #_(print-req)
       (keyword-params/wrap-keyword-params)
       (nested-params/wrap-nested-params)
       (params/wrap-params)
@@ -53,17 +61,20 @@

 (defn run-gorilla-server
   [conf]
-  (println "Gorilla-REPL starting ...")
+  (println "Gorilla-REPL.")
   ;; first we look at the configuration, and if requested, load the worksheet
   (when-let [ws (:worksheet conf)]
+    (print (str "Loading " ws " ... "))
     ;; if we load a file, we store its filename in the config
     (swap! config-info #(assoc % :worksheet-filename ws))
     ;; load the file itself and put that in the config
-    (swap! config-info #(assoc % :worksheet-data (slurp ws))))
+    ;; TODO: S'pose some error handling here wouldn't be such a bad thing
+    (swap! config-info #(assoc % :worksheet-data (slurp ws)))
+    (println "done."))
   ;; start the app
   (let [p (:port @config-info)
         s (jetty/run-jetty app-routes {:port p :join? false})]
-    (println (str "Ready. Running at http://localhost:" p "/worksheet.html ."))
+    (println (str "Running at http://localhost:" p "/worksheet.html ."))
     (println "Ctrl+C to exit.")
     ;; block this thread by joining the server (which should run until killed)
     (.join s)))


Document how render sets the filepath & handle case where no permapath

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -216,7 +216,11 @@
     ((resolve '~sym) ~file)))

 (deftask render
-  "Render pages"
+  "Render pages.
+
+   If permalink is set for the file, it is used as the filepath else. If permalink
+   ends in slash, index.html is used as filename. If permalink is not set, the
+   original filename is used with file extension set to html."
   [o out-dir  OUTDIR   str  "The output directory"
    r renderer RENDERER sym  "Page renderer. Must be fully qualified symbol which resolves to a function."]
   (let [pods    (wrap-pool (pod/pod-pool (boot/get-env)))
@@ -229,11 +233,11 @@
           (let [html          (render-in-pod pod renderer file)
                 page-filepath (perun/create-filepath
                                 (:out-dir options)
-                                ; If permalink ends in slash, append index.html to filepath
+                                ; If permalink ends in slash, append index.html as filename
                                 (or (some-> (:permalink file)
-                                            (.replaceAll "/$" "/index.html")
+                                            (string/replace #"/$" "/index.html")
                                             perun/url-to-path)
-                                    filename))]
+                                    (string/replace filename #"(?i).[a-z]+$" ".html")))]
             (perun/create-file tmp page-filepath html)))
         (u/info "Render all pages\n")
         (commit fileset tmp)))))


Workaround type coersion issue in backend by using explicit double scaling constants in config.clj.

--- metlog-agent/config.clj
+++ metlog-agent/config.clj
@@ -1,11 +1,11 @@
 (def start-t (System/currentTimeMillis))

 (defsensor sine {:poll-interval (seconds 10)}
-  (Math/sin (/ (- (System/currentTimeMillis) start-t) (minutes 1))))
+  (Math/sin (/ (- (System/currentTimeMillis) start-t) 60000.0)))

 (defsensor cosine {:poll-interval (seconds 10)}
-  (Math/cos (/ (- (System/currentTimeMillis) start-t) (minutes 1))))
+  (Math/cos (/ (- (System/currentTimeMillis) start-t) 60000.0)))

 (defsensor steps-ascending {:poll-interval (seconds 5)}
-  (mod (/ (- (System/currentTimeMillis) start-t) (minutes 2))
+  (mod (/ (- (System/currentTimeMillis) start-t) 120000.0)
        3))


modified clojush/problems/tozier/winkler01.clj (fiddled with args)

--- src/clojush/problems/tozier/winkler01.clj
+++ src/clojush/problems/tozier/winkler01.clj
@@ -1,16 +1,17 @@
 ;; winkler01.clj
 ;; Bill Tozier, bill@vagueinnovation.com
 ;;
-;; This is code for running my variant on Winkler's Zeros-and-Ones puzzle:
-;; For any positive integer input, return a strictly positive integer which
-;;   when multiplied by the input produces a result which contains only the
+;; This is code for running Tozier's variant on Winkler's Zeros-and-Ones puzzle:
+;;   For any positive (non-zero) integer input, return a strictly positive integer which
+;;   when multiplied by the input value produces a result which contains only the
 ;;   digits 0 and 1 (in base 10 notation)
 ;;
-;; Input and output are given as single integers using the integer stack.
+;; Input and output are given as integers using the integer stack.

 (ns clojush.problems.tozier.winkler01
   (:use clojush.pushgp.pushgp
         [clojush pushstate interpreter random]
+        [clojure.math.numeric-tower]
         ))

 ; Create the error function
@@ -41,14 +42,26 @@
             1000))))))

+; Atom generators
+(def winkler-atom-generators
+  (concat (list
+            (fn [] (lrand-int 65536)) ;Integer ERC [0,65536]
+            ;;; end ERCs
+            'in1
+            ;;; end input instructions
+            )
+            (registered-for-stacks [:integer :boolean :exec])))
+
+
 ; Define the argmap
 (def argmap
-  {:error-function (winkler-error-function 80)
+  {:error-function (winkler-error-function 100)
+   :atom-generators winkler-atom-generators
    :max-points 1000
    :max-genome-size-in-initial-program 500
-   :evalpush-limit 800
+   :evalpush-limit 2000
    :population-size 1000
-   :max-generations 1000
+   :max-generations 300
    :parent-selection :lexicase
    :final-report-simplifications 1000
    })


CMR-6221 removed unnecessary sorting param, values with identical scores still sorted alphabetically in case of tie

--- search-app/src/cmr/search/models/query.clj
+++ search-app/src/cmr/search/models/query.clj
@@ -179,8 +179,6 @@
 (defmethod common-qm/default-sort-keys :autocomplete
   [_]
   [{:field :_score :order :desc}
-   ;; TODO: remove sorting by type field after relevancy works, will be unneeccsary
-   {:field :type :order :asc}
    {:field :value :order :asc}])

 (defmethod common-qm/concept-type->default-query-attribs :granule


Added drift on the y-axis

Added drift on the y-axis

--- desktop/src-common/ds3/enemy.clj
+++ desktop/src-common/ds3/enemy.clj
@@ -29,7 +29,8 @@
             :body (create-enemy-body! screen)
             :width (c/screen-to-world 16) :height (c/screen-to-world 16)
             :id :enemy-ship :enemy? true
-            :drift-x-delta (* (c/distance-from-center col) c/drift-x-delta))
+            :drift-x-delta (* (c/distance-from-center col) c/drift-x-delta)
+            :drift-y-delta (/ (* (* (c/distance-from-center col) (c/distance-from-center col)) c/drift-x-delta) 20.0))
         (body! :set-linear-velocity 0 0))))

 (defn create-enemy-body!
@@ -56,7 +57,9 @@
         outward  (:formation-expand screen)
         b (cond on-left outward
                 :else (not outward))
-        delta-fn (cond b -
+        delta-x-fn (cond b -
+                       :else +)
+        delta-y-fn (cond outward -
                        :else +)]
-    (body-position! entity (delta-fn (:x entity) (:drift-x-delta entity)) (:y entity) (:angle entity)))
+    (body-position! entity (delta-x-fn (:x entity) (:drift-x-delta entity)) (delta-y-fn (:y entity) (:drift-y-delta entity)) (:angle entity)))
   entity)


CMR-7673: Bumped jsoup version (#1333)

CMR-7673: Bumped jsoup version (#1333)

--- system-int-test/project.clj
+++ system-int-test/project.clj
@@ -13,6 +13,7 @@
                [org.apache.httpcomponents/httpcore]
                [org.clojure/tools.logging]
                [org.clojure/tools.reader]
+               [org.jsoup/jsoup]
                [potemkin]
                [ring/ring-codec]]
   :dependencies [[cheshire "5.10.0"]
@@ -43,6 +44,7 @@
                  [org.clojure/clojure "1.10.0"]
                  [org.clojure/tools.logging "0.4.0"]
                  [org.clojure/tools.reader "1.3.2"]
+                 [org.jsoup/jsoup "1.14.2"]
                  [potemkin "0.4.5"]
                  [prismatic/schema "1.1.9"]
                  [ring/ring-codec "1.1.3"]


Fix java.io.IOException: UT000034: Stream is closed

--- env/dev/clj/territory_bro/dev_middleware.clj
+++ env/dev/clj/territory_bro/dev_middleware.clj
@@ -10,7 +10,8 @@

 (defn wrap-dev [handler]
   (-> handler
-      wrap-with-logger
+      ;; FIXME: wrap-with-logger will read the body destructively so that the handler cannot anymore read it
+      #_wrap-with-logger
       wrap-reload
       wrap-error-page
       ;; FIXME: prone fails to load its own css, so the error pages are useless


fix up test data

fix up test data

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -88,7 +88,7 @@

 (defn rnd [seq] (nth seq (rand-int (count seq))))

-(if false
+(if true
   (def *metamodel*
        (new org.dada.core.MetaModelImpl
 	    "Cetacea"
@@ -449,28 +449,28 @@

 ;; create some whales...

-(def num-whales 1000000)
+(def num-whales 1000)
+
+(def some-whales1
+     (pmap (fn [id] (whale id)) (range num-whales)))

 (def some-whales
-     (pmap (fn [id] (whale id)) (range num-whales)))
-
-(def some-whales2
      (let [#^Creator creator (.getCreator whale-metadata)]
        (map
 	#(.create creator (into-array Object %))
-	(list
-	 [0 0 (Date. 0 1 1) "blue" 100 0]
-	 [1 0 (Date. 0 1 1) "blue" 200 0]
-	 [2 0 (Date. 0 1 1) "grey" 100 0]
-	 [3 0 (Date. 0 1 1) "grey" 200 0]
-	 [4 0 (Date. 1 1 1) "blue" 100 0]
-	 [5 0 (Date. 1 1 1) "blue" 200 0]
-	 [6 0 (Date. 1 1 1) "grey" 100 0]
-	 [7 0 (Date. 1 1 1) "grey" 200 0]
+	(list
+	 [0 0 (Date. 0 1 1) "blue whale" "arctic" 100 0]
+	 [1 0 (Date. 0 1 1) "blue whale" "indian" 200 0]
+	 [2 0 (Date. 0 1 1) "gray whale" "arctic" 101 0]
+	 [3 0 (Date. 0 1 1) "gray whale" "indian" 200 0]
+	 [4 0 (Date. 1 1 1) "blue whale" "arctic" 100 0]
+	 [5 0 (Date. 1 1 1) "blue whale" "indian" 200 0]
+	 [6 0 (Date. 1 1 1) "gray whale" "arctic" 100 0]
+	 [7 0 (Date. 1 1 1) "gray whale" "indian" 200 0]
 	 ))
        ))

-;;(println "WHALES:" some-whales)
+(doall (map #(println "WHALES:" (bean %)) some-whales))

 (time
  (doall


debug prints

debug prints

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -2,6 +2,8 @@
   (:gen-class)
   (:require [instaparse.core :as insta ])
   (:require [clojure.string  :as string]))
+
+(def debug false)

 (def parse (insta/parser (clojure.java.io/resource "grammar")))

@@ -14,7 +16,7 @@
         list2str #(apply str (map prpr %))
         sf       #(prpr (first %))
         sl       #(prpr (last %))]
-;;   (println (str "k=" k " v=" v))
+    (if debug (println (str "k=" k " v=" v)))
     (apply str
            (case k
              :s        (ds v)


nml-add refactoring

nml-add refactoring

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -34,17 +34,17 @@
   (nml-str (second x)))

 (defn nml-add [tree parent child match]
-  (insta/transform {parent (fn [& children] (into [parent (if (not-any? #(= (nml-str (second %)) match) children) (parse (str match "=0") :start child))] children))} tree))
-
+  (let [missing? (fn [children] (not-any? #(= (nml-name %) match) children))
+        f (fn [& children] (into [parent (if (missing? children) (parse (str match "=0") :start child))] children))]
+    (insta/transform {parent f} tree)))
+
 (defn nml-set [tree nml key val & sub]
   (let [child  (if sub :nvsubseq :stmt)
         match  (if sub key nml)
         parent (if sub :nvseq :s)
         vnew   (if sub (fn [tree] (parse val :start :values)) #(nml-set % nml key val true))
         f      (fn [k v] [child k (if (= (nml-str k) match) (vnew v) v)])]
-    (let [t2 (if sub (nml-add tree parent child match) tree)]
-      (if sub (println t2))
-      (insta/transform {child f} t2))))
+    (insta/transform {child f} (if sub (nml-add tree parent child match) tree))))

 (defn nml-sets [tree sets]
   (loop [t tree s sets]


work on add support

work on add support

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -34,14 +34,11 @@
   (nml-str (second x)))

 (defn nml-add [tree parent child match proxy]
-;; (println tree)
-;; (println parent child match proxy)
   (let [missing? (fn [children] (not-any? #(= (nml-name %) match) children))
-        f (fn [& children] (if (missing? children)
-                             (into [parent (parse proxy :start child)] children)
-                             (into [parent] children)))]
-;;   (println (insta/transform {parent f} tree))
-;;   (println "###")
+        f (fn [& children]
+            (if (missing? children)
+              (into [parent (parse proxy :start child)] children)
+              (into [parent] children)))]
     (insta/transform {parent f} tree)))

 (defn nml-set [tree nml key val & sub]
@@ -50,7 +47,6 @@
         parent (if sub :nvseq :s)
         proxy  (if sub (str match "=0") (str "&" match " /"))
         vnew   (if sub (fn [tree] (parse val :start :values)) #(nml-set % nml key val true))
-;;       f      (fn ([k v] (println (str "### k " k)) (println (str "### v " v)) [child k (if (= (nml-str k) match) (vnew v) v)]))]
         f      (fn ([k v] [child k (if (= (nml-str k) match) (vnew v) v)]))]
     (insta/transform {child f} (nml-add tree parent child match proxy))))


Remove the dependency on buffer to fix cycling dependency issue with buffer now dependiing on #'overtone.sc.info (which in turn depends on #'overtone.sc.synth which depends on #'overtone.sc.machinery.ugen.fn-gen)

--- src/overtone/sc/machinery/ugen/fn_gen.clj
+++ src/overtone/sc/machinery/ugen/fn_gen.clj
@@ -5,7 +5,6 @@
   (:use [overtone.util lib]
         [overtone.libs counters]
         [overtone.helpers seq]
-        [overtone.sc buffer]
         [overtone.sc.machinery.ugen sc-ugen defaults specs special-ops intern-ns]
         [overtone.sc.machinery.ugen.metadata unaryopugen binaryopugen])
   (:require [overtone.sc.machinery.ugen.doc :as doc]))
@@ -133,7 +132,7 @@
     (if (and
          (= 1 (count args))
          (not (sc-ugen? (first args)))
-         (not (buffer? (first args)))
+         (not (isa? (type (first args)) ::overtone.sc.buffer/buffer))
          (map? (first args)))
       (apply f (flatten (seq (first args))))
       (apply f args))))


CEO-216 Remove backend code

CEO-216 Remove backend code

--- src/clj/collect_earth_online/db/plots.clj
+++ src/clj/collect_earth_online/db/plots.clj
@@ -75,7 +75,6 @@
         project-id      (tc/val->int (:projectId params))
         visible-id      (tc/val->int (:visibleId params))
         user-id         (:userId params -1)
-        admin-mode      (contains? #{"true"} (:adminMode params "false"))
         proj-plots      (case navigation-mode
                           "unanalyzed" (call-sql "select_unanalyzed_plots" project-id user-id)
                           "analyzed"   (call-sql "select_user_analyzed_plots" project-id user-id)


Into is not needed

Into is not needed

--- src/clj/collect_earth_online/db/plots.clj
+++ src/clj/collect_earth_online/db/plots.clj
@@ -97,8 +97,7 @@
                                                grouped-plots)
                                          (->> grouped-plots
                                               (first)
-                                              (second)
-                                              (into [])))
+                                              (second)))
                           "previous" (or (->> grouped-plots
                                               (sort-by first #(compare %2 %1))
                                               (some (fn [[plot-id plots]]
@@ -106,8 +105,7 @@
                                                            plots))))
                                          (->> grouped-plots
                                               (last)
-                                              (second)
-                                              (into [])))
+                                              (second)))
                           "id"       (some (fn [[plot-id plots]]
                                              (and (= plot-id visible-id)
                                                   plots))


fix: [bug] declare didn't work, define function before use

--- src/cljs/expense_tracker/transaction.cljs
+++ src/cljs/expense_tracker/transaction.cljs
@@ -4,17 +4,15 @@
             [expense-tracker.globals :as g]
             [clojure.string :as str]))

-(declare new-state)
+(defn new-state []
+  {:to 0 :from 0
+   :trans [(atom {:id 0 :type :to :val 0 :acc ""})
+           (atom {:id 1 :type :from :val 0 :acc ""})]})
 (defonce app-state (r/atom (new-state)))
 (defonce tmp (atom 0))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; helpers
-
-(defn new-state []
-  {:to 0 :from 0
-   :trans [(atom {:id 0 :type :to :val 0 :acc ""})
-           (atom {:id 1 :type :from :val 0 :acc ""})]})

 (defn new-trans [typeof] {:id (count @app-state) :val 0 :type typeof})