LeaveCalc implemented

LeaveCalc implemented

--- src/cljs/t5pmobile/leave.cljs
+++ src/cljs/t5pmobile/leave.cljs
@@ -26,7 +26,7 @@
 (def ch (chan (dropping-buffer 2)))
 (enable-console-print!)
 (def jquery (js* "$"))
-(defonce app-state (atom  {:view 0 :leavecode "" :leavetypes [] :leaveapp {:leavecode "请选择"} } ))
+(defonce app-state (atom  {:view 0 :leavecode "" :leavetypes [] :leaveapp {:leavecode "请选择"} } )) ;; :leavedays 0 :leavehours 0

@@ -42,6 +42,7 @@
         :hide (get fielddef "hide") :values (get fielddef "values")} }
     ]
     (swap! fieldnum inc)
+
     newdata
   )
 )
@@ -85,6 +86,23 @@
 )

+(defn OnCalcLeaveDays [response]
+  ( let [
+    newdata (map leaves-to-map response)
+    leavecodes (map leaves-to-leavecodes response)
+  ]
+
+
+     (swap! app-state assoc :leavetypes  (into {} newdata) )
+     (swap! app-state assoc :leavecodes leavecodes)
+  )
+
+
+   ;(.log js/console (:leavetypes @app-state))
+
+)
+
+

 (defn error-handler [{:keys [status status-text]}]
   (.log js/console (str "something bad happened: " status " " status-text))
@@ -93,6 +111,17 @@

+
+(defn calcLeaveDays []
+  (POST "http://localhost/T5PWebAPI/api/empleave" {:handler OnCalcLeaveDays
+                                            :error-handler error-handler
+                                            :headers {:content-type "application/json"
+                                                      :Authorization (str "Bearer "  (:token  (first (:token @t5pcore/app-state))))
+                                            }
+                                            :format :json
+                                            :params (:leaveapp @app-state)
+                                            })
+)

@@ -131,7 +160,7 @@

 (defn handle-chkb-change [e]
   ;(.log js/console (.. e -target -id) )
-  (.log js/console "The change ....")
+  ;(.log js/console "The change ....")
   (.stopPropagation e)
   (.stopImmediatePropagation (.. e -nativeEvent) )
   (swap! app-state assoc-in [:leaveapp (keyword  (.. e -currentTarget -id) )]
@@ -161,65 +190,74 @@
 )

 (def custom-formatter1 (tf/formatter "MMM dd yyyy hh:mm:ss"))
-(def custom-formatter2  (tf/formatter (:datemask (:User @t5pcore/app-state)) ))
-
-(def custom-formatter3 (tf/formatter "yyyyMMdd"))
+;(def custom-formatter2  (tf/formatter (:datemask (:User @t5pcore/app-state)) ))
+
+(def custom-formatter3 (tf/formatter "yyyy/MM/dd"))

 (defn setdatepicker [field]
-  (if (and
-      (= (:fieldtype (nth field 1) ) 1 )
-      (= (:timeformat (nth field 1) ) 0 )
-    )
-
-    (jquery
-     (fn []
-       (-> (jquery (str "#" (name (nth field 0) )) )
-         (.datepicker #js{:format "dd/mm/yyyy" })
-         (.on "show"
-           (fn [e] (
-              let [
-                ;;dt (js/Date (.. e -date))
-                ;dtstring (tf/parse custom-formatter1 (subs (str (.. e -date)  )  4 24)  )
-                dtstring (if
-                  (= (count (.. e -dates) ) 0)
-                    (tf/parse custom-formatter1 "May 26 2016 08:00:00"  )
-                    (tf/parse custom-formatter1 (subs (str (.. e -date)  )  4 24)  )
-                )
-
-
-              ]
-              ;;(swap! app-state assoc-in [:leavetypes :ivyt03 :fields :leavefromdate :value] (str (subs dt 8 10)  "/05/"    (subs dt 11 16)  ) )
-             ;;(.log js/console dt)
-             ;;(.log js/console (str (.. e -date)  ) )
-             ;(.log js/console (count (.. e -dates)))
-             ;(.log js/console (subs (str (.. e -date)  ) 4 24))
-             (.log js/console (tf/unparse custom-formatter3 (tm/date-time 2010 10 3)))  ;;dtstring
+  (let [custom-formatter2  (tf/formatter (:datemask (:User @t5pcore/app-state)) )]
+
+
+    (if (and
+        (= (:fieldtype (nth field 1) ) 1 )
+        (= (:timeformat (nth field 1) ) 0 )
+      )
+
+      (jquery
+       (fn []
+         (-> (jquery (str "#" (name (nth field 0) )) )
+           (.datepicker #js{:format "dd/mm/yyyy" })
+           (.on "show"
+             (fn [e] (
+                let [
+                  ;;dt (js/Date (.. e -date))
+                  ;dtstring (tf/parse custom-formatter1 (subs (str (.. e -date)  )  4 24)  )
+                  dtstring (if
+                    (= (count (.. e -dates) ) 0)
+                      (tf/parse custom-formatter1 "May 26 2016 08:00:00"  )
+                      (tf/parse custom-formatter1 (subs (str (.. e -date)  )  4 24)  )
+                  )
+
+
+                ]
+                ;;(swap! app-state assoc-in [:leavetypes :ivyt03 :fields :leavefromdate :value] (str (subs dt 8 10)  "/05/"    (subs dt 11 16)  ) )
+               ;;(.log js/console dt)
+               ;;(.log js/console (str (.. e -date)  ) )
+               ;(.log js/console (count (.. e -dates)))
+               ;(.log js/console (subs (str (.. e -date)  ) 4 24))
+               (.log js/console (tf/unparse custom-formatter2 dtstring))
+               (swap! app-state assoc-in [:leaveapp (keyword (.. e -target -id))] (tf/unparse custom-formatter2 dtstring))
+               )
              )
            )
-         )
-       )
-     )
-    )
-
-
-
-
-
-  )
-
-  (if (and
-      (= (:fieldtype (nth field 1) ) 1 )
-      (= (:timeformat (nth field 1) ) 2 )
-    )
-
-    (jquery
-     (fn []
-       (-> (jquery (str "#" (name (nth field 0) )) )
-         (.timepicker #js{:timeFormat "H:i:s" } )
-       )
-     )
-    )
-  )
+         )
+       )
+      )
+
+
+
+
+
+    )
+
+    (if (and
+        (= (:fieldtype (nth field 1) ) 1 )
+        (= (:timeformat (nth field 1) ) 2 )
+      )
+
+      (jquery
+       (fn []
+         (-> (jquery (str "#" (name (nth field 0) )) )
+           (.timepicker #js{:timeFormat "H:i:s" } )
+         )
+       )
+      )
+    )
+
+
+
+  )
+

@@ -236,6 +274,40 @@
 )

+(defn setcalculatedfield [field]
+    ;(.log js/console (keyword  (nth field 0) )  )
+    ;(.log js/console (get (nth fields 2 ) "fieldcode"    )   )
+
+
+  ;; leavedays, leavehours - these fields are calculated fields, set initial values to 0
+  (if (= (:fieldtype (nth field 1)) 5)
+    (if (=   ( (keyword  (nth field 0) ) (:leaveapp @app-state)) nil)
+      (swap! app-state assoc-in [:leaveapp (keyword  (nth field 0) )]
+        0
+      )
+    )
+  )
+
+
+  ;; boolean fields initialize to TRUE
+  (if (= (:fieldtype (nth field 1)) 3)
+    (if (=   ( (keyword  (nth field 0) ) (:leaveapp @app-state)) nil)
+      (swap! app-state assoc-in [:leaveapp (keyword  (nth field 0) )]
+        1
+      )
+    )
+  )
+)
+
+
+(defn setcalculatedfields []
+  (let [fields  (:fields ((keyword (:leavecode (:leaveapp @app-state) )) (:leavetypes @app-state) ) ) ]
+    ;(.log js/console "Inside  setcalculatedfields" )
+    ;(.log js/console (get (nth fields 2 ) "fieldcode"    )   )
+    (dorun (map setcalculatedfield fields   ))
+  )
+)
+

 (defn setdatepicker2 [field]
   (.log js/console (:name (nth field 1)  ) )
@@ -250,6 +322,10 @@
   )
 )

+(defn setcontrols []
+  (setdatepickers)
+  (setcalculatedfields)
+)

 (defn alertselected1 [event param]
   ;(js/alert (str event  "ClojureScript says 'Boo!'" ))
@@ -263,7 +339,7 @@
      )
    )
   )
-  (swap! app-state assoc-in [:leaveapp (keyword param)] event)
+  (swap! app-state assoc-in [:leaveapp (keyword param)] event)
    (.log js/console (str "#" param ))
   ;(setdatepickers2)
   1
@@ -291,37 +367,91 @@
 (defn initqueue []
   (doseq [n (range 1000)]
     (go ;(while true)
-      (take! ch (fn [v] (
-                         setdatepickers
-                         ;.log js/console "Core.ASYNVC working!!!"
-                         )       )  )
-
+      (take! ch (
+        fn [v] (
+                                        ;(setcalculatedfields)
+           setcontrols
+                                        ;.log js/console "Core.ASYNVC working!!!"
+        )
+      ))
     )
   )
 )

 (initqueue)

-(defn OnCalcLeave [response]
-  (.log js/console (str  (response) ))
+(defn leave-to-state [leave]
+  (let [
+      newdata {:leavecode (get leave "leavecode") :name (get leave "name") }
+    ]
+    newdata
+  )
+
+)
+
+(defn OnCalcLeave [response]
+  (let [
+      newdata {:leavedays (get response "leavedays") :leavehours (get response "leavehours") }
+    ]
+
+    (swap! app-state assoc-in [:leaveapp :leavedays]
+      (:leavedays newdata)
+    )
+    (.log js/console (str  (:leavedays newdata) ))
+  )
+
   ;;(.log js/console (str  (get (first response)  "Title") ))
 )
+

 (defn calcleave []
   (POST "http://localhost/T5PWebAPI/api/leavecalc" {:handler OnCalcLeave
                                             :error-handler error-handler
-                                            :headers {:content-type "application/json" :Authorization (str "Bearer "  (:token  (first (:token @t5pcore/app-state)))) }
-                                            :body (str
-"{"
-  "\"leavecode\":\"" "LV04A"  "\","
-  "\"leavefromtime\":\"" "2016/05/01 08:00"  "\","
-  "\"leavetotime\":\"" "2016/05/01 18:00"  "\","
-  "\"notes\":\"" "from clojure mobile"  "\""
-"}")
+                                            :headers {
+                                              :content-type "application/json"
+                                              :Authorization (str "Bearer "  (:token  (first (:token @t5pcore/app-state)))) }
+                                            :format :json
+                                            :params (:leaveapp @app-state)
                                             })
 )

+(defn CheckCalcLeave []
+  (if (=
+      (and ( = (nil? (:leavefromdate (:leaveapp @app-state)))  false)
+           ( = (nil? (:leavetodate (:leaveapp @app-state)))  false)
+           ( = (nil? (:leavecode (:leaveapp @app-state)))  false)
+      ) true
+    )
+    calcleave
+  )
+
+)
+
+(defn desplayComboboxField [text]
+  (dom/div {:className "col-sm-10"}
+    (b/button-group
+      {:id  (name (first text) ) }
+      (b/dropdown {:title
+      (if
+        (= ( (keyword (nth text 0)) (:leaveapp @app-state)) nil )
+          (:name  (nth text 1))
+          ( (keyword (nth text 0)) (:leaveapp @app-state))
+
+      )
+
+      }
+        (map (fn [item]
+          (b/menu-item {:key (get item "code")
+            :on-select  (fn [e](alertselected1 e (name (first text) )))
+          } (get item "value"))
+          )(:values (nth text 1))
+        )
+      )
+    )
+  )
+
+)

 (defcomponent leave-page-view [data owner]
   (did-mount [_]
@@ -366,41 +496,19 @@
                 (dom/div {:className "col-sm-10"}
                   (cond
                     (= (:fieldtype (nth text 1)  )  0)
-                      ;;(dom/input {:type "text" :id (name (first text) ) :onChange #(handle-change %)})
-                      (dom/div {:className "col-sm-10"}
-                        (b/button-group
-                          {:id  (name (first text) ) }
-                          (b/dropdown {:title
-                          (if
-                            (= ( (keyword (nth text 0)) (:leaveapp @app-state)) nil )
-                              (:name  (nth text 1))
-                              ( (keyword (nth text 0)) (:leaveapp @app-state))
-
-                          )
-
-                          }
-                            (map (fn [item]
-                              (b/menu-item {:key (get item "code")
-                                :on-select  (fn [e](alertselected1 e (name (first text) )))
-                              } (get item "value"))
-                              )(:values (nth text 1))
-                            )
-                          )
-                        )
-                      )
-
+                      (desplayComboboxField text)
                     (= (:fieldtype (nth text 1)  )  1)
                       (dom/input {:type "text" :id (name (first text) ) :oninput #(handle-change %)})
                     (= (:fieldtype (nth text 1)  )  2)
                       (dom/input {:type "text" :id (name (first text) ) :onChange #(handle-change %)})
                     (= (:fieldtype (nth text 1)  )  3)
-                      (dom/input {:type "checkbox"   :id (name (first text)) :label (:name  (nth text 1))
-                      ;;:onClick #(handle-chkb-click %)
+                      (dom/input {:type "checkbox" :defaultChecked true :id (name (first text)) :label (:name  (nth text 1))
                       :onChange ( fn [e]( handle-chkb-change  e )   )
                       })
+                    (= (:fieldtype (nth text 1)  )  5)
+                      (dom/input {:type "text" :disabled true :value ((keyword (name (first text) )) (:leaveapp @app-state))  :ref (name (first text) ) :id (name (first text) )})
+
                   )
-
-
                 )
               )
               )


Removing unused skew function

Removing unused skew function

--- src/clojure/crap/jinterop.clj
+++ src/clojure/crap/jinterop.clj
@@ -6,11 +6,6 @@
   Iterable
   (iterator [this]
     (.iterator (range x y))))
-
-;; a simple function
-(defn skew [this]
-    (+ 3 5 ))
-

 ;; an interface?
 (defprotocol Talkable (speak [this]))


neko.activity: Deprecate `with-activity` macro

--- src/clojure/neko/activity.clj
+++ src/clojure/neko/activity.clj
@@ -28,6 +28,7 @@
 (defmacro with-activity
   "Evaluates body such that *activity* is bound to the given activity."
   [activity & body]
+  (println "WARNING: with-activity and any usage of *activity* is deprecated.")
   `(binding [*activity* ~activity]
      ~@body))


translate some comments

translate some comments

--- src/clojure/sparkling/sql.clj
+++ src/clojure/sparkling/sql.clj
@@ -23,7 +23,7 @@
   data-frame)

 (defn select
-  "封装 DataFrame 的 select 方法。"
+  "DataFrame select, accept vector [column...]"
   [cols data-frame]
   (.select data-frame
            (into-array cols)))
@@ -51,23 +51,23 @@
   (.where data-frame expression))

 (defn join
-  "封装 DataFrame 的 join 方法。"
+  "DataFrame join use expression text"
   [expression other data-frame]
   (.join data-frame expression))

 (defn join-on
-  "根据给定的字段文本构造两个 data frame 的 inner join 。"
+  "data frame inner join use one column name"
   [column-name other data-frame]
   (.join data-frame other
          (.equalTo (.col data-frame column-name) (.col other column-name))))

 (defn group-by
-  "封装 DataFrame 的 groupBy 操作"
+  "DataFrame group by"
   [cols data-frame]
   (.groupBy data-frame (into-array cols)))

 (defn group-by-cols
-  "根据给定的字段文本列表构造 group by 操作并调用"
+  "DataFrame group by column names"
   [columns data-frame]
   (.groupBy data-frame (into-array (cols columns data-frame))))


(maint) Fix reports integration test

(maint) Fix reports integration test

Something in the agent changed to make it log more at info level; adjust the
tests to match.

--- test/puppetlabs/puppetdb/integration/reports.clj
+++ test/puppetlabs/puppetdb/integration/reports.clj
@@ -164,7 +164,7 @@
                   (filter #(= "notice" (:level %))
                           logs))))

-        (is (= 5 (count
+        (is (= 6 (count
                   (filter #(= "info" (:level %))
                           logs))))))))


Doc string tweaks

Doc string tweaks

--- src/such/relational.clj
+++ src/such/relational.clj
@@ -74,8 +74,8 @@
                                              {:a 2, :b 2, :c 1}
                                              {:a 2, :b 2, :c 2}}}

-   Alternately, you can describe which left-hand-side keys should be
-   considered the same as which right-hand-side keys with a map. In
+   Alternately, you can use a map to describe which left-hand-side keys should be
+   considered the same as which right-hand-side keys. In
    the above case, the sharing could be made explicit with `(join
    has-a-and-b has-b-and-c {:b :b})`.

@@ -87,6 +87,7 @@

    In such a case, the join would look like this:

+         (join has-a-and-b has-b-and-c {:b :blike}) =>
                                            #{{:a 1, :b 2, :blike 2, :c 1}
                                              {:a 1, :b 2, :blike 2, :c 2}

@@ -95,7 +96,7 @@
                                              {:a 2, :b 2, :blike 2, :c 1}
                                              {:a 2, :b 2, :blike 2, :c 2}}

-   Notice that the `:b` and `:blike` keys are duplicated.
+   Notice that the `:b` and `:blike` keys are both included.

    The join when there are no keys shared is the cross-product of the relations.

@@ -254,20 +255,20 @@
 (defn index-select
   "Produce a map by looking a key up in an index.

-  See <<someplace>> for examples.
+  See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for examples.

   `key` is a unique or compound key that's been indexed with [[one-to-one-index-on]]
   or [[one-to-many-index-on]]. The `options` may be given as N keys and values
   following `key` (Smalltalk style) or as a single map. They are:

-  :using <index>
-    (required) The index to use.
-  :keys <[keys...]>
-    (optional) Keys you're interested in (default is all of them)
-  :prefix <prefix>
-    (optional) Prepend the given prefix to all the keys in the selected map.
-    The prefix may be either a string or keyword. The resulting key will be
-    of the same type (string or keyword) as the original.
+      :using <index>
+        (required) The index to use.
+      :keys <[keys...]>
+        (optional) Keys you're interested in (default is all of them)
+      :prefix <prefix>
+        (optional) Prepend the given prefix to all the keys in the selected map.
+        The prefix may be either a string or keyword. The resulting key will be
+        of the same type (string or keyword) as the original.

   The return value depends on the index. If it is `one-to-one`, a map is returned.
   If it is `one-to-many`, a vector of maps is returned.
@@ -298,27 +299,27 @@
   "Add more key/value pairs to `kvs`. They are found by looking up values
   in a [[one-to-one-index-on]] or [[one-to-many-index-on]] index.

-  See <<someplace>> for examples.
+  See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for examples.

   The `options` control what maps are returned and how they're merged into the
   original `kvs`. They may be given as N keys and values
-  following `kvs` (Smalltalk style) or as a single map. They are:
-
-  :using <index>
-    (required) The index to use.
-  :via <key>
-    (required) A single foreign key or a sequence of them that is used to
-    look up a map in the <index>.
-  :into <key>
-    (optional, relevant only to a one-to-many map). Since a one-to-many map
-    can't be [[merge]]d into the `kvs`, it has to be added \"under\" (as the
-    value of) a particular `key`.
-  :keys <[keys...]>
-    (optional) Keys you're interested in (default is all of them)
-  :prefix <prefix>
-    (optional) Prepend the given prefix to all the keys in the selected map.
-    The prefix may be either a string or keyword. The resulting key will be
-    of the same type (string or keyword) as the original.
+  following the `kvs` argument (Smalltalk style) or as a single map. They are:
+
+      :using <index>
+        (required) The index to use.
+      :via <key>
+        (required) A single foreign key or a sequence of them that is used to
+        look up a map in the <index>.
+      :into <key>
+        (optional, relevant only to a one-to-many map). Since a one-to-many map
+        can't be merged into the `kvs`, it has to be added \"under\" (as the
+        value of) a particular `key`.
+      :keys [key1 key2 key3 ...]
+        (optional) Keys you're interested in (default is all of them)
+      :prefix <prefix>
+        (optional) Prepend the given prefix to all the keys in the selected map.
+        The prefix may be either a string or keyword. The resulting key will be
+        of the same type (string or keyword) as the original.
   "

   ([kvs options]
@@ -364,13 +365,13 @@
    in the last of the list of indexes, following keys to move from index to index.
    Example:

-      (let [index:countries-by-person-id (subject/combined-index-on index:rulership-by-person-id
-                                                                    :country_code
-                                                                    index:country-by-country-code)]
-        (subject/index-select 1 :using index:countries-by-person-id :keys [:gdp])
-        => [{:gdp 1690}])
-
-   (See ..someplace.. for details..)
+        (let [index:countries-by-person-id (subject/combined-index-on index:rulership-by-person-id
+                                                                      :country_code
+                                                                      index:country-by-country-code)]
+          (subject/index-select 1 :using index:countries-by-person-id :keys [:gdp])
+          => [{:gdp 1690}])
+
+   (See [the wiki](https://github.com/marick/suchwow/wiki/such.relational) for details.)
   "
   {:arglists '([starting-index foreign-key next-index ...])}
   [starting-index & path-pairs]


Don't send full delta if state is current

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -40,11 +40,13 @@

 (defn delta [old-state]
   (let [cs @current-state]
+  (if (= old-state (str (:current cs)))
+   #{}
   (if old-state
     (let [os (.getIfPresent cache! old-state)]
       (when os (debug "Cache hit:" os))
       (object-array [(:current cs) (ddiff [] os (:state cs) #{})]))
-    (object-array [(:current cs) (ddiff [] nil (:state cs) #{})]))))
+    (object-array [(:current cs) (ddiff [] nil (:state cs) #{})])))))

 (defn groovy [s x cls]
   (case (.getMaximumNumberOfParameters cls)


revert me! Debugging only

revert me! Debugging only

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -19,7 +19,7 @@
   `(when @debug-mode (println ~@text)))

-(def cache! (.. (CacheBuilder/newBuilder) (expireAfterAccess 5 TimeUnit/SECONDS) (build)))
+(def cache! (.. (CacheBuilder/newBuilder) (expireAfterAccess 500 TimeUnit/SECONDS) (build)))

 (def current-state
   (atom {:state nil


Remove unused ns

Remove unused ns

--- src/net/sekao/nightcode/core.clj
+++ src/net/sekao/nightcode/core.clj
@@ -1,7 +1,6 @@
 (ns net.sekao.nightcode.core
   (:require [clojure.java.io :as io]
             [net.sekao.nightcode.projects :as p]
-            [net.sekao.nightcode.boot :as b]
             [net.sekao.nightcode.state :refer [state]])
   (:import [javafx.application Application]
            [javafx.fxml FXMLLoader]
@@ -10,7 +9,7 @@
   (:gen-class :extends javafx.application.Application))

 (defn -start [^net.sekao.nightcode.core app ^Stage stage]
-  (let [root (FXMLLoader/load (clojure.java.io/resource "main.fxml"))
+  (let [root (FXMLLoader/load (io/resource "main.fxml"))
         scene (Scene. root 800 600)
         editor (.lookup scene "#editor")
         project-tree (.lookup scene "#project_tree")


facebook og tags should use "property" not "name" (#7)

--- src/norman_sicily_static/web.clj
+++ src/norman_sicily_static/web.clj
@@ -62,15 +62,15 @@
        [:meta {:name "twitter:card" :content "summary"}]
        [:meta {:name "twitter:site" :content "@Norman_Sicily"}]
        [:meta {:name "twitter:creator" :content "@Norman_Sicily"}]
-       [:meta {:name "og:title" :content site-title}]
-       [:meta {:name "og:type" :content "website"}]
-       [:meta {:name "og:url" :content web-url}]
-       [:meta {:name "og:description" :content site-description}]
-       [:meta {:name "og:image" :content "/images/favicon-196.png"}]
-       [:meta {:name "og:image:url" :content "/images/favicon-196.png"}]
-       [:meta {:name "og:image:type" :content "image/png"}]
-       [:meta {:name "og:image:width" :content "196"}]
-       [:meta {:name "og:image:height" :content "196"}]
+       [:meta {:property "og:title" :content site-title}]
+       [:meta {:property "og:type" :content "website"}]
+       [:meta {:property "og:url" :content web-url}]
+       [:meta {:property "og:description" :content site-description}]
+       [:meta {:property "og:image" :content "/images/favicon-196.png"}]
+       [:meta {:property "og:image:url" :content "/images/favicon-196.png"}]
+       [:meta {:property "og:image:type" :content "image/png"}]
+       [:meta {:property "og:image:width" :content "196"}]
+       [:meta {:property "og:image:height" :content "196"}]
        [:title site-title]
        (optimus.html/link-to-css-bundles request ["app.css"])
        (javascript-tag (str


change :builds to a map; makes things much cleaner

--- src-cljs/cljsbuild_ui/pages/main.cljs
+++ src-cljs/cljsbuild_ui/pages/main.cljs
@@ -65,30 +65,28 @@

    ;; from project.clj, but with extra tool state
    ;; (see initial-project-build-state)
-   :builds []})
+   :builds {}
+   :builds-order []})
+
+(def build-keys [:id :source-paths :compiler])

 (defn attach-state-to-build
   "Attach state to project-build map, and prune out unused keys"
-  [build]
-  (let [keep-keys [:id
-                   :source-paths
-                   :compiler]]
-    (-> initial-project-build-state
-        (merge (select-keys build keep-keys)))))
+  [bld]
+  (merge initial-project-build-state
+    (select-keys bld build-keys)))
+
+(def project-keys [:filename :name :version :license :dependencies :plugins])

 (defn attach-state-to-proj
   "Attach state to project map, and prune out unused keys"
-  [project]
-  (let [keep-keys [:filename
-                   :name
-                   :version
-                   :license
-                   :dependencies
-                   :plugins]
-        builds (->> project :cljsbuild :builds (mapv attach-state-to-build))]
+  [prj]
+  (let [blds (->> prj :cljsbuild :builds (mapv attach-state-to-build))
+        bld-ids (map :id blds)]
     (-> initial-project-state
-        (merge (select-keys project keep-keys))
-        (assoc :builds builds))))
+        (merge (select-keys prj project-keys))
+        (assoc :builds (zipmap bld-ids blds)
+               :builds-order (vec bld-ids)))))

 (defn add-project!
   [project]
@@ -150,26 +148,16 @@
 ;; NOTE: this function will not work if two builds have the same output-to target
 ;; should probably refactor with a filter?
 (defn- output-to->bld-id [prj-key output-to]
-  (let [blds (get-in @state [:projects prj-key :builds])
+  (let [blds (vals (get-in @state [:projects prj-key :builds]))
         outputs (map #(-> % :compiler :output-to) blds)
         ids (map :id blds)
         m (zipmap outputs ids)]
     (get m output-to)))

-;; NOTE: this could probably be written cleaner with a threading macro
-;; TODO: this function needs to go away! we are using the wrong data structure
-;; for builds; need to switch to a map and just have a separate vector for order
-(defn- bld-id->idx [prj-key bld-id]
-  (first
-    (remove nil?
-      (map-indexed
-        (fn [idx bld]
-          (if (= bld-id (:id bld)) idx))
-        (get-in @state [:projects prj-key :builds])))))
-
 (defn- num-selected-builds [prj]
   (->> prj
     :builds
+    vals
     (map :active?)
     (remove false?)
     count))
@@ -177,6 +165,7 @@
 (defn- get-active-bld-ids [prj]
   (->> prj
     :builds
+    vals
     (filter #(true? (:active? %)))
     (map :id)))

@@ -209,8 +198,8 @@
 ;; update the now timestamps every 0.25 second
 ;; (js/setInterval update-now! 250)

-(defn- clear-compiled-info! [prj-key bld-idx]
-  (swap! state update-in [:projects prj-key :builds bld-idx]
+(defn- clear-compiled-info! [prj-key bld-id]
+  (swap! state update-in [:projects prj-key :builds bld-id]
     assoc :last-compile-time nil
           :error nil
           :warnings []))
@@ -219,28 +208,25 @@
   "Removes compiled info from a build: last-compile-time, error, warnings"
   [prj-key]
   (doall
-    (map-indexed
-      #(clear-compiled-info! prj-key %1)
+    (map
+      #(clear-compiled-info! prj-key (first %))
       (get-in @state [:projects prj-key :builds]))))

 (defn- mark-build-as-waiting! [prj-key bld-id]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (swap! state assoc-in [:projects prj-key :builds bld-idx :state] :waiting)))
-
-(defn- show-waiting! [prj-key bld-ids]
+  (swap! state assoc-in [:projects prj-key :builds bld-id :state] :waiting))
+
+(defn- mark-builds-as-waiting! [prj-key bld-ids]
   (doall
     (map
       #(mark-build-as-waiting! prj-key %)
       bld-ids)))

 (defn- show-start-compiling! [prj-key bld-id]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (clear-compiled-info! prj-key bld-idx)
-    (swap! state assoc-in [:projects prj-key :builds bld-idx :state] :compiling)))
+  (clear-compiled-info! prj-key bld-id)
+  (swap! state assoc-in [:projects prj-key :builds bld-id :state] :compiling))

 (defn- show-done-compiling! [prj-key bld-id compile-time]
-  (let [bld-idx (bld-id->idx prj-key bld-id)
-        map-path [:projects prj-key :builds bld-idx]
+  (let [map-path [:projects prj-key :builds bld-id]
         bld (get-in @state map-path)
         new-state (if (-> bld :warnings empty?) :done :done-with-warnings)
         new-bld (assoc bld :compile-time compile-time
@@ -249,14 +235,14 @@
     (swap! state assoc-in map-path new-bld)))

 (defn- show-warnings! [prj-key bld-id warnings]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (swap! state update-in [:projects prj-key :builds bld-idx :warnings] (fn [w]
-      (into [] (concat w warnings))))))
-
-(defn- show-build-error! [prj-key bld-id error-msg]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (swap! state update-in [:projects prj-key :builds bld-idx]
-      assoc :error error-msg :state :done-with-error)))
+  (swap! state update-in [:projects prj-key :builds bld-id :warnings]
+    (fn [w]
+      (into [] (concat w warnings)))))
+
+(defn- show-build-error! [prj-key bld-id errors]
+  (swap! state update-in [:projects prj-key :builds bld-id]
+    assoc :error errors
+          :state :done-with-error))

 (defn- compiler-done!
   "Mark a project as being finished with compiling. ie: idle state"
@@ -264,11 +250,11 @@
   (swap! state assoc-in [:projects prj-key :state] :idle)

   ;; TODO: make sure all the builds are in a "finished" state
+  ;; clear any "Waiting" with "Output missing"
   )

 (defn- show-lein-startup! [prj-key bld-id]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (swap! state assoc-in [:projects prj-key :builds bld-idx :state] :lein-startup)))
+  (swap! state assoc-in [:projects prj-key :builds bld-id :state] :lein-startup))

 ;;------------------------------------------------------------------------------
 ;; Compiler Interface
@@ -291,7 +277,7 @@
         (js-log "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"))

       (when @first-output?
-        (show-waiting! prj-key bld-ids)
+        (mark-builds-as-waiting! prj-key bld-ids)
         (reset! first-output? false))

       (case type
@@ -319,7 +305,8 @@
   (swap! state assoc-in [:projects prj-key :state] :auto)

   ;; update the BuildRows state
-  (doall (map #(show-lein-startup! prj-key %) bld-ids))
+  (doall
+    (map #(show-lein-startup! prj-key %) bld-ids))

   (remove-compiled-info! prj-key)

@@ -332,7 +319,8 @@
   (swap! state assoc-in [:projects prj-key :state] :once)

   ;; update the BuildRows state
-  (doall (map #(show-lein-startup! prj-key %) bld-ids))
+  (doall
+    (map #(show-lein-startup! prj-key %) bld-ids))

   (remove-compiled-info! prj-key)

@@ -353,14 +341,36 @@
         (swap! state assoc-in [:projects prj-key :compile-menu-showing?] false))
       (-> @state :projects :order))))

-(defn- compile-now! [prj-key]
+(defn- compile-now! [prj-key prj bld-ids]
+  (if (:auto-compile? prj)
+    (start-auto-compile! prj-key bld-ids)
+    (start-compile-once! prj-key bld-ids)))
+
+(defn- mark-build-as-cleaning! [prj-key bld-id]
+  (swap! state assoc-in [:projects prj-key :builds bld-id :state] :cleaning))
+
+(defn- start-build-clean! [prj-key bld-id]
+  (let [bld (get-in @state [:projects prj-key :builds bld-id])]
+    (mark-build-as-cleaning! prj-key bld-id)
+    (exec/clean-build! prj-key bld)))
+
+(defn- click-compile-btn [prj-key]
   (let [prj (get-in @state [:projects prj-key])
         bld-ids (get-active-bld-ids prj)]
     ;; safeguard
     (when-not (zero? (count bld-ids))
-      (if (:auto-compile? prj)
-        (start-auto-compile! prj-key bld-ids)
-        (start-compile-once! prj-key bld-ids)))))
+      ;; remove any errors / warnings from previous builds
+      (remove-compiled-info! prj-key)
+
+      ;; update project state
+      (swap! state assoc-in [:projects prj-key :state] :cleaning)
+
+      ;; clean the builds
+      (doall
+        (map #(start-build-clean! prj-key %) bld-ids))
+
+      ;; start the compile
+      (compile-now! prj-key prj bld-ids))))

 (defn- click-stop-auto-btn [prj-key]
   ;; update project state
@@ -369,30 +379,6 @@
   ;; stop the process
   (exec/stop-auto prj-key))

-
-(defn- mark-build-as-cleaning! [prj-key bld-id]
-  (let [bld-idx (bld-id->idx prj-key bld-id)]
-    (swap! state assoc-in [:projects prj-key :builds bld-idx :state] :cleaning)))
-
-(defn- click-compile-btn [prj-key]
-  ;; remove any errors / warnings from previous builds
-  (remove-compiled-info! prj-key)
-
-  ;; update project state
-  (swap! state assoc-in [:projects prj-key :state] :cleaning)
-
-  ;; clean the builds
-  (let [bld-ids (get-active-bld-ids (get-in @state [:projects prj-key]))]
-    (doall
-      (map
-        (fn [bld-id]
-          (mark-build-as-cleaning! prj-key bld-id)
-          (exec/clean-build! prj-key (get-in @state [:projects prj-key :builds (bld-id->idx prj-key bld-id)])))
-        bld-ids)))
-
-  ;; start the compile
-  (compile-now! prj-key))
-
 (defn- click-compile-options [js-evt prj-key]
   (.stopPropagation js-evt)
   (swap! state update-in [:projects prj-key :compile-menu-showing?] not))
@@ -400,8 +386,8 @@
 (defn- toggle-auto-compile [prj-key]
   (swap! state update-in [:projects prj-key :auto-compile?] not))

-(defn- toggle-build-active [prj-key bld-idx]
-  (swap! state update-in [:projects prj-key :builds bld-idx :active?] not))
+(defn- toggle-build-active [prj-key bld-id]
+  (swap! state update-in [:projects prj-key :builds bld-id :active?] not))

 ;;------------------------------------------------------------------------------
 ;; Sablono Templates
@@ -487,9 +473,9 @@
     (if-not active?
       " not-active-a8d35")))

-(sablono/defhtml build-option [idx bld prj-key]
+(sablono/defhtml build-option [bld prj-key]
   [:div.bld-e7c4d
-    {:on-click #(toggle-build-active prj-key idx)}
+    {:on-click #(toggle-build-active prj-key (:id bld))}
     (if (:active? bld)
       [:i.fa.fa-check-square-o]
       [:i.fa.fa-square-o])
@@ -507,7 +493,11 @@
       "Auto Compile"]
     [:div.spacer-685b6]
     [:label.small-cffc5 "builds"]
-    (map-indexed #(build-option %1 %2 prj-key) (:builds prj))])
+    (map
+      (fn [bld-id]
+        (let [bld (get-in prj [:builds bld-id])]
+          (build-option bld prj-key)))
+      (:builds-order prj))])

 (sablono/defhtml idle-state [prj-key prj]
   [:button.compile-btn-17a78
@@ -580,8 +570,11 @@
         [:table.tbl-bdf39
           (bld-tbl-hdr)
           (map-indexed
-            #(BuildRow (assoc %2 :idx %1 :prj-key prj-key))
-            (:builds prj))]])))
+            (fn [idx bld-id]
+              (let [bld (get-in prj [:builds bld-id])]
+                (BuildRow (assoc bld :idx idx
+                                     :prj-key prj-key))))
+            (:builds-order prj))]])))

 (quiescent/defcomponent AppRoot [app-state]
   (sablono/html


Throttle calls to update when changing document date

The date chooser has a spinner item which can change the dates value very
fast. So we don't overwork the server and/or get inconsistent values I
now throttle the calls with a 200ms timeout.

--- src-cljs/pepa/workflows/document.cljs
+++ src-cljs/pepa/workflows/document.cljs
@@ -135,12 +135,27 @@
                {:state state})]))

 (ui/defcomponent ^:private date-picker [{:keys [document_date]} owner]
-  (render-state [_ {:keys [date value]}]
+  (init-state [_]
+    {:on-change-ch (async/chan)})
+  (will-mount [_]
+    (go-loop [old-date nil new-date nil]
+      (let [{:keys [on-change-ch date]} (om/get-state owner)
+            timeout (async/timeout 200) ;;Throttle calls for 200ms
+            [val ch] (alts! [timeout on-change-ch])]
+        (condp = ch
+          on-change-ch ;;The current date has changed
+          (recur old-date val)
+          timeout ;;If we have a new date notify for an update
+          (do
+            (when (and (not= new-date old-date) (seq new-date))
+              (async/put! date new-date))
+            (recur new-date new-date))))))
+  (render-state [_ {:keys [on-change-ch value]}]
     [:input {:type "date"
              :value value
-             :on-change (fn [e] (do
-                                  (om/set-state! owner :value e.target.value)
-                                  (async/put! date e.target.value)))}]))
+             :on-change (fn [e] (let [val e.target.value]
+                                  (om/set-state! owner :value val)
+                                  (async/put! on-change-ch val)))}]))

 (ui/defcomponent ^:private meta-pane [{:keys [document_date] :as document} owner]
   (render [_]


Resolve type issues blocking tree shaking

Tree shaking now works!

--- src/oxcart/passes/tree_shake.clj
+++ src/oxcart/passes/tree_shake.clj
@@ -16,7 +16,7 @@
             [oxcart.passes.defs :as defs]
             [clojure.set :as set]
             [clojure.tools.analyzer.ast :as ast]
-            [taoensso.timbre :refer [info warn error]]))
+            [taoensso.timbre :refer [info warn error debug]]))

 (defn reach-set
@@ -31,22 +31,20 @@

 (defn -step-reach-set
-  [ast]
-  (util/map-vals
-   (fn [v]
-     (->> v
-          (map (partial get ast))
-          (reduce set/union v)))))
+  [mapping]
+  (->> (for [[var deps] mapping]
+         [var (->> deps
+                   (mapv mapping)
+                   (reduce set/union deps))])
+       (into {})))

 (defn global-reach-set
   "λ {Symbol → #{Symbol}} → {Symbol → #{Symbol}}

   Computes the reach set for an entire program"
-  [whole-program-ast]
-  (util/fix -step-reach-set
-            (-> whole-program-ast
-                (util/map-vals reach-set))))
+  [symbol-dep-tree]
+  (util/fix -step-reach-set symbol-dep-tree))

 (defn trim-with-emit-set
@@ -54,14 +52,25 @@
   (let [new-ast (atom {:modules modules})]

     (doseq [m modules]
-      (doseq [[sym ast] (get whole-program-ast m)]
+      (debug "Pondering module:" m)
+
+      (assert (:forms (get whole-program-ast m)))
+
+      (doseq [ast (:forms (get whole-program-ast m))]
+        (debug "Pondering line:" (util/line ast) (:op ast))
+
         (if (pattern/def? ast)
           (if (contains? reach-set (:var ast))
-            (swap! new-ast assoc-in [m sym] ast)
+            (swap! new-ast update-in [m :forms] conj ast)
+
             (info "Discarding unused def form,"
                   (util/line ast)))
-          (warn "Discarding non-def top level form,"
-                (util/line ast)))))
+
+          (do (warn "Discarding non-def top level form,"
+                    (util/line ast))
+              (print (:form ast)))))
+
+      (swap! new-ast update-in [m :forms] vec))

     @new-ast))

@@ -80,17 +89,15 @@
     which is the entry point of the prorgam. It is with respect to this
     function that all other defs will be considered for elimination."
   [{:keys [modules] :as ast} {:keys [entry] :as options}]
-  (let [;; First find and annotate all the defs in the program
-        ast (-> ast (defs/locate-defs options))
-
-        ;; Then compute the {Var → #{Var}} form of the whole program
-        symbol-sets (->> (for [m   modules
-                               sym (keys (get ast m))
-                               :let [form (get-in ast [m sym])]]
-                           [(:var form) (reach-set form)])
-                         (into {})
-                         global-reach-set)
+  (let [;; Compute the {Var → #{Var}} form of the whole program
+        symbol-sets (->>  (for [m     modules
+                                form  (:forms (get ast m))
+                                :when (pattern/def? form)]
+                            [(:var form) (reach-set form)])
+                          (into {})
+                          global-reach-set)

         ;; The emit set is now trivially
         emit-set (get symbol-sets (resolve entry))]
+    (info emit-set)
     (trim-with-emit-set ast emit-set)))


computer moves + new game

computer moves + new game

--- src/tictactoe/core.cljs
+++ src/tictactoe/core.cljs
@@ -4,25 +4,48 @@
 (enable-console-print!)

 ;; define your app data so that it doesn't get over-written on reload
+
 (defn new-board
   [n]
-  (vec (repeat n (vec (repeat n 0)))))
+  (vec (repeat n (vec (repeat n "B")))))

-(prn (new-board 3))
+(def board-size 3)

-(defonce app-state (atom {:text "Welocome to tic-tac-toe!"
-                          :board (new-board 3)}))
+(defonce app-state (atom {:text "Welocome to tic-tac-toe!!"
+                          :board (new-board board-size)}))
+
+
+
+(prn (new-board board-size))
+
+(defn free-spots []
+  (let [board (:board @app-state)]
+  (for  [i (range board-size)
+         j (range board-size)
+        :when (= (get-in board [i j]) "B")]
+        [i j])))
+
+(defn computer-move []
+  (let [move (rand-nth (free-spots))
+        coords (into [:board] move)]
+    (prn "?? ")
+    (swap! app-state assoc-in coords "X")
+    (prn coords)
+    ))
+
 (defn blank [i j]
       [:rect {:width 0.95
               :height 0.95
               :x i
               :y j
-              :fill (if (zero? (get-in @app-state [:board i j]))
+              :fill (if (= "B" (get-in @app-state [:board i j]))
                         "green" "yellow")
               :on-click
               (fn rect-click [e]
                 (prn "You clicked me" i j)
-                (prn (swap! app-state update-in [:board i j] inc )))}])
+                (prn (swap! app-state assoc-in [:board i j] "O" )
+                (computer-move)
+                ))}])

 (defn circle [i j]
   [:circle {:r 0.45
@@ -39,15 +62,18 @@
   [:center
     [:h1 (:text @app-state)]
     [:svg
-      {:view-box "0 0 3 3" :width 500 :height 500}
+      {:view-box ( str "0 0 " board-size " " board-size) :width 500 :height 500}
       (for [i (range (count (:board @app-state)))
             j (range (count (:board @app-state)))]
             (case (get-in @app-state [:board i j])
-              0 [blank i j]
-              1 [circle i j]
-              2 [cross i j])
-      )
-      ]])
+              "B" [blank i j]
+              "O" [circle i j]
+              "X" [cross i j]))]
+    [:p
+      [:button
+        {:on-click
+          (fn new-game-click [e]
+            (swap! app-state assoc :board (new-board board-size)) )} "New Game"]]])

 (reagent/render-component [tic-tac-toe]
                           (. js/document (getElementById "app")))
@@ -56,5 +82,4 @@
   ;; optionally touch your app-state to force rerendering depending on
   ;; your application
   (swap! app-state assoc-in [:text] "Hello")
-  (prn (:board @app-state))
-)
+  (prn (:board @app-state)))


Update todo

Update todo

--- src/todomvc/events.cljs
+++ src/todomvc/events.cljs
@@ -144,15 +144,18 @@
 (reg-event-db
   :save
   (fn [db [_ id title]]
-    (prn ":save action")
+    (prn ":save action id" id)
+    (prn ":save action title" title)
     (let [session (:state db)
           todo (get-todo db id)
-          update (update-in todo [:title] title)]
+          updated-todo (assoc todo :title title)]
       (prn ":save session" session)
       (prn ":save todo" todo)
-      (prn ":save update" update)
-      (fire-rules (insert session update)))))
-
+      (prn ":save updated-todo" updated-todo)
+      {:state (-> session
+                (retract todo)
+                (insert updated-todo)
+                (fire-rules))})))

 (reg-event-db
   :delete-todo


fix: cosmetic

fix: cosmetic

--- src/bulk_trader/cljs/geojit.cljs
+++ src/bulk_trader/cljs/geojit.cljs
@@ -31,6 +31,7 @@

 (defn do-login [e]
   (.preventDefault e)
+  ;; (handler {:logged-in? true}) ; for testing "POST"
   (POST (str g/login-domain g/login-url)
         {:params {:trader "geojit"
                   :username "foo"


stubbing out digest search & render fns

stubbing out digest search & render fns

--- src/chat/server/email_digest.clj
+++ src/chat/server/email_digest.clj
@@ -28,12 +28,20 @@
     (doall (filter thread-unseen? (db/get-open-threads-for-user user-id)))))

 (defn daily-update-users
-  "Find all users that want daily digest updates"
-  [])
+  "Find all ids for users that want daily digest updates"
+  []
+  (db/user-search-preferences :email-frequency :daily))

 (defn weekly-update-users
-  "Find all users that want weekly digest updates"
-  [])
+  "Find all ids for users that want weekly digest updates"
+  []
+  (db/user-search-preferences :email-frequency :weekly))
+
+; build a message from a thread
+
+(defn render-thread
+  [thread]
+  )

 ; sending


Disable task evaluation

Disable task evaluation

--- src/cider_ci/dispatcher/task.clj
+++ src/cider_ci/dispatcher/task.clj
@@ -197,9 +197,8 @@
 (defdaemon "evaluate-task-eval-notifications"
   0.25 (evaluate-task-eval-notifications))

-(defn initialize []
-  (catcher/with-logging {}
-    (start-evaluate-task-eval-notifications)))
+;TODO: remove disable and evaluate tasks in builder
+(defn initialize [])

 ;(messaging/publish "task.create-trials" {:id "de10e33c-c13f-5aba-94aa-db1dca1e5932"})


Implement the upload of the DTBook XML structure

--- src/clj/mdr2/routes/services.clj
+++ src/clj/mdr2/routes/services.clj
@@ -20,7 +20,9 @@
     [mdr2.vubis :as vubis]
     [mdr2.production :as prod]
     [mdr2.production.spec :as prod.spec]
-    [mdr2.repair.core :as repair]))
+    [mdr2.pipeline1 :as pipeline]
+    [mdr2.repair.core :as repair]
+    [mdr2.dtbook.validation :as validation]))

 (def default-limit 100)

