Added save->

Added save->

--- src/cooljure/core.clj
+++ src/cooljure/core.clj
@@ -98,6 +98,27 @@
   (reduce   #(conj %1 (first %2) (second %2))
             [] (seq m) ))

+; #awt #todo: Test failure of (safe-> 3 (* 2) (+ 1))
+; #awt #todo: finish safe->>
+(defmacro safe->
+  "When expr is not nil, threads it into the first form (via ->), and when that result is not nil,
+   through the next etc.  If result is nil, throw IllegalArgumentException"
+  [expr & forms]
+  (let [g     (gensym)
+        pstep (fn [step] `(if (nil? ~g)
+                            (throw (IllegalArgumentException. (str "Nil value passed to form '" ~step \')))
+                            #_(do (println "g=" ~g) (spyxx (-> ~g ~step)))
+                                ;; (def mm {:a {:b 2}})
+                                ;; user=> (safe-> mm (:aa) (:b))
+                                ;; g= {:a {:b 2}}
+                                ;; NullPointerException   user/eval1850 (form-init5653535826905962071.clj:1)
+                                ;; user=> (safe-> mm :aa :b)   ; works
+                            (-> ~g ~step)
+                          )) ]
+    `(let [~g ~expr
+           ~@(interleave (repeat g) (map pstep forms))]
+       ~g)))
+
 (defmacro with-exception-default
   "Evaluates body & returns its result.  In the event of an exception, default-val is returned
    instead of the exception."


#6 Fix alert message and get-co2 message

--- src/antlion_clojure/bot.clj
+++ src/antlion_clojure/bot.clj
@@ -346,7 +346,7 @@
     (map->Payload {:type :message
                    :user (:user res)
                    :channel (:channel res)
-                   :text (str "っ＝[" last-state "ppm]")})))
+                   :text (str last-state "ppmﾀﾞﾖ-")})))

 (defn- set-lemming-led
   [{:keys [slack to-lemming-usecase res] :as opt} value]
@@ -463,7 +463,9 @@
         (map->Payload
           {:type :message
            :channel channel-id
-           :text (str "ﾜｰﾆﾝ!つ = [Co2濃度" max-ppm "ppmを超えました]")})))))
+           :text (str
+                   "<!here> " (:value co2) "ppmﾀﾞﾖ-\n"
+                   "*空気中のCo2濃度が" max-ppm "ppmを超えました*")})))))

 (defn register-events!
   [{:keys [slack dynamodb] :as opt}]


create table, sys_context

create table, sys_context

--- ddl.clj
+++ ddl.clj
@@ -1,4 +1,5 @@
-  CREATE TABLE "MART_USER"."RM_CASE_ASSESS"
+
+  create table "RM_CASE_ASSESS"
   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"TEMPLATE_ID" NUMBER,
@@ -166,8 +167,8 @@
 --  DDL for Table RM_CASE_CLASSIFICATIONS
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_CLASSIFICATIONS"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_CLASSIFICATIONS"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"CLASSIFICATION_ID" NUMBER,
@@ -224,8 +225,8 @@
 --  DDL for Table RM_CASE_EVENT
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_EVENT"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_EVENT"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"DESC_REPTD" varchar(250),
@@ -417,8 +418,8 @@
 --  DDL for Table RM_CASE_EVENT_ASSESS
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_EVENT_ASSESS"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_EVENT_ASSESS"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"EVENT_SEQ_NUM" NUMBER,
 	"PROD_SEQ_NUM" NUMBER,
@@ -492,8 +493,8 @@
 --  DDL for Table RM_CASE_FOLLOWUP
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_FOLLOWUP"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_FOLLOWUP"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"RECEIPT_DATE" DATE,
@@ -561,8 +562,8 @@
 --  DDL for Table RM_CASE_MASTER
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_MASTER"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_MASTER"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"CASE_NUM" varchar(20),
 	"REV" NUMBER,
@@ -712,8 +713,8 @@
 --  DDL for Table RM_CASE_NARRATIVE
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_NARRATIVE"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_NARRATIVE"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"ABBREV_NARRATIVE" CLOB DEFAULT EMPTY_CLOB(),
 	"ABBREV_NARRATIVE_J" CLOB,
@@ -792,8 +793,8 @@
 --  DDL for Table RM_CASE_PAT_INFO
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_PAT_INFO"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_PAT_INFO"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"PAT_ID" varchar(10),
 	"PAT_SUBJ_NUM" varchar(20),
@@ -950,8 +951,8 @@
 --  DDL for Table RM_CASE_PROD_DRUGS
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_PROD_DRUGS"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_PROD_DRUGS"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"FORMULATION_ID" NUMBER,
@@ -1093,8 +1094,8 @@
 --  DDL for Table RM_CASE_PRODUCT
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_PRODUCT"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_PRODUCT"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"PRODUCT_ID" NUMBER,
@@ -1324,8 +1325,8 @@
 --  DDL for Table RM_CASE_REPORTERS
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_REPORTERS"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_REPORTERS"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"SEQ_NUM" NUMBER,
 	"MEDIA_ID" NUMBER,
@@ -1433,8 +1434,8 @@
 --  DDL for Table RM_CASE_STUDY
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_CASE_STUDY"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_CASE_STUDY"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CASE_ID" NUMBER,
 	"STUDY_KEY" NUMBER,
 	"STUDY_NUM" varchar(35),
@@ -1525,8 +1526,8 @@
 --  DDL for Table RM_LM_CASE_CLASSIFICATION
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_CASE_CLASSIFICATION"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_CASE_CLASSIFICATION"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CLASSIFICATION_ID" NUMBER,
 	"DESCRIPTION" varchar(30),
 	"PROTECTED" NUMBER,
@@ -1568,8 +1569,8 @@
 --  DDL for Table RM_LM_CAUSALITY
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_CAUSALITY"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_CAUSALITY"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"CAUSALITY_ID" NUMBER,
 	"CAUSALITY" varchar(35),
 	"REPORTABILITY" NUMBER,
@@ -1611,8 +1612,8 @@
 --  DDL for Table RM_LM_COUNTRIES
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_COUNTRIES"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_COUNTRIES"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"COUNTRY_ID" NUMBER,
 	"COUNTRY" varchar(50),
 	"A2" varchar(2),
@@ -1658,8 +1659,8 @@
 --  DDL for Table RM_LM_PRODUCT
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_PRODUCT"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_PRODUCT"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"PRODUCT_ID" NUMBER,
 	"PROD_NAME" varchar(70),
 	"FAMILY_ID" NUMBER,
@@ -1752,8 +1753,8 @@
 --  DDL for Table RM_LM_PRODUCT_FAMILY
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_PRODUCT_FAMILY"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_PRODUCT_FAMILY"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"FAMILY_ID" NUMBER,
 	"NAME" varchar(40),
 	"PRIMARY_VIEW" NUMBER,
@@ -1795,8 +1796,8 @@
 --  DDL for Table RM_LM_REPORT_TYPE
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_LM_REPORT_TYPE"
-   (	"ENTERPRISE_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','enterprise_id'),
+  create table "RM_LM_REPORT_TYPE"
+   (	"ENTERPRISE_ID" NUMBER ,
 	"RPT_TYPE_ID" NUMBER,
 	"REPORT_TYPE" varchar(30),
 	"PROTECTED" NUMBER,
@@ -1845,8 +1846,8 @@
 --  DDL for Table RM_MEDDRA_SMQ_CONTENT
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_MEDDRA_SMQ_CONTENT"
-   (	"GLOBAL_DICT_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','meddra_global_dict_id'),
+  create table "RM_MEDDRA_SMQ_CONTENT"
+   (	"GLOBAL_DICT_ID" NUMBER ,
 	"SMQ_CODE" NUMBER,
 	"TERM_CODE" NUMBER,
 	"TERM_LEVEL" NUMBER,
@@ -1902,8 +1903,8 @@
 --  DDL for Table RM_MEDDRA_SMQ_LIST
 --------------------------------------------------------

-  CREATE TABLE "MART_USER"."RM_MEDDRA_SMQ_LIST"
-   (	"GLOBAL_DICT_ID" NUMBER DEFAULT SYS_CONTEXT('ARGUS_MART_CTX','meddra_global_dict_id'),
+  create table "RM_MEDDRA_SMQ_LIST"
+   (	"GLOBAL_DICT_ID" NUMBER ,
 	"SMQ_CODE" NUMBER,
 	"SMQ_NAME" varchar(100),
 	"SMQ_LEVEL" NUMBER,


Change the parameters order of `relativize` function.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -231,9 +231,9 @@

 (defn relativize
   "Returns the relationship between two paths."
-  [path1 path2]
-  (.relativize ^Path (pt/-path path1)
-               ^Path (pt/-path path2)))
+  [base other]
+  (.relativize ^Path (pt/-path other)
+               ^Path (pt/-path base)))

 (defn to-file
   "Converts the path to a java.io.File instance."


Fixing problem with campaign generation in ECHO10.

--- umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/echo10.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/echo10.clj
@@ -81,44 +81,44 @@
   "Returns ECHO10 XML structure from UMM collection record c."
   [c]
   (xml
-   [:Collection
-    [:ShortName (:EntryId c)]
-    [:VersionId (:Version c)]
-    [:InsertTime "1999-12-31T19:00:00-05:00"]
-    [:LastUpdate "1999-12-31T19:00:00-05:00"]
-    [:LongName "dummy-long-name"]
-    [:DataSetId (:EntryTitle c)]
-    [:Description (:Abstract c)]
-    [:CollectionDataType (:CollectionDataType c)]
-    [:Orderable "true"]
-    [:Visible "true"]
-    [:SuggestedUsage (:Purpose c)]
-    [:ProcessingLevelId (-> c :ProcessingLevel :Id)]
-    [:ProcessingLevelDescription (-> c :ProcessingLevel :ProcessingLevelDescription)]
-    [:CollectionState (:CollectionProgress c)]
-    [:RestrictionFlag (-> c :AccessConstraints :Value)]
-    [:RestrictionComment (-> c :AccessConstraints :Description)]
-    [:Price (-> c :Distributions first :Fees)]
-    [:DataFormat (-> c :Distributions first :DistributionFormat)]
-    [:SpatialKeywords
-     (for [kw (:SpatialKeywords c)]
-       [:Keyword kw])]
-    [:TemporalKeywords
-     (for [kw (:TemporalKeywords c)]
-       [:Keyword kw])]
-    (echo10-temporal c)
-    (echo10-platforms c)
-    [:AdditionalAttributes
-     (for [aa (:AdditionalAttributes c)]
-       [:AdditionalAttribute
-        (elements-from aa
-                       :Name :Description :DataType :ParameterRangeBegin
-                       :ParameterRangeEnd :Value)])]
-    (for [{:keys [ShortName LongName StartDate EndDate]} (:Projects c)]
-      [:Campaigns
-       [:Campaign
-        [:ShortName ShortName]
-        [:LongName LongName]
-        [:StartDate StartDate]
-        [:EndDate EndDate]]])
-    (spatial/spatial-element c)]))
+    [:Collection
+     [:ShortName (:EntryId c)]
+     [:VersionId (:Version c)]
+     [:InsertTime "1999-12-31T19:00:00-05:00"]
+     [:LastUpdate "1999-12-31T19:00:00-05:00"]
+     [:LongName "dummy-long-name"]
+     [:DataSetId (:EntryTitle c)]
+     [:Description (:Abstract c)]
+     [:CollectionDataType (:CollectionDataType c)]
+     [:Orderable "true"]
+     [:Visible "true"]
+     [:SuggestedUsage (:Purpose c)]
+     [:ProcessingLevelId (-> c :ProcessingLevel :Id)]
+     [:ProcessingLevelDescription (-> c :ProcessingLevel :ProcessingLevelDescription)]
+     [:CollectionState (:CollectionProgress c)]
+     [:RestrictionFlag (-> c :AccessConstraints :Value)]
+     [:RestrictionComment (-> c :AccessConstraints :Description)]
+     [:Price (-> c :Distributions first :Fees)]
+     [:DataFormat (-> c :Distributions first :DistributionFormat)]
+     [:SpatialKeywords
+      (for [kw (:SpatialKeywords c)]
+        [:Keyword kw])]
+     [:TemporalKeywords
+      (for [kw (:TemporalKeywords c)]
+        [:Keyword kw])]
+     (echo10-temporal c)
+     (echo10-platforms c)
+     [:AdditionalAttributes
+      (for [aa (:AdditionalAttributes c)]
+        [:AdditionalAttribute
+         (elements-from aa
+                        :Name :Description :DataType :ParameterRangeBegin
+                        :ParameterRangeEnd :Value)])]
+     [:Campaigns
+      (for [{:keys [ShortName LongName StartDate EndDate]} (:Projects c)]
+        [:Campaign
+         [:ShortName ShortName]
+         [:LongName LongName]
+         [:StartDate StartDate]
+         [:EndDate EndDate]])]
+     (spatial/spatial-element c)]))


get-user client knows how to fall-back to bots

--- src/braid/common/state.cljs
+++ src/braid/common/state.cljs
@@ -28,9 +28,14 @@
 (defn get-user
   "Get user by id. Can be sub'd directly or dynamically"
   ([state [_ user-id]]
-   (reaction (get-in @state [:users user-id])))
+   (get-user state nil [user-id]))
   ([state _ [user-id]]
-   (reaction (get-in @state [:users user-id]))))
+   (reaction (if-let [u (get-in @state [:users user-id])]
+               u
+               (let [g-id (@state :open-group-id)
+                     group-bots (get-in @state [:groups g-id :bots])]
+                 (first (filter (fn [b] (= (b :user-id user-id)))
+                                group-bots)))))))

 (defn get-users
   [state _]


Remove unnecessary let.

Remove unnecessary let.

--- src/onyx/flow_conditions/fc_routing.cljc
+++ src/onyx/flow_conditions/fc_routing.cljc
@@ -37,22 +37,21 @@
    (->Route #{} #{} nil nil)
    compiled-flow-conditions))

-(defn route-data [{:keys [egress-tasks compiled-ex-fcs compiled-norm-fcs
+(defn route-data [{:keys [egress-tasks compiled-ex-fcs compiled-norm-fcs onyx.core/task-id
                           onyx.core/flow-conditions] :as event} result message]
-  (let [{:keys [onyx.core/task-id]} event]
-    (if (nil? flow-conditions)
-      (if (exception? message)
+  (if (nil? flow-conditions)
+    (if (exception? message)
+      (let [{:keys [exception segment]} (ex-data message)]
+        (throw (maybe-attach-segment exception task-id segment)))
+      (->Route egress-tasks nil nil nil))
+    (if (exception? message)
+      (if (seq compiled-ex-fcs)
+        (choose-output-paths event compiled-ex-fcs result (:exception (ex-data message)) egress-tasks)
         (let [{:keys [exception segment]} (ex-data message)]
-          (throw (maybe-attach-segment exception task-id segment)))
-        (->Route egress-tasks nil nil nil))
-      (if (exception? message)
-        (if (seq compiled-ex-fcs)
-          (choose-output-paths event compiled-ex-fcs result (:exception (ex-data message)) egress-tasks)
-          (let [{:keys [exception segment]} (ex-data message)]
-            (throw (maybe-attach-segment exception task-id segment))))
-        (if (seq compiled-norm-fcs)
-          (choose-output-paths event compiled-norm-fcs result message egress-tasks)
-          (->Route egress-tasks nil nil nil))))))
+          (throw (maybe-attach-segment exception task-id segment))))
+      (if (seq compiled-norm-fcs)
+        (choose-output-paths event compiled-norm-fcs result message egress-tasks)
+        (->Route egress-tasks nil nil nil)))))

 (defn apply-post-transformation [message routes event]
   (let [post-transformation (:post-transformation routes)


Make the tests pass

Make the tests pass

--- src/caesium/randombytes.clj
+++ src/caesium/randombytes.clj
@@ -5,21 +5,7 @@
             [caesium.byte-bufs :as bb])
   (:import (java.nio ByteBuffer)))

-(defn random-to-byte-array!
-  "**DANGER** This function is low-level, you only want to use it if you are
-  managing your own buffers. See [[randombytes]] for a high level API that
-  creates the byte array buffer for you.
-
-  Given a byte array, populate it with n random bytes.
-
-  If n is not given, populates the entire array."
-  ([^bytes arr]
-   (random-to-byte-array! arr (bb/buflen arr)))
-  ([^bytes arr n]
-   (.randombytes b/sodium arr (long n))
-   arr))
-
-(defn random-to-byte-buffer!
+(defn random-to-buf!
   "**DANGER** This function is low-level, you only want to use it if you are
   managing your own buffers. See [[randombytes]] for a high level API that
   creates the buffer for you.
@@ -28,7 +14,7 @@

   If n is not given, populates the entire buffer."
   ([^ByteBuffer buf]
-   (random-to-byte-buffer! buf (.remaining buf)))
+   (random-to-buf! buf (.remaining buf)))
   ([^ByteBuffer buf n]
    (.randombytes b/sodium buf (long n))
    buf))
@@ -36,5 +22,4 @@
 (defn randombytes
   "Create a byte array with n random bytes."
   [n]
-  (let [buf (byte-array n)]
-    (random-to-byte-array! buf n)))
+  (bb/->bytes (random-to-buf! (bb/alloc n) n)))


layout

layout

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -17,8 +17,12 @@
     [slingshot.slingshot :only  [throw+ try+]]
     [celestial.model :only (vconstruct pconstruct rconstruct)])
   (:require ; loading defmethods
-    proxmox.provider aws.provider vc.provider
-    physical.provider docker.provider
+    proxmox.provider
+    aws.provider
+    vc.provider
+    physical.provider
+    docker.provider
+    openstack.provider
     celestial.puppet_standalone
     remote.capistrano remote.ruby
     ;cloning


fix args

fix args

--- src/clj/battlebots/game.clj
+++ src/clj/battlebots/game.clj
@@ -178,7 +178,8 @@
   [players clean-arena]
   (map (fn [{:keys [_id bot saved-state energy] :as player}]
          {:decision ((load-string bot)
-                     {:arena (get-arena-area clean-arena (get-player-coords _id) 10)
+                     {:arena (get-arena-area clean-arena
+                                             (get-player-coords _id clean-arena) 10)
                                         :state saved-state
                                         :bot_id _id
                                         :energy energy


source map comments

source map comments

--- src/clj/cljs/source_map.clj
+++ src/clj/cljs/source_map.clj
@@ -10,11 +10,24 @@
 ;; All source map code in the file assumes the following in memory
 ;; representation of source map data.
 ;;
-;; { file { line { col } } }
+;; { file-name[String]
+;;   { line[Integer]
+;;     { col[Integer]
+;;       [{ :gline ..., :gcol ..., :name ...}] } }
 ;;
-;; Each level is a sorted map. This simplifies merging ClojureScript source
-;; map information with source map information generated by Google Closure
-;; Compiler optimization.
+;; The outer level is a sorted map where the entries are file name and
+;; sorted map of line information, the keys are strings. The line
+;; information is represented as a sorted map of of column
+;; information, the keys are integers. The column information is a
+;; sorted map where the keys are integers and values are a vector of
+;; maps - these maps have the keys :gline and :gcol for the generated
+;; line and column.  A :name key may be present if available.
+;;
+;; This representation simplifies merging ClojureScript source map
+;; information with source map information generated by Google Closure
+;; Compiler optimization. We can now trivially create the merged map
+;; by using :gline and :gcol in the ClojureScript source map data to
+;; extract final :gline and :gcol from the Google Closure source map.

 ;; -----------------------------------------------------------------------------
 ;; Utilities


modify damage functions to support replacement

--- src/clj/game/core-rules.clj
+++ src/clj/game/core-rules.clj
@@ -99,7 +99,7 @@
 (defn damage-defer
   "Registers n damage of the given type to be deferred until later. (Chronos Protocol.)"
   [state side dtype n]
-  (swap! state assoc-in [:damage :defer-damage dtype] n ))
+  (swap! state assoc-in [:damage :defer-damage dtype] n))

 (defn get-defer-damage [state side dtype {:keys [unpreventable] :as args}]
   (when-not unpreventable (get-in @state [:damage :defer-damage dtype])))
@@ -110,16 +110,17 @@
   [state side type n {:keys [unpreventable unboostable card] :as args}]
   (swap! state update-in [:damage :defer-damage] dissoc type)
   (trigger-event state side :pre-resolve-damage type card n)
-  (let [n (if (get-defer-damage state side type args) 0 n)]
-    (let [hand (get-in @state [:runner :hand])]
-      (when (< (count hand) n)
-        (flatline state))
-      (when (= type :brain)
-        (swap! state update-in [:runner :brain-damage] #(+ % n))
-        (swap! state update-in [:runner :hand-size-modification] #(- % n)))
-      (doseq [c (take n (shuffle hand))]
-        (trash state side c {:unpreventable true :cause type} type))
-      (trigger-event state side :damage type card))))
+  (when-not (get-in @state [:damage :damage-replace])
+    (let [n (if (get-defer-damage state side type args) 0 n)]
+      (let [hand (get-in @state [:runner :hand])]
+        (when (< (count hand) n)
+          (flatline state))
+        (when (= type :brain)
+          (swap! state update-in [:runner :brain-damage] #(+ % n))
+          (swap! state update-in [:runner :hand-size-modification] #(- % n)))
+        (doseq [c (take n (shuffle hand))]
+          (trash state side c {:unpreventable true :cause type} type))
+        (trigger-event state side :damage type card)))))

 (defn damage
   "Attempts to deal n damage of the given type to the runner. Starts the
@@ -129,7 +130,7 @@
    (swap! state update-in [:damage :damage-bonus] dissoc type)
    (swap! state update-in [:damage :damage-prevent] dissoc type)
    ;; alert listeners that damage is about to be calculated.
-   (trigger-event state side :pre-damage type card)
+   (trigger-event state side :pre-damage type card n)
    (let [n (damage-count state side type n args)]
      (let [prevent (get-in @state [:prevent :damage type])]
        (if (and (not unpreventable) prevent (pos? (count prevent)))
@@ -141,12 +142,13 @@
                  (let [prevent (get-in @state [:damage :damage-prevent type])]
                    (system-msg state :runner
                                (if prevent
-                                 (str "prevents " (if (= prevent Integer/MAX_VALUE) "all" prevent )
-                                      " " (name type) " damage")
+                                 (do (str "prevents " (if (= prevent Integer/MAX_VALUE) "all" prevent)
+                                          " " (name type) " damage")
+                                     (trigger-event state side :prevented-damage type prevent))
                                  "will not prevent damage"))
                    (resolve-damage state side type (max 0 (- n (or prevent 0))) args)))
-               {:priority 10}))
-         (resolve-damage state side type n args))))))
+                 {:priority 10}))
+           (resolve-damage state side type n args))))))

 ;;; Tagging


Remove an incorrect comment

Remove an incorrect comment

--- src/clj/mdr2/production.clj
+++ src/clj/mdr2/production.clj
@@ -255,8 +255,6 @@

 (defn set-state-archived! [production]
   (delete-all-dirs! production)
-  ;; even if for some reason the directories were not deleted we set
-  ;; the state to "archived" anyway
   (set-state! production "archived"))

 (defn repair!


Monitor the delete-all-dirs! function

Monitor the delete-all-dirs! function

--- src/clj/mdr2/production.clj
+++ src/clj/mdr2/production.clj
@@ -286,3 +286,4 @@
 (prometheus/instrument! metrics/registry #'set-state-cataloged!)
 (prometheus/instrument! metrics/registry #'repair!)
 (prometheus/instrument! metrics/registry #'add-structure)
+(prometheus/instrument! metrics/registry #'delete-all-dirs!)


Use `apply concat` instead of `flatten` for performance

--- src/cljam/pileup/pileup.clj
+++ src/cljam/pileup/pileup.clj
@@ -63,7 +63,7 @@
                             (nth positions (quot (count positions) 2)))
                       alns (read-alignments-memo rdr rname rlength pos)]
                   (count-for-positions alns rname positions))))
-         flatten)))
+         (apply concat))))

 (defn first-pos
   "Return a position of first alignment in left-right, or nil."


Add with-credentials, again.

Add with-credentials, again.

--- src/cljs/movement/util.cljs
+++ src/cljs/movement/util.cljs
@@ -19,6 +19,7 @@
   (let [token (str "Token " (session/get :token))
         base-opts {:format          (edn-request-format)
                    :response-format (edn-response-format)
+                   :with-credentials true
                    :interceptors    [(to-interceptor {:name    "Token Interceptor"
                                                       :request #(assoc-in % [:headers "authorization"]
                                                                           token)})]}]
@@ -28,6 +29,7 @@
   (let [token (str "Token " (session/get :token))
         base-opts {:format          (edn-request-format)
                    :response-format (edn-response-format)
+                   :with-credentials true
                    :interceptors    [(to-interceptor {:name    "Token Interceptor"
                                                       :request #(assoc-in % [:headers "authorization"] token)})]
                    :headers {:x-csrf-token csrf-token}}]


Both optimizing and simplifying the code

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -57,10 +57,6 @@
 ;; IDENTIFY CONVERTIBLE CELLS
 ;; -----------------------------------------

-(defn ^boolean not_in-board?
-  [x y]
-  (or (neg? x) (neg? y) (> x board-width) (> y board-height)))
-
 (defn ^boolean is-cell-empty?
   "Indicates whether a cell is owned by any player"
   [cell]
@@ -70,13 +66,12 @@
   "Give all the pairs [cell coordinate] in the provided direction"
   [board [xi yi] [dx dy]]
   (loop [x xi, y yi, res []]
-    (if (or (not_in-board? x y) (is-cell-empty? (get-in board [x y])))
-      res
-      (recur
-        (+ x dx)
-        (+ y dy)
-        (conj res [(get-in board [x y]) [x y]])))
-    ))
+    (if-let [c (get-in board [x y])]
+      (if (is-cell-empty? c) res
+        (recur
+          (+ x dx) (+ y dy)
+          (conj res [c [x y]])))
+      res)))

 (defn range-cells ;; TODO - Use the concept of sentinel for the walls?
   "Give all the cells in the provided direction - until you reach an empty / blocked / wall cell"


Start work on AI algorithms

Start work on AI algorithms

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -170,6 +170,19 @@

 ;; -----------------------------------------
+;; ARTIFICIAL INTELLIGENCE
+;; -----------------------------------------
+
+(defn best-immediate-move
+  "Return the move with the highest immediate score increase for the provided player"
+  [game player]
+  (let [moves (get-in game [:moves player])]
+    (apply max-key
+      #(transduce (map (comp count :taken)) + (second %))
+      moves)))
+
+
+;; -----------------------------------------
 ;; GAME STATE
 ;; -----------------------------------------


refactor core

refactor core

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -24,16 +24,21 @@

 (def ai-move-delay 1000)

+(defn run-async
+  [computation]
+  (let [out-chan (chan 1)]
+    (go (>! out-chan (computation)))
+    out-chan))
+
 (defn ai-computation
   [game]
-  (let [out-chan (chan 1)
-        ai-chan (chan 1)]
+  (let [out-chan (chan 1)]
     (go
-      (<! (async/timeout 500)) ;; Avoid animation stalling (not multi-threading)
-      (>! ai-chan (ai/play-best-move game)))
-    (go
-      (<! (async/timeout ai-move-delay))
-      (let [g (<! ai-chan)] (>! out-chan g)))
+      (<! (async/timeout 500))
+      (let [ai-chan (run-async #(ai/play-best-move game))
+            _ (<! (async/timeout ai-move-delay))
+            g (<! ai-chan)]
+        (>! out-chan g)))
     out-chan))

 (defn start-game-loop


Removed useless check

Removed useless check

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -66,6 +66,7 @@
   "All neighbors of a given coordinate"
   [[x y]]
   (map (fn [[dx dy]] [(+ x dx) (+ y dy)]) directions))
+

 ;; -----------------------------------------
 ;; INIT THE BOARD
@@ -104,7 +105,6 @@

 (defn ^boolean is-cell-empty?
   "Indicates whether a cell is owned by any player"
-  {:pre [(or (nil? cell) (cell? cell))]}
   [cell]
   (or (nil? cell) (= cell :empty) (= cell :wall)))


Let's overfit like there's no tomorrow 2.

--- src/restaurants/model/decision_trees.clj
+++ src/restaurants/model/decision_trees.clj
@@ -35,7 +35,7 @@
       {:v l})))

 (defn stop-split? [records]
-  (<= (count records) 7))
+  (<= (count records) 1))

 (defn partitions [s]
   (map #(split-at % s) (range 1 (count s))))


Java Interface Autogeneration should work again

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/java.clj
+++ src/conexp/contrib/java.clj
@@ -47,8 +47,13 @@

 (defn- dissect-arglist
   [arglist]
-  (let [[a b] (split-with #(not= '& %) arglist)]
-    [a (rest b)]))
+  (if (not (vector? arglist))
+    arglist
+    (let [[a b] (split-with #(not= '& %) arglist)]
+      (if (not-empty b)
+        `(vec (list* ~@(map dissect-arglist a)
+                     ~(dissect-arglist (second b))))
+        (vec (map dissect-arglist arglist))))))

 (defn- function-signatures
   "Returns sequence of function signatures, each being suitable for
@@ -67,25 +72,20 @@
     (if-not arglists
       nil
       (for [arglist arglists]
-        (let [arglist-split (dissect-arglist arglist)]
-          [new-name
-           (if (empty? (second arglist-split))
-             (vec (map tag (first arglist-split)))
-             (conj (vec (map tag (first arglist-split)))
-                   "[Ljava.lang.Object;"))
-           return])))))
+        [new-name
+         (vec (map tag (dissect-arglist arglist)))
+         return]))))

 (defn- generate-definition
   "Generates function definition with name new-name, calling orig-name
   with supplied arguments. Prepends prefix before new-name"
   [prefix new-name orig-name & arglists]
-  `(defn ~(symbol (str prefix new-name))
-     ~@(for [args arglists]
-         (let [arglist-split (dissect-arglist args)]
-           `(~args
-             ~(if (not-empty (second arglist-split))
-                `(apply ~(symbol orig-name) ~@(first arglist-split) ~@(second arglist-split))
-                `(~(symbol orig-name) ~@(first arglist-split))))))))
+  (when (not-empty arglists)
+    `(defn ~(symbol (str prefix new-name))
+       ~@(for [args arglists]
+           (let [arglist-split (dissect-arglist args)]
+             `(~args
+               (apply ~(symbol orig-name) ~(dissect-arglist args))))))))

 ;;;


Change the comments that explain what `swap!` does

--- test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_020_atoms.clj
+++ test/com/nomistech/clojure_the_language/c_400_state_and_concurrency/s_020_atoms.clj
@@ -21,10 +21,10 @@
 (fact (deref *my-number) => 0)
 (fact @*my-number => 0)

-(do (swap! *my-number inc) ; does this: (inc 0)
+(do (swap! *my-number inc) ; replace the value with: (inc 0)
     (fact @*my-number => 1))

-(do (swap! *my-number inc) ; does this: (inc 1)
+(do (swap! *my-number inc) ; replace the value with: (inc 1)
     (fact @*my-number => 2))

 (fact "`swap` returns the new value of the atom"
@@ -39,10 +39,10 @@
 ;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ;;;; Supplying additional args to the data function:

-(do (swap! *my-number + 10) ; does this: (+ 2 10)
+(do (swap! *my-number + 10) ; replace the value with: (+ 2 10)
     (fact @*my-number => 12))

-(do (swap! *my-number + 1 2 3 4 5) ; does this: (+ 12 1 2 3 4 5)
+(do (swap! *my-number + 1 2 3 4 5) ; replace the value with: (+ 12 1 2 3 4 5)
     (fact @*my-number => 27))

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


ensuring distinct css file reloads

ensuring distinct css file reloads

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -473,13 +473,15 @@
          (.insertBefore parent klone (.-nextSibling orig-link)))
        (js/setTimeout #(.removeChild parent orig-link) 300))))

+(defn distictify [key seqq]
+  (vals (reduce #(assoc %1 (get %2 key) %2) {} seqq)))
+
 (defn reload-css-file [{:keys [file] :as f-data}]
-  (if-let [link (get-correct-link f-data)]
+  (when-let [link (get-correct-link f-data)]
     (add-link-to-doc link (clone-link link (.-href link)))
-    (add-link-to-doc (create-link file))))
+    #_(add-link-to-doc (create-link file))))

 (defn reload-css-files [{:keys [on-cssload] :as opts} files-msg]
   (when (utils/html-env?)
-    (doseq [f (:files files-msg)] (reload-css-file f))
+    (doseq [f (distictify :file (:files files-msg))] (reload-css-file f))
     (js/setTimeout #(on-cssload (:files files-msg)) 100)))
-


Whitespace

Whitespace

--- src/dat/sys/client/app.cljs
+++ src/dat/sys/client/app.cljs
@@ -1,19 +1,19 @@
 (ns dat.sys.client.app
-    (:require-macros [cljs.core.async.macros :refer [go-loop]]
-                     [reagent.ratom :refer [reaction]])
-    (:require [dat.view]
-              [dat.reactor :as reactor]
-              [dat.remote]
-              [dat.remote.impl.sente :as sente]
-              [dat.sync.client :as dat.sync]
-              [dat.sys.client.views :as views]
-              [dat.sys.client.events]
-              [dat.reactor.dispatcher :as dispatcher]
-              [datascript.core :as d]
-              [taoensso.timbre :as log :include-macros true]
-              [reagent.core :as r]
-              [com.stuartsierra.component :as component]
-              [posh.core :as posh]))
+  (:require-macros [cljs.core.async.macros :refer [go-loop]]
+                   [reagent.ratom :refer [reaction]])
+  (:require [dat.view]
+            [dat.reactor :as reactor]
+            [dat.remote]
+            [dat.remote.impl.sente :as sente]
+            [dat.sync.client :as dat.sync]
+            [dat.sys.client.views :as views]
+            [dat.sys.client.events]
+            [dat.reactor.dispatcher :as dispatcher]
+            [datascript.core :as d]
+            [taoensso.timbre :as log :include-macros true]
+            [reagent.core :as r]
+            [com.stuartsierra.component :as component]
+            [posh.core :as posh]))

 ;; # The system & main function


Remove printlns on client.

Remove printlns on client.

--- src/msgbus/client.clj
+++ src/msgbus/client.clj
@@ -22,7 +22,6 @@

 (defn- schedule
   [client]
-  (println "schedule")
   (let [active (.-active client)]
     (when (atomic/compare-and-set! active false true)
       (exec/execute! client))))
@@ -56,11 +55,9 @@
 (deftype AsyncClient [context state endpoint poller active]
   Runnable
   (run [this]
-    (println "AsyncClient$run")
     (try
       (let [items (zmq/poll! poller 3000)]
         (when-not (empty? items)
-          (println "AsyncClient$run$1" items)
           (handle-items state poller items)))
       (finally
         (atomic/set! active false)


Extract platform discovery

Extract platform discovery

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -3,29 +3,30 @@
             [pandect.core :as p]
             [clojure.java.io :as io]))

+(defn platform
+  "Returns a keyword representing the current platform, one of :win32, :win64,
+  :linux32, :linux64, or :mac."
+  []
+  (let [os-arch (. (System/getProperty "os.arch") toLowerCase)
+        os-name (. (System/getProperty "os.name") toLowerCase)]
+    (cond (and (.startsWith os-name "win") (= "x86" os-arch))      :win32
+          (and (.startsWith os-name "win") (= "x64" os-arch))      :win64
+          (and (.startsWith os-name "mac"))                        :mac
+          (and (.startsWith os-name "linux") (= "i386" os-arch))   :linux32
+          (and (.startsWith os-name "linux") (= "amd64" os-arch))  :linux64
+          :else
+          (throw (UnsupportedOperationException.
+                   (str "Unsupported platform: " os-name ", " os-arch))))))
+
 (defn- os-specific-path
   "Finds the OS specific path for the given library name."
   [s]
-  (let [os-arch (. (System/getProperty "os.arch") toLowerCase)
-        os-name (. (System/getProperty "os.name") toLowerCase)]
-    (cond (and (.startsWith os-name "win") (= "x86" os-arch))
-          (str "win-x86/" s ".dll")
-
-          (and (.startsWith os-name "win") (= "x64" os-arch))
-          (str "win-x86_64/" s ".dll")
-
-          (and (.startsWith os-name "mac")) ; assume all macs are 64bits
-          (str "macosx/" s ".dylib")
-
-          (and (.startsWith os-name "linux") (= "i386" os-arch))
-          (str "linux-x86/" s ".so")
-
-          (and (.startsWith os-name "linux") (= "amd64" os-arch))
-          (str "linux-x86_64/" s ".so")
-
-          :else (throw (UnsupportedOperationException.
-                         (str "Unsupported platform: " os-name ", " os-arch
-                              " for library " s))))))
+  (get {:win32   (str "win-x86/" s ".dll")
+        :win64   (str "win-x86_64/" s ".dll")
+        :mac     (str "macosx/" s ".dylib")
+        :linux32 (str "linux-x86/" s ".so")
+        :linux64 (str "linux-x86_64/" s ".so")}
+       (platform)))

 (defn- save-library
   [s]


fix event params

fix event params

--- src/notifier/core.clj
+++ src/notifier/core.clj
@@ -35,12 +35,12 @@
 (defn get-asx-prices []
   )

-(defn publish-event [event & value]
+(defn publish-event [event & values]
   (let[url (format  "https://maker.ifttt.com/trigger/%s/with/key/%s" event @ifttt-key)
-       body (into {} (for [i (range (count value))]
-                       [(->> i inc (str "value") keyword) value]))
+       body (into {} (map-indexed
+                      (fn[i v] [(->> i inc (str "value") keyword) v]) values))
        {:keys[status body]} @(http/post url {:headers {"Content-Type" "application/json"}
-                                             :body (and value (json/write-str body))})]
+                                             :body (and values (json/write-str body))})]
     (println "published event:" url " result:" status ":" body)
     status))


fix updating asx prices

fix updating asx prices

--- src/notifier/core.clj
+++ src/notifier/core.clj
@@ -81,13 +81,16 @@
   (let [asx-prices (persistent-atom file {})]
     (fn[]
       (if-let[new-prices (get-asx-prices)]
-        (doseq [[stock price] new-prices :let[event-prices (@asx-prices stock {})]]
-          (doseq [[pct prev-price] event-prices
-                  :let [change (-> (- price prev-price) (/ prev-price) (* 100))]]
-            (when (>= (Math/abs change) pct)
-              (publish-event (str "ASX-" stock "-" pct) (str price)
-                             (format "%+.1f%%" change))
-              (swap! asx-prices assoc stock (assoc event-prices pct price))))
+        (doseq [[stock price] new-prices
+                :let[event-prices (@asx-prices stock {})
+                     changes (for [[pct prev-price] event-prices
+                                   :let [change (-> (- price prev-price) (/ prev-price) (* 100))]
+                                   :when #(>= (Math/abs change) pct)] [pct change])]]
+          (doseq [[pct change] changes]
+            (publish-event (str "ASX-" stock "-" pct) (str price)
+                           (format "%+.1f%%" change)))
+          (if-not (empty? changes)
+            (swap! asx-prices assoc stock (apply assoc event-prices (for[[pct _] changes] [pct price]))))
           (if (empty? event-prices)
             (swap! asx-prices assoc stock (into {} (for [l percents] [l price])))))))))


Use slurp to download hosted scripts

Use slurp to download hosted scripts

We are getting HTTPS errors when downloading hosted scripts using
httpkip, while curl, browsers and slurp all work. This changes the
codeto use slurp.

Other minor changes:

- Retry 3 times per script rather than 3 times total.
- Include the failing script as well as the root exception in the
  ex-info when the download fails, rather than just asserting.
- Remove httpkit import that is no longer needed.

--- src/frontend/tasks/http.clj
+++ src/frontend/tasks/http.clj
@@ -6,8 +6,7 @@
             [fs]
             [stefon.core :as stefon]
             [stefon.manifest]
-            [cheshire.core :as json]
-            [org.httpkit.client :as http]))
+            [cheshire.core :as json]))

 (def stefon-options {:asset-roots frontend.stefon/asset-roots
                      :precompiles frontend.stefon/precompiles
@@ -16,22 +15,17 @@
                      :mode :production})

 (defn update-hosted-scripts [scripts]
-  (loop [tries 0]
-    (let [result (try
-                   (doseq [script scripts]
-                     (println (format "Updating %s" script))
-                     (let [response @(http/get (:url script) {:as :text})]
-                       (assert (= (:status response) 200))
-                       (spit (str "resources/assets/" (:path script)) (:body response))))
-                   :success
-                   (catch Exception e
-                     (if (> 3 tries)
-                       :retry
-                       :fail)))]
-      (condp = result
-        :success :success
-        :retry (recur (inc tries))
-        (throw (Exception. "Couldn't compile hosted scripts"))))))
+  (doseq [script scripts]
+    (println (format "Updating %s" script))
+    (loop [tries 3]
+      (when-not (try
+                  (spit (str "resources/assets/" (:path script))
+                        (slurp (:url script)))
+                  true
+                  (catch Exception e
+                    (when (zero? tries)
+                      (throw (ex-info "Couldn't update hosted script" script e)))))
+        (recur (dec tries))))))

 (defn generate-doc-manifest []
   (let [doc-root "resources/assets/docs"


Update dom.cljx

Update dom.cljx

--- src/om_tools/dom.cljx
+++ src/om_tools/dom.cljx
@@ -29,6 +29,7 @@
 (defn camel-case
   "Converts kebab-case to camelCase"
   [s]
+  (.log js/console s)
   (str/replace s #"-(\w)" (comp str/upper-case second)))

 (defn- opt-key-case


Cleanup omnibus.steps namespace form

Cleanup omnibus.steps namespace form

--- src/omnibus/steps.clj
+++ src/omnibus/steps.clj
@@ -18,12 +18,11 @@
 ;;

 (ns omnibus.steps
-  (:use [omnibus.log]
-        [clojure.contrib.logging :only [log]]
-        [clojure.contrib.io :only [make-parents file-str]]
-        [clojure.contrib.str-utils :only [str-join]]
-        [clojure.java.shell :only [sh with-sh-env with-sh-dir]])
-  (:require [clojure.contrib.string :as str])
+  (:use (omnibus (log :only [log-sh-result]))
+        (clojure.contrib (io :only [file-str])
+                         (logging :only [log])
+                         (str-utils :only [str-join]))
+        (clojure.java (shell :only [sh with-sh-env with-sh-dir])))
   (:gen-class))

 (defn run-shell


Update core.clj

Update core.clj

--- src/hasta_la_vista/core.clj
+++ src/hasta_la_vista/core.clj
@@ -146,9 +146,11 @@
                                                       thread-count          (get-in config [:ok :hasta-la-vista :thread-count])
                                                       thread-wait           (get-in config [:ok :hasta-la-vista :thread-wait]) ]
     (log/info (client/get-available-servers client))
+    (log/info "client-config" client-config "view-config" view-config)
     ;; creating N async threads
     (dotimes [i thread-count]
       (thread
+        (log/info "client-config" client-config "view-config" view-config)
         ;; inside a thread we usually process something
         ;; blocking like this thread sleeps for random(1000) ms
         ;; after the blocking part you send the message


Some more refactoring in pepa.web.poll.

Some more refactoring in pepa.web.poll.

--- src/pepa/web/poll.clj
+++ src/pepa/web/poll.clj
@@ -29,24 +29,21 @@
                        (-> data (data->response) (str \newline))
                        {:close? true}))))

-(defn spawn-client [db ch seqs content-type]
+(defn ^:private send-seqs! [db ch content-type]
+  ((send-fn content-type) ch {:seqs (m/sequence-numbers db)}))
+
+(defn ^:private handle-poll! [db ch seqs content-type]
   (let [send! (send-fn content-type)]
     (go
-      (cond
-        (empty? seqs)
-        (send! ch {:seqs (m/sequence-numbers db)})
-
-        true
-        (do
-          (<! (async/timeout))
-                    (send! ch {:foo 42}))))))
+      (<! (async/timeout 1000))
+      (send! ch {:foo 42}))))

 (defn ^:private poll-handler* [req]
   (let [method (:request-method req)
         allowed-methods #{:get :post}
-        content-type (get #{"application/transit+json"
-                            "application/json"}
-                          (:content-type req))]
+        content-type (soome #(re-find % (:content-type req))
+                            [#"^application/transit\+json"
+                             #"^application/json"])]
     (cond
       (not content-type)
       {:status 406}
@@ -55,18 +52,21 @@
       {:status 405}

       true
-      (let []
-        (-> req
-            (async-web/as-channel
-             {:on-open (fn [ch]
-                         (spawn-client (:pepa.web.handlers/db req)
-                                       ch
-                                       (:body req)
-                                       content-type))
-              :on-error (fn [ch throwable]
-                          (println "Caught exception:" throwable)
-                          (async-web/close ch))})
-            (assoc-in [:headers "content-type"] content-type))))))
+      (-> req
+          (async-web/as-channel
+           {:on-open (fn [ch]
+                       (let [seqs (:body req)
+                             db (:pepa.web.handlers/db req)]
+                         (if (empty? seqs)
+                           (send-seqs! db ch content-type)
+                           (handle-poll! db
+                                         ch
+                                         seqs
+                                         content-type))))
+            :on-error (fn [ch throwable]
+                        (println "Caught exception:" throwable)
+                        (async-web/close ch))})
+          (assoc-in [:headers "content-type"] content-type)))))

 (def poll-handler #'poll-handler*)


Refactor the incoming message state machine

--- src/picard/server.clj
+++ src/picard/server.clj
@@ -103,9 +103,10 @@
 (defn- downstream-fn
   [state channel keepalive?]
   ;; The state of the response needs to be tracked
-  (let [next-fn (atom #(initialize-resp %1 %2
-                                        state channel
-                                        keepalive? false nil))]
+  (let [next-fn (atom #(initialize-resp
+                        %1 %2
+                        state channel
+                        keepalive? false nil))]

     ;; The upstream application will call this function to
     ;; send the response back to the client
@@ -126,37 +127,48 @@
   "State transition from an HTTP request has finished being processed.
    If the response has already been sent, then the next state is to
    listen for new requests."
-  [upstream [_ [app opts] responded?]]
-  (if responded?
-    [incoming-request [app opts]]
-    [waiting-for-response [app opts upstream]]))
+  [state]
+  (swap! state
+         (fn [[_ [app opts upstream] responded?]]
+           (if responded?
+             [incoming-request [app opts]]
+             [waiting-for-response [app opts upstream]]))))

 (defn- transition-to-streaming-body
-  [upstream [_ [app opts] responded?]]
-  [stream-request-body [app opts upstream] responded?])
+  [state]
+  (swap! state
+         (fn [[_ args responded?]]
+           [stream-request-body args responded?])))
+
+(defn- register-upstream-handler
+  [state upstream]
+  (swap! state
+         (fn [[f [app opts] responded?]]
+           [f [app opts upstream] responded?])))

 (defn- stream-request-body
-  [[app opts upstream] _  _ ^HttpChunk chunk]
+  [state _ ^HttpChunk chunk [app opts upstream]]
+  [[_ _ upstream] _  _ ^HttpChunk chunk]
   (if (.isLast chunk)
     (do
       (upstream :done nil)
-      (partial transition-from-req-done upstream))
-    (do
-      (upstream :body (.getContent chunk))
-      (partial transition-to-streaming-body upstream))))
+      (transition-from-req-done state))
+    (upstream :body (.getContent chunk))))

 (defn- incoming-request
-  [[app opts] state channel ^HttpMessage msg]
-  (let [upstream (app (downstream-fn state channel (HttpHeaders/isKeepAlive msg)))
+  [state ch ^HttpMessage msg [app opts]]
+  ;; [[app opts] state channel ^HttpMessage msg]
+  (let [upstream (app (downstream-fn state ch (HttpHeaders/isKeepAlive msg)))
         headers  (headers-from-netty-req msg)]
-    ;; HACK - Set the state to include the upstream
-    (swap! state (fn [[f]] [f [app opts upstream]]))
+
+    ;; Add the upstream handler to the state
+    (register-upstream-handler state upstream)

     ;; Send the HTTP headers upstream
     (if (.isChunked msg)
       (do
         (upstream :request [headers nil])
-        (partial transition-to-streaming-body upstream))
+        (transition-to-streaming-body state))
       (do
         (upstream :request
                   [headers
@@ -164,7 +176,7 @@
                      (.getContent msg)
                      nil)])
         (upstream :done nil)
-        (partial transition-from-req-done upstream)))))
+        (transition-from-req-done state)))))

 (defn- netty-bridge
   [app opts]
@@ -191,7 +203,7 @@
           (instance? MessageEvent evt)
           (let [msg (.getMessage ^MessageEvent evt)
                 [next-fn args] @state]
-            (swap! state (next-fn args state ch msg)))
+            (next-fn state ch msg args))

           (and (instance? ChannelStateEvent evt)
                (= ChannelState/INTEREST_OPS


Revert "Revert changes"

Revert "Revert changes"

This reverts commit 14aa25f090f96cadaf92730e0da4ffba632cef24.

--- src/play_clj/math.clj
+++ src/play_clj/math.clj
@@ -38,8 +38,7 @@

 (defmacro bezier
   [points & options]
-  `(let [^Bezier object# (bezier* ~points)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Bezier (bezier* ~points) ~@options))

 (defmacro bezier!
   [object k & options]
@@ -53,8 +52,7 @@

 (defmacro bresenham2
   [& options]
-  `(let [^Bresenham2 object# (bresenham2*)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Bresenham2 (bresenham2*) ~@options))

 (defmacro bresenham2!
   [object k & options]
@@ -70,8 +68,7 @@

 (defmacro b-spline
   [points degree cont? & options]
-  `(let [^BSpline object# (b-spline* ~points ~degree ~cont?)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^BSpline (b-spline* ~points ~degree ~cont?) ~@options))

 (defmacro b-spline!
   [object k & options]
@@ -87,8 +84,7 @@

 (defmacro catmull-rom-spline
   [points cont? & options]
-  `(let [^CatmullRomSpline object# (catmull-rom-spline* ~points ~cont?)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^CatmullRomSpline (catmull-rom-spline* ~points ~cont?) ~@options))

 (defmacro catmull-rom-spline!
   [object k & options]
@@ -104,8 +100,7 @@

 (defmacro circle
   [x y radius & options]
-  `(let [^Circle object# (circle* ~x ~y ~radius)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Circle (circle* ~x ~y ~radius) ~@options))

 (defmacro circle!
   [object k & options]
@@ -119,8 +114,7 @@

 (defmacro convex-hull
   [& options]
-  `(let [^ConvexHull object# (convex-hull*)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^ConvexHull (convex-hull*) ~@options))

 (defmacro convex-hull!
   [object k & options]
@@ -134,8 +128,7 @@

 (defmacro delaunay-triangulator
   [& options]
-  `(let [^DelaunayTriangulator object# (delaunay-triangulator*)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^DelaunayTriangulator (delaunay-triangulator*) ~@options))

 (defmacro delaunay-triangulator!
   [object k & options]
@@ -149,8 +142,7 @@

 (defmacro ear-clipping-triangulator
   [& options]
-  `(let [^EarClippingTriangulator object# (ear-clipping-triangulator*)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^EarClippingTriangulator (ear-clipping-triangulator*) ~@options))

 (defmacro ear-clipping-triangulator!
   [object k & options]
@@ -166,8 +158,7 @@

 (defmacro ellipse
   [x y width height & options]
-  `(let [^Ellipse object# (ellipse* ~x ~y ~width ~height)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Ellipse (ellipse* ~x ~y ~width ~height) ~@options))

 (defmacro ellipse!
   [object k & options]
@@ -181,8 +172,7 @@

 (defmacro float-counter
   [window-size & options]
-  `(let [^FloatCounter object# (float-counter* ~window-size)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^FloatCounter (float-counter* ~window-size) ~@options))

 (defmacro float-counter!
   [object k & options]
@@ -196,8 +186,7 @@

 (defmacro frustum
   [& options]
-  `(let [^Frustum object# (frustum*)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Frustum (frustum*) ~@options))

 (defmacro frustum!
   [object k & options]
@@ -211,8 +200,7 @@

 (defmacro grid-point-2
   [x y & options]
-  `(let [^GridPoint2 object# (grid-point-2* ~x ~y)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^GridPoint2 (grid-point-2* ~x ~y) ~@options))

 (defmacro grid-point-2!
   [object k & options]
@@ -226,8 +214,7 @@

 (defmacro grid-point-3
   [x y z & options]
-  `(let [^GridPoint3 object# (grid-point-3* ~x ~y ~z)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^GridPoint3 (grid-point-3* ~x ~y ~z) ~@options))

 (defmacro grid-point-3!
   [object k & options]
@@ -243,8 +230,7 @@

 (defmacro matrix-3
   [values & options]
-  `(let [^Matrix3 object# (matrix-3* ~values)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Matrix3 (matrix-3* ~values) ~@options))

 (defmacro matrix-3!
   [object k & options]
@@ -260,8 +246,7 @@

 (defmacro matrix-4
   [values & options]
-  `(let [^Matrix4 object# (matrix-4* ~values)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Matrix4 (matrix-4* ~values) ~@options))

 (defmacro matrix-4!
   [object k & options]
@@ -275,8 +260,7 @@

 (defmacro plane
   [normal d & options]
-  `(let [^Plane object# (plane* ~normal ~d)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Plane (plane* ~normal ~d) ~@options))

 (defmacro plane!
   [object k & options]
@@ -292,8 +276,7 @@

 (defmacro polygon
   [vertices & options]
-  `(let [^Polygon object# (polygon* ~vertices)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Polygon (polygon* ~vertices) ~@options))

 (defmacro polygon!
   [object k & options]
@@ -309,8 +292,7 @@

 (defmacro polyline
   [vertices & options]
-  `(let [^Polyline object# (polyline* ~vertices)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Polyline (polyline* ~vertices) ~@options))

 (defmacro polyline!
   [object k & options]
@@ -326,8 +308,7 @@

 (defmacro quaternion
   [w x y z & options]
-  `(let [^Quaternion object# (quaternion* ~w ~x ~y ~z)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Quaternion (quaternion* ~w ~x ~y ~z) ~@options))

 (defmacro quaternion!
   [object k & options]
@@ -343,8 +324,7 @@

 (defmacro rectangle
   [x y width height & options]
-  `(let [^Rectangle object# (rectangle* ~x ~y ~width ~height)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Rectangle (rectangle* ~x ~y ~width ~height) ~@options))

 (defmacro rectangle!
   [object k & options]
@@ -360,8 +340,7 @@

 (defmacro vector-2
   [x y & options]
-  `(let [^Vector2 object# (vector-2* ~x ~y)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Vector2 (vector-2* ~x ~y) ~@options))

 (defmacro vector-2!
   [object k & options]
@@ -377,8 +356,7 @@

 (defmacro vector-3
   [x y z & options]
-  `(let [^Vector3 object# (vector-3* ~x ~y ~z)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^Vector3 (vector-3* ~x ~y ~z) ~@options))

 (defmacro vector-3!
   [object k & options]
@@ -392,8 +370,7 @@

 (defmacro windowed-mean
   [window-size & options]
-  `(let [^WindowedMean object# (windowed-mean* ~window-size)]
-     (u/calls! object# ~@options)))
+  `(u/calls! ^WindowedMean (windowed-mean* ~window-size) ~@options))

 (defmacro windowed-mean!
   [object k & options]


Bridget Riley!

Bridget Riley!


Commented out obsolete painting code that becomes incompatible with soon to be added new features

--- flatguicore/src/flatgui/paint.clj
+++ flatguicore/src/flatgui/paint.clj
@@ -140,32 +140,19 @@
   "Paints component, does not pait children"
   (if (:visible cmpnt)
     (let [ look-vec (:look-vec cmpnt)]
-      (flatten-vector [ (if look-vec look-vec) (if (:has-trouble cmpnt) (trouble-look cmpnt dirty-rects)) ]))
-    ))
-
-(defn paint-component-only2 [cmpnt dirty-rects]
-  "Paints component, does not pait children"
-  (if (and (:visible cmpnt) (:look cmpnt))
-    (flatten-vector ((:look cmpnt) cmpnt dirty-rects))
-    ))
+      (flatten-vector [ (if look-vec look-vec) (if (:has-trouble cmpnt) (trouble-look cmpnt dirty-rects))]))))

 (defn paint-component-with-children [component dirty-rects]
   "Paints component and its children"
   (try
-    (let [ clip-w (m/x (:clip-size component))
-           clip-h (m/y (:clip-size component))
-           position-matrix (:position-matrix component)
-           viewport-matrix (:viewport-matrix component)
-
-          ;transform-matrix (m/mx* position-matrix viewport-matrix)
-          ;awt-transform-matrix (affinetransform transform-matrix)
-          ;awt-transform-matrix-inverse (invert awt-transform-matrix)
-
+    (let [clip-w (m/x (:clip-size component))
+          clip-h (m/y (:clip-size component))
+          position-matrix (:position-matrix component)
+          viewport-matrix (:viewport-matrix component)
           awt-position-matrix (awt/affinetransform position-matrix)
           awt-viewport-matrix (awt/affinetransform viewport-matrix)
           awt-viewport-matrix-inverse (awt/invert awt-viewport-matrix)
-          awt-position-matrix-inverse (awt/invert awt-position-matrix)
-          ]
+          awt-position-matrix-inverse (awt/invert awt-position-matrix)]
         (flatten-vector
           ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
           [(if (not= (:widget-type component) "tablecell")  (awt/pushCurrentClip))
@@ -173,16 +160,10 @@
            (if (not= (:widget-type component) "tablecell") (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
            (awt/transform awt-viewport-matrix)
            (paint-component-only component dirty-rects)
-           ;(vec (for [[k v] (:children component)] (paint-component-with-children v dirty-rects)))
            (mapv #(paint-component-with-children % dirty-rects) (sort-by :z-position (for [[_ v] (:children component)] v)))
-
            (awt/transform awt-viewport-matrix-inverse)
            (awt/transform awt-position-matrix-inverse)
-           ;(transform awt-transform-matrix-inverse)
-
-           (if (not= (:widget-type component) "tablecell") (awt/popCurrentClip))
-           ]
-        ))
+           (if (not= (:widget-type component) "tablecell") (awt/popCurrentClip))]))
     (catch Exception e (do
                          (fg/log-debug "Exception " (.getMessage e)
                            " when painting component id = " (:id component)
@@ -191,17 +172,84 @@
                          (.printStackTrace e)))))

 (defn paint-all [container clipx clipy clipw cliph]
-  (let [ t (System/currentTimeMillis)
-         result (paint-component-with-children container nil)]
-      (do
-        ;(println "  -----Painted container in " (- (System/currentTimeMillis) t) " millis ")
-        result)))
-
-(defn get-dirty-rect-from-container [container]
-  (let [ r (:dirty-rect container)]
-    (if r
-      [(double (:x r)) (double (:y r)) (double (:w r)) (double (:h r))])))
-
+  (paint-component-with-children container nil))
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; New painting approach optimized for web
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmulti extract-value (fn [property _ _] (class property)))
+
+(defmethod extract-value Keyword [property f container]
+  (f (property container)))
+
+(defmethod extract-value Collection [property f container]
+  ;; This reduce accumulates bit flags
+  (reduce #(+ (* 2 %1) %2) 0 (for [p property] (f (p container)))))
+
+(defn- get-component-id-path-to-property-value [id-path container property f]
+  (let [this-id-path (fgc/conjv id-path (:id container))]
+    (apply
+      merge
+      {this-id-path (extract-value property f container)}
+      (for [[_ v] (:children container)] (get-component-id-path-to-property-value this-id-path v property f)))))
+
+(defn get-component-id-path-to-position-matrix [container]
+  (get-component-id-path-to-property-value [] container :position-matrix awt/affinetransform))
+
+(defn get-component-id-path-to-viewport-matrix [container]
+  (get-component-id-path-to-property-value [] container :viewport-matrix awt/affinetransform))
+
+(defn get-component-id-path-to-clip-size [container]
+  (get-component-id-path-to-property-value [] container :clip-size (fn [c] [(m/x c) (m/y c)])))
+
+(defn get-component-id-path-to-look-vector [container]
+  (get-component-id-path-to-property-value [] container :look-vec identity))
+
+(defn get-component-id-path-to-child-count [container]
+  (get-component-id-path-to-property-value [] container :children count))
+
+(defn get-component-id-path-to-flags [container]
+  (get-component-id-path-to-property-value [] container [:rollover-notify-disabled :popup :visible] (fn [v] (if v 1 0))))
+
+(defn get-component-id-path-to-image-url [container]
+      (get-component-id-path-to-property-value [] container :image-url identity))
+
+(defn- ready-for-paint? [container]
+  (and
+    (:position-matrix container)
+    (:viewport-matrix container)
+    (:clip-size container)
+    (:look-vec container)))
+
+;;;
+;;; TODO sort by z-order here?
+;;;
+(defn get-paint-all-sequence
+  ([id-path container]
+    (if (ready-for-paint? container)
+      (apply concat
+             [(conj id-path (:id container))]
+             (for [[_ v] (:children container)] (get-paint-all-sequence (conj id-path (:id container)) v)))
+     []))
+  ([container] (get-paint-all-sequence [] container)))
+
+
+
+;;;;;;;;;;;;;;
+;;;;;;;;;;;;;; Old experimental approaches
+;;;;;;;;;;;;;;
+
+;(defn paint-component-only2 [cmpnt dirty-rects]
+;  "Paints component, does not pait children"
+;  (if (and (:visible cmpnt) (:look cmpnt))
+;    (flatten-vector ((:look cmpnt) cmpnt dirty-rects))
+;    ))
+
+;(defn get-dirty-rect-from-container [container]
+;  (let [ r (:dirty-rect container)]
+;    (if r
+;      [(double (:x r)) (double (:y r)) (double (:w r)) (double (:h r))])))

 ;;@todo with such approach clip rect should be passed to evolve
 ;;
@@ -249,153 +297,91 @@
 ;         involved-components (get-all-components-for-dirty-rects container all-rects-to-paint)]
 ;    (paint-components (sort-components-by-id involved-components) all-rects-to-paint)))

-;(defn- clip? [component] (not= (:widget-type component) "tablecell"))
-; TODO
-(defn- clip? [component] (#{"tablecontentpane" "window" "toolbar" "component" "tableheader"} (:widget-type component)))
-
-(defn paint-dirty-impl [component dirty-rects force-paint]
-  "Paints component and its children"
-  (try
-    (let [ clip-w (m/x (:clip-size component))
-          clip-h (m/y (:clip-size component))
-          position-matrix (:position-matrix component)
-          viewport-matrix (:viewport-matrix component)
-
-          ; TODO this is optimization for web: to transmit less commands
-          transform-matrix (m/mx* position-matrix viewport-matrix)
-          awt-transform-matrix (awt/affinetransform transform-matrix)
-          awt-transform-matrix-inverse (awt/invert awt-transform-matrix)
-
-          awt-position-matrix (awt/affinetransform position-matrix)
-          awt-viewport-matrix (awt/affinetransform viewport-matrix)
-          ;awt-viewport-matrix-inverse (invert awt-viewport-matrix)
-          ;awt-position-matrix-inverse (invert awt-position-matrix)
-
-          paint-this (or force-paint
-                         (   ;or (nil? dirty-rects)
-                           and dirty-rects
-                               (r/intersect?
-                                 dirty-rects
-                                 {:x (m/mx-x (:abs-position-matrix component))
-                                  :y (m/mx-y (:abs-position-matrix component))
-                                  :w (m/x (:clip-size component))
-                                  :h (m/y (:clip-size component))})))
-          ;_ (if (= :main (:id component)) (println "Painting " (:id component) " paint=" paint-this " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
-          ;_ (if (and dirty-rects paint-this) (println "Painting " (:id component) " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
-          children (:children component)]
-      (if paint-this
-        (flatten-vector
-          ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
-          [(if (clip? component)  (awt/pushCurrentClip))
-           (awt/transform awt-position-matrix)
-
-           (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
-           (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
-
-           (paint-component-only2 component dirty-rects)
-           ;(println "Painting component " (:id component) " :needs-repaint = " (:needs-repaint component))
-
-           (mapv #(paint-dirty-impl % dirty-rects (and paint-this (not= :main (:id component)))) (sort-by :z-position (for [[_ v] (:children component)] v)))
-
-           ;(transform awt-viewport-matrix-inverse)
-           ;(transform awt-position-matrix-inverse)
-           (awt/transform awt-transform-matrix-inverse)
-
-           (if (clip? component) (awt/popCurrentClip))
-           ])
-        (if (seq children)
-          (let [ children-look (mapv #(paint-dirty-impl % dirty-rects false) (sort-by :z-position (for [[_ v] children] v)))]
-            (if (seq children-look)
-              (flatten-vector
-                [                                               ;(transform awt-transform-matrix)
-                 (if (clip? component)  (awt/pushCurrentClip))
-                 (awt/transform awt-position-matrix)
-                 (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
-                 (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
-
-                 children-look
-
-                 (awt/transform awt-transform-matrix-inverse)
-                 (if (clip? component) (awt/popCurrentClip))
-                 ;(transform awt-transform-matrix-inverse)
-                 ])
-              (do
-                ;(println "Chidren look skipped")
-                nil)))
-          )))
-    (catch Exception e (do
-                         (fg/log-debug "Exception " (.getMessage e)
-                                    " when painting component id = " (:id component)
-                                    ;" component: " (container-to-str component)
-                                    )
-                         (.printStackTrace e)))))
-
-(defn paint-dirty [component _ _]
-  (if (:dirty-rect component)
-    (do
-      ;(println "Dirty rect is " (:dirty-rect component) " painting...")
-      (paint-dirty-impl component (:dirty-rect component) nil))
-    (do
-      ;(println " Dirty rect is null, skipped painting")
-      [])))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;; New painting approach optimized for web
-;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmulti extract-value (fn [property _ _] (class property)))
-
-(defmethod extract-value Keyword [property f container]
-  (f (property container)))
-
-(defmethod extract-value Collection [property f container]
-  ;; This reduce accumulates bit flags
-  (reduce #(+ (* 2 %1) %2) 0 (for [p property] (f (p container)))))
-
-(defn- get-component-id-path-to-property-value [id-path container property f]
-  (let [this-id-path (fgc/conjv id-path (:id container))]
-    (apply
-      merge
-      {this-id-path (extract-value property f container)}
-      (for [[_ v] (:children container)] (get-component-id-path-to-property-value this-id-path v property f)))))
-
-(defn get-component-id-path-to-position-matrix [container]
-  (get-component-id-path-to-property-value [] container :position-matrix awt/affinetransform))
-
-(defn get-component-id-path-to-viewport-matrix [container]
-  (get-component-id-path-to-property-value [] container :viewport-matrix awt/affinetransform))
-
-(defn get-component-id-path-to-clip-size [container]
-  (get-component-id-path-to-property-value [] container :clip-size (fn [c] [(m/x c) (m/y c)])))
-
-(defn get-component-id-path-to-look-vector [container]
-  (get-component-id-path-to-property-value [] container :look-vec identity))
-
-(defn get-component-id-path-to-child-count [container]
-  (get-component-id-path-to-property-value [] container :children count))
-
-(defn get-component-id-path-to-flags [container]
-  (get-component-id-path-to-property-value [] container [:rollover-notify-disabled :popup :visible] (fn [v] (if v 1 0))))
-
-(defn get-component-id-path-to-image-url [container]
-      (get-component-id-path-to-property-value [] container :image-url identity))
-
-(defn- ready-for-paint? [container]
-  (and
-    (:position-matrix container)
-    (:viewport-matrix container)
-    (:clip-size container)
-    (:look-vec container)))
-
-;;;
-;;; TODO sort by z-order here?
-;;;
-(defn get-paint-all-sequence
-  ([id-path container]
-    (if (ready-for-paint? container)
-      (apply concat
-             [(conj id-path (:id container))]
-             (for [[_ v] (:children container)] (get-paint-all-sequence (conj id-path (:id container)) v)))
-     []))
-  ([container] (get-paint-all-sequence [] container)))+;; TODO
+;(defn- clip? [component] (#{"tablecontentpane" "window" "toolbar" "component" "tableheader"} (:widget-type component)))
+
+;(defn paint-dirty-impl [component dirty-rects force-paint]
+;  "Paints component and its children"
+;  (try
+;    (let [ clip-w (m/x (:clip-size component))
+;          clip-h (m/y (:clip-size component))
+;          position-matrix (:position-matrix component)
+;          viewport-matrix (:viewport-matrix component)
+;
+;          ; TODO this is optimization for web: to transmit less commands
+;          transform-matrix (m/mx* position-matrix viewport-matrix)
+;          awt-transform-matrix (awt/affinetransform transform-matrix)
+;          awt-transform-matrix-inverse (awt/invert awt-transform-matrix)
+;
+;          awt-position-matrix (awt/affinetransform position-matrix)
+;          awt-viewport-matrix (awt/affinetransform viewport-matrix)
+;          ;awt-viewport-matrix-inverse (invert awt-viewport-matrix)
+;          ;awt-position-matrix-inverse (invert awt-position-matrix)
+;
+;          paint-this (or force-paint
+;                         (   ;or (nil? dirty-rects)
+;                           and dirty-rects
+;                               (r/intersect?
+;                                 dirty-rects
+;                                 {:x (m/mx-x (:abs-position-matrix component))
+;                                  :y (m/mx-y (:abs-position-matrix component))
+;                                  :w (m/x (:clip-size component))
+;                                  :h (m/y (:clip-size component))})))
+;          ;_ (if (= :main (:id component)) (println "Painting " (:id component) " paint=" paint-this " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
+;          ;_ (if (and dirty-rects paint-this) (println "Painting " (:id component) " dirty-rects = " dirty-rects " abs pm = " (:abs-position-matrix component)))
+;          children (:children component)]
+;      (if paint-this
+;        (flatten-vector
+;          ; TODO WARNING! This is a temporary hack. Otherwise content-pane children do not respect table clip rect (not= (:widget-type component) "tablecell")
+;          [(if (clip? component)  (awt/pushCurrentClip))
+;           (awt/transform awt-position-matrix)
+;
+;           (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
+;           (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
+;
+;           (paint-component-only2 component dirty-rects)
+;           ;(println "Painting component " (:id component) " :needs-repaint = " (:needs-repaint component))
+;
+;           (mapv #(paint-dirty-impl % dirty-rects (and paint-this (not= :main (:id component)))) (sort-by :z-position (for [[_ v] (:children component)] v)))
+;
+;           ;(transform awt-viewport-matrix-inverse)
+;           ;(transform awt-position-matrix-inverse)
+;           (awt/transform awt-transform-matrix-inverse)
+;
+;           (if (clip? component) (awt/popCurrentClip))
+;           ])
+;        (if (seq children)
+;          (let [ children-look (mapv #(paint-dirty-impl % dirty-rects false) (sort-by :z-position (for [[_ v] children] v)))]
+;            (if (seq children-look)
+;              (flatten-vector
+;                [                                               ;(transform awt-transform-matrix)
+;                 (if (clip? component)  (awt/pushCurrentClip))
+;                 (awt/transform awt-position-matrix)
+;                 (if (clip? component) (if (:popup component) (awt/setClip 0 0 clip-w clip-h) (awt/clipRect 0 0 clip-w clip-h)))
+;                 (if (not= awt-viewport-matrix m/IDENTITY-MATRIX) (awt/transform awt-viewport-matrix))
+;
+;                 children-look
+;
+;                 (awt/transform awt-transform-matrix-inverse)
+;                 (if (clip? component) (awt/popCurrentClip))
+;                 ;(transform awt-transform-matrix-inverse)
+;                 ])
+;              (do
+;                ;(println "Chidren look skipped")
+;                nil)))
+;          )))
+;    (catch Exception e (do
+;                         (fg/log-debug "Exception " (.getMessage e)
+;                                    " when painting component id = " (:id component)
+;                                    ;" component: " (container-to-str component)
+;                                    )
+;                         (.printStackTrace e)))))
+;
+;(defn paint-dirty [component _ _]
+;  (if (:dirty-rect component)
+;    (do
+;      ;(println "Dirty rect is " (:dirty-rect component) " painting...")
+;      (paint-dirty-impl component (:dirty-rect component) nil))
+;    (do
+;      ;(println " Dirty rect is null, skipped painting")
+;      [])))


Sort Tree.toString correctly

Sort Tree.toString correctly

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -165,7 +165,7 @@
 (deftype Tree [max-keys key-len ^:mutable root]
   Object
   (toString [this]
-            (pr-str (into {} (map vec this))))
+            (pr-str (into (sorted-map-by key-compare) (map vec this))))
   (assoc! [this key val]
           (.assoc! root key val max-keys))
   (dissoc! [this key]


Cleaning up.

Cleaning up.

--- src/re_demo/time.cljs
+++ src/re_demo/time.cljs
@@ -3,7 +3,7 @@
             [re-com.core     :refer  [label]]
             [re-com.util     :refer  [pad-zero-number]]
             [re-com.time     :refer  [time-input]]
-            [re-com.box      :refer  [h-box v-box box gap line]]
+            [re-com.box      :refer  [h-box v-box box gap]]
             [re-com.dropdown :refer  [single-dropdown]]
             [reagent.core    :as     reagent]))


Add tests for check the tokens backend using malformed tokens.

--- test/buddy/auth/backends/token_tests.clj
+++ test/buddy/auth/backends/token_tests.clj
@@ -50,7 +50,7 @@
                     (format "Token %s"))]
     {:headers {"authorization" header}}))

-(deftest jws-backend-test
+(deftest jws-tests
   (testing "Jws token backend authentication"
     (let [request (make-jws-request jws-data jws-secret)
           handler (wrap-authentication identity jws-backend)
@@ -81,7 +81,7 @@
       (is (= (:status response) 401))
       (is (= (:body response) "Unauthorized"))))

-  (testing "Jws token authorization - authenticated but unathorized thrown yields 403"
+  (testing "Jws token authorization with authenticated but unathorized thrown yields 403"
     (let [request (make-jws-request {:userid 1} jws-secret)
           handler (-> (fn [req] (throw-unauthorized))
                       (wrap-authorization jws-backend)
@@ -90,7 +90,7 @@
       (is (= (:status response) 403))
       (is (= (:body response) "Permission denied"))))

-  (testing "Jws token unathorized - :unauthorized-handlercalled when provided"
+  (testing "Jws token unathorized with :unauthorized-handlercalled when provided"
     (let [request (make-jws-request jws-data "wrong-key")
           onerror (fn [_ _] {:status 3000})
           backend (token/jws-backend {:secret jws-secret
@@ -101,7 +101,7 @@
           response (handler request)]
       (is (= (:status response) 3000))))

-  (testing "Jws token wrongdata - onerror handler called when provided"
+  (testing "Jws token wrongdata with onerror handler called when provided"
     (let [request (make-jws-request jws-data "wrong-key")
           onerror (fn [_ _] {:status 3000})
           backend (token/jws-backend {:secret jws-secret
@@ -110,8 +110,19 @@
                       (wrap-authorization backend)
                       (wrap-authentication backend))
           response (handler request)]
-      (is (= (:status response) 3000)))))
-
+      (is (= (:status response) 3000))))
+
+  (testing "Jws token with wrong token"
+    (let [request (assoc (make-request "xyz")
+                         :foo :bar)
+          backend (token/jws-backend {:secret jws-secret})
+          handler (-> identity
+                      (wrap-authorization backend)
+                      (wrap-authentication backend))
+          response (handler request)]
+      (is (nil? (:identity request)))
+      (is (= :bar (:foo request)))))
+)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Tests: JWE
@@ -157,7 +168,7 @@
           response (handler request)]
       (is (= (:status response) 401))))

-  (testing "Jwe token authorization - authenticated but unathorized thrown yields 403"
+  (testing "Jwe token authorization with authenticated but unathorized thrown yields 403"
     (let [request (make-jwe-request {:userid 1} jwe-secret)
           handler (-> (fn [req] (throw-unauthorized))
                       (wrap-authorization jwe-backend)
@@ -165,7 +176,7 @@
           response (handler request)]
       (is (= (:status response) 403))))

-  (testing "Jwe token unathorized - unauth handler called when provided"
+  (testing "Jwe token unathorized with unauth handler called when provided"
     (let [request (make-jwe-request jwe-data (hash/sha256 "wrong-key"))
           onerror (fn [_ _] {:status 3000})
           backend (token/jwe-backend {:secret jwe-secret
@@ -176,7 +187,7 @@
           response (handler request)]
       (is (= (:status response) 3000))))

-  (testing "Jwe token wrongdata - onerror handler called when provided"
+  (testing "Jwe token wrongdata with onerror handler called when provided"
     (let [request (make-jwe-request jws-data (hash/sha256 "foobar"))
           onerror (fn [_ _] {:status 3000})
           backend (token/jwe-backend {:secret jwe-secret


Implement basic client death detection - if a client hasn't pinged for a while it is dead. We now need the concept of a Session with which to associate all server-side resources for a given client, so that they can be tidied up on a client's death.


Basic indentation.

Basic indentation.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -11,7 +11,11 @@
   (re-seq (re-pattern (str ".{0," width "}\\s")) (str s " ")))

 (defn ljust [width s] ; Left justify a string.
-  (format (str "%-" width "s") s))
+  (if (> width 0)
+    (format (str "%-" width "s") s)
+    s))
+
+(defn nl [lvl] (ljust lvl "\n")) ; Generate newline + indentation.

 (defn read-model-file [fname]
     {:fname fname
@@ -67,45 +71,46 @@
        forms))

 (defn cvt-let [lvl scope op [bindings & body]]
-  [(interpose "\n"
+  [(interpose (nl lvl)
               (map (fn [[var-name init-val]]
                      [(cvt-sym var-name) ":= (" (cvt-expr (inc lvl) scope init-val) ")"])
                    (partition 2 bindings)))
-   "\n"
+   (nl lvl)
    (cvt-body (inc lvl) scope body)])

 (defn cvt-if [lvl scope op [test then else]]
-  ["if (" (cvt-expr (inc lvl) scope test) ") {\n"
+  ["if (" (cvt-expr (inc lvl) scope test) ") {" (nl lvl)
    (cvt-expr (inc lvl) scope then)
-   "\n} else {\n"
+   (nl lvl) "} else {" (nl lvl)
    (cvt-expr (inc lvl) scope else)
-   "\n}"])
+   (nl lvl) "}"])

 (defn cvt-cond [lvl scope op test-expr-forms]
   [(interpose "else"
               (map (fn [[test expr]]
-                     ["if (" (cvt-expr (inc lvl) scope test) ") {\n"
-                      (cvt-expr (inc lvl) scope expr) "\n}"])
+                     ["if (" (cvt-expr (inc lvl) scope test) ") {" (nl lvl)
+                      (cvt-expr (inc lvl) scope expr) "}" (nl lvl)])
                    (partition 2 test-expr-forms)))])

 (defn cvt-ago [lvl scope op [self-actx actx body]]
   ["go {" body "}"])

 (defn cvt-ago-loop [lvl scope op [self-actx parent-actx bindings & body]]
-  ["(func() chan interface{} { result := make(chan interface{}, 1)\n"
-   "go (func() {\n"
-   (interpose "\n"
+  ["(func() chan interface{} { result := make(chan interface{}, 1)" (nl lvl)
+   "go (func() {" (nl lvl)
+   (interpose (nl lvl)
               (map-indexed (fn [idx [var-name init-val]]
                              [(str "l" idx) ":=" (cvt-expr (inc lvl) scope init-val)])
                            (partition 2 bindings)))
-   "\nfor {\n"
-   (interpose "\n"
+   (nl lvl)
+   "for {" (nl lvl)
+   (interpose (nl lvl)
               (map-indexed (fn [idx [var-name init-val]]
                              [(cvt-sym var-name) ":=" (str "l" idx)])
                            (partition 2 bindings)))
-   "\n"
+   (nl lvl)
    (cvt-body (inc lvl) scope body)
-   "\n}})()\n"
+   (nl lvl) "}})()" (nl lvl)
    "return result })()"])

 (def cvt-special-fns
@@ -120,7 +125,7 @@

 (defn cvt-expr [lvl scope expr]
   (cond
-   (vector? expr) ["[" (interpose "," (map #(cvt-expr scope %) expr)) "]"]
+   (vector? expr) ["[" (interpose "," (map #(cvt-expr (inc lvl) scope %) expr)) "]"]
    (map? expr) ["{" (interpose "," (map (fn [[k v]]
                                           [(cvt-expr (inc lvl) scope k) ":"
                                            (cvt-expr (inc lvl) scope v)])
@@ -147,7 +152,8 @@
                forms))

 (defn cvt-fn [lvl params forms]
-  ["func" (cvt-fn-params params) "{\n" (cvt-fn-body (inc lvl) params forms) "}\n"])
+  ["func" (cvt-fn-params params) "{" (nl lvl)
+   (cvt-fn-body (inc lvl) params forms) "}" (nl lvl)])

 (defn cvt-defn [name params forms]
   ["func" (cvt-sym name) (rest (cvt-fn 0 params forms))])


(.foo bar) is always a call in cljs

(.foo bar) is always a call in cljs

--- src/main/clojure/clojure/tools/analyzer/passes/js/analyze_host_expr.clj
+++ src/main/clojure/clojure/tools/analyzer/passes/js/analyze_host_expr.clj
@@ -20,3 +20,11 @@
     (merge (ana/-analyze :const the-class env :class)
            {:form form})
     ast))
+
+(defmethod analyze-host-expr :host-interop
+  [{:keys [m-or-f target] :as ast}]
+  (merge (dissoc ast m-or-f)
+         {:op       :host-call
+          :method   m-or-f
+          :args     []
+          :children [:target :args]}))


fix(user plugin): a subtle bug related to key bindings updates

--- ccw.core/src/clj/ccw/e4/model.clj
+++ ccw.core/src/clj/ccw/e4/model.clj
@@ -887,7 +887,7 @@
     (if-let [kb (find-key-binding app spec)]
       (do
         (t/format :e4 "key binding found: %s" kb)
-        kb)
+        (update-key-binding! kb spec))
       (do
         (t/trace :e4 "key binding not found, let's create one")
         (let [kb (-> (create-key-binding) (update-key-binding! spec))]


* src/clj/cljs/core.clj: goto 1 << 31

* src/clj/cljs/core.clj: goto 1 << 31

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -53,7 +53,7 @@
                  ITransientAssociative ITransientMap ITransientVector ITransientSet
                  IMultiFn])
           (iterate (fn [[p b]]
-                     (if (core/== 32 b)
+                     (if (core/== 2147483648 b)
                        [(core/inc p) 1]
                        [p (core/bit-shift-left b 1)]))
                    [0 1])))


Docstring readability, typo fix

Docstring readability, typo fix

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -645,7 +645,7 @@
      ret#))

 (defmacro this-as
-  "Defines a scope where JavaScript's implit this is bound to the name provided."
+  "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
   [name & body]
   `(let [~name (~'js* "this")]
      ~@body))


CLJS-1148: ClojureScript REPL must maintain eval/print pairing

direct all printing which is not the result of eval to *err*. default
:bind-err to true which simply maps *err* to *out* to preserve
old behavior for command line REPLs.

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -33,6 +33,10 @@

 (def ^:dynamic *cljs-verbose* false)
 (def ^:dynamic *repl-opts* nil)
+
+(defmacro err-out [& body]
+  `(binding [*out* *err*]
+     ~@body))

 ;; =============================================================================
 ;; Copied over from clojure.main
@@ -355,26 +359,27 @@
   ([repl-env ret form opts]
    (display-error repl-env ret form (constantly nil) opts))
   ([repl-env ret form f {:keys [print flush] :as opts}]
-   (f)
-   (when-let [value (:value ret)]
-     (print value))
-   (when-let [st (:stacktrace ret)]
-     (if (and (true? (:source-map opts))
-              (satisfies? IParseStacktrace repl-env))
-       (let [cst (try
-                   (-parse-stacktrace repl-env st ret opts)
-                   (catch Throwable e
-                     (when (:repl-verbose opts)
-                       (print "Failed to canonicalize stacktrace")
-                       (print (Throwables/getStackTraceAsString e))
-                       (flush))))]
-         (if (vector? cst)
-           (if (satisfies? IPrintStacktrace repl-env)
-             (-print-stacktrace repl-env cst ret opts)
-             (print-mapped-stacktrace cst opts))
-           (print st)))
-       (print st))
-     (flush))))
+   (err-out
+     (f)
+     (when-let [value (:value ret)]
+       (print value))
+     (when-let [st (:stacktrace ret)]
+       (if (and (true? (:source-map opts))
+             (satisfies? IParseStacktrace repl-env))
+         (let [cst (try
+                     (-parse-stacktrace repl-env st ret opts)
+                     (catch Throwable e
+                       (when (:repl-verbose opts)
+                         (print "Failed to canonicalize stacktrace")
+                         (print (Throwables/getStackTraceAsString e))
+                         (flush))))]
+           (if (vector? cst)
+             (if (satisfies? IPrintStacktrace repl-env)
+               (-print-stacktrace repl-env cst ret opts)
+               (print-mapped-stacktrace cst opts))
+             (print st)))
+         (print st))
+       (flush)))))

 (defn evaluate-form
   "Evaluate a ClojureScript form in the JavaScript environment. Returns a
@@ -425,7 +430,7 @@
              (distinct (vals (:uses ast))))
            opts))
        (when *cljs-verbose*
-         ((:print opts) js))
+         (err-out ((:print opts) js)))
        (let [ret (-evaluate repl-env filename (:line (meta form)) wrap-js)]
          (case (:status ret)
            :error (throw
@@ -649,7 +654,7 @@
 (defn repl*
   [repl-env {:keys [init need-prompt quit-prompt prompt flush read eval print caught reader
                     print-no-newline source-map-inline wrap repl-requires
-                    compiler-env]
+                    compiler-env bind-err]
              :or {need-prompt #(if (readers/indexing-reader? *in*)
                                 (== (readers/get-column-number *in*) 1)
                                 (identity true))
@@ -665,7 +670,8 @@
                            1 "NO_SOURCE_FILE")
                   print-no-newline print
                   source-map-inline true
-                  repl-requires '[[cljs.repl :refer-macros [source doc find-doc apropos dir pst]]]}
+                  repl-requires '[[cljs.repl :refer-macros [source doc find-doc apropos dir pst]]]
+                  bind-err true}
              :as opts}]
   (let [repl-opts (-repl-options repl-env)
         repl-requires (into repl-requires (:repl-requires repl-opts))
@@ -687,7 +693,8 @@
                :print-no-newline print-no-newline
                :source-map-inline source-map-inline})))]
     (env/with-compiler-env (or compiler-env (env/default-compiler-env opts))
-     (binding [ana/*cljs-ns* 'cljs.user
+     (binding [*err* (if bind-err *out* *err*)
+               ana/*cljs-ns* 'cljs.user
                *cljs-verbose* repl-verbose
                ana/*cljs-warnings*
                (assoc ana/*cljs-warnings*
@@ -750,7 +757,7 @@
                (when-let [src (:watch opts)]
                  (future
                    (let [log-file (io/file (util/output-directory opts) "watch.log")]
-                     (print "Watch compilation log available at:" (str log-file))
+                     (err-out (print "Watch compilation log available at:" (str log-file)))
                      (flush)
                      (try
                        (let [log-out (FileWriter. log-file)]


Better message for rezzing cards

Better message for rezzing cards

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -35,11 +35,13 @@
              (or (not forfeit-cost) (not (empty? scored))))
       {:costs costs, :forfeit-cost forfeit-cost, :scored scored})))

-(defn build-spend-msg [cost-str verb]
-  (if (or (nil? cost-str)
-          (= "" cost-str))
-    (str verb "s ")
-    (str "spends " cost-str " to " verb " ")))
+(defn build-spend-msg
+  ([cost-str verb] (build-spend-msg cost-str verb nil))
+  ([cost-str verb verb2]
+    (if (or (not (instance? String cost-str))
+            (= "" cost-str))
+      (str (or verb2 (str verb "s")) " ")
+      (str "spends " cost-str " to " verb " "))))

 (defn cost-names [value attr]
   (when (> value 0)
@@ -1388,7 +1390,7 @@
              (update! state side (-> h
                                      (update-in [:zone] #(map to-keyword %))
                                      (update-in [:host :zone] #(map to-keyword %)))))
-           (system-msg state side (str (build-spend-msg cost-str "rez")
+           (system-msg state side (str (build-spend-msg cost-str "rez" "rezzes")
                                        (:title card) (when no-cost " at no cost")))
            (when (#{"ICE"} (:type card)) (update-ice-strength state side card))
            (trigger-event state side :rez card))))


fix issue with remote server removal

fix issue with remote server removal

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -109,8 +109,10 @@
                     (vec (map-indexed
                           (fn [i s]
                             (if (< i n) s
-                                {:content (for [c (:content s)] (update-in c [:zone] #(assoc (vec %) 2 i)))
-                                 :ices (for [c (:ices s)] (update-in c [:zone] #(assoc (vec %) 2 i)))}))
+                                {:content (vec (for [c (:content s)]
+                                                 (update-in c [:zone] #(assoc (vec %) 2 i))))
+                                 :ices (vec (for [c (:ices s)]
+                                              (update-in c [:zone] #(assoc (vec %) 2 i))))}))
                           (get-in @state [:corp :servers :remote]))))
              (doseq [s (drop n (get-in @state [:corp :servers :remote]))
                      c (concat (:content s) (:ices s))]


send an event

send an event

--- src/clj/hsm/views.clj
+++ src/clj/hsm/views.clj
@@ -229,8 +229,8 @@
   analytics.page();}}();
 ")
 (format`
-"window.jstag=function(e){var t=!1,n=window,r=document,i='/js/io',s=Array.prototype.slice,o=e.url||'';return n.jstag||{load:function(){var e,s=r.getElementsByTagName('script')[0];return t=!0,'JSON'in n&&Array.prototype.forEach||(i+='w'),r.getElementById(i)?this:(e=r.createElement('script'),e.id=i,e.src=o+i+'.min.js',s.parentNode.insertBefore(e,s),this)},_q:[],_c:e,bind:function(e){this._q.push([e,s.call(arguments,1)])},ready:function(){this._q.push(['ready',s.call(arguments)])},send:function(){return t||this.load(),this._q.push(['ready','send',s.call(arguments)]),this},ts:(new Date).getTime()}
-}({cid:'report',url:'//%s/',path:'',idpath:''});" (if is-dev? "dev.strck.hackersome.com" "strck.hackersome.com"))
+"function(){window.jstag=function(e){var t=!1,n=window,r=document,i='/js/io',s=Array.prototype.slice,o=e.url||'';return n.jstag||{load:function(){var e,s=r.getElementsByTagName('script')[0];return t=!0,'JSON'in n&&Array.prototype.forEach||(i+='w'),r.getElementById(i)?this:(e=r.createElement('script'),e.id=i,e.src=o+i+'.min.js',s.parentNode.insertBefore(e,s),this)},_q:[],_c:e,bind:function(e){this._q.push([e,s.call(arguments,1)])},ready:function(){this._q.push(['ready',s.call(arguments)])},send:function(){return t||this.load(),this._q.push(['ready','send',s.call(arguments)]),this},ts:(new Date).getTime()}
+}({cid:'report',url:'//%s/',path:'',idpath:''});jstag.send({data:1});}();" (if is-dev? "dev.strck.hackersome.com" "strck.hackersome.com"))
           )
         ])
     [:img {:src "http://strck.hackersome.com/pixel.gif" :alt ""}]])))


Improvements to server stop/start

Improvements to server stop/start

--- src/clj/sbsk/core.clj
+++ src/clj/sbsk/core.clj
@@ -182,13 +182,25 @@
                (generate-string))}
     {:status 503}))

+(def servers (atom []))
+
+(defn stop-server
+  []
+  (run! #(.stop %) @servers)
+  (reset! servers []))
+
 (defn run-server
   []
   (reload-database)
-  (future (run-jetty (wrap-cors search-handler
-                                :access-control-allow-origin [#".*"]
-                                :access-control-allow-methods [:get]) {:port 3000}))
-  (future (run-jetty reload-database-handler {:port 4000})))
+  (reset! servers
+          [(run-jetty (wrap-cors search-handler
+                                 :access-control-allow-origin [#".*"]
+                                 :access-control-allow-methods [:get]) {:port 3000
+                                                                        :daemon? true
+                                                                        :join? false})
+           (run-jetty reload-database-handler {:port 4000
+                                               :daemon? true
+                                               :join? false})]))

 (defn -main
   [& args]


Make component dependency explicit, changed hash order due to 1.6.0

--- src/clj_crud/core.clj
+++ src/clj_crud/core.clj
@@ -86,7 +86,8 @@
                      {:database :db})
        :db-fixtures (component/using
                      (dev-db-fixtures)
-                     {:database :db})
+                     {:database :db
+                      :db-migrator :db-migrator})
        :ring-handler (component/using
                       (ring/ring-handler (dev-handler))
                       {:database :db


Fix an incorrect rebase conflict merge, fixing multipart

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -143,11 +143,8 @@
       (doseq [[header-n header-v] headers]
         (.addHeader http-req header-n header-v))
       (if multipart
-        (let [mp-entity (MultipartEntity.)]
-          (doseq [[k v] multipart]
-            (.addPart mp-entity (name k) (ByteArrayBody. v (name k))))
-          (.setEntity #^HttpEntityEnclosingRequest http-req
-                      (create-multipart-entity multipart)))
+        (.setEntity #^HttpEntityEnclosingRequest http-req
+                    (create-multipart-entity multipart))
         (when body
           (let [http-body (ByteArrayEntity. body)]
             (.setEntity #^HttpEntityEnclosingRequest http-req http-body))))


Chance put to allow giving the entire object

--- src/infoq_podcast/cache.clj
+++ src/infoq_podcast/cache.clj
@@ -1,6 +1,6 @@
 (ns infoq-podcast.cache
   (:require [infoq-podcast.db :as db]
-            [taoensso.timbre  :as timbre :refer [trace debug info]]))
+            [taoensso.timbre  :as timbre :refer [trace debug info warn]]))

 ;;; Globals
@@ -27,13 +27,13 @@
                    [:cdate :DATETIME "NOT NULL"]
                    [:data :BLOB "NOT NULL"]))

-(defn put [id date data]
+(defn put [item]
   (try ;; Protect against existing entries
-    (->> {:id id, :cdate date, :data data}
+    (->> {:id (:id item), :cdate (:date item), :data item}
          pre-process
          (db/insert db-spec :presentation))
     (catch java.sql.SQLException e
-      (info "Presentation already exists" id))))
+      (warn "Presentation already exists" item))))

 (defn lookup [id]
   (->> (db/select' db-spec :presentation