date picker WIP  - cleanup post review. Simplify using range and map over dates

--- src/re_com/date.cljs
+++ src/re_com/date.cljs
@@ -48,7 +48,8 @@
                     ;; override position from css because we are inline
                     :style {:font-size "13px"
                             :position "static"
-                            :-webkit-user-select "none"}} table-div]]])
+                            :-webkit-user-select "none" ;; only good on webkit/chrome what do we do for firefox etc
+                            }} table-div]]])

 (defn- table-thead
@@ -67,7 +68,7 @@

 (defn- table-td
-  [date column focus-month]
+  [date focus-month]
   ;;Cells which represent days not in focus month are subdued
   ;;TODO: only allow Sundays to be selected, highlight ?
   (if (= focus-month (month date))
@@ -75,28 +76,28 @@
     [:td {:class "available off" } (day date)]))

+
 (defn- table-tr
   "Return 7 columns of date cells from date inclusive."
-  [date focus-month week-row-ix]
+  [date focus-month]
   ;;TODO: Add first column to show week number.
-  (let [week-start (inc-date date (* 7 week-row-ix))
-        columns    (take-while (partial > 7) (iterate inc 0))]
-    (into [:tr] (map #(table-td (inc-date week-start %) % focus-month) columns))))
+  (into [:tr] (map #(table-td (inc-date date %) focus-month) (range 7))))

 (defn- table-tbody
   "Return matrix of 7 x 6 table cells representing 41 days from start-date inclusive"
   [current]
-  (let [current-start (->previous-sunday current)
-        focus-month   (month current)
-        rows          (take-while (partial > 6) (iterate inc 0))]
-    (into [:tbody] (map #(table-tr current-start focus-month %) rows))))
+  (let [current-start   (->previous-sunday current)
+        focus-month     (month current)
+        row-start-dates (map #(inc-date current-start (* 7 %)) (range 6))]
+    (into [:tbody] (map #(table-tr % focus-month) row-start-dates))))

 (trace-forms {:tracer default-tracer}
 (defn inline-date-picker
   [& {:keys [model]}]
   ;;TODO: add args handling for :minimum :maximum :show-weeks :disabled :on-change :allow
+  ;;TODO: Pass thorugh on-change call back to table-tbody, table-tr, table-td
   (let [current (reagent/atom (first-day-of-the-month @model))]
     (fn []
       (main-div-with


Correct parameters docs on Tab

Correct parameters docs on Tab

--- src/re_com/tabs.cljs
+++ src/re_com/tabs.cljs
@@ -11,7 +11,7 @@

 (def tabs-args-desc
   [{:name :model     :required true  :type "a tab id | atom" :description "the :id of the currently selected tab."}
-   {:name :tabs      :required true  :type "vector of maps"  :description "one element in the vector for each tab. In each map, at least :id and :label."}
+   {:name :tabs      :required true  :type "vector of maps | atom"  :description "one element in the vector for each tab. In each map, at least :id and :label."}
    {:name :on-change :required true  :type "(:id) -> nil"    :description "called when user alters the selection. Passed the :id of the selection."}])

 (def tabs-args


Ring uses Middleware Endpoint & polish

Ring uses Middleware Endpoint & polish

--- src/reitit/ring.cljc
+++ src/reitit/ring.cljc
@@ -6,7 +6,6 @@

 (def http-methods #{:get :head :patch :delete :options :post :put})
 (defrecord Methods [get head post put delete trace options connect patch any])
-(defrecord Endpoint [meta handler])

 (defn- group-keys [meta]
   (reduce-kv
@@ -56,30 +55,22 @@
               (update acc method expand opts)
               acc)) meta http-methods)])

-(defn compile-handler [[path meta] opts]
+(defn compile-result [[path meta] opts]
   (let [[top childs] (group-keys meta)]
     (if-not (seq childs)
-      (map->Methods
-        {:any (map->Endpoint
-                {:handler (middleware/compile-handler [path top] opts)
-                 :meta top})})
-      (let [any-handler (if (:handler top) (middleware/compile-handler [path meta] opts))]
+      (let [middleware (middleware/compile-result [path top] opts)]
+        (map->Methods {:any (middleware/compile-result [path top] opts)}))
+      (let [any-handler (if (:handler top) (middleware/compile-result [path meta] opts))]
         (reduce-kv
           (fn [acc method meta]
-            (let [meta (meta-merge top meta)
-                  handler (middleware/compile-handler [path meta] opts method)]
-              (assoc acc method (map->Endpoint
-                                  {:handler handler
-                                   :meta meta}))))
-          (map->Methods
-            {:any (map->Endpoint
-                    {:handler (if (:handler top) (middleware/compile-handler [path meta] opts))
-                     :meta top})})
+            (let [meta (meta-merge top meta)]
+              (assoc acc method (middleware/compile-result [path meta] opts method))))
+          (map->Methods {:any any-handler})
           childs)))))

 (defn router
   ([data]
    (router data nil))
   ([data opts]
-   (let [opts (meta-merge {:coerce coerce-handler, :compile compile-handler} opts)]
+   (let [opts (meta-merge {:coerce coerce-handler, :compile compile-result} opts)]
      (reitit/router data opts))))


better CLI parsing

better CLI parsing

--- src/clojure/zensols/actioncli/parse.clj
+++ src/clojure/zensols/actioncli/parse.clj
@@ -13,6 +13,11 @@
 (def ^:dynamic *log-error*
   "Log exceptions in [[handle-exception]]."
   false)
+
+(def ^:dynamic *rethrow-error*
+  "When not dying on error with [[*dump-jvm-on-error*]] also don't rethrow the
+  exception in [[handle-exception]]."
+  true)

 (defa- program-name-inst "prog")

@@ -153,7 +158,7 @@
                            (.toString e)))))))
   (if *dump-jvm-on-error*
     (System/exit 1)
-    (throw e)))
+    (if *rethrow-error* (throw e))))

 (defmacro with-exception
   "Wrap a CLI forms in a `try` and call [[handle-exception]] if an exception


left and right arrows

left and right arrows

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -67,8 +67,8 @@
                                     ;:strokeThickness 1
                                     ))

-(def left "←")
-(def right "→")
+(defonce left "←")
+(defonce right "→")

 (defonce scroll-text
@@ -79,7 +79,7 @@
 ;; font preloader channel
 ;;
 (defonce render! (go
-                   (<! (events/wait-time 2000))
+                   (<! (events/wait-time 1000))
                    (sprite/set-pos! dummy-text -100000 -10000)
                    (sprite/set-pos! test-text 0 0)
                    (.addChild (-> canvas :layer :ui) dummy-text)
@@ -222,6 +222,8 @@
           (sprite/set-pos! right-arrow 200 0.0)
           (sprite/set-scale! left-arrow 2)
           (sprite/set-scale! right-arrow 2)
+          (sprite/set-alpha! left-arrow 0.5)
+          (sprite/set-alpha! right-arrow 0.5)
           (.addChild (-> canvas :layer :ui) left-arrow)
           (.addChild (-> canvas :layer :ui) right-arrow)
           (go (loop [n 0]


local state in search removed

local state in search removed

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/search.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/search.cljs
@@ -3,64 +3,54 @@
             [iwaswhere-web.utils.misc :as u]
             [iwaswhere-web.utils.parse :as p]
             [clojure.string :as s]
-            [clojure.set :as set]
-            [reagent.core :as rc]))
+            [clojure.set :as set]))

 (defn search-field-view
   [snapshot put-fn query-id]
-  (let [local (rc/atom {:current-query (p/parse-search "")})
-        update-search (fn [] (put-fn [:search/update
-                                       (merge {:query-id query-id}
-                                              (:current-query @local))]))]
-    (update-search)
-    (fn [snapshot put-fn query-id]
-      (let [get-tags #(% (:current-query @local))
-            local-snapshot @local
-            before-cursor (h/string-before-cursor
-                            (:search-text (:current-query @local)))
-            show-pvt? (:show-pvt (:cfg snapshot))
-            hashtags (:hashtags (:cfg snapshot))
-            pvt-hashtags (:pvt-hashtags (:cfg snapshot))
-            hashtags (if show-pvt? (set/union hashtags pvt-hashtags) hashtags)
-            mentions (:mentions (:cfg snapshot))
-            [curr-tag f-tags] (p/autocomplete-tags before-cursor "#" hashtags)
-            [curr-mention f-mentions] (p/autocomplete-tags before-cursor "@" mentions)
-            on-input-fn (fn [ev]
-                          (let [search (p/parse-search
-                                         (aget ev "target" "innerText"))]
-                            (swap! local assoc-in [:current-query] search)
-                            (update-search)))
-            tag-replace-fn
-            (fn [curr-tag tag]
-              (let [curr-tag-regex (js/RegExp (str curr-tag "(?!" p/tag-char-cls ")") "i")
-                    search-text (:search-text (:current-query @local))
-                    new-search (p/parse-search (s/replace search-text curr-tag-regex tag))]
-                (swap! local assoc-in [:current-query] new-search)
-                (update-search)))
-            on-keydown-fn
-            (fn [ev]
-              (let [key-code (.. ev -keyCode)]
-                (when (= key-code 9)          ; TAB key pressed
-                  (when (and curr-tag (seq f-tags))
-                    (tag-replace-fn curr-tag (first f-tags)))
-                  (when (and curr-mention (seq f-mentions))
-                    (tag-replace-fn curr-mention (first f-mentions)))
-                  ;(.setTimeout js/window (fn [] (h/focus-on-end (.-target ev))) 50)
-                  (.preventDefault ev))))]
-        [:div.search
-         [:div.hashtags
-          (for [tag (get-tags :tags)]
-            ^{:key (str "search-" tag)}
-            [:span.hashtag tag])
-          (for [tag (get-tags :not-tags)]
-            ^{:key (str "search-n" tag)}
-            [:span.hashtag.not-tag tag])
-          (for [tag (get-tags :mentions)]
-            ^{:key (str "search-" tag)}
-            [:span.mention tag])]
-         [:div.search-field {:content-editable true
-                             :on-input         on-input-fn
-                             :on-key-down      on-keydown-fn}
-          (:search-text (:current-query local-snapshot))]
-         [u/suggestions "search" f-tags curr-tag tag-replace-fn "hashtag"]
-         [u/suggestions "search" f-mentions curr-mention tag-replace-fn "mention"]]))))
+  (let [current-query (query-id (:current-query snapshot))
+        update-search-fn (fn [search-str]
+                           (put-fn [:search/update
+                                    (merge {:query-id query-id}
+                                           (p/parse-search search-str))]))
+        get-tags #(% current-query)
+        before-cursor (h/string-before-cursor (:search-text current-query))
+        show-pvt? (:show-pvt (:cfg snapshot))
+        hashtags (:hashtags (:cfg snapshot))
+        pvt-hashtags (:pvt-hashtags (:cfg snapshot))
+        hashtags (if show-pvt? (set/union hashtags pvt-hashtags) hashtags)
+        mentions (:mentions (:cfg snapshot))
+        [curr-tag f-tags] (p/autocomplete-tags before-cursor "#" hashtags)
+        [curr-mention f-mentions] (p/autocomplete-tags before-cursor "@" mentions)
+        on-input-fn (fn [ev] (update-search-fn (aget ev "target" "innerText")))
+        tag-replace-fn
+        (fn [curr-tag tag]
+          (let [curr-regex (js/RegExp (str curr-tag "(?!" p/tag-char-cls ")") "i")
+                search-text (:search-text current-query)]
+            (update-search-fn (s/replace search-text curr-regex tag))))
+        on-keydown-fn
+        (fn [ev]
+          (let [key-code (.. ev -keyCode)]
+            (when (= key-code 9) ; TAB key pressed
+              (when (and curr-tag (seq f-tags))
+                (tag-replace-fn curr-tag (first f-tags)))
+              (when (and curr-mention (seq f-mentions))
+                (tag-replace-fn curr-mention (first f-mentions)))
+              ;(.setTimeout js/window (fn [] (h/focus-on-end (.-target ev))) 50)
+              (.preventDefault ev))))]
+    [:div.search
+     [:div.hashtags
+      (for [tag (get-tags :tags)]
+        ^{:key (str "search-" tag)}
+        [:span.hashtag tag])
+      (for [tag (get-tags :not-tags)]
+        ^{:key (str "search-n" tag)}
+        [:span.hashtag.not-tag tag])
+      (for [tag (get-tags :mentions)]
+        ^{:key (str "search-" tag)}
+        [:span.mention tag])]
+     [:div.search-field {:content-editable true
+                         :on-input         on-input-fn
+                         :on-key-down      on-keydown-fn}
+      (:search-text current-query)]
+     [u/suggestions "search" f-tags curr-tag tag-replace-fn "hashtag"]
+     [u/suggestions "search" f-mentions curr-mention tag-replace-fn "mention"]]))


Added TODOs.

Added TODOs.

--- lambdalf-lib/src/main/clojure/alfresco/transact.clj
+++ lambdalf-lib/src/main/clojure/alfresco/transact.clj
@@ -71,3 +71,6 @@
   scope of the Alfresco transaction (which is probably not what's intended)."
   [user & body]
   `(alfresco.auth/run-as ~user (alfresco.transact/in-ro-tx ~@body)))
+
+;TODO: ADD "as-fn" VERSIONS OF ABOVE FUNCTIONS (see alfresco.auth/run-as-fn for an example)
+;TODO: ADD BATCHING FUNCTIONS!


Fix development middleware order

Fix development middleware order

We need to wrap-file at its earliest so that subsequent
middleware (eg, wrap-mime) is applied properly to hosted files from
this path.

(Service workers for instance check for a valid mime type on registration.)

--- src/leiningen/new/chestnut/dev/user.clj
+++ src/leiningen/new/chestnut/dev/user.clj
@@ -15,7 +15,7 @@
     (assoc ({{project-ns}}.application/app-system config)
            :middleware (new-middleware
                         {:middleware
-                         (conj (:middleware config) [wrap-file "dev-target/public"])})
+                         (vec (concat [[wrap-file "dev-target/public"]] (:middleware config)))})
            :figwheel-system (fw-sys/figwheel-system (fw-config/fetch-config))
            :css-watcher (fw-sys/css-watcher {:watch-paths ["resources/public/css"]}){{{extra-dev-components}}})))


fixed atom plugin

fixed atom plugin

--- main/src/dda/pallet/dda_managed_ide/domain/atom.clj
+++ main/src/dda/pallet/dda_managed_ide/domain/atom.clj
@@ -22,7 +22,7 @@
   ["ink" "minimap" "busy-signal" "atom-toolbar" "atom-meld" "intentions"])

 (def clean-typing-plugins
-  ["trailing-spaces" "linter" "linter-shell" "linter-write-good" "linter-ui-default" "linter-jsonlint" "linter-spell-html" "linter-clojure" "minimap-linter"])
+  ["trailing-spaces" "linter" "linter-write-good" "linter-ui-default" "linter-jsonlint" "linter-spell" "linter-spell-html" "linter-clojure" "minimap-linter"])

 (def pair-programming-plugins
   ["teletype"])


accepting select/activity command

accepting select/activity command

--- src/tango/broker.clj
+++ src/tango/broker.clj
@@ -6,6 +6,12 @@

 ;; Provides useful Timbre aliases in this ns
 (log/refer-timbre)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This should be componitized
+
+(defn select-activity [activity]
+  (log/info "Get this stuff to Datomic"))

 (defn start-result-rules-engine [in-ch out-ch]
   (async/go-loop []
@@ -18,6 +24,10 @@
             (log/info (str "Result Received Topic: [" topic "]"))
             (log/info (str "Result Received payload: [" payload "]"))
             (match [topic payload]
+                   ['app/select-activity _]
+                   (do
+                     (log/info (str "Select activity " payload))
+                     (select-activity payload))
                    [:set-result p]
                    (log/info "Mark X")
                    :else (async/>!!
@@ -27,6 +37,8 @@
             (log/error e "Exception in Broker message go loop")
             (async/>! out-ch (str "Exception message: " (.getMessage e)))))
         (recur)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+

 (defn message-dispatch [{:keys [topic payload sender] :as message}
                         {:keys [channel-connection-channels
@@ -47,8 +59,8 @@
              ;; If a result is accepted it should be sent to the
              ;; "Results Access" for handling.
              (async/>!! (:in-channel rules-engine-channels)
-                        {:topic   topic
-                         :payload payload}))
+                        {:topic   (first payload)
+                         :payload (second payload)}))
            [:file/import _]
            (let [[import import-ch] (async/alts!!
                                      [[(:in-channel file-handler-channels)


(maint) Fix indentation

(maint) Fix indentation

--- src/puppetlabs/trapperkeeper/services/status/status_core.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_core.clj
@@ -203,28 +203,28 @@
     service :- [ServiceInfo]
     level :- ServiceStatusDetailLevel
     service-status-version :- (schema/maybe schema/Int)]
-  (let [status (if (nil? service-status-version)
-                   (last (sort-by :service-status-version service))
-                   (first (filter #(= (:service-status-version %)
-                                    service-status-version)
-                            service)))]
-      (when (nil? status)
-        (throw+ {:type    :service-status-version-not-found
-                 :message (str "No status function with version "
-                            service-status-version
-                            " found for service "
-                            service-name)}))
-      (let [timeout (check-timeout level)
-            callback-resp (guarded-status-fn-call (:status-fn status) level timeout)
-            data (:status callback-resp)
-            state (if-not (schema/check State (:state callback-resp))
-                         (:state callback-resp)
-                         :unknown)]
-        {:service_version (:service-version status)
-         :service_status_version (:service-status-version status)
-         :detail_level level
-         :state state
-         :status data}))))
+   (let [status (if (nil? service-status-version)
+                  (last (sort-by :service-status-version service))
+                  (first (filter #(= (:service-status-version %)
+                                     service-status-version)
+                                 service)))]
+     (when (nil? status)
+       (throw+ {:type    :service-status-version-not-found
+                :message (str "No status function with version "
+                              service-status-version
+                              " found for service "
+                              service-name)}))
+     (let [timeout (check-timeout level)
+           callback-resp (guarded-status-fn-call (:status-fn status) level timeout)
+           data (:status callback-resp)
+           state (if-not (schema/check State (:state callback-resp))
+                   (:state callback-resp)
+                   :unknown)]
+       {:service_version (:service-version status)
+        :service_status_version (:service-status-version status)
+        :detail_level level
+        :state state
+        :status data}))))

 (schema/defn ^:always-validate call-status-fns :- ServicesStatus
   "Call the latest status function for each service in the service context,


separate out the middleware functions for macro expansion from the middleware for expand/resolve.

--- src/metabase/driver/query_processor.clj
+++ src/metabase/driver/query_processor.clj
@@ -115,17 +115,27 @@
            qp))))

-(defn- pre-expand [qp]
-  (fn [query]
-    (qp (if (structured-query? query)
-          (let [macro-expanded-query (macros/expand-macros query)]
-            (when (and (not *disable-qp-logging*)
-                       (not= macro-expanded-query query))
-              (log/debug (u/format-color 'cyan "\n\nMACRO/SUBSTITUTED: 😻\n%s" (u/pprint-to-str macro-expanded-query))))
-            (-> macro-expanded-query
-                expand/expand
-                resolve/resolve))
-          query))))
+(defn- pre-expand-macros [qp]
+  (fn [query]
+    ;; if necessary, handle macro substitution
+    (let [query (if-not (structured-query? query)
+                  query
+                  ;; for structured queries run our macro expansion
+                  (u/prog1 (macros/expand-macros query)
+                    (when (and (not *disable-qp-logging*)
+                               (not= <> query))
+                      (log/debug (u/format-color 'cyan "\n\nMACRO/SUBSTITUTED: 😻\n%s" (u/pprint-to-str <>))))))]
+      (qp query))))
+
+
+(defn- pre-expand-resolve [qp]
+  (fn [query]
+    ;; if necessary, expand/resolve the query
+    (let [query (if-not (structured-query? query)
+                  query
+                  ;; for structured queries we expand first, then resolve
+                  (resolve/resolve (expand/expand query)))]
+      (qp query))))

 (defn- post-add-row-count-and-status
@@ -357,7 +367,8 @@
                                                driver/process-native) driver)]
       ((<<- wrap-catch-exceptions
             pre-add-settings
-            pre-expand
+            pre-expand-macros
+            pre-expand-resolve
             driver-process-in-context
             post-add-row-count-and-status
             post-format-rows


Added tests for validation of granule AQL TwoDCoordinateSystem.

--- test/cmr/system_int_test/search/granule_grid_search_test.clj
+++ test/cmr/system_int_test/search/granule_grid_search_test.clj
@@ -125,9 +125,9 @@
            (let [{:keys [status errors]} (search/find-refs :granule {:grid two-d})]
              (is (= [400 [error]]
                     [status errors])))
-           " :1," "grid name can not be empty, but is for [ :1,]"
-           "name:x" "grid values [x] must be numeric value or range"
-           "name:10-x" "grid values [10-x] must be numeric value or range"
+           " :1," "Grid name can not be empty, but is for [ :1,]"
+           "name:x" "Grid values [x] must be numeric value or range"
+           "name:10-x" "Grid values [10-x] must be numeric value or range"
            "name:10-5" "Invalid grid range for [10-5]"
            "name:6,10-5" "Invalid grid range for [10-5]"))

@@ -164,9 +164,9 @@
                  {:keys [status errors]} (search/find-refs :granule search-params)]
              (is (= [400 [error]]
                     [status errors])))
-           " " "1" "grid name can not be empty, but is for [ :1]"
-           "name" "x" "grid values [x] must be numeric value or range"
-           "name" "10-x" "grid values [10-x] must be numeric value or range"
+           " " "1" "Grid name can not be empty, but is for [ :1]"
+           "name" "x" "Grid values [x] must be numeric value or range"
+           "name" "10-x" "Grid values [10-x] must be numeric value or range"
            "name" "10-5" "Invalid grid range for [10-5]"
            "name" "6,10-5" "Invalid grid range for [10-5]"))

@@ -191,6 +191,23 @@
            {:name "one CALIPSO" :coord-1 nil :coord-2 [329 360]}
            [gran1 gran2 gran3 gran4 gran5 gran7 gran8 gran10]
            {:name "one CALIPSO" :coord-1 nil :coord-2 [nil 360]}
-           [gran3 gran5 gran6 gran9 gran10] {:name "one CALIPSO" :coord-1 nil :coord-2 [360 nil]}))))
-
-
+           [gran3 gran5 gran6 gran9 gran10] {:name "one CALIPSO" :coord-1 nil :coord-2 [360 nil]}))
+
+    (testing "invalid AQL two-d-coordinate-system"
+      (are [two-d-name coord-1 coord-2 error]
+           (let [two-d {:name two-d-name :coord-1 coord-1 :coord-2 coord-2}
+                 {:keys [status errors]} (search/find-refs-with-aql
+                                           :granule
+                                           [{:TwoDCoordinateSystem two-d}])]
+             (is (= [400 [error]]
+                    [status errors])))
+           " " "1" nil "TwoDCoordinateSystemName can not be empty"
+           "name" "x" nil "Invalid format for coordinate1, it should be numeric"
+           "name" nil "x" "Invalid format for coordinate2, it should be numeric"
+           "name" [10 "x"] nil "Invalid format for coordinate1, it should be numeric"
+           "name" [5 1] nil
+           "TwoDCoordinateSystem coordinate1 range lower [5.0] should be smaller than upper [1.0]"
+           "name" nil [5 1]
+           "TwoDCoordinateSystem coordinate2 range lower [5.0] should be smaller than upper [1.0]"))))
+
+


s/(.size /(count /

s/(.size /(count /

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -22,7 +22,7 @@
   "like (toks), but use lexicon to consolidate two initial tokens into one. may consolidate larger groups than two in the future."
   (cond (nil? tokens) nil
         (empty? tokens) nil
-        (> (.size tokens) 1)
+        (> (count tokens) 1)
         ;; it's two or more tokens, so try to combine the first and the second of them:
         (let [looked-up (lookup (str (first tokens) " " (second tokens)))]
           (if (not (empty? looked-up))
@@ -33,20 +33,20 @@
             (cons (lookup (first tokens))
                   (toks2 (rest tokens) lexicon lookup))))
         ;; only one token left: look it up.
-        (= (.size tokens) 1)
+        (= (count tokens) 1)
         (list (lookup (first tokens)))
         true
         nil))

 (defn create-unigram-map [args index]
-  (if (< index (.size args))
+  (if (< index (count args))
     (merge
      {[index (+ 1 index)]
       (subvec args index (+ 1 index))}
      (create-unigram-map args (+ 1 index)))))

 (defn create-bigram-map [args index grammar]
-  (if (< (+ 1 index) (.size args))
+  (if (< (+ 1 index) (count args))
     (let [left-side (subvec args index (+ 1 index))
           right-side (subvec args (+ 1 index) (+ 2 index))]
       (merge
@@ -58,7 +58,7 @@
 (declare over)

 (defn create-trigram-map [args index grammar bigrams]
-  (if (< (+ 2 index) (.size args))
+  (if (< (+ 2 index) (count args))
     (do
       (merge
        {[index (+ 3 index)]
@@ -84,12 +84,12 @@
   (over/over grammar left right))

 (defn create-ngram-map [args left ngrams grammar split-at x]
-  (log/debug (str "create-ngram-map: left:" left ";split-at:" split-at "; size:" (.size args) "; x:" x))
+  (log/debug (str "create-ngram-map: left:" left ";split-at:" split-at "; size:" (count args) "; x:" x))
   (if (< (+ left (- split-at 2))
-         (/ (.size args) 2))
+         (/ (count args) 2))
     (lazy-cat
      (let [left-parses (get ngrams [left (+ left (- split-at 0))] '())
-           right-parses (get ngrams [(+ left split-at 0) (- (.size args) 0)] '())]
+           right-parses (get ngrams [(+ left split-at 0) (- (count args) 0)] '())]
        (if (and (not (empty? left-parses))
                 (not (empty? right-parses)))
          (over grammar left-parses right-parses)))
@@ -104,7 +104,7 @@
                                     (create-xgram-map args (- x 1) 0 grammar))]
                (cond
                 (= x 3) (create-trigram-map args index grammar nminus1grams)
-                (< (+ x index) (+ 1 (.size args)))
+                (< (+ x index) (+ 1 (count args)))
                 (let [runlevel (if runlevel runlevel 0)]
                   (log/debug (str "create-xgram-map: x=" x "; index=" index "; runlevel=" runlevel))
                   (log/debug (str "  -> create-ngram-map(index:" index ";split-at: " 1 ";x:" x))
@@ -137,8 +137,8 @@
         ;; return the parse of the whole expression.
         ;; TODO: if a parse for the whole expression is not found,
         ;; return the largest subparse(s).
-        (get (create-xgram-map arg (.size arg) 0 grammar)
-             [0 (.size arg)])
+        (get (create-xgram-map arg (count arg) 0 grammar)
+             [0 (count arg)])
         true
         :error))


cleanup code in (generate-question-and-correct-set)

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -3,7 +3,7 @@
   [:require
    [babel.directory :refer [models]]
    [babel.generate :refer [generate]]
-   [babel.korma :as korma :refer [convert-keys-from-string-to-keyword init-db]]
+   [babel.korma :as korma :refer [convert-keys-from-string-to-keyword init-db read-array]]
    [clojure.string :as string]
    [clojure.data.json :as json :refer [read-str write-str]]
    [clojure.tools.logging :as log]
@@ -90,9 +90,10 @@
    To rephrase, the set of expressions in the target language share an identical semantics,
    and the single expression in the source language contains that semantics."
   (log/debug (str "generate target language set with target-language:" target-language " ;spec: " target-spec))
-  (let [target-spec (unify target-spec
-                           {:synsem {:subcat '()}})]
-    (cond (= target-language "la")
+  (let [target-spec (-> target-spec
+                        (unify {:synsem {:subcat '()}})
+                        (dissoc-paths [[:dag_unify.core/serialized]]))]
+    (cond (= target-language "la") ;; TODO: should not have a special case for one language.
           (babel.latin/read-one :top  ;; TODO: use target-spec
                                 @((-> models :la))
                                 @((-> models :en)))
@@ -105,10 +106,7 @@
                     ((fn [target-spec]
                        (if (= :top target-spec)
                          {}
-                         target-spec)))
-
-                    ;; remove dag_unify-specific metadata:
-                    (dissoc-paths [[:dag_unify.core/serialized]]))
+                         target-spec))))
                 target-json-spec (json/write-str (strip-refs json-input-spec))]
             (log/debug (str "looking for expressions in target language: " target-language
                             " with spec: " target-spec))
@@ -146,7 +144,7 @@
                       debug (log/debug (str "number of target results:" size-of-results))
                       debug (log/debug (str "index of target result:" index-of-result))
                       target-expression (nth results index-of-result)
-                      debug (log/debug (str "target-expression is nil?" (nil? target-expression)))
+                      debug (log/debug (str "target-expression is nil? " (nil? target-expression)))
                       debug (log/trace (str "target-expression is: " target-expression))
                       ]

@@ -183,50 +181,63 @@
                     (log/debug (str "target expression:" (:surface target-structure)))
                     (log/debug (str "target semantics:" (strip-refs target-semantics)))
                     (log/debug (str "source semantics:" (strip-refs source-semantics)))
-                    (log/debug (str "json target semantics:" json-target-semantics))
-                    (log/debug (str "json source semantics:" json-source-semantics))
-                    (let [results
-                          (db/exec-raw [(str "SELECT source.surface AS source, source.id AS source_id,
-                                             target.surface AS target,target.root AS target_root,
-                                             source.structure AS structure,
-                                             target.structure::text AS target_structure
+                    (log/trace (str "json target semantics:" json-target-semantics))
+                    (log/trace (str "json source semantics:" json-source-semantics))
+                    (let [result
+                          (first
+                           (db/exec-raw [(str "SELECT source.surface AS source, source.id AS source_id,
+                                              ARRAY_AGG(target.surface) AS target,ARRAY_AGG(target.root) AS target_root,
+                                              ARRAY_AGG(source.structure::jsonb) AS target_structure,
+                                              ARRAY_AGG(target.id) AS target_id
                                         FROM (SELECT surface, source.structure->'synsem'->'sem'
                                                      AS sem,
                                                      source.structure AS structure, source.id
                                                 FROM expression AS source
                                                WHERE source.language=?
                                                  AND source.active=true
-                                                 AND source.structure->'synsem'->'sem' @> '"
-                                             json-source-semantics "' LIMIT 1) AS source
+                                                 AND source.structure->'synsem'->'sem' @> ?::jsonb
+                                             LIMIT 1) AS source
                                   INNER JOIN (SELECT
                                             DISTINCT surface, target.structure->'synsem'->'sem' AS sem,
-                                                     root,structure
+                                                     root, structure, target.id
                                                 FROM expression_with_root AS target
                                                WHERE target.language=?
                                                  AND target.active=true
-                                                 AND target.structure->'synsem'->'sem' = '" json-target-semantics "') AS target
+                                                 AND target.structure->'synsem'->'sem' = ?::jsonb) AS target
                                           ON (source.surface IS NOT NULL)
-                                         AND (target.surface IS NOT NULL)")
-                                        [source-language target-language]]
-                                       :results)]
-                      (if (nil? (first (map :source results)))
-                        ;; TODO: use real sql (from above) rather than this fake string:
-                        (let [sql (str "SELECT surface FROM expression_with_root AS source WHERE "
-                                       " source.structure->'synsem'->'sem' @> '" json-source-semantics "'")
-                              message (str "no source expression found for target semantics: "
-                                           (get-in target-structure
-                                                   [:synsem :sem])
-                                           "; used source semantics:" source-semantics "; SQL:" sql)]
+                                         AND (target.surface IS NOT NULL) "
+                                              " GROUP BY source.surface,source.id")
+                                         [source-language json-source-semantics target-language json-target-semantics]]
+                                        :results))]
+                      (if (nil? result)
+                        (let [message (str "no source expression found for target semantics: "
+                                           (get-in target-structure [:synsem :sem])
+                                           "; used source semantics:" source-semantics ".")]
                           (log/error message)
                           (throw (Exception. message))))
-                      {:source-id (first (map :source_id results))
-                       :source (first (map :source results))
-                       :target-spec target-spec
-                       :targets-with-roots (map (fn [result]
-                                                  {:root (:target_root result)
-                                                   :target (:target result)})
-                                                results)
-                       :targets (map :target results)})))))))))
+                      (log/info (str "RESULT: " result))
+                      (log/info (str "TYPE OF target_structure:"
+                                     (type (get result :target_structure))))
+                      (let [show-target-structures false ;; true for debugging
+                            retval
+                            (-> result
+
+                                (dissoc :target) ;; aggregate 'target' values into 'targets'
+                                (assoc :targets (read-array (:target result)))
+
+                                (dissoc :target_id) ;; aggregate targets' ids into 'target_ids'
+                                (assoc :target_ids (read-array (:target_id result)))
+
+                                (dissoc :target_root) ;; targets' roots -> 'target_roots'
+                                (assoc :target_roots (read-array (:target_root result)))
+
+                                (dissoc :target_structure) ;; targets' structures -> 'target structures'
+
+                                (and show-target-structures
+                                     (assoc :target_structures (read-array (:target_structure result))))
+
+                                )]
+                        retval))))))))))

 (defn get-lexeme [canonical language & [ spec ]]
   "get a lexeme from the database given the canonical form, given a


Import name-with-attributes from clojure.contrib.def

--- src/useful/macro.clj
+++ src/useful/macro.clj
@@ -59,3 +59,29 @@
         (var ~name)))
   ([name orig doc]
      (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
+
+;; name-with-attributes by Konrad Hinsen, stolen from c.c.def:
+(defn ^{:dont-test "Stolen from contrib"} name-with-attributes
+  "To be used in macro definitions.
+   Handles optional docstrings and attribute maps for a name to be defined
+   in a list of macro arguments. If the first macro argument is a string,
+   it is added as a docstring to name and removed from the macro argument
+   list. If afterwards the first macro argument is a map, its entries are
+   added to the name's metadata map and the map is removed from the
+   macro argument list. The return value is a vector containing the name
+   with its extended metadata map and the list of unprocessed macro
+   arguments."
+  [name macro-args]
+  (let [[docstring macro-args] (if (string? (first macro-args))
+                                 [(first macro-args) (next macro-args)]
+                                 [nil macro-args])
+        [attr macro-args]          (if (map? (first macro-args))
+                                     [(first macro-args) (next macro-args)]
+                                     [{} macro-args])
+        attr                       (if docstring
+                                     (assoc attr :doc docstring)
+                                     attr)
+        attr                       (if (meta name)
+                                     (conj (meta name) attr)
+                                     attr)]
+    [(with-meta name attr) macro-args]))


Add bus related methods.

Add bus related methods.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -116,32 +116,38 @@
   [ob]
   (instance? js/Rx.Observable ob))

-;; (defn from-poll
-;;   "Creates an observable sequence polling given
-;;   function with given interval."
-;;   [ms f]
-;;   (create (fn [sick]
-
-;;             (let [sem (js/setInterval
-;;                        (fn []
-;;                          (let [v (f)]
-;;                            (when (or (-end? v) (-error? v))
-;;                              (js/clearInterval sem))
-;;                            (sick v))))]
-;;                    (.onNext ob)
-
-;;                    (-end? v)
-;;                  (if (instance? EndValue v)
-;;                    (.onComplete ob (.-v v))
-;;                    (.onComplete ob v))
-
-;;                  (-error? v)
-;;                  (.onError ob v))))))
-
-
-
-
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Bus
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn bus
+  "Bus is an observable sequence that allows you to push
+  values into the stream."
+  []
+  (js/Rx.Subject.))
+
+(defn bus?
+  "Return true if `b` is a Subject instance."
+  [b]
+  (instance? js/Rx.Subject b))
+
+(defn push!
+  "Pushes the given value to the bus stream."
+  [b v]
+  {:pre [(bus? b)]}
+  (.onNext b v))
+
+(defn error!
+  "Pushes the given error to the bus stream."
+  [b e]
+  {:pre [(bus? b)]}
+  (.onError b e))
+
+(defn end!
+  "Ends the given bus stream."
+  [b]
+  {:pre [(bus? b)]}
+  (.onCompleted b))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Observable Subscription


Add specific error handler for disable loader in an unexpected error.

--- src/uxbox/state.cljs
+++ src/uxbox/state.cljs
@@ -9,7 +9,10 @@
   (:require [beicon.core :as rx]
             [lentes.core :as l]
             [uxbox.rstore :as rs]
+            [uxbox.locales :refer (tr)]
             [uxbox.util.storage :refer (storage)]))
+
+(enable-console-print!)

 (defonce state (atom {}))

@@ -19,7 +22,7 @@

 (def loader (atom false))

-(defn get-initial-state
+(defn- get-initial-state
   []
   {:dashboard {:project-order :name
                :project-filter ""}
@@ -35,6 +38,13 @@
    :projects-by-id {}
    :pages-by-id {}})

+(defn- on-error
+  [error]
+  ;; Disable loader in case of error.
+  (reset! loader false))
+
+(rs/add-error-watcher :test on-error)
+
 (defonce stream
   (rs/init (get-initial-state)))


Fixed optimization problem.

Fixed optimization problem.

--- src/butler/core.cljs
+++ src/butler/core.cljs
@@ -22,10 +22,10 @@
   (into {} (for [[k v] m] [(f k) v])))

 (defn- message-handler [handlers e]
-  (let [deserialized (deserialize (.-serialized (.-data e)))
+  (let [deserialized (deserialize (aget (.-data e) "serialized"))
         name (keyword (:name deserialized))
         data (:data deserialized)
-        transferables (map-key deserialize (js->clj (.-transferables (.-data e))))
+        transferables (map-key deserialize (js->clj (aget (.-data e) "transferables")))
         copied (reduce #(assoc-in %1 (first %2) (second %2)) data transferables)]
     (when-let [handler (get handlers name)]
       (handler copied))))


Added functions to compute vertice-degrees.

--- src/main/clojure/conexp/fca/applications/socialanalytics.clj
+++ src/main/clojure/conexp/fca/applications/socialanalytics.clj
@@ -293,5 +293,58 @@
   [context]
   (average-shortest-path context adjacency-matrix-for-attribute-projection))

+;;;Vertice-degrees
+
+(defn vertice-degrees
+  "For a given `context' and a `projection', which maps
+  contexts to graphs, represented by adjacency-maps,
+  the seq of vertice-degrees of (projection context) is returned."
+  [context projection]
+  (assert (context? context) "First argument must be a formal context!")
+  (map
+    count
+    (vals (projection context))))
+
+(defn vertice-degrees-objects-and-attributes
+  "For a given `context', the seq of vertice-degrees
+  of the graph, which has as verticies the objects
+  and attributes of the context and in which the edges
+  are defined through the incidence-relation, is returned."
+  [context]
+  ;; Note that this function does not use
+  ;; the above vertice-degrees function
+  ;; for airbitary projections.
+  ;; The reason therefore is,
+  ;; that the special construction of
+  ;; this specific graph allows to directly
+  ;; compute the list of the vertice-degrees
+  ;; from the context.
+  (assert (context? context) "Argument must be a formal context!")
+  (concat
+    (map
+      #(count (object-derivation context #{%}))
+      (objects context))
+    (map
+      #(count (attribute-derivation context #{%}))
+      (attributes context))))
+
+(defn vertice-degrees-objects
+  "For a given `context', this function returns
+  the vertice-degrees of the graph, which has
+  as verticies the objects of the context
+  and in which two objects share an edge if they share
+  an attribute."
+  [context]
+  (vertice-degrees context object-projection))
+
+(defn vertice-degrees-attributes
+  "For a given `context', this function returns
+  the vertice-degrees of the graph, which has
+  as verticies the attributes of the context and
+  in which two attributes share an edge if they share
+  an object."
+  [context]
+  (vertice-degrees context attribute-projection))
+
 ;;;
 nil


allow key to be passed in for making coinbase

also allow chain to be passed in when mining
a block; rename this function to express
the committing-to-chain process it embodies

--- src/block_chain/miner.clj
+++ src/block_chain/miner.clj
@@ -7,11 +7,13 @@
             [block-chain.transactions :as txn]
             [block-chain.wallet :as wallet]))

-(defn coinbase []
-  (txn/hash-txn
-   {:inputs []
-    :outputs [{:amount 25 :address wallet/public-pem}]
-    :timestamp (current-time-millis)}))
+(defn coinbase
+  ([] (coinbase wallet/public-pem))
+  ([address] (txn/tag-coords
+              (txn/hash-txn
+               {:inputs []
+                :outputs [{:amount 25 :address address}]
+                :timestamp (current-time-millis)}))))

 (defn payment
   [address source-hash source-index]
@@ -36,20 +38,19 @@
 (defonce mine? (atom true))
 (defn stop-miner! [] (reset! mine? false))

-(defn mine-block
-  ([] (mine-block (blocks/generate-block [(coinbase)])))
-  ([pending]
-   (println "****** Will Mine Block: ******\n" pending "\n***************************")
+(defn mine-and-commit
+  ([] (mine-and-commit bc/block-chain))
+  ([chain] (mine-and-commit chain (blocks/generate-block [(coinbase)])))
+  ([chain pending]
    (if-let [b (mine pending mine?)]
-     (do (println "****** Successfully Mined Block: ******\n" b "\n***************************")
-         (bc/add-block! b))
+     (swap! chain conj b)
      (println "didn't find coin, exiting"))))

 (defn run-miner! []
   (reset! mine? true)
   (async/go
     (while @mine?
-      (mine-block))))
+      (mine-and-commit))))

 ;; wallet -- using blockchain to find
 ;; balance / transaction outputs


debugging

debugging

--- src/braid/server/bots.clj
+++ src/braid/server/bots.clj
@@ -10,7 +10,8 @@
   (let [body (->transit message)
         hmac (crypto/hmac-bytes (bot :token) body)]
     (timbre/debugf "sending bot notification")
-    @(http/put (bot :webhook-url)
-               {:headers {"Content-Type" "application/transit+msgpack"
-                          "X-Braid-Signature" hmac}
-                :body (ByteArrayInputStream. body)})))
+    (println
+      @(http/put (bot :webhook-url)
+                 {:headers {"Content-Type" "application/transit+msgpack"
+                            "X-Braid-Signature" hmac}
+                  :body (ByteArrayInputStream. body)}))))


Printing output

Printing output

--- jvm-runner/src/clojure/codewars/runners.clj
+++ jvm-runner/src/clojure/codewars/runners.clj
@@ -15,11 +15,18 @@
           (format "Language %s is not implemented"
                   (pr-str language)))))

+(defn- print-result [{:keys [:stdout :stderr] :as result}]
+  (print stdout)
+  (binding [*out* *err*] (print stderr))
+  result)
+
 (defn run
   "Run code or a test-fixture."
   [opts]
-  (wrap-result
-   (with-timeout timeout
-     (if (contains? opts :fixture)
-       (full-project opts)
-       (code-only opts)))))
+  (->> (if (contains? opts :fixture)
+         (full-project opts)
+         (code-only opts))
+       (with-timeout timeout)
+       wrap-result
+       print-result
+       ))


make post request from cljs client

make post request from cljs client

--- cljs-rest-client-server-demo/src-cljs/cljs_rest_client_server_demo/core.cljs
+++ cljs-rest-client-server-demo/src-cljs/cljs_rest_client_server_demo/core.cljs
@@ -1,9 +1,29 @@
 (ns cljs-rest-client-server-demo.core
-  (:require [clojure.browser.repl :as repl]))
+  (:require [clojure.browser.repl :as repl]
+            [goog.net.XhrIo :as xhr]
+            [goog.Uri.QueryData :as query-data]
+            [goog.structs :as structs]
+            [goog.dom :as dom]))

 ;; (defonce conn
 ;;   (repl/connect "http://localhost:9000/repl"))

 (enable-console-print!)

-(println "Hello world!")
+(defn receiver [event]
+  (let [response (.-target event)]
+    (println (.getResponseText response))
+    (set! (.-value (dom/getElement "returnVal"))
+          (.getResponseText response))))
+
+(defn post [url content]
+  (xhr/send url receiver "POST" content))
+
+(defn ^:export main [& _]
+  (println "starting!")
+  (post "/4459"
+        (query-data/createFromMap
+         (structs/Map. (clj->js (:mykey
+                                 (.-value (dom/getElement "returnVal")))))))
+  (println "done"))
+


Make the tests pass

Make the tests pass

--- src/caesium/crypto/scalarmult.clj
+++ src/caesium/crypto/scalarmult.clj
@@ -1,9 +1,46 @@
 (ns caesium.crypto.scalarmult
-  (:require [caesium.binding :refer [defconsts]]))
   "**DANGER** This namespace consists of low-level details that you
   should not use unless you know what you are doing. You probably
   want [[caesium.crypto.box]] instead.

   Scalar multiplication."
+  (:refer-clojure :exclude [bytes])
+  (:require [caesium.binding :refer [defconsts sodium]]
+            [caesium.util :as u]))

 (defconsts [bytes scalarbytes primitive])
+
+(defn scalarmult-to-buf!
+  "Performs scalar multiplication into the given out buffer against a
+  given point using `crypto_scalarmult`, or against the fixed base
+  point with `crypto_scalarmult_base` when no point is passed."
+  ([n out]
+   (.crypto_scalarmult_base sodium out n))
+  ([n p out]
+   (.crypto_scalarmult sodium out n p)))
+
+(defn scalarmult
+  "Performs scalar multiplication against a given point, using"
+  ([n]
+   (let [out (byte-array bytes)]
+     (scalarmult-to-buf! n out)
+     out))
+  ([n p]
+   (let [out (byte-array bytes)]
+     (scalarmult-to-buf! n p out)
+     out)))
+
+(def ^bytes int->scalar
+  "**DANGER** This fn is typically only used for demos, not secure
+  cryptosystems; see rest of docstring for details.
+
+  Turns an integral type (int, bigint, biginteger) into a byte array
+  suitable for use as a scalar for scalarmult.
+
+  The resulting byte array will be `scalarbytes` wide.
+
+  Note that int is generally only 32 bits wide (see `Integer/SIZE`),
+  whereas scalars here are 32 bytes wide (see `scalarbytes`). An
+  attacker can simply exhaust all 32-bit options, so points generated
+  this way should not be considered secure."
+  (partial u/n->bytes scalarbytes))


* src/clj/cljs/compiler.clj: warning string tweak

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -817,7 +817,7 @@
             (println (str "WARNING: " (symbol (str ns-name) (str sym))
                           " no longer fn, references are stale"
                           (when (:line env)
-                            (str " at line " (:line env) " " *cljs-file*)))))))
+                            (str ", at line " (:line env) " " *cljs-file*)))))))
       (swap! namespaces update-in [ns-name :defs sym]
              (fn [m]
                (let [m (assoc (or m {}) :name name)]


Emit goog.require for 'used' namespaces. Refs #CLJS-65

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -518,11 +518,11 @@
   (emit-wrap env (print (str (emits target) " = "(emits val)))))

 (defmethod emit :ns
-  [{:keys [name requires requires-macros env]}]
+  [{:keys [name requires uses requires-macros env]}]
   (println (str "goog.provide('" (munge name) "');"))
   (when-not (= name 'cljs.core)
     (println (str "goog.require('cljs.core');")))
-  (doseq [lib (vals requires)]
+  (doseq [lib (into (vals requires) (vals uses))]
     (println (str "goog.require('" (munge lib) "');"))))

 (defmethod emit :deftype*


fix JavaScriptCore related regression - the clever bit around defs w/o init is causing tests to fail when running against JSC only under advanced compilation.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -351,9 +351,12 @@
   (let [mname (munge name)]
     (emit-comment doc (:jsdoc init))
     (emits mname)
-    (if init
+    (when init
       (emits " = " init)
-      (emits " = (typeof " mname " != 'undefined') ? " mname " : undefined"))
+      ;; NOTE: JavaScriptCore does not like this under advanced compilation
+      ;; this change was primarily for REPL interactions - David
+      ;(emits " = (typeof " mname " != 'undefined') ? " mname " : undefined")
+      )
     (when-not (= :expr (:context env)) (emitln ";"))
     (when export
       (emitln "goog.exportSymbol('" (munge export) "', " mname ");"))))


supply transaction date when getting transaction

--- src/clj_money/trading.clj
+++ src/clj_money/trading.clj
@@ -253,15 +253,15 @@

 (defn unbuy
   "Reverses a commodity purchase"
-  [storage-spec transaction-id]
+  [storage-spec {transaction-id :id transaction-date :transaction-date}]
   (with-transacted-storage [s storage-spec]
-    (let [transaction (transactions/find-by-id s transaction-id)
+    (let [transaction (transactions/find-by-id s transaction-id transaction-date)
           lot (lots/find-by-id s (-> transaction :lot-items first :lot-id))
           commodity (commodities/find-by-id s (:commodity-id lot))]
       (when (not= (:shares-purchased lot) (:shares-owned lot))
         (throw (IllegalStateException.
                  "Cannot undo a purchase if shares have been sold from the lot")))
-      (transactions/delete s (:id transaction))
+      (transactions/delete s transaction-id transaction-date)
       (lots/delete s (:id lot))
       {:transaction transaction
        :lot lot
@@ -377,10 +377,10 @@
              create-sale-transaction)))))

 (defn unsell
-  [storage-spec transaction-id]
+  [storage-spec {transaction-id :id transaction-date :transaction-date}]
   (with-transacted-storage [s storage-spec]
-    (let [transaction (transactions/find-by-id s transaction-id)]
+    (let [transaction (transactions/find-by-id s transaction-id transaction-date)]
       (doseq [lot-item (:lot-items transaction)]
         (let [lot (lots/find-by-id s (:lot-id lot-item))]
           (lots/update s (update-in lot [:shares-owned] #(+ % (:shares lot-item))))))
-      (transactions/delete s transaction-id))))
+      (transactions/delete s transaction-id transaction-date))))


Add UI draft for tax-rate update.

Add UI draft for tax-rate update.

--- src/cljs/beatha/core.cljs
+++ src/cljs/beatha/core.cljs
@@ -372,13 +372,48 @@
   [n]
   (str (Math/floor (* n 100)) "%"))

+(defn- normalize
+  [n min max]
+  (cond
+   (< n min) min
+   (> n max) max
+   :else     n))
+
 (def market-model-customization
   (reify
     CellularAutomatonAppCustomization
-    (automaton-input-view [_] empty-view)
+    (automaton-input-view [_]
+      (fn [data owner]
+        (reify
+          om/IRenderState
+          (render-state [_ state]
+            (let [c (:input-info-channel state)
+                  tax-rate (get-in data [:command :tax-rate])]
+              (dom/div
+               #js {:role "form" :className "economic-model-control"}
+               (dom/label nil "Tax rate (%)")
+               (dom/input
+                #js {:type "text" :className "form-control" :value tax-rate
+                     :onChange
+                     #(om/update! data [:command :tax-rate]
+                                  (.. % -target -value))})
+               (dom/button
+                #js {:type "button"
+                     :className "btn btn-success btn-lg btn-block"
+                     :onClick
+                     #(let [new-tax-rate
+                            (normalize
+                             (/ (js/parseFloat
+                                 (get-in @data [:command :tax-rate]))
+                                100)
+                             0 1.0)]
+                        (when-not (empty? tax-rate)
+                          (put! c {:tax-rate new-tax-rate})))}
+                "Send command")))))))
     (automaton-input-reset [_ _])
     (automaton-output-handler [_ data owner msg]
       (om/transact! data (fn [d] (assoc d :market-state msg))))
+
     (automaton-output-view [_]
       (fn [data owner]
         (let [get-market-info (fn [path] (get-in (:market-state data) path))]
@@ -483,3 +518,5 @@

 (render-menu-view)
+(render-cellular-automaton (gen-app-view
+                   a/market-model market-model-customization))


quote and deref

quote and deref

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -230,6 +230,11 @@
    (keyword? f) {f true}
    :else f))

+(defn wrapping-reader
+  [sym]
+  (fn [rdr _]
+    (list sym (read rdr true nil true))))
+
 (defn read-meta
   [rdr _]
   (let [m (desugar-meta (read rdr true nil true))]
@@ -253,8 +258,8 @@
 (def macros
   { \" read-string
     \; not-implemented ;; never hit this
-    \' not-implemented
-    \@ not-implemented
+    \' (wrapping-reader 'quote)
+    \@ (wrapping-reader 'deref)
     \^ read-meta
     \` not-implemented
     \~ not-implemented


Factored out helper methods in reader

Factored out helper methods in reader

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -29,11 +29,17 @@
   "Creates a StringPushbackReader from a given string"
   (StringPushbackReader. (atom s)))

+;; Helper functions
+
 (defn- whitespace?
-  "Checks whether the reader is on a whitespace character."
-  [reader]
-  (let [ch (peek reader)]
-    (or (gstring/isBreakingWhitespace ch) (= \, ch))))
+  "Checks whether a given character is whitespace"
+  [ch]
+  (or (gstring/isBreakingWhitespace ch) (= \, ch)))
+
+(defn- numeric?
+  "Checks whether a given character is numeric"
+  [ch]
+  (gstring/isNumeric ch))

 (defn- comment?
   "Checks whether the reader is at the beginning of a comment"
@@ -44,9 +50,9 @@
   "Checks whether the reader is at the first digit of a number"
   [reader]
   (let [ch (peek reader)]
-    (or (gstring/isNumeric ch)
+    (or (numeric? ch)
         (and (or (= \+ ch) (= \- ch))
-             (gstring/isNumeric (peek reader 2))))))
+             (numeric? (peek reader 2))))))

 (defn- string-literal?
   "Checks whether the reader is at the first character of a string literal"
@@ -91,7 +97,7 @@
   [reader]
   (if (not (nil? (peek reader)))
     (cond
-     (whitespace? reader) (do (read-char reader) (recur reader))
+     (whitespace? (peek reader)) (do (read-char reader) (recur reader))
      (comment? reader) (recur (skip-line reader))
      (number-literal? reader) (read-number reader)
      (string-literal? reader) (read-string reader)


add test-RefType-array-reference

add test-RefType-array-reference

--- test/app/test/model/javaparser_test.clj
+++ test/app/test/model/javaparser_test.clj
@@ -66,3 +66,38 @@
     (is (primitive? foo2-base-base-base))
     (is (not (reference-type? foo2-base-base-base)))
     (is (= "int" (typeName foo2-base-base-base)))))
+
+(deftest test-RefType-array-reference
+  (let [cu (parseResource "RefTypes")
+        c (first (topLevelTypes cu))
+        foo3 (.getType (.get (.getMembers c) 2))
+        foo3-base (baseType foo3)
+        foo4 (.getType (.get (.getMembers c) 3))
+        foo4-base (baseType foo4)
+        foo4-base-base (baseType foo4-base)
+        foo4-base-base-base (baseType foo4-base-base)]
+    (is (array? foo3))
+    (is (not (primitive? foo3)))
+    (is (not (reference-type? foo3)))
+
+    (is (not (array? foo3-base)))
+    (is (not (primitive? foo3-base)))
+    (is (reference-type? foo3-base))
+    (is (= "A" (typeName foo3-base)))
+
+    (is (array? foo4))
+    (is (not (primitive? foo4)))
+    (is (not (reference-type? foo4)))
+
+    (is (array? foo4-base))
+    (is (not (primitive? foo4-base)))
+    (is (not (reference-type? foo4-base)))
+
+    (is (array? foo4-base-base))
+    (is (not (primitive? foo4-base-base)))
+    (is (not (reference-type? foo4-base-base)))
+
+    (is (not (array? foo4-base-base-base)))
+    (is (not (primitive? foo4-base-base-base)))
+    (is (reference-type? foo4-base-base-base))
+    (is (= "A" (typeName foo4-base-base-base)))))


Allow to jump to subscriptions.

Allow to jump to subscriptions.

--- src/cljs/medusa/core.cljs
+++ src/cljs/medusa/core.cljs
@@ -312,26 +312,41 @@
                                                 (js/navigator.id.logout)))}
          (if user "Logout" "Login")]]))))

-(defn subscription-list [{{:keys [detector metric]} :subscriptions} owner]
+(defn subscription-list [{{:keys [detector metric]} :subscriptions
+                          [from to] :selected-date-range}
+                         owner]
   (reify
     om/IRender
     (render [_]
       (let [format-detector (fn [{:keys [detector_name metrics_filter]}]
-                              [:div
+                              [:div {:style {:overflow "hidden"}}
                                [:div [:small "Detector: " [:em detector_name]]]
                                (when (seq metrics_filter)
                                  [:div [:small "Filter: " [:em metrics_filter]]])])
             format-metric (fn [{:keys [metric_name detector_name]}]
-                            [:div
+                            [:div {:style {:overflow "hidden"}}
                              [:div [:small "Detector: " [:em detector_name]]]
-                             [:div [:small "Metric: " [:em metric_name]]]])]
-       (html [:div
-             [:label "Your Subscriptions:"]
-             [:div.list-group
-              (for [d detector]
-                [:a.list-group-item (format-detector d)])
-              (for [m metric]
-                [:a.list-group-item (format-metric m)])]])))))
+                             [:div [:small "Metric: " [:em metric_name]]]])
+            detector-click (fn [detector]
+                             (let [{:keys [detector_id metrics_filter]} @detector]
+                               (routing/goto :detector-id detector_id
+                                             :metrics-filter metrics_filter
+                                             :from from
+                                             :to to))
+                             )
+            metric-click (fn [metric]
+                           (let [{:keys [detector_id metric_id]} @metric]
+                             (routing/goto :detector-id detector_id
+                                           :metric-id metric_id
+                                           :from from
+                                           :to to)))]
+        (html [:div
+               [:label "Your Subscriptions:"]
+               [:div.list-group
+                (for [d detector]
+                  [:a.list-group-item {:on-click (partial detector-click d)} (format-detector d)])
+                (for [m metric]
+                  [:a.list-group-item {:on-click (partial metric-click m)} (format-metric m)])]])))))

 (defn layout [state owner]
   (reify
@@ -466,7 +481,8 @@

                 :detector-selected
                 (route-update {:selected-detector message
-                               :selected-metric nil})
+                               :selected-metric nil
+                               :metrics-filter nil})

                 :metric-selected
                 (route-update {:selected-metric message})
@@ -500,7 +516,7 @@
                                              :selected-date-range])
                          {:init-state {:event-channel event-channel}})
                (om/build subscription-list
-                         (select-keys state [:subscriptions]))
+                         (select-keys state [:subscriptions :selected-date-range]))
                (om/build error-notification (select-keys state [:error]))]
               [:div.col-md-9
                (om/build description


add better ns reader

add better ns reader

--- src/cljs_api_gen/read.clj
+++ src/cljs_api_gen/read.clj
@@ -5,7 +5,13 @@
     [clojure.tools.reader.reader-types :as readers]
     [cljs.tagged-literals :refer [*cljs-data-readers*]]
     [me.raynes.fs :refer [exists?]]
+    [cljs-api-gen.config :refer [repo-dir
+                                 *cljs-num*]]
     ))
+
+;;--------------------------------------------------------------------------------
+;; Read forms
+;;--------------------------------------------------------------------------------

 (defn read-forms
   [r]
@@ -31,3 +37,43 @@
   (let [r (readers/string-push-back-reader s)]
     (read-forms r)))

+;;--------------------------------------------------------------------------------
+;; Read forms from namespaces
+;;--------------------------------------------------------------------------------
+
+(defmulti src-path
+  identity)
+
+(defmethod src-path :library
+  [src-type]
+  (cond
+    (=> *cljs-num* 3255) "src/main/cljs"
+    (=> *cljs-num* 0)    "src/cljs"
+    :else nil))
+
+(defmethod src-path :compiler
+  [src-type]
+  (cond
+    (=> *cljs-num* 3255) "src/main/clojure"
+    (=> *cljs-num* 0)    "src/clj"
+    :else nil))
+
+(defn get-ns-files
+  [ns- src-types]
+  (filter exists?
+    (let [ns-path (replace ns- "." "/")]
+      (for [src (map src-path src-types)
+            ext  ["clj" "cljs" "cljc"]]
+        (str repo-dir "/clojurescript/" src "/" ns-path "." ext)))))
+
+(defn read-ns-forms
+  [ns- src-types]
+  (->> (get-ns-files ns- src-types)
+       (mapcat read-forms-from-file)))
+
+(defn read-clj-core-forms
+  []
+  (->> ["core" "core_proxy" "core_print" "core_deftype"]
+       (map #(str repo-dir "/clojure/src/clj/clojure/" % ".clj"))
+       (mapcat read-forms-from-file)))
+


Add atom usage examples

Add atom usage examples

--- src/clojure/mcj/ch_xx.clj
+++ src/clojure/mcj/ch_xx.clj
@@ -208,4 +208,37 @@

 (check-philosophers all-philosophers all-forks)

-;; Using atoms: TBC (p99)
+;; Pause the simulation
+(map future-cancel philosophers-futures)
+
+;; Using atoms:
+
+(def state (atom 0))
+
+@state ;; 0
+
+(reset! state 1) ;; 1
+
+@state ;; 1
+
+(swap! state + 2) ;; 3
+
+;; Using add-watch function (contain error in the book)
+(defn make-state-with-watch []
+  (let [state (atom 0)
+        state-is-changed? (atom false)
+        watch-fn (fn [key r old-value new-value]
+                   (swap! state-is-changed? (fn [_] true)))]
+    (add-watch state nil watch-fn)
+    [state
+     state-is-changed?]))
+
+(def s (make-state-with-watch))
+
+@(nth s 1) ;; false
+
+(swap! (nth s 0) inc) ;; 1
+
+@(nth s 1) ;; true
+
+;; Using agents (TBC)


Add a little better exception text when evaluation fails

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -76,4 +76,11 @@
       (map evaluate body))))

 (defn evaluate-all [stmts]
-  (map evaluate stmts))
+  (when-let [[stmt & stmts] stmts]
+    (try
+      (prn stmt)
+      (evaluate stmt)
+      (catch Exception e
+        (let [[start end] (insta/span stmt)]
+          (throw (RuntimeException. (str "evaluation failed; [" start ", " end "]") e)))))
+    (recur stmts)))


Moar.

Moar.

--- src/clojurecraft/core.clj
+++ src/clojurecraft/core.clj
@@ -32,6 +32,7 @@
   0x17 :addobjectvehicle
   0x18 :mobspawn
   0x19 :entitypainting
+  0x1B :stanceupdate
 })
 (def packet-ids (apply assoc {} (mapcat reverse packet-types)))

@@ -221,6 +222,16 @@
   (-write-int conn y)
   (-write-int conn x)
   (-write-int conn direction))
+
+(defn write-packet-stanceupdate [conn {unknown1 :unknown1 unknown2 :unknown2 unknown3 :unknown3 unknown4 :unknown4 unknown5 :unknown5 unknown6 :unknown6 }]
+  (-write-byte conn (:stanceupdate packet-ids))
+
+  (-write-float conn unknown1)
+  (-write-float conn unknown2)
+  (-write-bool conn unknown3)
+  (-write-bool conn unknown4)
+  (-write-float conn unknown5)
+  (-write-float conn unknown6))

 ; Writing Wrappers -----------------------------------------------------------------
@@ -246,6 +257,7 @@
     (= packet-type :entityaction)         (write-packet-entityaction conn payload)
     (= packet-type :pickupspawn)          (write-packet-pickupspawn conn payload)
     (= packet-type :entitypainting)       (write-packet-entitypainting conn payload)
+    (= packet-type :stanceupdate)         (write-packet-stanceupdate conn payload)
     )
   (flushc conn))

@@ -452,6 +464,15 @@
     (assoc :y (-read-int conn))
     (assoc :z (-read-int conn))
     (assoc :direction (-read-int conn))))
+
+(defn read-packet-stanceupdate [conn]
+  (-> {}
+    (assoc :unknown1 (-read-float conn))
+    (assoc :unknown2 (-read-float conn))
+    (assoc :unknown3 (-read-bool conn))
+    (assoc :unknown4 (-read-bool conn))
+    (assoc :unknown5 (-read-float conn))
+    (assoc :unknown6 (-read-float conn))))

 ; Reading Wrappers -----------------------------------------------------------------
@@ -484,6 +505,7 @@
         (= packet-type :addobjectvehicle)     (read-packet-addobjectvehicle conn)
         (= packet-type :mobspawn)             (read-packet-mobspawn conn)
         (= packet-type :entitypainting)       (read-packet-entitypainting conn)
+        (= packet-type :stanceupdate)         (read-packet-stanceupdate conn)
         :else (str "UNKNOWN PACKET TYPE: " packet-id)
         ))
     (println "\n\n\n")))


Color compare - Hackathon JPA

Color compare - Hackathon JPA

--- src/colorcompare/core.clj
+++ src/colorcompare/core.clj
@@ -55,4 +55,4 @@
                   wrap-params
                   wrap-keyword-params
                   wrap-json-params
-                  wrap-json-response) {:port 8080}))
+                  wrap-json-response) {:port (Integer. (or (System/getenv "PORT") "8080"))}))


fix #152

fix #152

--- src/clj/com/rpl/specter/impl.cljc
+++ src/clj/com/rpl/specter/impl.cljc
@@ -96,11 +96,8 @@
 #?(
    :clj
    (defmacro fast-object-array [i]
-     `(com.rpl.specter.Util/makeObjectArray ~i))
-
-   :cljs
-   (defn fast-object-array [i]
-     (object-array i)))
+     `(com.rpl.specter.Util/makeObjectArray ~i)))
+

 (defn benchmark [iters afn]
   (time
@@ -110,11 +107,12 @@
 #?(
    :clj
    (defmacro exec-select* [this & args]
-     (let [hinted (with-meta (gensym) {:tag 'com.rpl.specter.protocols.RichNavigator})]
-       `(let [~hinted ~this]
-          (.select* ~hinted ~@args))))
-
-
+     (let [platform (if (contains? &env :locals) :cljs :clj)
+           hinted (with-meta (gensym) {:tag 'com.rpl.specter.protocols.RichNavigator})]
+       (if (= platform :cljs)
+         `(p/select* ~this ~@args)
+         `(let [~hinted ~this]
+            (.select* ~hinted ~@args)))))
    :cljs
    (defn exec-select* [this vals structure next-fn]
      (p/select* ^not-native this vals structure next-fn)))
@@ -123,10 +121,12 @@
 #?(
    :clj
    (defmacro exec-transform* [this & args]
-     (let [hinted (with-meta (gensym) {:tag 'com.rpl.specter.protocols.RichNavigator})]
-       `(let [~hinted ~this]
-          (.transform* ~hinted ~@args))))
-
+     (let [platform (if (contains? &env :locals) :cljs :clj)
+           hinted (with-meta (gensym) {:tag 'com.rpl.specter.protocols.RichNavigator})]
+       (if (= platform :cljs)
+         `(p/transform* ~this ~@args)
+         `(let [~hinted ~this]
+            (.transform* ~hinted ~@args)))))

    :cljs
    (defn exec-transform* [this vals structure next-fn]


added docs to short-term trend collection

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -151,68 +151,67 @@
        (i/matrix)))

 (defn trend-mat
+  "returns a (`len` x 2) matrix, with first column of ones; and second
+  column of 1 through `len`"
   [len]
   (i/bind-columns
    (repeat len 1)
    (map inc (range len))))

 (defn proj-mat
+  "returns the projection matrix for a given X, premultiplied by
+  inv(X), which is used to calculate the coefficient vector for
+  ordinary least squares:
+
+  P = X*inv(X'*X)*X' => inv(X)*P = inv(X'*X)*X',
+  which implies that estimated OLS coefficient vector:
+  beta = inv(X'*X)*X'*y = inv(X)*P*y"
   [block-len]
   (let [X (trend-mat block-len)]
     (i/mmult (i/solve (i/mmult (i/trans X) X))
              (i/trans X))))

 (defn grab-trend
+  "returns the trend from an ordinary least squares regression of a
+  spectral time series on an intercept and a trend variable"
   [proj-mat sub-coll]
   (second (i/mmult proj-mat sub-coll)))

 (defn moving-subvec
-  [coll window]
+  "returns a vector of incanter sub-matrices, offset by 1 and of
+  length `window`; works like partition for non-incanter data
+  structures."
+  71[window coll]
   (loop [idx 0
          res []]
     (if (> idx (- (count coll) window))
       res
-      (recur
+      (recure
        (inc idx)
-       (conj res (i/sel coll :rows (range idx (+ window idx))))))))
-
-(defn block-ols-trend
-  [block-len spectral-ts reli-ts]
+       (conj res (i/sel coll
+                        :rows (range idx (+ window idx))))))))
+
+(defn windowed-trend
+  "returns a vector of short-trem trend coefficients of block length
+  `block-len`"
+  [block-len freq spectral-ts reli-ts]
   (map (partial grab-trend (proj-mat block-len))
-       (moving-subvec (deseasonalize 23 spectral-ts reli-ts) block-len)))
-
-(defn collect-short
-  [block-len training-end spectral-ts reli-ts]
-  (let [leading-buffer (+ 2 (- training-end (+ block-len 10)))]
-    (->> (block-ols-trend block-len spectral-ts reli-ts)
-         (utils/moving-average 10)
+       (moving-subvec block-len (deseasonalize freq spectral-ts reli-ts))))
+
+(defn collect-short-trend
+  "returns a vector of the short-term trend coefficients over time
+  series blocks of length `long-block`, smoothed by moving average
+  window of length `short-block`.  The coefficients are calculated
+  along the entire time-series, but only apply to periods at and after
+  the end of the training period.  TODO: make sure that the result
+  contains the appropriate number of observations, i.e., that the
+  first observation in the vector is the interval that marks the end
+  of the training period."
+  [long-block short-block freq training-end
+  spectral-ts reli-ts]
+  (let [leading-buffer (+ 2 (- training-end (+ long-block short-block)))]
+    (->> (windowed-trend long-block freq spectral-ts reli-ts)
+         (utils/moving-average short-block)
          (reductions min)
          (drop leading-buffer))))

-         ;; (drop leading-buffer)
-
-;; (defn test-trends
-;;   [spectral-ts reli-ts long-block]
-;;   (let [proj     (proj-mat long-block)
-;;         clean-ts (deseasonalize 23 spectral-ts reli-ts)]
-;;     (loop [iter 0
-;;            mat (i/sel clean-ts :rows (range iter (+ iter long-block)))
-;;            res  []]
-;;       (println res)
-;;       (println proj)
-;;       (println "")
-;;       (println (i/sel clean-ts :rows
-;;                       (range iter (+ iter long-block))))
-;;       (if (> iter 5)
-;;         res
-;;         (recur (inc iter)
-;;                (i/sel clean-ts :rows (range iter (+ iter long-block)))
-;;                (conj res (grab-trend proj-mat mat)))))))
-
-;; (reduce min (utils/moving-average 5 ndvi))
-;; (if (< (count sub-coll) 30)
-;;         res
-;;         (recur
-;;          (inc i)
-;;          (i/sel coll :rows  i (+ 30 i))
-;;          (conj res (grab-trend proj sub-coll))))


change Psychographics, Shipments, ToL advancements to :placed true

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -229,7 +229,7 @@
                        [reveal r] (split-with (complement ice?) (get-in @state [:corp :deck]))
                        titles (->> (conj (vec reveal) (first r)) (filter identity) (map :title))]
                    (trash state side target {:cause :ability-cost})
-                   (when (seq titles)
+                   (when (seq titles)
                      (system-msg state side (str "reveals " (clojure.string/join ", " titles) " from R&D")))
                    (if-let [ice (first r)]
                      (let [newice (assoc ice :zone (:zone target) :rezzed true)
@@ -308,7 +308,7 @@
                                     {:msg (msg "place " c " advancement tokens on "
                                                (if (:rezzed target) (:title target) "a card"))
                                      :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
-                                     :effect (effect (add-prop target :advance-counter c))} card nil)))}
+                                     :effect (effect (add-prop target :advance-counter c {:placed true}))} card nil)))}

    "Punitive Counterstrike"
    {:trace {:base 5 :msg (msg "do " (or (:stole-agenda runner-reg) 0) " meat damage")
@@ -370,7 +370,7 @@
                                (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                (= (:type %) "Agenda"))}
     :msg (msg "1 advancement tokens on " (count targets) " cards")
-    :effect (req (doseq [t targets] (add-prop state :corp t :advance-counter 1)))}
+    :effect (req (doseq [t targets] (add-prop state :corp t :advance-counter 1 {:placed true})))}

    "Shipment from MirrorMorph"
    (let [shelper (fn sh [n] {:prompt "Select a card to install"
@@ -389,7 +389,7 @@
                                           (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                           (= (:type %) "Agenda"))}
                       :msg (msg "add " c " advancement tokens on a card")
-                      :effect (effect (add-prop :corp target :advance-counter c))} card nil)))}
+                      :effect (effect (add-prop :corp target :advance-counter c {:placed true}))} card nil)))}

    "Shoot the Moon"
    {:choices {:req #(and (= (:type %) "ICE") (not (:rezzed %)))
@@ -510,8 +510,8 @@
                                                               (or (= (:advanceable %) "always")
                                                                   (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                                                   (= (:type %) "Agenda")))}
-                                         :effect  (effect (add-prop :corp target :advance-counter c)
-                                                          (add-prop :corp fr :advance-counter (- c))
+                                         :effect  (effect (add-prop :corp target :advance-counter c {:placed true})
+                                                          (add-prop :corp fr :advance-counter (- c) {:placed true})
                                                           (system-msg (str "moves " c " advancement tokens from "
                                                                            (if (:rezzed fr) (:title fr) "a card") " to "
                                                                            (if (:rezzed target) (:title target) "a card"))))}


update  ecs ns, implement run-system

update  ecs ns, implement run-system

--- src/clj/resonate2015/day1/ecs.clj
+++ src/clj/resonate2015/day1/ecs.clj
@@ -51,7 +51,47 @@
       (new-entity! app-state)
       states)))

-(defn system
-  "Defines a new system"
-  [name f]
+(defn new-system!
+  "Defines a new system in the given app-state atom.
+  Asks for system name, a set of required component IDs and
+  a system function to process all matching entities."
+  [app-state name comp-ids f]
+  (swap! app-state assoc-in
+         [:systems name]
+         {:fn f
+          :comp-ids comp-ids}))
+
+(defn make-entity-validator
+  [comp-ids]
+  (let [valid-entity-keys? (partial set/subset? comp-ids)]
+    (fn [[_ v]]
+      (valid-entity-keys? (set (keys v))))))
+
+(defn run-system
+  "Runs a single system fn on matching components"
+  [app-state name]
+  (let [{:keys [entities systems]} (deref app-state)
+        {sys-fn :fn comp-ids :comp-ids} (systems name)
+        valid-entity? (make-entity-validator comp-ids)
+        matching-entities (filter valid-entity? entities)]
+     (dorun
+       (map
+         (fn [[eid estate]] (sys-fn app-state eid estate))
+         matching-entities))))
+
+
+(let (a "hello" b "whatever")
+
+(defn foo [{c :a d :b}]
   )
+
+(run-system app-state :render)
+
+(def a 23)
+
+
+
+(let [a 42
+       (+ a 10)
+      a :foo]
+  b)


Fixed warning about redefining update.

Fixed warning about redefining update.

--- src/cljc/com/lemondronor/pid.cljc
+++ src/cljc/com/lemondronor/pid.cljc
@@ -1,4 +1,5 @@
-(ns com.lemondronor.pid)
+(ns com.lemondronor.pid
+  (:refer-clojure :exclude [update]))

 (defn scale


Fix warning about redefining print

Fix warning about redefining print

--- src/cljs/asciinema_player/vt.cljs
+++ src/cljs/asciinema_player/vt.cljs
@@ -1,4 +1,5 @@
 (ns asciinema-player.vt
+  (:refer-clojure :exclude [print])
   (:require [clojure.string :as string]))

 ;; References:


Cleanup

Cleanup

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -9,8 +9,6 @@
 (defn- normalize-board
   "Uses p2-focused-board if present"
   [data]
-  (println "--normalize-board")
-  (println data)
   (if (data :p2-focused-board)
     (-> data
         (assoc :board (data :p2-focused-board))
@@ -136,7 +134,6 @@
   [game position]
   (let [player-code (get-in game [:game-data "viewed-by" "player-code"])
         pos (name position)]
-    (println "get-name-for " pos " code: " player-code)
     (cond
       (= "p1" pos player-code) (get-in game [:game-data "p1" "name"])
       (= ["p2" pos player-code] ["p2" "p1" "p2"]) (get-in game [:game-data "p2" "name"])
@@ -178,7 +175,6 @@
         new-actions (conj actions current-action)
         current-game (state/get-state :game-data)
         updated-game (assoc current-game "board" (or (get data "p2-focused-board") (get data "board")))]
-    (println updated-game)
     (state/set-state :game-data updated-game)
     (state/set-state :current-actions new-actions)
     (state/set-state :processing-action nil)
@@ -192,13 +188,9 @@
 (defn- game-deployed
   "After the game was deployed"
   [data]
-  (println (state/get-state :game-data))
-  (println "--game deployed")
-  (println data)
   (state/set-state :game-data data)
   (state/set-state :current-actions nil)
-  (state/set-state :processing-action nil)
-    )
+  (state/set-state :processing-action nil))

 (defn- deploy-game
   "Deploys a game"
@@ -230,7 +222,6 @@
         jsgame (js/encodeURIComponent (.stringify js/JSON (clj->js game)))
         url (str "http://rules.api.orionsbelt.eu/game/turn/" player-code "?context=" jsgame)]
     (state/set-state :processing-action action)
-    (println (.stringify js/JSON (clj->js new-actions)))
     (GET url {:handler action-added
               :error-handler error-loading-action})))

@@ -248,8 +239,8 @@
     (cond
       (state :processing-action) "disabled"
       (not= "deploy" (get-in state [:original-game-data "board" "state"])) "disabled"
-      (empty? (get-in state [:game-data "board" "stash" player-code])) ""
-      :else "disabled")))
+      (empty? (get-in state [:original-game-data "board" "stash" player-code])) "disabled"
+      :else "")))

 (defn- render-action-console
   "Renders the action management console"


Pre's make everything better.

Pre's make everything better.

--- src/cljs/onyx_dashboard/core.cljs
+++ src/cljs/onyx_dashboard/core.cljs
@@ -47,8 +47,7 @@

 (defcomponent select-deployment [{:keys [deployments deployment]} owner]
   (render [_]
-          (dom/div
-            "Some deployment: "
+          (dom/div
             (b/toolbar {}
                        (apply (partial b/dropdown {:bs-style "primary"
                                                    :title (or (:id deployment)
@@ -116,13 +115,15 @@

 (defcomponent catalog-view [catalog owner]
   (render [_]
-          (om/build ankha/collection-view catalog {:opts {:open? true}})))
+          (dom/pre
+           (om/build ankha/collection-view catalog {:opts {:open? true}}))))

 (defcomponent job-info [{:keys [selected-job jobs]} owner]
   (render [_]
           (if-let [job (and selected-job jobs (jobs selected-job))]
-            (dom/div
-              (dom/div (str (om/value job)))
+            (dom/div
+             (dom/pre
+              (dom/div (str (om/value job))))
               (if-let [catalog (:catalog job)]
                 (om/build catalog-view catalog {}))))))

@@ -175,11 +176,13 @@
       (reify
         om/IRender
         (render [_]
-          (dom/div
+          (dom/div
+           (g/grid
+            {}
             (om/build select-deployment app {})
             (dom/aside {}
                        (dom/nav (om/build job-selector (:deployment app) {}))
                        (dom/nav (om/build job-info (:deployment app) {}))
-                       (dom/nav (om/build deployment-entries (:deployment app) {})))))))
+                       (dom/nav (om/build deployment-entries (:deployment app) {}))))))))
     app-state
     {:target (. js/document (getElementById "app"))}))


use contains in turn to switch player

use contains in turn to switch player

--- src/cljs/triboard/logic/turn.cljs
+++ src/cljs/triboard/logic/turn.cljs
@@ -12,14 +12,19 @@
 ;; Private
 ;; -----------------------------------------

+(defn- who-can-play
+  "Given the current player and the transitions for the next turn,
+   returns the next player that has at least one transition available"
+  [player transitions]
+  (filter #(contains? transitions %) (player/next-three player)))
+
 (defn- with-next-player
   "Complete the turn to compute to find the next player than can act
    * Requires to look-ahead for the next possible transitions
    * To save computation, keep this look-ahead available"
   [{:keys [board player] :as turn}]
   (let [transitions (transition/all-transitions board)
-        who-can-play (filter #(get transitions %) (player/next-three player))
-        next-player (first who-can-play)]
+        next-player (first (who-can-play player transitions))]
     (-> turn
       (assoc :transitions (get transitions next-player))
       (assoc :player next-player)


Fix find exception on Windows

Fix find exception on Windows

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -18,7 +18,8 @@
            [javax.swing.event DocumentListener HyperlinkEvent$EventType]
            [nightcode.ui JConsole]
            [org.fife.ui.rsyntaxtextarea FileLocation TextEditorPane Theme]
-           [org.fife.ui.rtextarea RTextScrollPane SearchContext SearchEngine]))
+           [org.fife.ui.rtextarea RTextScrollPane SearchContext SearchEngine
+            SearchResult]))

 (def editors (atom (flatland/ordered-map)))
 (def font-size (atom (utils/read-pref :font-size 14)))
@@ -241,10 +242,13 @@
           (.setCaretPosition text-area 0))
         (when (.isShiftDown e)
           (.setSearchForward context false)))
-      (if (and valid-search?
-               (-> (SearchEngine/find text-area context) .getCount (= 0)))
-        (s/config! e :background (color/color :red))
-        (s/config! e :background nil))
+      (if (or (not valid-search?)
+              (let [result (SearchEngine/find text-area context)]
+                (if (isa? (type result) SearchResult)
+                  (-> result .getCount (> 0))
+                  result)))
+        (s/config! e :background nil)
+        (s/config! e :background (color/color :red)))
       (when (= (count find-text) 0)
         (SearchEngine/find text-area context)))))

@@ -262,7 +266,7 @@
       (if (and enter-key?
                (or (= (count find-text) 0)
                    (not (try (SearchEngine/replaceAll text-area context)
-                          (catch Exception e false)))))
+                          (catch Exception _ false)))))
         (s/config! e :background (color/color :red))
         (s/config! e :background nil))
       (when enter-key?


Pass on the container ID to the app

Pass on the container ID to the app

--- src/clojure/nightcode/sandbox.clj
+++ src/clojure/nightcode/sandbox.clj
@@ -22,7 +22,9 @@
   []
   (when (get-dir)
     (let [path (get-path ".lein")]
-      (into-array String [(str "LEIN_HOME=" path)]))))
+      (into-array String [(str "LEIN_HOME=" path)
+                          (str "APP_SANDBOX_CONTAINER_ID="
+                               (System/getenv "APP_SANDBOX_CONTAINER_ID"))]))))

 (defn set-properties!
   []


:sparkles: Enable drawing new canvas.

:sparkles: Enable drawing new canvas.

--- frontend/src/uxbox/main/geom.cljs
+++ frontend/src/uxbox/main/geom.cljs
@@ -177,6 +177,7 @@
 (defn setup-proportions
   [shape]
   (case (:type shape)
+    :canvas (setup-proportions-rect shape)
     :rect (setup-proportions-rect shape)
     :circle (setup-proportions-rect shape)
     :icon (setup-proportions-image shape)


:bug: Fix login and logout remo handlers.

--- frontend/src/uxbox/main/repo.cljs
+++ frontend/src/uxbox/main/repo.cljs
@@ -122,14 +122,14 @@

 (defmethod mutation :login
   [id params]
-  (let [url (str url "/login")]
+  (let [url (str url "/api/login")]
     (->> (impl-send {:method :post :url url :body params})
          (rx/map conditional-decode)
          (rx/mapcat handle-response))))

 (defmethod mutation :logout
   [id params]
-  (let [url (str url "/logout")]
+  (let [url (str url "/api/logout")]
     (->> (impl-send {:method :post :url url :body params :auth false})
          (rx/map conditional-decode)
          (rx/mapcat handle-response))))


Exposed get-look-from-skin for external usage

--- flatguiskins/src/flatgui/skins/skinbase.clj
+++ flatguiskins/src/flatgui/skins/skinbase.clj
@@ -6,7 +6,7 @@
 ; the terms of this license.
 ; You must not remove this notice, or any other, from this software.

-(ns ^{:doc "'Oldschool' skin"
+(ns ^{:doc "Skin utilities"
       :author "Denys Lebediev"}
   flatgui.skins.skinbase
   (:use flatgui.base))
@@ -15,16 +15,18 @@
 (defn widgettype->key [widgettype]
   (keyword widgettype))

+(defn get-look-from-skin [skin-name skin-key]
+  (let [skin (find-ns (symbol skin-name))]
+    (if skin
+      (let [skin-map (var-get (ns-resolve skin 'skin-map))]
+        (get-in skin-map skin-key))
+      (throw (IllegalArgumentException. (str "Skin not found:" skin-name))))))
+
 (defevolverfn skin-look-evolver :look
   (cond

     (:skin-key component)
-    (let [skin-name (get-property component [:this] :skin)
-          skin (find-ns (symbol skin-name))]
-      (if skin
-        (let [skin-map (var-get (ns-resolve skin 'skin-map))]
-          (get-in skin-map (:skin-key component)))
-        (throw (IllegalArgumentException. (str "Skin not found:" skin-name)))))
+    (get-look-from-skin (get-property component [:this] :skin) (:skin-key component))

     old-look
     old-look


Bump version of cider plugin.

Bump version of cider plugin.


remove unused requires

remove unused requires

--- main/src/dda/pallet/dda_managed_vm/domain/user.clj
+++ main/src/dda/pallet/dda_managed_vm/domain/user.clj
@@ -12,11 +12,8 @@
 ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 ; See the License for the specific language governing permissions and
 ; limitations under the License.
-(ns dda.pallet.dda-managed-vm.domain.user
-  (:require
-   [schema.core :as s]
-   [clojure.string :as str]))
-
+(ns dda.pallet.dda-managed-vm.domain.user)
+
 (defn authorized-keys
   [user]
   (let [{:keys [ssh]} user]


More indexing.

More indexing.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -5,23 +5,41 @@
   {:rmap (sorted-map)
    :imap (sorted-map)})

-(defn- index-assoc [index on record]
-  (if-let [val (on record)]
-    (assoc index val (:id record))))
+(defn- index-insert [index on record]
+  (let [val (on record)]
+    (if (not (nil? val))
+      (assoc index val (:id record)))))
+
+(defn- indexes-insert [imap record]
+  (reduce
+    (fn [int-imap [on index]]
+      (if-let [new-index (index-insert index on record)]
+        (assoc int-imap on new-index)
+        int-imap))
+    imap imap))
+
+(defn- index-delete [index on record]
+  (let [val (on record)]
+    (if (not (nil? val))
+      (dissoc index val))))
+
+(defn- indexes-delete [imap record]
+  (reduce
+    (fn [int-imap [on index]]
+      (if-let [new-index (index-delete index on record)]
+        (assoc int-imap on new-index)
+        int-imap))
+    imap imap))

 (defn- q-insert [db {:keys [record]}]
   (assert record)
   (let [id   (:id record)
-        rmap (:rmap db)
-        imap (:imap db)]
+        {old-rmap :rmap old-imap :imap} db]
     (assert id)
-    (assert (not (contains? rmap id)))
-    (let [rmap-new (assoc rmap id record)
-          imap-new (reduce
-                     (fn [imap-int [on index]]
-                       (assoc imap-int on (index-assoc index on record)))
-                     imap imap)]
-      (assoc db :rmap rmap-new :imap imap-new))))
+    (assert (not (contains? old-rmap id)))
+    (let [new-rmap (assoc old-rmap id record)
+          new-imap (indexes-insert old-imap record)]
+      (assoc db :rmap new-rmap :imap new-imap))))

 (def- conj-op?
   #{:and :or})
@@ -95,27 +113,35 @@

 (defn- q-update [db {:keys [with] :as opts}]
   (assert with)
-  (let [old-rmap   (:rmap db)
-        up-records (find-records (vals old-rmap) opts)
-        new-rmap
+  (let [{old-rmap :rmap old-imap :imap} db
+        old-records     (find-records (vals old-rmap) opts)
+        num-old-records (count old-records)
+        [new-rmap new-imap]
           (reduce
-            (fn [int-rmap up-record]
-              (assoc int-rmap (:id up-record)
-                (merge-compact up-record with)))
-            old-rmap
-            up-records)]
-    (assoc db :rmap new-rmap)))
+            (fn [[int-rmap int-imap] old-record]
+              (let [new-record (merge-compact old-record with)
+                    aug-rmap   (assoc (:id old-record) new-record)
+                    aug-imap   (-> int-imap
+                                 (indexes-delete old-record)
+                                 (indexes-insert new-record))]
+                [aug-rmap aug-imap]))
+            [old-rmap old-imap]
+            old-records)]
+    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

 (defn- q-delete [db opts]
-  (let [old-rmap    (:rmap db)
-        del-records (find-records (vals old-rmap) opts)
-        new-rmap
+  (let [{old-rmap :rmap old-imap :imap} db
+        old-records (find-records (vals old-rmap) opts)
+        num-old-records (count old-records)
+        [new-rmap new-imap]
           (reduce
-            (fn [int-rmap del-record]
-              (dissoc int-rmap (:id del-record)))
-            old-rmap
-            del-records)]
-    (assoc db :rmap new-rmap)))
+            (fn [[int-rmap int-imap] old-record]
+              (let [aug-rmap (dissoc int-rmap (:id old-record))
+                    aug-imap (indexes-delete int-imap old-record)]
+                [aug-rmap aug-imap]))
+            [old-rmap old-imap]
+            old-records)]
+    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

 (defn- q-index [db {:keys [on where]}]
   (assoc-in db [:imap on]


Introduce explain.

Introduce explain.

--- src/fleetdb/core.clj
+++ src/fleetdb/core.clj
@@ -99,8 +99,6 @@

 (defn- where-plans [db where order]
   [{:action  :db-scan
-    :options nil
-    :source  nil
     :order   [:id :asc]
     :size    :db
     :cost    [:scan :db]}])
@@ -110,50 +108,50 @@
     source
     {:action  :filter
      :options {:where where}
-     :source  source
      :order   (:order source)
      :size    (:size source)
-     :cost    [:scan (:size source)]}))
+     :cost    [:scan (:size source)]
+     :source  source}))

 (defn- order-plan [source order]
   (if (or (not order) (= order (:order source)))
     source
     {:action  :sort
      :options {:order order}
-     :source  source
      :order   order
      :size    (:size source)
-     :cost    [:sort (:size source)]}))
+     :cost    [:sort (:size source)]
+     :source  source}))

 (defn- offset-plan [source offset]
   (if-not offset
     source
     {:action  :offset
      :options {:offset offset}
-     :source  source
      :order   (:order source)
      :size    (:size source)
-     :cost    [:scan :range]}))
+     :cost    [:scan :range]
+     :source  source}))

 (defn- limit-plan [source limit]
   (if-not limit
     source
     {:action  :limit
      :options {:limit limit}
-     :source  source
      :order   (:order source)
      :size    (:size source)
-     :cost    [:scan :range]}))
+     :cost    [:scan :range]
+     :source  source}))

 (defn- only-plan [source only]
   (if-not only
     source
     {:action  :only
      :options {:only only}
-     :source  source
      :order   (:order source)
      :size    (:size source)
-     :cost    [:scan (:size source)]}))
+     :cost    [:scan (:size source)]
+     :source  source}))

 (defn symbolic-costs [{:keys [source] :as plan}]
   (cons (:cost plan)
@@ -254,6 +252,11 @@
             old-records)]
     [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

+(defn- q-explain [db {[query-type opts] :query :as explain-opts}]
+  (assert (= query-type :select))
+  (let [{:keys [where order offset limit only]} opts]
+    (select-plan db where order offset limit only)))
+
 (defn- q-create-index [db {:keys [on where]}]
   (let [records (vals (:rmap db))
         index
@@ -298,6 +301,7 @@
    :insert        q-insert
    :update        q-update
    :delete        q-delete
+   :explain       q-explain
    :create-index  q-create-index
    :drop-index    q-drop-index
    :list-indexes  q-list-indexes


change to deftype

change to deftype

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

--- plugins/SlideExplorer2/src/slide_explorer/cache.clj
+++ plugins/SlideExplorer2/src/slide_explorer/cache.clj
@@ -44,6 +44,20 @@
   (has [this key]
        "Checks if image is available in cache."))

+(deftype ImageCache [cache-agent dir memory-cache-size]
+  ImageCacheProtocol
+    (add [_ key image] (add-image cache-agent dir key image))
+    (get [_ key] (get-image cache-agent dir key))
+    (has [_ key] (has-image @cache-agent dir key))
+  clojure.lang.IRef
+    (addWatch [_ Object IFn] (.addWatch cache-agent Object IFn))
+    (deref [_] (.deref cache-agent))
+    (getValidator [_] (.getValidator cache-agent))
+    (getWatches [_] (.getWatches cache-agent))
+    (removeWatch [_ Object] (.removeWatch cache-agent Object))
+    (setValidator [_ IFn] (.setValidator cache-agent IFn))
+  )
+
 (defn image-cache
   "Creates an image cache that uses a LRU policy to store memory-cache-size images in memory,
    and also stores all images on disk in TIFF files in the specified directory."
@@ -53,6 +67,7 @@
       (add [key image] (add-image this dir key image))
       (get [key] (get-image this dir key))
       (has [key] (has-image this dir key))
+      (ADD
       (toString [] (str t ". On disk: " dir)))

 ;; test