@@ -138,7 +140,24 @@
                              (content-type "text/xml")
                              (charset "UTF-8"))
                          (not-found)))
-            }}]]
+            }
+      :post {:summary "Upload the DTBook XML structure for a production"
+             :parameters {:path {:id int?}
+                          :multipart {:file multipart/temp-file-part}}
+             :handler (fn [{{{:keys [file]} :multipart {:keys [id]} :path} :parameters}]
+                        (let [tempfile (:tempfile file)
+                              production (db/get-production {:id id})
+                              errors (concat
+                                      ;; validate XML
+                                      (pipeline/validate (.getPath tempfile) :dtbook)
+                                      ;; validate meta data
+                                      (validation/validate-metadata (.getPath tempfile) production)
+                                      ;; make sure production is in the state that allows upload
+                                      (when (not (#{"new" "structured"} (:state production)))
+                                        ["Production not in state \"new\" or \"structured\""]))]
+                          (if-not (seq errors)
+                            (no-content)
+                            (bad-request {:status-text "Upload of DTBook XML structure failed" :errors errors}))))}}]]

    ["/abacus"
     {:swagger {:tags ["Abacus API"]}}


Cleanup

Cleanup

--- src/cljs/reframe_test/views.cljs
+++ src/cljs/reframe_test/views.cljs
@@ -7,23 +7,19 @@
   []
   (let [zipper (subscribe [:zipper])]
     (fn []
-      (println "text-zipper fn called")
-      (str @zipper))))
+      [:div "Zipper: " (str @zipper)]
+      )))

 (defn main-panel    ;; the top level of our app
   []
   (let [name    (subscribe [:name])
-        zipper  (subscribe [:zipper]) ]
+        ;zipper  (subscribe [:zipper])]
     (fn []
-      (println )
-      (println "main-panel sees zipper as: "@zipper)
       [:div
-       [:div "Zipper: " (text-zipper)]
+       [:div "Zipper: " [text-zipper]]
        [:div
         [:button {:class "button-class"
-                  :on-click #(do
-                               (println @zipper)
-                               (dispatch [:append-node]))}
+                  :on-click #(dispatch [:append-node])}
          "append"
          ]]
        ])))


