Prepare for next release cycle.

Prepare for next release cycle.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject onyx-app/lein-template "0.12.0.0-alpha1"
+(defproject onyx-app/lein-template "0.12.0.0-SNAPSHOT"
   :description "Onyx Leiningen application template"
   :url "https://github.com/onyx-platform/onyx-template"
   :license {:name "MIT License"


Upgrade schema to 1.1.6

Upgrade schema to 1.1.6

--- project.clj
+++ project.clj
@@ -4,7 +4,7 @@
   :license {:name "Apache License Version 2.0"
             :url "https://www.apache.org/licenses/LICENSE-2.0"}
   :dependencies [[org.clojure/clojure "1.7.0"]
-                 [prismatic/schema "1.0.1"]]
+                 [prismatic/schema "1.1.6"]]
   :profiles {:dev {:dependencies [[org.clojure/math.combinatorics "0.1.3"]
                                   [org.clojure/data.fressian "0.2.1"]]}
              :provided {:dependencies [[org.clojure/clojurescript "1.7.170"]]}}


Version 0.0.14-SNAPSHOT

Version 0.0.14-SNAPSHOT

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject pe-fp-rest "0.0.13"
+(defproject pe-fp-rest "0.0.14-SNAPSHOT"
   :description "A Clojure library providing a REST API interface on top of the fuel purchase abstractions."
   :url "https://github.com/evanspa/pe-fp-rest"
   :license {:name "MIT"


Version 5.3.14

Version 5.3.14

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(def ps-version "5.3.14-SNAPSHOT")
+(def ps-version "5.3.14")
 (def jruby-1_7-version "1.7.27-1")
 (def jruby-9k-version "9.1.16.0-1")


fix lack of kioo.core/value-component on server

--- src/kioo/server/core.clj
+++ src/kioo/server/core.clj
@@ -101,35 +101,35 @@

 (defmacro snippet
   ([path sel args]
-     (snippet* path sel {} args server-emit-opts true))
+     (snippet* path sel {} args server-emit-opts false))
   ([path sel args trans]
-     (snippet* path sel trans args server-emit-opts true))
+     (snippet* path sel trans args server-emit-opts false))
   ([path sel args trans opts]
-     (snippet* path sel trans args (merge server-emit-opts opts) true)))
+     (snippet* path sel trans args (merge server-emit-opts opts) false)))

 (defmacro template
   ([path args]
-     (snippet* path [:body :> any-node] {} args server-emit-opts true))
+     (snippet* path [:body :> any-node] {} args server-emit-opts false))
   ([path args trans]
-     (snippet* path [:body :> any-node] trans args server-emit-opts true))
+     (snippet* path [:body :> any-node] trans args server-emit-opts false))
   ([path args trans opts]
-     (snippet* path [:body :> any-node] trans args (merge server-emit-opts opts) true)))
+     (snippet* path [:body :> any-node] trans args (merge server-emit-opts opts) false)))

 (defmacro defsnippet
   ([sym path sel args]
-     `(def ~sym ~(snippet* path sel {} args server-emit-opts true)))
+     `(def ~sym ~(snippet* path sel {} args server-emit-opts false)))
   ([sym path sel args trans]
-     `(def ~sym ~(snippet* path sel trans args server-emit-opts true)))
+     `(def ~sym ~(snippet* path sel trans args server-emit-opts false)))
   ([sym path sel args trans opts]
-     `(def ~sym ~(snippet* path sel trans args (merge server-emit-opts opts) true))))
+     `(def ~sym ~(snippet* path sel trans args (merge server-emit-opts opts) false))))

 (defmacro deftemplate
   ([sym path args]
-     `(def ~sym ~(snippet* path [:body :> any-node] {} args server-emit-opts true)))
+     `(def ~sym ~(snippet* path [:body :> any-node] {} args server-emit-opts false)))
   ([sym path args trans]
-     `(def ~sym ~(snippet* path [:body :> any-node] trans args server-emit-opts true)))
+     `(def ~sym ~(snippet* path [:body :> any-node] trans args server-emit-opts false)))
   ([sym path args trans opts]
-     `(def ~sym ~(snippet* path [:body :> any-node] trans args (merge server-emit-opts opts) true))))
+     `(def ~sym ~(snippet* path [:body :> any-node] trans args (merge server-emit-opts opts) false))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; TRANSFORMS


Fix missing Histograms.json subscriber bug.

--- src/clj/medusa/alert.clj
+++ src/clj/medusa/alert.clj
@@ -15,7 +15,7 @@

 (defn notify-subscribers [{:keys [metric_id date emails]}]
   (let [{:keys [hostname]} @config/state
-        foreign_subscribers (when (seq? emails) (string/split emails #","))
+        foreign_subscribers (when emails (string/split emails #","))
         {metric_name :name,
          detector_id :detector_id
          metric_id :id} (db/get-metric metric_id)


improved the disconnect

improved the disconnect

--- src/clj_discord/core.clj
+++ src/clj_discord/core.clj
@@ -2,12 +2,14 @@
   (:require [clj-http.client :as client]
             [clojure.data.json :as json]
             [gniazdo.core :as ws]))
+

 (def the-token (atom nil))
 (def the-gateway (atom nil))
 (def the-socket (atom nil))
 (def the-ready (atom nil))
 (def the-keepalive (atom nil))
+

 (defn obtain-token [email password]
   (let [response (client/post "https://discordapp.com/api/auth/login"
@@ -19,6 +21,7 @@
       (get (json/read-str (:body response)) "token")
       (println "Token obtention failed with status code " status))))

+
 (defn obtain-gateway [token]
   (let [response (client/get "https://discordapp.com/api/gateway"
                              {:headers {:authorization token}})
@@ -27,11 +30,13 @@
       (get (json/read-str (:body response)) "url")
       (println "Gateway obtention failed with status code " status))))

+
 (defn connect [email password]
+  (disconnect)
   (reset! the-keepalive true)
   (reset! the-token (obtain-token email password))
   (reset! the-gateway (obtain-gateway @the-token))
-  (reset! the-socket
+  (reset! the-socket
           (ws/connect
             @the-gateway
             :on-receive #(do
@@ -39,14 +44,19 @@
                            (if (.equals "READY" (get (json/read-str %) "t"))
                              (reset! the-ready (json/read-str %))))))
   (ws/send-msg @the-socket (json/write-str {:op 2, :d {:token @the-token,:properties {:$browser "clj-discord"}}}))
-  (while (nil? @the-ready) (Thread/sleep 1000))
+  (while (and @the-keepalive (nil? @the-ready)) (Thread/sleep 1000))
   (.start (Thread. (fn [] (while @the-keepalive
                             (do
-                              (println (get (get @the-ready "d") "heartbeat_interval"))
                               (ws/send-msg @the-socket (json/write-str {:op 1, :d (System/currentTimeMillis)}))
-                              (Thread/sleep (get (get @the-ready "d") "heartbeat_interval"))))))))
+                              (Thread/sleep (get (get @the-ready "d") "heartbeat_interval")))))))
+  (println "Connected."))
+

 (defn disconnect []
   (reset! the-keepalive false)
-  (ws/close @the-socket))
+  (if (not (nil? @the-socket)) (ws/close @the-socket))
+  (reset! the-token nil)
+  (reset! the-gateway nil)
+  (reset! the-socket nil)
+  (reset! the-ready nil))


Add import

Add import

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -1,5 +1,6 @@
 (ns clj-gatling.core
-  (:import (io.gatling.charts.report ReportsGenerator)
+  (:import (scala.collection.mutable HashMap)
+           (io.gatling.charts.report ReportsGenerator)
            (io.gatling.charts.result.reader FileDataReader)
            (io.gatling.core.config GatlingConfiguration))
   (:require [clojure-csv.core :as csv]
@@ -9,7 +10,7 @@
   (:gen-class))

 (defn create-chart [dir]
-  (let [conf (scala.collection.mutable.HashMap.)]
+  (let [conf (HashMap.)]
     (.put conf "gatling.core.directory.results" dir)
     (GatlingConfiguration/setUp conf)
     (ReportsGenerator/generateFor "out" (FileDataReader. "23"))))


Adds docstring variable to macro definition

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -45,8 +45,9 @@

 ;TODO - deal with search for nice formatting. Do you want docstrings?
 (defmacro spotify-api-call
-  [f verb uri]
+  [f verb uri doc-string]
   `(defn ~f
+     ~doc-string
      ([args#] (~f args# nil))
      ([args# oauth-token#]
       (let [query-params# {:query-params (apply dissoc args# template-keys) :oauth-token oauth-token#}]
@@ -59,57 +60,57 @@
           )))))

 ;Albums
-(spotify-api-call get-album client/get (str spotify-api-url "albums/id"))
-(spotify-api-call get-several-albums client/get (str spotify-api-url "albums"))
-(spotify-api-call get-tracks-of-album client/get (str spotify-api-url "albums/id/tracks"))
+(spotify-api-call get-album client/get (str spotify-api-url "albums/id") "")
+(spotify-api-call get-several-albums client/get (str spotify-api-url "albums") "")
+(spotify-api-call get-tracks-of-album client/get (str spotify-api-url "albums/id/tracks") "")

 ;Artists
-(spotify-api-call get-artist client/get (str spotify-api-url "artists/id"))
-(spotify-api-call get-several-artists client/get (str spotify-api-url "artists"))
-(spotify-api-call get-artists-albums client/get (str spotify-api-url "artists/id/albums"))
-(spotify-api-call get-artists-top-tracks client/get (str spotify-api-url "artists/id/top-tracks"))
-(spotify-api-call get-artists-related-artists client/get (str spotify-api-url "artists/id/related-artists"))
+(spotify-api-call get-artist client/get (str spotify-api-url "artists/id") "")
+(spotify-api-call get-several-artists client/get (str spotify-api-url "artists") "")
+(spotify-api-call get-artists-albums client/get (str spotify-api-url "artists/id/albums") "")
+(spotify-api-call get-artists-top-tracks client/get (str spotify-api-url "artists/id/top-tracks") "")
+(spotify-api-call get-artists-related-artists client/get (str spotify-api-url "artists/id/related-artists") "")

 ;Browse
-(spotify-api-call get-a-list-of-featured-playlists client/get (str spotify-api-url "browse/featured-playlists"))
-(spotify-api-call get-a-list-of-new-releases client/get (str spotify-api-url "browse/new-releases"))
-(spotify-api-call get-a-list-of-categories client/get (str spotify-api-url "browse/categories"))
-(spotify-api-call get-a-category client/get (str spotify-api-url "browse/categories/category_id"))
-(spotify-api-call get-a-categorys-playlists client/get (str spotify-api-url "browse/categories/category_id/playlists"))
+(spotify-api-call get-a-list-of-featured-playlists client/get (str spotify-api-url "browse/featured-playlists") "")
+(spotify-api-call get-a-list-of-new-releases client/get (str spotify-api-url "browse/new-releases") "")
+(spotify-api-call get-a-list-of-categories client/get (str spotify-api-url "browse/categories") "")
+(spotify-api-call get-a-category client/get (str spotify-api-url "browse/categories/category_id") "")
+(spotify-api-call get-a-categorys-playlists client/get (str spotify-api-url "browse/categories/category_id/playlists") "")

 ;Follow
-(spotify-api-call get-users-followed-artists client/get (str spotify-api-url "me/following"))
-(spotify-api-call follow-artists-or-users client/put (str spotify-api-url "me/following"))
-(spotify-api-call unfollow-artists-or-users client/delete (str spotify-api-url "me/following"))
-(spotify-api-call user-following-artists-or-users? client/get (str spotify-api-url "me/following/contains"))
-(spotify-api-call follow-a-playlist client/put (str spotify-api-url "users/owner_id/playlists/playlist_id/followers"))
-(spotify-api-call unfollow-a-playlist client/delete (str spotify-api-url "users/owner_id/playlists/playlist_id/followers"))
-(spotify-api-call user-following-playlist? client/get (str spotify-api-url "users/owner_id/playlists/playlist_id/followers/contains"))
+(spotify-api-call get-users-followed-artists client/get (str spotify-api-url "me/following") "")
+(spotify-api-call follow-artists-or-users client/put (str spotify-api-url "me/following") "")
+(spotify-api-call unfollow-artists-or-users client/delete (str spotify-api-url "me/following") "")
+(spotify-api-call user-following-artists-or-users? client/get (str spotify-api-url "me/following/contains") "")
+(spotify-api-call follow-a-playlist client/put (str spotify-api-url "users/owner_id/playlists/playlist_id/followers") "")
+(spotify-api-call unfollow-a-playlist client/delete (str spotify-api-url "users/owner_id/playlists/playlist_id/followers") "")
+(spotify-api-call user-following-playlist? client/get (str spotify-api-url "users/owner_id/playlists/playlist_id/followers/contains") "")

 ;Library
-(spotify-api-call save-tracks-for-user client/put (str spotify-api-url "me/tracks"))
-(spotify-api-call get-users-saved-tracks client/get (str spotify-api-url "me/tracks"))
-(spotify-api-call remove-users-saved-tracks client/delete (str spotify-api-url "me/tracks"))
-(spotify-api-call check-users-saved-tracks client/get (str spotify-api-url "me/tracks/contains"))
+(spotify-api-call save-tracks-for-user client/put (str spotify-api-url "me/tracks") "")
+(spotify-api-call get-users-saved-tracks client/get (str spotify-api-url "me/tracks") "")
+(spotify-api-call remove-users-saved-tracks client/delete (str spotify-api-url "me/tracks") "")
+(spotify-api-call check-users-saved-tracks client/get (str spotify-api-url "me/tracks/contains") "")

 ;Playlists
-(spotify-api-call get-a-list-of-a-users-playlists client/get (str spotify-api-url "users/user_id/playlists"))
-(spotify-api-call get-a-playlist client/get (str spotify-api-url "users/user_id/playlists/playlist_id"))
-(spotify-api-call get-a-playlists-tracks client/get (str spotify-api-url "users/user_id/playlists/playlist_id/tracks"))
-(spotify-api-call create-a-playlist client/post (str spotify-api-url "users/user_id/playlists"))
-(spotify-api-call add-tracks-to-a-playlist client/post (str spotify-api-url "users/user_id/playlists/playlist_id/tracks"))
-(spotify-api-call remove-tracks-from-a-playlist client/delete (str spotify-api-url "users/user_id/playlists/playlist_id/tracks"))
-(spotify-api-call reorder-a-playlists-tracks client/put (str spotify-api-url "users/user_id/playlists/playlist_id/tracks"))
-(spotify-api-call replace-a-playlists-tracks client/put (str spotify-api-url "users/user_id/playlists/playlist_id/tracks"))
-(spotify-api-call change-a-playlists-details client/put (str spotify-api-url "users/user_id/playlists/playlist_id"))
+(spotify-api-call get-a-list-of-a-users-playlists client/get (str spotify-api-url "users/user_id/playlists") "")
+(spotify-api-call get-a-playlist client/get (str spotify-api-url "users/user_id/playlists/playlist_id") "")
+(spotify-api-call get-a-playlists-tracks client/get (str spotify-api-url "users/user_id/playlists/playlist_id/tracks") "")
+(spotify-api-call create-a-playlist client/post (str spotify-api-url "users/user_id/playlists") "")
+(spotify-api-call add-tracks-to-a-playlist client/post (str spotify-api-url "users/user_id/playlists/playlist_id/tracks") "")
+(spotify-api-call remove-tracks-from-a-playlist client/delete (str spotify-api-url "users/user_id/playlists/playlist_id/tracks") "")
+(spotify-api-call reorder-a-playlists-tracks client/put (str spotify-api-url "users/user_id/playlists/playlist_id/tracks") "")
+(spotify-api-call replace-a-playlists-tracks client/put (str spotify-api-url "users/user_id/playlists/playlist_id/tracks") "")
+(spotify-api-call change-a-playlists-details client/put (str spotify-api-url "users/user_id/playlists/playlist_id") "")

 ;Profiles
-(spotify-api-call get-a-users-profile client/get (str spotify-api-url "users/user_id"))
-(spotify-api-call get-current-users-profile client/get (str spotify-api-url "me"))
+(spotify-api-call get-a-users-profile client/get (str spotify-api-url "users/user_id") "")
+(spotify-api-call get-current-users-profile client/get (str spotify-api-url "me") "")

 ;Search
-(spotify-api-call search client/get (str spotify-api-url "search"))
+(spotify-api-call search client/get (str spotify-api-url "search") "")

 ;Tracks
-(spotify-api-call get-a-track client/get (str spotify-api-url "tracks/id"))
-(spotify-api-call get-several-tracks client/get (str spotify-api-url "tracks"))
+(spotify-api-call get-a-track client/get (str spotify-api-url "tracks/id") "")
+(spotify-api-call get-several-tracks client/get (str spotify-api-url "tracks") "")


finished map improvements (for now)

finished map improvements (for now)

--- src/prais2/map_data.cljs
+++ src/prais2/map_data.cljs
@@ -36,7 +36,13 @@

     (if (nil? (:map-h-code (rum/react core/app)))
       [:.col-sm-6.col-xs-7.col-md-7 (hospital-list)]
-      [:.col-sm-6.col-xs-7.col-md-7 (data/hospital-detail (:map-h-code (rum/react core/app)))])]])
+      [:.col-sm-6.col-xs-7.col-md-7
+       [:div.clearfix
+        [:button.btn.btn-primary.pull-left {:type      "button"
+                                            :on-click  #(core/click->event-bus % :reset-map-to-home nil)
+                                            :tab-index 0}
+         [:i.fa.fa-chevron-left] " Back"]]
+       (data/hospital-detail (:map-h-code (rum/react core/app)))])]])

        #_[:col-sm-6.col-xs-6 {:style {:margin "40px 0px"}}


assuring ip release

assuring ip release

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -99,21 +99,23 @@
   Vm
   (create [this]
           (debug "creating" (:vmid ct))
-          (try+
-            (let [ct* (gen-ip ct) {:keys [hostname vmid ip_address]} ct*]
+          (let [ct* (gen-ip ct) {:keys [hostname vmid ip_address]} ct*]
+            (try+
               (check-task node (prox-post (str "/nodes/" node "/openvz") ct*))
               (enable-features this)
               (when (p/host-exists? hostname)
-                (p/update-host hostname {:proxmox (select-keys ct* [:vmid :ip_address] )})))
-            (catch [:status 500] e
-              (warn "Container already exists" e))))
+                (p/update-host hostname {:proxmox (select-keys ct* [:vmid :ip_address])}))
+              (catch [:status 500] e
+                (release-ip (ct* :ip_address))
+                (warn "Container already exists" e)))))

   (delete [this]
-          (debug "deleting" (:vmid ct))
-          (unmount this)
-          (safe
-            (prox-delete (str "/nodes/" node "/openvz/" (:vmid ct))))
-          (release-ip (:ip_address ct)))
+          (try
+            (debug "deleting" (:vmid ct))
+            (unmount this)
+            (safe
+              (prox-delete (str "/nodes/" node "/openvz/" (:vmid ct))))
+            (finally (release-ip (:ip_address ct)))))

   (start [this]
          (debug "starting" (:vmid ct))
@@ -164,7 +166,7 @@
       (apply get* ks)
       (catch [:type :celestial.common/missing-conf] e
         (throw+ {:type :missing-template :message
-         (<< "no matching proxmox template found for ~{os} add one to configuration under ~{ks}")})))))
+                 (<< "no matching proxmox template found for ~{os} add one to configuration under ~{ks}")})))))

 (defn generate
   "apply generated values (if not present)."


progress?

progress?

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -63,7 +63,7 @@
              (comp-paths-to-complements bolt model depth max-depth)
              [] [bolt])))

-     (filter #(not (some empty? (vals %))))
+;     (filter #(not (some empty? (vals %))))

      (map (fn [each-bolt-and-comps] ;; for each such map in each bolt, find all possible combinations of complements, taking one complement per path.
             ;; the result is a trellis for each bolt, and a path through this trellis is one complement for each complement position.
@@ -72,7 +72,7 @@
                            each-path-through-trellis))
                  (apply combo/cartesian-product (vals each-bolt-and-comps)))))

-     (filter #(not (empty? %)))
+ ;    (filter #(not (empty? %)))

      (mapcat (fn [bolt-group]
                (->> bolt-group
@@ -186,8 +186,7 @@
                                  (+ 1 depth) max-depth))
         lexemes-before-phrases
         (lexemes-before-phrases depth max-depth)]
-    (log/info (str "type of bolts-at:" (type bolts-at)))
-    (log/info (str "nil? of bolts-at:" (nil? bolts-at)))
+    (if (not (nil? bolts-at)) (log/info (str "realized? of bolts-at:" (realized? bolts-at))))
     (cond (nil? bolts-at)
           (lazy-seq lexemes)
           lexemes-before-phrases


max-total-depth: 20->5 to avoid high bias to phrasal verbs

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -9,7 +9,7 @@

 ;; during generation, will not decend deeper than this when creating a tree:
 ;; TODO: should also be possible to override per-language.
-(def ^:const max-total-depth 20)
+(def ^:const max-total-depth 5)
 (def ^:const max-generated-complements 200)

 ;; use map or pmap.


working on clarifying (generate-all)

working on clarifying (generate-all)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -71,25 +71,27 @@
                (map (fn [each-path-through-trellis]
                       (zipmap (keys each-bolt-and-comps) each-path-through-trellis))
                     (apply combo/cartesian-product (vals each-bolt-and-comps)))))
+
+     (map (fn [bolt-and-comps]
+            {:bolt (get bolt-and-comps [])
+             :comps (dissoc bolt-and-comps [])}))

      ;; for each such path through a trellis, unify the bolt with all of its complements to create a final expression tree.
-     (map (fn [bolt-and-comps]
-            (let [bolt (get bolt-and-comps [])
-                  paths-and-comps (dissoc bolt-and-comps [])]
-              ;; TODO: further flatten this into the overall ->> pipeline
-              (reduce (fn [a b]
-                        (let [result
-                              (cond (or (= :fail a)
-                                        (= :fail b)) :fail
-                                    true (unify a b))]
-                          (log-unification-result a b result model)
-                          result))
-                      (cons bolt
-                            ;; TODO: further flatten this into the overall ->> pipeline
-                            (map (fn [path-to-comp]
-                                   (let [complement (get paths-and-comps path-to-comp)]
-                                     (assoc-in bolt path-to-comp complement)))
-                                 (keys paths-and-comps)))))))
+     (map (fn [{bolt :bolt comps :comps}]
+            ;; TODO: further flatten this into the overall ->> pipeline
+            (reduce (fn [a b]
+                      (let [result
+                            (cond (or (= :fail a)
+                                      (= :fail b)) :fail
+                                  true (unify a b))]
+                        (log-unification-result a b result model)
+                        result))
+                    (cons bolt
+                          ;; TODO: further flatten this into the overall ->> pipeline
+                          (map (fn [path-to-comp]
+                                 (let [complement (get comps path-to-comp)]
+                                   (assoc-in bolt path-to-comp complement)))
+                               (keys comps))))))

      (map #(do-defaults % model)) ;; for each tree, run model defaults.


truncate complement immediately after adding it (if truncate-children=true)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -84,21 +84,22 @@
     (if truncate-children
       (->
        (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
-       (add-all-comps language-model total-depth)
-       (truncate-expressions [[:head][:comp]]))
+       (add-all-comps language-model total-depth true)
+       (truncate-expressions [[:head]]))
       (->
        (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
-       (add-all-comps language-model total-depth)))))
-
-(defn add-all-comps [bolts language-model total-depth]
+       (add-all-comps language-model total-depth false)))))
+
+(defn add-all-comps [bolts language-model total-depth truncate-children]
   (log/trace (str "add-all-comps with (empty? bolts): " (empty? bolts)))
   (lazy-mapcat
    (fn [bolt]
      (add-all-comps-with-paths [bolt] language-model total-depth
-                               (find-comp-paths-in bolt [:head])))
+                               (find-comp-paths-in bolt [:head])
+                               truncate-children))
    bolts))

-(defn add-all-comps-with-paths [bolts language-model total-depth comp-paths]
+(defn add-all-comps-with-paths [bolts language-model total-depth comp-paths truncate-children]
   (log/trace (str "add-all-comps-with-paths with (empty? bolts): "
                   (empty? bolts)))
   (if (not (empty? comp-paths))
@@ -110,11 +111,13 @@
                           "@[" (string/join " " path) "]" "^" total-depth))
           (add-complement-to-bolt bolt path
                                   language-model (+ total-depth (count path))
-                                  :max-total-depth max-total-depth))
+                                  :max-total-depth max-total-depth
+                                  :truncate-children truncate-children))
         bolts)
        language-model
        total-depth
-       (rest comp-paths)))
+       (rest comp-paths)
+       truncate-children))
     bolts))

 (defn find-comp-paths-in [bolt path]
@@ -123,8 +126,9 @@
           (find-comp-paths-in bolt (concat path [:head])))))

 (defn add-complement-to-bolt [bolt path language-model total-depth
-                              & {:keys [max-total-depth]
-                                 :or {max-total-depth max-total-depth}}]
+                              & {:keys [max-total-depth truncate-children]
+                                 :or {max-total-depth max-total-depth
+                                      truncate-children true}}]
   (log/debug (str "add-complement-to-bolt: " (show-bolt bolt path language-model)
                   "@[" (string/join " " path) "]" "^" total-depth))
   (let [index (:index language-model)
@@ -151,9 +155,13 @@
                                              complement-candidate-lexemes)]
     (filter #(not (fail? %))
             (mapfn (fn [complement]
-                    (unify (copy bolt)
-                           (path-to-map path
-                                        (copy complement))))
+                     (let [unified
+                           (unify (copy bolt)
+                                  (path-to-map path
+                                               (copy complement)))]
+                       (if truncate-children
+                         (truncate unified [path])
+                         unified)))
                   (let [debug (log/trace (str "add-complement-to-bolt(total-depth=" total-depth
                                               ",path=" path ",bolt=(" (show-bolt bolt path language-model)
                                               "): calling generate-all(" (strip-refs spec) ");"


remove logging that's not useful

remove logging that's not useful

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -98,7 +98,6 @@
   [language-model spec depth total-depth
                        & {:keys [max-total-depth]
                           :or {max-total-depth max-total-depth}}]
-  (log/debug (str "lightning-bolts: start: spec: " (spec-info spec)))
   (let [grammar (:grammar language-model)
         depth (if depth depth 0)
         ;; this is the relative depth; that is, the depth from the top of the current lightning bolt.
@@ -112,29 +111,8 @@
                (let [lexicon (or (:lexicon (:generate language-model)) (:lexicon language-model))
                      subset (if-let [index-fn (:index-fn language-model)]
                               (index-fn (get-in parent [:head] :top))
-                              (do (log/warn (str "lightning-bolts: no index-fn for model:" (:name language-model) ": using entire lexicon."))
-                                  (flatten (vals lexicon))))]
-                 (if (not (empty? subset))
-                   (log/debug (str "lightning-bolts: " (get-in parent [:rule])
-                                   " : subset of candidate heads: "
-                                   (count subset) " with spec: " (strip-refs spec)))
-                   (log/debug (str "index returned a null set for spec:" (strip-refs spec))))
-                 (log/trace (str "lightning-bolts: " (get-in parent [:rule])
-                                 " : head lexeme candidates: "
-                                 (string/join ","
-                                              (map #((:morph language-model) %)
-                                                   subset))))
-
-                 (log/trace (str "trying overh with parent: " (:rule parent) " and head constraints: " (get-in parent [:head])))
+                              (flatten (vals lexicon)))]
                  (let [result (over/overh parent (shuffle subset))]
-                   (when (not (empty? subset))
-                     (log/trace (str "lightning-bolts:  surviving candidate heads: " (count subset) " -(unify)-> " (count result))))
-
-                   (log/trace (str "lightning-bolts: surviving results: "
-                                   (string/join ","
-                                                (map #((:morph language-model) %)
-                                                     result))))
-
                    (if (and (not (empty? subset)) (empty? result)
                             (> (count subset)
                                50))
@@ -143,7 +121,6 @@
                      ;; and candidate head must be copied.
                      (log/warn (str "tried: " (count subset) " lexical candidates with spec:"
                                     (strip-refs spec) " and all of them failed as heads of parent:" (get-in parent [:rule]))))
-                   (log/trace (str "returning bolts: count: " (count result)))
                    result)))
              (filter #(= false
                          (get-in % [:head :phrasal] false))
@@ -151,18 +128,15 @@
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (and (< total-depth max-total-depth)
                    (= true (get-in spec [:head :phrasal] true)))
-            (do
-              (lazy-mapcat (fn [parent]
-                             (log/debug (str "calling lightning-bolts recursively: parent: " (:rule parent) " with spec : "
-                                             (spec-info (get-in parent [:head]))))
-                             (over/overh
-                              parent
-                              (lightning-bolts language-model (get-in parent [:head])
-                                               (+ 1 depth) (+ 1 total-depth)
-                                               :max-total-depth max-total-depth)))
+            (lazy-mapcat (fn [parent]
+                           (over/overh
+                            parent
+                            (lightning-bolts language-model (get-in parent [:head])
+                                             (+ 1 depth) (+ 1 total-depth)
+                                             :max-total-depth max-total-depth)))
                          (filter #(= true
                                      (get-in % [:head :phrasal] true))
-                                 parents))))]
+                                 parents)))]
       (filter
        (fn [bolt]
          (any-possible-complement?


disable :do-enrich; may reenable again after investigation

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -7,6 +7,8 @@
    [babel.generate :as generate :refer [try-hard-to]]
    [babel.over :as over]
    [babel.parse :as parse]
+   #?(:clj [clojure.tools.logging :as log])
+   #?(:cljs [babel.logjs :as log])
    [clojure.repl :refer [doc]]
    [clojure.string :as string]
    [dag_unify.core :refer (fail-path-between get-in strip-refs unifyc)]))
@@ -77,7 +79,9 @@
        (conj {:surface (fo result)}
              result))))
   ([spec model]
-   (let [result (engine/generate spec model)]
+   (let [result (engine/generate spec model
+                                 ;; TODO: why is this needed: remove (if possible) this override of :do-enrich.
+                                 :do-enrich false)]
      (if result
        (conj {:surface (fo result)}
              result)))))


gosync: the big refactoring

gosync: the big refactoring

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -38,7 +38,7 @@
     :id :buildviz-url
     :default "http://localhost:3000"]
    ["-f" "--from DATE" "DATE from which on builds are loaded (by default tries to pick up where the last run finished)"
-    :id :load-builds-from
+    :id :sync-start-time
     :parse-fn #(tf/parse date-formatter %)]
    ["-s" "--aggregate PIPELINE" "PIPELINE for which a complete stage will be synced as a job"
     :id :aggregate-jobs-for-pipelines
@@ -46,91 +46,6 @@
     :assoc-fn (fn [previous key val] (assoc previous key (conj (get previous key) val)))]
    ["-h" "--help"]])

-;; util
-
-(defn accumulate-build-times [builds]
-  (let [start-times (map :start builds)
-        end-times (map :end builds)]
-    (if (empty? (filter nil? end-times))
-      {:start (apply min start-times)
-       :end (apply max end-times)}
-      {})))
-
-(defn accumulate-builds [builds]
-  (let [outcomes (map :outcome builds)
-        accumulated-outcome (if (every? #(= "pass" %) outcomes)
-                              "pass"
-                              "fail")]
-    (assoc (accumulate-build-times builds)
-           :outcome accumulated-outcome)))
-
-(defn ignore-old-runs-for-rerun-stages [{stage-run :stageRun} builds]
-  (filter #(= stage-run (:actual-stage-run %)) builds))
-
-(defn build-for-job [job-instance]
-  (if-let [jobs-for-accumulation (:jobs-for-accumulation job-instance)]
-    (->> jobs-for-accumulation
-         (map #(merge job-instance %))
-         (map (partial goapi/build-for go-url))
-         (ignore-old-runs-for-rerun-stages job-instance)
-         accumulate-builds)
-    (dissoc (goapi/build-for go-url job-instance)
-            :actual-stage-run)))
-
-(defn job-data-for-instance [jobInstance]
-  (assoc jobInstance :build (build-for-job jobInstance)))
-
-
-(defn job-instances-for-stage-instance [{pipeline-run :pipeline_counter
-                                         stage-run :counter
-                                         jobs :jobs}]
-  (map (fn [{id :id name :name scheduled-date :scheduled_date}]
-         {:jobId id
-          :jobName name
-          :stageRun stage-run
-          :pipelineRun pipeline-run
-          :scheduledDateTime (tc/from-long scheduled-date)})
-       jobs))
-
-(defn job-instance-for-accumulated-stage-instance [{pipeline-run :pipeline_counter
-                                                    stage-run :counter
-                                                    jobs :jobs}]
-  (let [job-instances (map (fn [{id :id name :name}]
-                             {:jobId id :jobName name})
-                           jobs)]
-    {:jobId 0
-     :jobName "accumulated"
-     :stageRun stage-run
-     :pipelineRun pipeline-run
-     :scheduledDateTime (tc/from-long (apply min (map :scheduled_date jobs)))
-     :jobs-for-accumulation job-instances}))
-
-(defn fetch-job-instances-for-stage-instance [accumulate-stages-for-pipelines stage-name stage-instance]
-  (if (contains? accumulate-stages-for-pipelines stage-name)
-    (list (job-instance-for-accumulated-stage-instance stage-instance))
-    (job-instances-for-stage-instance stage-instance)))
-
-(defn job-instances-for-stage [load-builds-from accumulate-stages-for-pipelines {stage-name :stage pipeline :pipeline}]
-  (let [safe-build-start-date (t/minus load-builds-from (t/millis 1))]
-    (->> stage-name
-         (goapi/get-stage-history go-url pipeline)
-         (mapcat (partial fetch-job-instances-for-stage-instance accumulate-stages-for-pipelines pipeline))
-         (take-while #(t/after? (:scheduledDateTime %) safe-build-start-date))
-         (map #(assoc % :stageName stage-name :pipelineName pipeline)))))
-
-
-(defn augment-job-with-inputs [job]
-  (let [pipeline-run (:pipelineRun job)
-        pipeline-name (:pipelineName job)
-        inputs (goapi/get-inputs-for-pipeline-run go-url pipeline-name pipeline-run)]
-    (assoc job :inputs inputs)))
-
-
-(defn select-stages [filter-groups stages]
-  (if (seq filter-groups)
-    (filter #(contains? filter-groups (:group %)) stages)
-    stages))
-

 (defn- testsuite? [elem]
   (= :testsuite (:tag elem)))
@@ -141,51 +56,129 @@
       (list root)
       (:content root))))

-(defn accumulate-junit-xml-results [junit-xml-list]
+(defn aggregate-junit-xml-testsuites [junit-xml-list]
   (xml/emit-str (apply xml/element (cons :testsuites
                                          (cons {}
                                                (mapcat testsuite-list junit-xml-list))))))

-(defn get-all-junit-xml [job-instance]
-  (let [jobs (:jobs-for-accumulation job-instance)]
-    (->> jobs
-         (map #(merge job-instance %))
-         (map (partial goapi/get-junit-xml go-url)))))
-
-(defn get-accumulated-junit-xml [job-instance]
-  (let [all-junit-xml (get-all-junit-xml job-instance)
+(defn aggregate-junit-xml [{pipeline-name :pipelineName
+                            pipeline-run :pipelineRun
+                            stage-name :stageName
+                            stage-run :stageRun
+                            job-instances :job-instances}]
+  (let [all-junit-xml (map :junit-xml job-instances)
         junit-xml-list (remove nil? all-junit-xml)]
     (when-not (empty? junit-xml-list)
       (when-not (= (count junit-xml-list) (count all-junit-xml))
-        (let [{pipeline-name :pipelineName
-               pipeline-run :pipelineRun
-               stage-name :stageName
-               stage-run :stageRun} job-instance]
-          (log/infof "Unable to accumulate all JUnit XML for jobs of %s %s (%s %s)"
-                   pipeline-name stage-name pipeline-run stage-run)))
-      (accumulate-junit-xml-results junit-xml-list))))
-
-(defn fetch-junit-xml [job-instance]
-  (if (contains? job-instance :jobs-for-accumulation)
-    (get-accumulated-junit-xml job-instance)
-    (goapi/get-junit-xml go-url job-instance)))
-
-(defn augment-job-instance-with-junit-xml [job-instance]
-  (if-let [junit-xml (fetch-junit-xml job-instance)]
-    (assoc job-instance
-           :junit-xml junit-xml)
-    job-instance))
+        (log/infof "Unable to accumulate all JUnit XML for jobs of %s %s (%s %s)"
+                   pipeline-name stage-name pipeline-run stage-run))
+      (aggregate-junit-xml-testsuites junit-xml-list))))
+
+
+(defn aggregate-build-times [job-instances]
+  (let [start-times (map :start job-instances)
+        end-times (map :end job-instances)]
+    (if (empty? (filter nil? end-times))
+      {:start (apply min start-times)
+       :end (apply max end-times)}
+      {})))
+
+(defn aggregate-builds [job-instances]
+  (let [outcomes (map :outcome job-instances)
+        accumulated-outcome (if (every? #(= "pass" %) outcomes)
+                              "pass"
+                              "fail")]
+    (assoc (aggregate-build-times job-instances)
+           :outcome accumulated-outcome)))
+
+
+(defn ignore-old-runs-for-rerun-stages [job-instances stage-run]
+  (filter #(= stage-run (:actual-stage-run %)) job-instances))
+
+(defn- aggregate-build [{stage-run :stageRun
+                         stage-name :stageName
+                         job-instances :job-instances}]
+  (-> job-instances
+      (ignore-old-runs-for-rerun-stages stage-run)
+      aggregate-builds
+      (assoc :name stage-name)))
+
+(defn- aggregate-jobs-for-stage [stage-instance]
+  (let [aggregated-junit-xml (aggregate-junit-xml stage-instance)
+        aggregated-build (aggregate-build stage-instance)]
+    (assoc stage-instance
+           :job-instances (list (assoc aggregated-build
+                                       :junit-xml aggregated-junit-xml)))))
+
+(defn- aggregate-jobs-for-selected-stages [stage-instance aggregate-jobs-for-pipelines]
+  (let [{pipeline-name :pipelineName} stage-instance]
+    (if (contains? aggregate-jobs-for-pipelines pipeline-name)
+      (aggregate-jobs-for-stage stage-instance)
+      stage-instance)))
+
+
+(defn- build-for-job [stage-instance job-name]
+  (let [job-instance (assoc stage-instance :jobName job-name)]
+    (-> (goapi/build-for go-url job-instance)
+        (assoc :name job-name)
+        (assoc :junit-xml (goapi/get-junit-xml go-url job-instance)))))
+
+(defn- add-job-instances-for-stage-instances [stage-instance]
+  (let [job-names (:job-names stage-instance)]
+    (assoc stage-instance
+           :job-instances (map #(build-for-job stage-instance %) job-names))))
+
+
+(defn parse-stage-instance [{pipeline-run :pipeline_counter
+                             stage-run :counter
+                             jobs :jobs}]
+  {:stageRun stage-run
+   :pipelineRun pipeline-run
+   :scheduled-time (tc/from-long (apply min (map :scheduled_date jobs)))
+   :job-names (map :name jobs)})
+
+(defn stage-instances-from [sync-start-time {stage-name :stage pipeline-name :pipeline}]
+  (let [safe-build-start-date (t/minus sync-start-time (t/millis 1))]
+    (->> (goapi/get-stage-history go-url pipeline-name stage-name)
+         (map parse-stage-instance)
+         (map #(assoc % :stageName stage-name :pipelineName pipeline-name))
+         (take-while #(t/after? (:scheduled-time %) safe-build-start-date)))))
+
+
+(defn add-inputs-for-stage-instances [stage-instance]
+  (let [pipeline-run (:pipelineRun stage-instance)
+        pipeline-name (:pipelineName stage-instance)
+        inputs (goapi/get-inputs-for-pipeline-run go-url pipeline-name pipeline-run)]
+    (assoc stage-instance :inputs inputs)))
+
+
+(defn select-stages [filter-groups stages]
+  (if (seq filter-groups)
+    (filter #(contains? filter-groups (:group %)) stages)
+    stages))
+

 ;; upload

-(defn make-build-instance [{jobName :jobName stageName :stageName pipelineName :pipelineName
-                            stageRun :stageRun pipelineRun :pipelineRun
-                            junit-xml :junit-xml
-                            inputs :inputs build :build}]
-  {:jobName (format "%s %s %s" pipelineName stageName jobName)
-   :buildNo (format "%s %s" pipelineRun stageRun)
-   :junit-xml junit-xml
-   :build (assoc build :inputs inputs)})
+(defn- stage-instances->builds [{pipeline-name :pipelineName
+                                 pipeline-run :pipelineRun
+                                 stage-name :stageName
+                                 stage-run :stageRun
+                                 inputs :inputs
+                                 job-instances :job-instances}]
+  (map (fn [{outcome :outcome
+             start :start
+             end :end
+             name :name
+             junit-xml :junit-xml}]
+         {:job-name (format "%s %s %s" pipeline-name stage-name name)
+          :build-id (format "%s %s" pipeline-run stage-run)
+          :junit-xml junit-xml
+          :build {:start start
+                  :end end
+                  :outcome outcome
+                  :inputs inputs}})
+       job-instances))

 (defn buildviz-build-base-url [job-name build-no]
   (format "%s/builds/%s/%s" buildviz-url job-name build-no))
@@ -203,7 +196,7 @@
   (print ".")
   (flush))

-(defn put-to-buildviz [{job-name :jobName build-no :buildNo build :build junit-xml :junit-xml}]
+(defn put-to-buildviz [{job-name :job-name build-no :build-id build :build junit-xml :junit-xml}]
   (dot)
   (log/info (format "Syncing %s %s: build" job-name build-no build))
   (put-build job-name build-no  build)
@@ -236,23 +229,24 @@

 ;; run

-(defn- emit-start [load-builds-from accumulate-stages-for-pipelines pipeline-stages]
+(defn- emit-start [sync-start-time aggregate-jobs-for-pipelines pipeline-stages]
   (println "Looking at pipeline groups" (distinct (map :group pipeline-stages)))
-  (println "Syncing all builds starting from" (tf/unparse (:date-time tf/formatters) load-builds-from))
-  (when (some? accumulate-stages-for-pipelines)
-    (println "Aggregating jobs for stages of" accumulate-stages-for-pipelines))
-
-  (println "Finding all builds for syncing...")
+  (println "Syncing all stages starting from" (tf/unparse (:date-time tf/formatters) sync-start-time))
+  (when (some? aggregate-jobs-for-pipelines)
+    (println "Aggregating jobs for stages of" aggregate-jobs-for-pipelines))
+
+  (println "Finding all pipeline runs for syncing...")

   pipeline-stages)

 (defn- emit-count-items [builds]
-  (println (format "Found %s builds to be synced, starting" (count builds)))
+  (println (format "Found %s stage instances to be synced, starting" (count builds)))
   builds)

 (defn- emit-end [builds]
-  (println)
-  (println (format "Done, wrote %s build entries" (count builds))))
+  (let [build-count (count builds)]
+    (println)
+    (println (format "Done, wrote %s build entries" build-count))))

 (defn -main [& c-args]
   (def args (parse-opts c-args cli-options))
@@ -267,20 +261,19 @@

   (println "Go" go-url "-> buildviz" buildviz-url)

-  (let [load-builds-from (get-start-date (:load-builds-from (:options args)))
-        accumulate-stages-for-pipelines (set (:aggregate-jobs-for-pipelines (:options args)))
+  (let [sync-start-time (get-start-date (:sync-start-time (:options args)))
+        aggregate-jobs-for-pipelines (set (:aggregate-jobs-for-pipelines (:options args)))
         selected-pipeline-group-names (set (drop 1 (:arguments args)))]

     (->> (goapi/get-stages go-url)
          (select-stages selected-pipeline-group-names)
-         (emit-start load-builds-from accumulate-stages-for-pipelines)
-         (mapcat (partial job-instances-for-stage load-builds-from accumulate-stages-for-pipelines))
-         (sort-by :scheduledDateTime)
+         (emit-start sync-start-time aggregate-jobs-for-pipelines)
+         (mapcat #(stage-instances-from sync-start-time %))
+         (sort-by :scheduled-time)
          emit-count-items
-         (map augment-job-with-inputs)
-         (map job-data-for-instance)
-         (filter #(some? (:build %)))
-         (map augment-job-instance-with-junit-xml)
-         (map make-build-instance)
+         (map add-inputs-for-stage-instances)
+         (map add-job-instances-for-stage-instances)
+         (map #(aggregate-jobs-for-selected-stages % aggregate-jobs-for-pipelines))
+         (mapcat stage-instances->builds)
          (map put-to-buildviz)
          emit-end)))


Make raw-bound-fns accessible

Make raw-bound-fns accessible

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -27,23 +27,9 @@
                         (vary-meta arg assoc :tag tag)))]]
       [name (mapv ann args)])))

-(def ^:private bound-fns
-  "A mapping of type- and jnr.ffi-annotated bound method symbols to
-  respective argspec.
-
-  This exists so that tooling (like magic macro helpers) can easily
-  inspect caesium allegedly binds. That can be done by reflecting on
-  the interface too, but that's significantly less convenient;
-  Clojure's reflection tools don't show annotations, and we always use
-  the data in metadata-annotated form anyway (both to create the
-  interface and to bind fns to vars).
-
-  This has to be a vec and not a map, because the same key (symbol,
-  method name) might occur with multiple values (e.g. when binding the
-  same char* fn with different JVM byte types)."
-  (mapcat
-   permuted-byte-types
-   '[[^int sodium_init []]
+(def ^:private raw-bound-fns
+  "See [[bound-fns]], but without the permutations."
+  '[[^int sodium_init []]
      [^String sodium_version_string []]

      [^void randombytes
@@ -210,7 +196,23 @@
      [^int crypto_scalarmult
       [^bytes ^{Pinned {}} q
        ^bytes ^{Pinned {}} n
-       ^bytes ^{Pinned {}} p]]]))
+       ^bytes ^{Pinned {}} p]]])
+
+(def ^:private bound-fns
+  "A mapping of type- and jnr.ffi-annotated bound method symbols to
+  respective argspec.
+
+  This exists so that tooling (like magic macro helpers) can easily
+  inspect caesium allegedly binds. That can be done by reflecting on
+  the interface too, but that's significantly less convenient;
+  Clojure's reflection tools don't show annotations, and we always use
+  the data in metadata-annotated form anyway (both to create the
+  interface and to bind fns to vars).
+
+  This has to be a vec and not a map, because the same key (symbol,
+  method name) might occur with multiple values (e.g. when binding the
+  same char* fn with different JVM byte types)."
+  (mapcat permuted-byte-types raw-bound-fns))

 (defmacro ^:private defsodium
   []


remove reload system task

remove reload system task

--- src/cake/tasks/help.clj
+++ src/cake/tasks/help.clj
@@ -11,7 +11,7 @@
     (apply println "cake" name deps)
     (doseq [doc docs] (println "  " doc))))

-(def system-tasks #{"reload" "ps" "kill" "killall" "log" "upgrade"})
+(def system-tasks #{"ps" "kill" "killall" "log" "upgrade"})
 (def hidden-tasks #{"default" "eat" "bake"})

 (defn taskdocs [pattern]


Parametrized number of clients for net simulation.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -193,7 +193,8 @@
                                         :client (get-el-value "client")
                                         :color (get-el-value "color")
                                         :sleep (js/parseInt (get-el-value "sleep"))}))
-        render-state (atom {})]
+        render-state (atom {})
+        num-clients 3]
     (vis-init (fn [world vis-chs]
                 (let [connect-ch (achan-buf world 10)
                       listen-ch (achan-buf world 10)
@@ -209,12 +210,15 @@
                          (server-accept-loop world accept-ch1 close-accept-ch1)
                          (let [req-ch (achan init-world)
                                res-ch (achan init-world)
-                               client-cmd-chs {"client-0" (client-loop world connect-ch
-                                                                       :server 8000 :client-0 res-ch)
-                                               "client-1" (client-loop world connect-ch
-                                                                       :server 8100 :client-1 res-ch)
-                                               "client-2" (client-loop world connect-ch
-                                                                       :server 8000 :client-2 res-ch)}]
+                               server-ports (cycle [8000 8100])
+                               client-cmd-chs (reduce
+                                               (fn [acc i]
+                                                 (let [client-id (str "client-" i)]
+                                                   (assoc acc client-id
+                                                          (client-loop world connect-ch
+                                                                       :server (nth server-ports (count acc))
+                                                                       (keyword client-id) res-ch))))
+                                               {} (range num-clients))]
                            (world-cmd-loop world cbfg.world-lane/cmd-handlers cmd-ch
                                            req-ch res-ch vis-chs world-vis-init el-prefix)
                            (ago-loop cmd-dispatch-loop world [num-dispatches 0]


Added all the query fields

Added all the query fields

--- src/cfpb/qu/swagger.clj
+++ src/cfpb/qu/swagger.clj
@@ -101,7 +101,35 @@
                                                  :paramType "path"
                                                  :description "Name of slice"
                                                  :required true
-                                                 :enum slices)])
+                                                 :enum slices)
+                                      (api-param :string "$select"
+                                                 :paramType "query"
+                                                 :description "Fields to return, separated by commas."
+                                                 :required false)
+                                      (api-param :string "$where"
+                                                 :paramType "query"
+                                                 :description "Conditions to search for in the slice, in SQL WHERE style."
+                                                 :required false)
+                                      (api-param :string "$group"
+                                                 :paramType "query"
+                                                 :description "Fields to group by, summarizing the data, separated by commas."
+                                                 :required false)
+                                      (api-param :integer "$limit"
+                                                 :paramType "query"
+                                                 :description "Number of records to return, 100 by default. Enter 0 for no limit."
+                                                 :required false)
+                                      (api-param :integer "$offset"
+                                                 :paramType "query"
+                                                 :description "Number of records to skip."
+                                                 :required false)
+                                      (api-param :string "$orderBy"
+                                                 :paramType "query"
+                                                 :description "Fields to order by, separated by commas. ASC and DESC can be used to modify the order."
+                                                 :required false)
+                                      (api-param :string "$callback"
+                                                 :paramType "query"
+                                                 :description "JavaScript callback to invoke. Only useful with JSONP requests."
+                                                 :required false)])
                 (get-api :path (urls/slice-metadata-path :dataset dataset :slice "{slice}")
                          :nickname (str "getSliceMetadata" (capitalize dataset))
                          :summary "Get the metadata for a slice in this dataset."


Code to load configuration and start IRC bot

--- src/clj_mrazik/core.clj
+++ src/clj_mrazik/core.clj
@@ -17,10 +17,17 @@

 (require '[irclj.core :as irc])

-(require '[clj-mrazik.config :as config])
+(require '[clj-mrazik.config   :as config])
+(require '[clj-mrazik.schedule :as schedule])
+(require '[clj-mrazik.irc-bot  :as irc-bot])

 (defn -main
     "Entry point to this bot."
     [& args]
-    (pprint/pprint (config/load-configuration "config.ini")))
+    (let [config   (config/load-configuration "config.ini")
+          schedule (schedule/compute-schedule (:bot config))]
+         (config/print-configuration config)
+         (pprint/pprint schedule)
+         (irc-bot/start-irc-bot (:server config))
+    ))


* src/cljs/cljs/core.cljs: fix ci-reduce for IndexedSeq

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -433,11 +433,11 @@
   (-reduce [coll f]
     (if (counted? a)
       (ci-reduce a f (aget a i) (inc i))
-      (ci-reduce coll f (aget a i) (inc i))))
+      (ci-reduce coll f (aget a i) 0)))
   (-reduce [coll f start]
     (if (counted? a)
       (ci-reduce a f start i)
-      (ci-reduce coll f start i)))
+      (ci-reduce coll f start 0)))

   IHash
   (-hash [coll] (hash-coll coll)))


remove some test source code

remove some test source code

--- src/cljs/jiyi/core.cljs
+++ src/cljs/jiyi/core.cljs
@@ -402,18 +402,3 @@
 (defn init! []
   (hook-browser-navigation!)
   (mount-root))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Just for testing
-
-(comment
-  (do
-    (reset! deck {:reviewed [{:id 5702, :photo "https://genome.klick.com/local-instance/staff images/5702_3525_sq.jpg", :name "Ashley Ho", :title "Medical Editor", :dept "Creative"}], :to-review [{:id 4967, :photo "https://genome.klick.com/local-instance/staff images/4967_2553.jpg", :name "Alfred Oo", :title "Application Developer", :dept "KH4 Tech"} {:id 4966, :photo "https://genome.klick.com/local-instance/staff images/4966_2688_sq.jpg", :name "Max Gerlach", :title "Senior Mobile Developer", :dept "KH4 Tech"}]})
-    (set-to-being-reviewed (first (all-to-review))))
-
-  (add-watch deck :deck (fn [k r o n]
-                          (prn k o)
-                          (prn '=>)
-                          (prn k n)))
-  )


Fix failing jar-link test

Fix failing jar-link test

--- src/clojars/web/jar.clj
+++ src/clojars/web/jar.clj
@@ -64,7 +64,7 @@
   (html-doc account (str (:jar_name jar) " " (:version jar))
             [:div.container_12
              [:div#jar-title.grid_8.alpha
-              [:h1 (:jar_name jar)]
+              [:h1 (jar-link jar)]
               [:h2 (:description jar)]
               [:div#jar-info-bar
                (let [stats (stats/all)]


fixed checking for custom intermediate tags

--- src/selmer/validator.clj
+++ src/selmer/validator.clj
@@ -45,7 +45,7 @@
        (some #{tag-name} (close-tags))
        (let [tags (vec (butlast tags))]
          (if (some #{tag-name} end-tags)
-           (if (get @closing-tags tag-name)
+           (if (not-empty (get @closing-tags tag-name))
              (conj tags (assoc tag :line line)) tags)
            (exception
              "Tag " (format-tag last-tag)" was not closed on line " (:line last-tag) " for template " template)))


Updated the source URI in the docs.

Updated the source URI in the docs.

This time properly.

--- lambda-blog/project.clj
+++ lambda-blog/project.clj
@@ -19,4 +19,4 @@
             [lein-codox "0.9.1"]]
   :codox {:doc-paths ["doc/docs"]
           :metadata {:doc/format :markdown}
-          :source-uri "https://github.com/Idorobots/lambda-blog/lambda-blog/blob/{version}/{filepath}#L{line}"})
+          :source-uri "https://github.com/Idorobots/lambda-blog/blob/{version}/lambda-blog/{filepath}#L{line}"})


Fixing circular reference in reify clause

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/goa/goa.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/goa/goa.clj
@@ -111,7 +111,7 @@
                  :ns "kbio" :prefix "R_"}]
           [?/protein {:ln (:sha-1 ?/go ?/bioentity)
                      :ns "kbio" :prefix "P_"}]
-          [?/gocc {:ln (:sha-1 ?/go ?/to1)
+          [?/gocc {:ln (:sha-1 ?/go ?/bioentity)
                    :ns "kbio" :prefix "CC_"}]
           )


Remove comments

Remove comments

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -101,33 +101,7 @@
                :data-success-text "Saved",
                :type "submit"
                :value "Save Heroku key"
-               :on-click #(do (submit-form!) false)}])]
-
-           #_[:form
-            (when heroku-api-key
-              [:div.form-group
-               [:label "Current Heroku key"]
-               [:input.form-control.dumb
-                {:required  true
-                 :type      "text",
-                 :readonly  "readonly"
-                 :value heroku-api-key}]])
-            [:div.form-group
-             [:label "Add new key"]
-             [:input#heroku-key
-              {:required  true
-               :type      "text",
-               :value     heroku-api-key-input
-               :on-change  #(utils/edit-input owner (conj state/user-path :heroku-api-key-input) %)}]]
-            [:div.form-group
-            (forms/managed-button
-             [:input.btn.btn-success
-              {:data-loading-text "Saving...",
-               :data-failed-text  "Failed to save Heroku key",
-               :data-success-text "Saved",
-               :type "submit"
-               :value "Save Heroku key"
-               :on-click #(do (submit-form!) false)}])]]]])))))
+               :on-click #(do (submit-form!) false)}])]]])))))

 (defn api-tokens [app owner]
   (reify
@@ -163,25 +137,6 @@
                :type "submit"
                :value "Create new token"}])]

-           #_[:form
-            [:div.form-group
-             [:label "Add a new token name"]
-             [:input.form-control#api-token
-              {:required  true
-               :name      "label",
-               :type      "text",
-               :value     (str new-user-token)
-               :on-change #(utils/edit-input owner state/new-user-token-path %)}]]
-            [:div.form-group
-             (forms/managed-button
-               [:input.btn.btn-success
-                {:data-loading-text "Creating...",
-                 :data-failed-text  "Failed to add token",
-                 :data-success-text "Created",
-                 :on-click          #(do (create-token! new-user-token)
-                                         false)
-                 :type "submit"
-                 :value "Create new token"}])]]
           [:div.api-item
            (when (seq tokens)
              [:table.table


Support gen

Support gen

--- src/spec_tools/core.cljc
+++ src/spec_tools/core.cljc
@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [string? integer? int? double? keyword? boolean? uuid? inst?])
   (:require
     [clojure.spec :as s]
+    [clojure.spec.gen :as gen]
     #?@(:cljs [goog.date.UtcDateTime]))
   #?(:clj
      (:import [java.util Date UUID])))
@@ -86,7 +87,8 @@

 (def ^:dynamic ^:private *conformations* nil)

-(defn dynamic-conformer [pred]
+(defn dynamically-conformed [pred]
+  (s/with-gen
   (s/conformer
     (fn [x]
       (if (pred x)
@@ -96,7 +98,8 @@
             (conformer x)
             '::s/invalid)
           ::s/invalid)))
-    identity))
+      identity)
+    #(s/gen pred)))

 (defn conform
   ([spec value]
@@ -110,10 +113,10 @@
 ;;

 (def string? clojure.core/string?)
-(def integer? (dynamic-conformer clojure.core/integer?))
-(def int? (dynamic-conformer clojure.core/int?))
-(def double? (dynamic-conformer double-like?))
-(def keyword? (dynamic-conformer clojure.core/keyword?))
-(def boolean? (dynamic-conformer clojure.core/boolean?))
-(def uuid? (dynamic-conformer clojure.core/uuid?))
-(def inst? (dynamic-conformer clojure.core/inst?))
+(def integer? (dynamically-conformed clojure.core/integer?))
+(def int? (dynamically-conformed clojure.core/int?))
+(def double? (dynamically-conformed double-like?))
+(def keyword? (dynamically-conformed clojure.core/keyword?))
+(def boolean? (dynamically-conformed clojure.core/boolean?))
+(def uuid? (dynamically-conformed clojure.core/uuid?))
+(def inst? (dynamically-conformed clojure.core/inst?))


Remove specs from trace results

Remove specs from trace results

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -23,22 +23,18 @@
     (s/conform (:args (s/get-spec var)) args)))

 (defn trace [{:keys [path] :as problem}]
-  (let [spec (s/get-spec (first (:via problem)))]
-    (loop [path path, spec spec, form (s/form spec), ret []]
+  (let [form (s/form (s/get-spec (first (:via problem))))]
+    (loop [path path, form form, ret []]
       ;(prn :path path)
-      ;(prn :spec spec)
       ;(prn :form form)
       (if (empty? path)
         ret
-        (let [[spec' path'] (step (first form)
+        (let [[form' path'] (step (first form)
                                   (conform-macro-form form)
-                                  path)
-              [spec' form'] (if (keyword? spec')
-                              (let [spec (s/get-spec spec')]
-                                [spec (s/form spec)])
-                              [spec spec'])]
-          (recur path' spec' form'
-                 (conj ret {:spec spec :form form})))))))
+                                  path)]
+          (recur path'
+                 (if (keyword? form') (s/form (s/get-spec form')) form')
+                 (conj ret {:form form})))))))

 (defn traces [ed]
   (mapv trace (::s/problems ed)))


Add notes to gasplan

Add notes to gasplan

--- src/angelic/search/action_set/gasplan.clj
+++ src/angelic/search/action_set/gasplan.clj
@@ -21,7 +21,15 @@
 ; Problems:
  ; (1) actions are split based on primary effect.
  ; (2) end up hallucinating huge pointless chains.
- ; (3) ways to assign parents multiples in general -- need to keep in control somehow.
+                                        ; (3) ways to assign parents multiples in general -- need to keep in control somehow.
+
+;; Note: this fails completely, even on cyclic unary domains.
+;; See, e.g., angelic.domains.unary-cyclic.clj.
+;;Var z, vals 0, 1, initially 0.
+;;a can transition along the line with no preconditions, except 0-->1 requires z = 1.
+;;z can transition 0 --> 1 when a = -1.
+
+;; Seems to require either prediction or more interleaving, not handleable in this framework.

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; States, (meta)primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -227,7 +235,7 @@
             (do (println "??????????!!") (activation-actions child-var-map x))
 ;; tODO: put below back, needed for correctness!
           ;; Active top-down var -- add actions
-;          (util/find-first #(and (not (state/get-var s (free-var %)))
+;            (util/find-first #(and (not (state/get-var s (free-var %)))
 ;                                 (not (state/get-var s (action-var (current-child s child-var-map %))))) ;->ASPLAN1
 ;                           (map second na-tuples))
 ;            (do ;(println "A!" x (state/get-var s x) )


user.clj -main function now runs a system with code refresh on SIGHUP

--- clstreams/dev/user.clj
+++ clstreams/dev/user.clj
@@ -10,6 +10,7 @@

    [com.stuartsierra.component :as component]

+   [clstreams.core :refer (run-and-handle-signals)]
    [clstreams.pipelines :refer (count-words)]))

 (def system nil)
@@ -35,5 +36,12 @@

 (defn -main
-  [func-name]
-  (println "This is user.clj talking!"))
+  [& _]
+  (let [[func-name & args] *command-line-args*
+        system-init-fn (eval (symbol func-name))]
+    (alter-var-root #'system
+                    (constantly (apply system-init-fn args)))
+    (run-and-handle-signals
+     (alter-var-root #'system component/start)
+     (alter-var-root #'system component/stop)
+     (refresh :after 'user/-main))))


Работа над сортировкой тегов

Работа над сортировкой тегов

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -447,39 +447,43 @@

 (defn sort-tree-as-flat-groups
   "Сортировка дерева в списке по иерархии и группировка"
-  [get-id-fn get-parent-id-fn tree-list]
-  (let [roots (->> tree-list
-                   (reduce (fn [[is ps] item]
-                             [(conj is (get-parent-id-fn item))
-                              (conj ps (get-id-fn item))])
-                           [#{} #{}])
-                   ((fn [[parents-ids ids]]
-                      (let [roots-ids (clojure.set/difference parents-ids ids)]
-                        (filter #(->> % get-parent-id-fn (contains? roots-ids)) tree-list)))) )]
-    (letfn [(sort-tree [parent]
-              (let [parent-id (get-id-fn parent)]
-                (->> tree-list
-                     (filter #(-> % get-parent-id-fn (= parent-id)))
-                     (sort-by get-id-fn)
-                     (reduce #(-> %1 (into (sort-tree %2))) [parent]) )))]
-      (->> roots
-           vec
-           (sort-by get-id-fn)
-           (reduce #(-> %1 (conj (sort-tree %2))) [] )))))
+  ([get-id-fn get-parent-id-fn tree-list]
+   (sort-tree-as-flat-groups get-id-fn get-parent-id-fn tree-list get-id-fn))
+  ([get-id-fn get-parent-id-fn tree-list get-sort-field-fn]
+   (let [roots (->> tree-list
+                    (reduce (fn [[is ps] item]
+                              [(conj is (get-parent-id-fn item))
+                               (conj ps (get-id-fn item))])
+                            [#{} #{}])
+                    ((fn [[parents-ids ids]]
+                       (let [roots-ids (clojure.set/difference parents-ids ids)]
+                         (filter #(->> % get-parent-id-fn (contains? roots-ids)) tree-list)))) )]
+     (letfn [(sort-tree [parent]
+               (let [parent-id (get-id-fn parent)]
+                 (->> tree-list
+                      (filter #(-> % get-parent-id-fn (= parent-id)))
+                      (sort-by get-sort-field-fn)
+                      (reduce #(-> %1 (into (sort-tree %2))) [parent]) )))]
+       (->> roots
+            vec
+            (sort-by get-sort-field-fn)
+            (reduce #(-> %1 (conj (sort-tree %2))) [] ))))))

 ;; TODO: написать тесты!
 (defn sort-tree-as-flat-groups-with-patches
-  [get-id-fn get-parent-id-fn store-on-key tree-list]
-  (->> tree-list
-       (sort-tree-as-flat-groups get-id-fn get-parent-id-fn)
-       (map (partial add-tree-patches get-id-fn get-parent-id-fn store-on-key))))
+  ([get-id-fn get-parent-id-fn store-on-key tree-list]
+   (sort-tree-as-flat-groups-with-patches get-id-fn get-parent-id-fn store-on-key tree-list get-id-fn))
+  ([get-id-fn get-parent-id-fn store-on-key tree-list get-sort-field-fn]
+   (->> (sort-tree-as-flat-groups get-id-fn get-parent-id-fn tree-list get-sort-field-fn)
+        (map (partial add-tree-patches get-id-fn get-parent-id-fn store-on-key)))))

 (defn sort-tree-as-flat
   "Сортировка древовидной структуры"
-  [get-id-fn get-parent-id-fn tree-list]
-  (->> tree-list
-       (sort-tree-as-flat-groups get-id-fn get-parent-id-fn)
-       (reduce into)))
+  ([get-id-fn get-parent-id-fn tree-list]
+   (sort-tree-as-flat get-id-fn get-parent-id-fn tree-list get-id-fn))
+  ([get-id-fn get-parent-id-fn tree-list get-sort-field-fn]
+   (->> (sort-tree-as-flat-groups get-id-fn get-parent-id-fn tree-list get-sort-field-fn)
+        (reduce into))))

 ;; END Common utils
 ;;..................................................................................................
@@ -763,7 +767,7 @@

 ;; TODO: написать тесты
 (defn tag-tree-as-flat-groups-with-patches [store-on-key]
-  (sort-tree-as-flat-groups-with-patches :id :parent_id store-on-key (select tag)))
+  (sort-tree-as-flat-groups-with-patches :id :parent_id store-on-key (select tag) :tagname))

 ;; TODO: написать тесты
 (defn tag-tree-as-flat []


Experimental: Add `:swap/abort` support to swap utils

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -532,10 +532,14 @@
       (let [[old-val ex] (parse nil (with-replies (get k) (exists k)))
             nx?          (= ex 0)
             [new-val return-val] (enc/-vswapped (f old-val nx?))
-            cas-success? (parse nil
-                           (with-replies
-                             (parse-suppress (multi) (set k new-val))
-                             (exec)))]
+            cas-success?
+            (if (= new-val :swap/abort)
+              true
+              (parse nil
+                (with-replies
+                  (parse-suppress (multi) (set k new-val))
+                  (exec))))]
+
         (if cas-success?
           (return return-val)
           (if (or (nil? nmax-attempts) (< idx (long nmax-attempts)))
@@ -598,12 +602,16 @@
               nx?                  (= ex 0)
               ?sha                 (when-not (= sha "") sha)
               [new-val return-val] (enc/-vswapped (f old-val nx?))
-              cas-success?         (= 1 (parse nil
-                                          (with-replies
-                                            (if nx?
-                                              (setnx k new-val)
-                                              (compare-and-set k old-val
-                                                ?sha new-val)))))]
+              cas-success?
+              (if (= new-val :swap/abort)
+                true
+                (= 1 (parse nil
+                       (with-replies
+                         (if nx?
+                           (setnx k new-val)
+                           (compare-and-set k old-val
+                             ?sha new-val))))))]
+
           (if cas-success?
             (return return-val)
             (if (or (nil? nmax-attempts) (< idx (long nmax-attempts)))
@@ -619,12 +627,16 @@
               nx?                  (= ex 0)
               ?sha                 (when-not (= sha "") sha)
               [new-val return-val] (enc/-vswapped (f old-val nx?))
-              cas-success?         (= 1 (parse nil
-                                          (with-replies
-                                            (if nx?
-                                              (hsetnx k field new-val)
-                                              (compare-and-hset k field old-val
-                                                ?sha new-val)))))]
+              cas-success?
+              (if (= new-val :swap/abort)
+                true
+                (= 1 (parse nil
+                       (with-replies
+                         (if nx?
+                           (hsetnx k field new-val)
+                           (compare-and-hset k field old-val
+                             ?sha new-val))))))]
+
           (if cas-success?
             (return return-val)
             (if (or (nil? nmax-attempts) (< idx (long nmax-attempts)))


Housekeeping: `map`->`mapv` when lazy seqs aren't explicitly required

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -132,8 +132,8 @@
       (some->> (.getN  x) str->num)
       (some->> (.getB  x) thaw)
       (some->> (.getSS x) (into #{}))
-      (some->> (.getNS x) (map str->num) (into #{}))
-      (some->> (.getBS x) (map thaw)     (into #{}))))
+      (some->> (.getNS x) (mapv str->num) (into #{}))
+      (some->> (.getBS x) (mapv thaw)     (into #{}))))

 (defn- clj-val->db-val "Returns an AttributeValue object for given Clojure value."
   ^AttributeValue [x]
@@ -151,8 +151,8 @@
      (throw (Exception. "Invalid DynamoDB value: empty set"))
      (cond
       (every? string?     x) (doto (AttributeValue.) (.setSS x))
-      (every? simple-num? x) (doto (AttributeValue.) (.setNS (map str x)))
-      (every? freeze?     x) (doto (AttributeValue.) (.setBS (map freeze* x)))
+      (every? simple-num? x) (doto (AttributeValue.) (.setNS (mapv str x)))
+      (every? freeze?     x) (doto (AttributeValue.) (.setBS (mapv freeze* x)))
       :else (throw (Exception. (str "Invalid DynamoDB value: set of invalid type"
                                     " or more than one type")))))

@@ -160,8 +160,8 @@
                                  " See `freeze` for serialization.")))))

 (comment
-  (map clj-val->db-val [  "a"    1 3.14    (.getBytes "a")    (freeze :a)
-                        #{"a"} #{1 3.14} #{(.getBytes "a")} #{(freeze :a)}]))
+  (mapv clj-val->db-val [  "a"    1 3.14    (.getBytes "a")    (freeze :a)
+                         #{"a"} #{1 3.14} #{(.getBytes "a")} #{(freeze :a)}]))

 ;;;; Coercion - objects

@@ -291,7 +291,7 @@
 (defn- attribute-defs "[{:name _ :type _} ...] defs -> [AttributeDefinition ...]"
   [hash-keydef range-keydef indexes]
   (let [defs (->> (conj [] hash-keydef range-keydef)
-                  (concat (map :range-keydef indexes))
+                  (concat (mapv :range-keydef indexes))
                   (filterv identity))]
     (mapv
      (fn [{key-name :name key-type :type :as def}]


Add support for Local Secondary Indexes (Rotary PR: edpaget)

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -30,6 +30,8 @@
              ;; KeySchema
              KeySchemaElement
              KeysAndAttributes
+             LocalSecondaryIndex
+             Projection
              ProvisionedThroughput
              ProvisionedThroughputDescription
              PutItemRequest
@@ -103,8 +105,26 @@
     (.setAttributeName key-name)
     (.setAttributeType (str/upper-case (name key-type)))))

-(defn- attribute-definitions "Returns a new vector of AttributeDefinition objects."
+(defn- attribute-definitions "Returns a vector of AttributeDefinition objects."
   [defs] (mapv attribute-definition defs))
+
+(defn- create-projection "Returns a new Projection object."
+  [projection & [included-attrs]]
+  (let [pr (Projection.)]
+    (.setProjectionType pr (str/upper-case (name projection)))
+    (when included-attrs (.setNonKeyAttributes pr included-attrs))
+    pr))
+
+(defn- local-index "Returns a new LocalSecondaryIndex object."
+  [hash-key {:keys [name range-key projection included-attrs]
+             :or   {projection :all}}]
+  (doto (LocalSecondaryIndex.)
+    (.setIndexName  name)
+    (.setKeySchema  (key-schema hash-key range-key))
+    (.setProjection (create-projection projection included-attrs))))
+
+(defn- local-indexes "Returns a vector of LocalSecondaryIndexes objects."
+  [hash-key indexes] (mapv (partial local-index hash-key) indexes))

 ;;;; Coercion - values

@@ -225,7 +245,6 @@
     :read  - the provisioned number of reads per second
     :write - the provisioned number of writes per second

-  ;; TODO +
   The indexes vector is a vector of maps with keys:
     :name           - the name of the Local Secondary Index (required)
     :range-key      - a map that defines the range key name and type (required)
@@ -233,19 +252,18 @@
       :all, :keys_only, :include (optional - default is :keys-only)
     :included-attrs - a vector of attribute names when :projection is :include
                       (optional)"
-  [creds {:keys [name hash-key range-key throughput]}] ;; TODO +indexes
+  [creds {:keys [name hash-key range-key throughput indexes]}]
   (.createTable
    (db-client creds)
    (let [defined-attrs (->> (conj [] hash-key range-key)
-                              ;; (concat (map #(:range-key %) indexes))
+                            (concat (map #(:range-key %) indexes))
                             (filter identity))]
      (doto (CreateTableRequest.)
        (.setTableName (str name))
        (.setKeySchema (key-schema hash-key range-key))
        (.setAttributeDefinitions (attribute-definitions defined-attrs))
        (.setProvisionedThroughput (provisioned-throughput throughput))
-       ;; (.setLocalSecondaryIndexes (local-indexes hash-key indexes))
-       ))))
+       (.setLocalSecondaryIndexes (local-indexes hash-key indexes))))))

 (defn update-table
   "Update a table in DynamoDB with the given name. Only the throughput may be
@@ -535,7 +553,7 @@

 (defn- query-request
   "Create a QueryRequest object."
-  [table hash-key range-clause {:keys [order limit after count consistent attrs]}] ;; TODO +index
+  [table hash-key range-clause {:keys [order limit after count consistent attrs index]}]
   (let [qr (QueryRequest.)
         hash-clause (set-hash-condition hash-key)
         [range-key operator range-value range-end] range-clause
@@ -553,7 +571,7 @@
     (when count      (.setCount qr count))
     (when consistent (.setConsistentRead qr consistent))
     (when after      (.setExclusiveStartKey qr (item-key after)))
-    ;; (when index      (.setIndexName qr index)) ; TODO
+    (when index      (.setIndexName qr index))
     qr))

 (defn- extract-range [[range options]]
@@ -592,7 +610,7 @@
     :limit - the maximum number of items to return
     :after - only return results after this key
     :consistent - return a consistent read if logical true
-;;    :index - the secondary index to query ; TODO
+    :index - the secondary index to query

   The items are returned as a map with the following keys:
     :items - the list of items returned


Support multiple forms in as-admin, run-as

--- lambdalf-lib/src/main/clojure/alfresco/auth.clj
+++ lambdalf-lib/src/main/clojure/alfresco/auth.clj
@@ -30,18 +30,18 @@
   sequence that include calls to repository functions, as when/if they are
   eventually evaluated, the calls to those functions will occur outside the
   scope of the authorisation context (which is probably not what's intended)."
-  [user f]
+  [user & f]
   `(let [work# (reify AuthenticationUtil$RunAsWork
                      (~'doWork [~'this]
-                               ~f))]
+                               ~@f))]
      (AuthenticationUtil/runAs work# ~user)))

 (defmacro run-as-fn
   "Returns a closure which will run with the provided user privileges"
-  [user f]
+  [user & f]
   `(fn []
      (run-as ~user
-             ~f)))
+             ~@f)))

 (defmacro as-admin
   "Runs the provided form as admin.
@@ -49,8 +49,8 @@
   sequence that include calls to repository functions, as when/if they are
   eventually evaluated, the calls to those functions will occur outside the
   scope of the authorisation context (which is probably not what's intended)."
-  [f]
-  `(run-as (admin) ~f))
+  [& f]
+  `(run-as (admin) ~@f))

 (defn whoami
   "Returns the currently valid user name"


fixed bugs in get-document-value-map! function

--- cljs/src/views/editor.cljs
+++ cljs/src/views/editor.cljs
@@ -363,8 +363,8 @@
   ([language feed-name content]
      {:feed [language feed-name]
       :title (ui/get-form-value "title")
-      :subtitle (when-let [subtitle (ui/get-form-value "subtitle")]
-                  subtitle)
+      :subtitle (when-let [subtitle-el (dom/getElement "subtitle")]
+                  (ui/get-form-value subtitle-el))
       :slug (ui/get-form-value "slug")
       :draft (.-checked (dom/getElement "draft"))
       :content (or content (html-with-clean-image-uris
@@ -374,21 +374,21 @@
                      (html-with-clean-image-uris
                        (.getCleanContents @description-editor-field
                                           @description-editor-field)))
-      :start-time (when-let [start-time (ui/get-form-value "start-time")]
-                    start-time)
-      :end-time (when-let [end-time (ui/get-form-value "end-time")]
-                  end-time)
-      :icon (let [icon-container-el (dom/getElement
-                                     "icon-preview-container")]
+      :start-time (when-let [start-time-el (dom/getElement "start-time")]
+                    (ui/get-form-value  start-time-el))
+      :end-time (when-let [end-time-el (dom/getElement "end-time")]
+                  (ui/get-form-value end-time-el))
+      :icon (when-let [icon-container-el (dom/getElement
+                                          "icon-preview-container")]
               (when-let [icon-slug-el (first
                                        (util/get-children-by-tag
                                         icon-container-el
                                         "input"))]
                 {:slug (.getAttribute icon-slug-el "value")
                  :title (.-innerHTML (first
-                                 (util/get-children-by-tag
-                                  icon-container-el
-                                  "span")))}))
+                                      (util/get-children-by-tag
+                                       icon-container-el
+                                       "span")))}))
       :related-pages (vec
                       (get-related-pages
                        (dom/getElement "related-pages-container")))


separate transaction coercion from item

separate transaction coercion from item

--- src/clj/clj_money/models/transactions.clj
+++ src/clj/clj_money/models/transactions.clj
@@ -167,9 +167,11 @@
 (def ^:private coercion-rules
   [(coercion/rule :uuid [:id])
    (coercion/rule :integer [:entity-id])
-   (coercion/rule :decimal [:items :quantity])
    (coercion/rule :local-date [:transaction-date])
    (coercion/rule :local-date [:original-transaction-date])])
+
+(def ^:private item-coercion-rules
+  [(coercion/rule :decimal [:quantity])])

 (defn- expand-simplified-items
   [{:keys [items quantity debit-account-id credit-account-id] :as transaction}]
@@ -192,6 +194,7 @@
       (coercion/coerce coercion-rules)
       (update-in [:items] (fn [items]
                             (->> items
+                                 (map #(coercion/coerce % item-coercion-rules))
                                  (map #(merge % (select-keys
                                                   transaction
                                                   [:transaction-date


Also show which columns are missing in error message

--- src/clj/org/openforis/ceo/db/projects.clj
+++ src/clj/org/openforis/ceo/db/projects.clj
@@ -361,21 +361,22 @@
       (do
         (when (not (str/includes? header-row ","))
           (init-throw "The CSV file must use commas for the delimiter."))
-        (let [headers (as-> header-row hr
-                        (str/split hr #",")
-                        (mapv #(-> %
-                                   (str/upper-case)
-                                   (str/replace #"-| |," "_")
-                                   (str/replace #"X|LONGITUDE|LONG|CENTER_X" "LON")
-                                   (str/replace #"Y|LATITUDE|CENTER_Y" "LAT"))
-                              hr))]
-          (if (every? (set headers) must-include)
+        (let [headers    (as-> header-row hr
+                           (str/split hr #",")
+                           (mapv #(-> %
+                                      (str/upper-case)
+                                      (str/replace #"-| |," "_")
+                                      (str/replace #"X|LONGITUDE|LONG|CENTER_X" "LON")
+                                      (str/replace #"Y|LATITUDE|CENTER_Y" "LAT"))
+                                 hr))
+              header-set (set headers)]
+          (if (set/subset must-include header-set)
             (do
               (spit ext-file (str/replace-first data header-row (str/join "," headers)))
               (type-columns headers))
-            (init-throw (str "Error while checking headers. Fields must include LON,LAT,"
-                             (str/join "," must-include)
-                             ".")))))
+            (init-throw (str "Header fields "
+                             (str/join "," (set/difference (set must-include) header-set))
+                             " are missing. ")))))
       (init-throw "CSV File is empty."))))

 (defn- load-external-data [distribution project-id ext-file type must-include]


Add throwaway map dev view

Add throwaway map dev view

--- src/cljs/gtfve/components/maps_panel.cljs
+++ src/cljs/gtfve/components/maps_panel.cljs
@@ -19,6 +19,19 @@
                            :zoom 15})

 (defn maps-canvas [ui owner]
+(defn maps-canvas-dev [ui _]
+  (reify
+    om/IRenderState
+    (render-state [_ {:keys [gmap] :as state}]
+      (html
+       [:div.panel.panel-info {:style {:position "fixed"
+                                       :bottom "10px"
+                                       :right "10px"}}
+        [:div.panel-heading "Map Info"]
+        [:div.panel-body
+         (when gmap
+           [:p (pr-str (:bounds state))])]]))))
+
   (reify
     om/IInitState
     (init-state [_]


rewrite is-inside? for the abstract case

--- src/cljs/infinitelives/utils/spatial.cljs
+++ src/cljs/infinitelives/utils/spatial.cljs
@@ -93,10 +93,16 @@
 (defn query-cells [{:keys [hash divider] :as spatial} start-cell end-cell]
   (apply merge (for [cell (all-cells start-cell end-cell)] (hash cell))))

-(defn is-inside? [[x1 y1 z1] [x2 y2 z1] [x y z]]
-  (if (and (nil? z1) (nil? z2) (nil? z3))
-    (and (<= x1 x x2) (<= y1 y y2))
-    (and (<= x1 x x2) (<= y1 y y2) (<= z1 z z2))))
+(defn is-inside? [low high pos]
+  (loop [[p & prest] pos
+         state true
+         [l & lrest] low
+         [h & hrest] high]
+    (if (and state (seq lrest) (seq hrest))
+      (recur prest (and state
+                      (<= l p h))
+             lrest hrest)
+      state)))

 (defn query [{:keys [hash divider] :as spatial} start-pos end-pos]
   (let [start (hash-position divider start-pos)


Update api tests to handle RDDs where ordering is not guaranteed. Update glom test to use a fixed partition.

--- test/flambo/api_test.clj
+++ test/flambo/api_test.clj
@@ -113,9 +113,9 @@
               ]
           (-> (f/join LDATA RDATA)
               f/collect
-              vec)) => [["key3" [[5] [33]]]
-                        ["key4" [[1] [44]]]
-                        ["key1" [[2] [22]]]])
+              vec)) => (just [["key3" [[5] [33]]]
+                              ["key4" [[1] [44]]]
+                              ["key1" [[2] [22]]]] :in-any-order))

       (fact
         "left-outer-join returns an RDD of (K, (V, W)) when called on RDDs of type (K, V) and (K, W)"
@@ -129,11 +129,11 @@
                                       ["key4" [44]]])]
           (-> (f/left-outer-join LDATA RDATA)
               f/collect
-              vec)) => [["key3" [[5] [33]]]
-                        ["key4" [[1] [44]]]
-                        ["key5" [[2] nil]]
-                        ["key1" [[2] [22]]]
-                        ["key2" [[3] nil]]])
+              vec)) => (just [["key3" [[5] [33]]]
+                              ["key4" [[1] [44]]]
+                              ["key5" [[2] nil]]
+                              ["key1" [[2] [22]]]
+                              ["key2" [[3] nil]]] :in-any-order))

       (fact
         "sample returns a fraction of the RDD, with/without replacement,
@@ -141,7 +141,7 @@
         (-> (f/parallelize c [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15])
             (f/sample false 0.4 10)
             f/collect
-            vec) => [1 4 7 11 14])
+            vec) => (just [1 4 7 11 14] :in-any-order))

       (fact
         "combine-by-key returns an RDD by combining the elements for each key using a custom
@@ -151,7 +151,7 @@
                               ["key1" 1]])
             (f/combine-by-key identity + +)
             f/collect
-            vec) => [["key1" 2] ["key2" 1]])
+            vec) => (just [["key1" 2] ["key2" 1]] :in-any-order))

       (fact
         "sort-by-key returns an RDD of (K, V) pairs sorted by keys in asc or desc order"
@@ -175,7 +175,7 @@
         (-> (f/parallelize c [1 1 2 3 5 8])
             (f/group-by (f/fn [x] (mod x 2)))
             f/collect
-            vec) => [[0 [2 8]] [1 [1 1 3 5]]])
+            vec) => (just [[0 [2 8]] [1 [1 1 3 5]]] :in-any-order))

       (fact
         "group-by-key"
@@ -186,7 +186,7 @@
                               ["key3" 5]])
             f/group-by-key
             f/collect
-            vec) => [["key3" [5]] ["key1" [1 2]] ["key2" [3 4]]])
+            vec) => (just [["key3" [5]] ["key1" [1 2]] ["key2" [3 4]]] :in-any-order))

       (fact
         "flat-map-to-pair"
@@ -268,7 +268,7 @@
            vec) => (contains #{1 2 3 4 5}))

       (fact
-       "distinct returns distinct elements of an RDD with the give number of partitions"
+       "distinct returns distinct elements of an RDD with the given number of partitions"
        (-> (f/parallelize c [1 2 1 3 4 5 4])
            (f/distinct 2)
            f/collect
@@ -281,10 +281,10 @@

       (fact
         "glom returns an RDD created by coalescing all elements within each partition into a list"
-        (-> (f/parallelize c [[1] [2] [3] [4] [5]])
+        (-> (f/parallelize c [[1] [2] [3] [4] [5]] 1)
             f/glom
             f/collect
-            vec) => [[[1]] [[2]] [[3]] [[4] [5]]])
+            vec) => (just [[[1] [2] [3] [4] [5]]] :in-any-order))

       (fact
         "cache persists this RDD with a default storage level (MEMORY_ONLY)"


Notes.

Notes.

--- src/defragment/core.clj
+++ src/defragment/core.clj
@@ -228,6 +228,7 @@
   (let [n (.name f)
         v (.value f)]
     (and (= "TITLE" n)
+         ;; TODO: bikeshed with (some? [#(pred) #(pred) empty?] (st/trim v))
          (or (= "Unknown" (st/trim v))
              (= "%Y-%m-%d" (st/trim v))
              (empty? v)))))


Whitespace

Whitespace

--- src/detritus/update.clj
+++ src/detritus/update.clj
@@ -1,4 +1,6 @@
-(ns detritus.update)
+(ns detritus.update
+  "A collection of helper functions useful for updating and
+  conditionally updating datastructures.")

 (defn map-vals
   "λ {A → B} → (λ B → more* → C) → more* → {A → C}
@@ -7,8 +9,8 @@
   keys of m to (apply f (get m k) args)."
   [m f & args]
   (->> (for [[k v] m]
-         [k (apply f v args)])
-       (into {})))
+       [k (apply f v args)])
+     (into {})))

 (defn fix


Only use .get_trailing when using the converter

--- src-cljs/frontend/models/action.cljs
+++ src-cljs/frontend/models/action.cljs
@@ -53,21 +53,23 @@
         converter (->> output :type keyword (new-converter action))
         plain-style {:color "white" :italic false :bold false}

-        [style-map converted-message] (cond
-                                        (:truncated-client-side? action)
-                                        [plain-style html-escaped-message]

-                                        (> (count stripped-message) (+ 1000 (count html-escaped-message)))
-                                        [plain-style stripped-message]
+        [style-map converted-message trailing-out] (cond
+                                                   (:truncated-client-side? action)
+                                                   [plain-style html-escaped-message html-escaped-message]

-                                        :else ; colorize it
-                                        [(utils/js->clj-kw (.currentState converter))
-                                         (.append converter html-escaped-message)])]
+                                                   (> (count stripped-message) (+ 1000 (count html-escaped-message)))
+                                                   [plain-style stripped-message stripped-message]
+
+                                                   :else ; colorize it
+                                                   [(utils/js->clj-kw (.currentState converter))
+                                                    (.append converter html-escaped-message)
+                                                    (.get_trailing converter)])]
     (-> action
         (assoc-in [:output output-index :converted-message] converted-message)
         (assoc-in [:output output-index :react-key] (utils/uuid))
         (assoc-in [:converters-state (keyword (:type output))]
-                  (merge style-map {:converted-output (.get_trailing converter)})))))
+                  (merge style-map {:converted-output trailing-out})))))

 (defn format-latest-output [action]
   (if-let [output (seq (:output action))]


Forcing reload of template namespace during reloading.

This will ensure that we get updated html file templates. Still not sure
exactly who is doing the caching but I think it is enlive.

--- dev/user.clj
+++ dev/user.clj
@@ -19,4 +19,5 @@

 (defn load-and-go []
   (load "reloaded")
+  (require 'ahnentafel.server.pages :reload) ;; to force refresh on templates
   ((ns-resolve *ns* 'go)))


not derefing action

not derefing action

--- src-cljs/frontend/components/build_steps.cljs
+++ src-cljs/frontend/components/build_steps.cljs
@@ -126,8 +126,8 @@
                                     header-classes)
                            ;; TODO: figure out what to put here
                            :on-click #(raise! owner [:action-log-output-toggled
-                                                     {:index (:index @action)
-                                                      :step (:step @action)
+                                                     {:index (:index action)
+                                                      :step (:step action)
                                                       :value (not visible?)}])}
               [:div.button {:class (when (action-model/has-content? action)
                                      header-classes)}


Link back to search results when applicable

--- src-cljs/frontend/components/documentation.cljs
+++ src-cljs/frontend/components/documentation.cljs
@@ -175,7 +175,11 @@
         (om/build docs-categories (categories docs))]
        [:article
         (om/build docs-search app)
-        (cond
-         (= subpage :search) (om/build search-results query-results {:opts {:query query}})
-         subpage (om/build docs-subpage doc {:opts {:_fragment fragment}})
-         :else (om/build front-page app))]]])))
+        (if (= subpage :search)
+          (om/build search-results query-results {:opts {:query query}})
+          [:div
+           (when query
+             [:p [:a {:href "/docs/search"} (gstring/format "Back to search results for \"%s\"" query)]])
+           (if subpage
+             (om/build docs-subpage doc {:opts {:_fragment fragment}})
+             (om/build front-page app))])]]])))


refactor code

refactor code

--- src/k_means/cluster.clj
+++ src/k_means/cluster.clj
@@ -3,11 +3,6 @@
   (:gen-class)
   (:require [taoensso.timbre.profiling :as profiling :refer (p profile)])
   (:require [k-means.vector :as vector]))
-
-(defn mean
-  "Retrieve the mean value of a list"
-  [l]
-  (float (/ (reduce + l) (count l))))

 (defn mean-2dvec
   [v]
@@ -75,22 +70,27 @@
       :else
       a)))

-(defn -dist-cluster
-  "perform recursive clustering"
-  ([l c] (-dist-cluster l c []))
+(defn cluster-m
+  "take a list of vectors and cluster on centroids c via distance"
+  ([l c] (cluster l c (vector/make-vector (count c))))
   ([l c a]
     (cond
       (empty? l) a
+      ; otherwise we continue until the list of vectors is empty
       (not-empty l)
-        (let [i (min-index (p :min-distance-p (min-distance-p c (first l))))]
-          (recur (rest l) c (conj a (first l)))))))
+        ; for the vector at the start of the list, choose a centroid which is closest
+        (let [i (min-index (p :min-distance (min-distance-p c (first l))))]
+          ; append the vector to the smallest distance
+          (recur (rest l) c (assoc a i (conj (nth a i) (first l)))))
+      :else
+      a)))

-(defn -group-clusters
+(defn group-clusters
   "group a list of cluster groups into one cluster group"
-  ([l] (-group-clusters l (vector/make-vector (count l)) 0))
+  ([l] (group-clusters l (vector/make-vector (count l)) 0))
   ([l a i]
     (cond
-      (empty? l) (pmap first a)
+      (empty? l) (vec (pmap first a))
       :else
         (recur (rest l) (assoc a i (conj (nth a i) (nth (first l) i))) (inc i)))))

@@ -98,5 +98,5 @@
   "take a list of vectors and cluster on centroids c via distance in parallel"
   ([l c] (cluster-p l c []))
   ([l c a]
-    (let [clusters (for [i (partition-all (int (/ (count l) (count c))) l) :let [m (future (p :cluster (cluster i c)))]] (deref m))]
-      (p :group-clusters (-group-clusters clusters)))))
+    (let [clusters (for [i (partition-all (int (/ (count l) (count c))) l) :let [m (future (p :cluster (cluster-m i c)))]] (deref m))]
+      (p :group-clusters (group-clusters clusters)))))