Revert hacky aggregates

Revert hacky aggregates

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -1,6 +1,6 @@
 (ns aurora.language
   (:require [aurora.btree :as btree])
-  (:require-macros [aurora.macros :refer [apush aclear set!!]]))
+  (:require-macros [aurora.macros :refer [apush set!!]]))

 ;; KNOWLEDGE

@@ -105,7 +105,7 @@

 ;; FLOWS

-(deftype SolverFlow [solver output-kinds output-names output-fields]
+(deftype Flow [solver output-kinds output-names output-fields]
   Object
   (run [this kn rule->dirty? kind->name->rules]
        (.reset solver)
@@ -118,40 +118,6 @@
                (let [dirtied-rules (aget kind->name->rules kind name)]
                  (dotimes [j (alength dirtied-rules)]
                    (aset rule->dirty? (aget dirtied-rules j) true)))))))))
-
-(deftype AggregateFlow [prefix-len input-index output-kind output-name output-fields aggregate-function]
-  Object
-  (run [this kn rule->dirty? kind->name->rules]
-       (let [current-key nil
-             inputs #js []
-             output-facts&vals #js []]
-         (.foreach input-index
-                   (fn [key]
-                     (when (nil? current-key)
-                       (set!! current-key key))
-                     (when (btree/prefix-not= key current-key prefix-len)
-                       (let [outputs (aggregate-function inputs)]
-                         (dotimes [i (alength outputs)]
-                           (let [output-key (.slice current-key 0 prefix-len)]
-                             (aset output-key prefix-len (aget outputs i))
-                             (apush output-facts&vals output-key)
-                             (apush output-facts&vals 1)))
-                         (set!! current-key key)
-                         (aclear inputs)))
-                     (apush inputs (.slice key prefix-len))))
-         (when (> (alength inputs) 0)
-           (let [outputs (aggregate-function inputs)]
-             (dotimes [i (alength outputs)]
-               (let [output-key (.slice current-key 0 prefix-len)]
-                 (aset output-key prefix-len (aget outputs i))
-                 (apush output-facts&vals output-key)
-                 (apush output-facts&vals 1)))
-             (set!! current-key key)
-             (aclear inputs)))
-         (when (true? (.update-facts kn output-kind output-name output-fields output-facts&vals))
-           (let [dirtied-rules (aget kind->name->rules output-kind output-name)]
-             (dotimes [j (alength dirtied-rules)]
-               (aset rule->dirty? (aget dirtied-rules j) true)))))))

 (deftype Flows [rules rule->flow rule->dirty? kind->name->rules name->transient?]
   Object
@@ -191,13 +157,9 @@
         kind->name->rules (atom {})
         name->transient? (atom {})
         clauses (.keys (.get-or-create-index kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"]))
-        fields (.keys (.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"]))
-        aggregate-vars (.keys (.get-or-create-index kn "know" "clause-aggregate-vars" #js ["aggregate-id" "ix" "var"]))
-        aggregate-funs (.keys (.get-or-create-index kn "know" "clause-aggregate-funs" #js ["aggregate-id" "js"]))
+        fields (.keys (.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"]))
         rule-id->clauses (atom (into {} (for [[k vs] (group-by #(nth % 0) clauses)] [k (set (map vec vs))])))
-        clause-id->fields (atom (into {} (for [[k vs] (group-by #(nth % 0) fields)] [k (set (map vec vs))])))
-        aggregate-id->aggregate-vars (atom (into {} (for [[k vs] (group-by #(nth % 0) aggregate-vars)] [k (set (map vec vs))])))
-        aggregate-id->aggregate-funs (atom (into {} (for [[k vs] (group-by #(nth % 0) aggregate-funs)] [k (set (map vec vs))])))]
+        clause-id->fields (atom (into {} (for [[k vs] (group-by #(nth % 0) fields)] [k (set (map vec vs))])))]

     ;; rewrite clauses
     (doseq [[rule-id clauses] @rule-id->clauses]
@@ -320,81 +282,41 @@
               solver (btree/solver num-vars (into-array constraints))

               ;; make output specs
-              output-kinds #js []
-              output-names #js []
-              output-fields #js []]
-
-          (doseq [[_ clause-type clause-id clause-name] clauses
-                  :when (not= clause-type "when")]
-            (let [clause-fields (get @clause-id->fields clause-id)
-                  fields (make-array num-vars)
-                  aggregate-keys&ids (for [[_ field-type key val] clause-fields
-                                           :when (= field-type "aggregate")]
-                                       [key val])
-                  _ (assert (<= (count aggregate-keys&ids) 1)) ;; TODO handle multiple aggregates
-                  aggregate-key (first (first aggregate-keys&ids))
-                  aggregate-id (second (first aggregate-keys&ids))
-                  ix->aggregate-keys&vars (into (sorted-map)
-                                                (for [[_ ix var] (@aggregate-id->aggregate-vars aggregate-id)]
-                                                  [ix [(new-id) var]]))
-                  aggregate-funs (for [[_ js] (@aggregate-id->aggregate-funs aggregate-id)]
-                                   js)
-                  _ (assert (<= (count aggregate-funs) 1))
-                  aggregate-fun (first aggregate-funs)
-                  output-name (if (nil? aggregate-key)
-                                clause-name
-                                (str "aggregate-" rule-id))
-                  output-type (if (nil? aggregate-key)
-                                clause-type
-                                "know")]
-
-              ;; add to rule outputs
-              (doseq [[_ field-type key val] clause-fields
-                      :when (= field-type "variable")]
-                (aset fields (var->ix val) key))
-              (doseq [[ix [key var]] ix->aggregate-keys&vars]
-                (aset fields (var->ix var) key))
-              (apush output-kinds output-type)
-              (apush output-names output-name)
-              (apush output-fields fields)
-
-              ;; ensure indexes exist
-              (let [filtered-fields (make-array num-vars)
-                    _ (doseq [[_ field-type key val] clause-fields
-                              :when (= field-type "variable")]
-                        (aset filtered-fields (var->ix val) key))
-                    filtered-fields (into-array (filter #(not (nil? %)) filtered-fields))
-                    ;; make sure aggregate-variables are last
-                    _ (when-not (nil? aggregate-key)
-                        (doseq [[ix [key var]] ix->aggregate-keys&vars]
-                          (apush filtered-fields key)))
-                    final-fields (make-array num-vars)
-                    _ (doseq [[_ field-type key val] clause-fields
-                              :when (= field-type "variable")]
-                        (aset final-fields (var->ix val) key))
-                    final-fields (into-array (filter #(not (nil? %)) final-fields))
-                    _ (when-not (nil? aggregate-key)
-                        (apush final-fields aggregate-key))
-                    ;; TODO get transient? from schema instead
-                    transient? (identical? clause-type "know")]
-                (assert (not= (not transient?) (get @name->transient? clause-name)) clause-name)
-                (swap! name->transient? assoc clause-name transient?)
-                (swap! kind->name->rules update-in [clause-type clause-name] #(or % #{}))
-                (.ensure-index kn "know" clause-name final-fields)
-                (when (false? transient?)
-                  (.ensure-index kn "forget" clause-name final-fields)
-                  (.ensure-index kn "remember" clause-name final-fields))
-
-                ;; create aggregate flow if needed
-                (when-not (nil? aggregate-key)
-                  (let [input-index (.get-or-create-index kn "know" output-name filtered-fields)
-                        aggregate-function (aget js/aurora.aggregates aggregate-fun)
-                        prefix-len (- (count final-fields) 1)]
-                    (swap! name->transient? assoc output-name true)
-                    (swap! kind->name->rules update-in ["know" output-name] #(conj (or % #{}) output-name))
-                    (swap! rule->flow assoc output-name (AggregateFlow. prefix-len input-index clause-type clause-name final-fields aggregate-function)))))))
-
-          (swap! rule->flow assoc rule-id (SolverFlow. solver output-kinds output-names output-fields)))))
+              output-kinds (into-array
+                            (for [[_ clause-type clause-id name] clauses
+                                  :when (not= clause-type "when")]
+                              clause-type))
+              output-names (into-array
+                            (for [[_ clause-type clause-id name] clauses
+                                  :when (not= clause-type "when")]
+                              name))
+              output-fields (into-array
+                             (for [[_ clause-type clause-id name] clauses
+                                   :when (not= clause-type "when")]
+                               (let [clause-fields (get @clause-id->fields clause-id)
+                                     output-fields (make-array num-vars)]
+                                 (doseq [[_ field-type key val] clause-fields]
+                                   (assert (= field-type "variable") [rule-id clause-id clause-fields])
+                                   (aset output-fields (var->ix val) key))
+                                 output-fields)))]
+
+          ;; set up state for outputs
+          (dotimes [i (alength output-kinds)]
+            (let [kind (aget output-kinds i)
+                  name (aget output-names i)
+                  fields (aget output-fields i)
+                  filtered-fields (into-array (filter #(not (nil? %)) fields))
+                  transient? (identical? kind "know")]
+              ;; TODO get transient? from schema instead
+              (assert (not= (not transient?) (get @name->transient? name)) name)
+              (swap! name->transient? assoc name transient?)
+              (swap! kind->name->rules update-in [kind name] #(or % #{}))
+              (.ensure-index kn "know" name filtered-fields)
+              (when (false? transient?)
+                (.ensure-index kn "forget" name filtered-fields)
+                (.ensure-index kn "remember" name filtered-fields))))
+
+          (swap! rule->flow assoc rule-id (Flow. solver output-kinds output-names output-fields)))))

     ;; TODO stratify
     (Flows. (clj->js (map first @rule->flow)) (clj->js @rule->flow) #js {} (clj->js @kind->name->rules) (clj->js @name->transient?))))
@@ -414,16 +336,12 @@

 (.get-or-create-index kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"])

-(.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"])
-
-(.get-or-create-index kn "know" "clause-aggregate-vars" #js ["aggregate-id" "ix" "var"])
-
-(.get-or-create-index kn "know" "clause-aggregate-funs" #js ["aggregate-id" "js"])
+(.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"])

 (.add-facts kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"] #js [#js ["single-edge" "when" "get-edges" "edge"]
                                                                                #js ["single-edge" "know" "output-connected" "connected"]])

-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["get-edges" "variable" "x" "xx"]
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-edges" "variable" "x" "xx"]
                                                                                #js ["get-edges" "variable" "y" "yy"]
                                                                                #js ["output-connected" "variable" "x" "xx"]
                                                                                #js ["output-connected" "variable" "y" "yy"]])
@@ -432,7 +350,7 @@
                                                                                #js ["transitive-edge" "when" "get-right-connected" "connected"]
                                                                                #js ["transitive-edge" "know" "output-transitive-connected" "connected"]])

-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["get-left-edge" "variable" "x" "xx"]
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-left-edge" "variable" "x" "xx"]
                                                                                #js ["get-left-edge" "variable" "y" "yy"]
                                                                                #js ["get-right-connected" "variable" "x" "yy"]
                                                                                #js ["get-right-connected" "variable" "y" "zz"]
@@ -444,7 +362,7 @@
                                                                                #js ["function-edge" "when" "make-str" "=function"]
                                                                                #js ["function-edge" "remember" "know-str" "str-edge"]])

-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["get-function-edge" "variable" "x" "xx"]
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-function-edge" "variable" "x" "xx"]
                                                                                #js ["get-function-edge" "variable" "y" "yy"]
                                                                                #js ["filter-edge" "constant" "js" "xx == \"a\""]
                                                                                #js ["make-str" "variable" "variable" "zz"]
@@ -455,7 +373,7 @@
                                                                                #js ["-function-edge" "when" "-make-str" "=function"]
                                                                                #js ["-function-edge" "forget" "-know-str" "str-edge"]])

-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["-get-function-edge" "variable" "x" "xx"]
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["-get-function-edge" "variable" "x" "xx"]
                                                                                #js ["-get-function-edge" "variable" "y" "yy"]
                                                                                #js ["-make-str" "variable" "variable" "zz"]
                                                                                #js ["-make-str" "constant" "js" "\"edge \" + xx + \" \" + yy"]
@@ -471,39 +389,16 @@
                                                                                #js ["overlap" "when" "some-interval" "interval"]
                                                                                #js ["overlap" "remember" "rem-bar" "bar"]])

-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["get-foos" "variable" "x" "xx"]
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-foos" "variable" "x" "xx"]
                                                                                #js ["get-foos" "variable" "y" "yy"]
                                                                                #js ["some-interval" "variable" "lo" "xx"]
                                                                                #js ["some-interval" "variable" "hi" "yy"]
                                                                                #js ["some-interval" "variable" "in" "zz"]
                                                                                #js ["rem-bar" "variable" "z" "zz"]])

-
-(.add-facts kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"] #js [#js ["count-overlap" "when" "get-more-foos" "foo"]
-                                                                                #js ["count-overlap" "when" "some-more-interval" "interval"]
-                                                                                #js ["count-overlap" "remember" "rem-quux" "quux"]
-                                                                                #js ["count-overlap" "remember" "rem-frip" "frip"]])
-
-(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable|aggregate" "key" "val"] #js [#js ["get-more-foos" "variable" "x" "xx"]
-                                                                                #js ["get-more-foos" "variable" "y" "yy"]
-                                                                                #js ["some-more-interval" "variable" "lo" "xx"]
-                                                                                #js ["some-more-interval" "variable" "hi" "yy"]
-                                                                                #js ["some-more-interval" "variable" "in" "zz"]
-                                                                                #js ["rem-quux" "variable" "x" "xx"]
-                                                                                #js ["rem-quux" "variable" "y" "yy"]
-                                                                                #js ["rem-quux" "aggregate" "z" "count-zz"]
-                                                                                #js ["rem-frip" "variable" "x" "xx"]
-                                                                                #js ["rem-frip" "variable" "y" "yy"]
-                                                                                #js ["rem-frip" "aggregate" "z" "top-3-zz"]])
-
-(.add-facts kn "know" "clause-aggregate-vars" #js ["aggregate-id" "ix" "var"] #js [#js ["count-zz" 0 "zz"]
-                                                                                #js ["top-3-zz" 0 "zz"]
-                                                                                #js ["top-3-zz" 1 "zz"]])
-
-(.add-facts kn "know" "clause-aggregate-funs" #js ["aggregate-id" "js"] #js [#js ["count-zz" "count"]
-                                                                             #js ["top-3-zz" "top-3"]])
-
 (def flows (compile kn))
+
+(set! (.-rules flows) #js ["single-edge" "transitive-edge" "function-edge" "-function-edge" "overlap"])

 (enable-console-print!)

@@ -525,6 +420,4 @@
 (.get-or-create-index kn "know" "foo" #js ["x" "y"])

 (.get-or-create-index kn "know" "bar" #js ["z"])
-
-(.get-or-create-index kn "know" "quux" #js ["x" "y" "z"])
 )


feat(server): introduce start-server

feat(server): introduce start-server

--- src/busa_server/main.clj
+++ src/busa_server/main.clj
@@ -3,7 +3,9 @@
     [busa-server.page.driver :as page-driver]
     [busa-server.model.db :as db]
     [busa-server.core.connections :as connections]
-    [busa-server.core.scheduler :as scheduler])
+    [busa-server.core.scheduler :as scheduler]
+    [busa-server.api.handler :as busa-api]
+    [org.httpkit.server :as httpkit])
   (:gen-class))

 (defn init []
@@ -15,7 +17,12 @@
   (println "Connections loaded")
   (scheduler/run-everyday-after-midnight connections/load-connections))

+(defn start-server [conf]
+  (httpkit/run-server #'busa-api/busa-handler conf)
+  (println (str "Server started at port " (:port conf))))
+
 (defn -main
   [& args]
   (println "Starting BUSA Server")
-  (init))
+  (init)
+  (start-server {:port 3000}))


* src/clj/cljs/closure.clj: CLJS-323: add compiler build :warnings true option

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -871,7 +871,9 @@
     (binding [ana/*cljs-static-fns*
               (or (and (= (opts :optimizations) :advanced))
                   (:static-fns opts)
-                  ana/*cljs-static-fns*)]
+                  ana/*cljs-static-fns*)
+              ana/*cljs-warn-on-undeclared*
+              (true? (opts :warnings))]
       (let [compiled (-compile source all-opts)
             compiled (concat
                       (if (coll? compiled) compiled [compiled])


formatting & comment

formatting & comment

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -680,6 +680,8 @@
               ;; add inputs to module
               (doseq [^SourceFile module-source module-sources]
                 (.add js-module module-source))
+              ;; add module dependencies, will always work
+              ;; since modules are already in dependency order
               (doseq [dep depends-on]
                 (if-let [parent-module (get-in (into {} ret) [dep :closure-module])]
                   (.addDependency js-module ^JSModule parent-module)
@@ -787,8 +789,7 @@
                   (cons "var CLOSURE_NO_DEPS = true;" sources)
                   sources)
         ^List inputs (map #(js-source-file (javascript-name %) %) sources)
-        result ^Result (.compile closure-compiler externs inputs compiler-options)
-        ]
+        result ^Result (.compile closure-compiler externs inputs compiler-options)]
     (if (.success result)
       ;; compiler.getSourceMap().reset()
       (let [source (.toSource closure-compiler)]


return nil for -first with nil

return nil for -first with nil

--- src/clj/clojure/next.clj
+++ src/clj/clojure/next.clj
@@ -151,10 +151,6 @@
 (defn count [obj]
   (-count obj))

-(extend-type nil
-  ICounted
-  (-count [this] 0))
-
 (defn deref [obj]
   (-deref obj))

@@ -188,6 +184,14 @@

 (defn namespace [named]
   (-namespace named))
+
+(extend-type nil
+  ICounted
+  (-count [this] 0)
+  ISeqable
+  (-seq [this] nil)
+  ISeq
+  (-first [this] nil))

 (defn seq [s]
   (-seq s))
@@ -226,14 +230,8 @@
     (list elem)
     (make-cons elem (seq seqable))))

-(extend-type nil
-  ISeqable
-  (-seq [this] nil))
-
 (defn first [s]
-  (if (satisfies? ISeq s)
-    (-first s)
-    (-first (seq s))))
+  (-first (seq s)))

 (defn next [s]
   (-next (seq s)))


Change routes

Change routes

--- src/clj/notes/server.clj
+++ src/clj/notes/server.clj
@@ -22,7 +22,8 @@
   (PATCH "/notes/:id" {params :params edn-params :edn-params} (update-note edn-params))
   (DELETE "/notes/:id" {params :params edn-params :edn-params} (delete-note edn-params))
   (resources "/react" {:root "react"})
-  (files "/" {:root "resources/public"}))
+  (files "/" {:root "resources/public"})
+  (GET "/*" req (page)))

 (defn logging-middleware [chain] (fn [req] (do (println (str "REQUEST: " req)) (chain req))))


Adds pause-a-users-playback function.

Adds pause-a-users-playback function.

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -3,7 +3,7 @@
             [clojure.data.json :as json]
             [clojure.string :as string]))

-(def template-keys [:id :category_id :owner_id :playlist_id :user_id])
+(def template-keys [:id :category_id :owner_id :playlist_id :user_id :device_id])

 (def spotify-api-url "https://api.spotify.com/v1/")

@@ -521,8 +521,13 @@
   Example: (start-or-resume-a-users-playback {:device_id [\"74ASZWbe4lXaubB36ztrGX\"] :context_uri \"spotify:album:2cX9e3renOX5bUQEXWFrJr\"} :offset {:position 5}} \"BQBw-JtC..._7GvA\")"
   (api-put "me/player/play"))

-
 ;;TODO Pause a users playback.
+(def pause-a-users-playback
+  " Takes two arguments, a map with query parameters and an oauth-token t.
+  There are no compulsary keys in m, optional key is :device_id.
+  :device_id is the device id of the device the command is targeting. If not supplied, the users current device is the target.
+  Example: (pause-a-users-playback {:device_id \"74ASZWbe4lXaubB36ztrGX\"} \"BQBw-JtC..._7GvA\")"
+  (api-put "me/player/pause"))

 ;;TODO Skip users playback to next track.


Break out function for calculating piece css class

--- src/cljs/chess/core.cljs
+++ src/cljs/chess/core.cljs
@@ -5,11 +5,16 @@

 (defonce app-state (atom {:board board/start-position}))

+
+(defn piece-class-name
+  [p]
+  (str "piece " (board/colour p) " " (board/pieces p)))
+
 (defn piece [p owner]
   (reify
     om/IRender
     (render [_]
-      (dom/div #js {:className (str "piece " (board/colour p) " " (board/pieces p))} nil))))
+      (dom/div #js {:className (piece-class-name p)} nil))))

 (defn main []
   (om/root


Re-add downsample to evaluate

Re-add downsample to evaluate

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -71,8 +71,8 @@
       (let [p (:program i)
             evaluated-i (if (or (not reuse-errors)
                                 (nil? (:errors i)))
-                         (error-function i)
-                         i)
+                          (error-function i (:sub-training-cases argmap))
+                          i)
             raw-errors (:errors evaluated-i)
             e (vec (if (and reuse-errors (not (nil? (:errors i))))
                      (:errors i)


fixed paging sort default field

fixed paging sort default field

--- src/ctia/http/routes/common.clj
+++ src/ctia/http/routes/common.clj
@@ -5,7 +5,7 @@
             [ring.swagger.schema :refer [describe]]))

 (s/defschema PagingParams
-  {(s/optional-key :sort_by) (describe (s/enum :timestamp) "Sort results on a field")
+  {(s/optional-key :sort_by) (describe (s/enum :id) "Sort results on a field")
    (s/optional-key :sort_order) (describe (s/enum :asc :desc) "Sort direction")
    (s/optional-key :offset) (describe Long "Pagination Offset")
    (s/optional-key :limit) (describe Long "Pagination Limit")})


raise redis timeouti ms

raise redis timeouti ms

--- src/ctia/stores/redis/store.clj
+++ src/ctia/stores/redis/store.clj
@@ -31,7 +31,9 @@
     (when (false? (and host port))
       (log/warn "Redis has been de-configured"))
     {:pool {}
-     :spec {:host (or host default-host) :port (or default-port)}}))
+     :spec {:host (or host default-host)
+            :port (or default-port)
+            :timeout-ms 30000}}))

 (defn enabled?
   "Returns true when Redis is currently configured"


Code improvement in day 13

Code improvement in day 13

--- src/adventofcode/solutions.clj
+++ src/adventofcode/solutions.clj
@@ -449,8 +449,7 @@
                         #(+ % (deltas %2))
                         0
                         (conj pairs [(ffirst pairs) (last (last pairs))]))))]
-    (reduce
-      #(if (> %2 %) %2 %)
-      (map
-        #(+ (happiness %) (happiness (reverse %)))
-        arrangements))))
+    (apply max
+           (map
+             #(+ (happiness %) (happiness (reverse %)))
+             arrangements))))


Added event to let settlement died out

Added event to let settlement died out

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -142,18 +142,26 @@
       (record-event (str "Population of " (.name s) " shrinking to " (.pop s)) nil))
     (update-settlement s)))

+(defn ghost-town? [settlement]
+  (= 0 (.pop settlement)))
+
 (defn update-settlement-fun [id-settlement]
   (fn []
     (let [s     (get-settlement id-settlement)
           event (rand-nth [:growing :shrinking :stable])]
-      (when (= event :growing)
-        (let [perc (+ 1.0 (/ (rand) 4.0))
-              new-pop (int (* (.pop s) perc))]
-          (update-settlement-pop id-settlement new-pop)))
-      (when (= event :shrinking)
-        (let [perc (- 1.00 (/ (rand) 4.0))
-              new-pop (int (* (.pop s) perc))]
-          (update-settlement-pop id-settlement new-pop))))))
+      (when (not (ghost-town? s))
+        (when (= event :growing)
+          (let [perc (+ 1.0 (/ (rand) 4.0))
+                new-pop (int (* (.pop s) perc))]
+            (update-settlement-pop id-settlement new-pop)))
+        (when (= event :shrinking)
+          (let [perc (- 1.00 (/ (rand) 4.0))
+                new-pop (int (* (.pop s) perc))]
+            (update-settlement-pop id-settlement new-pop)))
+        (let [s (get-settlement id-settlement)]
+          (when (and (< (.pop s) 50) (chance 0.35))
+            (update-settlement-pop id-settlement 0)
+            (record-event "Village " (.name s) " is now a ghost town")))))))

 (defn- create-tribe-in-game [game]
   (let [id-tribe (.next-id game)


Adjust main to use new version.

Adjust main to use new version.


CMR-3557: Putting in partial work around for acl search performance. No ACL condition is added if user has ANY_ACL permission.

--- access-control-app/src/cmr/access_control/services/acl_search_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_search_service.clj
@@ -264,9 +264,10 @@
 (defn make-acl-condition
   "Returns elastic condition to filter out ACLs that are not visible to the user."
   [context acls-with-concept-id]
-  (let [concept-ids (get-searchable-acls context acls-with-concept-id)]
-    (when (seq concept-ids)
-      (common-qm/string-conditions :concept-id concept-ids true))))
+  (when-not (acl-auth/has-system-access? context :read "ANY_ACL")
+   (let [concept-ids (get-searchable-acls context acls-with-concept-id)]
+     (when (seq concept-ids)
+       (common-qm/string-conditions :concept-id concept-ids true)))))

 (defmethod qe/add-acl-conditions-to-query :acl
   [context query]


[#1602] Copyright notice

[#1602] Copyright notice

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/t.clj
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/t.clj
@@ -1,4 +1,4 @@
-;; Copyright (C) 2014 Stichting Akvo (Akvo Foundation)
+;; Copyright (C) 2014-2016 Stichting Akvo (Akvo Foundation)
 ;;
 ;; This file is part of Akvo FLOW.
 ;;


add exception info when reporting error command

--- src/mapfs/core.clj
+++ src/mapfs/core.clj
@@ -224,7 +224,7 @@
           (try
             (println (eval (read-string (str "(" v ")"))))
             (catch Exception e
-              (println "  ERROR: Invalid command")))
+              (println "  ERROR: Invalid command:" (.getMessage e))))
           (recur)
           )))
     (pop-thread-bindings)


Avoid error if loading midje.repl after midje.sweet

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -19,7 +19,8 @@
 (namespace/immigrate-from 'midje.ideas.metadata
                           (map metadata/metadata-function-name
                                metadata/fact-properties))
-(namespace/immigrate 'midje.sweet)
+(when-not (ns-resolve 'user '=>) ; when not already `use`d.
+  (namespace/immigrate 'midje.sweet))
 (declare forget-facts)


+Antonia and Luisa

+Antonia and Luisa

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -37,6 +37,13 @@
                    :human true}
              :propernoun true
              :agr {:number :sing
+                   :person :3rd
+                   :gender :fem}}}
+   "Antonia and Luisa"
+   {:synsem {:sem {:pred :antonia-and-luisa
+                   :human true}
+             :propernoun true
+             :agr {:number :plur
                    :person :3rd
                    :gender :fem}}}
    "Antonio"
@@ -147,7 +154,8 @@
                                                  :subj the-real-subj}
                                            }
                                        :2 {:cat :noun
-                                           :agr subj-agr
+                                           :agr {:gender gender
+                                                 :number number}
                                            :sem the-obj
                                            :pronoun false
                                            :propernoun true ;; "John" in "My name is John"


add (default) rule for {:modal-with :infinitive}

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -210,32 +210,39 @@
                                            :sem {:obj obj
                                                  :pred pred}}}}}))])

-   "be able to" {:english {:imperfect {:1sing "was able to"
-                                       :2sing "were able to"
-                                       :3sing "was able to"
-                                       :1plur "were able to"
-                                       :2plur "were able to"
-                                       :3plur "were able to"}
-
-                           ;; TODO: improve this. Currently sounds pretty awkward:
-                           ;; "he was being able to"
-                           :participle "being able to"
-
-                           :present {:1sing "am able to"
-                                     :2sing "are able to"
-                                     :3sing "is able to"
-                                     :1plur "are able to"
-                                     :2plur "are able to"
-                                     :3plur "are able to"}
-                           :past {:1sing "was able to"
-                                  :2sing "were able to"
-                                  :3sing "was able to"
-                                  :1plur "were able to"
-                                  :2plur "were able to"
-                                  :3plur "were able to"}}
-                 :synsem {:cat :verb
-                          :sem {:pred :be-able-to}}}
-
+   "be able" (let [common {:english {:imperfect {:1sing "was able"
+                                                    :2sing "were able"
+                                                    :3sing "was able"
+                                                    :1plur "were able"
+                                                    :2plur "were able"
+                                                    :3plur "were able"}
+
+                                        ;; TODO: improve this. Currently sounds pretty awkward:
+                                        ;; "he was being able"
+                                        :participle "being able"
+
+                                        :present {:1sing "am able"
+                                                  :2sing "are able"
+                                                  :3sing "is able"
+                                                  :1plur "are able"
+                                                  :2plur "are able"
+                                                  :3plur "are able"}
+                                        :past {:1sing "was able"
+                                               :2sing "were able"
+                                               :3sing "was able"
+                                               :1plur "were able"
+                                               :2plur "were able"
+                                               :3plur "were able"}}}]
+               [(unify common
+                       {:modal-with :infinitive
+                        :synsem {:cat :verb
+                                 :sem {:pred :be-able-to}}})
+                (unify common
+                       {:synsem {:cat :verb
+                                 :sem {:pred :be-able-to}
+                                 :subcat {:1 {:cat :top}
+                                          :2 '()}}})])
+
    "be born" {:synsem {:cat :verb
                        :sem {:pred :be-born}
                        :subcat {:2 '()}}
@@ -2203,8 +2210,23 @@
                   {:synsem {:cat :verb
                             :subcat {:2 {:cat :top}}}})

+                 (default
+                  {:modal-with false
+                   :synsem {:cat :verb}})
+
+                 (default
+                  (let [modal-subject (atom {:cat :noun})]
+                    {:modal-with :infinitive
+                     :synsem {:cat :verb
+                              :subcat {:1 modal-subject
+                                       :2 {:cat :verb
+                                           :infl :infinitive
+                                           :subcat {:1 modal-subject
+                                                    :2 '()}}}}}))
+
                  ;; add :sem :obj if necessary, so that intransitivize is triggered.
-                 (if-then {:synsem {:cat :verb
+                 (if-then {:modal-with false
+                           :synsem {:cat :verb
                                     :subcat {:2 {:cat :noun}}}}
                           {:synsem {:sem {:obj {:pred :top}}}})


fix present-tense for "may"

fix present-tense for "may"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1039,7 +1039,12 @@
    "may"
    {:english {:past "might"
               :participle "able to"
-              :present "may"
+              :present {:1sing "may"
+                        :2sing "may"
+                        :3sing "may"
+                        :1plur "may"
+                        :2plur "may"
+                        :3plur "may"}
               :future "be able to"
               :conditional "might"}
     :synsem {:cat :verb


+avoid<noun[animate],noun>

+avoid<noun[animate],noun>

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -124,7 +124,10 @@
                                          :human false}}}}}

    "avoid" {:synsem {:cat :verb
-                     :sem {:pred :avoid}}}
+                     :sem {:pred :avoid}
+                     :subcat {:1 {:cat :noun
+                                  :sem {:animate true}}
+                              :2 {:cat :noun}}}}

    "bag" {:synsem {:cat :noun
                    :sem {:pred :bag}}}


Fix package litedocx.wpml

Fix package litedocx.wpml

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -231,12 +231,12 @@
   "Creates XML data for docProps/app.xml file in DOCX pakcage.

   Parameters:
-  - & properties: option, value, ...
-
-  Examples:
-  - (doc-props-app-xml :application \"Microsoft Office Word\" :app-version \"12.0000\")"
-  [& {:as options
-      :keys [application app-version]}]
+  - options: option, value, ...
+
+  Examples:
+  - (doc-props-app-xml {:application \"Microsoft Office Word\" :app-version \"12.0000\")}"
+  [{:as options
+    :keys [application app-version]}]
   (node :properties:Properties doc-props-app-xml-xmlns
         (map when-v-node
              [application app-version]
@@ -260,12 +260,12 @@
   "Creates XML data for docProps/core.xml file in DOCX pakcage.

   Parameters:
-  - & properties: option, value, ...
-
-  Examples:
-  - (doc-props-core-xml :creator \"Bak Yeon O\" :last-modified-by \"Bak Yeon O\")"
-  [& {:as properties
-      :keys [title subject creator keywords description last-modified-by]}]
+  - properties: option, value, ...
+
+  Examples:
+  - (doc-props-core-xml {:creator \"Bak Yeon O\" :last-modified-by \"Bak Yeon O\"})"
+  [{:as properties
+    :keys [title subject creator keywords description last-modified-by]}]
   (node :cp:coreProperties doc-props-core-xml-xmlns
         (map when-v-node
              [title subject creator keywords description last-modified-by]
@@ -273,12 +273,18 @@
               :dc:description :cp:lastModifiedBy])))

 (defn word-document-xml
-  "Creates XML data for word/document.xml file in DOCX pakcage."
-  [& {:as params
-      :keys [page-width page-height page-orientation
-             page-margin-top page-margin-bottom page-margin-left page-margin-right
-             page-margin-header page-margin-footer
-             body]}]
+  "Creates XML data for word/document.xml file in DOCX pakcage.
+
+  Parameters:
+  - TODO
+
+  Examples:
+  - TODO"
+  [{:as params
+    :keys [page-width page-height page-orientation
+           page-margin-top page-margin-bottom page-margin-left page-margin-right
+           page-margin-header page-margin-footer
+           body]}]
   ;; Document
   (node :w:document word-xmlns
         ;; w:body
@@ -295,7 +301,7 @@
                                    :w:code 9}) ; Printer Paper Code
                     ;; Page Margins
                     (node :w:pgMar {:w:top page-margin-top ; (default: 720)
-                                    :w:bottom page-margin-bottm ; (default: 720)
+                                    :w:bottom page-margin-bottom ; (default: 720)
                                     :w:left page-margin-left ; (default: 720)
                                     :w:right page-margin-right ; (default: 720)
                                     :w:header page-margin-header ; (default: 0)


Write all game functions

Write all game functions


Added curried func.

Added curried func.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -138,17 +138,16 @@
     (when-let [e @error]
       (throw e))))

-(defn sync-updated!
-  [global-config local-config rw-lock]
-  (let [{remote-path-map :domains} global-config
-        {:keys [hdfs-conf local-dir]} local-config
+;; TODO: Integrate curry-func
+(defn sync-updated! [global-config local-config curry-func]
+  (let [{:keys [hdfs-conf local-dir]} local-config
         domains-info (-> (filesystem hdfs-conf)
                          (init-domain-info-map global-config))
         domains (keys domains-info)]
     (log-message "Domains info: " domains-info)
     (future
       (try (purge-unused-domains! domains local-dir)
-           (load-and-sync-status! remote-path-map local-config rw-lock domains-info)
+           (curry-func domains-info)
            (cleanup-domains! domains local-dir)
            (log-message "Finished loading all updated domains from remote")
            (catch Throwable t
@@ -184,8 +183,9 @@
        (and @download-supervisor
             (not (.isDone @download-supervisor))))))

+;; TODO: integrate curry-func, remove extra args
 (defn- update-domains
-  [download-supervisor domains-info global-config local-config rw-lock]
+  [download-supervisor domains-info local-config curry-func]
   (let [{max-kbs :max-online-download-rate-kb-s
          local-dir :local-dir} local-config
          ^DownloadState state (-> domains-info
@@ -195,12 +195,9 @@
     (log-message "UPDATER - Updating domains: " (s/join ", " (keys domains-info)))
     (reset! download-supervisor (start-download-supervisor shard-amount max-kbs state))
     (future
-      (try (load-and-sync-status! (:domains global-config)
-                                  local-config
-                                  rw-lock
-                                  domains-info
-                                  :update? true
-                                  :state state)
+      (try (curry-func domains-info
+                       :update? true
+                       :state state)
            (log-message "Finished updating all domains from remote.")
            (log-message "Removing all old versions of updated domains!")
            (try (cleanup-domains! (keys domains-info) local-dir)
@@ -210,11 +207,11 @@
              (log-error t "Error when syncing data"))))))

 (defn- trigger-update
-  [service-handler download-supervisor domains-info global-config local-config rw-lock]
+  [service-handler download-supervisor domains-info local-config curry-func]
   (with-ret true
     (if (service-updating? service-handler download-supervisor)
       (log-message "UPDATER - Not updating as update process still in progress.")
-      (update-domains download-supervisor domains-info global-config local-config rw-lock))))
+      (update-domains download-supervisor domains-info local-config curry-func))))

 ;; 5. TODO: (What does this mean?) Create Hadoop FS on demand... need
 ;; retry logic if loaders fail?
@@ -229,7 +226,7 @@
                         local-config
                         rw-lock)
         ;; TODO: Pass curry into here, and down below on updater.
-        domains-info (sync-updated! global-config local-config rw-lock)
+        domains-info (sync-updated! global-config local-config curry!)
         download-supervisor (atom nil)]
     (proxy [ElephantDB$Iface Shutdownable] []
       (shutdown []
@@ -300,17 +297,15 @@
         (trigger-update this
                         download-supervisor
                         domains-info
-                        global-config
                         local-config
-                        rw-lock))
+                        curry!))

       (update [^String domain]
         (trigger-update this
                         download-supervisor
                         (select-keys domains-info [domain])
-                        global-config
                         local-config
-                        rw-lock)))))
+                        curry!)))))

 (defn service-handler
   "Entry point to edb. `service-handler` returns a proxied


code-style: remove redundant anonymous function

--- src/clj/lambdacd/steps/git.clj
+++ src/clj/lambdacd/steps/git.clj
@@ -82,7 +82,7 @@
     (assoc sh-result :cwd checkout-folder-name)))

 (defn- last-step-id-of [step-ids]
-  (last (sort-by #(first %) step-ids)))
+  (last (sort-by first step-ids)))

 (defn checkout-and-execute [repo-uri revision args ctx steps]
   (let [checkout-result (checkout ctx repo-uri revision)


fix assertion mismatch, fix evidence parsing

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -10,6 +10,7 @@
             [net.cgrand.enlive-html :as html]
             [salava.core.util :as u]
             [salava.core.http :as http]
+            [salava.core.helper :refer [dump]]
             [schema.core :as s])
   (:import (ar.com.hjg.pngj PngReader)
            (java.io StringReader)))
@@ -351,16 +352,17 @@
                                                   :ctime now
                                                   :mtime now}]
                    ;; list of evidences
-                   (coll? (:evidence assertion)) (mapv #({:id nil
-                                                            :user_badge_id nil
-                                                            :url (:id %)
-                                                            :narrative (:narrative %)
-                                                            :name (:name %)
-                                                            :description (:description %)
-                                                            :genre (:genre %)
-                                                            :audience (:audience %)
-                                                            :ctime now
-                                                            :mtime now}) (:evidence assertion))
+                   (coll? (:evidence assertion)) (mapv (fn [e]
+                                                         {:id nil
+                                                          :user_badge_id nil
+                                                          :url (:id e)
+                                                          :narrative (:narrative e)
+                                                          :name (:name e)
+                                                          :description (:description e)
+                                                          :genre (:genre e)
+                                                          :audience (:audience e)
+                                                          :ctime now
+                                                          :mtime now}) (:evidence assertion))
                    :else [])

         badge  (if (map? (:badge assertion)) (:badge assertion) (http/json-get (:badge assertion)))
@@ -512,7 +514,7 @@
 (defmethod verify-assertion :v2.0 [url asr]
   (let [kind (get-in asr [:verify :type] (get-in asr [:verification :type]))]
     (when (and (not (nil? url)) (or (= kind "hosted") (= kind "HostedBadge")))
-      (if (not= (:id asr) url)
+      (if (and (not= (:id asr) url) (not (string/includes? url (:id asr))))
         (throw (IllegalArgumentException. "invalid assertion, verify url mismatch")))
       (if (map? (:badge asr))
         (if (not= (domain (get-in asr [:badge :id])) (domain (:id asr)))


Fix email bug

Fix email bug

--- src/clj/salava/social/mail.clj
+++ src/clj/salava/social/mail.clj
@@ -107,9 +107,7 @@
                    (-> current
                        (assoc-in [key :first_name] (:first_name item))
                        (assoc-in [key :last_name] (:last_name item))
-                       (assoc-in  [key typecount]  (inc (get-in current [key typecount] 0)))
-                       )
-                   ))
+                       (assoc-in  [key typecount]  (inc (get-in current [key typecount] 0))))))

         reduced-events (vals (reduce helper {} (reverse message-events)))]
     (map (fn [item] (follow-message item lng)) reduced-events)))
@@ -125,7 +123,6 @@
                           (if (and (not (nil? (first follow-events))) (not (empty? follow-events)))
                             follow-events)
                           ])))
-(events ctx {:id 1} "en")


add url references

add url references

--- src/cljs/lesezeichen/core.cljs
+++ src/cljs/lesezeichen/core.cljs
@@ -107,7 +107,9 @@

 (defsnippet url "templates/bookmarks.html" [:.list-group-item]
   [bookmark]
-  {[:.url-text] (content (:url bookmark))
+  {[:.url-text] (do->
+                 (set-attr :href (:url bookmark))
+                 (content (:url bookmark)))
    [:.url-ts] (content (:ts bookmark))})

@@ -115,17 +117,18 @@
   [app owner state]
   {[:#bm-header] (content "Recent bookmarks")
    [:#url-input] (do-> (set-attr :value (:url-input-text state))
-                       (listen :on-change #(do
-                                             (println (:url-input-text state))
-                                             (handle-text-change % owner :url-input-text))))
+                       (listen :on-change #(do (println (:url-input-text state))
+                                               (handle-text-change % owner :url-input-text))))
    [:#url-list] (content (map #(url %) (sort-by :ts > (get-bookmarks app))))
-   [:#bookmark-btn] (listen :on-click (fn [e]
-                                        (do
-                                          (if (clojure.string/blank? (:url-input-text state))
-                                            (println "no input")
-                                            (do
-                                              (add-bookmark owner)
-                                              (om/set-state! owner :url-input-text ""))))))})
+   [:#bookmark-btn] (listen
+                     :on-click
+                     (fn [e]
+                       (do
+                         (if (clojure.string/blank? (:url-input-text state))
+                           (println "no input")
+                           (do
+                             (add-bookmark owner)
+                             (om/set-state! owner :url-input-text ""))))))})

 ;; --- INIT ---


Add item removal button, time is set to now if empty

--- src/cljs/modern_cljs/core.cljs
+++ src/cljs/modern_cljs/core.cljs
@@ -104,7 +104,10 @@
   (updatedb [:editing] (merge {:pos pos} item)))

 (defn save []
-  (let [doc (:editing db)
+  (let [d (:editing db)
+        doc (if (nil? (get d "time"))
+              (assoc d "time" (str (new js/Date)))
+              d)
         data (:data db)
         pos (:pos doc)]
     (if (not (empty? doc))
@@ -117,6 +120,10 @@
         (clear)
         (println "Saved!" (str doc))))))

+(defn delete [pos]
+  (let [data (:data db)]
+    (updatedb [:data]
+              (vec (concat (subvec data 0 pos) (subvec data (inc pos)))))))
 ;
 ; View
 ;
@@ -174,7 +181,8 @@
                            (m "td" nil (format_time (new js/Date time)))
                            (m "td" nil comment)
                            (m "td" nil
-                              [(m "button.pure-button" {:onclick #(edit item pos)} "Edit")])])))
+                              [(m "button.pure-button" {:onclick #(edit item pos)} "Edit")
+                               (m "button.pure-button" {:onclick #(delete pos)} "Remove")])])))
         (if (< PAGESIZE (count data))
           (subvec data start (+ start PAGESIZE))
           data))]))
@@ -240,11 +248,11 @@
                   "url" (route_param "url")
                   "referer" (route_param "referer")
                   "time" (str (new js/Date))}]
-      (if (not(nil? (get "url" params)))
+      (if (not(nil? (get params "url")))
         (do (println "initial param was:" params)
             (.route js/m "/")
             (updatedb [:editing] params))
-        (println "No params!"))))
+        (println "No params!" params))))
   (println "No auth!"))

 ;; (require '[modern-cljs.core :as c] :reload)


Revert "Go back to using KeyListener"

Revert "Go back to using KeyListener"

This reverts commit 08b9a35039289de9b9da9c06930687f9cba68030.

--- src/clojure/nightmod/input.clj
+++ src/clojure/nightmod/input.clj
@@ -1,7 +1,11 @@
 (ns nightmod.input
-  (:require [play-clj.core :as play-clj])
-  (:import [com.badlogic.gdx.backends.lwjgl LwjglInput]
-           [java.awt.event KeyListener]
+  (:require [nightcode.shortcuts :as shortcuts]
+            [nightcode.ui :as ui]
+            [nightmod.utils :as u]
+            [play-clj.core :as play-clj])
+  (:import [java.awt KeyboardFocusManager KeyEventDispatcher]
+           [java.awt.event ComponentAdapter KeyEvent]
+           [com.badlogic.gdx.backends.lwjgl LwjglInput]
            [nightmod KeyCodeConverter]
            [org.lwjgl.input Keyboard]
            [org.lwjgl.opengl InputImplementation]))
@@ -27,28 +31,51 @@
         impl (proxy [InputImplementation] []
                (pollKeyboard [bb])
                (readKeyboard [bb]))]
-    (.addKeyListener
-      window
-      (reify KeyListener
-        (keyReleased [this e]
-          (.set impl-field nil impl)
-          (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 0))
-          (-> game
-              .getInput
-              .getInputProcessor
-              (.keyUp (awt->libgdx (.getKeyCode e)))
-              play-clj/on-gl))
-        (keyTyped [this e]
-          (-> game
-              .getInput
-              .getInputProcessor
-              (.keyTyped (.getKeyChar e))
-              play-clj/on-gl))
-        (keyPressed [this e]
-          (.set impl-field nil impl)
-          (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 1))
-          (-> game
-              .getInput
-              .getInputProcessor
-              (.keyDown (awt->libgdx (.getKeyCode e)))
-              play-clj/on-gl))))))
+    (.addKeyEventDispatcher
+      (KeyboardFocusManager/getCurrentKeyboardFocusManager)
+      (proxy [KeyEventDispatcher] []
+        (dispatchKeyEvent [^KeyEvent e]
+          (cond
+            ; a key was released in a game
+            (and @ui/tree-selection
+                 (shortcuts/focused-window? window)
+                 (not (.isVisible @u/editor))
+                 (= (.getID e) KeyEvent/KEY_RELEASED))
+            (do
+              (.set impl-field nil impl)
+              (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 0))
+              (-> game
+                  .getInput
+                  .getInputProcessor
+                  (.keyUp (awt->libgdx (.getKeyCode e)))
+                  play-clj/on-gl)
+              true)
+            ; a key was typed in a game
+            (and @ui/tree-selection
+                 (shortcuts/focused-window? window)
+                 (not (.isVisible @u/editor))
+                 (= (.getID e) KeyEvent/KEY_TYPED))
+            (do
+              (-> game
+                  .getInput
+                  .getInputProcessor
+                  (.keyTyped (.getKeyChar e))
+                  play-clj/on-gl)
+              true)
+            ; a key was pressed in a game
+            (and @ui/tree-selection
+                 (shortcuts/focused-window? window)
+                 (not (.isVisible @u/editor))
+                 (= (.getID e) KeyEvent/KEY_PRESSED))
+            (do
+              (.set impl-field nil impl)
+              (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 8))
+              (-> game
+                  .getInput
+                  .getInputProcessor
+                  (.keyDown (awt->libgdx (.getKeyCode e)))
+                  play-clj/on-gl)
+              true)
+            ; don't handle
+            :else
+            false))))))


re-enabled redirect-handler (accidentally commented out)

--- src/vix/routes.clj
+++ src/vix/routes.clj
@@ -547,6 +547,6 @@

 (def app
   (-> (handler/site main-routes)
-      ;(redirection-handler)
+      (redirection-handler)
       (wrap-caching-headers)
       (handle-authentication-errors)))


Simple Layered Layout does not scale anymore

since this is done by the drawer.

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

--- src/conexp/layouts/layered.clj
+++ src/conexp/layouts/layered.clj
@@ -13,7 +13,7 @@
 	[conexp.fca.lattices :only (base-set order)])
   (:use [clojure.contrib.graph :only (directed-graph, dependency-list, remove-loops)]))

-(ns-doc "Basic namespace for lattice layouts.")
+(ns-doc "Layered lattice layouts.")

 ;;; Simple Layered Layout
@@ -45,6 +45,8 @@
 		(map #(vector % number)
 		     (iterate inc start)))))

+;;;
+
 (defn simple-layered-layout
   "Simple layered layout for lattice visualization."
   [lattice]
@@ -53,10 +55,9 @@
 				(map layer-coordinates
 				     (iterate inc 0)
 				     (layers lattice))))]
-    (scale-layout [0.0 0.0] [200.0 200.0]
-		  (make-layout positions (edges lattice)))))
-
+    (make-layout positions (edges lattice))))

 ;;;

+
 nil


Bind the IO Streams to the Nailgun IO streams provided with the context

I'm actually not sure that this is needed. It seems to work also without
binding. But you never know...

--- src/de/kotka/gorilla/nails.clj
+++ src/de/kotka/gorilla/nails.clj
@@ -25,7 +25,9 @@
      (de.kotka.gorilla [util :only (with-command-line clj->vim)]
                        backend))
   (:import
-     com.martiansoftware.nailgun.NGContext))
+     com.martiansoftware.nailgun.NGContext
+     clojure.lang.LineNumberingPushbackReader
+     (java.io InputStreamReader OutputStreamWriter PrintWriter)))

 (defmacro defnail
   "Define a new Nail of the given name. A suitable class with the
@@ -46,10 +48,16 @@
      (defn ~(symbol (str (name nail) "-nailMain"))
        ~usage
        [~(with-meta 'nailContext {:tag 'NGContext})]
-       (with-command-line (.getArgs ~'nailContext)
-         ~usage
-         ~arguments
-         ~@body))))
+       (binding [~'*in*  (-> ~'nailContext
+                           .in
+                           InputStreamReader.
+                           LineNumberingPushbackReader.)
+                 ~'*out* (-> ~'nailContext .out OutputStreamWriter.)
+                 ~'*err* (-> ~'nailContext .err PrintWriter.)]
+         (with-command-line (.getArgs ~'nailContext)
+           ~usage
+           ~arguments
+           ~@body)))))

 (defnail DocLookup
   "Usage: ng de.kotka.gorilla.nails.DocString [options] [--] symbol ..."


Added empty? check to models/add-votes

Added empty? check to models/add-votes

Calling it should no longer cause exception if there are no actual votes
to be added

--- src/mafia_votecount/models.clj
+++ src/mafia_votecount/models.clj
@@ -87,8 +87,9 @@
                      (where {:game game-id})))))

 (defn add-votes [votes]
-  (insert vote
-          (values votes)))
+  (if-not (empty? votes)
+    (insert vote
+            (values votes))))

 (defn get-votes [id]
   (select vote


do not use help cursor

do not use help cursor

--- src-cljs/acha.cljs
+++ src-cljs/acha.cljs
@@ -149,8 +149,7 @@
       [:.up__hr]
       [:.up__achs
         (for [[achent _] aches]
-          [:img.up__ach {:src (achent-img achent)
-                         :style {:cursor "help"}
+          [:img.up__ach {:src   (achent-img achent)
                          :title (str (:achent/name achent) ":\n\n" (:achent/desc achent)) }])]]))

 (r/defc users-pane [db users]


removed unused dependency

removed unused dependency

--- src/makerbar/pov/ui/draw.clj
+++ src/makerbar/pov/ui/draw.clj
@@ -1,6 +1,5 @@
 (ns makerbar.pov.ui.draw
-  (:require [clojure.core.async :as async]
-            [hiphip.int :as int]
+  (:require [hiphip.int :as int]
             [makerbar.pov.rendersphere :as rendersphere]
             [makerbar.pov.state :as s]
             [makerbar.pov.ui.images :as img]


comments

comments

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/stats/timeseries.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/stats/timeseries.cljs
@@ -1,11 +1,10 @@
 (ns birdwatch.stats.timeseries
   (:require [birdwatch.util :as util]))

-(enable-console-print!)
-
 (defn date-round
-  "return function that rounds the provided seconds since epoch down to the nearest time interval s
-  e.g. (date-round 60) creates a function that takes seconds t and rounds them to the nearest minute"
+  "Returns function that rounds the provided seconds since epoch down to the
+   nearest time interval s e.g. (date-round 60) creates a function that takes
+   seconds t and rounds them to the nearest minute."
   [s]
   (fn [t] (* s (Math/floor (/ t s)))))

@@ -16,7 +15,8 @@
 (def day (* 24 hr))

 (defn grouping-interval
-  "determine duration of individual intervals (bars) depending on duration of timespan between newest and oldest"
+  "Determines duration of individual intervals (bars) depending on duration of
+   timespan between newest and oldest."
   [newest oldest]
   (cond
    (> (- newest oldest) (* 20 day)) day  ;round by nearest day
@@ -26,24 +26,25 @@
    :else                            m))  ;round by nearest minute

 (defn empty-ts-map
-  "generates map with all rounded intervals between oldest and newest, initialized to a count of 0"
+  "Generates map with all rounded intervals between oldest and newest,
+   initialized to a count of 0."
   [newest oldest interval]
   (let [rounder (date-round interval)
         values (range (rounder oldest) (rounder newest) interval)]
     (apply sorted-map-by < (flatten [(interpose 0 values) 0]))))

 (defn count-into-map
-  "increment count for time interval"
+  "Increments count for time interval."
   [ts-map k]
   (update-in ts-map [k] inc))

 (defn tweet-ts
-  "retrieve seconds since epoch from tweet using moment.js"
+  "Retrieves seconds since epoch from tweet using moment.js."
   [t]
   (.unix (js/moment. (:created_at t))))

 (defn ts-data
-  "Perform time series analysis by counting tweets in even intervals."
+  "Performs time series analysis by counting tweets in even intervals."
   [app]
   (let [tweets-by-id ((util/tweets-by-order :tweets-map :by-id) app 100000)]
     (let [oldest (tweet-ts (last tweets-by-id))
@@ -53,4 +54,3 @@
       (reduce count-into-map
               (empty-ts-map newest oldest interval)
               (map #(rounder (tweet-ts %)) tweets-by-id)))))
-


tweak drag-and-drop example: clicks remove boxes

--- examples/drag-and-drop/src/drag_and_drop/core.cljs
+++ examples/drag-and-drop/src/drag_and_drop/core.cljs
@@ -29,28 +29,33 @@
      :height (- bottom top)
      :hue (pos->hue centre)}))

-(defn centred-box
-  [centre-pos]
-  (let [scale [20 20]]
-    (build-box (map - centre-pos scale)
-               (map + centre-pos scale))))
-
 (defn in-box?
   [[x y]
    {:keys [top left width height]}]
   (and (< left x (+ left width))
        (< top y (+ top height))))

-(defn add-box
+(defn all-boxes
+  [state]
+  (-> (:placed-boxes state)
+      (concat (-> state :drag :moving-boxes))
+      (conj (-> state :drag :resizing-box))))
+
+(defn clicked-boxes
   [pos state]
-  (update-in state
-             [:placed-boxes]
-             (fn [boxes]
-               (if (some (partial in-box? pos)
-                         (concat boxes (-> state :drag :moving-boxes)))
-                 boxes
-                 (conj boxes (centred-box pos))))))
+  (->> (all-boxes state)
+       (into #{} (filter (partial in-box? pos)))))

+(defn remove-boxes
+  [clicked-boxes state]
+  (-> state
+      (update-in [:placed-boxes] (partial remove clicked-boxes))
+      (update-in [:drag :moving-boxes] (partial remove clicked-boxes))
+      (update-in [:drag :resizing-box] (fn [box] (if (clicked-boxes box) nil box)))))
+
+(defn click
+  [pos state]
+  (remove-boxes (clicked-boxes pos state) state))

 (defn topleft-pos
   [{:keys [left top]}]
@@ -112,7 +117,7 @@
       (assoc :drag nil)))

 (defrecord NoOp [] IFn (-invoke [_ state] state))
-(defrecord Click [pos] IFn (-invoke [_ state] (add-box pos state)))
+(defrecord Click [pos] IFn (-invoke [_ state] (click pos state)))
 (defrecord StartDrag [pos] IFn (-invoke [_ state] (start-drag pos state)))
 (defrecord Drag [pos] IFn (-invoke [_ state] (drag pos state)))
 (defrecord StopDrag [] IFn (-invoke [_ state] (stop-drag state)))
@@ -176,7 +181,12 @@
         (map render-ghost-box moving-boxes))
       (render-ghost-box resizing-box)
       (dom/div #js {:style #js {:position "relative"}}
-        (dom/h1 nil "drag and drop")
+        (dom/h1 nil "Drag and drop")
+        (dom/p nil
+               "Drag to create boxes, drag to move them around, and click to remove them. "
+               (dom/a #js {:href "https://github.com/jamesmacaulay/zelkova/blob/gh-pages/examples/drag-and-drop/src/drag_and_drop/core.cljs"}
+                      "View source")
+               ".")
         (dom/pre nil (.stringify js/JSON (clj->js state) nil 2))))))

 (om/root


Remove title when video is removed

Remove title when video is removed


json date formatter with millis

json date formatter with millis

--- utils/src/samsara/utils.clj
+++ utils/src/samsara/utils.clj
@@ -20,7 +20,7 @@
   (if-not data
     ""
     (-> data
-        (json/generate-string {:pretty pretty})
+        (json/generate-string {:pretty pretty :date-format "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'"})
         ((fn [s] (if pretty (str s \newline) s))))))


Add PModule protocol

Add PModule protocol

--- src/cortex/protocols.clj
+++ src/cortex/protocols.clj
@@ -1,2 +1,10 @@
-(ns cortex.protocols)
+(ns cortex.protocols
+  "Protocols for cortex ML Module implementations")

+(defprotocol PModule
+  "Protocol for a generic module. All cortex modules must implement this."
+  (calc [m input]
+    "Performs module calculation, returning an updated module that includes the output and
+     any intermediate states computed")
+  (output [m]
+    "Returns the calculated output of a module"))


fix typo

fix typo

--- src/babel/pos.cljc
+++ src/babel/pos.cljc
@@ -78,7 +78,7 @@
 (def proper-noun
   {:synsem {:cat :noun
             :pronoun false
-            :propernoun false
+            :propernoun true
             :agr {:person :3rd}
             :subcat '()}})


Add function for calculating value of coalition

--- src/baustellen.clj
+++ src/baustellen.clj
@@ -15,3 +15,37 @@
   the number of skill-units transported."
   [dist skill cnt skill-costs]
   (* dist (Math/sqrt cnt) (get skill-costs skill)))
+
+(defn sum-allocations
+  [skill allocation]
+  (apply + (vals (get allocation skill))))
+
+(defn sufficient-allocation?
+  "True if the allocated skills meet the demand of the site."
+  [{:keys [site allocation]} sites]
+  (let [demand (:skills (get sites site))]
+    (every?
+      (fn [skill]
+        (>= (sum-allocations skill allocation) (get demand skill)))
+      (keys demand))))
+
+(defn cost-in-coal
+  [agent {:keys [site allocation]} sites agents skill-costs]
+  (let [skill (:skill (get agents agent))
+        cnt (get-in allocation [skill agent])]
+    (cost (distance (:location (get sites site))
+                    (:location (get agents agent)))
+          skill cnt skill-costs)))
+
+(defn total-cost
+  [{:keys [site allocation] :as coal} sites agents skill-costs]
+  (let [agents-in-coal (mapcat keys (vals allocation))]
+    (apply + (map (fn [a] (cost-in-coal a coal sites agents skill-costs))
+                  agents-in-coal))))
+
+(defn coalition-value
+  [coalition sites agents skill-costs]
+  (if (sufficient-allocation? coalition sites)
+    (- (:payoff (get sites (:site coalition)))
+       (total-cost coalition sites agents skill-costs))
+    0))


Fix an arity bug in share invocation.

Fix an arity bug in share invocation.

--- src/oc/storage/api/entries.clj
+++ src/oc/storage/api/entries.clj
@@ -142,7 +142,7 @@
     (do
       (timbre/info "Updated entry for:" entry-for)
       (when (= (:status updated-result) "published")
-        (share-on-publish conn updated-result)
+        (share-on-publish conn ctx updated-result)
         (change/send-trigger! (change/->trigger :update updated-result)))
       (notification/send-trigger! (notification/->trigger :update org board {:old entry :new updated-result} user))
       {:updated-entry updated-result})


dead code elimination of clojurescript code

--- src/ocr_visualizer/client.cljs
+++ src/ocr_visualizer/client.cljs
@@ -8,130 +8,6 @@
             [cljs.core.async :refer [put! chan <!]]
             [clojure.string :as string]
             [clojure.browser.repl :as repl]))
-;;************************************************
-;; Dev stuff
-;;************************************************
-
-(enable-console-print!)
-
-(+ 1 2 3)
-
-(def dev-mode true)
-
-(defn repl-connect []
- (when dev-mode
-   (repl/connect "http://localhost:9000/repl")))
-
-
-(defn get-errors []
-  (-> (d/by-id "errors") d/text reader/read-string))
-
-(defn get-left []
-  (-> (d/by-id "left") d/html))
-
-(defn get-right []
-  (-> (d/by-id "right") d/html))
-
-
-
-
-;;highlights are of the form start end color
-(def highlights-left (atom []))
-
-;;************************************************
-;; Dev stuff
-;;************************************************
-(def dev-mode true)
-
-(defn repl-connect []
- (when dev-mode
-   (repl/connect "http://localhost:9000/repl")))
-
-
-
-
-(defn get-errors []
-  (-> (d/by-id "errors") d/text reader/read-string))
-
-(defn get-left []
-  (-> (d/by-id "left") d/html))
-
-(defn get-right []
-  (-> (d/by-id "right") d/html))
-
-
-;;highlights are of the form start end color
-(def highlights-left (atom []))
-(def highlights-right(atom []))
-(def text-left (atom []))
-(def text-right (atom []))
-
-(defn highlight
-  ([text] (highlight text "blue"))
-  ([text color]
-     (str "" (if (= text "")
-                                                          "|" text) "")))
-
-
-
-(defn save-texts [r]
-  (reset! text-left (map #(d/html (d/by-id (str "left-" %))) r))
-  (reset! text-right (map #(d/html (d/by-id (str "right-" %))) r)))
-
-
-(def offset 43)
-
-(defn highlight-text [text positions]
-  (apply str
-         (-> (reduce (fn [[pos substrings] [nstart nend color]]
-                       [nend (conj substrings (.substring text pos nstart)
-                                   (highlight (.substring text nstart nend)
-                                              color))])
-                     [0 []] positions)
-             second
-             (conj (.substring text (second (last positions)) (count text))))))
-
-
-(defn build-insertion-highlight [[_ [l r] :as error]]
-  [{:type :insertion
-    :error error
-    :position [l l "green"]}
-   {:type :insertion
-    :error error
-    :position [r (inc r) "green"]}])
-
-(defn build-deletion-highlight [[_ [l r] :as error]]
-  [{:type :deletion
-    :error error
-    :position [l (inc l) "red"]}
-   {:type :deletion
-    :error error
-    :position [r r "red"]}])
-
-
-(defn build-one-to-many-highlight [[_ [ls rs] [le re] :as error]]
-  [{:type :one-to-many
-   :error error
-   :position [ls le "yellow"]}
-   {:type :one-to-many
-    :error error
-    :position [rs (inc re) "yellow"]}])
-
-(defn build-many-to-one-highlight [[_ [ls rs] [le re] :as error]]
-  [{:type :many-to-one
-   :error error
-   :position [ls (inc le) "orange"]}
-   {:type :many-to-one
-    :error error
-    :position [rs re "orange"]}])
-
-(defn build-substitution-highlight [[_ [l r] :as error]]
-  [{:type :substitution
-   :error error
-   :position [l (inc l) "#00FFFF"]}
-   {:type :substitution
-    :error error
-    :position [r (inc r) "#00FFFF"]}])

 (defmulti get-position (fn [a b] a))

@@ -154,8 +30,7 @@
 (def empty-sign "|")

 (defn get-text [[start end] text]
-  #_(prn "get-text " start end text)
-  (let [t (.substring text start end)]
+    (let [t (.substring text start end)]
     (if-not (= t "")
       t
       empty-sign)))
@@ -183,84 +58,20 @@
       (= a 7)  :many-to-one
       :else    :substitution)))

-(get-type [[1 1] [3 3]])
-
 (defn build-highlight [error texta textb page-index]
   (let [type (get-type error)]
     (make-highlight error type texta textb page-index)))

-(defn highlight-text [text positions]
-  (apply str
-         (-> (reduce (fn [[pos substrings] [nstart nend color]]
-                       [nend (conj substrings (.substring text pos nstart)
-                                   (highlight (.substring text nstart nend)
-                                              color))])
-                     [0 []] positions)
-             second
-             (conj (.substring text (second (last positions)) (count text))))))
-

 (defn build-highlights [errors a b page-index]
-  #_(prn "lights " errors a b)
   (as->
     (reduce (fn [[posl hls-left posr hls-right] error]
               (let [[{[ls le] :position :as hl-l} {[rs re] :position :as hl-r}]
-                     (build-highlight error a b page-index)
-                   #_#_ _ (prn "bhlths " ls le rs re error a b)]
+                     (build-highlight error a b page-index)]
                 [le (conj hls-left (.substring a posl ls) hl-l)
                  re (conj hls-right (.substring b posr rs) hl-r)])) [0 [] 0 []] errors) x
      (let [[le hls re hlr] x]
        [(conj hls (.substring a le (count a))) (conj hlr (.substring b re (count b)))])))
-
-
-
-(defn fill-highlights [r]
-  (let [errors (map #(reader/read-string (d/html (d/by-id (str "errors-" %)))) r)
-        hl (map (fn [errors]
-                  (for [e errors]
-                    (highlight e))) errors)]
-    (reset! highlights-left (map (fn [hl] (distinct (map first hl))) hl))
-    (reset! highlights-right (map (fn [hl] (distinct (map second hl))) hl))))
-
-(defn show-highlights [r]
-  (dotimes [i (count r)]
-    (d/set-html! (d/by-id (str "left-" i)) (highlight-text (nth @text-left i)
-                                                           (nth @highlights-left i)))
-    (d/set-html! (d/by-id (str "right-" i)) (highlight-text (nth @text-right i)
-                                                            (nth @highlights-right i)))))
-
-
-(defn fill-table [r]
-  (dotimes [i (count r)]
-    (let [errors (reader/read-string (d/html (d/by-id (str "errors-" i))))
-          kinds (group-by first errors)
-          rows (for [[code positions] (sort-by (comp #(reduce + %) first) kinds)]
-                 (str "
"
-                      "" code "	"
-                      "" (count positions) "	"
-                      "" positions "	"
-                      "" (-> [code (first positions)]
-                                 highlight
-                                 first
-                                 (nth 2))
-                      "
"))
-          table (d/html (d/by-id (str "table-" i)))]
-      (d/set-html! (d/by-id (str "table-" i))
-                   (str (.substring table 0 (- (count table) 8))
-                        (apply str rows))))))
-
-(defn visualize-errors []
-  (let [i (range (count (d/by-class "wrap")))]
-    (save-texts i)
-    (fill-highlights i)
-    (show-highlights i)
-    (fill-table i)))
-
-(defn compute-highlights [left right error-codes]
-  (let [highlights (map light error-codes)
-        left-hl (map first highlights)
-        right-hl (map second highlights)]))
-

 (def app-state (atom {:pages []
                       :available-pages []


Distortion drawing tweaks.

Distortion drawing tweaks.

--- src/bru_3/core.clj
+++ src/bru_3/core.clj
@@ -118,21 +118,21 @@
         xmax (inc (q/width))
         ymax (inc (q/height))]
     (q/push-style)
-    (q/fill 255)
-    (q/stroke 255)
+    (q/fill 242 53 53)
+    (q/stroke 242 53 53)
     (doseq [x (range 0 xmax step)
             y (range 0 ymax step)
             :let [[x1 y1] (g/+ (g/* (distortion/vec-at df x y xmax ymax)
                                     intensity)
                                (v/vec2 x y))]]
       (draw-vector x y x1 y1))
-    (q/fill 255 32 32)
-    (q/stroke 255 32 32)
-    (doseq [i (range (count df))
-            j (range (count (first df)))
-            :let [xstep (/ (q/width) (count df))
-                  ystep (/ (q/height) (count (first df)))]]
-      (q/ellipse (* i xstep) (* j ystep) 10 10))
+;;     (q/fill 255 32 32)
+;;     (q/stroke 255 32 32)
+;;     (doseq [i (range (count df))
+;;             j (range (count (first df)))
+;;             :let [xstep (/ (q/width) (count df))
+;;                   ystep (/ (q/height) (count (first df)))]]
+;;       (q/ellipse (* i xstep) (* j ystep) 8 8))
     (q/pop-style)))

 ;;


Unexpose last-id func.

Unexpose last-id func.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -293,8 +293,7 @@
                    :chs {}   ; {ch -> {:id (gen-id),
                              ;         :msgs {msg -> true}
                              ;         :first-taker-actx actx-or-nil}}.
-                   :gen-id gen-id
-                   :last-id (fn [] @last-id)})]
+                   :gen-id gen-id})]
     (go-loop [num-events 0
               vis-last nil
               vis-last-positions nil


Helper func vis-arrow.

Helper func vis-arrow.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -200,6 +200,10 @@

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

+(defn vis-arrow [class x1 y1 x2 y2 stroke]
+  ["<line class='" class "' x1='" x1 "' y1='" y1 "' x2='" x2 "' y2='" y2
+   "' stroke='" stroke "' stroke-width='1' marker-end='url(#triangle)'/>"])
+
 (defn vis-svg-actxs [vis positions deltas phase]
   (let [stroke-width 1
         line-height 21
@@ -237,22 +241,18 @@
                    [(case (:delta delta)
                       :put (when (get chs (:ch delta))
                              ["<g transform='translate(500," ay ")'>"
-                              "<line class='delta' x1='0' y1='0' x2='100' y2='"
-                              (- cy ay) "' stroke='green'"])
+                              (vis-arrow "delta" 0 0 100 (- cy ay) "green") "</g>"])
                       :take (when (get chs (:ch delta))
                               ["<g transform='translate(600," cy ")'>"
-                               "<line class='delta' x1='0' y1='0' x2='-100' y2='"
-                               (- ay cy) "' stroke='" (if (:msg delta) "green" "black") "'"])
+                               (vis-arrow "delta" 0 0 -100 (- ay cy)
+                                          (if (:msg delta) "green" "black")) "</g>"])
                       :actx-start (when (> childy line-height)
                                     ["<g transform='translate(30," ay ")'>"
-                                     "<line class='delta' x1='0' y1='0' x2='30' y2='"
-                                     (- childy ay) "' stroke='green'"])
+                                     (vis-arrow "delta" 0 0 30 (- childy ay) "green") "</g>"])
                       :actx-end (when (> childy line-height)
                                   ["<g transform='translate(60," childy ")'>"
-                                   "<line class='delta' x1='0' y1='0' x2='-30' y2='"
-                                   (- ay childy) "' stroke='black'"])
+                                   (vis-arrow "delta" 0 0 -40 0 "black") "</g>"])
                       nil)
-                    " stroke-width='1' marker-end='url(#triangle)'/></g>"
                     (when (:ch-name delta)
                       ["<text class='ch-name' x='540' y='" (* 0.5 (+ ay cy))
                        "'>" (:ch-name delta) "</text>"])]))))


Use timestamp instead of timestamp-str.

Use timestamp instead of timestamp-str.

--- src/dsbdp/experiment_helper.clj
+++ src/dsbdp/experiment_helper.clj
@@ -79,7 +79,7 @@
      n))

 (def sample-pcap-processing-definition-rules
-  [['timestamp '(timestamp-str-be 0) :qm]
+  [['timestamp '(timestamp-be 0) :qm]
    ['capture-length '(int32be 8)]
    ['eth-src '(eth-mac-addr-str 22) :qm]
    ['eth-dst '(eth-mac-addr-str 16) :qm]


(SERVER-1772) Use uberjar profile

(SERVER-1772) Use uberjar profile

Use the uberjar profile when building the additional uberjars

--- src/puppetlabs/ezbake/core.clj
+++ src/puppetlabs/ezbake/core.clj
@@ -618,7 +618,7 @@
         ; for all of its dependencies, but not its own code. By adding itself as a
         ; dependency, we ensure its own code will be in the final uberjar as well.
         project-map (-> project-file
-                        project/read
+                        (project/read [:uberjar])
                         (update :dependencies conj dependency-coordinates))]
     (lein-main/info "Building uberjar for " dependency-coordinates)
     ; When the project.clj file is read by project/read above, it includes the


Allow e.g dangerously-set-inner-HTML

Allow e.g dangerously-set-inner-HTML

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -14,6 +14,11 @@
                               (catch js/Object e nil)))))

 (def dont-camel-case #{"aria" "data"})
+
+(defn capitalize [s]
+  (if (< (count s) 2)
+    (string/upper-case s)
+    (str (string/upper-case (subs s 0 1)) (subs s 1))))

 (defn dash-to-camel [dashed]
   (if (string? dashed)
@@ -22,7 +27,7 @@
           [start & parts] (string/split name-str #"-")]
       (if (dont-camel-case start)
         name-str
-        (apply str start (map string/capitalize parts))))))
+        (apply str start (map capitalize parts))))))

 (def attr-aliases {:class "className"
                    :for "htmlFor"


Class up the joint with some destructuring

--- src/reply/JlineInputReader.clj
+++ src/reply/JlineInputReader.clj
@@ -11,11 +11,7 @@
                    :internal-queue (java.util.LinkedList.)))])

 (defn -read-single [this]
-  (let [state @(.state this)
-        internal-queue (:internal-queue state)
-        jline-reader (:jline-reader state)
-        set-empty-prompt (:set-empty-prompt state)]
-
+  (let [{:keys [internal-queue jline-reader set-empty-prompt]} @(.state this)]
     (if-let [c (.peekFirst internal-queue)]
       (.removeFirst internal-queue)
       (let [line (.readLine jline-reader)]
@@ -28,19 +24,17 @@
             (-read-single this))
           -1)))))

-(defn -read-char<>-int-int [this cbuf off len]
-  (let [state @(.state this)
-        internal-queue (:internal-queue state)
-        jline-reader (:jline-reader state)]
-    (loop [i   off
-           left len]
+(defn -read-char<>-int-int [this buffer offset length]
+  (let [{:keys [internal-queue jline-reader]} @(.state this)]
+    (loop [i    offset
+           left length]
       (if (> left 0)
         (let [c (-read-single this)]
           (if (= c -1)
-            (if (= i off)
+            (if (= i offset)
               -1
-              (- i off))
-            (do (aset-char cbuf i c)
+              (- i offset))
+            (do (aset-char buffer i c)
                 (recur (inc i) (dec left)))))
-        (- i off)))))
+        (- i offset)))))


Removed debug println.

Removed debug println.

--- src/fm/simrunner/gui/wiring.clj
+++ src/fm/simrunner/gui/wiring.clj
@@ -48,7 +48,6 @@
                               (on-event :input-changed input)))))))

 (defn- wire-button [button on-event]
-  (println button)
   (-> button
       :widget
       (.addActionListener (reify


Improve select function on dsl ns.

Improve select function on dsl ns.

--- src/cljooq/dsl.clj
+++ src/cljooq/dsl.clj
@@ -103,9 +103,15 @@
 (defn select
   "Start select statement."
   [& fields]
-  (->> (map field fields)
-       (into-array org.jooq.Field)
-       (DSL/select)))
+  (cond
+   (instance? org.jooq.WithStep (first fields))
+   (.select (first fields)
+            (->> (map field (rest fields))
+                 (into-array org.jooq.Field)))
+   :else
+   (->> (map field fields)
+        (into-array org.jooq.Field)
+        (DSL/select))))

 (defn select-distinct
   "Start select statement."


CMR-738: Added test of retrieving Atom spatial results with cartesian polygons.:

--- test/cmr/system_int_test/search/collection_search_format_test.clj
+++ test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -249,7 +249,11 @@
                                         :summary "Summary of coll2"
                                         :beginning-date-time "2010-01-01T12:00:00Z"
                                         :ending-date-time "2010-01-11T12:00:00Z"
-                                        :related-urls [ru3]}))]
+                                        :related-urls [ru3]
+                                        :spatial-coverage
+                                        (dc/spatial :cartesian
+                                                    :cartesian
+                                                    (poly/polygon [(umm-s/ords->ring -70 20, 70 20, 70 30, -70 30, -70 20)]))}))]

     (index/refresh-elastic-index)


Add docs

Add docs

--- src/micro_logic/core.clj
+++ src/micro_logic/core.clj
@@ -1,17 +1,53 @@
 (ns micro-logic.core
   (:require [micro-logic.protocols :refer :all]))

-;;; Variable defs
-;;; c: lvar id
-;;; s: substitution map
-;;; u, v: either literal values or logic variables.
-
+;; ## Common variables
+;; - *c* The id of an lvar
+;; - *s* A substitution map. Keys are lvars, values are either lvars or values.
+;; - *u, v* Either an lvar or a literal value. Unification terms, more precisely.
+;; - *g* A goal function. Given a substition map, produce a stream of substitution maps.
+;; - *gc* Goal constructor function.
+;; - *$* A stream: either a function, an lcons, or nil.
+
+
+;; ## Logic Variables
+;;
+;; Logic variables (lvars for short) are the unknown items that will
+;; be given a value by the unifier. Each of them has an id (*c*); this
+;; is a number which is assigned when a new variable is allocated by
+;; (fresh). The interpreter state stores the next id to use.
 (defrecord LVar [c])
 (defn lvar [c] (LVar. c))
-(defn lvar? [x] (= LVar (class x)))
-
+(defn lvar? [x] (instance? LVar x))
+
+
+;; ## Substitutions and Walking
+;;
+;; A substitution map (*s*) gives mappings from logic variables to
+;; their values.
+;;
+;; To see what value an lvar is bound to in a given substitution map,
+;; use `(walk u s)`. (*u* is an lvar or a value) Supposing *a* and *b*
+;; are lvars; in this simple case, `(walk a {a 1})` returns `1`.
+;;
+;; Minikanren derivatives (including this one) use *triangular*
+;; substitutions, which means that an lvar may map to another lvar.
+;; Walk will follow these variable references until a value is
+;; reached. For example, `(walk a {a b, b 2})` returns `2`.
+;;
+;; The observant reader may note that it is easy to construct a
+;; substitution map with a loop in it: `(walk a {a b, b a})` will not
+;; terminate. This case may be handled (but is not, in this
+;; implementation) with an *occurs-check* function call when adding
+;; new substitutions.
+;;
+;; We implement this in clojure with the IWalk protocol, since it is
+;; polymorphic on the type of *u*.
 (extend-protocol IWalk
   LVar
+  ;; When walking for a variable, it may not be present in the
+  ;; substitution map.  In this case, the variable itself is returned,
+  ;; indicating that the variable is currently unbound.
   (walk [u s] (if-let [val (get s u)]
                 (walk val s)
                 u))
@@ -21,7 +57,13 @@
   nil
   (walk [u s] nil))

-(defn unify [u v s]
+;; # Unification
+
+(defn unify
+  "Given two terms *u* and *v*, and an existing substitution map *s*,
+  unify produces a new substitution map with mappings that will make u
+  and v equal."
+  [u v s]
   (let [u (walk u s),  v (walk v s)
         ulv (lvar? u), vlv (lvar? v)]
     (cond
@@ -31,7 +73,14 @@
       (= u v) s
       :default (unify-terms u v s))))

-
+;; This unifier is extensible, in the spirit of core.logic. Only
+;; unification on basic types is directly implemented here. By
+;; extending the IUnifyTerms protocol, special unification logic may
+;; be supplied for any data type.
+;;
+;; A *term* is, somewhat circularly, something you can pass to the unifier.
+;; this includes lvars, regular values, and values of any type to which
+;; you have extended IUnifyTerms.
 (extend-protocol IUnifyTerms
   Object
   (unify-terms [u v s]


more cards implementations

more cards implementations

--- src/node/game/cards.cljs
+++ src/node/game/cards.cljs
@@ -798,6 +798,10 @@
    {:trace {:base 2 :msg (msg "reveal the Runner's Grip")
             :effect (req (doseq [c (:hand runner)] (move state side c :play-area false true)))
             :unsuccessful {:msg "take 1 bad publicity" :effect (effect (gain :corp :bad-publicity 1))}}}
+
+   "Isabel McGuire"
+   {:abilities [{:label "Add an installed card to HQ" :choices {:req #(= (first (:zone %)) :servers)}
+                 :msg (msg "move " (:title target) " to HQ") :effect (effect (move target :hand))}]}

    "IT Department"
    {:abilities [{:counter-cost 1 :label "Add strength to a rezzed ICE"
@@ -1236,6 +1240,15 @@
    "Professional Contacts"
    {:abilities [{:cost [:click 1] :effect (effect (gain :credit 1) (draw))
                  :msg "gain 1 [Credits] and draw 1 card"}]}
+
+   "Psychographics"
+   {:req (req (<= target (:tag runner))) :choices :credit :prompt "How many credits?"
+    :effect (req (let [c (min target (:tag runner))]
+                   (resolve-ability state side
+                                    {:msg (msg "place " c " advancement tokens on "
+                                               (if (:rezzed target) (:title target) "a card"))
+                                     :choices {:req #(or (= (:type %) "Agenda") (:advanceable %))}
+                                     :effect (effect (add-prop target :advance-counter c))} card nil)))}

    "Punitive Counterstrike"
    {:trace {:base 5 :msg (msg "do " (:stole-agenda runner-reg) " meat damage")
@@ -1714,6 +1727,10 @@
     :msg (msg "move " (:title target) " to his or her grip")
     :effect (effect (move target :hand))}

+   "Unorthodox Predictions"
+   {:prompt "Choose an ICE type for Unorthodox Prediction" :choices ["Sentry", "Code Gate", "Barrier"]
+    :msg (msg "prevent subroutines on " target " ICE from being broken until next turn.")}
+
    "Unregistered S&W 35"
    {:abilities
     [{:cost [:click 2] :req (req (some #{:hq} (:successful-run runner-reg)))
@@ -2560,9 +2577,6 @@
    "Power Shutdown"
    {:req (req (:made-run runner-reg))}

-   "Psychographics"
-   {:req (req tagged)}
-
    "Reina Roja: Freedom Fighter"
    {:effect (effect (gain :link 1))}


remove description from loaded attributes

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/summary/tab.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/summary/tab.cljs
@@ -227,7 +227,8 @@
                        (let [response (:server-response @state)
                              attributes (get-in response
                                           [:workspace "workspace" "attributes" ])
-                             attrs-list (mapv (fn [[k v]] [k v]) attributes)]
+                             attrs-list (mapv (fn [[k v]] [k v])
+                                          (dissoc attributes "description"))]
                          (swap! state assoc :attrs-list attrs-list))
                        (swap! state dissoc :attrs-list))
                      (swap! state update-in [:load-counter] dec))})


add cursor/selection playback

add cursor/selection playback

--- src/parinfer/editor.cljs
+++ src/parinfer/editor.cljs
@@ -131,13 +131,19 @@
      (clj->js to)
      origin))

+(defn parse-selection
+  [selection]
+  {:anchor (parse-pos (.-anchor selection))
+   :head (parse-pos (.-head selection))
+   })
+
 (defn parse-selections
   [selections]
-  selections)
+  (map parse-selection selections))

 (defn apply-selections
   [cm selections]
-  )
+  (.setSelections cm (clj->js selections)))

 (defn on-change
   "Called after any change is applied to the editor."


Minor nit.

Minor nit.

--- support/build-support/src/main/clojure/immutant/build/install_module.clj
+++ support/build-support/src/main/clojure/immutant/build/install_module.clj
@@ -22,6 +22,6 @@

 (defn -main [assembly-path module-path]
   (let [module-dir (.getCanonicalFile (io/file module-path))]
-    (println "Installing module from " module-dir)
+    (println "Installing module from" (.getAbsolutePath module-dir))
     (init (io/file assembly-path))
     (install-module module-dir)))


props attrs csss refactored a bit

props attrs csss refactored a bit

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -840,7 +840,7 @@
 ;; properties
 ;;

-(defn get-element-property-el
+(defn- get-element-property-el
   [driver el property]
   (with-resp driver :get
     [:session (:session @driver) :element el :property (name property)]
@@ -864,20 +864,14 @@
   [driver q name]
   (get-element-property-el driver (query driver q) name))

-(defn get-element-properties-el
-  [driver el & names]
-  (mapv
-   #(get-element-property-el driver el %)
-   names))
-
 (defn get-element-properties
   "Returns multiple properties in batch. The result is a vector of
   corresponding properties."
-  [driver q & names]
-  (apply get-element-properties-el
-         driver
-         (query driver q)
-         names))
+  [driver q & props]
+  (let [el (query driver q)]
+    (vec
+     (for [prop props]
+       (get-element-property-el driver el prop)))))

 ;;
 ;; attributes
@@ -917,26 +911,21 @@
   [driver q name]
   (get-element-attr-el driver (query driver q) name))

-(defn get-element-attrs-el
-  [driver el & names]
-  (mapv
-   #(get-element-attr-el driver el %)
-   names))
-
 (defn get-element-attrs
   "Returns multiple attributes in batch. The result is a vector of
   corresponding attributes."
-  [driver q & names]
-  (apply get-element-attrs-el
-         driver
-         (query driver q)
-         names))
+  [driver q & attrs]
+  (let [el (query driver q)]
+    (vec
+     (for [attr attrs]
+       (get-element-attr-el driver el attr)))))

 ;;
 ;; css
 ;;

-(defn get-element-css-el [driver el name*]
+(defn- get-element-css-el
+  [driver el name*]
   (with-resp driver :get
     [:session (:session @driver) :element el :css (name name*)]
     nil
@@ -966,20 +955,18 @@
   (get-element-css driver {:id :content} :background-color)
   >> \"rgb(204, 204, 204)\" ;; or \"rgba(204, 204, 204, 1)\"
 "
-  [driver q name]
-  (get-element-css-el driver (query driver q) name))
-
-(defn get-element-csss-el
-  [driver el & names]
-  (mapv
-   #(get-element-css-el driver el %)
-   names))
+  [driver q prop]
+  (get-element-css-el driver (query driver q) prop))
+

 (defn get-element-csss
   "Returns multiple CSS properties in batch. The result is a vector of
   corresponding properties."
-  [driver q & names]
-  (apply get-element-csss-el driver (query driver q) names))
+  [driver q & props]
+  (let [el (query driver q)]
+    (vec
+     (for [prop props]
+       (get-element-css-el driver el prop)))))

 ;;
 ;; element text, name and value


less chatty logging

less chatty logging

--- src/so/grep/cyanite/carbon.clj
+++ src/so/grep/cyanite/carbon.clj
@@ -8,7 +8,6 @@

 (defn formatter
   [rollups input]
-  (debug "got input: " input)
   (let [[path metric time] (s/split input #" ")]
     (when (not= metric "nan")
       (for [{:keys [rollup period rollup-to]} rollups]
@@ -28,7 +27,7 @@
 (defn start
   [{:keys [store carbon]}]
   (let [handler (handler (:rollups carbon) store)]
-    (info "starting carbon handler with config: " carbon)
+    (info "starting carbon handler")
     (tcp/start-tcp-server
      handler
      (merge carbon {:frame (string :utf-8 :delimiters ["\r\n"])}))))


Requirements

Requirements

Slamhound is a thing

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -3,7 +3,8 @@
   (:require [taoensso.nippy :as nippy]
             [icecap.handlers.http]
             [icecap.handlers.delay]
-            [clojure.core.async :refer [<!! <! go] :as async]
+            [icecap.schema :refer [validate-plan]]
+            [clojure.core.async :refer [<!! <! >!! go] :as async]
             [icecap.handlers.core :refer [execute]]
             [icecap.crypto :as crypto]
             [icecap.store.api :refer [create! retrieve delete!]]


fix broken regex for id/class containing the "s" character

--- src/hiccups/runtime.cljs
+++ src/hiccups/runtime.cljs
@@ -2,7 +2,7 @@
   (:require [clojure.string :as cstring]))

 (def ^{:doc "Regular expression that parses a CSS-style id and class from a tag name." :private true}
-  re-tag #"([^\s\.#]+)(?:#([^s\.#]+))?(?:\.([^\s#]+))?")
+  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

 (def ^{:doc "Characters to replace when escaping HTML" :private true}
   character-escapes {\& "&", \< "<", \> ">", \" """})
@@ -17,7 +17,7 @@
   (if (or (keyword? x) (symbol? x))
     (name x)
     (str x)))
-
+
 (def ^:dynamic *html-mode* :xml)

 (defn- xml-mode? []
@@ -56,7 +56,7 @@
   (apply str
     (sort (map render-attribute attrs))))

-(defn normalize-element
+(defn normalize-element
   "Ensure a tag vector is of the form [tag-name attrs content]."
   [[tag & content]]
   (when (not (or (keyword? tag) (symbol? tag) (string? tag)))


Allow the running of a story command with a console command.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -63,6 +63,12 @@

     (Story. player rooms)))

+(defn run-command [story command-str]
+  (let [command (first (str/split command-str #" "))
+        arguments-str (second (str/split command-str #" " 2))
+        arguments-vec (if (nil? arguments-str) [nil] [arguments-str])]
+    (clojure.lang.Reflector/invokeInstanceMethod story command (to-array arguments-vec))))
+
 (defn get-story-ctx []
   {"my" (interpreter/instantiate-type (get types "_player"))})