Add :port argument to defapplication

Add :port argument to defapplication

--- src/clojure/neko/application.clj
+++ src/clojure/neko/application.clj
@@ -31,7 +31,7 @@
   application's `onCreate` event which automatically calls the
   superOnCreate method and then calls the provided function onto the
   Application object."
-  [name & {:keys [extends prefix on-create]
+  [name & {:keys [extends prefix on-create nrepl-port]
            :or {extends android.app.Application
                 prefix (str (simple-name name) "-")}}]
   `(do
@@ -47,7 +47,7 @@
            (.superOnCreate ~'this)
            (alter-var-root #'context (constantly ~'this))
            (alter-var-root #'package-name (constantly (.getPackageName ~'this)))
-           (init ~'this)
+           (init ~'this :port ~(or nrepl-port 9999))
            (init-threading)
            ~(when on-create
               `(~on-create ~'this))))))


Fix custom cursor code due to libGDX changes

--- src/clojure/nightmod/screens.clj
+++ src/clojure/nightmod/screens.clj
@@ -48,10 +48,15 @@

 ; helpers

-(defn set-cursor-image!
-  [img]
+(defn new-cursor
+  [path]
+  (try (graphics! :new-cursor (pixmap path) 0 0)
+    (catch Exception _)))
+
+(defn set-cursor!
+  [cursor]
   (try
-    (input! :set-cursor-image img 0 0)
+    (graphics! :set-cursor cursor)
     (catch Exception _)))

 (defn take-screenshot!
@@ -152,7 +157,7 @@
 (defn load-project!
   [path]
   ; clear the custom cursor and start with a blank screen
-  (on-gl (set-cursor-image! nil)
+  (on-gl (set-cursor! nil)
          (set-blank-screen!))
   ; save in project-dir so the asset loading and reset button works
   (reset! u/project-dir path)
@@ -194,7 +199,7 @@
           (on-gl
             (asset-manager! manager :clear)
             (set-screen! nightmod main-screen)
-            (set-cursor-image! nil)
+            (set-cursor! nil)
             (manager/clean!)))))))

 (defn restart!
@@ -274,7 +279,7 @@
       (update! screen
                :renderer (stage)
                :camera (orthographic)
-               :cursor-image (pixmap "glove.png")
+               :cursor (new-cursor "glove.png")
                :click-sound (sound "click.ogg"))
       (let [ui-skin (skin "uiskin.json")
             default-font (skin! ui-skin :get-font "default-font")
@@ -342,8 +347,8 @@
       (actor! (:actor screen) :set-color 1 1 1 0.5))
     (if (or (some-> (:actor screen) image-text-button?)
             (some-> (:actor screen) (actor! :get-parent) image-text-button?))
-      (set-cursor-image! (:cursor-image screen))
-      (set-cursor-image! nil)))
+      (set-cursor! (:cursor screen))
+      (set-cursor! nil)))

   :on-ui-changed
   (fn [screen entities]


remove unused arity of trace-var*

remove unused arity of trace-var*

--- src/com/billpiel/sayid/trace.clj
+++ src/com/billpiel/sayid/trace.clj
@@ -146,20 +146,17 @@
            (alter-meta! dissoc ::traced))))))

 (defn trace-var*
-  ([ns s tracer-fn workspace]
-   (trace-var* (ns-resolve ns s)
-               tracer-fn
-               workspace))
-  ([v tracer-fn workspace]
-   (let [^clojure.lang.Var v (if (var? v) v (resolve v))]
-     (when (and (ifn? @v) (-> v meta :macro not))
-       (if-let [[traced-id traced-f] (-> v meta ::traced)]
-         (when (or (not= traced-id (:id workspace))
-                   (not= (-> tracer-fn meta ::trace-type)
-                         (-> v meta ::trace-type)))
-           (untrace-var* v)
-           (apply-trace-to-var v tracer-fn workspace))
-         (apply-trace-to-var v tracer-fn workspace))))))
+  [v tracer-fn workspace & {:keys [no-overwrite]}]
+  (let [^clojure.lang.Var v (if (var? v) v (resolve v))]
+    (when (and (ifn? @v) (-> v meta :macro not))
+      (if-let [[traced-id traced-f] (-> v meta ::traced)]
+        (when (and (not no-overwrite)
+                   (or (not= traced-id (:id workspace))
+                       (not= (-> tracer-fn meta ::trace-type)
+                             (-> v meta ::trace-type))))
+          (untrace-var* v)
+          (apply-trace-to-var v tracer-fn workspace))
+        (apply-trace-to-var v tracer-fn workspace)))))

 (defn trace-ns*
   [ns workspace]


Added some generic crypto tests back in

Added some generic crypto tests back in

--- test/compojure/crypto.clj
+++ test/compojure/crypto.clj
@@ -2,9 +2,34 @@
   (:use compojure.crypto)
   (:use clojure.contrib.test-is))

