Add 'count' to web api.

Add 'count' to web api.

--- src/cavm/query/functions.clj
+++ src/cavm/query/functions.clj
@@ -41,4 +41,5 @@
    'cdr rest
    'group-by group-by
    'mean meannan
+   'count count
    'apply apply}) ; XXX is this a security hole? Can the user pass in clojure symbols?


Add a few docstrings

Add a few docstrings

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -35,7 +35,7 @@
   (reader.jline/resume-reader))

 (defn exit
-  "Exits the REPL."
+  "Exits the REPL. This is fairly brutal, does (System/exit 0)."
   []
   (shutdown-agents)
   (reader.jline/shutdown-reader)
@@ -66,6 +66,8 @@
       arg-map)))

 (defn launch-nrepl [options]
+  "Launches the nREPL version of REPL-y, with options already
+  parsed out"
   (reader.jline/with-jline-in
     (evaluation.nrepl/main
       (assoc options
@@ -75,7 +77,10 @@
                   (reader.jline/prepare-for-read))
         "--interactive" true))))

-(defn launch-standalone [options]
+(defn launch-standalone
+  "Launches the streamed (non-nREPL) version of REPL-y, with options already
+  parsed out"
+  [options]
   (concurrency/set-signal-handler! "INT" handle-ctrl-c)
   (clojure.main/repl :read reply-read
         :eval reply-eval


green

green

--- src/cloogling/core.clj
+++ src/cloogling/core.clj
@@ -1,11 +1,11 @@
 (ns cloogling.core
   (:require [clojure.data.json :as json]))

-(defrecord entry [url title])
+(defrecord entry [url title snippet])

 (defn get-entries
   "Get results from json data retrieved from engine"
   [x]
-  (map (fn [x] (->entry (x "Url" ) (x "Title"))) (-> x
+  (map (fn [x] (->entry (x "Url" ) (x "Title") (x "Description"))) (-> x
                                                      json/read-str
                                                      (get-in ["d" "results"]))))


(TK-62) Improve docstring

(TK-62) Improve docstring

--- src/puppetlabs/trapperkeeper/services_internal.clj
+++ src/puppetlabs/trapperkeeper/services_internal.clj
@@ -40,7 +40,7 @@
        (every? fn-sig? (apply concat (vals m)))))

 (defn var->symbol
-  "Returns a symbol with the namespace name of a given var"
+  "Returns a symbol for the var, including its namespace"
   [fn-var]
   {:pre [(var? fn-var)]
    :post [(symbol? %)]}


Extract an applicative instance for synths.

--- src/klangmeister/sound/synthesis.cljs
+++ src/klangmeister/sound/synthesis.cljs
@@ -73,14 +73,23 @@

 ; Combinators

+(defn fapply
+  "Apply a function within the (applicative) context of a synth."
+  [f synth1 synth2]
+  (fn [context at duration]
+    (let [graph1 (-> synth1 (run-with context at duration))
+          graph2 (-> synth2 (run-with context at duration))]
+      (f graph1 graph2))))
+
 (defn connect
   "Use the output of one synth as the input to another."
   [upstream-synth downstream-synth]
-  (fn [context at duration]
-    (let [{downstream-input :input downstream-output :output} (-> downstream-synth (run-with context at duration))
-          {upstream-input :input upstream-output :output} (-> upstream-synth (run-with context at duration))]
-      (-> upstream-output (.connect downstream-input))
-      (section upstream-input downstream-output))))
+  (fapply
+    (fn [graph1 graph2]
+      (-> (:output graph1) (.connect (:input graph2)))
+      (section (:input graph1) (:output graph2)))
+    upstream-synth
+    downstream-synth))

 (defn connect->
   "Connect synths in series."


updated to latest dependencies

updated to latest dependencies

--- src/leiningen/new/cryogen/project.clj
+++ src/leiningen/new/cryogen/project.clj
@@ -8,8 +8,8 @@
                            [compojure "1.4.0"]
                            [ring-server "0.4.0"]
                            [cryogen-markdown "0.1.1"]
-                           [cryogen-core "0.1.26"]]
-            :plugins [[lein-ring "0.9.6"]]
+                           [cryogen-core "0.1.27"]]
+            :plugins [[lein-ring "0.9.7"]]
             :main cryogen.core
             :ring {:init cryogen.server/init
                    :handler cryogen.server/handler})


atom get-or-set tests

atom get-or-set tests

--- test/conv_man_tests.clj
+++ test/conv_man_tests.clj
@@ -3,6 +3,18 @@
         test-helpers)
   (:require [clojure.test :refer :all]
             [polismath.conv-man :refer :all]))
+
+
+(deftest get-or-set-test
+  (testing "should work when not set"
+    (let [a (atom {})]
+      (get-or-set! a :shit (fn [] "stuff"))
+      (is (= (:shit @a) "stuff"))))
+  (testing "should work when set"
+    (let [a (atom {:shit "stuff"})]
+      (is (= (get-or-set! a :shit (fn [] "crap"))
+             "stuff")))))
+

 ; Initialization test
 (deftest split-batches-test


Add bounds checks for RyuFloat

Add bounds checks for RyuFloat

--- test/float/ryu_test.clj
+++ test/float/ryu_test.clj
@@ -110,6 +110,21 @@
                        (<= (count ryu) (count libc)))))
               digits))))

+(deftest bounds
+  (testing "bounds"
+    (let [values [(str Float/MAX_VALUE) (str \- Float/MAX_VALUE) (str Float/MIN_VALUE) (str \- Float/MIN_VALUE)]
+          digits (range 1 20)
+          combos (for [v values
+                       d digits] [v d])]
+      (doseq [[v-str d] combos]
+        (let [vf (Float. ^String v-str)
+              v (format "%.12e" vf)
+              libc (libc-float d v)
+              ryu (ryu-float d v)]
+;          (println libc ryu v d) ; dumps the libc vs. ryu output
+          (is (= (Float. ^String libc) (Float. ^String ryu)) {:value v-str :digits d})
+          (is (<= (count ryu) (count libc)) {:value v-str :digits d}))))))
+
 (deftest regressions
   (testing "regressions"
     (let [values ["9.032756200e-23" "4.200000251e6" "1.035024980e-7" "7.085204700e-21"]


testing "times" using new style

testing "times" using new style

--- test/java_time_test.clj
+++ test/java_time_test.clj
@@ -416,23 +416,83 @@
       (is (j/not-before? dt+5 dt))
       (is (not (j/not-before? dt dt+5))))

-    (is (j/after? (j/local-date clock) (j/minus (j/local-date clock) (j/days 5))))
-    (is (j/before? (j/local-date clock) (j/plus (j/local-date clock) (j/days 5))))
-
-    (is (j/after? (j/local-time clock) (j/minus (j/local-time clock) (j/minutes 5))))
-    (is (j/before? (j/local-time clock) (j/plus (j/local-time clock) (j/minutes 5))))
-
-    (is (j/after? (j/zoned-date-time clock) (j/minus (j/zoned-date-time clock) (j/minutes 5))))
-    (is (j/before? (j/zoned-date-time clock) (j/plus (j/zoned-date-time clock) (j/minutes 5))))
-
-    (is (j/after? (j/offset-date-time clock) (j/minus (j/offset-date-time clock) (j/minutes 5))))
-    (is (j/before? (j/offset-date-time clock) (j/plus (j/offset-date-time clock) (j/minutes 5))))
-
-    (is (j/after? (j/offset-time clock) (j/minus (j/offset-time clock) (j/minutes 5))))
-    (is (j/before? (j/offset-time clock) (j/plus (j/offset-time clock) (j/minutes 5))))
-
-    (is (j/after? (j/instant clock) (j/minus (j/instant clock) (j/minutes 5))))
-    (is (j/before? (j/instant clock) (j/plus (j/instant clock) (j/minutes 5)))))
+    (let [dt (j/local-date clock)
+          dt+5 (j/plus dt (j/days 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5))))
+
+    (let [dt (j/local-time clock)
+          dt+5 (j/plus dt (j/minutes 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5))))
+
+    (let [dt (j/zoned-date-time clock)
+          dt+5 (j/plus dt (j/minutes 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5))))
+
+    (let [dt (j/offset-date-time clock)
+          dt+5 (j/plus dt (j/minutes 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5))))
+
+    (let [dt (j/offset-time clock)
+          dt+5 (j/plus dt (j/minutes 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5))))
+
+    (let [dt (j/instant clock)
+          dt+5 (j/plus dt (j/minutes 5))]
+      (is (j/after? dt+5 dt))
+      (is (not (j/after? dt dt+5)))
+      (is (j/before? dt dt+5))
+      (is (not (j/before? dt+5 dt)))
+      (is (j/not-after? dt dt))
+      (is (j/not-after? dt dt+5))
+      (is (not (j/not-after? dt+5 dt)))
+      (is (j/not-before? dt dt))
+      (is (j/not-before? dt+5 dt))
+      (is (not (j/not-before? dt dt+5)))))

   (testing "clocks"
     (is (j/after? (j/fixed-clock 1000) (j/fixed-clock 0)))


Added the new environment files to the core assets

--- src/leiningen/new/retro_fever.clj
+++ src/leiningen/new/retro_fever.clj
@@ -19,7 +19,11 @@
    ["src/<<sanitized>>/core.cljs" "core/src/core.cljs"]

    ;; resources
-   ["resources/public/index.html" "core/resources/index.html"]])
+   ["resources/public/index.html" "core/resources/index.html"]
+
+   ;; environment
+   ["env/dev/<<sanitized>>/dev.cljs" "core/env/dev.cljs"]
+   ["env/prod/<<sanitized>>/prod.cljs" "core/env/prod.cljs"]])

 (defn render-template [template options]
   (selmer/render


start fixing broken tests (wip)

start fixing broken tests (wip)

--- test/navigator_test.clj
+++ test/navigator_test.clj
@@ -16,19 +16,22 @@
                            :comp/id-sk "i am a shared key"
                            :comp/name "COMP there it is"}]))))
   (testing "create-competency"
-    (is (n-tl/ensure-tx (navigator/create-competency
+    (is (n-tl/ensure-tx (navigator/tx-entity
                          (:db-conn nt-config/system)
-                         "I will keep typing"
-                         "v1"
-                         :comp.status/active
-                         :comp/id-sk "yeep"))))
+                         {:db/id (d/tempid :db.part/user)
+                          :comp/name "I will keep typing"
+                          :comp/version "v1"
+                          :comp/status :comp.status/active
+                          :comp/id-sk "yeep"}
+                         :comp))))
   (testing "create duplicate competency"
-    (is (n-tl/should-throw @(navigator/create-competency
+    (is (n-tl/should-throw @(navigator/tx-entity
                              (:db-conn nt-config/system)
-                             "I will keep typing"
-                             "v1"
-                             :comp.status/active
-                             :comp/id-sk "jeep")))))
+                             {:db/id (d/tempid :db.part/user)
+                              :comp/name "I will keep typing"
+                              :comp/version "v1"
+                              :comp/status :comp.status/active
+                              :comp/id-sk "jeep"})))))

 (deftest update-comps
   (is (n-tl/ensure-tx (navigator/create-competency


Improve coverage

Improve coverage

--- test/github_changelog/formatters/markdown_test.clj
+++ test/github_changelog/formatters/markdown_test.clj
@@ -31,14 +31,15 @@
                 :scope        scope
                 :subject      "new something"
                 :pull-request pull
-                :issues       []}))))
+                :issues       [["1" "http://example.com/issue/1"]]}))))

