Catch unhandled exceptions

Catch unhandled exceptions

--- src/org/spootnik/cyanite.clj
+++ src/org/spootnik/cyanite.clj
@@ -49,20 +49,24 @@
 (defn -main
   "Our main function, parses args and launches appropriate services"
   [& args]
-  (let [[{:keys [path help quiet]} args banner] (get-cli args)]
-    (when help
-      (println banner)
-      (System/exit 0))
-    (let [{:keys [carbon http aggregator blacklist] :as config} (config/init path quiet)]
-      (let [load-configs
-            (fn []
-              (when (:enabled aggregator)
-                (config/load-aggregator-config (:path aggregator)))
-              (when (:enabled blacklist)
-                (config/load-blacklist-config (:path blacklist))))]
-        (reset! (beckon/signal-atom "HUP") #{load-configs})
-        (load-configs))
-      (install-flusher config (when (:enabled carbon) (carbon/start config)))
-      (when (:enabled http)
-        (http/start config))))
-  nil)
+  (try
+    (let [[{:keys [path help quiet]} args banner] (get-cli args)]
+      (when help
+        (println banner)
+        (System/exit 0))
+      (let [{:keys [carbon http aggregator blacklist] :as config} (config/init path quiet)]
+        (let [load-configs
+              (fn []
+                (when (:enabled aggregator)
+                  (config/load-aggregator-config (:path aggregator)))
+                (when (:enabled blacklist)
+                  (config/load-blacklist-config (:path blacklist))))]
+          (reset! (beckon/signal-atom "HUP") #{load-configs})
+          (load-configs))
+        (install-flusher config (when (:enabled carbon) (carbon/start config)))
+        (when (:enabled http)
+          (http/start config))))
+    nil
+    (catch Exception e
+      (error "Unhandled exception:" e)
+      (System/exit 1))))


Update tracks_on_tracks_on_tracks_test.clj (#461)

I think here should be thread-first instead of thread-last.

--- exercises/concept/tracks-on-tracks-on-tracks/test/tracks_on_tracks_on_tracks_test.clj
+++ exercises/concept/tracks-on-tracks-on-tracks/test/tracks_on_tracks_on_tracks_test.clj
@@ -7,7 +7,7 @@

 (deftest list-add-test
   (is (= '("JavaScript" "Java" "Lisp" "Clojure")
-         (->> (tracks-on-tracks-on-tracks/new-list)
+         (-> (tracks-on-tracks-on-tracks/new-list)
               (tracks-on-tracks-on-tracks/add-language "Clojure")
               (tracks-on-tracks-on-tracks/add-language "Lisp")
               (tracks-on-tracks-on-tracks/add-language "Java")
@@ -23,4 +23,4 @@
   (is (= 3 (tracks-on-tracks-on-tracks/count-languages '("JavaScript" "Java" "Clojure")))))

 (deftest learning-list-test
-  (is (= 3 (tracks-on-tracks-on-tracks/learning-list))))+  (is (= 3 (tracks-on-tracks-on-tracks/learning-list))))


fixed // in scripts

fixed // in scripts

--- main/src/dda/pallet/dda_backup_crate/infra/lib/duplicity_lib.clj
+++ main/src/dda/pallet/dda_backup_crate/infra/lib/duplicity_lib.clj
@@ -20,9 +20,9 @@

 (s/defn transport-backup
   [backup-script-path :- s/Str]
-  [(str backup-script-path "/duplicity_backup_transport.sh")
+  [(str backup-script-path "duplicity_backup_transport.sh")
    ""])

 (s/defn transport-restore
   [backup-script-path :- s/Str]
-  (str backup-script-path "/duplicity_restore_transport.sh"))
+  (str backup-script-path "duplicity_restore_transport.sh"))


Releasing lein-template

Releasing lein-template

--- lein-template/project.clj
+++ lein-template/project.clj
@@ -1,7 +1,7 @@
 ;; Copyright © 2014 JUXT LTD.

 ;; We call this project modular to make the invocation: lein new modular appname
-(defproject modular/lein-template "0.6.5"
+(defproject modular/lein-template "0.6.6"
   :description "Leiningen template for a full-featured component based app using modular extensions."
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}


new fipp version

new fipp version

--- src/gamma/compiler.cljs
+++ src/gamma/compiler.cljs
@@ -1,571 +0,0 @@
-(ns gamma.compiler
-  (:use [gamma.ast :only [id?]])
-  (:require
-    [fipp.printer]))
-
-
-
-
-
-
-
-;;; Convert tree ast into flat ast
-
-
-
-
-;;; CSE
-
-
-
-;{:conditional tf :current n :start id}
-
-
-(comment
-  (defn walk [db id]
-        (loop [db (assoc-in db [id :walk :children] (:body (db id))) id id]
-              (let [e (db id)
-                    c (:children (:walk e))]
-                   (println e)
-                   (if (or (= :literal (:head e)) (empty? c))
-                     (if (= :root (:id e))
-                       db
-                       (recur (update-in db [id] dissoc :walk) (:parent (:walk e))))
-
-                     (let [f (first c) n (next c)]
-                          (recur
-                            (assoc-in
-                              (assoc-in db [f :walk] {:parent id :children (:body (db f))})
-                              [id :walk :children] n)
-                            f))))))
-
-  ;; parent should get to decide what to do with the env that is returned from children
-  ;; pass the fn than gets applied to itself. pass up and down fns
-  ;; can pass the env in the node data
-
-  (defn standard-down [db p c]
-        (assoc-in db [(:id c) :env] {:parent (:id p) :children (:body c)}))
-
-  (defn standard-up [db c p]
-        (update-in
-          (update-in db [(:id c)] dissoc :env)
-          [(:id p) :env :children]
-          next))
-
-
-  (defn walk [db id down up]
-        (loop [db (assoc-in db [id :env :children] (:body (db id))) id id]
-              (let [e (db id)
-                    c (:children (:env e))]
-                   (println e)
-                   (if (or (= :literal (:head e)) (empty? c))
-                     (if (= :root (:id e))
-                       db
-                       (recur (up db e (db (:parent (:env e)))) (:parent (:env e))))
-
-                     (let [f (first c) ]
-                          (recur
-                            (down db e (db f))
-                            f))))))
-
-  ;;;;
-
-  (defn node [x]
-        ((:db x) (:id x)))
-
-  (defn parent [x]
-        (assoc x :id (:parent (:env (node x)))))
-
-  (defn node-update [x p f & args]
-        (assoc-in x [:db (:id x)] (apply update-in (node x) p f args)))
-
-  (defn node-assoc [x & args] 1)
-
-  (defn env-merge [to from keys]
-        (node-update to [:env] merge (select-keys (:env (node from)) keys)))
-
-  (defn env-assoc [loc & args]
-        (apply node-update loc [:env] assoc args))
-
-
-  (defn move-to [id loc] (assoc loc :id id))
-
-  (defn standard-next [loc]
-        (let [{:keys [db id]} loc
-              no (node loc)
-              c (get-in no [:env :children])
-              f (first c)
-              n (next c)
-              ]
-             (if f
-               (env-assoc
-                 (move-to f (env-assoc loc :children n))
-                 :parent id :children (:body no))
-               (move-to nil loc))))
-
-
-  (defn standard-next [loc]
-        (let [{:keys [db id]} loc
-              c (get-in db [id :env :children])
-              f (first c)
-              n (next c)
-              ]
-             (if f
-               {:id f :db (assoc-in
-                            (assoc-in db [id :env :children] n)
-                            [f :env] {:parent id :children (:body (db f))})}
-               {:id nil :db db})))
-
-
-  (defn standard-up [loc]
-        (let [p (parent loc)]
-             (move-to (:id p) (assoc (:db loc) (:id loc) (dissoc (node loc) :env)))))
-
-  (defn standard-up [loc]
-        (let [{:keys [db id]} loc]
-             {:id (:parent (:env (db id))) :db (update-in db [id] dissoc :env)}))
-
-
-  (defn walk [loc next-child up]
-        (let [{:keys [db id]} loc]
-             (loop [loc {:id id :db (assoc-in db [id :env :children] (:body (db id)))}]
-                   (let [{:keys [db id]} loc]
-                        (println loc)
-                        (if (= :literal (:head (db id)))
-                          (recur (up loc))
-                          (let [n (next-child loc)]
-                               (if (:id n)
-                                 (recur n)
-                                 (if (= :root id)
-                                   loc
-                                   (recur (up (assoc n :id id)))))))))))
-
-
-
-  (comment
-
-    (let [x (term :plus 1 2)
-          y (term :plus x x (g/if true 1 x))]
-         (walk {:db (flatten-ast y) :id :root}  standard-next standard-up)))
-
-
-
-  (defn statement? [x]
-        (#{:if} (:head x)))
-
-  (defn block? [x]
-        (#{:block} (:head x)))
-
-  (defn literal? [x]
-        (#{:literal} (:head x)))
-
-
-  (defn shared-set [x]
-        (into #{}
-              (map first
-                   (filter (fn [y] (let [u (:unconditional (last y)) c (:conditional (last y))] (if u (<= 2 u))))
-                           x))))
-
-
-
-
-  (defn env-get [x k]
-
-        )
-
-
-
-  (defn iterate-stages [stages]
-        (let [stage-index (into {} (map-indexed #(vector %2 %2) stages)) last-stage (last stages)]
-             (fn iterate-stages-sub [loc]
-                 (let [children (env-get loc :children)]
-                      (if (= :none children)
-                        nil
-                        (let [current-stage (env-get loc :stage)
-                              f (first children)
-                              n (next children)]
-                             (if f
-                               (env-assoc
-                                 (move-to f (env-assoc loc :children n))
-                                 :parent (:id loc))
-                               (if current-stage
-                                 ;; move to next stage, if any
-                                 (if (= last-stage current-stage)
-                                   nil
-                                   (let [new-stage (if current-stage
-                                                     (nth stages (+ 1 (stage-index current-stage)))
-                                                     (first stages))]
-                                        (iterate-stages-sub
-                                          (env-assoc loc
-                                                     :stage new-stage
-                                                     :children ((node loc) new-stage)))))))))))))
-
-
-  (def separate-usages-next-0 (iterate-stages [:shared :body]))
-
-  (defn separate-usages-next [loc]
-        (if-let [next-loc (separate-usages-next-0 loc)]
-                (let [id-map (env-get loc :id-map)
-                      next-loc
-                      (env-assoc
-                        (env-merge next-loc loc [:id-map :output])
-                        :new-id (gen-term-id))]
-                     (if-let [binding-id (id-map (:id next-loc))]
-                             (env-assoc next-loc :binding-id binding-id :children :none)
-                             next-loc))))
-
-  (defn separate-usages-up [loc output-fn]
-        (let [parent-loc (parent loc)
-              stage (env-get parent-loc :stage)
-              parent-newid (env-get parent-loc :new-id)
-              newid (env-get loc :new-id)]
-             (if-let [bid (env-get loc :binding-id)]
-                     (output-fn parent-loc parent-newid stage bid)
-                     (if (= :body stage)
-                       (env-merge
-                         (parent loc)
-                         (output-fn loc
-                                    parent-newid
-                                    stage
-                                    (env-get loc :new-id))
-                         [:output])
-                       (node-update
-                         (env-merge
-                           (parent loc)
-                           (output-fn loc parent-newid stage (env-get loc :new-id)) [:output])
-                         [:env :id-mapping]
-                         assoc (:id loc) newid)))))
-
-  ;;;;;;;;;;;;;
-
-  (defn walk [x]
-        (loop [y x]
-              (let [s (:stack y) f (peek s)]
-                   (if f
-                     (f (assoc y :stack (pop s)))
-                     y))))
-
-  (defn push [x y])
-
-  (declare separate-usages-path separate-usages-body)
-
-  (defn separate-usages-node [node id-mapping]
-        (fn [x]
-            (if (literal? node)
-              x
-              ;; need to initialize :shared for the node, and set the path in reduce
-              (reduce
-                #(push %1 (separate-usages-path %2 node id-mapping))
-                (push x (separate-usages-body node id-mapping))
-                (get-shared x node)))))
-
-  (defn separate-usages-path [path id-mapping]
-        ;; create new node and insert into parent
-        ;; recurse onto self with separate-usages-node
-        (fn [x]
-            (let [{:keys [parent-id parent-path id]} path]
-                 (if-let [target-id (id-mapping (:id path))]
-                         (assoc-in x [parent-id parent-path] target-id)
-                         (let [newid (gen-term-id)
-                               node (assoc ((:source-db x) id) :id newid :parents [parent-id] :source-id id)]
-                              (push
-                                (assoc-in
-                                  (assoc-in x [:db newid] node)
-                                  [parent-id parent-path] newid)
-                                (separate-usages-node newid id-mapping)))))))
-
-  (defn id-map [x id id-mapping])
-
-  (defn separate-usages-body [id id-mapping]
-        ;; gather id mapping
-        ;; push separate-usages-body-node
-        (fn [x]
-            (let [im (id-map x id id-mapping)
-                  body (get-in x [:db :id :body])]
-                 ;; asssoc bindings to node for later use
-                 (reduce #(push %1
-                                (separate-usages-path
-                                  {:parent-id id :parent-path [:body (first %2)] :id (last %2)} id-mapping))
-                         x (map-indexed vector body)))))
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-
-
-
-
-
-
-
-  ;;
-
-  (defn db-assoc [x])
-  (defn db-assoc-in [x])
-  (defn db-get [x])
-  (defn db-update-in [x])
-
-  (defn path-assoc [db path])
-
-  (defn lift-assignments-sub )
-
-
-  (defn lift-assignments [target-block-id]
-        (fn [db path]
-            [
-             ;; if path is in :shared, or is a statement, lift into target
-             (lift-assignments-sub db path target-block-id)
-             [[:assignments (map-path #(lift-assignments target-block-id))]
-              [:body (let [target (get-target arg)] (map-path #(lift-assignments target)))]]]))
-
-
-  ;;
-
-  (defn insert-variables [db path element]
-        [
-         ;; if id is in the binding map of self (or parent when looking at an :assignments path), insert new node at that position with a literal variable
-         (insert-variables-sub)]
-        [[:assignments (map-path insert-variables-sub)] [:body (map-path insert-variables-sub)]])
-
-
-
-
-
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-
-
-  {:db {:root {:body [old-id]}} :source-db {} :stack []}
-
-
-  ;;;;;;;;;;;;;
-
-  (defn separate-usages-next-child [parent]
-        (let [parent-env (:env parent)
-              new-env (if-let [n (next (:children parent-env))]
-                              (assoc parent-env :children n)
-                              (if (= :shared (:stage parent-env))
-                                (assoc parent-env :stage :body :children (:body parent))))]
-             (assoc parent :env new-env)))
-
-
-  (defn separate-usages-up [db child parent]
-        (let [parent-env (:env parent)
-              child-env (:env child)
-              new-db
-              (update-in
-                (:db child-env)
-                [(:new-id parent-env) (:stage parent-env)]
-                conj
-                (if (:shared-usage child-env)
-                  ((:id-map parent-env) (:id child))
-                  (:new-id child-env)))
-              new-env (assoc parent-env :db new-db)
-              new-env (if (= :shared (:stage parent-env))
-                        (update-in new-env [:id-mapping] assoc (:id child) (:new-id child-env))
-                        new-env)
-              ]
-             (assoc db
-                    (:id child) (dissoc child :env)
-                    (:id parent) (separate-usages-next-child (assoc parent :env new-env)))))
-
-  (defn separate-usages-down [db parent child]
-
-        (let [id-map (:id-map (:env parent))]
-             (if (id-map (:id child))
-               (assoc-in db [(:id child) :env]
-                         {:children nil :parent (:id parent) :shared-usage true})
-               (let [s (shared-set (:shared child))
-                     s2 (filter #(not (id-map %)) s)
-                     new-id (gamma.ast/gen-term-id)]
-                    (assoc-in db
-                              [(:id child) :env]
-                              {:new-id new-id
-                               :parent   (:id parent)
-                               :stage    (if s2 :shared :body)
-                               :children (if s2 s2 (:body child))
-                               :id-map id-map
-                               :db (assoc (:db (:env parent))
-                                          new-id (assoc child
-                                                        :id new-id
-                                                        :parents [(:new-id (:env parent))]
-                                                        :body (if (literal? child) (:body child) [])
-                                                        :shared (if s2 [] nil)))}))))
-
-
-
-
-
-        ;; set up walk env
-        ;; if walking :shared, mark node
-        ;; if node contains :shared, set children to those
-        ;; push env to children
-        ;; if node is in env, set children to nil to prevent iteration
-
-        ;; emit new nodes
-
-        )
-
-  ;; should not introduce variables yet
-  (defn separate-usages [db new-db parent-id id new-id env]
-        (let [x (db id)
-              s (shared-set (:shared x))
-              s2 (filter #(not (env %)) s)
-              ]
-             (if (literal? x)
-               (assoc new-db new-id (assoc x :id new-id))
-               (let [new-children-ids (repeatedly (count (:body x)) gamma.ast/gen-term-id)
-                     new-shared-ids (repeatedly (count s2) gamma.ast/gen-term-id)
-                     new-env (merge env (zipmap s2 new-shared-ids))
-                     new-db2 (reduce #(separate-usages db % new-id (first %2) (last %2) env)
-                                     new-db
-                                     (map list s2 new-shared-ids))
-                     new-db3 (reduce #(separate-usages db % new-id (first %2) (last %2) new-env)
-                                     new-db2
-                                     (filter #(not (new-env (first %)))
-                                             (map list (:body x) new-children-ids)))
-
-                     ]
-                    ;(println [x parent-id id new-id])
-                    (let [n (merge x {:id new-id :body   (map #(if (new-env %1) (new-env %1) %2) (:body x) new-children-ids)
-                                      :shared new-shared-ids :parents [parent-id]})]
-                         (println n)
-                         (assoc new-db3
-                                new-id n
-                                ))))))
-
-  )
-
-
-
-
-(comment
-  (emit parent-id :body my-id)
-  (emit my-id :shared shared-set)
-
-
-
-  )
-
-
-(comment
-  (use 'gamma.compiler)
-  (in-ns 'gamma.compiler)
-  (require '[gamma.api :as g])
-
-  (def d (let [x (term :plus 1 2)
-         y (term :plus x x (g/if true 1 x))]
-     (separate-usages
-       (bubble-terms (flatten-ast y))
-       {}
-       :root
-       :root
-       :root
-       {})))
-
-  (print-ast d (fn [x db] [(:id x) (:shared x)]) 30)
-
-  (let [x (term :plus 1 2)
-        y (term :plus x x (g/if true 1 x))]
-    (print-ast
-      (separate-usages
-       (bubble-terms (flatten-ast y))
-       {}
-       :root
-       :root
-       :root
-       {})
-      (fn [x db] [(:id x) (:shared x)]) 30))
-  )
-
-
-;; continue bubbling of unconditional terms drawn from both sides of if statement
-;; needs to be done to a fixed point
-
-;; walk db and replace :shared with a single statement :shared [ids..]
-
-;; create new db with unique paths for all exprs and minimal shared identifiers
-
-
-
-(comment
-  (defn lift-assignments [node-id parent-block-id]
-        (fn [x]
-
-            (reduce (lift-shared node-id parent-block-id))
-
-
-            )
-
-        )
-
-
-  (def lift-assignments-next-0 (iterate-stages [:shared :body]))
-
-  (defn lift-assignments-next [loc]
-        (if-let [next-loc (separate-usages-next-0 loc)]
-                (if (= :block (:head (node loc)))
-                  (env-assoc next-loc :parent-block-id (:id loc))
-                  (env-merge next-loc loc [:parent-block-id]))))
-
-  (defn assign-to-block [loc]
-        (move-to
-          (:id loc)
-          (node-update (move-to (env-get loc :parent-block-id) loc)
-                       :assignments conj (:id loc))))
-
-  (defn lift-assignments-up [loc]
-        ;; if is shared, or if statement, assign self to parent-block
-        (let [p (parent loc)
-              stage (:stage (node parent))]
-             (if (or (= :shared stage) (statement? loc))
-               (parent (assign-to-block loc))
-               (parent loc))))
-
-
-
-
-
-  (defn lift-assignments-next [loc]
-        ;; if parent is block, pass new block id down
-        )
-
-  ;; by now shared elements are specifically identified
-  (defn lift-assignments
-        ([db]
-          (lift-assignments :root :root db))
-        ([current-id parent-block-id db]
-          (let [e (db current-id)]
-               ;; first lift any shared expressions
-
-               ;; all shared exprs
-               (let [db2 (reduce
-                           (fn [db eid]
-                               (lift-assignments
-                                 eid parent-block-id
-                                 (update-in db [parent-block-id :assignments] conj eid)))
-                           db
-                           (:shared e))]
-                    (cond
-                      (literal? e)
-                      db2
-
-                      (statement? e)
-                      ;; if a statement, add self to parent block assignments
-                      (let [db3 (update-in db2 [parent-block-id :assignments] conj (:id e))]
-                           (reduce #(lift-assignments %2 parent-block-id %1) db3 (:body e)))
-
-                      (block? e)
-                      ;; children of block see a new node in which to place assignment
-                      (let [db3 (assoc-in db2 [current-id :assignments] [])]
-                           (reduce #(lift-assignments %2 current-id %1) db3 (:body e)))
-
-
-                      :default
-                      ;; expressions just recurse to children
-                      (reduce #(lift-assignments %2 parent-block-id %1) db2 (:body e))))))))
-
-


Refactor

Refactor

--- src/greenyet/config.clj
+++ src/greenyet/config.clj
@@ -42,12 +42,11 @@
   (let [hosts-with-checks (map (fn [host]
                                  [host (first (filter #(not (contains? host %)) required-keys))])
                                entries)
-        successful-hosts (->> hosts-with-checks
-                              (filter (fn [[host checks]] (nil? checks)))
-                              (map first))
-        errors (->> hosts-with-checks
-                    (filter (fn [[host checks]] (not (nil? checks))))
-                    (map (fn [[host checks]] (format "missing '%s' for entry %s" (name checks) host))))]
+        {good-entries true bad-entries false} (group-by (fn [[host checks]] (nil? checks)) hosts-with-checks)
+        successful-hosts (map first good-entries)
+        errors (map (fn [[host checks]]
+                      (format "missing '%s' for entry %s" (name checks) host))
+                    bad-entries)]
     [successful-hosts errors]))

 (defn- validate-known-system [hosts status-url-by-system]


Only reload already loaded namespaces

Only reload already loaded namespaces

--- src/io/perun/render.clj
+++ src/io/perun/render.clj
@@ -14,6 +14,9 @@
                    (util/dbug "Scan directories: %s\n" (pr-str (:directories pod/env)))
                    (dir/scan-dirs (or tracker (track/tracker)) (:directories pod/env))))

+  ;; Only reload namespaces which are already loaded
+  (swap! tracker (fn [tracker] (update tracker ::track/load (fn [load] (filter find-ns load)))))
+
   (let [changed-ns (::track/load @tracker)]

     (util/dbug "Unload: %s\n" (pr-str (::track/unload @tracker)))


proper pay and gain functions

proper pay and gain functions

--- src/node/game/main.cljs
+++ src/node/game/main.cljs
@@ -52,13 +52,25 @@
        (swap! state update-in [side :hand] #(concat % (take n deck))))
      (swap! state update-in [side :deck] (partial drop n))))

-(defn pay! [state side resource n]
-  (swap! state update-in [side resource] #(- % n)))
+(defn gain!
+  ([state side resource] (gain! state side resource 1))
+  ([state side resource n]
+     (swap! state update-in [side resource] #(+ % n))))
+
+(defn pay!
+  ([state side resource] (pay! state side resource 1))
+  ([state side resource n]
+     (if (>= (- (get-in @state [side resource]) n) 0)
+       (swap! state update-in [side resource] #(- % n))
+       false)))

 (def commands
   {"draw" (fn [state side & args]
-            (draw! state side)
-            (pay! state side :click 1))})
+            (when (pay! state side :click)
+              (draw! state side)))
+   "credit" (fn [state side & args]
+              (when (pay! state side :click)
+                (gain! state side :credit)))})

 (defn exec [action args]
   (let [params (js->clj args :keywordize-keys true)


add metadata to Transform utility macros

--- src/processing/core.clj
+++ src/processing/core.clj
@@ -4110,8 +4110,13 @@
   []
   (.getWidth *applet*))

-(defmacro with-translation
-  "Berforms body with translation, restores current transformation on
+(defmacro
+  ^{:requires-bindings true
+    :processing-name nil
+    :category "Transform"
+    :subcategory "Utility Macros"}
+  with-translation
+  "Performs body with translation, restores current transformation on
   exit."
   [translation-vector & body]
   `(let [tr# ~translation-vector]
@@ -4120,7 +4125,12 @@
      ~@body
      (pop-matrix)))

-(defmacro with-rotation
+(defmacro
+  ^{:requires-bindings true
+    :processing-name nil
+    :category "Transform"
+    :subcategory "Utility Macros"}
+  with-rotation
   "Performs body with rotation, restores current transformation on exit.
   Accepts a vector [angle] or [angle x-axis y-axis z-axis].

@@ -4249,6 +4259,8 @@
           (into {} (map (fn [[k v]] [(str k) v]) (sorted-category-map)))
           (sorted-category-map)))

+
+
 (defn doc-cats
   "Print out a list of all the categories and subcategories,
   associated index nums and fn count (in parens)."


removes old build script

removes old build script

--- build.clj
+++ build.clj
@@ -1,6 +0,0 @@
-(require 'cljs.build.api)
-
-(cljs.build.api/build "src"
-                      {:main 'clack.core
-                       :output-to "clack.js"
-                       :target :nodejs})


patch the ajax error handler

patch the ajax error handler

--- frontend/utils/ajax.cljs
+++ frontend/utils/ajax.cljs
@@ -91,7 +91,11 @@
                                                {:X-CSRFToken (utils/csrf-token)})
                                              headers)
                              :handler #(put! channel (assoc % :status :success))
-                             :error-handler #(put! channel %)
+                             ;; TODO: clean this up
+                             :error-handler #(put! channel (-> %
+                                                               (assoc :status-code (:status %))
+                                                               (assoc :resp (get-in % [:response :resp]))
+                                                               (assoc :status :failed)))
                              :finally #(close! channel)}))
     channel))


Fixed bugs so tests pass

Fixed bugs so tests pass

--- src/hiccup.clj
+++ src/hiccup.clj
@@ -58,12 +58,13 @@
   type)

 (defmethod render-html IPersistentVector
-  [[tag content]]
+  [[tag & content]]
   (let [[tag id class]  (parse-tag-name tag)
-        tag-attrs       {:id id, :class class}
+        tag-attrs       {:id id
+                         :class (if class (.replace class "." " "))}
         map-attrs       (first content)
         [attrs content] (if (map? map-attrs)
-                          [(merge tag-attrs map-attrs) (rest content)]
+                          [(merge tag-attrs map-attrs) (next content)]
                           [tag-attrs content])]
     (if (or content (container-tags tag))
       (str "<" tag (make-attrs attrs) ">"


streams/part-time-fast uses periodically-until-expired.

This means part-time-fast will no longer leak threads when streams
expire.

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -131,33 +131,41 @@
                (when-not (deref periodic)
                  (ref-set periodic (periodic/every interval delay f)))))))))))

-; This leaks a thread. Need to think about dynamic scheduling/expiry.
 (defn part-time-fast
   "Partitions events by time (fast variant). Each <interval> seconds, creates a
   new bin by calling (create). Applies each received event to the current bin
   with (add bin event). When the time interval is over, calls (finish bin
-  start-time end-time)."
+  start-time elapsed-time)."
   [interval create add finish]
-  (let [current (ref (create))
-        start (ref (unix-time))
-        switcher (.start (new Thread (bound-fn []
-          ; Switch between bins
-          (loop []
-            ; Wait for interval
-            (Thread/sleep (* interval 1000))
-            ; Switch out old bin, create new one, call finish on old bin.
-            (apply finish
-                   (dosync
-                     (let [bin (deref current)
-                           old-start (deref start)
-                           boundary (unix-time)]
-                       (ref-set start boundary)
-                       (ref-set current (create))
-                       [bin old-start boundary])))
-            (recur)))))]
-    (fn [event]
-      (dosync
-        (add (deref current) event)))))
+  (let [current (ref nil)
+        start (ref nil)
+        setup (fn []
+                (dosync
+                  (ref-set start (unix-time))
+                  (ref-set current (create))))
+
+        switch (fn []
+                 (apply finish
+                        (dosync
+                          (when (deref start))
+                            (let [bin (deref current)
+                                old-start (deref start)
+                                boundary (unix-time)]
+                              (ref-set start boundary)
+                              (ref-set current (create))
+                              [bin old-start boundary]))))
+        p (periodically-until-expired interval interval switch)]
+    (fn [event]
+      (p event)
+      (if (expired? event)
+        ; Kill our state
+        (dosync
+          (ref-set start nil)
+          (ref-set current nil))
+        ; Append event to this bin
+        (if-let [bin (dosync (deref current))]
+          (add bin event)
+          (add (setup) event))))))

 (defn fill-in
   "Passes on all events. Fills in gaps in event stream with copies of the given


more aggressive caching to speed validation up

--- cljs/src/main/plastic/main/validator.cljs
+++ cljs/src/main/plastic/main/validator.cljs
@@ -34,48 +34,52 @@
    children-table-row])

 (def layout-info
-  {:id                        node-id
-   :tag                       s/Keyword
-   (s/optional-key :line)     line-number
-   (s/optional-key :text)     s/Str
-   (s/optional-key :type)     s/Keyword
-   (s/optional-key :children) (s/either children-table node-id-list)
-   s/Keyword                  TODO})
+  (cached
+    {:id                        node-id
+     :tag                       s/Keyword
+     (s/optional-key :line)     line-number
+     (s/optional-key :text)     s/Str
+     (s/optional-key :type)     s/Keyword
+     (s/optional-key :children) (s/either children-table node-id-list)
+     s/Keyword                  TODO}))

 (def editor-layout
   (cached {form-id {node-id layout-info}}))

 (def selectable-info
-  {:id                        node-id
-   :tag                       s/Keyword
-   (s/optional-key :line)     line-number
-   (s/optional-key :text)     s/Str
-   (s/optional-key :type)     s/Keyword
-   (s/optional-key :children) (s/either children-table node-id-list)
-   s/Keyword                  TODO})
+  (cached
+    {:id                        node-id
+     :tag                       s/Keyword
+     (s/optional-key :line)     line-number
+     (s/optional-key :text)     s/Str
+     (s/optional-key :type)     s/Keyword
+     (s/optional-key :children) (s/either children-table node-id-list)
+     s/Keyword                  TODO}))

 (def editor-selectables
   (cached {form-id {node-id selectable-info}}))

 (def spatial-item
-  {:id                    node-id
-   :tag                   s/Keyword
-   (s/optional-key :line) line-number
-   (s/optional-key :text) s/Str
-   (s/optional-key :type) s/Keyword
-   s/Keyword              TODO})
+  (cached
+    {:id                    node-id
+     :tag                   s/Keyword
+     (s/optional-key :line) line-number
+     (s/optional-key :text) s/Str
+     (s/optional-key :type) s/Keyword
+     s/Keyword              TODO}))

 (def spatial-info
-  {line-number [spatial-item]})
+  (cached {line-number [spatial-item]}))

 (def editor-spatial-web
   (cached {form-id spatial-info}))

 (def structural-item
-  {:left  maybe-node-id
-   :right maybe-node-id
-   :up    maybe-node-id
-   :down  maybe-node-id})
+  (cached
+    {:left  maybe-node-id
+     :right maybe-node-id
+     :up    maybe-node-id
+     :down  maybe-node-id}))

 (def structural-info
   {node-id structural-item})
@@ -89,11 +93,12 @@
    s/Keyword TODO})

 (def analysis-item
-  {(s/optional-key :scope)        analysis-scope
-   (s/optional-key :parent-scope) TODO
-   (s/optional-key :decl-scope)   analysis-scope
-   (s/optional-key :related)      node-id-set
-   s/Keyword                      TODO})
+  (cached
+    {(s/optional-key :scope)        analysis-scope
+     (s/optional-key :parent-scope) TODO
+     (s/optional-key :decl-scope)   analysis-scope
+     (s/optional-key :related)      node-id-set
+     s/Keyword                      TODO}))

 (def analysis-info
   {node-id analysis-item})


Cleanup

Cleanup

--- src-dev/showkr/figwheel.cljs
+++ src-dev/showkr/figwheel.cljs
@@ -5,5 +5,3 @@

 (fw/watch-and-reload :jsload-callback
   (fn [] (swap! data/world #(assoc % :dev-reload (not (:dev-reload %))))))
-
-


also show time passed since last timing call

--- frontend/utils.clj
+++ frontend/utils.clj
@@ -14,7 +14,11 @@
   Returns the value of expr."
   {:added "1.0"}
   [label expr]
-  `(let [start# (.getTime (js/Date.))
-         ret# ~expr]
-     (prn (str ~label " elapsed time: " (- (.getTime (js/Date.)) start#) " msecs"))
+  `(let [global-start# (or (aget js/window "__global_time")
+                          (aset js/window "__global_time" (.getTime (js/Date.))))
+         start# (.getTime (js/Date.))
+         ret# ~expr
+         global-time# (- (.getTime (js/Date.)) global-start#)]
+     (aset js/window "__global_time" (.getTime (js/Date.)))
+     (prn (str ~label " elapsed time: " (- (.getTime (js/Date.)) start#) " ms, " global-time# " ms since last"))
      ret#))


using inteset instead of ad-hoc set operations

--- libs/gateway/src/gateway/core.clj
+++ libs/gateway/src/gateway/core.clj
@@ -53,10 +53,10 @@
                                                       :name rel
                                                       :key user} chan]))
                           (let [xform (comp
-                                       (filter (fn [ev] (contains? (:writers ev) (-> ev
-                                                                                :name
-                                                                                keyword
-                                                                                namespace))))
+                                       (filter (fn [ev] (interset/subset? (:writers ev) #{(-> ev
+                                                                                :name
+                                                                                keyword
+                                                                                namespace)})))
                                        (filter (fn [ev] (interset/subset? #{user} (:readers ev))))
                                        (map (fn [ev] (vec (cons (keyword (:name ev)) (:data ev))))))
                                 trans-chan (async/chan 1 xform)]


fixed cannot-connect test (#102)

fixed cannot-connect test (#102)

* fixed cannot-connect test

* clarified cannot-connect test

--- waiter/integration/waiter/deployment_errors_test.clj
+++ waiter/integration/waiter/deployment_errors_test.clj
@@ -30,9 +30,9 @@
 (deftest ^:parallel ^:integration-fast test-cannot-connect
   (testing-using-waiter-url
     (let [headers {:x-waiter-name (rand-name)
-                   ; listening on invalid port ($PORT0 --> 2020)
-                   :x-waiter-cmd (kitchen-cmd "-p 2020")}
-          {:keys [headers body] :as response} (make-request-with-debug-info headers #(make-kitchen-request waiter-url %))
+                   ; nothing to connect to
+                   :x-waiter-cmd "sleep 3600"}
+          {:keys [headers body] :as response} (make-request-with-debug-info headers #(make-shell-request waiter-url %))
           service-id (get headers "x-waiter-service-id")]
       (is (not (nil? service-id)))
       (assert-response-status response 503)


Todomvc - fixed problem with black todos

--- examples/todomvc/src/todomvc/db.cljs
+++ examples/todomvc/src/todomvc/db.cljs
@@ -63,8 +63,9 @@
 (re-frame/reg-cofx
   :local-store-todos
   (fn [cofx _]
-    "Read in todos from localstore, and process into a map we can merge into app-db."
-    (assoc cofx :local-store-todos
-      (some->> (.getItem js/localStorage ls-key)
-               (cljs.reader/read-string)                    ;; stored as an EDN map.
-               (into (sorted-map))))))
+      "Read in todos from localstore, and process into a map we can merge into app-db."
+      (assoc cofx :local-store-todos
+             (into (sorted-map)
+                   (some->> (.getItem js/localStorage ls-key)
+                            (cljs.reader/read-string)       ;; stored as an EDN map.
+                            )))))


CMR-4997: Addressed review feedback.

CMR-4997: Addressed review feedback.

--- umm-spec-lib/src/cmr/umm_spec/migration/version/variable.clj
+++ umm-spec-lib/src/cmr/umm_spec/migration/version/variable.clj
@@ -3,22 +3,22 @@
   (:require
    [cmr.umm-spec.migration.version.interface :as interface]))

-(defn sample-11->12
+(defn sample-1-1->1-2
   [x]
   {:MeasurementConditions (:MeasurementConditions x)
    :ReportingConditions (:ReportingConditions x)})

-(defn measurement-11->12
+(defn measurement-1-1->1-2
   [x]
   {:MeasurementSource (:MeasurementSource x)
    :MeasurementName {:MeasurementObject (:MeasurementName x)}})

-(defn measurement-12->11
+(defn measurement-1-2->1-1
   [x]
   {:MeasurementSource (:MeasurementSource x)
    :MeasurementName (get-in x [:MeasurementName :MeasurementObject])})

-(defn dimensions-12->11
+(defn dimensions-1-2->1-1
   [dims]
   (mapv #(dissoc % :Type) dims))

@@ -41,8 +41,8 @@
   (-> v
       (assoc :Characteristics (mapv #(select-keys % [:GroupPath])
                                     (:Characteristics v))
-             :MeasurementIdentifiers (mapv measurement-11->12 (:Measurements v))
-             :SamplingIdentifiers (mapv sample-11->12 (:Characteristics v)))
+             :MeasurementIdentifiers (mapv measurement-1-1->1-2 (:Measurements v))
+             :SamplingIdentifiers (mapv sample-1-1->1-2 (:Characteristics v)))
       (dissoc :Measurements)))

 (defmethod interface/migrate-umm-version [:variable "1.2" "1.1"]
@@ -55,8 +55,8 @@
              ;; because there's no way to definitely correlate indices of separate
              ;; arrays when trying to construct a 1.1 Characteristics array by
              ;; combining 1.2 Characteristics and 1.2 SamplingIdentifier arrays.
-             :Measurements (mapv measurement-12->11 (:MeasurementIdentifiers v)))
-      (update :Dimensions dimensions-12->11)
+             :Measurements (mapv measurement-1-2->1-1 (:MeasurementIdentifiers v)))
+      (update :Dimensions dimensions-1-2->1-1)
       (dissoc :MeasurementIdentifiers
               :SamplingIdentifiers
               :VariableSubType)))


Bumped lein-template version to match lambda-blog.

--- lein-lambda-blog/project.clj
+++ lein-lambda-blog/project.clj
@@ -1,4 +1,4 @@
-(defproject lambda-blog/lein-template "0.1.4"
+(defproject lambda-blog/lein-template "1.3.0"
   :description "A Leiningen template for λ-blog."
   :url "https://github.com/Idorobots/lambda-blog"
   :license {:name "MIT License"


First manually working version of data collector

Collects following data from kotio servers
* ruuvitag sensors
* tellstick sensors
* tellstick switches

Saves collected data to local or locally dockerized influxdb

--- data-collector/src/data_collector/core.clj
+++ data-collector/src/data_collector/core.clj
@@ -6,18 +6,70 @@

 (def db (capasitor/make-client {:db "kotio" :username "kotio" :password "kotio"}))

-(defn write-sensor [sensor]
-  (def now (quot (System/currentTimeMillis) 1000))
-  (capasitor/write-points db
-    [{:measurement "temperature" :tags {"name" (get sensor "name")} :fields {"value" (float (get-in sensor ["data" "temperature"]))} :timestamp now}
-    {:measurement "humidity" :tags {"name" (get sensor "name")} :fields {"value" (get-in sensor ["data" "humidity"])} :timestamp now}
-    {:measurement "pressure" :tags {"name" (get sensor "name")} :fields {"value" (get-in sensor ["data" "pressure"])} :timestamp now}]))
+(defn parse-ruuvitag-sensor [sensor]
+  (let [now (quot (System/currentTimeMillis) 1000)
+    name {"name" (get sensor "name")}
+    temperature {"value" (float (get-in sensor ["data" "temperature"]))}
+    humidity {"value" (get-in sensor ["data" "humidity"])}
+    pressure {"value" (get-in sensor ["data" "pressure"])}]
+    [{:measurement "temperature" :tags name :fields temperature :timestamp now}
+      {:measurement "humidity" :tags name :fields humidity :timestamp now}
+      {:measurement "pressure" :tags name :fields pressure :timestamp now}]))

-(defn save-readings [sensors]
-  (dorun (map write-sensor sensors)))
+(defn parse-humidity [sensor]
+  (let [humidity (int (read-string (get sensor "humidity")))]
+    {"value" humidity}))

-(defn -main
-  "Fetch ruuvitag data and write it to influxdb"
-  []
-  (let [response-body (get (http/get "http://pommi:3102/ruuvitag") :body)]
-    (save-readings (json/parse-string response-body))))
+(defn parse-tellstick-sensor [sensor]
+  (let [now (quot (System/currentTimeMillis) 1000)
+    name {"name" (get sensor "name")}
+    temperature {"value" (float (read-string (get sensor "temperature")))}]
+    (if (nil? (get sensor "humidity"))
+      [{:measurement "temperature" :tags name :fields temperature :timestamp now}]
+      [
+        {:measurement "temperature" :tags name :fields temperature :timestamp now}
+        {:measurement "humidity" :tags name :fields (parse-humidity sensor) :timestamp now}
+      ])))
+
+(defn parse-switch-data [switch measurement-name]
+  (let [now (quot (System/currentTimeMillis) 1000)
+    name {"name" (get switch "name")}
+    status {"switchedOn" (get switch "switchedOn")}]
+  {:measurement measurement-name :tags name :fields status :timestamp now}))
+
+(defn parse-tellstick-switch [switch]
+  (parse-switch-data switch "switch"))
+
+(defn parse-tellstick-switch-group [switch-group]
+  (parse-switch-data switch-group "switchGroup"))
+
+(defn compose-ruuvitag-readings [sensors]
+  (map parse-ruuvitag-sensor sensors))
+
+(defn compose-tellstick-sensor-readings [sensors]
+  (map parse-tellstick-sensor sensors))
+
+(defn compose-tellstick-switch-readings [switches]
+  (concat
+    (map parse-tellstick-switch (get switches "devices"))
+    (map parse-tellstick-switch-group (get switches "groups"))))
+
+(defn fetch-data [url]
+  (try
+    (get (http/get url) :body)
+    (catch Exception e (println "Unable to fetch data from" url ":" (.getMessage e)))))
+
+(defn save-data-points [data-points]
+  (let [points (into [] data-points)]
+    (try
+      (if (> (count points) 0) (capasitor/write-points db points))
+      (catch Exception e (println "Unable to write data:" e)))))
+
+(defn -main []
+  (let [ruuvitag-data (fetch-data "http://localhost:3102/ruuvitag")
+      tellstick-sensor-data (fetch-data "http://localhost:3101/tellstick/sensors")
+      tellstick-switch-data (fetch-data "http://localhost:3101/tellstick/switches")]
+    (save-data-points (flatten (concat
+      (compose-ruuvitag-readings (json/parse-string ruuvitag-data))
+      (compose-tellstick-sensor-readings (json/parse-string tellstick-sensor-data))
+      (compose-tellstick-switch-readings (json/parse-string tellstick-switch-data)))))))


Implement proportion lock button on circle measurements element options sidebar.

With an additional cosmetic refactor.

--- src/uxbox/main/ui/workspace/sidebar/options/circle_measures.cljs
+++ src/uxbox/main/ui/workspace/sidebar/options/circle_measures.cljs
@@ -43,66 +43,64 @@
                   value (parse-int value nil)
                   sid (:id shape)
                   props {attr value}]
-              (rs/emit! (uds/update-position sid props))))]
-    (html
-     [:div.element-set {:key (str (:id menu))}
-      [:div.element-set-title (:name menu)]
-      [:div.element-set-content
-       ;; SLIDEBAR FOR ROTATION AND OPACITY
-       [:span "Size"]
-       [:div.row-flex
-        [:input.input-text
-         {:placeholder "Width"
-          :type "number"
-          :min "0"
-          :value (:rx shape)
-          :on-change (partial on-size-change :rx)}]
-        [:div.lock-size i/lock]
-        [:input.input-text
-         {:placeholder "Height"
-          :type "number"
-          :min "0"
-          :value (:ry shape)
-          :on-change (partial on-size-change :ry)}]]
+              (rs/emit! (uds/update-position sid props))))
+          (on-proportion-lock-change [event]
+            (if (:proportion-lock shape)
+              (rs/emit! (uds/unlock-proportions id))
+              (rs/emit! (uds/lock-proportions id))))]
+    [:div.element-set {:key (str (:id menu))}
+     [:div.element-set-title (:name menu)]
+     [:div.element-set-content
+      ;; SLIDEBAR FOR ROTATION AND OPACITY
+      [:span "Size"]
+      [:div.row-flex
+       [:input.input-text
+        {:placeholder "Width"
+         :type "number"
+         :min "0"
+         :value (:rx shape)
+         :on-change (partial on-size-change :rx)}]
+       [:div.lock-size
+        {:class (when (:proportion-lock shape) "selected")
+         :on-click on-proportion-lock-change}
+        i/lock]
+       [:input.input-text
+        {:placeholder "Height"
+         :type "number"
+         :min "0"
+         :value (:ry shape)
+         :on-change (partial on-size-change :ry)}]]

-       [:span "Position"]
-       [:div.row-flex
-        [:input.input-text
-         {:placeholder "cx"
-          :type "number"
-          :value (:cx shape "")
-          :on-change (partial on-pos-change :x)}]
-        [:input.input-text
-         {:placeholder "cy"
-          :type "number"
-          :value (:cy shape "")
-          :on-change (partial on-pos-change :y)}]]
+      [:span "Position"]
+      [:div.row-flex
+       [:input.input-text
+        {:placeholder "cx"
+         :type "number"
+         :value (:cx shape "")
+         :on-change (partial on-pos-change :x)}]
+       [:input.input-text
+        {:placeholder "cy"
+         :type "number"
+         :value (:cy shape "")
+         :on-change (partial on-pos-change :y)}]]

-       [:span "Rotation"]
-       [:div.row-flex
-        [:input.slidebar
-         {:type "range"
-          :min 0
-          :max 360
-          :value (:rotation shape 0)
-          :on-change on-rotation-change}]]
+      [:span "Rotation"]
+      [:div.row-flex
+       [:input.slidebar
+        {:type "range"
+         :min 0
+         :max 360
+         :value (:rotation shape 0)
+         :on-change on-rotation-change}]]

-       [:div.row-flex
-        [:input.input-text
-         {:placeholder ""
-          :type "number"
-          :min 0
-          :max 360
-          :value (:rotation shape "0")
-          :on-change on-rotation-change
-          }]
-        [:input.input-text
-         {:style {:visibility "hidden"}}]
-        ]]]
-     )))
-
-(def circle-measures-menu
-  (mx/component
-   {:render circle-measures-menu-render
-    :name "circle-measures-menu"
-    :mixins [mx/static]}))
+      [:div.row-flex
+       [:input.input-text
+        {:placeholder ""
+         :type "number"
+         :min 0
+         :max 360
+         :value (:rotation shape "0")
+         :on-change on-rotation-change
+         }]
+       [:input.input-text
+        {:style {:visibility "hidden"}}]]]]))


Use `update-size` event on circle measures element options sidebar.

--- src/uxbox/main/ui/workspace/sidebar/options/circle_measures.cljs
+++ src/uxbox/main/ui/workspace/sidebar/options/circle_measures.cljs
@@ -24,14 +24,15 @@
             [uxbox.util.dom :as dom]
             [uxbox.util.data :refer (parse-int parse-float read-string)]))

-(defn- circle-measures-menu-render
-  [own menu shape]
+(mx/defc circle-measures-menu
+  {:mixins [mx/static]}
+  [menu {:keys [id] :as shape}]
   (letfn [(on-size-change [attr event]
             (let [value (dom/event->value event)
                   value (parse-int value 0)
                   sid (:id shape)
                   props {attr value}]
-              (rs/emit! (uds/update-radius-attrs sid props))))
+              (rs/emit! (uds/update-size sid props))))
           (on-rotation-change [event]
             (let [value (dom/event->value event)
                   value (parse-int value 0)


Move exception data in analytics to :response

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -49,14 +49,14 @@
               processed (-> request
                             (dissoc :body :async-channel)
                             (assoc :started (time/format (time/datetime started)
-                                                         :date-hour-minute-second-ms))
-                            (cond-> (instance? Throwable response)
-                                    (assoc :failed (.getMessage ^Throwable response)
-                                           :status 500)
-                                    (not (instance? Throwable response))
-                                    (assoc :response (-> response
-                                                         (dissoc :body)
-                                                         (assoc :took took)))))]
+                                                         :date-hour-minute-second-ms)
+                                   :response (if (instance? Throwable response)
+                                               {:failed (.getMessage ^Throwable response)
+                                                :status 500
+                                                :took took}
+                                               (-> response
+                                                   (dissoc :body)
+                                                   (assoc :took took)))))]
           (future (try (store-request client app-name processed)
                        (catch Throwable t
                          (ex/exit-when-fatal t)


add misaki.compiler.default.config tests

--- test/misaki/test/compiler/config.clj
+++ test/misaki/test/compiler/config.clj
@@ -1,23 +1,76 @@
 (ns misaki.test.compiler.config
   (:use [misaki.compiler.default config]
-        [misaki.util file]
+        [misaki.util file sequence]
         misaki.test.compiler.common
         [clj-time.core :only [date-time year month day]]
         clojure.test)
-  (:require [clojure.java.io :as io]))
+  (:require [clojure.java.io :as io])
+  (:import [java.io FileNotFoundException])
+  )

-;(deftest* layout-file?-test
-;  (testing "success"
-;    (are [x y] (= x (layout-file? y))
-;      (io/file )
-;      )
-;    )
-;  (testing "error"
-;    (are [x y] (= x (layout-file? y))
-;      false nil
-;      )
-;    )
-;  )
+(def sample-posts
+  (list
+    {:file (io/file "b") :title "a" :date (date-time 2022 2 2)}
+    {:file (io/file "c") :title "c" :date (date-time 2000 1 1)}
+    {:file (io/file "a") :title "b" :date (date-time 2011 1 1)}))
+
+;;; layout-file?
+(deftest* layout-file?-test
+  (testing "normal pattern"
+    (are [x y] (= x (layout-file? (io/file y)))
+      true  (path (:layout-dir *config*) "default.clj")
+      false (path (:template-dir *config*) "index.html.clj")
+      false ""))
+
+  (testing "error"
+    (is (thrown? AssertionError (layout-file? nil)))))
+
+
+(deftest* sort-type->sort-fn-test
+  (testing "title sort"
+    (binding [*config* (assoc *config* :post-sort-type :title)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "a" p1
+          "b" p2
+          "c" p3))))
+  (testing "title-desc sort"
+    (binding [*config* (assoc *config* :post-sort-type :title-desc)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "c" p1
+          "b" p2
+          "a" p3))))
+
+  (testing "date sort"
+    (binding [*config* (assoc *config* :post-sort-type :date)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "c" p1
+          "b" p2
+          "a" p3))))
+  (testing "date-desc sort"
+    (binding [*config* (assoc *config* :post-sort-type :date-desc)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "a" p1
+          "b" p2
+          "c" p3))))
+
+  (testing "name sort"
+    (binding [*config* (assoc *config* :post-sort-type :name)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "b" p1
+          "a" p2
+          "c" p3))))
+  (testing "name-desc sort"
+    (binding [*config* (assoc *config* :post-sort-type :name-desc)]
+      (let [[p1 p2 p3] ((sort-type->sort-fn) sample-posts)]
+        (are [x y] (= x (:title y))
+          "c" p1
+          "a" p2
+          "b" p3)))))

 ;;; make-template-output-filename
 (deftest* make-template-output-filename-test


Adding a space for CMR-4313.

Adding a space for CMR-4313.

--- umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2.clj
+++ umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2.clj
@@ -147,8 +147,8 @@
   DataIdentification element"
   [md-data-id-el sanitize?]
   (if-let [value (char-string-value md-data-id-el "gmd:abstract")]
-    (let [[abstract version-description](string/split
-                                         value (re-pattern iso-util/version-description-separator))
+    (let [[abstract version-description] (string/split
+                                          value (re-pattern iso-util/version-description-separator))
           abstract (when (seq abstract) abstract)]
       [(su/truncate-with-default abstract su/ABSTRACT_MAX sanitize?) version-description])
     [(su/with-default nil sanitize?)]))


figwheel.main: no reason to stringify here

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -1153,7 +1153,7 @@
     (when (and (= :nodejs target)
                (:launch-node repl-env true)
                output-to)
-      (let [output-file (str (io/file output-dir "node.log"))]
+      (let [output-file (io/file output-dir "node.log")]
         (println "Starting node ... ")
         (reset! (:node-proc repl-env) (launch-node opts repl-env output-to output-file))
         (println "Node output being logged to:" output-file)


CMR-1055: Adding additional logging.

CMR-1055: Adding additional logging.

--- dev-system/src/cmr/dev_system/control.clj
+++ dev-system/src/cmr/dev_system/control.clj
@@ -72,12 +72,14 @@
       (debug "dev system /reset")
       (doseq [[service-name reset-fn] service-reset-fns]
         (reset-fn (app-context system service-name)))
+      (debug "dev system /reset complete")
       {:status 200})

     (POST "/clear-cache" []
       (debug "dev system /clear-cache")
       (doseq [[service-name clear-cache-fn] service-clear-cache-fns]
         (clear-cache-fn (app-context system service-name)))
+      (debug "dev system /clear-cache complete")
       {:status 200})

     (POST "/stop" []


(SERVER-2795) Add test for CSR API

(SERVER-2795) Add test for CSR API

This commit adds high level tests for the HTTP API for manipulating
CSRs.

--- test/integration/puppetlabs/services/certificate_authority/certificate_authority_int_test.clj
+++ test/integration/puppetlabs/services/certificate_authority/certificate_authority_int_test.clj
@@ -536,3 +536,48 @@
               (is (= auth-exts (get status-body "authorization_extensions")))
               (is (= "signed" (get status-body "state"))))))))
     (fs/delete (str bootstrap/master-conf-dir "/ssl/ca/signed/test_cert_with_auth_ext.pem"))))
+
+(deftest csr-api-test
+  (bootstrap/with-puppetserver-running-with-config
+   app
+   (bootstrap/load-dev-config-with-overrides
+    {:jruby-puppet
+     {:gem-path [(ks/absolute-path jruby-testutils/gem-path)]}
+     :webserver
+     {:ssl-cert (str bootstrap/master-conf-dir "/ssl/certs/localhost.pem")
+      :ssl-key (str bootstrap/master-conf-dir "/ssl/private_keys/localhost.pem")
+      :ssl-ca-cert (str bootstrap/master-conf-dir "/ssl/ca/ca_crt.pem")
+      :ssl-crl-path (str bootstrap/master-conf-dir "/ssl/crl.pem")}})
+   (let [request-dir (str bootstrap/master-conf-dir "/ssl/ca/requests")
+         key-pair (ssl-utils/generate-key-pair)
+         subjectDN (ssl-utils/cn "test_cert")
+         csr (ssl-utils/generate-certificate-request key-pair subjectDN)
+         csr-file (ks/temp-file "test_csr.pem")
+         saved-csr (str request-dir "/test_cert.pem")
+         url "https://localhost:8140/puppet-ca/v1/certificate_request/test_cert"
+         request-opts {:ssl-cert (str bootstrap/master-conf-dir "/ssl/ca/ca_crt.pem")
+                       :ssl-key (str bootstrap/master-conf-dir "/ssl/ca/ca_key.pem")
+                       :ssl-ca-cert (str bootstrap/master-conf-dir "/ssl/ca/ca_crt.pem")
+                       :as :text
+                       :headers {"content-type" "text/plain"}}]
+     (ssl-utils/obj->pem! csr csr-file)
+     (testing "submit a CSR via the API"
+       (let [response (http-client/put
+                       url
+                       (merge request-opts {:body (slurp csr-file)}))]
+         (is (= 200 (:status response)))
+         (is (= (slurp csr-file) (slurp saved-csr)))))
+     (testing "get a CSR from the API"
+       (let [response (http-client/get
+                       url
+                       request-opts)
+             csr (:body response)]
+         (is (= 200 (:status response)))
+         (is (= (slurp csr-file) csr))))
+     (testing "delete a CSR via the API"
+       (let [response (http-client/delete
+                       url
+                       request-opts)]
+         (is (= 204 (:status response)))
+         (is (not (fs/exists? saved-csr)))))
+     (fs/delete csr-file))))


Extract a page frame.

Extract a page frame.

--- src/klangmeister/ui/view.cljs
+++ src/klangmeister/ui/view.cljs
@@ -11,29 +11,23 @@
           :data-canonical-src "https://s3.amazonaws.com/github/ribbons/forkme_right_orange_ff7600.png"}]])

 (defn tabs []
-   [:div {:id "menu"}
-    [:ul
+  [:div {:id "menu"}
+   [:ul
     [:li [:a {:href "/synthesis"} "Synthesis"]]
     [:li [:a {:href "/jam"} "Jam"]]]])

-(defn render [handle! state-atom]
+(defn frame [content]
   [:div
    [:h1 "Klangmeister"]
    [tabs]
-   [content/render handle! state-atom]
-   [jam/render handle! state-atom]
+   content
    [ribbon]])

+(defn render [handle! state-atom]
+  (frame [content/render handle! state-atom]))
+
 (defn jam [handle! state-atom]
-  [:div
-   [:h1 "Klangmeister"]
-   [tabs]
-   [jam/render handle! state-atom]
-   [ribbon]])
+  (frame [jam/render handle! state-atom]))

 (defn content [handle! state-atom]
-  [:div
-   [:h1 "Klangmeister"]
-   [tabs]
-   [content/render handle! state-atom]
-   [ribbon]])
+  (frame [content/render handle! state-atom]))


Remove the fourth part from Row Row as we're only decoding three.

--- src/kolmogorov_music/song.clj
+++ src/kolmogorov_music/song.clj
@@ -83,7 +83,7 @@
                  [4 3 2 1 0]))
        (with (->> (phrase [8] [9]) (times 2)))
        (with (->> (phrase [1 1 2] [-7 -3 -7]) (times 4)))
-       (with (->> (phrase (cycle [2/3 1/3]) [8 8 nil 8 nil 8 nil 7]) (times 4)))
+       ;(with (->> (phrase (cycle [2/3 1/3]) [8 8 nil 8 nil 8 nil 7]) (times 4)))
        (wherever :pitch, :pitch (comp scale/A scale/major scale/lower))
        code))

@@ -101,7 +101,7 @@
                     [-17 nil -17 -17 nil -17 -17 nil -17 -10 -3 -11 -4 -12 -5 -13 -14])))
         harmony (phrase [32] [14])
         ]
-    (->>
+    (->>
       (with bass accompaniment)
       (wherever :pitch, :pitch (comp scale/A scale/major))
       code)))
@@ -118,7 +118,7 @@
     (where :duration (bpm 120))))

 (comment
-
+
    ; Loop the track, allowing live editing.
   (live/stop)
   (live/play (track row))


bumped up selmer

bumped up selmer

--- src/leiningen/new/reagent.clj
+++ src/leiningen/new/reagent.clj
@@ -35,7 +35,7 @@
     [ring/ring-defaults "0.1.3"]
     [prone "0.8.0"]
     [compojure "1.3.2"]
-    [selmer "0.8.0"]
+    [selmer "0.8.2"]
     [environ "1.0.0"]])

 (def lib-or-app-plugins


Splits (optional-)key-matches-with-binding.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -360,8 +360,10 @@
   (s/or :required (s/cat :key ::key :match-value ::match-value)))

 (s/def ::key-matches-with-binding
-  (s/or :required (s/cat :key ::key :match-value ::match-value :binding-key ::binding-key :binding ::binding)
-        :optional (s/cat :qmark ::qmark :key ::key :default-value ::default-value :binding-key ::binding-key :binding ::binding)))
+  (s/or :required (s/cat :key ::key :match-value ::match-value :binding-key ::binding-key :binding ::binding)))
+
+(s/def ::optional-key-matches-with-binding
+  (s/or :required (s/cat :qmark ::qmark :key ::key :default-value ::default-value :binding-key ::binding-key :binding ::binding)))

 (s/def ::path-matches-without-binding
   (s/or :required (s/cat :path ::path :match-value ::match-value)))
@@ -380,7 +382,8 @@
         :path-matches-without-binding ::path-matches-without-binding
         :path-matches-with-binding ::path-matches-with-binding
         :optional-key-exists-with-binding ::optional-key-exists-with-binding
-        :optional-path-exists-with-binding ::optional-path-exists-with-binding))
+        :optional-path-exists-with-binding ::optional-path-exists-with-binding
+        :optional-key-matches-with-binding ::optional-key-matches-with-binding))

 (defn match-value->matcher
   [[kind match-value]]
@@ -461,9 +464,12 @@
           :key-matches-with-binding
           (let [k (make-key (:key body))
                 b (make-binding (:binding body))]
-            (if (optional? mode)
-              `(optional-key-with-default-binding-clause ~k ~(:default-value body) ~b)
-              `(key-matches-with-binding-clause ~k (match-value->matcher ~(:match-value body)) ~b)))
+            `(key-matches-with-binding-clause ~k (match-value->matcher ~(:match-value body)) ~b))
+
+          :optional-key-matches-with-binding
+          (let [k (make-key (:key body))
+                b (make-binding (:binding body))]
+            `(optional-key-with-default-binding-clause ~k ~(:default-value body) ~b))

           :path-matches-without-binding
           (let [path (mapv make-key (:path body))]
@@ -557,15 +563,17 @@
                 predicate?  (= :compare-fn (first match))
                 match-value (second match)]
             (cond
-              (optional? mode)
-              [{}
-               `[~(symbol b) (get-in ~message [~k] ~(:default-value body))]]
               predicate?
               [`({~k ~'_} :guard [(constantly (~(:fn match-value) (get-in ~message [~k])))])
                `[~(symbol b) (get-in ~message [~k])]]
               :else
               [`{~k ~match-value}
                `[~(symbol b) (get-in ~message [~k])]]))
+
+          :optional-key-matches-with-binding
+          (let [k           (make-key (:key body))
+                b           (make-binding (:binding body))]
+              [{} `[~(symbol b) (get-in ~message [~k] ~(:default-value body))]])

           :path-matches-without-binding
           (let [path        (mapv make-key (:path body))


make sure when translating to use the same {:synsem {:cat}} in target as is used in the source

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -56,8 +56,10 @@
              (str "translating from:" source-language-short-name ": "
                   (:surface source-expression)))
             (log/debug (str source-language-short-name ": "
-                            (get-in (:structure source-expression) [:synsem :sem])))
-            (let [spec {:synsem {:sem
+                            (get-in source-expression [:structure :synsem :sem])))
+            (let [source-cat (get-in source-expression [:structure :synsem :cat] :top)
+                  spec {:synsem {:cat source-cat
+                                 :sem
                                  (strip-refs (get-in
                                               (:structure source-expression)
                                               [:synsem :sem]))}}]


throw error on could-not-translate so I can better diagnose runtime errors due to the same problem

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -88,7 +88,7 @@
                         ;; of what the (process) command did.
                         (log/debug (str "process result:" result)))
                       (catch Exception e
-                        (let [catch-and-log-error false]
+                        (let [catch-and-log-error true]
                           (log/error (str "Could not translate source expression: "
                                           "'" (get source-expression :surface) "'"
                                           " from language: '" source-language-short-name


Add function second-event to core-events

This functionally the same as first-event, but for the second time an
event occurs. Needed for implementing Gene Conditioning Shoppe

--- src/clj/game/core-events.clj
+++ src/clj/game/core-events.clj
@@ -59,3 +59,8 @@
   "Returns true if the given event has not occurred yet this turn."
   [state side ev]
   (empty? (turn-events state side ev)))
+
+(defn second-event
+  "Returns true if the given event has occurred exactly once this turn."
+  [state side ev]
+  (= (count (turn-events state side ev)) 1))


Removed debug logging

Removed debug logging

--- src/clj/salava/core/http.clj
+++ src/clj/salava/core/http.clj
@@ -54,7 +54,7 @@
        (curl url opt)))))

 (defn json-get [url]
-  (log/info "json-get: GET" url)
+  ;(log/info "json-get: GET" url)
   (http-get url {:as :json :accept :json :throw-entire-message? true}))


add top API

add top API

--- src/clj_docker/container.clj
+++ src/clj_docker/container.clj
@@ -112,3 +112,9 @@
     (client/delete cli (str "/containers" id)
                    {:query-params {:v remove-volumes
                                    :force force}})))
+
+(defn top [cli container & {:keys [ps-args]}]
+  (let [id (:id container)]
+    (client/get cli (str "/containers/" id "/top")
+                {:query-params {:ps_args ps-args}
+                 :as :json})))


fix issue with edge case in card lookup

fix issue with edge case in card lookup

--- src/cljs/netrunner/deck.cljs
+++ src/cljs/netrunner/deck.cljs
@@ -31,6 +31,9 @@
   (let [name (:title (first cards))]
     (every? #(= (:title %) name) cards)))

+(defn found? [query cards]
+  (some #(if (= (.toLowerCase (:title %)) query) %) cards))
+
 (defn match [query cards]
   (filter #(if (= (.indexOf (.toLowerCase (:title %)) query) -1) false true) cards))

@@ -39,18 +42,19 @@
         cards (:cards @cb/app-state)]
     (if-let [card (some #(when (= (-> % :title .toLowerCase) q) %) cards)]
       card
-      (loop [i 3 matches cards]
-        (cond (zero? (count matches)) query
-              (or (= (count matches) 1) (identical-cards? matches)) (first matches)
-              (<= i (count query)) (recur (inc i) (match (subs q 0 i) matches))
-              :else query)))))
+      (loop [i 2 matches cards]
+        (let [subquery (subs q 0 i)]
+         (cond (zero? (count matches)) query
+               (or (= (count matches) 1) (identical-cards? matches)) (first matches)
+               (found? subquery matches) (found? subquery matches)
+               (<= i (count query)) (recur (inc i) (match subquery matches))
+               :else query))))))

 (defn parse-line [line]
   (let [tokens (split line " ")
         qty (js/parseInt (first tokens))
         cardname (join " " (rest tokens))]
     (when-not (js/isNaN qty)
-      (println tokens)
       {:qty qty :card (lookup cardname)})))

 (defn parse-deck [deck]


Prevent queuing of multiple render notifications in the router

--- src/cljs/zetawar/router.cljs
+++ src/cljs/zetawar/router.cljs
@@ -46,6 +46,7 @@
 (defn start [{:as router-ctx :keys [ev-chan max-render-interval]}]
   (let [timer-start (atom -1)
         last-render (atom 0)
+        render-queued? (atom false)
         render-chan (chan 1)]
     (go-loop []
       (when-let [msg (<! ev-chan)]
@@ -56,12 +57,14 @@
             (reset! timer-start now)))

         ;; Queue notification of render
-        (r/next-tick #(let [now (.getTime (js/Date.))]
-                        (log/trace "Rendering...")
-                        (offer! render-chan :rendered)
-                        (when (> now @last-render)
-                          (log/tracef "Setting last-render to %d" now)
-                          (reset! last-render now))))
+        (when-not @render-queued?
+          (r/next-tick #(let [now (.getTime (js/Date.))]
+                          (log/trace "Rendering...")
+                          (offer! render-chan :rendered)
+                          (when (> now @last-render)
+                            (log/tracef "Setting last-render to %d" now)
+                            (reset! last-render now)
+                            (reset! render-queued? false)))))

         ;; Handle event
         (try


offset and vsnoise for prism

offset and vsnoise for prism

--- src/cljx/robinson/prism.cljx
+++ src/cljx/robinson/prism.cljx
@@ -29,14 +29,15 @@

 (defn offset
   [xy-or-fn f]
-  (let [t (type xy-or-fn)]
   (cond
-    (vector? t) (let [[x y] xy-or-fn]
-                  (fn [[xi yi]]
-                    (f [(+ xi x) (+ yi y)])))
-    (fn? t)     (fn [[xi yi]]
-                 (let [[x y] (xy-or-fn [xi yi])]
-                   (f [(+ xi x) (+ yi y)]))))))
+    (vector? xy-or-fn)
+      (let [[x y] xy-or-fn]
+        (fn [[xi yi]]
+          (f [(+ xi x) (+ yi y)])))
+    (fn? xy-or-fn)
+      (fn [[xi yi]]
+        (let [[x y] (xy-or-fn [xi yi])]
+          (f [(+ xi x) (+ yi y)])))))

 (defn scale [s f]
   (fn [[x y]]
@@ -60,9 +61,9 @@
   (vec more))

 (defn vsnoise
-  [noise]
+  [fnoise]
   (fn [[x y]]
-    (vectorize (rn/snoise noise x y) (rn/snoise noise (+ x 12.301) (+ y 70.261)))))
+    (vectorize (fnoise x y) (fnoise (+ x 12.301) (+ y 70.261)))))

 (defn vnoise
   [noise]
@@ -159,6 +160,6 @@

 (defn -main [& args]
   (let [n (rn/create-noise)]
-    #_(rn/print-fn (fn [x y] (rn/noise n x y)) 200 200)
-    (rn/print-fn (coerce (radius)) 200 200)))
+    #_(rn/print-fn (fn [x y] (rn/noise n x y)) 180 180)
+    (rn/print-fn (coerce (invert (offset (vsnoise (partial rn/noise n))  (scale 0.2 (radius))))) 180 180)))


Added an object to store things in memory.

--- src/clojure_test/handler.clj
+++ src/clojure_test/handler.clj
@@ -3,6 +3,16 @@
             [compojure.handler :as handler]
             [compojure.route :as route]
             [ring.middleware.json :as middleware]))
+
+(def animals (atom ()))
+
+(defn add-animal
+  [x]
+  (swap! animals conj x))
+
+(defn- get-animals [& _]
+  {:status 200
+   :body {:animals animals}})

 (defn- hello-world [& _]
   {:status 200
@@ -16,6 +26,8 @@
 (defroutes app-routes
   (GET "/sum/:x1/:x2" [x1 x2] (calculate-sum (read-string x1) (read-string x2)))
   (GET "/" [] hello-world)
+  (POST "/animal/:x1" [x1] (add-animal (read-string x1)))
+  (GET "/animals" [] get-animals)
   (route/resources "/")
   (route/not-found "Not Found"))


Added start/shutdown capability for the database.

--- src/dragon/components/db.clj
+++ src/dragon/components/db.clj
@@ -1,25 +1,73 @@
 (ns dragon.components.db
   (:require [com.stuartsierra.component :as component]
+            [clojure.core.async :as async]
+            [clojure.java.shell :as shell]
+            [clojure.string :as string]
+            [datomic.client :as datomic]
             [dragon.components.core :as component-api]
+            [dragon.config :as config]
             [dragon.event.subscription :as subscription]
             [dragon.event.tag :as tag]
             [dragon.event.topic :as topic]
             [taoensso.timbre :as log]))
+
+(defn execute-db-command!
+  [component]
+  (let [start-cfg (config/db-start-config component)
+        home (:home start-cfg)
+        args (:args start-cfg)]
+    (shell/with-sh-dir home
+      (log/debugf "Running command in %s ..." home)
+      (log/debug "Using shell/sh args:" args)
+      (apply shell/sh args))))
+
+(defn start-db!
+  [component]
+  (async/go-loop []
+    (log/debug "Starting database ...")
+    (let [ch (async/thread (execute-db-command! component))]
+      (when-let [result (async/<! ch)]
+        (log/info "Previous database processes had been shutdown.")
+        result)))
+  (Thread/sleep (config/db-start-delay component)))
+
+(defn stop-db!
+  [component]
+  ;; XXX If we ever support more than one type of database, we can just do a
+  ;;     case construct here ...
+  (->> (shell/sh "ps" "-eo" "pid,command")
+       :out
+       (shell/sh "grep" "datomic.peer-server" :in)
+       :out
+       (#(string/split % #"\n"))
+       (map (comp first #(string/split % #"\s")))
+       vec
+       (concat ["xargs" "kill"])
+       (apply shell/sh)))

 (defrecord DataBase []
   component/Lifecycle

   (start [component]
     (log/info "Starting db component ...")
-    (let [a "b"]
-      (log/debug "Started db component.")
-      component))
+    (start-db! component)
+    (let [cfg (config/db-config component)
+          conn (async/<!! (datomic/connect cfg))]
+      (log/debug "Using configuration:" cfg)
+      (if (:cognitect.anomalies/category conn)
+        (do
+          (log/error (:cognitect.anomalies/message conn))
+          component)
+        (do
+          (log/debug "Started db component.")
+          (assoc component :conn conn)))))

   (stop [component]
     (log/info "Stopping db component ...")
     (let [a "b"]
       (log/debug "Stopped db component.")
-      component)))
+      (stop-db! component)
+      (assoc component :conn nil))))

 (defn create-db-component
   ""


No need to wrap a vector with (vec)

No need to wrap a vector with (vec)

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -90,15 +90,15 @@
    (let [solved (get-solved (session/session-get :user))]
      (map-indexed
       (fn [x p]
-        (vec [:tr (row-class x)
-              [:td {:class "title-link"}
-               [:a {:href (str "/problem/" (p :_id))}
-                (p :title)]]
-              [:td {:class "centered"}
-               (map #(str % " ") (p :tags))]
-              [:td {:class "centered"} (p :times-solved)]
-              [:td {:class "centered"}
-               (if (contains? solved (p :_id))
-                 [:img {:src "/checkmark.png"}]
-                 [:img {:src "/empty-sq.png"}])]]))
-      (get-problem-list)))])+        [:tr (row-class x)
+         [:td {:class "title-link"}
+          [:a {:href (str "/problem/" (p :_id))}
+           (p :title)]]
+         [:td {:class "centered"}
+          (map #(str % " ") (p :tags))]
+         [:td {:class "centered"} (p :times-solved)]
+         [:td {:class "centered"}
+          [:img {:src (if (contains? solved (p :_id))
+                        "/checkmark.png"
+                        "/empty-sq.png")}]]])
+      (get-problem-list)))])


Implement additional conversion functions: s:/int and s:/boolean

--- src/gml_to_featured/code.clj
+++ src/gml_to_featured/code.clj
@@ -16,6 +16,8 @@
 (def key->fn {:s/tag `[tag]
               :s/id-attr `[id-attr]
               :s/inner-gml `[inner-gml]
+              :s/boolean `[text boolean (function "boolean")]
+              :s/int `[text #(. Integer parseInt %) (function "int")]
               :s/geometry `[geometry]})

 (defn parse-selector-vector [key selector]


CMR-3691: Testing

CMR-3691: Testing

--- system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -48,10 +48,14 @@
                        {"provguid1" "PROV1" "provguid2" "PROV2" "usgsguid" "USGS_EROS"})
   (constantly nil)))

+(def current-umm-version
+  "current umm schema version."
+  "1.10")
+
 (def original-ingest-accept-umm-version
   "Original ingest-accept-umm-version in ingest config
    used to reverse back after changing it for certain tests."
-  (cmr.ingest.config/ingest-accept-umm-version))
+  "1.9")

 (deftest simple-search-test
   (let [c1-echo (d/ingest "PROV1" (dc/collection {:short-name "S1"
@@ -96,7 +100,7 @@
 ;; This tests that searching for and retrieving metadata after refreshing the search cache works.
 ;; Other metadata tests all run before refreshing the cache so they cover that case.
 (deftest collection-metadata-cache-test
-  (dev-sys-util/eval-in-dev-sys `(cmr.ingest.config/set-ingest-accept-umm-version! "1.10"))
+  (dev-sys-util/eval-in-dev-sys `(cmr.ingest.config/set-ingest-accept-umm-version! current-umm-version))
   (let [c1-echo (d/ingest "PROV1" (dc/collection {:entry-title "c1-echo"})
                           {:format :echo10})
         c2-echo (d/ingest "PROV2" (dc/collection {:entry-title "c2-echo"})
@@ -209,7 +213,7 @@
   (dev-sys-util/eval-in-dev-sys `(cmr.ingest.config/set-ingest-accept-umm-version! original-ingest-accept-umm-version)))

 (deftest collection-umm-json-metadata-cache-test
-  (dev-sys-util/eval-in-dev-sys `(cmr.ingest.config/set-ingest-accept-umm-version! "1.10"))
+  (dev-sys-util/eval-in-dev-sys `(cmr.ingest.config/set-ingest-accept-umm-version! current-umm-version))
   (let [c1-r1-echo (d/ingest "PROV1" (du/umm-spec-collection {:entry-title "c1-echo"})
                              {:format :echo10})
         c1-r2-echo (d/ingest "PROV1" (du/umm-spec-collection {:entry-title "c1-echo"


CMR-2069: Fix for the test failures.

CMR-2069: Fix for the test failures.

--- system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -76,14 +76,12 @@
         c7-smap (d/ingest "PROV1" (dc/collection-smap {:short-name "S7"
                                                        :version-id "V7"})
                           {:format :iso-smap})
-        c8-dif10 (d/ingest "PROV1" (dc/collection-dif10 {:entry-id "S8"
-                                                         :short-name "S8"
+        c8-dif10 (d/ingest "PROV1" (dc/collection-dif10 {:short-name "S8"
                                                          :version-id "V8"
                                                          :entry-title "ET8"
                                                          :long-name "ET8"})
                            {:format :dif10})
-        c9-dif10 (d/ingest "PROV2" (dc/collection-dif10 {:entry-id "S9"
-                                                         :short-name "S9"
+        c9-dif10 (d/ingest "PROV2" (dc/collection-dif10 {:short-name "S9"
                                                          :version-id "V9"
                                                          :entry-title "ET9"
                                                          :long-name "ET9"})


very basic eval expr

very basic eval expr

--- src/kata/routes/services.clj
+++ src/kata/routes/services.clj
@@ -17,11 +17,11 @@
     {:info {:title "Sample api"}})

   (context* "/api" []
-            (POST* "/eval" []
+            (POST* "/evaluate" []
               :tags ["eval"]
               :return String
               :body-params [expr :- String]
-              (ok expr))
+              (ok (with-out-str (clojure.pprint/pprint (eval (read-string expr))))))

             (GET* "/plus" []
                   :return       Long


Un-tagging: Remove tags in the client.

Un-tagging: Remove tags in the client.

--- src-cljs/pepa/api.cljs
+++ src-cljs/pepa/api.cljs
@@ -289,7 +289,10 @@

 ;;; HACK
 (defmethod entities-changed* :deletions [state _ changes]
-  (js/console.warn "NOT applying deletions: Not implemented"))
+  (js/console.warn "NOT applying (most) deletions: Not implemented")
+  (when-let [changed-tags (get-in changes [:deletions :tags])]
+    (doseq [tag changed-tags]
+      (refresh-tag! state tag))))

 (defn entities-changed! [state changes]
   (doseq [entity (keys changes)]


add routes /integration/lite for catalyst integration on params but unmodified elasticsearch response

--- src/wb_es/web/index.clj
+++ src/wb_es/web/index.clj
@@ -26,6 +26,13 @@
   (GET "/random" [q & options]
        (response (web-core/random options))))

+(defroutes api-lite-routes
+  search-route
+  autocomplete-route
+  search-exact-route
+  count-route
+  random-route)
+
 (defroutes integration-routes
   (-> search-route
       (wrap-routes web-integration/wrap-params)
@@ -44,13 +51,11 @@
       (wrap-routes web-integration/wrap-random)))

 (defroutes app
-  search-route
-  autocomplete-route
-  search-exact-route
-  count-route
-  random-route
+  api-lite-routes
   (context "/integration" []
-           integration-routes)
+           integration-routes
+           (context "/lite" []
+                    (wrap-routes api-lite-routes web-integration/wrap-params)))
   (route/not-found (response {:message "endpoint not found"})))

 (defn handler [request]


Added filter-rows-containing-num function.

--- src/lottery_prophet/core.clj
+++ src/lottery_prophet/core.clj
@@ -68,7 +68,10 @@
   (let [pred (fn [[num freq]]
                (not (some #(= num %) nums-to-remove)))]
     (filter pred nums)))
-
+
+(defn filter-rows-containing-num
+  [nums n]
+  (filter #(some #{n} %) nums))
 ;(def original-data (read-resource "data/original.htm"))
 ;(def preprocessed-data (find-lottery-lines original-data))
 ;(def cleaned-data (clean-data preprocessed-data))


Fix cursor jumping when file is updated outside LT

For cases where file timestamp is updated and content stays the
same or is appended

--- src/lt/objs/editor/pool.cljs
+++ src/lt/objs/editor/pool.cljs
@@ -131,7 +131,7 @@
     (popup/popup! popup)))

 (defn- reload [ed]
-  (editor/set-val ed (:content (files/open-sync (-> @ed :info :path))))
+  (editor/set-val-and-keep-cursor ed (:content (files/open-sync (-> @ed :info :path))))
   (doc/update-stats (-> @ed :info :path))
   (object/merge! ed {:dirty false}))


Function to read word classes

Function to read word classes

--- src/zg/db_interface.clj
+++ src/zg/db_interface.clj
@@ -194,3 +194,12 @@
             (log/error e "read sources")
             [])))

+(defn read-word-classes
+    []
+    (try
+        (jdbc/query db-spec/zg-db
+                        ["select id, class from classes order by class"])
+        (catch Exception e
+            (log/error e "read classes")
+            [])))
+


make non public functions private

make non public functions private

--- src/zombie_run/core.clj
+++ src/zombie_run/core.clj
@@ -45,13 +45,13 @@
 (defn world-right-upper-corner [[x _]]
   [x 0])

-(defn in-world? [[world-x world-y] [x y]]
+(defn- in-world? [[world-x world-y] [x y]]
   (and (>= x 0)
        (>= y 0)
        (< x world-x)
        (< y world-y)))

-(defn get-position
+(defn- get-position
   ([pos action] (get-position pos action 1))
   ([[x y] action steps]
    (case action
@@ -65,7 +65,7 @@
      :down-right [(+ x steps) (+ y steps)]
      [x y])))

-(defn distance [[a-x a-y] [b-x b-y]]
+(defn- distance [[a-x a-y] [b-x b-y]]
   (let [x-dist (Math/pow (- a-x b-x) 2)
         y-dist (Math/pow (- a-y b-y) 2)
         dist (Math/sqrt (+ x-dist y-dist))]
@@ -78,16 +78,16 @@
   {:type      type
    :direction :up})

-(defn set-terrain-direction [terrain direction]
+(defn- set-terrain-direction [terrain direction]
   (assoc terrain :direction direction))

-(defn terrain-has-type? [terrain pos type]
+(defn- terrain-has-type? [terrain pos type]
   (= (get-in terrain [pos :type]) type))

-(defn terrain-accessible? [terrain pos]
+(defn- terrain-accessible? [terrain pos]
   (not (contains? terrain pos)))

-(defn damage-terrain [terrain target attack]
+(defn- damage-terrain [terrain target attack]
   (if-let [health (get-in terrain [target :health])]
     (let [new-health (- health attack)]
       (if (zero? new-health)
@@ -122,21 +122,21 @@
    (assert (contains? weapons type) "Weapon doesn't exist.")
    (assoc (get weapons type) :weapon-type type)))

-(defn weapon-is-ready? [{last-attack :last-attack recharge-delay :recharge-delay}]
+(defn- weapon-is-ready? [{last-attack :last-attack recharge-delay :recharge-delay}]
   (let [available (t/plus last-attack (t/seconds recharge-delay))
         now (t/now)]
     (or (t/after? now available)
         (t/equal? now available))))

-(defn weapon-range [{range :range}] range)
-
-(defn in-weapon-range? [terrain attacker-pos target-pos]
+(defn- weapon-range [{range :range}] range)
+
+(defn- in-weapon-range? [terrain attacker-pos target-pos]
   (= (weapon-range (get-in terrain [attacker-pos :weapon]))
      (distance attacker-pos target-pos)))

-(defn weapon-attack [{attack :attack}] attack)
-
-(defn attack-target [terrain attacker-pos target-pos target-type]
+(defn- weapon-attack [{attack :attack}] attack)
+
+(defn- attack-target [terrain attacker-pos target-pos target-type]
   (if (weapon-is-ready? (get-in terrain [attacker-pos :weapon]))
     (let [terrain (assoc-in terrain [attacker-pos :weapon :last-attack] (t/now))]
       (if (terrain-has-type? terrain target-pos target-type)
@@ -177,7 +177,7 @@
                                                           (assoc :weapon (make-weapon :dagger))
                                                           (set-terrain-direction direction))))))))))

-(defn move-player [{world-size :world-size current-pos :player-pos terrain :terrain :as game} action]
+(defn- move-player [{world-size :world-size current-pos :player-pos terrain :terrain :as game} action]
   (let [new-pos (get-position current-pos action)
         new-pos (if (and (in-world? world-size new-pos)
                          (terrain-accessible? terrain new-pos))
@@ -185,7 +185,7 @@
                   current-pos)]
     (set-player game new-pos action)))

-(defn player-attack [{terrain :terrain player-pos :player-pos :as game}]
+(defn- player-attack [{terrain :terrain player-pos :player-pos :as game}]
   (reduce (fn [game counter]
             (let [target-pos (get-position player-pos (player-direction game) counter)]
               (update game :terrain attack-target player-pos target-pos :zombie)))
@@ -208,7 +208,7 @@
 (defn zombie-health [game position]
   (:health (get-in game [:terrain position])))

-(defn is-zombie? [terrain]
+(defn- is-zombie? [terrain]
   (= (:type terrain) :zombie))

 (defn zombie-positions [game]
@@ -216,7 +216,7 @@
                    []
                    (:terrain game))))

-(defn calculate-zombie-action [[x y] [player-x player-y]]
+(defn- calculate-zombie-action [[x y] [player-x player-y]]
   (let [x-dist (- x player-x)
         y-dist (- y player-y)]
     (cond (and (> x-dist 0) (> y-dist 0)) :up-left
@@ -228,7 +228,7 @@
           (and (= x-dist 0) (> y-dist 0)) :up
           (and (= x-dist 0) (< y-dist 0)) :down)))

-(defn move-zombie [terrain current-pos action]
+(defn- move-zombie [terrain current-pos action]
   (let [new-pos (get-position current-pos action)]
     (if (terrain-accessible? terrain new-pos)
       (clojure.set/rename-keys terrain {current-pos new-pos})
@@ -262,8 +262,8 @@
                                          (assoc :health zombie-default-health)
                                          (assoc :weapon (make-weapon :zombie-fist)))))

-(defn set-zombies [game zombie-positions]
-  (reduce set-zombie game zombie-positions))
+(defn set-zombies [game positions]
+  (reduce set-zombie game positions))

 (defn make-game [{world-size :world-size player-pos :player-pos zombies :zombies}]
   (-> {:world-size world-size


Remove redundant 'or'.

Remove redundant 'or'.

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -420,8 +420,7 @@
             (channels-sequenceable property-sequences channels)
             (all-equal? 0 (map :skip-frames channels))
             (all-equal? true (map :use-z-stack channels))
-            (or
-              (not slices-first))))
+            (not slices-first)))
         (or
           (not use-autofocus)
           (>= autofocus-skip (dec numFrames)))


add cljs.core/random-uuid

add cljs.core/random-uuid

--- src/main/cljs/cljs/core.cljs
+++ src/main/cljs/cljs/core.cljs
@@ -9534,6 +9534,19 @@
 (defn uuid [s]
   (UUID. s nil))

+(defn random-uuid []
+  (letfn [(hex [] (.toString (rand-int 15) 16))]
+    (let [rhex (.toString (bit-or 0x8 (bit-and 0x3 (rand-int 14))) 16)]
+      (uuid
+        (str (hex) (hex) (hex) (hex)
+             (hex) (hex) (hex) (hex) "-"
+             (hex) (hex) (hex) (hex) "-"
+             "4"   (hex) (hex) (hex) "-"
+             rhex  (hex) (hex) (hex) "-"
+             (hex) (hex) (hex) (hex)
+             (hex) (hex) (hex) (hex)
+             (hex) (hex) (hex) (hex))))))
+
 ;;; ExceptionInfo

 (defn- pr-writer-ex-info [obj writer opts]


[#73] Add support for caddisfly responses (#77)

--- api/src/clojure/org/akvo/flow_api/datastore/form_instance.clj
+++ api/src/clojure/org/akvo/flow_api/datastore/form_instance.clj
@@ -140,6 +140,10 @@
   [_ response-str opts]
   (try (json/parse-string response-str)
        (catch JsonParseException _)))
+
+(defmethod parse-response "CADDISFLY"
+  [_ response-str opts]
+  (json/parse-string response-str))

 (defn fetch-answers [ds form-definition form-instances opts]
   (let [question-types (question-type-map form-definition)]


removing deprecated site handler

removing deprecated site handler

--- ingestion-api/src/ingestion_api/route.clj
+++ ingestion-api/src/ingestion_api/route.clj
@@ -73,9 +73,8 @@

 (def app
-  (->
-   (handler/site app-routes)
-   (wrap-json-body {:keywords? true})
-   (wrap-json-response)
-   (gzip-req-wrapper)
-   catch-all))
+  (-> app-routes
+      (wrap-json-body {:keywords? true})
+      (wrap-json-response)
+      (gzip-req-wrapper)
+      catch-all))


modified imports in hello.physics

modified imports in hello.physics

--- src/maqueta/hello/physics.clj
+++ src/maqueta/hello/physics.clj
@@ -3,10 +3,9 @@

 (ns maqueta.hello.physics
   (:use (maqueta application assets))
-  (:import com.jme3.scene.shape.Sphere
-           com.jme3.scene.shape.Box
-           com.jme3.math.Vector3f
-           com.jme3.math.Vector2f
+  (:import (com.jme3.scene.shape Box Sphere Sphere$TextureMode)
+           (com.jme3.math Vector2f Vector3f)
+           com.jme3.texture.Texture$WrapMode
            com.jme3.asset.TextureKey
            com.jme3.bullet.BulletAppState
            com.jme3.bullet.control.RigidBodyControl
@@ -18,7 +17,7 @@
 (def brick-height 0.12)

 (def sphere (doto (Sphere. 32 32 0.4 true false)
-              (.setTextureMode com.jme3.scene.shape.Sphere$TextureMode/Projected)))
+              (.setTextureMode Sphere$TextureMode/Projected)))

 (def box (doto (Box. Vector3f/ZERO brick-length brick-height brick-width)
            (.scaleTextureCoordinates (Vector2f. 1 0.5))))
@@ -41,7 +40,7 @@
 (def floor-mat (let [mat (load-material "Common/MatDefs/Misc/Unshaded.j3md")
                      key (TextureKey. "Textures/Terrain/Pond/Pond.jpg")
                      tex (load-texture (doto key (.setGenerateMips true)))]
-                 (.setWrap tex com.jme3.texture.Texture$WrapMode/Repeat)
+                 (.setWrap tex Texture$WrapMode/Repeat)
                  (doto mat
                    (.setTexture "ColorMap" tex))))


Put `topics` back into regular boards. Accidentally dropped out.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -72,7 +72,7 @@
                             (comments %) (reactions %)
                             (:access-level ctx) (-> ctx :user :user-id))
                       entries)]
-    (assemble-board org-slug board entry-reps ctx)))
+    (assemble-board org-slug (assoc board :topics topics) entry-reps ctx)))

   ;; Recursion to finish up both kinds of boards
   ([org-slug :guard string? board :guard map? entry-reps :guard seq? ctx]


fix issue with photo timestamps

fix issue with photo timestamps

--- iwaswhere-web/src/clj/iwaswhere_web/imports.clj
+++ iwaswhere-web/src/clj/iwaswhere_web/imports.clj
@@ -4,6 +4,7 @@
             [iwaswhere-web.files :as f]
             [iwaswhere-web.migrations :as m]
             [clj-time.coerce :as c]
+            [clj-time.core :as t]
             [cheshire.core :as cc]
             [matthiasn.systems-toolbox.component :as st]
             [me.raynes.fs :as fs]
@@ -32,16 +33,38 @@
               (- dd)
               dd)))))))

-(defn extract-ts
+(defn add-filename-offset
+  "Add the last three digits of the filename to the timestamp in order to avoid collisions when
+  photos were taken in burst mode on the iPhone, as unfortunately the photo timestamp is only
+  precise to the second and the capture rate for iPhone 6s is 10fps."
+  [millis filename]
+  (let [filename-number (re-find #"\d{3}(?=\.)" filename)
+        offset (if filename-number (Integer. filename-number) 0)]
+    (+ millis offset)))
+
+(defn extract-gps-ts
   "Converts concatenated GPS timestamp strings into milliseconds since epoch.
   Example from iPhone 6s camera app:
     'GPS Date Stamp' '2016:03:30'
     'GPS Time-Stamp' '20:07:57.00 UTC'"
-  [ts]
+  [ts filename]
   (let [f (tf/formatter "yyyy:MM:dd HH:mm:ss.SS z")]
     (when (and (seq ts)
                (re-matches #"\d{4}:\d{2}:\d{2} \d{2}:\d{2}:\d{2}\.\d{2} [A-Z]{1,5}" ts))
-      (c/to-long (tf/parse f ts)))))
+      (add-filename-offset (c/to-long (tf/parse f ts)) filename))))
+
+(defn extract-ts
+  "Converts 'Date/Time' exif tag into milliseconds since epoch. Assumes local timezone at the time
+  of importing a photo, which may or may not be accurate. In case of iPhone, this is only relevant
+  for screenshots, media saved to local camera roll or when no GPS available, such as in the case
+  of being in an aircraft (airplane mode). This is unfortunate, why would they not just use UTC
+  all the time?"
+  [ts filename]
+  (let [dtz (t/default-time-zone)
+        f (tf/formatter "yyyy:MM:dd HH:mm:ss" dtz)]
+    (when (and (seq ts)
+               (re-matches #"\d{4}:\d{2}:\d{2} \d{2}:\d{2}:\d{2}" ts))
+      (add-filename-offset (c/to-long (tf/parse f ts)) filename))))

 (defn extract-from-tag
   "Creates map for a single Exif directory.
@@ -53,14 +76,15 @@
   "Takes an image file (as a java.io.InputStream or java.io.File) and extracts exif information into a map.
   Borrowed and modified from: https://github.com/joshuamiller/exif-processor"
   [file]
-  (let [metadata (ImageMetadataReader/readMetadata file)
+  (let [filename (.getName file)
+        metadata (ImageMetadataReader/readMetadata file)
         exif-directories (.getDirectories metadata)
         tags (map #(.getTags %) exif-directories)
         exif (into {} (map extract-from-tag tags))]
     {:raw-exif  exif
-     :timestamp (or (extract-ts (str (get exif "GPS Date Stamp") " " (get exif "GPS Time-Stamp")))
-                    (extract-ts (str (get exif "Date/Time") ".00 UTC"))
-                    (extract-ts (str (get exif "Date/Time Original") ".00 UTC"))
+     :timestamp (or (extract-gps-ts (str (get exif "GPS Date Stamp") " " (get exif "GPS Time-Stamp")) filename)
+                    (extract-ts (str (get exif "Date/Time")) filename)
+                    (extract-ts (str (get exif "Date/Time Original")) filename)
                     (st/now))
      :latitude  (dms-to-dd exif "GPS Latitude" "GPS Latitude Ref")
      :longitude (dms-to-dd exif "GPS Longitude" "GPS Longitude Ref")}))


Limitted feed length to 10 most recent entries.

--- lambda-blog/src/lambda_blog/templates/feeds.clj
+++ lambda-blog/src/lambda_blog/templates/feeds.clj
@@ -29,4 +29,7 @@
                               (sort-by :id tags))
                          (summary {:type :html}
                                   (:summary e))))
-                (reverse (sort-by :timestamp entries))))))
+                (->> entries
+                     (sort-by :timestamp)
+                     reverse
+                     (take 10))))))


Fix sliding-buffer call

Fix sliding-buffer call

--- src/orbitingnews/twitter.clj
+++ src/orbitingnews/twitter.clj
@@ -89,7 +89,7 @@
 (defn firehose []
   ; We want tweets with the word tweet in them
   (let [stream (oauth-stream-authorized-twitter)
-        c (chan (sliding-buffer 50))]
+        c (chan (async/sliding-buffer 50))]
     (.addListener stream (status-listener c))
     (.sample stream)
     c))