+(deftest secret-key-length
+  (are (= (count (gen-secret-key {:key-size _1})) _2)
+    256 32
+    128 16))
+
+(deftest secret-key-uniqueness
+  (let [a (gen-secret-key {:key-size 128})
+        b (gen-secret-key {:key-size 128})]
+    (is (not= a b))))
+
 (def secret-key
   (.getBytes "0123456789ABCDEF"))

-(deftest test-seal-unseal
-  (is (= (unseal secret-key (seal secret-key "Foobar"))
-         "Foobar")))
+(deftest seal-string
+  (is (not= (seal secret-key "Foobar") "Foobar")))
+
+(deftest seal-uniqueness
+  (let [a (seal secret-key "Foobar")
+        b (seal secret-key "Foobar")]
+    (is (not= a b))))
+
+(deftest seal-then-unseal
+  (are (= (unseal secret-key (seal secret-key _1)) _1)
+    "Foobar"
+    [1 2 3]
+    {:a 10}))
+
+(deftest seal-then-tamper
+  (let [data (seal secret-key "Foobar")
+        data (apply str "A" (rest data))]
+    (is (nil? (unseal secret-key "Foobar")))))


Housekeeping for 47ff095

Housekeeping for 47ff095

--- src/org/httpkit/client.clj
+++ src/org/httpkit/client.clj
@@ -135,7 +135,8 @@
   Request options:
     :url :method :headers :timeout :query-params :form-params :as
     :client :body :basic-auth :user-agent :filter :worker-pool"