-(def expected-change (str "new something " (md/link "#1" "http://example.com/")))
+(def expected-change (str "new something " (md/link "#1" "http://example.com/")
+                          ", closes " (md/link "1" "http://example.com/issue/1")))

 (def expected-changes (str/join (map md/li [expected-change expected-change])))

 (def expected-scopeless-changes (str (md/h4 "Features")
-                                  expected-changes))
+                                     expected-changes))

 (def expected-scope (md/emphasis "scope:"))
 (def expected-scoped-changes (str (md/h4 "Features")


add tests with larger arrays and objects


Tokenise the 'group' field too

Tokenise the 'group' field too

--- src/net/dishevelled/mailindex.clj
+++ src/net/dishevelled/mailindex.clj
@@ -132,7 +132,7 @@
     (fieldpool/reset)

     (let [source (-> @connection :config :name)]
-      (.add doc (fieldpool/stored-field "group" (-> msg :id :group)))
+      (.add doc (fieldpool/tokenized-field "group" (-> msg :id :group)))
       (.add doc (fieldpool/stored-field "num" (-> msg :id :num)))
       (.add doc (fieldpool/stored-field "source" source))
       (.add doc (fieldpool/stored-field "id"


Revised query body for class_consolidation_by_shared_label rule

The previous version regex’d each label to replace underscores with
spaces. This operation is too costly to do for all labels vs. all
labels. The current implementation is more efficient and executes in a
reasonable amount of time.

--- resources/rules/pre_identifier_merge/step_b_id_exact_match/shared_label/class_consolidation_by_shared_label.clj
+++ resources/rules/pre_identifier_merge/step_b_id_exact_match/shared_label/class_consolidation_by_shared_label.clj
@@ -9,15 +9,14 @@
                   prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
                   prefix oboInOwl: <http://www.geneontology.org/formats/oboInOwl#>
                   select ?id1 ?id2 {
-                             ?c1 oboInOwl:hasOBONamespace ?ns1 .
-                             ?c1 rdf:type owl:Class .
-                             ?c1 rdfs:label ?label1 .
-                             ?c2 oboInOwl:hasOBONamespace ?ns2 .
-                             ?c2 rdf:type owl:Class .
-                             ?c2 rdfs:label ?label2 .
-
-                             FILTER (?c1 != ?c2 && replace(str(?label1),'_',' ') = replace(str(?label2),'_',' ') && STR(IRI(?c1)) < STR(IRI(?c2)))
-                             ?id1 obo:IAO_0000219 ?c1 .
-                             ?id2 obo:IAO_0000219 ?c2 .
-                             }"
+                    ?c1 oboInOwl:hasOBONamespace ?ns1 .
+                    ?c1 rdf:type owl:Class .
+                    ?c1 rdfs:label ?label .
+                    ?c2 rdfs:label ?label .
+                    ?c2 oboInOwl:hasOBONamespace ?ns2 .
+                    ?c2 rdf:type owl:Class .
+                    FILTER (?c1 != ?c2 && STR(IRI(?c1)) < STR(IRI(?c2)))
+                    ?id1 obo:IAO_0000219 ?c1 .
+                    ?id2 obo:IAO_0000219 ?c2 .
+                  }"
   }


Remove old stuff, so we can see what's happening

--- src/reagent_components/modal.cljs
+++ src/reagent_components/modal.cljs
@@ -89,88 +89,6 @@

 ;; ------------------------------------------------------------------------------------
-;;  modal-window-OLD  TODO: TO BE REMOVED
-;; ------------------------------------------------------------------------------------
-
-;; CORE.ASYNC REMOVED
-;; (defn listen [el type]
-;;   (let [out (chan)]
-;;     (events/listen el type (fn [e] (put! out e)))
-;;     out))
-
-(def modal-alert (reagent/atom nil))
-
-
-(defn modal-window-OLD [markup status modal-options progress-percent]
-  "Renders a modal window centered on screen. A dark transparent backdrop sits between this and the underlying
-  main window to prevent UI interactivity and place user focus on the modal window.
-  Parameters:
-  - markup            The message to display in the modal (a string or a hiccup vector or function returning a hiccup vector)
-  - status            [optional] The atom used to indicate the process is running (:running, :finished, :cancelled) and that
-  .                   the modal should be shown. Only required when :cancel-button specified.
-  - modal-options     [optional] A map containing two options:
-  .                    - :spinner       A boolean indicating whether to show a spinner or not
-  .                    - :progress-bar? A boolean indicating whether to show a progress bar or not
-  .                    - :cancel-button A boolean indicating whether to show a cancel button or not
-  - progress-percent  [optional] The integer atom used to hold the percentage through the process we are. Used in rendering the progress bar
-  "
-  (let [spinner?       (:spinner       modal-options)
-        progress-bar?  (:progress-bar  modal-options)
-        cancel-button? (:cancel-button modal-options)
-        ;; cancel-id      (gensym "cancel-") ;; CORE.ASYNC REMOVED
-        ]
-
-    ;; (util/console-log "In show-modal-window")
-    (reagent/create-class
-     {
-      :component-did-mount
-      (fn []
-        ;; CORE.ASYNC REMOVED
-        ;; (when cancel-button?
-        ;;   (let [elem   (util/get-element-by-id cancel-id)
-        ;;         clicks (listen elem "click")]
-        ;;     (util/console-log (str "show-modal-window :component-did-mount - " (.-value elem)))
-        ;;     (go (while true
-        ;;           (<! clicks)
-        ;;           (util/console-log "CANCEL CLICKED")
-        ;;           (reset! status :cancelled false)
-        ;;           ))))
-        )
-
-      :render
-      (fn []
-        ;; (util/console-log "show-modal-window :render")
-        [:div
-         {:style {:display "flex"      ;; Semi-transparent backdrop
-                  :position "fixed"
-                  :left "0px"
-                  :top "0px"
-                  :width "100%"
-                  :height "100%"
-                  :background-color "rgba(0,0,0,0.85)"
-                  :z-index 1020
-                  :on-click #(util/console-log "clicked backdrop") ;; Gobble up clicks so they don't go to the main window (TODO: Doesn't work)
-                  }}
-         [:div                         ;; Modal window containing div
-          {:style {:margin "auto"
-                   :background-color "white"
-                   :padding "16px"
-                   :border-radius "6px"
-                   :z-index 1020}}
-          markup
-          (when spinner?       [spinner])
-          (when progress-bar?  [progress-bar progress-percent])
-          (when cancel-button? [cancel-button #(reset! status :cancelled)])
-          #_(when @modal-alert   [:div {:style {:margin "12px"}}
-                                [closeable-alert
-                                 @modal-alert
-                                 (fn [id] (reset! modal-alert nil))]])
-          ]]
-        )
-      })))
-
-
-;; ------------------------------------------------------------------------------------
 ;;  modal-window
 ;; ------------------------------------------------------------------------------------

@@ -181,83 +99,34 @@
   Parameters:
   - markup  The message to display in the modal (a string or a hiccup vector or function returning a hiccup vector)
   "
-  (reagent/create-class
-   {
-    :component-did-mount
-    (fn []
-      ;; CORE.ASYNC REMOVED
-      )
+  (fn []
+    [:div
+     {:style {:display "flex"      ;; Semi-transparent backdrop
+              :position "fixed"
+              :left "0px"
+              :top "0px"
+              :width "100%"
+              :height "100%"
+              :background-color "rgba(0,0,0,0.85)"
+              :z-index 1020
+              :on-click #(util/console-log "clicked backdrop") ;; Gobble up clicks so they don't go to the main window (TODO: Doesn't work)
+              }}
+     [:div                         ;; Modal window containing div
+      {:style {:margin "auto"
+               :background-color "white"
+               :padding "16px"
+               :border-radius "6px"
+               :z-index 1020}}
+      markup]]))

-    :render
-    (fn []
-      [:div
-       {:style {:display "flex"      ;; Semi-transparent backdrop
-                :position "fixed"
-                :left "0px"
-                :top "0px"
-                :width "100%"
-                :height "100%"
-                :background-color "rgba(0,0,0,0.85)"
-                :z-index 1020
-                :on-click #(util/console-log "clicked backdrop") ;; Gobble up clicks so they don't go to the main window (TODO: Doesn't work)
-                }}
-       [:div                         ;; Modal window containing div
-        {:style {:margin "auto"
-                 :background-color "white"
-                 :padding "16px"
-                 :border-radius "6px"
-                 :z-index 1020}}
-        markup]])}))

 ;; ------------------------------------------------------------------------------------
-;;  chunk-runner  TODO: TO BE REMOVED
+;;  looper
 ;; ------------------------------------------------------------------------------------

-(defn chunk-runner [chunk-fn status chunks]
-  "Split your long running process into bite-size chunks and use this function to schedule those execution
-  chunks into the JavaScript event loop. It will also:
-  - Manage the showing/hiding of the modal window
-  - Calculate the percentage to be used in the progress bar if that's being shown
-  Parameters:
-  - chunk-fn  Your function that will be repeatedly called to perform a single chunk of processing.
-  .           It will be passed the following parameters:
-  .            - chunk-index  Chunk number 0 to chunks - 1
-  .            - chunks       Number of chucks to be processed [TODO: Would we ever really need this?]
-  .            - percent      Percentage through the process, rounded to nearest integer. This is important
-  .                           as chunk-fn is responsible for updating the atom holding the percentage progress
-  .                           used by the progress bar
-  - status    The atom used to indicate the process is running (:running, :finished, :cancelled) and that
-  .           the modal should be shown
-  - chunks    How many times chunk-fn should be called (if omitted, defaults to 1)
-  "
-  (let [chunks (if chunks chunks 1)]
-    (util/console-log (str "STARTING chunk-runner (" chunks ")"))
-    (reset! modal-alert nil) ;; Clea any previous alerts
-    (reset! status :running)   ;; Start by showing the modal
-    (loop [chunk-index 0]
-      (if (< chunk-index chunks)
-        (let [percent (int (+ (* (/ chunk-index (- chunks 1)) 100) 0.5))] ;; OR: (-> chunk-index (/ (- chunks 1)) (* 100) (+ 0.5) int)
-          (js/setTimeout #(chunk-fn chunk-index chunks percent) 0) ;; Schedule each chunk of work
-          (recur (inc chunk-index)))
-        (js/setTimeout #(reset! status :finished) 0)) ;; Schedule closing the modal window
-      ))
-  (util/console-log "FINISHED chunk-runner"))
-
-
-(defn start-cpu-intensive
-  [func]
-  "Run a CPU intensive function with a slight delay to allow the UI to updated (and show modal window changes)
-  "
-  (js/setTimeout func 10))
-
-
-;; ------------------------------------------------------------------------------------
-;;  modal-multi-chunk-runner   TODO: TO BE REMOVED
-;; ------------------------------------------------------------------------------------
-
-(defn modal-multi-chunk-runner
-  [func initial-state running?]
+(defn looper
+  [& {:keys [initial-value func when-done]}]
   "...
   Parameters:
   - func           A function to repeatedly call. On each call, something else happens, could be the
@@ -267,23 +136,6 @@
   .                to be used for the subsequent function call and so on.
   - running?       A reagent boolean atom indicating if the processing is running
   "
-  (let [schedule (fn reschedule [state]
-                   (js/setTimeout
-                    #(let [next-state (apply (func) state)]
-                       (util/console-log (str "IN reschedule: " state))
-                       (when-not next-state (reset! running? false))
-                       (when @running? (reschedule next-state)))
-                    20))] ;; 20ms should give enough time for UI events to be processed
-    (reset! running? true)
-    (schedule initial-state)))
-
-
-;; ------------------------------------------------------------------------------------
-;;  looper
-;; ------------------------------------------------------------------------------------
-
-(defn looper
-  [& {:keys [initial-value func when-done]}]
   (go (loop [pause (<! (timeout 20))
              val   initial-value]
         (let [[continue? out]  (func val)]
@@ -291,16 +143,6 @@
             (recur (<! (timeout 20)) out)
             (when-done out))))))

-
-(defn looper-OLD
-  [initial-value func continue?]
-  (reset! continue? true)
-  (go (loop [pause (<! (timeout 20))
-             val   initial-value]
-        (let [out  ((func continue?) val)]
-          (if @continue?
-            (recur (<! (timeout 20)) out)
-            out)))))

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


Add routes for chapters and scenes

Add routes for chapters and scenes

--- src/storemi/routes/authorship.clj
+++ src/storemi/routes/authorship.clj
@@ -129,8 +129,12 @@
          (story-data request))

     (GET url/story-path request
-         (coerce enforce-user-story page/story)
-         )))
+         (coerce enforce-user-story page/story))
+    (GET url/chapter-path request
+         (coerce enforce-user-story page/story))
+    (GET url/scene-path request
+         (coerce enforce-user-story page/story))
+    ))