-  [{:keys [client timeout filter worker-pool keepalive as follow-redirects max-redirects response]
+  [{:keys [client timeout filter worker-pool keepalive as follow-redirects max-redirects response
+           trace-redirects allow-unsafe-redirect-methods]
     :as opts
     :or {client @default-client
          timeout 60000
@@ -159,20 +160,20 @@
                   (onSuccess [this status headers body]
                     (if (and follow-redirects
                              (#{301 302 303 307 308} status)) ; should follow redirect
-                      (if (>= max-redirects (count (:trace-redirects opts)))
+                      (if (>= max-redirects (count trace-redirects))
                         (request (assoc opts ; follow 301 and 302 redirect
                                    :url (.toString ^URI (.resolve (URI. url) ^String
                                                                   (.get headers "location")))
                                    :response response
-                                   :method (if (and (not (:allow-unsafe-redirect-methods opts))
+                                   :method (if (and (not allow-unsafe-redirect-methods)
                                                     (#{301 302 303} status))
                                              :get ;; change to :GET
                                              (:method opts))  ;; do not change
-                                   :trace-redirects (conj (:trace-redirects opts) url))
+                                   :trace-redirects (conj trace-redirects url))
                                  callback)
                         (deliver-resp {:opts (dissoc opts :response)
                                        :error (Exception. (str "too many redirects: "
-                                                               (count (:trace-redirects opts))))}))
+                                                               (count trace-redirects)))}))
                       (deliver-resp {:opts    (dissoc opts :response)
                                      :body    body
                                      :headers (prepare-response-headers headers)


Fix the test

Fix the test

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -21,16 +21,24 @@
   [plan]
   (-> (mock/request :post "/v0/caps")
       (mock/content-type "application/edn")
-      (mock/header "Accept" "application/edn")
       (mock/body (str plan))))
+
+(defn valid-headers?
+  "Does the response have valid headers?"
+  [{clength "Content-Length" ctype "Content-Type"}]
+  (and (some? clength) (= ctype "application/edn; charset=utf-8")))

 (deftest handler-tests
   (testing "creating cap with valid plan succeeds"
     (let-flow [req (create-cap-req {:type :succeed})
-               res (handler req)]
-              (is (= (:status res) 201))))
+               {status :status headers :headers} (handler req)]
+              (is (= status 201))
+              (is (valid-headers? headers))))
   (testing "creating cap with bogus plan results in useful errors"
     (let-flow [req (create-cap-req {:type :bogus})
                {status :status headers :headers} (handler req)]
               (is (= status 400))
-              (is (= headers {})))))
+              (is (valid-headers? headers)))))
+
+(def r (create-cap-req {:type :succeed}))
+(def f (handler r))


update server docstrings

update server docstrings

--- src/overtone/sc/server.clj
+++ src/overtone/sc/server.clj
@@ -19,6 +19,7 @@
 (defonce osc-log*       (atom []))

 (defn server-status
+  "Returns a keyword representing the current status of the server."
   []
   @server-status*)

@@ -69,28 +70,34 @@
   "Connect to an externally running SC audio server listening to port on host.
   Host defaults to localhost.

-  (connect 57710)                  ;=> connect to an external server on the
-                                       localhost listening to port 57710
-  (connect \"192.168.1.23\" 57110) ;=> connect to an external server with ip
-                                       address 192.168.1.23 listening to port
-                                       57110"
+  (connect-external-server 57710)                  ;=> Connect to an external
+                                                       server on the localhost
+                                                       listening to port 57710
+  (connect-external-server \"192.168.1.23\" 57110) ;=> Connect to an external
+                                                       server with ip address
+                                                       192.168.1.23 listening to
+                                                       port 57110"
   ([port] (connect-external-server "127.0.0.1" port))
   ([host port] (connect host port)))

 (defn boot-external-server
+  "Boot an external server by starting up an external process and connecting to
+  it."
   ([] (boot :external (+ (rand-int 50000) 2000)))
   ([port] (boot :external port)))

 (defn boot-server
+  "Boot an internal server."
   []
   (boot :internal))

 (defn kill-server
+  "Shutdown the running server"
   []
   (shutdown-server))

 (defn external-server-log
-  "Print the server log."
+  "Print the external server log."
   []
   (doseq [msg @external-server-log*]
     (print msg)))


Refactors code to use app-state instead of local

--- src/wordsmith/core.cljs
+++ src/wordsmith/core.cljs
@@ -10,49 +10,46 @@
   ICloneable
   (-clone [s] (js/String. s)))

-(def app-state (atom {:input ""}))
+(def app-state (atom {:input "" :titles [] :current ""}))

-(defn handle-title-change [event owner]
+(defn handle-title-change [event app]
   (let [new-title (.. event -target -value)
-        old-title (om/get-state owner :title)]
+        old-title (:title app)]
     (when-not (= "" new-title)
-      (om/set-state! owner :title new-title))))
+      (om/update! (:title app) :title new-title))))

 (defn title-field [app owner]
   (reify
-    om/IInitState
-    (init-state [_]
-      {:title ""})
-    om/IRenderState
-    (render-state [_ {:keys [title]}]
+    om/IRender
+    (render [_]
       (dom/div #js {:id "title-field"}
-       (dom/input #js {:type "text" :onBlur #(handle-title-change % owner)}
-                  title)))))
+       (dom/input #js {:type "text" :onBlur #(handle-title-change % app)}
+                  (:current app))))))