Fixed typo in touch extension

Fixed typo in touch extension

--- src/duffel_ext/touch.clj
+++ src/duffel_ext/touch.clj
@@ -1,4 +1,4 @@
-(ns duffel-ext.put
+(ns duffel-ext.touch
     (:use duffel.ext-protocol)
     (:require [duffel.fs-util  :as dfs-util]
               [duffel.ext      :as dext]


variable aoo grid size

variable aoo grid size

--- src/dwc_analysis/aoo.clj
+++ src/dwc_analysis/aoo.clj
@@ -68,16 +68,18 @@
       grid)})

 (defn aoo-0
-  [occs]
-  (let [points (occs-to-points occs)]
-    (reduce concat
-      (mapv
-        (fn [cluster]
-          (cluster-points
-            (make-grid 2 (second cluster))
-            (second cluster)))
-        (cluster-points (make-grid 20 points) points)))))
+  ([occs] (aoo-0 occs 2))
+  ([occs step]
+    (let [points (occs-to-points occs)]
+      (reduce concat
+        (mapv
+          (fn [cluster]
+            (cluster-points
+              (make-grid step (second cluster))
+              (second cluster)))
+          (cluster-points (make-grid (* step 10) points) points))))))

 (defn aoo
-  [occs] (prepare-result (aoo-0 occs)))
+  ([occs] (aoo occs 2))
+  ([occs step] (prepare-result (aoo-0 occs step))))


[#1745] Handle middleware args in vectors

Since middleware arguments are defined in vectors and
(seq? []) ;; false
(sequential? []) ;; true

--- backend/src/akvo/lumen/component/handler.clj
+++ backend/src/akvo/lumen/component/handler.clj
@@ -9,7 +9,7 @@
   (:endpoints component (find-endpoint-keys component)))

 (defn- middleware-fn [f args]
-  (let [args (if (or (nil? args) (seq? args)) args (list args))]
+  (let [args (if (or (nil? args) (sequential? args)) args (list args))]
     #(apply f % args)))

 (defn- middleware-map [{:keys [functions arguments]}]


add chat channel for Spanish speakers (by request)

--- src/cljs/netrunner/chat.cljs
+++ src/cljs/netrunner/chat.cljs
@@ -8,7 +8,7 @@
             [netrunner.main :as main]))

 (def app-state
-  (atom {:channels {:general [] :america [] :europe [] :asia-pacific [] :francais [] :italia [] :sverige []}}))
+  (atom {:channels {:general [] :america [] :europe [] :asia-pacific [] :francais [] :español [] :italia [] :sverige []}}))

 (def chat-channel (chan))
 (def chat-socket (.connect js/io (str js/iourl "/chat")))


Move codes around

Move codes around

--- src/cljs/openslack/xmpp.cljs
+++ src/cljs/openslack/xmpp.cljs
@@ -210,64 +210,6 @@
     (.on client "unsubscribed" (partial async/put! c))
     c))

-;; Service discovery
-
-(defn get-features [client]
-  (js->clj (.-features (.-discoInfo (.getCurrentCaps client)))))
-
-(defn update-capabilities [client]
-  (.updateCaps client))
-
-; TODO: Error handling
-(defn disco-info [client jid node]
-  (let [c (async/chan 1)]
-    (.getDiscoInfo client jid node (fn [_ rinfo]
-                                     (async/put! c rinfo)))
-    c))
-
-; TODO: Error handling
-(defn disco-items [client jid node]
-  (let [c (async/chan 1)]
-    (.getDiscoItems client jid node (fn [_ ritems]
-                                      (async/put! c ritems)))
-    c))
-
-;; Chats
-
-(defn raw-chat->chat [rchat]
-  {:body (.-body rchat)
-   :type (keyword (.-type rchat))
-   :from (raw-jid->jid (.-from rchat))
-   :to (raw-jid->jid (.-to rchat))})
-
-(defn chats [client]
-  (let [c (async/chan 10 (map raw-chat->chat))]
-    (.on client "chat" (partial async/put! c))
-    (.on client "groupchat" (partial async/put! c))
-    c))
-
-(defn raw-chat-state->chat-state [rchatstate]
-  {:from (raw-jid->jid (.-from rchatstate))
-   :state (keyword (.-chatState rchatstate))})
-
-(defn chat-states [client]
-  (let [c (async/chan 10 (map raw-chat-state->chat-state))]
-    (.on client "chat:state" (partial async/put! c))
-    c))
-
-;; MUC
-
-(defn raw-room->room
-  [rroom]
-  {:from (raw-jid->jid (.-from rroom))
-   :type (keyword (.-type rroom))})
-
-(defn join-room [client room nick]
-  (let [c (async/chan 10 (map (comp either/right raw-room->room)))]
-    (.once client "muc:join" (partial async/put! c))
-    (.joinRoom client room nick)
-    c))
-
 (defn raw-presence->presence
   [rpr]
   {:from (raw-jid->jid (.-from rpr))
@@ -280,3 +222,61 @@
   (let [c (async/chan 10 (map raw-presence->presence))]
     (.on client "presence" (partial async/put! c))
     c))
+
+;; Service discovery
+
+(defn get-features [client]
+  (js->clj (.-features (.-discoInfo (.getCurrentCaps client)))))
+
+(defn update-capabilities [client]
+  (.updateCaps client))
+
+; TODO: Error handling
+(defn disco-info [client jid node]
+  (let [c (async/chan 1)]
+    (.getDiscoInfo client jid node (fn [_ rinfo]
+                                     (async/put! c rinfo)))
+    c))
+
+; TODO: Error handling
+(defn disco-items [client jid node]
+  (let [c (async/chan 1)]
+    (.getDiscoItems client jid node (fn [_ ritems]
+                                      (async/put! c ritems)))
+    c))
+
+;; Chats
+
+(defn raw-chat->chat [rchat]
+  {:body (.-body rchat)
+   :type (keyword (.-type rchat))
+   :from (raw-jid->jid (.-from rchat))
+   :to (raw-jid->jid (.-to rchat))})
+
+(defn chats [client]
+  (let [c (async/chan 10 (map raw-chat->chat))]
+    (.on client "chat" (partial async/put! c))
+    (.on client "groupchat" (partial async/put! c))
+    c))
+
+(defn raw-chat-state->chat-state [rchatstate]
+  {:from (raw-jid->jid (.-from rchatstate))
+   :state (keyword (.-chatState rchatstate))})
+
+(defn chat-states [client]
+  (let [c (async/chan 10 (map raw-chat-state->chat-state))]
+    (.on client "chat:state" (partial async/put! c))
+    c))
+
+;; MUC
+
+(defn raw-room->room
+  [rroom]
+  {:from (raw-jid->jid (.-from rroom))
+   :type (keyword (.-type rroom))})
+
+(defn join-room [client room nick]
+  (let [c (async/chan 10 (map (comp either/right raw-room->room)))]
+    (.once client "muc:join" (partial async/put! c))
+    (.joinRoom client room nick)
+    c))


late game

late game

--- src/cljs/triboard/ai/ai.cljs
+++ src/cljs/triboard/ai/ai.cljs
@@ -34,11 +34,18 @@
   [turn]
   (< (count (turn/transitions turn)) 5))

+(defn- in-late-game?
+  [scores]
+  (let [max-score (count board/coordinates)
+        sum-score (apply + (vals scores))]
+    (< (- max-score sum-score) 20)))
+
 (defn- high-level-ai
   "High level AI: choose the right evaluation function to play"
   [{:keys [player scores] :as turn}]
   (cond
     (focus-human-player? scores) (strategies/optmize-ai-scores-ai)
+    (in-late-game? scores) (strategies/optimize-own-score-ai player)
     (limited-move-options? turn) (strategies/optimize-own-choices-ai player)
     :else (strategies/optimize-own-score-ai player)
     ))


return math_tick after increment

return math_tick after increment

--- src/polismath/components/postgres.clj
+++ src/polismath/components/postgres.clj
@@ -284,7 +284,8 @@

 (defn inc-math-tick
   [postgres zid]
-  (query postgres ["insert into math_ticks (zid, math_env) values (?, ?) on conflict (zid, math_env) do update set modified = now_as_millis(), math_tick = (math_ticks.math_tick + 1) returning *;" zid (name (-> postgres :config :math-env))]))
+  (log/info "inc-math-tick" zid)
+  (:math_tick (first (query postgres ["insert into math_ticks (zid, math_env) values (?, ?) on conflict (zid, math_env) do update set modified = now_as_millis(), math_tick = (math_ticks.math_tick + 1) returning math_tick;" zid (name (-> postgres :config :math-env))]))))

 (defn pg-json
   [data]


make test/axioms_coll.clj work

make test/axioms_coll.clj work

--- test/clojure/test/axioms_coll.clj
+++ test/clojure/test/axioms_coll.clj
@@ -17,7 +17,7 @@
   ;; (:use [clj-logging-config.log4j])
   (:require [clojure.test :refer :all]
             ;; [migae.infix :as infix]
-            [migae.datastore :refer :all]
+            [migae.datastore :as ds]
             ;; [migae.datastore.api :as ds]
             ;; [migae.datastore.service :as dss]
             ;; [migae.datastore.entity :as dse]
@@ -57,18 +57,18 @@

 (deftest ^:coll emap-axiom1
   (testing "emap axiom 1: an entity-map is a map"
-    (let [e1 (entity-map [:A/B] {:a 1 :b 2})]
-      (log/trace "e1 " (epr e1))
+    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})]
+      ;; (log/trace "e1 " (ds/print e1))
       (is (coll? e1))
       (is (map? e1))
-      (is (emap? e1))
+      (is (ds/emap? e1))
       (is (= (keys e1) '(:a :b)))
       (is (= (vals e1) '(1 2)))
       )))

 (deftest ^:coll emap-axiom2
   (testing "emap axiom 2: an entity-map is seqable"
-    (let [e1 (entity-map [:A/B] {:a 1 :b 2})]
+    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})]
       (is (not (seq? e1)))
       (is (seq? (seq e1)))
       )))
@@ -78,34 +78,34 @@

 (deftest ^:coll coll-axiom1
   (testing "coll axiom 1: an entity-map is countable"
-    (let [e1 (entity-map [:A/B] {:a 1 :b 2})]
+    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})]
       (is (= (count e1) 2))
       )))

 (deftest ^:coll empty-axiom1
   (testing "empty axiom 1: empty works"
-    (let [e1 (entity-map [:A/B] {:a 1 :b 2})
+    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})
           e2 (empty e1)]
-      (is (emap? e2))
+      (is (ds/emap? e2))
       (is (empty? e2))
-      (is (key= e1 e2)) ; an entity-map must have a key
+      (is (ds/key= e1 e2)) ; an entity-map must have a key
       )))

 (deftest ^:coll empty-axiom2
   (testing "empty axiom 2: not-empty works on non-empty emaps"
-    (let [e1 (entity-map [:A/B] {:a 1 :b 2})
+    (let [e1 (ds/entity-map [:A/B] {:a 1 :b 2})
           e2 (not-empty e1)]
-      (is (emap? e2))
+      (is (ds/emap? e2))
       (is (not (empty? e2)))
-      (is (key= e1 e2))
+      (is (ds/key= e1 e2))
       (is (= e1 e2))
       )))

 (deftest ^:coll empty-axiom3
   (testing "empty axiom 3: not-empty works on empty emaps"
-    (let [e1 (entity-map [:A/B] {})
+    (let [e1 (ds/entity-map [:A/B] {})
           e2 (not-empty e1)]
       (is (nil? e2))
-      (is (not (emap? e2)))
+      (is (ds/emap? e2))
       )))


Uncomment previously commented test.

Uncomment previously commented test.

--- test/continuo/postgresql_spec.clj
+++ test/continuo/postgresql_spec.clj
@@ -48,9 +48,9 @@
 ;; Tests
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-;; (t/deftest facked-connect-tests
-;;   (let [tx @(impl/connect (URI. uri) {})]
-;;     (t/is (instance? Transactor tx))))
+(t/deftest facked-connect-tests
+  (let [tx @(impl/connect (URI. uri) {})]
+    (t/is (instance? Transactor tx))))

 (t/deftest open-not-created-database
   (try


add sticky-table test

add sticky-table test

--- test/desdemona/ui/table_test.cljs
+++ test/desdemona/ui/table_test.cljs
@@ -5,7 +5,8 @@
    [reagent.core :as r]
    [reagent.session :as session]
    [cljs.core.match :refer-macros [match]]
-   [dommy.core :as d :refer-macros [sel sel1]]))
+   [dommy.core :as d :refer-macros [sel sel1]]
+   [wilson.dom :as wd]))

 (def test-state {:results [{:a 1 :b 2}
                            {:a 4 :b 2}]
@@ -51,6 +52,21 @@
           (.click first-link)
           (is (nil? (some #{:a} (:table-toggled-ks @session/state)))))))))

+(deftest sticky-header-component-test
+  []
+  (let [ks (:all-table-ks test-state)
+        component (table/sticky-header-component ks)
+        [table-class table-id ths] (match component
+                                     [:table {:class table-class
+                                              :id table-id}
+                                      [:thead
+                                       [:tr ths]]]
+                                     [table-class table-id ths])]
+    (is (= table-class "table table-sticky"))
+    (is (= table-id "table-sticky"))
+    (doseq [[[_ _ desc] k] (map vector ths ks)]
+      (is (= desc (wd/describe-key k))))))
+
 (deftest table-component-test
   (let [results-count (count (:results test-state))
         component [table/table-component]]


more logging to diagnose the buffer overflow problems

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -304,7 +304,8 @@
         tags (if (and t (pos? t))
                (assoc tags "ElapsedTime-ms" t)
                (dissoc tags "ElapsedTime-ms"))]
-    (log "t: " t)
+    (println "cam-t: " t ", collect-t: " (elapsed-time @state)
+         ", remaining-images: " (core getRemainingImageCount))
     {:pix pix :tags (dissoc tags "StartTime-ms")}))

 (defn collect-snap-image []
@@ -318,7 +319,11 @@
     (if (. mmc isBufferOverflowed)
       (do (swap! state assoc :stop true)
           (ReportingUtils/showError "Circular buffer overflowed."))
-      (.put out-queue (make-TaggedImage (annotate-image image event @state))))))
+      (do (log "collect-image: "
+               (select-keys event [:position-index :frame-index
+                                   :slice-index :channel-index]))
+          (.put out-queue
+                (make-TaggedImage (annotate-image image event @state)))))))

 (defn compute-z-position [event]
   (if-let [z-drive (:z-drive event)]


Rearrange post tests to run fixtures every time

I'd rather write the tests with "testing" blocks, and write a single "deftest" for each function I'm testing. Unfortunately, the clojure.test fixtures will only run for each "deftest" or "with-test" block, so I rearranged the post tests to use "deftest" for each post I create and test.

--- test/swartz/models/posts_test.clj
+++ test/swartz/models/posts_test.clj
@@ -6,37 +6,43 @@

 (use-fixtures :each clean-db)

-(deftest test-create
+(deftest test-create-with-url
   (let [user (first (users/find-all test-db))
-        user-id (:id user)]
-    (testing "Create with URL"
-      (let [params (assoc post-params
-                          :content nil
-                          :user-id user-id)
-            post (create-test-post params)]
-        (is (= (:url params) (:url post)))))
-    (testing "Create with content"
-      (let [params (assoc post-params
-                          :url nil
-                          :user-id user-id)
-            post (create-test-post params)]
-        (is (= (:content params) (:content post)))))
-    (testing "Create with no content or URL"
-      (let [params (assoc post-params
-                          :url nil
-                          :content nil
-                          :user-id user-id)]
-        (try
-          (create-test-post params)
-          (catch Exception e
-            (is (= (class e) org.postgresql.util.PSQLException)))
-          (finally
-            (is (= 0 (count (posts/find-all test-db))))))))
-    (testing "Create with no user id"
-      (try
-        ;; post-params doesn't have user id by default -- it has to be assoc'd
-        (create-test-post)
-        (catch Exception e
-          (is (= (class e) org.postgresql.util.PSQLException)))
-        (finally
-          (is (= 0 (count (posts/find-all test-db)))))))))
+        user-id (:id user)
+        params (assoc post-params
+                      :content nil
+                      :user-id user-id)
+        post (create-test-post params)]
+    (is (= (:url params) (:url post)))))
+
+(deftest test-create-with-content
+  (let [user (first (users/find-all test-db))
+        user-id (:id user)
+        params (assoc post-params
+                      :url nil
+                      :user-id user-id)
+        post (create-test-post params)]
+    (is (= (:content params) (:content post)))))
+
+(deftest test-create-with-no-url-or-content
+  (let [user (first (users/find-all test-db))
+        user-id (:id user)
+        params (assoc post-params
+                      :url nil
+                      :content nil
+                      :user-id user-id)]
+    (try
+      (create-test-post params)
+      (catch Exception e
+        (is (= (class e) org.postgresql.util.PSQLException)))
+      (finally
+        (is (= 0 (count (posts/find-all test-db))))))))
+
+(deftest test-create-with-no-user-id
+  (try
+    ;; post-params doesn't have user id by default -- it has to be assoc'd
+    (create-test-post)
+    (catch Exception e
+      (is (= (class e) org.postgresql.util.PSQLException)))
+    (finally
+      (is (= 0 (count (posts/find-all test-db)))))))


Remaining dwelling rows and tidy up.

Remaining dwelling rows and tidy up.

--- src-cljs/kixi/hecuba/tabs/profiles.cljs
+++ src-cljs/kixi/hecuba/tabs/profiles.cljs
@@ -27,7 +27,7 @@
                :on-change #(handle-change owner key %1)
                :type "text"
                :id (name key)}]]