-(defn update-current [event owner]
-  (om/set-state! owner :current (.. event -target -text)))
+(defn update-current [event app]
+  (om/update! (:current app) :current (.. event -target -text)))

 (defn left-menu [app owner]
   (reify
-    om/IRenderState
-    (render-state [_ {:keys [titles]}]
+    om/IRender
+    (render [_]
       (dom/div #js {:id "left-menu"}
         (apply dom/ul nil
           (map #(dom/li
-                  #js {:key (str %) :onClick (fn [e] (update-current e owner))} %)
-               titles))))))
+                  #js {:key (str %) :onClick (fn [e] (update-current e app))} %)
+               (:titles app)))))))

 (defn wordsmith-app [app owner]
   (reify
-    om/IInitState
-    (init-state [_]
-      {:input (:input app) :titles (p/get-all-titles)})
-    om/IRenderState
-    (render-state [_ state]
+    om/IWillMount
+    (will-mount [_]
+      (om/update! (:titles app) :titles (p/get-all-titles)))
+    om/IRender
+    (render [_]
       (dom/div #js {:className "container"}
-        (om/build title-field app {:init-state state})
-        (om/build left-menu app {:init-state state})
-        (om/build e/editor app)))))
+        (om/build title-field app)
+        (om/build left-menu app)
+        (om/build e/editor (:input app))))))

 (om/root
   app-state


bugfix number equality instead of generic equality used

--- src/distillery/view/glossary.clj
+++ src/distillery/view/glossary.clj
@@ -30,13 +30,13 @@
   [pindex]
   (let [index-letters (map first pindex)]
     (->> (letter-list)
-         (map (fn [l] (map #(== % l) index-letters)))
+         (map (fn [l] (map #(= % l) index-letters)))
          first)))

 (defn- render-glossary-partition
   "Creates the HTML for a partion of a glossary."
   [first-letter [letter index-part]]
-  (let [is-first-letter (== letter first-letter)]
+  (let [is-first-letter (= letter first-letter)]
     {:tag :div
      :attrs {:id (str "glossary-part-" (glossary-partition-id letter))
              :class "glossary-part"
@@ -50,5 +50,4 @@
     (vec (cons
           (render-glossary-navigation pindex)
           (map (partial render-glossary-partition fl) pindex)))))
-


Add another field to the app-state

Add another field to the app-state

--- src/discuss/utils/common.cljs
+++ src/discuss/utils/common.cljs
@@ -38,7 +38,8 @@
                 :clipboard  {:selections nil
                              :current    nil}
                 :sidebar    {:show? true}
-                :common     {:references []}}))
+                :common     {:references []
+                             :reference-usages {}}}))

 (defn str->int
   "Convert String to Integer."


Fixed view layout to make the console scroll its contents.

--- src/fm/simrunner/gui/view.clj
+++ src/fm/simrunner/gui/view.clj
@@ -143,9 +143,9 @@

 (defn- console []
   (let [text-area   (doto (JTextArea.)
-                          (.setEditable false)
-                          (.setPreferredSize (Dimension. 0 150)))
-        scroll-pane (JScrollPane. text-area)]
+                          (.setEditable false))
+        scroll-pane (doto (JScrollPane. text-area)
+                          (.setPreferredSize (Dimension. 0 150)))]
     (gui/widget :console scroll-pane
                 :contents {:text-area (gui/widget :text-area text-area)})))


Separated input ids from specs.

Separated input ids from specs.

--- src/fm/simrunner/gui/view.clj
+++ src/fm/simrunner/gui/view.clj
@@ -19,33 +19,36 @@
                  JButton
                  JTextArea)))

-(def ^{:private true} input-specs [{:id         :input-file
-                                    :type       :select
-                                    :label-text "Input File"}
-                                   {:id         :output-file
-                                    :type       :select
-                                    :label-text "Output File"}
-                                   {:id         :eps
-                                    :type       :text
-                                    :label-text "EPS"}
-                                   {:id         :log-num
-                                    :type       :text
-                                    :label-text "Log Num"}
-                                   {:id         :stuetz-count
-                                    :type       :text
-                                    :label-text "Stütz #"}
-                                   {:id         :correction
-                                    :type       :text
-                                    :label-text "Correction"}
-                                   {:id         :max-deviation
-                                    :type       :text
-                                    :label-text "Max Deviation"}
-                                   {:id         :calc-err
-                                    :type       :checkbox
-                                    :label-text "Calc Err"}
-                                   {:id         :acsr-size
-                                    :type       :text
-                                    :label-text "ACSR Size"}])
+(def ^{:private true} input-ids [:input-file
+                                 :output-file
+                                 :eps
+                                 :log-num
+                                 :stuetz-count
+                                 :correction
+                                 :max-deviation
+                                 :calc-err
+                                 :acsr-size])
+
+(def ^{:private true} input-specs (map #(assoc %2 :id %1)
+                                       input-ids
+                                       [{:type       :select
+                                         :label-text "Input File"}
+                                        {:type       :select
+                                         :label-text "Output File"}
+                                        {:type       :text
+                                         :label-text "EPS"}
+                                        {:type       :text
+                                         :label-text "Log Num"}
+                                        {:type       :text
+                                         :label-text "Stütz #"}
+                                        {:type       :text
+                                         :label-text "Correction"}
+                                        {:type       :text
+                                         :label-text "Max Deviation"}
+                                        {:type       :checkbox
+                                         :label-text "Calc Err"}
+                                        {:type       :text
+                                         :label-text "ACSR Size"}]))

 (defn- tool-bar []
   (let [open-button    (gui/button :action :open-config
@@ -154,3 +157,9 @@
                    (widget-seq %))
                 contents)))))

+(defn- inputs [view])
+
+(defn render [view model]
+  (doseq [input (inputs view)]
+    (println input)))
+


added country bucketing.

added country bucketing.

--- src/clj/forma/hadoop/jobs/scatter.clj
+++ src/clj/forma/hadoop/jobs/scatter.clj
@@ -39,6 +39,7 @@
                                              ["ecoid"] ["gadm"]
                                              ["border"]])]
     (?<- (hfs-textline out-path
+                       :sinkmode :replace
                        :sinkparts 3
                        :sink-template "%s/")
          [?country ?lat ?lon ?mod-h ?mod-v ?sample ?line ?hansen ?ecoid ?vcf ?gadm ?border]
@@ -53,7 +54,6 @@
          (>= ?vcf 25))))

 ;; ## Forma