-     [:p {:class "form-control-static col-md-10"} (get data key "")])])
+     [:p.form-control-static (get data key "")])])

 (defn text-area-control [data state owner key title]
   (let [text (get data key)]
@@ -40,7 +40,7 @@
       (if (and text (re-find #"\w" text))
         [:div [:h3 title]
          [:p text]]
-        [:div {:class "hidden"} [:p {:class "form-control-static col-md-10"} text]]))))
+        [:div {:class "hidden"} [:p.form-control-static text]]))))

 (defn format-time-inst [t format]
   (if (nil? t)
@@ -119,7 +119,7 @@
              (bs/panel
               "Measurements"
               [:div
-               (text-control profile_data state owner :footprint "Footprint (internal groundfloor area (m2)")
+               (text-control profile_data state owner :footprint "Footprint (internal groundfloor area m2)")
                (text-control profile_data state owner :external_perimeter "External Perimeter (m)")
                (text-control profile_data state owner :gross_internal_area "Gross Internal Area (m2)")
                (text-control profile_data state owner :number_of_storeys "Number Of Storeys")
@@ -412,7 +412,7 @@
            (bs/panel
             "Conservatories"
             (if-let [conservatories (seq (:conservatories profile))]
-              [:div {:class (profile-column-width)}
+              [:div
                (for [c conservatories]
                  (bs/panel
                   "Conservtory"
@@ -435,7 +435,7 @@
            (bs/panel
             "Extensions"
             (if-let [extensions (seq (:extensions profile))]
-              [:div {:class (profile-column-width)}
+              [:div
                (for [item extensions]
                  (bs/panel
                   "Extension"
@@ -455,7 +455,7 @@
            (bs/panel
             "Heating Systems"
             (if-let [heating-systems (seq (:heating-systems profile))]
-              [:div {:class (profile-column-width)}
+              [:div
                (for [item heating-systems]
                  (bs/panel
                   "Heating System"
@@ -507,7 +507,7 @@
            (bs/panel
             "Hot Water Systems"
             (if-let [hot-water-systems (seq (:hot-water-systems profile))]
-              [:div {:class (profile-column-width)}
+              [:div
                (for [item hot-water-systems]
                  (bs/panel
                   "Hot Water System"
@@ -525,6 +525,286 @@
                    (text-control item state owner :cylinder_thermostat "Cylinder Thermostat")
                    (text-control item state owner :controls_same_for_all_zones "Controls Same For All Zones")]))]
               [:p "No hot water systems."]))])]))))
+
+(defn storeys-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Storeys"
+            (if-let [storeys (seq (:storeys profile))]
+              [:div
+               (for [item storeys]
+                 (bs/panel
+                  "Storey"
+                  [:div
+                   (text-control item state owner :storey_type "Storey Type")
+                   (text-control item state owner :storey ":Storey")
+                   (text-control item state owner :heat_loss_w_per_k "Heat Loss W Per K")
+                   (text-control item state owner :heat_requirement_kwth_per_year "Heat Requirement kWh Per Year")]))]
+              [:p "No storeys recorded."]))])]))))
+
+(defn walls-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Walls"
+            (if-let [walls (seq (:walls profile))]
+              [:div
+               (for [item walls]
+                 (bs/panel
+                  "Wall"
+                  [:div
+                   (text-control item state owner :wall_type "Wall Type")
+                   (text-control item state owner :construction "Construction")
+                   (text-control item state owner :construction_other "Construction Other")
+                   (text-control item state owner :insulation "Insulation")
+                   (text-control item state owner :insulation_date "Insulation Date")
+                   (text-control item state owner :insulation_type "Insulation Type")
+                   (text-control item state owner :insulation_thickness "Insulation Thickness")
+                   (text-control item state owner :insulation_product "Insulation Product")
+                   (text-control item state owner :uvalue "U Value")
+                   (text-control item state owner :location "Location")
+                   (text-control item state owner :area "Area")]))]
+              [:p "No walls recorded."]))])]))))
+
+(defn roofs-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Roofs"
+            (if-let [roofs (seq (:roofs profile))]
+              [:div
+               (for [item roofs]
+                 (bs/panel
+                  "Roof"
+                  [:div
+                   (text-control item state owner :roof_type "Roof Type")
+                   (text-control item state owner :construction "Construction")
+                   (text-control item state owner :construction_other "Construction Other")
+                   (text-control item state owner :insulation_location_one "Insulation Location One")
+                   (text-control item state owner :insulation_location_one_other "Insulation Location One Other")
+                   (text-control item state owner :insulation_location_two "Insulation Location Two")
+                   (text-control item state owner :insulation_location_two_other "Insulation Location Two Other")
+                   (text-control item state owner :insulation_thickness_one "Insulation Thickness One")
+                   (text-control item state owner :insulation_thickness_one_other "Insulation Thickness One Other")
+                   (text-control item state owner :insulation_thickness_two "Insulation Thickness Two")
+                   (text-control item state owner :insulation_thickness_two_other "Insulation Thickness Two Other")
+                   (text-control item state owner :insulation_date "Insulation Date")
+                   (text-control item state owner :insulation_type "Insulation Type")
+                   (text-control item state owner :insulation_product "Insulation Product")
+                   (text-control item state owner :uvalue "U Value")
+                   (text-control item state owner :uvalue_derived "U Value Derived")]))]
+              [:p "No roofs recorded."]))])]))))
+
+(defn window-sets-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Window Sets"
+            (if-let [window-sets (seq (:window-sets profile))]
+              [:div
+               (for [item window-sets]
+                 (bs/panel
+                  "Window Set"
+                  [:div
+                   (text-control item state owner :window_type "Window Type")
+                   (text-control item state owner :frame_type "Frame Type")
+                   (text-control item state owner :frame_type_other "Frame Type Other")
+                   (text-control item state owner :percentage_glazing "Percentage Glazing")
+                   (text-control item state owner :area "Area")
+                   (text-control item state owner :location "Location")
+                   (text-control item state owner :uvalue "Uvalue")]))]
+              [:p "No window sets recorded."]))])]))))
+
+(defn door-sets-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Door Sets"
+            (if-let [door-sets (seq (:door-sets profile))]
+              [:div
+               (for [item door-sets]
+                 (bs/panel
+                  "Door Set"
+                  [:div
+                   (text-control item state owner :door_type "Door Type")
+                   (text-control item state owner :door_type_other "Door Type Other")
+                   (text-control item state owner :frame_type "Frame Type")
+                   (text-control item state owner :frame_type_other "Frame Type Other")
+                   (text-control item state owner :percentage_glazing "Percentage Glazing")
+                   (text-control item state owner :area "Area")
+                   (text-control item state owner :location "Location")
+                   (text-control item state owner :uvalue "U Value")]))]
+              [:p "No door sets recorded."]))])]))))
+
+
+(defn floors-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Floors"
+            (if-let [floors (seq (:floors profile))]
+              [:div
+               (for [item floors]
+                 (bs/panel
+                  "Floor"
+                  [:div
+                   (text-control item state owner :floor_type "Floor Type")
+                   (text-control item state owner :construction "Construction")
+                   (text-control item state owner :construction_other "Construction Other")
+                   (text-control item state owner :insulation_thickness_one "Insulation Thickness One")
+                   (text-control item state owner :insulation_thickness_two "Insulation Thickness Two")
+                   (text-control item state owner :insulation_type "Insulation Type")
+                   (text-control item state owner :insulation_product "Insulation Product")
+                   (text-control item state owner :uvalue "U Value")
+                   (text-control item state owner :uvalue_derived "Uvalue Derived")]))]
+              [:p "No floors recorded."]))])]))))
+
+(defn roof-rooms-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Door Sets"
+            (if-let [roof-rooms (seq (:roof-rooms profile))]
+              [:div
+               (for [item roof-rooms]
+                 (bs/panel
+                  "Door Set"
+                  [:div
+                   (text-control item state owner :location "Location")
+                   (text-control item state owner :age "Age")
+                   (text-control item state owner :insulation_placement "Insulation Placement")
+                   (text-control item state owner :insulation_thickness_one "Insulation Thickness One")
+                   (text-control item state owner :insulation_thickness_one_other "Insulation Thickness One Other")
+                   (text-control item state owner :insulation_thickness_two "Insulation Thickness Two")
+                   (text-control item state owner :insulation_thickness_two_other "Insulation Thickness Two Other")
+                   (text-control item state owner :insulation_date "Insulation Date")
+                   (text-control item state owner :insulation_type "Insulation Type")
+                   (text-control item state owner :insulation_product "Insulation Product")
+                   (text-control item state owner :uvalue "U Value")
+                   (text-control item state owner :uvalue_derived "Uvalue Derived")]))]
+              [:p "No roof rooms recorded."]))])]))))
+
+(defn low-energy-lights-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Low Energy Lights"
+            (if-let [low-energy-lights (seq (:low-energy-lights profile))]
+              [:div
+               (for [item low-energy-lights]
+                 (bs/panel
+                  "Low Energy Light"
+                  [:div
+                   (text-control item state owner :light_type "Light Type")
+                   (text-control item state owner :light_type_other "Light Type Other")
+                   (text-control item state owner :bed_index "Bed Index")
+                   (text-control item state owner :proportion "Proportion")]))]
+              [:p "No low energy lights recorded."]))])]))))
+
+(defn ventilation-systems-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Ventilation Systems"
+            (if-let [ventilation-systems (seq (:ventilation-systems profile))]
+              [:div
+               (for [item ventilation-systems]
+                 (bs/panel
+                  "Ventilation System"
+                  [:div
+                   (text-control item state owner :approach "Approach")
+                   (text-control item state owner :approach_other "Approach Other")
+                   (text-control item state owner :ventilation_type "Ventilation Type")
+                   (text-control item state owner :ventilation_type_other "Ventilation Type Other")
+                   (text-control item state owner :mechanical_with_heat_recovery "Mechanical With Heat Recovery")
+                   (text-control item state owner :manufacturer "Manufacturer")
+                   (text-control item state owner :ductwork_type "Ductwork Type")
+                   (text-control item state owner :ductwork_type_other "Ductwork Type Other")
+                   (text-control item state owner :controls "Controls")
+                   (text-control item state owner :controls_other "Controls Other")
+                   (text-control item state owner :manual_control_location "Manual Control Location")
+                   (text-control item state owner :operational_settings "Operational Settings")
+                   (text-control item state owner :operational_settings_other "Operational Settings Other")
+                   (text-control item state owner :installer "Installer")
+                   (text-control item state owner :installer_engineers_name "Installer Engineers Name")
+                   (text-control item state owner :installer_registration_number "Installer Registration Number")
+                   (text-control item state owner :commissioning_date "Commissioning Date")
+                   (text-control item state owner :total_installed_area "Total Installed Area")]))]
+              [:p "No ventilation systems lights recorded."]))])]))))
+
+(defn airflow-measurements-row [profiles owner]
+  (reify
+    om/IRenderState
+    (render-state [_ state]
+      (html
+       [:div.col-md-12
+        (for [profile profiles]
+          [:div {:class (profile-column-width)}
+           (bs/panel
+            "Air Flow Measurements"
+            (if-let [airflow-measurements (seq (:airflow-measurements profile))]
+              [:div
+               (for [item airflow-measurements]
+                 (bs/panel
+                  "Air Flow Measurements"
+                  [:div
+                   (text-control item state owner :reference "Reference")
+                   (text-control item state owner :system "System")
+                   (text-control item state owner :inspector "Inspector")
+                   (text-control item state owner :inspector_engineers_name "Inspector Engineers Name")
+                   (text-control item state owner :inspector_registration_number "Inspector Registration Number")
+                   (text-control item state owner :inspection_date "Inspection Date")
+                   (text-control item state owner :measured_low "Measured Low")
+                   (text-control item state owner :design_low "Design Low")
+                   (text-control item state owner :measured_high "Measured High")
+                   (text-control item state owner :design_high "Design High")]))]
+              [:p "No air flow measurements recorded."]))])]))))

 (defn profile-rows [profiles owner]
   (reify
@@ -547,7 +827,6 @@
          (om/build issues-row profiles)
          (om/build sap-results-row profiles)
          (om/build lessons-learnt-row profiles)
-         (om/build bus-survey-information-row profiles)
          (om/build dwelling-u-values-summary-row profiles)
          (om/build air-tightness-test-row profiles)
          (om/build bus-survey-information-row profiles)
@@ -559,16 +838,16 @@
          (om/build extensions-row profiles)
          (om/build heating-systems-row profiles)
          (om/build hot-water-systems-row profiles)
-         ;; (om/build storeys profiles)
-         ;; (om/build walls profiles)
-         ;; (om/build roofs profiles)
-         ;; (om/build window-types profiles)
-         ;; (om/build door-types profiles)
-         ;; (om/build floors profiles)
-         ;; (om/build roof-rooms profiles)
-         ;; (om/build low-energy-lights profiles)
-         ;; (om/build ventilation-systems profiles)
-         ;; (om/build airflow-measurements profiles)
+         (om/build storeys-row profiles)
+         (om/build walls-row profiles)
+         (om/build roofs-row profiles)
+         (om/build window-sets-row profiles)
+         (om/build door-sets-row profiles)
+         (om/build floors-row profiles)
+         (om/build roof-rooms-row profiles)
+         (om/build low-energy-lights-row profiles)
+         (om/build ventilation-systems-row profiles)
+         (om/build airflow-measurements-row profiles)

          ;; renewable energy systems
          ;; (om/build photovoltaic-panels profiles)


Remove obsolete functions from previous commit

--- src/clojure/frereth_cp/client/hello.clj
+++ src/clojure/frereth_cp/client/hello.clj
@@ -18,17 +18,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Specs
-
-;; Keep in mind that this is totally distinct from
-;; cookie/wait-for-cookie!
-;; It's annoying that the signatures are so similar
-;; That distinction no longer seems to be true.
-;; Q: Is this actually used anywhere?
-(s/def ::cookie-sent-callback-obsolete (s/fspec :args (s/cat :notifier ::specs/deferrable
-                                                    :timeout (s/and number?
-                                                                    (complement neg?))
-                                                    :this ::state/state
-                                                    :sent ::specs/network-packet)))

 ;; TODO: Move this somewhere shared so I can eliminate the duplication
 ;; with cookie/wait-for-cookie! without introducing awkward ns dependencies.
@@ -183,60 +172,6 @@
       (+ timeout (crypto/random-mod timeout)))))

 (declare do-polling-loop)
-(s/fdef cookie-result-callback
-        :args (s/cat :this ::state/state
-                     :cokie-response dfrd/deferrable?
-                     ;; Q: What is this?
-                     ;; A: It looks like it should be a ::cookie/success-callback
-                     ;; Since I'm trying to called dfrd/success! on it below,
-                     ;; that better not be the case
-                     ;; TODO: Either way, move that spec somewhere shared
-
-                     ;; Q: What is this?
-                     :actual-success any?)
-        :ret any?)
-(defn cookie-result-callback-obsolete
-  [{:keys [::log/logger]
-    log-state ::log/state
-    :as this}
-   ;; Q: Can this go away?
-   cookie-response
-   actual-success]
-  {:pre [actual-success]}
-  (throw (RuntimeException. "Never called anywhere"))
-  (let [now (System/nanoTime)]
-    ;; TODO: convert this to a log message
-    ;; (although, admittedly, it's really helpful for debugging)
-    (println "hello/cookie-result-callback: Received network packet:\n"
-             (::shared/network-packet actual-success))
-    (if (and (not (instance? Throwable actual-success))
-             (not (#{::sending-hello-timed-out
-                     ::awaiting-cookie-timed-out
-                     ::send-response-timed-out} actual-success)))
-      (do
-        (when-let [problem (s/explain-data ::state/cookie-response actual-success)]
-          (println "hello/cookie-result-callback Bad cookie response:" problem)
-          (dfrd/error! cookie-response
-                       (ex-info "Bad cookie response"
-                                {::error problem})))
-        ;; FIXME: Debug only
-        (println "hello/cookie-result-callback Cookie response was OK")
-        (let [log-state (try
-                          (log/info (::log/state actual-success)
-                                    ::do-polling-loop
-                                    "Might have found a responsive server")
-                          (catch Exception ex
-                            (println "client: Failed trying to log about potentially responsive server\n"
-                                     (log/exception-details ex))
-                            (dfrd/error! (ex-info "Logging failure re: server response" {::actual-success actual-success} ex))))]
-          (dfrd/success! cookie-response actual-success)))
-      (dfrd/success! cookie-response {::log/state (log/warn log-state
-                                                            ::do-polling-loop
-                                                            "Problem retrieving cookie"
-                                                            {;; Actually, if this is a Throwable,
-                                                             ;; we probably don't have a way
-                                                             ;; to recover
-                                                             ::outcome actual-success})}))))

 (s/fdef possibly-recurse
         :args (s/cat :this ::state/state
@@ -269,53 +204,6 @@
                (pick-next-timeout (count remaining-ips))
                remaining-ips)
       (throw (ex-info "No IPs left. Giving up" this)))))