-
 (def forma-run-parameters
   {"1000-32" {:est-start "2005-12-01"
               :est-end "2011-07-01"
@@ -136,7 +136,7 @@
         src (hfs-seqfile unbucketed-path)]
     (?- (hfs-textline bucketed-path
                       :sinkmode :replace
-                      :sink-template "%s/%s/"
+                      :sink-template "%s/%s/%s/"
                       :outfields data-fields
                       :templatefields template-fields
                       :sinkparts 3)
@@ -156,6 +156,23 @@

 (defmain BucketForma [source-path results-path & codes]
   (bucket-forma source-path results-path codes))
+
+(defmapop [find-first [re]]
+  [s]
+  (re-find re s))
+
+(defmain BucketCountry
+  [source-path dest-path]
+  (let [src (hfs-textline source-path)]
+    (?<- (hfs-textline dest-path
+                       :sinkmode :replace
+                       :sink-template "%s/"
+                       :templatefields ["?datestring"]
+                       :outfields ["?text"]
+                       :sinkparts 3)
+         [?datestring ?text]
+         (src ?text)
+         (find-first [#"[^\s]+"] ?text :> ?datestring))))

 ;; ## Rain Processing, for Dan
 ;;


Corrected docs for pail to sequence file conversion steps

--- src/clj/forma/hadoop/jobs/scatter.clj
+++ src/clj/forma/hadoop/jobs/scatter.clj
@@ -170,7 +170,7 @@

               ndvi-pail-seq-step
               ([:tmp-dirs ndvi-seq-path]
-                 "Filters out NDVI with VCF < 25"
+                 "Convert ndvi pail to sequence files"
                  (?- (hfs-seqfile ndvi-seq-path)
                      (<- [?pail-path ?data-chunk]
                          ((constrained-tap ts-pail-path
@@ -180,7 +180,7 @@

               reli-pail-seq-step
               ([:tmp-dirs reli-seq-path]
-                 "Filters out reliability with VCF < 25"
+                 "Convert reliability pail to sequence files"
                  (?- (hfs-seqfile reli-seq-path)
                      (<- [?pail-path ?data-chunk]
                          ((constrained-tap ts-pail-path
@@ -190,7 +190,7 @@

               rain-pail-seq-step
               ([:tmp-dirs rain-seq-path]
-                 "Filter out rain with VCF < 25"
+                 "Convert rain pail to sequence files"
                  (?- (hfs-seqfile rain-seq-path)
                      (<- [?pail-path ?data-chunk]
                          ((constrained-tap ts-pail-path


Fixed bug in conv_man swap! for mod-update

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -280,7 +280,7 @@
               {votes :votes mods :moderation}
                         (split-batches msgs)]
           (when mods
-            (swap! conv/mod-update mods))
+            (swap! conv conv/mod-update mods))
           (swap! conv update-fn (or votes []) err-handler))
         (catch Exception e
           (log/error "Excpetion not handler by err-handler:" e)


Updated include-js function to explicitly use closing tag

--- src/compojure/html/page_functions.clj
+++ src/compojure/html/page_functions.clj
@@ -36,7 +36,7 @@
   "Include a list of external javascript files."
   [& scripts]
   (domap [script scripts]
-    [:script {:type "text/javascript" :src script}]))
+    [:script {:type "text/javascript" :src script} ""]))

 (defn include-css
   "Include a list of external stylesheet files."


Revert "Use apply str instead of join"

Revert "Use apply str instead of join"

This reverts commit 25517ae46d3f370137f1bcc871d646f8a02c743c.

--- src/github_changelog/util.clj
+++ src/github_changelog/util.clj
@@ -1,7 +1,7 @@
 (ns github-changelog.util
-  (:require [clojure.string :refer [ends-with?]]))
+  (:require [clojure.string :refer [join ends-with?]]))

-(defn str-map [f & sqs] (apply str (apply map f sqs)))
+(defn str-map [f & sqs] (join (apply map f sqs)))

 (defn extract-params [query-string]
   (into {} (for [[_ k v] (re-seq #"([^&=]+)=([^&]+)" query-string)]
@@ -11,5 +11,5 @@
   ([s] (strip-trailing s "/"))
   ([s end]
    (if (ends-with? s end)
-     (recur (apply str (drop-last s)) end)
+     (recur (join (drop-last s)) end)
      s)))


Use a simpler parser

Use a simpler parser

--- src/grimoire/api/web/read.clj
+++ src/grimoire/api/web/read.clj
@@ -106,6 +106,6 @@
         ?res    (do-data-req config def-thing "related")]
     (if (succeed? ?res)
       (->> ?res result
-         (map (comp #(path->thing (str (thing->path version) "/" %1)) :name))
+         (map (comp path->thing :uri))
          succeed)
       ?res)))


fixed docid->url function to use mapdb

fixed docid->url function to use mapdb

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -20,11 +20,9 @@

 (defn docid->url
   [docid]
-  (-> (some
-       #(when (.startsWith % (str docid)) %)
-       (line-seq (io/reader URL-MAPPING-FILENAME)))
-      (s/split #"\t")
-      second))
+  (with-open [db (spicerack/open-database MAPDB-FILENAME)]
+    (let [url-map (spicerack/open-hashmap db URL-MAPPING-DB)]
+      (get url-map docid))))

 (defn term->postings
   [term]


Flags on controlled planets also

Flags on controlled planets also

--- src/glory_of_empires/map_svg.clj
+++ src/glory_of_empires/map_svg.clj
@@ -89,18 +89,22 @@
   (let [ screen-locs (->> map-pieces (map :logical-pos) (map systems/screen-loc)) ]
     [ (min-pos screen-locs) (map + (max-pos screen-locs) systems/tile-size) ] ))

+(defn piece-to-flag [ { id :id controller :controller } ] { :id id :location id :owner controller :type :flag } )
+
 (defn render
   ( [ game-state ] (render game-state {} ))
-  ( [ { board :map units :units :as game-state } { given-scale :scale } ]
+  ( [ { board :map planets :planets units :units :as game-state } { given-scale :scale } ]
     (if (empty? board) "No map"
       (let [ map-pieces (vals board)
              scale (or given-scale 0.5)
              [ min-corner max-corner :as bounds] (bounding-rect map-pieces)
              svg-size (mul-vec (rect-size bounds) scale)
-             piece-to-flag (fn [ { id :id controller :controller } ] { :id id :location id :owner controller :type :flag })
+             planet-to-flag (fn [ { id :id controller :controller } ]
+                              { :id id :location (glory-of-empires.map/find-planet-loc board id)
+                               :planet id :owner controller :type :flag } )
              system-flags (->> board vals (filter :controller) (map piece-to-flag))
-             all-pieces (concat (vals units) system-flags)
+             planet-flags (->> planets vals (filter :controller) (map planet-to-flag))
+             all-pieces (concat (vals units) system-flags planet-flags)
              map-with-units (glory-of-empires.map/combine-map-units map-pieces all-pieces) ]
-        (println all-pieces)
         (svg/svg svg-size (svg/g { :scale scale :translate (mul-vec min-corner -1.0) }
                                  (map piece-to-svg map-with-units) ))))))


add doc-dir and dir-mtable, ns-interns ftw

--- user.clj
+++ user.clj
@@ -1,5 +1,6 @@
 (ns u
   (:require [clojure.pprint :as pp])
+  (:require [clojure.string :as string])
 )

 (defn class-path "Prints list of class paths" []
@@ -17,14 +18,24 @@
 (defn mtable "Prints meta of a function as a table" [sym]
   (table.core/table (meta (resolve sym))))

-; TODO: can't construct full symbol for doc correctly
-;(defmacro ls
-;  "Prints docs for all vars in a namespace"
-;  [nsname]
-;  `(doseq [v# (clojure.repl/dir-fn '~nsname)]
-;     (clojure.repl/doc
-;     (symbol (str '~nsname "/" v#))))
-;  )
+(defn dir-mtable [nsname]
+  (table.core/table (map #( meta (resolve %)) (clojure.repl/dir-fn nsname))))
+
+(defn sym-to-var [sym]
+  "Converts a symbol to var"
+  ((ns-interns ((meta (resolve sym)) :ns)) sym))
+
+(defn split [f coll]
+  "Like ruby's partition"
+  [(filter f coll) (remove f coll)])
+
+(defn doc-dir [nsname]
+  "Prints docs for a given namespace"
+  (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
+    (doseq [sym resolved]
+      (@#'clojure.repl/print-doc (meta (sym-to-var sym))))
+    (when-not (empty? unresolved)
+      (println (str "\n" "Unable to resolve these symbols: " (string/join ", " unresolved))))))

 (set! clojure.core/*print-length* 100)
 (set! clojure.core/*print-level* 5)


Reduce the number of times the namespace metadata is obtained and evaluated

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -214,24 +214,30 @@
   [routes]
   (into (sorted-map-by compare-route-specs) routes))

+(defn- caching-get
+  [m k f]
+  (if (contains? m k)
+    [m (get m k)]
+    (let [new-value (f)
+          new-map (assoc m k new-value)]
+      [new-map new-value])))
+
 (defn- analyze*
-  [routes handlers middleware extra-arg-resolvers dispatch-table-entry]
+  [[routes handlers middleware namespaces-metadata] extra-arg-resolvers dispatch-table-entry]
   (if-let [[method pathvec verb-fn-sym mw-spec] dispatch-table-entry]
     (t/track
       (format "Analyzing resource handler function `%s'." verb-fn-sym)
       (let [handler-key (gensym "handler-key__")
             routes' (assoc routes
                       [method (keywords->symbols pathvec)] handler-key)
-            [middleware' middleware-key] (if (contains? middleware mw-spec)
-                                   [middleware (get middleware mw-spec)]
-                                   (let [mw-sym (gensym "middleware-key__")]
-                                     [(assoc middleware mw-spec mw-sym) mw-sym]))
-            ns (-> verb-fn-sym namespace symbol the-ns)
-            ;; Seems like we should just do the *ns* binding trick once
-            ;; per namespace. Possibly as an additional map passed into
-            ;; analyze*
-            ns-metadata (binding [*ns* ns]
-                          (-> ns meta eval (dissoc :doc)))
+            [middleware' middleware-key] (caching-get middleware mw-spec #(gensym "middleware-key__"))
+
+            ns-symbol (-> verb-fn-sym namespace symbol)
+
+            [namespaces-metadata' ns-metadata] (caching-get namespaces-metadata ns-symbol
+                                                              #(binding [*ns* (the-ns ns-symbol)]
+                                                                (-> *ns* meta eval (dissoc :doc))))
+
             metadata (merge ns-metadata (meta (resolve verb-fn-sym)))
             route-params (mapv (comp symbol name)
                                (filter keyword? pathvec))
@@ -252,7 +258,7 @@
                       context
                       (assoc :context (string/join "/" (cons "" context))))
             handlers' (assoc handlers handler-key handler)]
-        [routes' handlers' middleware']))))
+        [routes' handlers' middleware' namespaces-metadata']))))

 (defn- analyse-dispatch-table
   "Returns a map holding a map of route-spec* -> handler-sym at
@@ -274,15 +280,14 @@
     metadata."
   [dispatch-table options]
   (let [extra-arg-resolvers (:arg-resolvers options)]
-    (loop [routes     {}
-           handlers   {}
-           middleware {}
+    (loop [analyze-state nil
            entries    (seq (unnest-dispatch-table dispatch-table))]
-      (if-let [[routes' handlers' middleware'] (analyze* routes handlers middleware extra-arg-resolvers (first entries))]
-        (recur routes' handlers' middleware' (next entries))
-        {:routes     (sorted-routes routes)
-         :handlers   handlers
-         :middleware (set/map-invert middleware)}))))
+      (if-let [analyze-state' (analyze* analyze-state extra-arg-resolvers (first entries))]
+        (recur analyze-state' (next entries))
+        (let [[routes handlers middleware] analyze-state]
+          {:routes     (sorted-routes routes)
+           :handlers   handlers
+           :middleware (set/map-invert middleware)})))))

 (defn- map-traversal-dispatcher
   "Returns a Ring handler using the given dispatch-map to guide


Now that we don't care about parts, use a plain vector to keep track of the voices.

--- src/kolmogorov_music/song.clj
+++ src/kolmogorov_music/song.clj
@@ -7,14 +7,6 @@
             [leipzig.temperament :as temperament]
             [kolmogorov-music.champernowne :as champernowne]))

-(def master-volume 0.05)
-
-(definst buzz [freq 110 vol 1.0 dur 1.0]
-  (-> (saw freq)
-      (rlpf (* 4 440) (line:kr 1/10 1/20 dur))
-      (* (env-gen (perc 0.01 0.5) :action FREE))
-      (* vol master-volume)))
-
 (definst sing [freq 110 dur 1.0 vol 1.0]
   (-> (sin-osc freq)
       (+ (sin-osc (* 3.01 freq)))
@@ -23,22 +15,23 @@
       (rlpf (line:kr 3000 500 dur) 1/50)
       (clip2 0.3)
       (* (env-gen (adsr 0.05 (* dur 1/3) 0.2) (line:kr 1 0 dur) :action FREE))
-      (* vol master-volume)))
+      (* vol)))

 ; Arrangement
-(defmethod live/play-note :default [{hertz :pitch seconds :duration}]
-  (when hertz (sing hertz seconds)))
+(defmethod live/play-note :default
+  [{hertz :pitch seconds :duration}]
+  (when hertz (sing hertz seconds 0.05)))

 (defn construct [time duration pitch]
   {:time time
    :pitch pitch
-   :duration duration })
+   :duration duration})

-(defn most-behind [m]
-  (first (apply min-key second m)))
+(defn most-behind [v]
+  (first (apply min-key second (zipmap (range) v))))

-(defn synchronise [m]
-  (zipmap (keys m) (repeat (apply max (vals m)))) )
+(defn synchronise [v]
+  (vec (repeat (count v) (apply max v))))

 (defn decode
   ([state [a b c d & digits]]
@@ -47,7 +40,7 @@
      (let [part (most-behind state)
            duration (/ a b)
            pitch (+ c d)
-           time (part state)]
+           time (get state part)]
        (cons (construct time duration pitch)
              (lazy-seq (->> digits
                             (decode (update-in state [part] (partial + duration))))))))))
@@ -83,7 +76,7 @@
 (defn track []
   (->>
     (champernowne/word 10 row)
-    (decode {:dux 0 :comes 0 :bass 0})
+    (decode [0 0 0])
     (wherever :pitch, :pitch (comp temperament/equal scale/A scale/minor scale/lower))
     (where :time (bpm 120))
     (where :duration (bpm 120))))


Fix wrong require: 0.8.0 instead of 0.7.0

--- src/day8/re_frame_10x/view/event.cljs
+++ src/day8/re_frame_10x/view/event.cljs
@@ -3,7 +3,7 @@
             [day8.re-frame-10x.view.components :as components]
             [day8.re-frame-10x.common-styles :as common]
             [mranderson047.garden.v1v3v3.garden.units :as units]
-            [mranderson047.reagent.v0v7v0.reagent.core :as reagent]
+            [mranderson047.reagent.v0v8v0_alpha2.reagent.core :as reagent]
             [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
             [zprint.core :as zp]
             [goog.string]


Fixed ordering of package task, due to changes to jar task

--- src/leiningen/amp/package.clj
+++ src/leiningen/amp/package.clj
@@ -199,13 +199,6 @@
         (if (fexists tgt-amp-file)
           (.delete ^java.io.File tgt-amp-file))

-        ; module.properties & file-mappings.properties
-        (mkdir-p tgt-amp)
-        (write-module-properties! tgt-module-properties module-properties)
-
-        (if (fexists src-file-mapping)
-          (io/copy src-file-mapping tgt-file-mapping))
-
         ; lib
         (let [project-jar     (io/file (get (jar/jar project) [:extension "jar"]))
               dependency-jars (get-dependency-jars project)]
@@ -218,6 +211,13 @@
               (if (not (empty? dependency-jars))
                 (doall (map #(io/copy % (io/file tgt-lib (fname %))) dependency-jars))))))

+        ; module.properties & file-mappings.properties
+        (mkdir-p tgt-amp)   ; Don't remove this - (jar/jar) cleans the project!
+        (write-module-properties! tgt-module-properties module-properties)
+
+        (if (fexists src-file-mapping)
+          (io/copy src-file-mapping tgt-file-mapping))
+
         ; Now zip the AMP
         (zip-directory! tgt-amp-file tgt-amp)


fixed logging

fixed logging

--- src/engine/middleware/log_request.clj
+++ src/engine/middleware/log_request.clj
@@ -1,7 +1,12 @@
 (ns engine.middleware.log-request
-  (:use [clojure.tools.logging :only [debug]]))
+  (:use [clojure.tools.logging :only (debug)]
+        clj-logging-config.log4j)
+  (:require [clojure.java.io :as io]))
+
+(def access-out (io/file "access.log"))

 (defn log [handler]
   (fn [request]
-    (debug (format "Current request is %s" request))
+    (with-logging-config [:root {:pattern "%d %-5p [%t]: %m%n" :level :debug :out access-out}]
+      (debug (format "Current request is %s" request)))
     (handler request)))


Core change: fair initialization

Core change: fair initialization

--- src/flatgui/widgets/componentbase.clj
+++ src/flatgui/widgets/componentbase.clj
@@ -58,31 +58,34 @@
   (let [
          ;@todo Experiment1
          ;targret-access-key (fgc/get-access-key target-id-path)
-         targret-visible-access-key (fgc/conjv targret-access-key :visible)
-
-         properties (if initialization
-                      (let [ target-properties-already-evovled (fgc/get-evolved-properties container targret-access-key)
-                             to-evolve (if target-properties-already-evovled
-                                         (vec (remove target-properties-already-evovled (:properties dependents)))
-                                         (:properties dependents))]
-                        (if (empty? to-evolve) nil to-evolve))
-
-                      ;
-                      ;@todo Experiment1. Have some :_parameter in :content-pane that tells this is allowed. Not allowed by default
-                      ;
-                      ;
-                      ;(if (get-in container targret-visible-access-key)
-                      ;  (:properties dependents)
-                      ;  (do ;(println " Limiting properties for " target-id-path " because it is not visible")
-                      ;    (if (some #(= :visible %1) (:properties dependents)) (:properties dependents)))
-                      ;  )
-                      ;
-                      ; It causes bugs with cell :visible :achor :selection when grouping/ungrouping and when
-                      ; selecting a row and then scrolling down
-                      ;
-                      (:properties dependents)
-
-                      )
+        ;targret-visible-access-key (fgc/conjv targret-access-key :visible)
+
+        ; TODO October 12, 2015 initialization check should not be needed since  remove the following comment, but Review Experiment1 for regular evolving
+         ;properties (if initialization
+         ;             (let [ target-properties-already-evovled (fgc/get-evolved-properties container targret-access-key)
+         ;                    to-evolve (if target-properties-already-evovled
+         ;                                (vec (remove target-properties-already-evovled (:properties dependents)))
+         ;                                (:properties dependents))]
+         ;               (if (empty? to-evolve) nil to-evolve))
+         ;
+         ;             ;
+         ;             ;@todo Experiment1. Have some :_parameter in :content-pane that tells this is allowed. Not allowed by default
+         ;             ;
+         ;             ;
+         ;             ;(if (get-in container targret-visible-access-key)
+         ;             ;  (:properties dependents)
+         ;             ;  (do ;(println " Limiting properties for " target-id-path " because it is not visible")
+         ;             ;    (if (some #(= :visible %1) (:properties dependents)) (:properties dependents)))
+         ;             ;  )
+         ;             ;
+         ;             ; It causes bugs with cell :visible :achor :selection when grouping/ungrouping and when
+         ;             ; selecting a row and then scrolling down
+         ;             ;
+         ;             (:properties dependents)
+         ;
+         ;             )
+        properties (:properties dependents)
+        ;_ (if (= [:main :hello] target-id-path) (println "ev-out" properties))

          dependent-children1 (:children dependents)

@@ -178,10 +181,13 @@
 (defn evolve-component [original-container container original-target-id-path target-id-path reason properties-to-evolve debug-shift initialization]
   (let [ k (fgc/get-access-key target-id-path)
          pre-target-component (get-in container k)]
-    ; Absence of :path-to-target means that target is a newly created component that has
-    ; not passed container initialization yet and hence cannot be evolved yet
+    ;; Absence of :path-to-target means that target is a newly created component that has
+    ;; not passed container initialization yet and hence cannot be evolved yet
     (if (and pre-target-component (:path-to-target pre-target-component))
-      (let [ evolved-properties-key (fgc/conjv k :evolved-properties)
+      (let [;; During initialization, if a property appears among :evolved-properties then:
+            ;; - it is aready initialized, i.e. transitioned from nil to explicitly specified initial value
+            ;; - it is not necessarily entirely initialized and may be updated because of the dependencies being initialized
+            evolved-properties-key (fgc/conjv k :evolved-properties)
              changed-properties-key (fgc/conjv k :changed-properties)
              latest-changed-properties-key (fgc/conjv k :latest-changed-properties)
              aux-container (update-in! (:aux-container container) latest-changed-properties-key (transient #{}))
@@ -201,15 +207,23 @@
                          pk (fgc/conjv k p)
                          evolver (p (:evolvers tgt))]
                     (if (or initialization evolver)
-                      (let [ old-value (p tgt);(if (and initialization (nil? reason)) nil (p tgt))
-                             ;evolver (p (:evolvers tgt))
+                      (let [;; Remember: cannot use get in :evolved-properties check because of http://dev.clojure.org/jira/browse/CLJ-700
+                            ;; We don track :children change during initialization. Current implementation of initialization
+                            ;; that calls account-struc-changes runs into stack overflow if we do this here
+                            old-value (if (and initialization (not= p :children))
+                                        (let [evolved (get-in aux evolved-properties-key)]
+                                          (if (or (nil? evolved) (not (evolved p)))
+                                            nil
+                                            (p tgt)))
+                                        (p tgt))
                              aux-with-p (update-in! aux evolved-properties-key fgc/set-conj! p)
                              root-p (assoc ret :aux-container aux-with-p)
                              aux-with-evolved-dependencies (:aux-container root-p)
                              ;@todo maybe use original value from original-container for currently evolved property while up-to-date for other, probably this is more honest
                              new-value (if evolver (evolver (assoc tgt :root-container root-p :aux-container aux-with-evolved-dependencies)) (p tgt))
+                             ;; TODO October 15, 2015: looks like it is the same from now on
                              has-changes-raw (not (= old-value new-value))
-                             has-changes (or initialization has-changes-raw)
+                             has-changes has-changes-raw ;(or initialization has-changes-raw)

 ;                             _ (if (and has-changes (= p :children)) (println " Evolved children count from " (count old-value) " to " (count new-value) " str change "
 ;                                                                       (and has-changes-raw (= p :children) (or (not (:_flexible-childset tgt)) (empty? old-value)))))
@@ -233,7 +247,6 @@
                                                       :consumed
                                                       (or (:consumed aux-with-evolved-dependencies) ((:consumes? tgt) tgt)))
                                                     aux-with-evolved-dependencies)
-                             ;_ (if (= :base (:id tgt)) (println "evolve-component" target-id-path "Reason" reason " Property " p "old" old-value "new" new-value " has-changes " has-changes))

                              new-aux (if has-changes
                                        (->
@@ -241,7 +254,15 @@
                                          (update-in! latest-changed-properties-key fgc/set-conj! p)
                                          (update-in! [:_changed-paths] fgc/set-conj! target-id-path))
                                        new-aux-with-consume)
-                             new-ret (if has-changes
+
+                            ;_ (if (and (= :hello (:id tgt)) (= p :position-bound))
+                            ;    (println "evolve-component" target-id-path "Reason" reason " Property " p "old" old-value "new" new-value " has-changes " has-changes
+                            ;             (if (get-in new-aux latest-changed-properties-key)
+                            ;               (str "position-bound?" ((get-in new-aux latest-changed-properties-key) :position-bound))
+                            ;                                 )))
+
+
+                            new-ret (if has-changes
                                        (let [ fin-ret1 (assoc (assoc-in root-p pk new-value)
                                                          :has-structure-changes (or (:has-structure-changes root-p) has-structure-changes)
                                                          :flex-structure-changes (merge (:flex-structure-changes root-p) flex-structure-changes)
@@ -328,20 +349,24 @@
                has-changes (or prev-has-changes new-has-changes)
                with-evolved-target (assoc with-evolved-target-fresh :has-changes has-changes)
                new-aux (:aux-container with-evolved-target)
-               ;_ (if (= [:main :app-panel :hello] target-id-path)
-               ;    (println " JUST EVOLVED target-id-path " target-id-path
-               ;      " new-has-changes " new-has-changes
-               ;      " init " initialization
-               ;      " props " (:position-matrix (get-in new-aux (fgc/conjv k :latest-changed-properties)))
-               ;      " val " (get-in container (fgc/conjv k :position-matrix))
-               ;      ))
+              ; _ (if (and
+              ;         (= [:main :hello] target-id-path)
+              ;         (get-in new-aux (fgc/conjv k :latest-changed-properties))
+              ;         ((get-in new-aux (fgc/conjv k :latest-changed-properties)) :position-bound))
+              ;     (println " JUST EVOLVED target-id-path " target-id-path
+              ;       " new-has-changes " new-has-changes
+              ;       " init " initialization
+              ;       (if (:position-bound (get-in new-aux (fgc/conjv k :latest-changed-properties)))
+              ;                               ((get-in new-aux (fgc/conjv k :latest-changed-properties)) :position-bound))
+              ;       " position-bound " (get-in container (fgc/conjv k :position-bound)) "->" (get-in with-evolved-target (fgc/conjv k :position-bound))
+              ;       ))
                ]
               ;@todo Without this initialization check :children for table content pane do not get evolved on initialization. Why?
               (if (or new-has-changes (and initialization has-changes))
-                (let [ all-out-dependents (:out-dependents new-aux)
-                       changed-properties (get-in new-aux (fgc/conjv k :latest-changed-properties))
-                       properties (if changed-properties (vec (seq (filter changed-properties (for [[k v] all-out-dependents] k)))) [])
-                       container-id (:id with-evolved-target)]
+                (let [all-out-dependents (:out-dependents new-aux)
+                      changed-properties (get-in new-aux (fgc/conjv k :latest-changed-properties))
+                      properties (if changed-properties (vec (seq (filter changed-properties (for [[k v] all-out-dependents] k)))) [])
+                      container-id (:id with-evolved-target)]
                   (loop [ pi (dec (count properties))
                           ret with-evolved-target]
                     (if (>= pi 0)
@@ -498,8 +523,8 @@
   ([root-container target-id-path] (evolve-all-component-only root-container target-id-path nil)))

 (defn- evolve-all
-  ([root-container target-id-path component]
-    (let [ fresh-root-container (evolve-all-component-only root-container target-id-path)]
+  ([root-container target-id-path component properties]
+    (let [ fresh-root-container (evolve-all-component-only root-container target-id-path properties)]
       (loop [ ret fresh-root-container
               children (seq (:children component))]
         (if children
@@ -507,10 +532,10 @@
                  child-id (first child-pair)
                  child-component (second child-pair)]
             (recur
-              (evolve-all ret (fgc/conjv target-id-path child-id) child-component)
+              (evolve-all ret (fgc/conjv target-id-path child-id) child-component properties)
               (next children)))
           ret))))
-  ([root-container] (evolve-all root-container [(:id root-container)] root-container)))
+  ([root-container] (evolve-all root-container [(:id root-container)] root-container nil)))

 (declare initialize-internal)


Add :target-path to clean-targets

Add :target-path to clean-targets

Closes #67.

--- src/leiningen/new/reagent/project.clj
+++ src/leiningen/new/reagent/project.clj
@@ -33,7 +33,8 @@

   :main {{project-ns}}.server

-  :clean-targets ^{:protect false} [[:cljsbuild :builds :app :compiler :output-dir]
+  :clean-targets ^{:protect false} [:target-path
+                                    [:cljsbuild :builds :app :compiler :output-dir]
                                     [:cljsbuild :builds :app :compiler :output-to]]

   :minify-assets


Fix indent

Fix indent

--- modules/reitit-frontend/src/reitit/frontend/history.cljs
+++ modules/reitit-frontend/src/reitit/frontend/history.cljs
@@ -54,10 +54,10 @@
   ;; for XML or XHTML it would be in the original case.
   (let [tag (.toUpperCase tag)]
     (loop [el el]
-    (if el
-      (if (= tag (.-nodeName el))
-        el
-        (recur (.-parentNode el)))))))
+      (if el
+        (if (= tag (.-nodeName el))
+          el
+          (recur (.-parentNode el)))))))

 (defrecord Html5History [on-navigate router listen-key click-listen-key]
   History


fix paging issue in QueryProcessor

fix paging issue in QueryProcessor

--- src/metabase/driver/postgres.clj
+++ src/metabase/driver/postgres.clj
@@ -93,7 +93,7 @@
              {:limit clause-value})
     :aggregation nil
     :page (when-let [{:keys [page items]} clause-value]
-            {:offset (* items (- 1 page))
+            {:offset (* items (- page 1))
              :limit items})))

 (defn build-query [{:keys [table columns] :as query}]