-
-(s/fdef cookie-sent-obsolete
-        :args (s/cat :this ::state/state
-                     :raw-packet ::specs/network-packet
-                     :log-state-atom ::log/state-atom
-                     ;; TODO: Need a better name that isn't as
-                     ;; easily confused with ::state/cookie-response
-                     :cookie-response dfrd/deferrable?
-                     :cookie-waiter ::cookie-waiter
-                     :send-packet-success boolean?)
-        ;; Success returns a deferrable
-        ;; that resolves to a ::state/cookie-response.
-        ;; This is a nice feature of deferred/chain:
-        ;; the outcome is the same either way.
-        :ret (s/or :response dfrd/deferrable?
-                   :recursed ::state/cookie-response))
-(defn cookie-sent-obsolete
-  ;; TODO: Come up with a better name. do-polling-loop
-  ;; needs both this and a callback from the cookie
-  ;; ns that it's named cookie-sent-callback.
-  ;; Need to make them different enough that I won't
-  ;; get them snarled up.
-  [{:keys [::state/timeout
-           :state/server-ips]
-    :as this}
-   raw-packet
-   log-state-atom
-   cookie-response
-   cookie-waiter
-   send-packet-success]
-  (throw (RuntimeException. "never called"))
-  (if send-packet-success
-    ;; Note that this timeout actually can grow to be quite long.
-    ;; In the original, they probably add up to a ballpark of a minute.
-    ;; It's probably acceptable for a single polling thread to block for that
-    ;; long.
-    ;; Or, at least, it probably was back in 2011 when the spec was written,
-    ;; or in 2013 when my copy of the reference implementation was published.
-    ;; Q: Is that still reasonable today?
-    ;; Better Q: Is there a better alternative?
-    (dfrd/timeout! cookie-response timeout ::awaiting-cookie-timed-out)
-    ;; I'd really like to trampoline this. Realistically, we can't, because
-    ;; we're inside a deferred chain.
-    ;; TODO: Prove that, one way or another
-    (trampoline possibly-recurse
-                (assoc this ::log/state @log-state-atom)
-                server-ips cookie-waiter raw-packet)))

 (s/fdef cookie-retrieved
         :args (s/cat :this ::state/state


no comment

no comment

--- src/data_obtainer/obtain.clj
+++ src/data_obtainer/obtain.clj
@@ -10,7 +10,7 @@

 (defn obtain [configuration]
 	(let [{:keys [host port schema user password]} configuration]
-		(let [subname (str "//" host ":" port "/information_schema?profileSQL=true")]
+		(let [subname (str "//" host ":" port "/information_schema")]
 			(let [mysql-conn {:subprotocol "mysql" :subname subname :user user :password password}]
 				(let [time (java.sql.Timestamp. (.getTime (java.util.Date.)))] ; a(. System (nanoTime)) based timestamping implementation or no-system call service can be considered
 					(try


Namespaced keyword shenanigans

Namespaced keyword shenanigans

--- src/clj/shale/node_providers.clj
+++ src/clj/shale/node_providers.clj
@@ -93,20 +93,20 @@
         port-num (:containerPort port)]
     (str "http://" (-> pod :status :podIP) ":" port-num)))

-(defrecord KubeNodeProvider [api-url label port-name namespace]
+(defrecord KubeNodeProvider [api-url]
   INodeProvider
   (get-nodes [this]
     (assert (map? label))
     (assert (= 1 (count label)))
-    (let [label-key (-> label first key)
-          label-value (-> label first val)
-          ]
-      (->> (kube/list-pods api-url)
+    (let [label (:kube/label this)
+          label-key (-> label first key)
+          label-value (-> label first val)]
+      (->> (kube/list-pods api-url {:namespace (or (:kube/namespace this) "default")})
            :items
            (filter (fn [pod]
                      (-> pod :metadata :labels (get label-key) (= label-value))))
            (map (fn [pod]
-                  (selenium-url pod port-name))))))
+                  (selenium-url pod (:kube/port-name this)))))))
   (add-node [this url]
     (throw (ex-info "Adding nodes is not yet implemented."
                     {:user-visible true :status 500})))
@@ -122,13 +122,12 @@
 ;; (s/def :kube/namespace string?)

 ;; (s/fdef new-kube-node-provider :args (s/keys :req-un [:kube/api-url :kube/label :kube/port-name] :opt-un [:kube/namespace]))
-(defn new-kube-node-provider [{:keys [api-url label port-name namespace]
-                               :or {namespace "default"}
+(defn new-kube-node-provider [{:keys [api-url label port-name]
                                :as options}]
   "Use pods with the given kubernetes label. Label is a map containing a single key & value. port-name is the named container port to connect on"
   (assert (= :kube (:provider options)))
   (assert api-url)
-  (let [api-url (if (and api-url (keyword? api-url) (= "env" (namespace api-url)))
+  (let [api-url (if (and (keyword? api-url) (= "env" (namespace api-url)))
                   (do
                     (assert (get env/env (keyword (name api-url))))
                     (str "https://" (get env/env (keyword (name api-url)))))


Simplify test

Simplify test

--- src/clj/test/cards-resources.clj
+++ src/clj/test/cards-resources.clj
@@ -698,8 +698,8 @@
   "Salsette Slums - Once per turn, when the trash cost of a card is paid, optionally remove from the game"
   (do-game
     (new-game (default-corp [(qty "Hostile Infrastructure" 1) (qty "Tech Startup" 1) (qty "Thomas Haas" 1)
-                             (qty "Hedge Fund" 3) (qty "Restructure" 3) (qty "The Root" 3) (qty "Mumba Temple" 3)])
-              (default-runner [(qty "Salsette Slums" 2) (qty "Sure Gamble" 2) (qty "Hyperdriver" 1)]))
+                             (qty "Hedge Fund" 3)])
+              (default-runner [(qty "Salsette Slums" 2) (qty "Sure Gamble" 3)]))
     ; Use Hostile Infrastructure to ensure on-trash effects don't fire.
     (core/move state :corp (find-card "Hostile Infrastructure" (:deck (get-corp))) :hand)
     (core/move state :corp (find-card "Tech Startup" (:deck (get-corp))) :hand)
@@ -708,26 +708,22 @@
     (play-from-hand state :corp "Hostile Infrastructure" "New remote")
     (play-from-hand state :corp "Thomas Haas" "New remote")
     (take-credits state :corp)
-    ; Allows the main part of the test case to happen on one turn
-    (play-from-hand state :runner "Hyperdriver")
-    (take-credits state :runner)
-    (take-credits state :corp)
-    (card-ability state :runner (get-program state 0) 0)
     (play-from-hand state :runner "Salsette Slums")
     (play-from-hand state :runner "Salsette Slums")
-    ; Sanity check
-    (is (= 3 (:credit (get-runner))))
+    (core/gain state :runner :credit 2)
+    (core/gain state :runner :click 4)
     (let [ts1 (get-content state :remote1 0)
           hostile2 (get-content state :remote2 0)
           th3 (get-content state :remote3 0)
           salsette1 (get-resource state 0)
           salsette2 (get-resource state 1)]
+      (is (= 3 (count (:hand (get-runner)))) "Runner started this part with three cards in hand")
       (core/rez state :corp hostile2)
       (run-empty-server state "Server 1")
       (is (not (empty? (:prompt (get-runner)))) "Prompting to trash.")
       (card-ability state :runner salsette1 0)
       (is (empty? (:prompt (get-runner))) "All prompts done")
-      (is (= 2 (count (:hand (get-runner)))) "On-trash ability of other Hostile didn't fire")
+      (is (= 3 (count (:hand (get-runner)))) "On-trash ability of other Hostile didn't fire")
       (is (= (:cid ts1) (:cid (last (:rfg (get-corp))))) "Tech Startup was removed from game")
       (is (= 2 (:credit (get-runner))) "Runner paid the trash cost.")
       (is (not (:run @state)) "Run is over")
@@ -752,12 +748,9 @@
       (card-ability state :runner salsette2 1)
       (is (not (empty? (:prompt (get-runner)))) "Prompting the runner to choose a card")
       (prompt-select :runner (find-card "Thomas Haas" (:discard (get-corp))))
-      (is (= (:cid th3) (:cid (last (:rfg (get-corp))))) "Card was removed from the game")
-      (take-credits state :runner))
+      (is (= (:cid th3) (:cid (last (:rfg (get-corp))))) "Card was removed from the game"))
     ; Set things up so we can trash the Hostile and then make sure we can't "oops I forgot on a later turn"
-    (take-credits state :corp)
-    (take-credits state :runner)
-    (take-credits state :corp)
+    (core/gain state :runner :credit 5)
     (run-empty-server state :remote2)
     (prompt-choice :runner "Yes")
     (take-credits state :runner)


Setting a last-modified for the graph API for every 24 hours

Likely setting this live soon, so this will help reduce some of the
load for the back end. The data doesn't change that often now that we
have already crawled all the nodes once.

--- src/clj/tropology/routes/api.clj
+++ src/clj/tropology/routes/api.clj
@@ -7,6 +7,11 @@
             [tropology.api :as api]
             [tropology.db :as db]
             [io.clojure.liberator-transit]))
+
+
+(def expiration-ms (* 1000 60 60 24))                       ; Graphs expire once a day
+(defn default-last-modified []
+  (* expiration-ms (long (/ (System/currentTimeMillis) expiration-ms))))

 (defresource home
              :handle-ok "Hello World!"
@@ -38,6 +43,7 @@

 (defresource network
              :allowed-methods [:get]
+             :last-modified (default-last-modified)
              :handle-ok (fn [request]
                           (let [{{{label :category, name :name} :params} :request} request
                                 code (lower-case (str label "/" name))]
@@ -53,6 +59,7 @@
                         (let [{{{label :category, name :name} :params} :request} request
                               code (lower-case (str label "/" name))]
                           (api/tropes-from-node code)))
+             :last-modified (default-last-modified)
              :handle-ok (fn [request]
                           (select-keys request [:title :description :references :code :display :image]))
              :available-media-types ["application/transit+json"


refine pseudo account logic

refine pseudo account logic

--- src/clj_money/models/reports.clj
+++ src/clj_money/models/reports.clj
@@ -175,44 +175,41 @@
 (defn- append-equity-pseudo-account
   [account-groups caption value]
   (update-in account-groups
-               [2]
-               (fn [entry]
-                 (-> entry
-                     (update-in [:accounts] #(conj %
-                                                   {:name caption
-                                                    :balance value
-                                                    :children-balance 0}))
-                     (update-in [:value] #(+ % value))))))
-
-(defn- append-retained-earnings
-  [account-groups]
-  (let [summary (->> account-groups
-                     (map (juxt :type :value))
-                     (into {}))
-        value (- (:income summary) (:expense summary))
-        caption (if (< value 0)
-                  "Retained Losses"
-                  "Retained Earnings")]
-    (append-equity-pseudo-account account-groups
-                                  caption
-                                  value)))
-
-(defn- append-unrealized-gains
-  [account-groups storage-spec entity-id as-of]
-  account-groups
-  (let [value (lots/unrealized-gains storage-spec entity-id as-of)
-        caption (if (< value 0)
-                  "Unrealized Losses"
-                  "Unrealized Gains")]
-    (append-equity-pseudo-account account-groups
-                                  caption
-                                  value)))
-
-(defn- append-calculated-values
+             [2]
+             (fn [entry]
+               (-> entry
+                   (update-in [:accounts] #(concat %
+                                                   [{:name caption
+                                                     :balance value
+                                                     :children-balance 0}]))
+                   (update-in [:value] #(+ % value))))))
+
+(def ^:private pseudo-accounts
+  [{:positive-caption "Retained Earnings"
+    :negative-caption "Retained Losses"
+    :calc-fn #(let [summary (->> (:account-groups %)
+                             (map (juxt :type :value))
+                             (into {}))]
+            (- (:income summary) (:expense summary))) }
+   {:positive-caption "Unrealized Gains"
+    :negative-caption "Unrealized Losses"
+    :calc-fn #(lots/unrealized-gains (:storage-spec %)
+                                (:entity-id %)
+                                (:as-of %))}])
+
+(defn- append-pseudo-accounts
   [storage-spec entity-id as-of account-groups]
-  (-> account-groups
-      append-retained-earnings
-      (append-unrealized-gains storage-spec entity-id as-of)))
+  (reduce (fn [result {:keys [calc-fn negative-caption positive-caption]}]
+            (let [value (calc-fn {:storage-spec storage-spec
+                                  :entity-id entity-id
+                                  :as-of as-of
+                                  :account-groups result})
+                  caption (if (< value 0)
+                            negative-caption
+                            positive-caption)]
+              (append-equity-pseudo-account result caption value)))
+          account-groups
+          pseudo-accounts))

 (defn balance-sheet
   "Returns the data used to populate a balance sheet report"
@@ -225,7 +222,7 @@
           storage-spec
           entity-id)
         (set-balances-in-account-groups storage-spec as-of)
-        (append-calculated-values storage-spec entity-id as-of)
+        (append-pseudo-accounts storage-spec entity-id as-of)
         transform-balance-sheet)))

 (defn- ->budget-report-record


Bouncy/derpy pong!

Bouncy/derpy pong!

--- src/cljs/clj_mini_apps/pong.cljs
+++ src/cljs/clj_mini_apps/pong.cljs
@@ -1,8 +1,8 @@
 (ns clj-mini-apps.pong
-	(:require [quil.core :as q :include-macros true]
+  (:require [quil.core :as q :include-macros true]
             [quil.middleware :as m]
             [jayq.core :refer [$]]
-	          [jayq.util :refer [log]]))
+            [jayq.util :refer [log]]))

 (defn ^:export init []
   (when (and js/document (.-getElementById js/document))
@@ -18,22 +18,29 @@

 (defn init-game []
   (log "init-game")
-  ;Create background and outline
-  (q/frame-rate 60)
-  (q/smooth)
-  (q/background 209 209 210)
-  (q/fill 255)
-  (q/no-stroke)
-  (q/rect 9 9 1082 482)
-  ;Create paddles and ball
-  (q/fill 0)
-  (q/rect-mode :center)
-  (q/rect 59 250 20 100)
-  (q/rect 1040 250 20 100)
-  (q/ellipse 550 250 ball-size ball-size)
-  {:player {:x 59 :y 250} :computer {:x 1040 :y 250} :ball {:x 550 :y 250}})

-(defn move-player-paddle
+  (do
+    (q/rect-mode :corner)
+    ;Create background and outline
+    (q/frame-rate 60)
+    (q/smooth)
+    (q/background 209 209 210)
+    (q/fill 255)
+    (q/no-stroke)
+    (q/rect 9 9 1082 482)
+    ;Create paddles and ball
+    (q/fill 0)
+    (q/rect-mode :center)
+    (q/rect 59 250 20 100)
+    (q/rect 1040 250 20 100)
+    (q/ellipse 550 250 ball-size ball-size))
+
+  {:player {:x 59 :y 250}
+   :computer {:x 1040 :y 250}
+   :ball {:x 550 :y 250}
+   :is-running? false})
+
+(defn move-player-paddle
   [state direction]
   ;(log "move-player-paddle")
   (if (= direction :down)
@@ -46,14 +53,14 @@
   (if (= 2 (count (:ball state)))
     (as-> state state
       (assoc-in state [:ball :x-dir] (rand-nth [+ -]))
-      (assoc-in state [:ball :y-dir] (rand-nth [+ -]))
+      (assoc-in state [:ball :y-dir] (rand-nth [+ -]))
       (update-ball state))
     state))

 (defn update-ball
   [state]
   ;(log "update-ball")
-  (if (= 4 (count (state :ball)))
+  (if (:is-running? state)
     (as-> state state
       (update-in state [:ball :y] (:y-dir (:ball state)) ball-speed)
       (update-in state [:ball :x] (:x-dir (:ball state)) ball-speed))
@@ -64,44 +71,58 @@
   (condp = (q/key-as-keyword)
     :w (move-player-paddle state :up)
     :s (move-player-paddle state :down)
-    (keyword " ") (start-game state)
+    (keyword " ") (-> state
+                      (update-in [:is-running?] not)
+                      (start-game))
+    :r (init-game)
     state))

-#_(defn collision [state]
-  (let [ball-x (:x (:ball state))]
-       [ball-y (:y (:ball state))]
-       [new-y-dir (if (= + (:y-dir (:ball state)))
-                      -
-                      +)])
-  ;Check wall collision
-  (if (not (and (> ((:y-dir (state :ball)) ball-speed ball-y) (16.5))
-                (< ((:y-dir (state :ball)) ball-speed ball-y) (- 490 7.5))))
-    (as-> state state
-      (assoc-in state [:ball :y-dir] new-y-dir)
-      (if (= new-y-dir +)
-        (assoc state [:ball :y] 16.5)
-        (assoc state [:ball :y] 490))
-      (update-in state [:ball :y] (:y-dir (:ball state)) ball-speed))
-    (update-ball state)))
+(defn on-collision [state]
+  (let [ball-x (:x (:ball state))
+        ball-y (:y (:ball state))
+        new-y-dir (if (= + (:y-dir (:ball state))) - +)
+        _ (log (str (new-y-dir 0 1)))]
+    (log "on-collision")
+    ;Check wall collision
+    (if (not (and (> ((:y-dir (state :ball)) ball-speed ball-y)
+                     (+ 9 7.5))
+                  (< ((:y-dir (state :ball)) ball-speed ball-y)
+                     (- 490 7.5))))
+      (as-> state state
+        (assoc-in state [:ball :y-dir] new-y-dir)
+        (if (= (:y-dir state) -)
+          (assoc-in state [:ball :y] 50)
+          (assoc-in state [:ball :y] 450))
+        ;(update-in state [:ball :x] (:x-dir (:ball state)) ball-speed)
+        )
+      state)))

 (defn draw-game
   [state]
   ;(log "draw-game")
-  (log (:x-dir (:ball state)))
-  (q/rect-mode :corner)
-  (q/fill 255)
-  (q/rect 9 9 1082 482)
-  ;Create paddles and ball
-  (q/fill 0)
-  (q/rect-mode :center)
-  (q/rect ((state :player) :x) ((state :player) :y) 20 100)
-  (q/rect ((state :computer) :x) ((state :computer) :y) 20 100)
-  (q/ellipse ((state :ball) :x) ((state :ball) :y) ball-size ball-size))
+
+  (do
+    (q/rect-mode :corner)
+    (q/fill 255)
+    (q/rect 9 9 1082 482)
+    ;Create paddles and ball
+    (q/fill 0)
+    (q/rect-mode :center))
+
+  (q/rect ((state :player) :x)
+          ((state :player) :y) 20 100)
+  (q/rect ((state :computer) :x)
+          ((state :computer) :y) 20 100)
+  (q/ellipse ((state :ball) :x)
+             ((state :ball) :y) ball-size ball-size))

 (defn update-game
   [state]
-  (-> state
-    (update-ball)))
+  (if (:is-running? state)
+    (-> state
+        (update-ball)
+        (on-collision))
+    state))

 (q/defsketch pong-canvas
   :size [1100 500]
@@ -109,4 +130,4 @@
   :key-pressed handle-input
   :draw draw-game
   :update update-game
-  :middleware [m/fun-mode])+  :middleware [m/fun-mode])


Do not add a hyphenation to the DOM

Do not add a hyphenation to the DOM

Just reset all fields

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -39,11 +39,18 @@
             :response-format :json
             :keywords? true))

+(defn reset-all! []
+  (reset! feedback {:message "Word successfully added" :kind :success})
+  (reset! word "")
+  (reset! hyphenation "")
+  (reset! suggested-hyphenation "")
+  (load-hyphenation-patterns! @spelling @word))
+
 (defn add-hyphenation-pattern!
   [pattern]
   (ajax/POST "/api/words"
              :params pattern
-             :handler (fn [] (add-hyphenation! pattern))
+             :handler (fn [] (reset-all!))
              :error-handler (fn [details]
                               (.warn js/console
                                      (str "Failed to add hyphenation pattern: " details)))
@@ -114,16 +121,15 @@
        :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

 (defn- hyphenation-add-button []
-  [:button.btn.btn-default
-   {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
-                 (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling})
-                 (reset! word "")
-                 (reset! hyphenation ""))
-    :disabled (when (or (string/blank? @word)
-                        (not (hyphenation-valid? @hyphenation))
-                        (= @hyphenation @suggested-hyphenation))
-                "disabled")}
-   "Add"])
+  [:div.form-group
+   [:button.btn.btn-default
+    {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
+                  (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
+     :disabled (when (or (string/blank? @word)
+                         (not (hyphenation-valid? @hyphenation))
+                         (= @hyphenation @suggested-hyphenation))
+                 "disabled")}
+    "Add"]])

 (defn spelling-filter []
   [:div.form-group


Added access to the content reader object (useful for getting special properties of a node like file size).

--- src/clojure/alfresco/content.clj
+++ src/clojure/alfresco/content.clj
@@ -26,6 +26,12 @@
   "Retrieves an InputStream of the content for the provided node"
   [node]
   (.getContentInputStream (.getReader (content-service) node ContentModel/PROP_CONTENT)))
+
+(defn get-reader
+  "Returns the ContentReader for the given node & property (defaults to cm:content).
+  Should not normally be used directly - read! is preferable."
+  ([node]          (get-reader node ContentModel/PROP_CONTENT))
+  ([node property] (.getReader (content-service) node property)))

 ;; as seen on
 ;; https://groups.google.com/group/clojure/browse_thread/thread/e5fb47befe8b9199


Adds helper function for starting cljs repl

--- env/dev/clj/chess/dev.clj
+++ env/dev/clj/chess/dev.clj
@@ -14,3 +14,6 @@
      (append  (html [:script {:type "text/javascript"} "goog.require('chess.dev')"]))
      ))

+(defn cljs-repl []
+  (figwheel-sidecar.repl-api/cljs-repl))
+


[outputs] incremental changes to how model outputs are checked.

--- keras/src/think/cortex/keras/core.clj
+++ keras/src/think/cortex/keras/core.clj
@@ -446,20 +446,31 @@
 (defn- associate-layer-outputs
   "Output a layer output per desc associated with that desc.
   Output may be nil for a given desc."
-  [desc-seq output-seq]
-  (loop [desc (first desc-seq)
-         desc-seq (rest desc-seq)
-         output-seq output-seq
-         retval []]
-    (if desc
-      (let [[retval output-seq] (if (:embedded-activation desc)
-                                  [(conj retval [desc nil]) output-seq]
-                                  [(conj retval [desc (if (contains? desc :embedded)
-                                                        (assoc (first output-seq) :layer-type :Activation)
-                                                        (first output-seq))])
-                                   (rest output-seq)])]
-        (recur (first desc-seq) (rest desc-seq) output-seq retval))
-      retval)))
+  [desc-seq output-map]
+  (mapv (fn [[_ lyr-map]]
+          (if-let [matching-output (-> lyr-map :id output-map)]
+            (if-not (:embedded-activation lyr-map)
+              [lyr-map matching-output]
+              [lyr-map nil])
+            (cond
+              (:embedded lyr-map) [lyr-map (get output-map (:embedded lyr-map))]
+              (= :input (:type lyr-map))     [lyr-map nil]
+              :else (throw (ex-info "No matching output for layer!"
+                      {:cause :missing-output
+                       :layer lyr-map})))))
+        desc-seq))
+
+(defn- check-output-dims
+  [desc-outputs]
+  (->> desc-outputs
+       (filter second)
+       (map (fn [[lyr output]]
+              (when (not= (:output-size lyr)
+                          (first (m/shape output)))
+                   {:id          (:id lyr)
+                    :model-dims  (:output-size lyr)
+                    :output-dims (m/shape output)})))
+       (filter (complement nil?))))

 (defn- reshape-layer-outputs
@@ -529,3 +540,16 @@
       {:model weight-desc
        :input input
        :layer-outputs (mapv :data layer-outputs)})))
+
+
+(defn load-sidecar-files
+  [json-file weights-h5-file output-file]
+  (resource/with-resource-context
+    (let [model-desc (model->description json-file weights-h5-file)
+          printer    (fn [item]
+                       (clojure.pprint/pprint item)
+                       item)
+          outputs    (-> output-file
+                         hdf5-child-map)]
+      outputs)))
+


Allow action functions to return a boolean (not just true), and better document what the return values mean

--- src/main/clojure/cascade/dispatcher.clj
+++ src/main/clojure/cascade/dispatcher.clj
@@ -18,7 +18,7 @@
   (:import (javax.servlet ServletResponse))
   (:use
     cascade
-    (cascade asset config dom logging path-map pipeline fail func-utils)
+    (cascade asset config dom logging path-map pipeline fail func-utils utils)
     (cascade.internal utils)))

 (defn prepare-dom-for-render
@@ -103,7 +103,7 @@
         ; Invoke the function, getting back a lazy seq of rendered nodes
         dom (view-fn env)
         ; Force those nodes to render top to bottom. This is only necessary
-        ; since need to force side effects before calling prepare-dom-for-render
+        ; since we need to force side effects before calling prepare-dom-for-render
         _ (force-dom dom)
         prepared (prepare-dom-for-render env dom)]
     (debug "Streaming XML response")
@@ -139,13 +139,16 @@

 (defn default-handle-action
   "Default dispatcher to an action function, responsible for passing the env to the
-   function, and for interpreting the return value."
+   function, and for interpreting the return value. Actions may return a boolean: true
+   means that the action already provided a response, nil or false indicates that the servlet
+   container should provide a default response. Actions may also return a function, which
+   must be a view function, which will be rendered. Other return values are an error."
   [env action-fn]
   (debug "Invoking action function %s" (qualified-function-name action-fn))
   (let [result (action-fn env)]
-    (cond
-      ;;  TODO: This should be an multimethod for extensibility
-      (true? result) true
+    (cond
+      (boolean? result) result
+      (nil? result) false
       (function? result) (render-view env result)
       :otherwise (fail "Unexpected response value %s from %s." (ppstring result) (qualified-function-name action-fn)))))


single: log what node a process uses

single: log what node a process uses

--- src/jepsen/voltdb/single.clj
+++ src/jepsen/voltdb/single.clj
@@ -25,8 +25,8 @@
       :strong-reads?                 Whether to perform normal or strong selects
       :procedure-call-timeout       How long in ms to wait for proc calls
       :connection-response-timeout  How long in ms to wait for connections"
-  ([opts] (client nil opts))
-  ([conn opts]
+  ([opts] (client nil nil opts))
+  ([conn node opts]
    (let [initialized? (promise)]
      (reify client/Client
        (setup! [_ test node]
@@ -57,9 +57,10 @@
                (catch RuntimeException e
                  (voltdb/close! conn)
                  (throw e))))
-           (client conn opts)))
+           (client conn node opts)))

        (invoke! [this test op]
+         (info "Process " (:process op) "using node" node)
          (try
            (let [id     (key (:value op))
                  value  (val (:value op))]


Changed parameter to recieve a higher-order function

--- src/journal_creator/core.clj
+++ src/journal_creator/core.clj
@@ -1,6 +1,5 @@
 (ns journal-creator.core
   (require [clj-time.core     :as t]
-           [clj-time.local    :as l]
            [clj-time.periodic :as p]
            [clj-time.format   :as f]))

@@ -13,32 +12,28 @@
 (defn get-today []
   (t/to-time-zone (t/now) (t/default-time-zone)))

-(defn parse-date [date format]
-  (f/unparse (f/formatter-local format) date))
+(defn parse-date-generator [date]
+  (fn [format] (f/unparse (f/formatter-local format) date)))

-(defn get-journal-header-str [date]
-  (->
-    date
-    #(parse-date % "MMMM dd, yyyy, EEEE")
-    #(str "= " % " - <SUMMARY GOES HERE> =")))
+(defn get-journal-header-str [date-parser]
+  (-> (date-parser "MMMM dd, yyyy, EEEE")
+      #(str "= " % " - <SUMMARY GOES HERE> =")))

-(defn get-filename-extension-str [date]
-  (->
-    date
-    #(parse-date "yyyy-MM-dd" %)
-    #(str % ".wiki")))
+(defn get-filename-extension-str [date-parser]
+  (-> (date-parser "yyyy-MM-dd")
+      #(str % ".wiki")))

 (defn save [day]
-  (let [filename (get-filename-extension-str day)
-        header (get-journal-header-str day)]
+  (let [date-parser-function (parse-date-generator day)
+        filename (get-filename-extension-str date-parser-function)
+        header (get-journal-header-str date-parser-function)]
     (spit filename header)))

 (defn iterate-times [times]
   (let [current-date (get-today)]
-  (map #(save %)
-       (time-range current-date
-                   (t/plus current-date (t/days times)) (t/days 1)))))
+    (map #(save %)
+         (time-range current-date
+                     (t/plus current-date (t/days times)) (t/days 1)))))

-(defn -main [& args]
-  (prn "args: " args)
+(defn -main [& args]
   (iterate-times (read-string (first args))))


remove debug logging

remove debug logging

--- test/clj/backtype/storm/nimbus_test.clj
+++ test/clj/backtype/storm/nimbus_test.clj
@@ -31,7 +31,6 @@
                {task {:node+port node+port :taskbeats taskbeats}}))))

 (defn do-task-heartbeat [cluster storm-id task-id task->node+port+taskbeats]
-  (log-message "TASKBATS: " task->node+port+taskbeats)
   (let [state (:storm-cluster-state cluster)
         [node port] (-> task->node+port+taskbeats (get task-id) :node+port)
         taskbeats (-> task->node+port+taskbeats (get task-id) :taskbeats)]


cleanup step in aggregates

cleanup step in aggregates

--- tutorial/aggregates.clj
+++ tutorial/aggregates.clj
@@ -94,9 +94,8 @@
        [?a :db/valueType ?vt]]
      db)

+(repl/delete-scratch-dbs "config.edn")

-
-


More sensible conditional & comment.

More sensible conditional & comment.

--- frontend/components/project/common.cljs
+++ frontend/components/project/common.cljs
@@ -22,8 +22,12 @@
                     ;; only bug them if < 20 days left in trial
                     ;; note that this includes expired trials
                     (< (plan-model/days-left-in-trial plan) 20)
-                    (or (not (plan-model/freemium? plan))
-                        (not (plan-model/trial-over? plan)))]]
+
+                    ;; only show freemium trial notices if the
+                    ;; trial is still active.
+                    (if (plan-model/freemium? plan)
+                      (not (plan-model/trial-over? plan))
+                      true)]]
     (utils/mlog (gstring/format "show-trial-notice? has conditions %s days left %d"
                                 conditions (plan-model/days-left-in-trial plan)))
     (every? identity conditions)))