latest version of systems toolbox

latest version of systems toolbox

--- Clojure-Websockets/MainApp/project.clj
+++ Clojure-Websockets/MainApp/project.clj
@@ -7,7 +7,7 @@
                  [clojurewerkz/elastisch "2.2.0-beta2"]
                  [org.clojure/tools.logging "0.3.1"]
                  [com.matthiasnehlsen/inspect "0.1.12"]
-                 [matthiasn/systems-toolbox "0.1.9-SNAPSHOT"]
+                 [matthiasn/systems-toolbox "0.1.10-SNAPSHOT"]
                  [org.clojure/tools.namespace "0.2.10"]
                  [ch.qos.logback/logback-classic "1.1.2"]
                  [com.taoensso/sente "1.4.1"]


bugfix: :?wrapper didn't convert keywords to strings for react

--- src/ez_form/decorate.cljc
+++ src/ez_form/decorate.cljc
@@ -118,7 +118,7 @@
   ;; clojurescript needs to decorate with a key for react's sake
   #?(:cljs (let [node (zip/node loc)
                  field (get-field form node :wrapper)
-                 options (merge {:key (or (:id field) (:name field))}
+                 options (merge {:key (kw->string (or (:id field) (:name field)))}
                                 (if (and (not (nil?  (:errors field)))
                                          (not (nil? @(:cursor field))))
                                   (get-material form node (material node))))]


Adjust up/down keybind impls to account for upstream changes

--- src/flense_nw/keymap.cljs
+++ src/flense_nw/keymap.cljs
@@ -9,10 +9,10 @@
             [xyzzy.core :as z]))

 (def keymap
-  {#{:down} text/down
+  {#{:down} (some-fn text/begin-editing completions/next-completion z/down)
    #{:left} z/left-or-wrap
    #{:right} z/right-or-wrap
-   #{:up} text/up
+   #{:up} (some-fn text/cease-editing completions/prev-completion z/up)
    #{:shift :left} z/prev
    #{:shift :right} z/next
    #{:meta :shift :k} model/prev-placeholder


Remove duplicate spec

Remove duplicate spec

--- test/tictactoe/core_test.clj
+++ test/tictactoe/core_test.clj
@@ -52,9 +52,6 @@
   (testing "Winning when in danger of losing"
     (is (= (cpu-move ["" "O" "O" "" "" "" "X" "X" ""] "X") 9)))

-  (testing "Winning when in danger of losing"
-    (is (= (cpu-move ["" "O" "O" "" "" "" "X" "X" ""] "X") 9)))
-
   (testing "Setting up some great opportunities with a corner move"
     (is (= (cpu-move ["X" "" "" "" "O" "" "" "" ""] "O") 9)))


Add a coupla handy reflective fn's: port and profile-active?

--- namespaces/common/src/main/clojure/immutant/util.clj
+++ namespaces/common/src/main/clojure/immutant/util.clj
@@ -80,21 +80,21 @@
   unsecure-interface-address
   (partial lookup-interface-address :unsecure))

+(defn port
+  "Returns the (possibly offset) port from the socket-binding in standalone.xml"
+  [socket-binding-name]
+  (if-let [sb (registry/get (str "jboss.binding." (name socket-binding-name)))]
+    (.getAbsolutePort sb)))
+
 (defn http-port
   "Returns the HTTP port for the embedded web server"
   []
-  (if-let [server (registry/get "jboss.web.connector.http")]
-    (.getPort server)))
+  (port :http))

 (defn hornetq-remoting-port
   "Returns the port that HornetQ is listening on for remote connections"
   []
-  (-> (ManagementFactory/getPlatformMBeanServer)
-      (.getAttribute
-       (ObjectName. "org.hornetq:module=Core,type=Acceptor,name=\"netty\"")
-       "Parameters")
-      (get "port")
-      (Integer.)))
+  (port :messaging))

 (defn context-path
   "Returns the HTTP context path for the deployed app"
@@ -210,8 +210,17 @@
     (apply deref v args)
     v))

+(defn profile-active?
+  "Returns true if the leiningen profile is active"
+  [id]
+  (and (->> (registry/get :project)
+            meta
+            :active-profiles
+            (some #{(keyword id)}))
+       true))
+
 (defn dev-mode?
   "Returns true if the app is running in dev mode."
   []
-  (not (or (System/getenv "LEIN_NO_DEV")
-           (->> (registry/get :project) meta :active-profiles (not-any? #{:dev})))))
+  (and (not (System/getenv "LEIN_NO_DEV"))
+       (profile-active? :dev)))


Update open to be backwards compatible for urls

A number of plugins rely on platform/open to open urls -
https://github.com/search?p=3&q=objs.platform+open+language%3Aclojure&ref=searchresults&type=Code&utf8=%E2%9C%93.
Also couldn't use files in platform for exists check since that created
a circular dependency

--- src/lt/objs/platform.cljs
+++ src/lt/objs/platform.cljs
@@ -5,6 +5,7 @@

 (def atom-shell true)

+(def fs (js/require "fs"))
 (def clipboard (js/require "clipboard"))
 (def shell (js/require "shell"))

@@ -17,11 +18,16 @@
     "linux" :linux
     "darwin" :mac))

-(defn open [path]
-  (.openItem shell path))
-
 (defn open-url [path]
   (.openExternal shell path))
+
+(defn open
+  "If the given path exists, open it with the desktop's default manner.
+  Otherwise, open it as an external protocol e.g. a url."
+  [path]
+  (if (.existsSync fs path)
+    (.openItem shell path)
+    (open-url path)))

 (defn show-item [path]
   (.showItemInFolder shell path))


Some fillers

Some fillers

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -393,11 +393,16 @@
              :custom put-and-take-slide
              :opts {:buffer-size 7 :font-size "72pt" :radius 50}}

-            {:subtitle "put and take with map"
+            {:subtitle "put and take with map< inc"
              :custom put-and-take-slide
              :ops :map
              :opts {:buffer-size 7 :font-size "72pt" :radius 50}}

+            ;; TODO "put and take with map> dec"
+            ;; TODO "put and take with filter
+
+            ;; TODO Now timeouts and alts
+
             {:subtitle "timeouts"
              :custom timeout-slide
              :opts {:font-size "72pt"}}
@@ -405,6 +410,8 @@
             {:subtitle "alts!"
              :custom alts-slide
              :opts {:font-size "30pt"}}
+
+            ;; TODO Now more explanation (filler) for go blocks

             {:subtitle "go blocks"
              :custom go-block-slide
@@ -413,6 +420,8 @@
                     :radius 60 :font-size "40pt"}
              }

+            ;; TODO Slow down catch game
+
             #_{:subtitle "catch game"
              :custom catch-game-slide
              :opts {:width 600 :height 600
@@ -420,11 +429,14 @@
                     :radius 30 :font-size "20pt"}
              }

-            ;; TODO Show source code from cljs sources on disk - via cljs - use different namespaces
-
             ;; TODO result of race in alts! between a channel and a timeout

             ;; Go blocks
+
+            ;; Now a Hecuba table (one hour on this, to create a data set for order/orderlines and a diagram)
+
+            {:title "Why core.async?"
+             :text "(it's about decoupling)"}

             {:title "References"
              :text "Some free software projects using core.async"}


tweaks

tweaks

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -635,9 +635,9 @@
                       :radius 30 :font-size "20pt"}}

             {:subtitle "And that's not all!"
-             :bullets ["Mixers"
-                       "Pub/sub"
-                       "https://github.com/clojure/core.async.git"]}
+             :bullets ["Multiplexing"
+                       "Mixers"
+                       "Pub/sub"]}

             ;; TODO result of race in alts! between a channel and a timeout

@@ -676,7 +676,7 @@
              :url "https://github.com/OpenSensorsIO/azondi"
              :bullets ["Builds on MQTT Broker"
                        "Designed for IoT volume traffic"
-                       "Uses LMAX disruptor"
+                       "Uses LMAX disruptor patterns"
                        "Advanced routing logic"]}

             ;; TODO Don't forget to mention Hecuba and Stentor (that they're free software)


- rule: s-modifier-modifier-last

- rule: s-modifier-modifier-last

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -266,24 +266,6 @@
                                                    :subcat '()
                                                    :sem head-sem}}
                                    :rule "s-modified-modifier-first"}))
-
-                   (unify-check h00
-                                modified
-                                (let [head-sem (atom :top)
-                                      head-infl (atom :top)]
-                                  {:synsem {:subcat '()
-                                            :infl head-infl
-                                            :sem head-sem
-                                            :cat :verb}
-                                   :comp {:synsem {:cat :prep
-                                                   :subcat '()
-                                                   :sem head-sem}}
-                                   :head {:modified false
-                                          :synsem {:cat :verb
-                                                   :infl head-infl
-                                                   :subcat '()
-                                                   :sem head-sem}}
-                                   :rule "s-modified-modifier-last"}))

                    (unify-check c10
                                 root-is-head-root


fix typo in "write"

fix typo in "write"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2476,7 +2476,7 @@
    "write"  {:english {:past "wrote"
                        :past-participle "written"}
              :synsem {:cat :verb
-                      :sem {:pred :write}}}
+                      :sem {:pred :scrivere}}}

    "yell" {:synsem {:cat :verb
                     :sem {:pred :yell}


+(defn transform-with-english-lexical-rules) : refactor (defn deliver-lexicon):

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -13,6 +13,7 @@

 (declare exception-generator)
 (declare phonize)
+(declare transform-with-english-lexical-rules)

 ;; TODO: allow a filter of lexemes
 (defn deliver-lexicon []
@@ -20,10 +21,16 @@
    (edn2lexicon (resource "babel/english/lexicon.edn"))
    (compile-lex)

+   (transform-with-english-lexical-rules)))
+
+
+(defn transform-with-english-lexical-rules [lexicon]
+  (->
+   lexicon
    (map-function-on-map-vals
     (fn [lexical-string lexical-val]
       (phonize lexical-val lexical-string)))
-
+
    ((fn [lexicon]
       (merge-with concat lexicon
                   (listify
@@ -408,7 +415,7 @@

    ;; </prep default rules>

-   ))
+ ))

 (defn exception-generator
   "_lexicon_ is a map where each key is a root form (a string) mapped to a set of lexical entries (maps) for that root form.


Cleanup domain if it failed to load new data as well.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -193,11 +193,9 @@

 (defn- close-if-updated [domain domains-info local-config new-data]
   (if new-data
-    (do
-      (close-domain domain domains-info)
-      (cleanup-domain domain domains-info local-config)
-      new-data)
-    new-data))
+    (close-domain domain domains-info))
+  (cleanup-domain domain domains-info local-config)
+  new-data)

 (defn- update-domains [all-domains domains-info global-config local-config]
   (let [max-kbs 8192


fix for badge image context

fix for badge image context

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -281,12 +281,13 @@
                                        (get-in badge [:criteria :narrative]
                                                (http/alternate-get "text/x-markdown" criteria-url))
                                        (http/alternate-get "text/x-markdown" (:criteria badge)))
-                       creator-url (get-in badge [:extensions:OriginalCreator :url])]
+                       creator-url (get-in badge [:extensions:OriginalCreator :url])
+                       image (if (map? (:image badge)) (get-in badge [:image :id]) (:image badge))]

                    {:content  [{:id ""
                                 :language_code language
                                 :name (:name badge)
-                                :image_file (:image badge)
+                                :image_file image
                                 :description (:description badge)
                                 :alignment (get-alignment badge)
                                 :tags (get badge :tags [])}]


Move scenario info printing to main thread for avoiding texts to mix up together

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -96,18 +96,13 @@
     c))

 (defn run-scenario [timeout scenario]
-  (let [concurrency        (:concurrency scenario)
-        number-of-requests (:number-of-requests scenario)]
-    (println "Running scenario" (:name scenario)
-             "with concurrency" concurrency
-             "and" (runner-info (:runner scenario)) ".")
-    (let [scenario-start (local-time/local-now)
-          response-chan (async/merge (map #(run-scenario-constantly scenario timeout %)
-                                          (range concurrency)))]
-      (loop [responses []]
-        (if (continue-run? (:runner scenario) (count responses) scenario-start)
-          (recur (conj responses (response->result scenario (<!! response-chan))))
-          responses)))))
+  (let [scenario-start (local-time/local-now)
+        response-chan (async/merge (map #(run-scenario-constantly scenario timeout %)
+                                        (range (:concurrency scenario))))]
+    (loop [responses []]
+      (if (continue-run? (:runner scenario) (count responses) scenario-start)
+        (recur (conj responses (response->result scenario (<!! response-chan))))
+        responses))))

 (defn- distinct-request-count [scenarios]
   (reduce + (map #(count (:requests %)) scenarios)))
@@ -125,8 +120,16 @@
           concurrencies
           requests)))

+(defn- print-scenario-info [scenario]
+  (let [concurrency        (:concurrency scenario)
+        number-of-requests (:number-of-requests scenario)]
+    (println "Running scenario" (:name scenario)
+             "with concurrency" concurrency
+             "and" (runner-info (:runner scenario)) ".")))
+
 (defn run-scenarios [timeout scenarios]
   (let [results (doall (map (fn [scenario]
+                              (print-scenario-info scenario)
                               (thread (run-scenario timeout scenario)))
                         scenarios))]
     (mapcat #(<!! %) results)))


display names of container steps

display names of container steps

--- src/cljs/lambdacd/ui_core.cljs
+++ src/cljs/lambdacd/ui_core.cljs
@@ -45,14 +45,24 @@
      [:h2 "Builds"]
      [:ul (map history-item-component history-to-display)]]))

+(declare build-step-component)
+
+
+(defn container-build-step-component [step-id status children name output-atom ul-or-ol]
+  [:li {:key step-id :data-status status }
+   [:span name]
+   [ul-or-ol (map #(build-step-component  % output-atom) children)]])
+
 (defn build-step-component [build-step output-atom]
   (let [step-id (str (:step-id build-step))
-        status (:status (:result build-step))]
+        status (:status (:result build-step))
+        name (:name build-step)
+        children (:children build-step)]
     (case (:type build-step)
-      "parallel"  [:li {:key step-id :data-status status } [:ul (map #(build-step-component  % output-atom)(:children build-step))]]
-      "container" [:li {:key step-id :data-status status} [:ol (map #(build-step-component % output-atom) (:children build-step))]]
+      "parallel"  (container-build-step-component step-id status children name output-atom :ul)
+      "container" (container-build-step-component step-id status children name output-atom :ol)
        [:li { :key step-id :data-status status :on-click #(reset! output-atom (:out (:result build-step)))}
-             [:span (:name build-step)]
+             [:span name]
              [:i {:class "fa fa-play trigger"}]
              [:i {:class "fa fa-repeat retrigger"}]])))


Test for coll? on input values

Test for coll? on input values

--- services/mailp2.clj
+++ services/mailp2.clj
@@ -11,8 +11,12 @@
                  msgs (for [retmap result-maps]
                         (let [name (retmap :name)
                               [bams csv] (retmap :value)
-                              bams (map fs/basename bams)
-                              csv (fs/basename csv)
+                              bams (if (coll? bams)
+                                     (map fs/basename bams)
+                                     (fs/basename bams))
+                              csv (if (coll? bams)
+                                    (map fs/basename csv)
+                                    (fs/basename csv))
                               exit (retmap :exit)
                               err (retmap :err)]
                           (if (= exit :success)


change present-package-satisfies? to actually return a present package

--- src/degasolv/resolver_core.clj
+++ src/degasolv/resolver_core.clj
@@ -235,19 +235,19 @@
    spec
    safe-spec-call
    status]
-  (reduce
-   #(or %1 %2)
-   false
+  (some
+   #(when (not (nil? %)) %)
    (map
     (fn [present-id-package]
       (let [present-package-test
             (safe-spec-call
              spec
              present-id-package)]
-        (or (and (= status :absent)
+        (when (or (and (= status :absent)
                        (not present-package-test))
                   (and (= status :present)
-                       present-package-test))))
+                       present-package-test))
+          present-id-package)))
     present-id-packages)))

 (defn resolve-dependencies


fix log messages at level DEBUG

fix log messages at level DEBUG

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -261,20 +261,20 @@
   [rules spec]
   (filter not-fail?
           (mapfn (fn [rule]
-                   (log/debug (str "candidate-parents: testing rule: " @(:rule rule)))
+                   (log/debug (str "candidate-parents: testing rule: " (:rule rule)))
                    (if (not-fail? (unify (get-in rule [:synsem :cat] :top)
                                          (get-in spec [:synsem :cat] :top)))
                      ;; TODO: add checks for [:synsem :subcat] valence as well as [:synsem :cat].
                      (do
-                       (log/debug (str "candidate-parents: " @(:rule rule) " is a cat-wise candidate for spec:"
+                       (log/debug (str "candidate-parents: " (:rule rule) " is a cat-wise candidate for spec:"
                                        (strip-refs spec)))
                        (let [unified (unify spec rule)]
                          (if (= :fail unified)
-                           (log/debug (str "candidate parent: " @(:rule rule) " failed at:" (fail-path spec rule)))
-                           (log/debug (str "candidate parent: " @(:rule rule) " unified successfully with spec:" (strip-refs spec))))
+                           (log/debug (str "candidate parent: " (:rule rule) " failed at:" (fail-path spec rule)))
+                           (log/debug (str "candidate parent: " (:rule rule) " unified successfully with spec:" (strip-refs spec))))
                          unified))
                      (do
-                       (log/debug (str "candidate-parents: " @(:rule rule) " is *not* a head candidate for spec:"
+                       (log/debug (str "candidate-parents: " (:rule rule) " is *not* a head candidate for spec:"
                                        spec))
                        :fail)))
                  rules)))


Defaults for hard coded container ID's.

Defaults for hard coded container ID's.

--- src/oc/storage/config.clj
+++ src/oc/storage/config.clj
@@ -110,9 +110,8 @@
     :table-prefix dynamodb-table-prefix
   })

-(defonce seen-home-container-id (env :seen-home-container-id))
-
-(defonce seen-replies-container-id (env :seen-replies-container-id))
+(defonce seen-home-container-id (or (env :seen-home-container-id) "1111-1111-1111"))
+(defonce seen-replies-container-id (or (env :seen-replies-container-id) "1111-1111-2222"))

 (defonce unread-days-limit (or (env :unread-days-limit) 30))


Extract shallow-render

Extract shallow-render

--- src-cljs/frontend/gencard.cljs
+++ src-cljs/frontend/gencard.cljs
@@ -16,29 +16,25 @@
                (remove (conj ignored-props "children")
                        (gobject/getKeys props))))))

+(defn- shallow-render
+  "Shallow-renders the component factory. If the factory actually returns a
+  React DOM element rather than a custom component element, returns that."
+  [factory props & children]
+  (let [elt (apply factory props children)]
+    (if (string? (gobject/get elt "type"))
+      elt
+      (let [renderer (js/React.addons.TestUtils.createRenderer)]
+        (.render renderer elt)
+        (.getRenderOutput renderer)))))
+
 (defn morph-data
   ([component-factory-var] (morph-data component-factory-var {}))
   ([component-factory-var overrides]
    (let [sample-size 100
-
          spec (:args (s/get-spec component-factory-var))
-
-         ;; Wrap the factory. If it's a simple function returning a React DOM
-         ;; element (an element with a string type), keep it as is. Otherwise
-         ;; we've got a composite element (one whose type is a class), and we
-         ;; need to (shallow) render it to get DOM elements to examine.
-         component-factory
-         (fn [props & children]
-           (let [elt (apply (deref component-factory-var) props children)]
-             (if (string? (gobject/get elt "type"))
-               elt
-               (let [renderer (js/React.addons.TestUtils.createRenderer)]
-                 (.render renderer elt)
-                 (.getRenderOutput renderer)))))
-
          groups (->> (gen/sample-seq (s/gen spec overrides))
                      (take sample-size)
-                     (group-by (comp signature (partial apply component-factory))))]
+                     (group-by (comp signature (partial apply shallow-render (deref component-factory-var)))))]
      (when (> sample-size (count groups))
        (->> groups
             (sort-by (comp hash key))


diagnostics

diagnostics

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -140,48 +140,52 @@
 (defn generate-all [spec grammar lexicon index morph & [total-depth]]
   (log/debug (str "generate-all: generating from spec: "
                  (strip-refs spec)))
-  (let [total-depth (if total-depth total-depth 0)
-        add-complements-to-bolts
-        (fn [bolts path]
-          (log/debug (str "generate-all: "
-                          "add-complements-to-bolts@" path ": first bolt:"
-                          (show-bolt (first bolts) path morph)))
-          (mapcat
-           #(if (not (= :none (get-in % path :none)))
-              (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
-              [%])
-           bolts))
-
-        expressions
-        (-> (lightning-bolt grammar
-                            lexicon
-                            spec 0 index morph total-depth)
-            ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
-            (add-complements-to-bolts [:head :head :head :comp] )
-            (add-complements-to-bolts [:head :head :comp])
-            (add-complements-to-bolts [:head :comp])
-            (add-complements-to-bolts [:comp]))]
-
-    (if (not (empty? expressions))
-      (log/debug
-       (str "generate-all: first expression generated for spec:"
-            (strip-refs (if (seq? spec)
-                          (first spec)
-                          spec))
-            ":"
-            "'" (morph (first expressions)) "'"))
-
-      ;; no expression could be generated.
-      (let [error-message
-            (str "generate-all: no expressions could be generated for spec:"
-                 (strip-refs (if (seq? spec)
-                               (first spec)
-                               spec)))]
-        (log/error error-message)
-        (exception error-message)))
-    (map (fn [expr]
-           (truncate expr [[:head][:comp]]))
-         expressions)))
+  (if (= false (get-in spec [:phrasal] true))
+    nil
+    ;; else, phrasal:
+    (let [total-depth (if total-depth total-depth 0)
+          add-complements-to-bolts
+          (fn [bolts path]
+            (log/debug (str "generate-all: "
+                            "add-complements-to-bolts@" path ": first bolt:"
+                            (show-bolt (first bolts) path morph)))
+            (mapcat
+             #(if (not (= :none (get-in % path :none)))
+                (lazy-seq (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path))))
+                [%])
+             bolts))
+
+          expressions
+          (lazy-seq
+           (-> (lightning-bolt grammar
+                               lexicon
+                               spec 0 index morph total-depth)
+               ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
+               (add-complements-to-bolts [:head :head :head :comp] )
+               (add-complements-to-bolts [:head :head :comp])
+               (add-complements-to-bolts [:head :comp])
+               (add-complements-to-bolts [:comp])))]
+
+      (if (not (empty? expressions))
+        (log/debug
+         (str "generate-all: first expression generated for spec:"
+              (strip-refs (if (seq? spec)
+                            (first spec)
+                            spec))
+              ":"
+              "'" (morph (first expressions)) "'"))
+
+        ;; no expression could be generated.
+        (let [error-message
+              (str "generate-all: no expressions could be generated for spec:"
+                   (strip-refs (if (seq? spec)
+                                 (first spec)
+                                 spec)))]
+          (log/error error-message)
+          (exception error-message)))
+      (map (fn [expr]
+             (truncate expr [[:head][:comp]]))
+           expressions))))

 (defn candidate-parents [rules spec]
   "find subset of _rules_ for which each member unifies successfully with _spec_"
@@ -198,7 +202,7 @@
                                                 (get-in spec [:synsem :modified] :top)))))
                      (unifyc spec rule)
                      :fail))
-                 (shuffle rules))))
+                 (lazy-seq (shuffle rules)))))

 (defn lightning-bolt [grammar lexicon spec depth index morph total-depth]
   "Returns a lazy-sequence of all possible trees given a spec, where
@@ -217,10 +221,18 @@
         (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
               (mapcat (fn [parent]
                         (if (= false (get-in parent [:head :phrasal] false))
-                          (let [candidate-lexemes (get-lex parent :head index spec)
-                                results (over/overh parent (mapfn copy candidate-lexemes))]
-                            (log/debug (str "lightning-bolt: " (get-in parent [:rule]) ": first candidate head lexeme:'"
-                                            (morph (first candidate-lexemes)) "'"))
+                          (let [candidate-lexemes (lazy-seq (get-lex parent :head index spec))
+                                results (filter #(not (nil? %))
+                                                (over/overh parent (mapfn copy candidate-lexemes)))]
+                            (log/debug (str "lightning-bolt: " (get-in parent [:rule])
+                                            ": first candidate head lexeme:'"
+                                            (let [fo (morph (first candidate-lexemes))]
+                                              (if (or (nil? fo)
+                                                      (= '' (trim fo)))
+                                                (str "NOTHING: '" (get-in (first candidate-lexemes)
+                                                                          [:english :english]) "'")
+                                                (str fo)))
+                                            "'"))
                             results)))
                       parents)
               phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
@@ -241,13 +253,13 @@
         spec (unifyc spec (get-in bolt path))
         immediate-parent (get-in bolt (butlast path))
         start-time (current-time)
-        cached (if cache
-                 (get-lex immediate-parent :comp cache spec)
-                 (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
-                     (reduce concat (vals lexicon))))
         complement-candidate-lexemes (if (not (= true
                                                  (get-in bolt (concat path [:phrasal]))))
-                                       (if cached cached (flatten (vals lexicon))))
+                                       (let [cached (if cache
+                                                      (lazy-seq (get-lex immediate-parent :comp cache spec))
+                                                      (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
+                                                          nil))]
+                                         (if cached cached (flatten (vals lexicon)))))
         complement-pre-check (fn [child parent path-to-child]
                                (let [child-in-bolt (get-in bolt path-to-child)
                                      result (not (fail?
@@ -261,7 +273,7 @@
         debug (log/debug
                (if (not (empty? filtered-lexical-complements))
                  (str "add-complement: " (show-bolt bolt path morph) ":candidate first complement-lexemes:'"
-                      (morph (first filtered-lexical-complements))) "'"))]
+                      (morph (first filtered-lexical-complements)) "'")))]
     (filter (fn [complement]
               (if (fail? complement)
                 (do


avoid excessive dag-copying

avoid excessive dag-copying

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -6,7 +6,7 @@
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [clojure.string :as string]
-   [dag_unify.core :refer [copy get-in fail? strip-refs unify]]))
+   [dag_unify.core :refer [copy get-in fail? strip-refs unify unify!]]))

 ;; during generation, will not decend deeper than this when creating a tree:
 ;; TODO: should also be possible to override per-language.
@@ -225,9 +225,9 @@
     (filter #(not-fail? %)
             (mapfn (fn [complement]
                      (let [unified
-                           (unify (copy bolt)
-                                  (assoc-in {} path
-                                            (copy complement)))]
+                           (unify! (copy bolt)
+                                   (assoc-in {} path
+                                             (copy complement)))]
                        (if truncate-children
                          (truncate unified [path] language-model)
                          unified)))


Make perform action have a more clojure oriented API

--- src/beehive/service.clj
+++ src/beehive/service.clj
@@ -29,7 +29,8 @@
                                       RejectedActionException
                                       Services
                                       ServiceProperties
-                                      Service)))
+                                      Service)
+           (net.uncontended.precipice.timeout ActionTimeoutException)))

 (set! *warn-on-reflection* true)

@@ -77,9 +78,14 @@
         (f/rejected-action-future (.reason e)))))
   (run-action [_ action-fn]
     (try
-      (.run service (c/wrap-action-fn action-fn))
+      (let [result (.run service (c/wrap-action-fn action-fn))]
+        {:status :success :result result :success? true})
       (catch RejectedActionException e
-        (c/rejected-exception->reason e))))
+        {:status :rejected :rejected? true :reason (c/rejected-exception->reason e)})
+      (catch ActionTimeoutException _
+        {:status :timeout :timeout? true})
+      (catch Throwable e
+        {:status :error :error e :error? true})))
   (metrics [this]
     (let [{:keys [slots-to-track resolution time-unit]} metrics-config]
       (metrics this (* slots-to-track resolution) time-unit)))


Should not add the extra translation of 'origin-x, origin-y'

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -21,8 +21,7 @@

 (defrecord TextureEntity [object] Entity
   (draw! [{:keys [^TextureRegion object x y width height
-                  scale-x scale-y angle origin-x origin-y color
-                  translate-x translate-y]}
+                  scale-x scale-y angle color translate-x translate-y]}
           _
           batch]
     (let [x (float (or x 0))
@@ -36,10 +35,8 @@
       (if (or scale-x scale-y angle)
         (let [scale-x (float (or scale-x 1))
               scale-y (float (or scale-y 1))
-              origin-x (float (or origin-x (/ width 2)))
-              origin-y (float (or origin-y (/ height 2)))
               angle (float (or angle 0))]
-          (.draw ^Batch batch object (+ x translate-x) (+ y translate-y) origin-x origin-y width height
+          (.draw ^Batch batch object (+ x translate-x) (+ y translate-y) 0 0 width height
             scale-x scale-y angle))
         (.draw ^Batch batch object (+ x translate-x) (+ y translate-y) width height))
       (when color


add detailed help for specific commands

add detailed help for specific commands

--- src/cake/tasks/help.clj
+++ src/cake/tasks/help.clj
@@ -1,15 +1,37 @@
 (ns cake.tasks.help
   (:use cake))

+(def line "-------------------------------------------")
+
+(defn print-task [name deps docs]
+  (println line)
+  (let [deps (if (seq deps) (cons "=>" deps) deps)]
+    (apply println "cake" name deps)
+    (doseq [doc docs] (println " ;;" doc))))
+
+(defn task-doc [& syms]
+  (doseq [sym syms]
+    (if-let [task (@tasks sym)]
+      (print-task sym (:deps task) (:doc task))
+      (if-let [doc (implicit-tasks sym)]
+        (print-task sym [] [doc])
+        (println "unknown task:" sym)))))
+
+(defn taskdocs [all?]
+  (into implicit-tasks
+        (for [[sym task] @tasks :when (and (not= 'default sym) (or all? (seq (:doc task))))]
+          [sym (str (first (:doc task)))])))
+
+(defn list-all-tasks []
+  (println line)
+  (let [taskdocs (taskdocs (:a opts))
+        width    (apply max (map #(count (name (first %))) taskdocs))
+        taskdoc  (str "cake %-" width "s  ;; %s")]
+    (doseq [[name doc] (sort-by first taskdocs)]
+      (println (format taskdoc name doc)))))
+
 (deftask help
   "Print tasks with documentation (use -a for all tasks)."
-  (println "-------------------------------------------")
-  (let [all?     (:a opts)
-        taskdocs (for [[sym task] @tasks :when (and (not= 'default sym) (or all? (seq (:doc task))))]
-                   [sym (str (first (:doc task)))])
-        taskdocs (into implicit-tasks taskdocs)
-        width  (apply max (map #(count (name (first %))) taskdocs))
-        format (str "cake %-" width "s  ;; %s\n")]
-    (doseq [[name doc] (sort-by first taskdocs)]
-      (printf format name doc))
-    (flush)))+  (if-let [names (:help opts)]
+    (apply task-doc (map symbol names))
+    (list-all-tasks)))


adding docker nodes

adding docker nodes

--- src/celestial/model.clj
+++ src/celestial/model.clj
@@ -42,8 +42,9 @@
     (fn [r k] (if-let [v (get-in m k)] (assoc-in r k v) r)) {} ks))

 (def whitelist
-  [[:proxmox :nodes] [:proxmox :ostemplates] [:vcenter :ostemplates]
-   [:aws] [:physical]])
+  [[:proxmox :nodes] [:proxmox :ostemplates]
+   [:docker :nodes]
+   [:vcenter :ostemplates] [:aws] [:physical]])

 (defn sanitized-envs
   "sanitized (from sensative data) environments "


relax restriction that components must implement IQuery to transact

same as Om 5ab452f42303ae00a054802669c4b34890a5dfde

--- src/cellophane/next.clj
+++ src/cellophane/next.clj
@@ -886,20 +886,17 @@
    (let [tx (cond-> tx
               (and (component? x) (satisfies? Ident x))
               (annotate-mutations (get-ident x)))]
-     (if (reconciler? x)
-       (transact* x nil nil tx)
-       (do
-         (assert (iquery? x)
-           (str "transact! invoked by component " x
-             " that does not implement IQuery"))
-         (loop [p (parent x) x x tx tx]
-           (if (nil? p)
-             (let [r (get-reconciler x)]
-               (transact* r x nil (transform-reads r tx)))
-             (let [[x' tx] (if (satisfies? ITxIntercept p)
-                             [p (tx-intercept p tx)]
-                             [x tx])]
-               (recur (parent p) x' tx))))))))
+     (cond
+       (reconciler? x) (transact* x nil nil tx)
+       (not (iquery? x)) (transact* (get-reconciler x) nil nil tx)
+       :else (loop [p (parent x) x x tx tx]
+               (if (nil? p)
+                 (let [r (get-reconciler x)]
+                   (transact* r x nil (transform-reads r tx)))
+                 (let [[x' tx] (if (satisfies? ITxIntercept p)
+                                 [p (tx-intercept p tx)]
+                                 [x tx])]
+                   (recur (parent p) x' tx)))))))
   ([r ref tx]
    (transact* r nil ref tx)))


Update example.

Update example.

--- src/cli4clj/example.clj
+++ src/cli4clj/example.clj
@@ -34,8 +34,11 @@
   (cli/start-cli {:cmds {:test-cmd {:fn #(println "This is a test.")
 ;;;                                 Optionally a short information text can be given.
                                     :short-info "Test Command"
-;;;                                 Another long information text can be optionally given as well.
-                                    :long-info "Prints a test message to stdout."}
+;;;                                 In addition, a long information text can be optionally given.
+                                    :long-info "Prints a test message to stdout."
+;;;                                 Furthermore, a "hint" text can be defined for the tab-completion.
+                                    :completion-hint "This is a test command without arguments."
+                                   }
 ;;;                      "Aliases" can be used, e.g., for defining shortcuts by relating to existing commands.
 ;;;                      The order in which aliases and commands are defined does not matter.
 ;;;                      Just make sure that the alias refers to an existing command.
@@ -45,8 +48,9 @@
 ;;;                      However, no sanity checks, e.g., with respect to the number of arguments or the argument type(s), are performed.
 ;;;                      If things go wrong, exceptions will be thrown and printed.
                          :add  {:fn (fn [summand1 summand2] (+ summand1 summand2))
-                                :short-info "Add two values."}
-                                :a :add
+                                :short-info "Add two values."
+                                :completion-hint "Enter the value to add."}
+                         :a :add
 ;;;                      cli4clj already provides some pre-defined commands, from which some can overridden while others cannot.
 ;;;                      "h" is a pre-defined command but it can be overridden.
 ;;;                      This is shown by using the definition of an alias to test as example.
@@ -71,7 +75,7 @@
                                   :long-info "The first argument will be divided by the second argument."}
                          :d :divide
 ;;;                      The following example shows the use of optional arguments.
-;;;                      It can also be used to test how different types of inputs are treated.
+;;;                      In addition, it can also be used to test how different types of inputs are treated.
                          :print-cmd {:fn (fn [arg & opt-args]
                                            (print "Arg-type:" (type arg) "Arg: ")
                                            (pprint/pprint arg)
@@ -80,10 +84,15 @@
                                      :short-info "Pretty print the supplied arguments."
                                      :long-info "This function pretty prints its supplied arguments. It takes at least one argument."}
                          :p :print
+;;;                      Below is a test command to mimic asynchronous text output.
+;;;                      Such asynchronous output could occur, e.g., during network interaction with sockets or a middleware.
                          :print-repeat {:fn (fn [text interval]
                                               (utils/run-repeat (utils/executor) (fn [] (cli/with-alt-scroll-out (println text))) interval))
                                         :short-info "Repeatedly print text with the given interval in milliseconds."}}
                   :allow-eval true
                   :prompt-string "cli# "
+;;;               Since cli4clj version 1.6.0 an alternate scrolling mode is supported.
+;;;               By default the "old" scrolling is used.
+;;;               The new scrolling mode can be enabled by setting :alternate-scrolling to "true" or by specifying a corresponding "predicate function".
                   :alternate-scrolling (some #(= % "alt") args)
                   :alternate-height 3}))


CLJS-920 add-watch/remove-watch should return reference, as in Clojure

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -8380,14 +8380,16 @@
       (deref a)
       ;=> 1"
   [iref key f]
-  (-add-watch iref key f))
+  (-add-watch iref key f)
+  iref)

 (defn remove-watch
   "Alpha - subject to change.

   Removes a watch (set by add-watch) from a reference"
   [iref key]
-  (-remove-watch iref key))
+  (-remove-watch iref key)
+  iref)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; gensym ;;;;;;;;;;;;;;;;
 ;; Internal - do not use!


Properly clean up interval

Properly clean up interval

If unmount happened before the go loop finished, the interval would be
set asynchronously after will-unmount is called.

--- src/cljs/virt/home.cljs
+++ src/cljs/virt/home.cljs
@@ -36,23 +36,24 @@
     (will-mount [_]
       (when (empty? (:channels data))
         (om/set-state! owner :loading true))
-      (go
-        (let [loc (<! (get-geolocation))]
-          (om/update! data [:geolocation] loc)
-          (let [response (<! (http/get "/api/channels" {:query-params loc}))]
-            (om/update! data [:channels] (:body response))))
-        (om/set-state! owner :loading false)
-        (om/set-state! owner :poll-interval
-          (js/setInterval
-            #(go
-               (let [loc (<! (get-geolocation))]
-                 (om/update! data [:geolocation] loc)
-                 (let [response (<! (http/get "/api/channels" {:query-params loc}))]
-                   (om/update! data [:channels] (:body response)))))
-            3000))))
+      (om/set-state! owner :interval-chan
+        (go
+          (let [loc (<! (get-geolocation))]
+            (om/update! data [:geolocation] loc)
+            (let [response (<! (http/get "/api/channels" {:query-params loc}))]
+              (om/update! data [:channels] (:body response)))
+            (om/set-state! owner :loading false)
+            (js/setInterval
+              #(go
+                 ;(let [loc (<! (get-geolocation))]
+                 ;  (om/update! data [:geolocation] loc)
+                   (let [response (<! (http/get "/api/channels" {:query-params loc}))]
+                     (om/update! data [:channels] (:body response))))
+              3000)))))
     om/IWillUnmount
     (will-unmount [_]
-      (js/clearInterval (om/get-state owner :poll-interval)))
+      (go
+        (js/clearInterval (<! (om/get-state owner :interval-chan)))))
     om/IRenderState
     (render-state [_ {:keys [comm]}]
       (if (om/get-state owner :loading)


add a handle-command fn

add a handle-command fn

--- src/replme/cljs/main.cljs
+++ src/replme/cljs/main.cljs
@@ -1,21 +1,23 @@
 (ns replme.cljs.main
   (:use [jayq.core :only [$ css html document-ready]]))

-(def $main ($ :#main))
 (def $repl-container ($ :#repl-container))

 (enable-console-print!)
+
+(defn handle-command [input]
+  (let [line input]
+    ;; evaluate line here and return that the as the value of "msg"...
+    (array (js-obj
+            "msg" line
+            "className" "jquery-console-message-value"))))

 (def repl-config (js-obj "promptLabel" ">>"
                          "autofocus" true
                          "welcomeMessage" "Welcome! Type in some clojure to get started"
                          "animateScroll" true
-                         "commandHandle" (fn [line]
-                                           (array (js-obj
-                                                   "msg" line
-                                                   "className" "jquery-console-message-value")))
+                         "commandHandle" handle-command
                          "promptHistory" true))
-

 (defn setup-console []
   (.console $repl-container repl-config))


Random clojure exclusion

Random clojure exclusion

--- dot/lein/profiles.clj
+++ dot/lein/profiles.clj
@@ -1,5 +1,5 @@
 {:user
- {:plugins [[lein-vanity "0.2.0"]
+ {:plugins [[lein-vanity "0.2.0" :exclusions [org.clojure/clojure]]
             [lein-ancient "0.5.5"]
             [jonase/eastwood "0.2.0"]
             [cider/cider-nrepl "0.8.2"]]


switch back to simple-complete since apropos blocks like a mf

--- dot/lein/profiles.clj
+++ dot/lein/profiles.clj
@@ -10,5 +10,5 @@
   :repl-options {:nrepl-middleware
                  [inspector.middleware/wrap-inspect
                   ritz.nrepl.middleware.javadoc/wrap-javadoc
-                  ritz.nrepl.middleware.apropos/wrap-apropos]}
+                  ritz.nrepl.middleware.simple-complete/wrap-simple-complete]}
   :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


GAWB-1536: remove timing and calls section when there are no calls Show Workflow and Call Failures from Cromwell Metadata

--- src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
+++ src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
@@ -1,6 +1,7 @@
 (ns broadfcui.page.workspace.monitor.workflow-details
   (:require
     [dmohs.react :as react]
+    [clojure.walk :refer [prewalk]]
     [clojure.string :as string]
     [broadfcui.common :as common]
     [broadfcui.common.components :as comps]
@@ -61,7 +62,6 @@
         [:div {:style {:padding "0.25em 0 0.25em 1em"}}
          (for [[k v] (:data props)]
            [:div {} k [:span {:style {:margin "0 1em"}} "→"] (display-value v)])])])})
-

 (react/defc WorkflowTiming
   {:get-initial-state
@@ -101,6 +101,30 @@
          (fn [[name value]]
            (create-field name (display-value value)))
          log-map)])))
+
+(react/defc Failures
+  {:get-initial-state
+   (fn []
+     {:expanded false})
+   :render
+   (fn [{:keys [props state]}]
+     [:div {}
+      (create-field
+        "Failures"
+        (style/create-link {:text (if (:expanded @state) "Hide" "Show")
+                            :onClick #(swap! state assoc :expanded (not (:expanded @state)))}))
+      (when (:expanded @state)
+        [comps/Tree {:start-collapsed? false
+                     :highlight-ends false
+                     :data (prewalk
+                             (fn [elem]
+                               (cond
+                                 ;; reorder map elements to message then causedBy
+                                 (map? elem) (select-keys elem ["message" "causedBy"])
+                                 ;; remove empty causedBy[] arrays - prewalk means this executes after the above
+                                 (= (second elem) []) nil
+                                 :else elem))
+                             (:data props))}])])})

 (react/defc CallDetail
   {:get-initial-state
@@ -137,9 +161,10 @@
               [IODetail {:label "Outputs" :data (data "outputs")}]
               (create-field "stdout" (display-value (data "stdout") (last (string/split (data "stdout") #"/"))))
               (create-field "stderr" (display-value (data "stderr") (last (string/split (data "stderr") #"/"))))
-              (backend-logs data)]])
-          (:data props)))])})
-
+              (backend-logs data)
+              (when-let [failures (data "failures")]
+                [Failures {:data failures}])]])
+        (:data props)))])})

 (defn- render-workflow-detail [workflow raw-data workflow-name submission-id bucketName]
@@ -173,9 +198,12 @@
      (let [wlogurl (str "gs://" bucketName "/" submission-id "/workflow.logs/workflow."
                         (workflow "id") ".log")]
        (create-field "Workflow Log" (display-value wlogurl (str "workflow." (workflow "id") ".log"))))]
-    [WorkflowTiming {:label "Workflow Timing" :data raw-data :workflow-name workflow-name}]]
-
-   [:div {:style {:marginTop "1em" :fontWeight 500}} "Calls:"]
+    (when-not (empty? (workflow "calls"))
+      [WorkflowTiming {:label "Workflow Timing" :data raw-data :workflow-name workflow-name}])
+    (when-let [failures (workflow "failures")]
+      [Failures {:data failures}])]
+   (when-not (empty? (workflow "calls"))
+     [:div {:style {:marginTop "1em" :fontWeight 500}} "Calls:"])
    (for [[call data] (workflow "calls")]
      [CallDetail {:label call :data data :submission-id submission-id :bucketName bucketName :workflowId (workflow "id")}])])


Fixed 'midje :autotest' StackOverflowException; filterung duplicate version numbers.

--- src/ancient_clj/repository.clj
+++ src/ancient_clj/repository.clj
@@ -2,7 +2,9 @@
        :author "Yannick Scherer" }
   ancient-clj.repository
   (:require [ancient-clj.repository.core :as r]
-            [ancient-clj.repository http local s3p]
+            [ancient-clj.repository.http]
+            [ancient-clj.repository.local]
+            [ancient-clj.repository.s3p]
             [ancient-clj.verbose :refer [verbose]]
             [clojure.data.xml :as xml :only [parse-str]]
             [version-clj.core :as v]))
@@ -95,6 +97,7 @@
                  (recur rst (concat versions repo-versions)))
                (recur rst versions)))))
        (map (juxt identity v/version->seq))
+       (distinct)
        (filter
          (fn [[v vs]]
            (and (or snapshots? (not (v/snapshot? vs)))


adding a test route

adding a test route

--- src/statuspage_crawler/server/routes.clj
+++ src/statuspage_crawler/server/routes.clj
@@ -46,11 +46,10 @@

 (def all-routes
   (routes
-   (GET "/jobs" []
+   (GET "/foo" []
         (fn [req]
-          (println "req:: " req)
-          {:body "No jobs"}))
-
+          {:body "bar"}))
+
    (POST "/jobs" [] create-new-job)

    (GET "/jobs/status/:job-id" [job-id]


🤠 REPL helper for granting existing users :configure-congregation

--- src/territory_bro/api.clj
+++ src/territory_bro/api.clj
@@ -205,4 +205,18 @@
       (binding [events/*current-system* "admin"]
         (congregation/grant! conn cong-id user-id :view-congregation)
         (congregation/grant! conn cong-id user-id :configure-congregation)
-        (gis-user/create-gis-user! conn (projections/current-state conn) cong-id user-id)))))
+        (gis-user/create-gis-user! conn (projections/current-state conn) cong-id user-id))))
+
+  (db/with-db [conn {}]
+    (binding [events/*current-system* "admin"]
+      (doseq [{:keys [cong-id user-id perms]}
+              (->> (::congregation/congregations (projections/cached-state))
+                   (mapcat (fn [[cong-id cong]]
+                             (map (fn [[user-id perms]]
+                                    {:cong-id cong-id
+                                     :user-id user-id
+                                     :perms perms})
+                                  (:congregation/user-permissions cong)))))]
+        (when (and (:view-congregation perms)
+                   (not (:configure-congregation perms)))
+          (congregation/grant! conn cong-id user-id :configure-congregation))))))


more logging

more logging

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -7,7 +7,9 @@
    [dag_unify.core :refer [copy get-in unify unify!
                            ;; temporary: until we move (truncate) from here to dag_unify, we
                            ;; need these three:
-                           deserialize dissoc-paths serialize]]))
+                           deserialize dissoc-paths serialize
+                           ;; needed for log/debug statements:
+                           strip-refs]]))

 ;; use map or pmap.
 (def ^:const mapfn pmap)
@@ -55,7 +57,9 @@
     (let [result (unify! (copy parent)
                          {:head (copy head)})]
       (if (not (= :fail result))
-        (list result)
+        (do
+          (log/debug (str "overh: " (get-in parent [:rule]) " -> " (strip-refs head)))
+          (list result))
         (log/debug (str "fail-path for rule: " (:rule parent) ":"
                         (dag_unify.core/fail-path
                          (copy parent)
@@ -92,6 +96,8 @@
 (declare subpath?)

 (defn truncate [input truncate-paths language-model]
+  (if (= :fail input)
+    (exception (str "input is fail!")))
   (log/debug (str "truncating@" truncate-paths ":" (show-bolt input language-model)))
   (let [serialized (if (:dag_unify.core/serialized input)
                      (:dag_unify.core/serialized input)


Clojure: first version of a recursive classification function

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -49,3 +49,18 @@
   (let [shift (.minus (pos node) (.modZ (pos node)))
         pos* (fn [v] (.minus (cover-node-position pos v) shift))]
     (map (comp sort (partial map pos*)) (shells net (cover-node net node)))))
+
+(defn classify [items2seqs]
+  (loop [done []
+         todo [[[] (seq items2seqs)]]]
+    (if (empty? todo)
+      done
+      (let [finished (fn [key group] (or (nil? (last key)) (= 1 (count group))))
+            refined (group-by first (for [[key group] todo, [item s] group]
+                                      [(conj key (first s)) [item (rest s)]]))
+            done (into done (for [[key group] refined
+                                  :when (finished key group)]
+                              [key (map (comp first second) group)]))
+            todo (for [[key group] refined :when (not (finished key group))]
+                   [key (map second group)])]
+        (recur done todo)))))


clojure: more work on new morphism algorithm

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -1,6 +1,8 @@
 (ns org.gavrog.clojure.pgraph-morphisms
   (:use (org.gavrog.clojure.common [util :only [empty-queue]]))
   (:import (org.gavrog.joss.pgraphs.basic
+             INode
+             IEdge
              PeriodicGraph$CoverNode Morphism Morphism$NoSuchMorphismException)
            (org.gavrog.joss.pgraphs.io Net)
            (org.gavrog.joss.geometry Operator Vector)
@@ -105,18 +107,22 @@
           check-sigs (fn [v w] (= (map-sig op (sigs v)) (sigs w)))]
       (loop [src2img {}
              q (into empty-queue [v w])]
-        (cond
-          (empty? q)
-          src2img
-
-          (= w (src2img v))
-          (recur src2img (pop q))
-
-          (not (and (check-sigs v w) (nil? (src2img v))))
-          nil
-
-          :else
-          (let [src2img (assoc src2img v w)]))))))
+        (let [[a b] (first q)]
+          (cond
+            (empty? q)
+            src2img
+
+            (= b (src2img a))
+            (recur src2img (pop q))
+
+            (not (and (check-sigs a b) (nil? (src2img a))))
+            nil
+
+            (instance? INode a)
+            (let [src2img (assoc src2img a b)
+                  nv (Morphism/neighborVectors a)
+                  nw (Morphism/neighborVectors b)]
+              )))))))

 (comment "previous version using Java:"
   (try


Move stat metadata functions.

Move stat metadata functions.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -31,6 +31,21 @@
 (def default-algorithm
   "The hashing algorithm used if not specified in functions which create blocks."
   :sha2-256)
+
+
+
+;; ## Stat Metadata
+
+(defn with-stats
+  "Adds stat information to a block's metadata."
+  [block stats]
+  (vary-meta block assoc :block/stats stats))
+
+
+(defn meta-stats
+  "Returns stat information from a block's metadata, if present."
+  [block]
+  (:block/stats (meta block)))

@@ -231,18 +246,3 @@
    (put! store (if (instance? File source)
                  (from-file source algorithm)
                  (read! source algorithm)))))
-
-
-
-;; ## Utility Functions
-
-(defn with-stats
-  "Adds stat information to a block's metadata."
-  [block stats]
-  (vary-meta block assoc :block/stats stats))
-
-
-(defn meta-stats
-  "Returns stat information from a block's metadata, if present."
-  [block]
-  (:block/stats (meta block)))


added jobNameTemplate to make-pipeline

added jobNameTemplate to make-pipeline

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -25,7 +25,9 @@
            [java.io InputStream OutputStream DataInputStream DataOutputStream File]
            [java.util UUID]
            [java.net URI]
-           [clojure.lang MapEntry ExceptionInfo]))
+           [clojure.lang MapEntry ExceptionInfo]
+           [org.joda.time DateTimeUtils DateTimeZone]
+           [org.joda.time.format DateTimeFormat DateTimeFormatter]))

 (def required-ns (atom #{}))

@@ -654,14 +656,23 @@

 (def ^:dynamic *pipeline-builder-caller* "unknown")

-(defmacro make-pipeline
-  [& args]
-  `(binding [*pipeline-builder-caller* ~(str *ns*)]
-     (make-pipeline* ~@args)))
+(defn create-timestamp
+  []
+  (let [formatter (-> "MMddHHmmss"
+                      (DateTimeFormat/forPattern)
+                      (.withZone DateTimeZone/UTC))]
+    (.print formatter (DateTimeUtils/currentTimeMillis))))
+
+(defn job-name-template
+  [tpl args]
+  (-> tpl
+      (str/replace #"%U" (or (System/getProperty "user.name") "nemo"))
+      (str/replace #"%A" *pipeline-builder-caller*)
+      (str/replace #"%T" (create-timestamp))
+      (str/lower-case)
+      (str/replace #"[^-a-z0-9]" "0")))

 (defn make-pipeline*
-  {:doc "Builds a Pipeline from command lines args"
-   :added "0.1.0"}
   ([itf str-args kw-args]
    (let [atomic-args (into {} (map (fn [kv] (let [[k v] (str/split kv #"=" 2)]
                                               [(str/camel-case (str/replace k #"^--" "")) v]))
@@ -671,7 +682,12 @@
          args-with-name (if (args "appName")
                           args
                           (assoc args "appName" *pipeline-builder-caller*))
-         reformed-args (map (fn [[k v]] (str "--" k "=" v)) args-with-name)
+         args-with-jobname (if-let [tpl (args-with-name "jobNameTemplate")]
+                             (-> args-with-name
+                                 (assoc "jobName" (job-name-template tpl args-with-name))
+                                 (dissoc "jobNameTemplate"))
+                             args-with-name)
+         reformed-args (map (fn [[k v]] (str "--" k "=" v)) args-with-jobname)
          builder (PipelineOptionsFactory/fromArgs
                   (into-array String reformed-args))
          options (if itf
@@ -691,6 +707,17 @@
    (cond (or (symbol? arg) (string? arg)) (make-pipeline* arg [] {})
          (seq? arg) (make-pipeline* nil arg {})
          :else (make-pipeline* nil [] arg))))
+
+(defmacro make-pipeline
+  {:doc "Builds a Pipeline from command lines args and configuration. Also accepts a jobNameTemplate param which is a string in which the following var are interpolated:
+  - %A -> Application name
+  - %U -> User name
+  - %T -> Timestamp
+It means the template %A-%U-%T is equivalent to the default jobName"
+   :added "0.1.0"}
+  [& args]
+  `(binding [*pipeline-builder-caller* ~(str *ns*)]
+     (make-pipeline* ~@args)))

 (defn run-pipeline
   {:doc "Run the computation for a given pipeline or PCollection."


Let log functions handle converting args to a string

--- src/devtools/debug.cljs
+++ src/devtools/debug.cljs
@@ -53,10 +53,7 @@
   (if-not *initialized*
     (apply api-call args)
     (do
-      (try
-        (log (logger name) (str args))                      ; potential exception converting args to string
-        (catch :default e
-          (log-exception (str e))))
+      (log (logger name) args)
       (indent!)
       (let [api-response (apply api-call args)
             api-response-filter (fn [key value] (if (= key "object") "##REF##" value))]
@@ -79,10 +76,7 @@
   (let [original-log-fn (aget js/console "log")]
     (aset js/console "log" (fn [& args]
                              (.addSeparator *console*)
-                             (try
-                               (log (logger "console") (str args)) ; potential exception converting args to string
-                               (catch :default e
-                                 (log-exception (str e))))
+                             (log (logger "console") args)
                              (.apply original-log-fn js/console (into-array args))))))

 (defn init! []


clean up "with"

clean up "with"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2046,9 +2046,7 @@
                      :participle "winning"}}

    "with" {:synsem {:cat :prep
-                    :subcat {:1 {:cat :noun
-                                 :pronoun false
-                                 :subcat '()}}
+                    :subcat {:1 {:cat :noun}}
                     :sem {:pred :with}}}

    "woman" {:english {:plur "women"}


remove another premature Bowie-ism

remove another premature Bowie-ism

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1521,10 +1521,6 @@
    "supply" {:synsem {:cat :verb
                 :sem {:pred :supply}}}

-   "super" {:synsem {:cat :adjective
-                     :sem {:it-came-from-outerspace true
-                           :mod {:pred :super}}}}
-
    "support" {:synsem {:cat :verb
                        :sem {:pred :support}}}


+pizza

+pizza

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1425,7 +1425,11 @@
                             :place true}}}
             {:synsem {:cat :noun
                       :sem {:pred :party
-                           :event true}}}]
+                            :event true}}}]
+
+   "pizza"
+   {:synsem {:cat :noun
+             :sem {:pred :pizza}}}

    ;; TODO: 3sing present exception used below to avoid "playies" is not an exception: it's a rule: y->ys.
    ;; the exceptional case is when "ys" is not used (e.g. "tries").


use English for :pred

use English for :pred

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -882,7 +882,7 @@
    "house" (unify agreement-noun
                   common-noun
                   countable-noun
-                  {:synsem {:sem (unify animal {:pred :casa
+                  {:synsem {:sem (unify animal {:pred :house
                                                 :buyable true
                                                 :artifact true
                                                 :place true})}})


added dire

added dire

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -156,6 +156,24 @@

    "désirer" {:synsem {:cat :verb
                        :sem {:pred :desire}}}
+
+   "dire"
+      (let [shared-part-of-dire
+              {:synsem {:cat :verb}
+               :français {:français "dire"
+                          :passato "dit"
+                          :future-stem "dir"
+                          :imperfect-stem "dis"
+                          :present {:1sing "dis"
+                                    :2sing "dis"
+                                    :3sing "dit"
+                                    :1plur "disons"
+                                    :2plur "dites"
+                                    :3plur "disent"}}]
+            [(merge shared-part-of-dire
+                    {:synsem {:pred :say}})
+             (merge shared-part-of-dire
+                    {:synsem {:pred :tell}})])

    "diviser" {:synsem {:cat :verb
                       :sem {:pred :divide}}}
@@ -372,7 +390,15 @@
                               :pred :work-nonhuman}}}]

   "mettre" {:synsem {:cat :verb
-                     :sem {:pred :set}}}
+                     :passato "mis"
+                     :present {:1sing "mets"
+                                    :2sing "mets"
+                                    :3sing "met"
+                                    :1plur "mettons"
+                                    :2plur "mettez"
+                                    :3plur "mettent"}
+
+                     :sem {:pred :put}}}
   "nous"
   (let [common {:synsem {:case :nom
                          :agr {:person :1st


added volere

added volere

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -1909,6 +1909,18 @@
              :sem {:human true
                    :pred :voi}
               :subcat '()}}]})
+
+    "volere" {:synsem {:cat :verb
+                         :sem {:pred :have-to}}
+                :italiano {:future-stem "vorr"
+                           :drop-e true
+                           :present {:1sing "voglio"
+                                     :2sing "vuoi"
+                                     :3sing "vuole"
+                                     :1plur "vogliamo"
+                                     :2plur "volete"
+                                     :3plur "vogliono"}}}
+

 ;; see TODOs in lexiconfn/compile-lex (should be more of a pipeline as opposed to a argument-position-sensitive function.
 (def lexicon (future (-> (compile-lex lexicon-source


Faster (and working) implementation of Ryssels Algorithm

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

--- src/conexp/contrib/experimental/ryssel_algorithm.clj
+++ src/conexp/contrib/experimental/ryssel_algorithm.clj
@@ -16,41 +16,54 @@
 ;;;

 (defn- covers? [base-set sets]
-  (subset? base-set (reduce union sets)))
+  (subset? base-set (reduce union #{} sets)))
+
+(defn- redundant? [cover]
+  (exists [set cover]
+    (covers? set (disj cover set))))

 (defn- minimum-covers [base-set sets]
-  (let [covers (if (covers? base-set sets)
-                 #{sets}
-                 #{})]
-    (loop [covers         covers,
-           minimum-covers #{}]
-      (if (empty? covers)
-        minimum-covers
-        (let [next-cover     (first covers),
-              smaller-covers (filter #(covers? base-set %)
-                                     (map #(disj next-cover %) next-cover))]
-          (if (not-empty smaller-covers)
-            (recur (into (disj covers next-cover)
-                         smaller-covers)
-                   minimum-covers)
-            (let [covers (disj covers next-cover),
-                  covers (set (mapcat #(if (subset? next-cover %)
-                                         (filter (fn [X]
-                                                   (covers? base-set X))
-                                                 (map (fn [x] (disj % x))
-                                                      next-cover))
-                                         (list %))
-                                      covers))]
-              (recur covers
-                     (conj minimum-covers next-cover)))))))))
-
+  (if-not (covers? base-set sets)
+    []
+    (let [sets   (vec (sort #(>= (count %1) (count %2)) sets)),
+          result (atom (transient [])),
+          search (fn search [rest-base-set current-cover i]
+                   (cond
+                    (redundant? current-cover)
+                    nil,
+                    (covers? base-set current-cover)
+                    (swap! result conj! current-cover),
+                    (>= i (count sets))
+                    nil,
+                    :else (do
+                            (search (difference base-set (sets i))
+                                    (conj current-cover (sets i))
+                                    (inc i))
+                            (when (covers? rest-base-set (drop (inc i) sets))
+                              (search rest-base-set current-cover (inc i))))))]
+      (search base-set #{} 0)
+      (persistent! @result))))
+
 (defn- cover [ctx candidates A]
   (let [base-set      (objects ctx),
+        candidates    (difference candidates
+                                  (set-of (intersection X Y) | X candidates, Y candidates
+                                                               :when (and (not (subset? X Y))
+                                                                          (not (subset? Y X))))),
         object-covers (minimum-covers (difference base-set A)
                                       (set-of (difference base-set N) | N candidates))]
     (map (fn [cover]
            (map #(difference base-set %) cover))
          object-covers)))
+
+(defn- collapse-equal-premises [implications]
+  (let [impl-map (reduce! (fn [map implication]
+                            (assoc! map (premise implication)
+                                    (into (get map (premise implication) #{})
+                                          (conclusion implication))))
+                          {}
+                          implications)]
+    (set-of (make-implication (pair 0) (pair 1)) | pair impl-map)))

 (defn ryssel-base
   "Returns the set of implications computed by Ryssels Algorithm."
@@ -66,7 +79,7 @@
     (loop [implications #{},
            extents      M]
       (if (empty? extents)
-        implications
+        (collapse-equal-premises implications)
         (let [A            (first extents),
               B            (oprime A),
               implications (into implications


removed logo from intro

removed logo from intro

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -334,7 +334,6 @@

         no-stream?
           (dom/div nil
-            (dom/img #js {:src "img/cellf-white.svg" :className "logo"})
             (dom/h1 nil "Hi")
             (dom/p nil (:intro1 strings))
             (dom/p nil (:intro2 strings))


Add back warmup time

Add back warmup time

--- src/exp/experiments.clj
+++ src/exp/experiments.clj
@@ -46,7 +46,7 @@
         :sahtn    `(sd/sahtn-dijkstra ~'init)
         :nsahtn    `(sd/sahtn-dijkstra ~'init)
         ))
-    'exp.experiments nil 10000 512 false  ::ExpResult))
+    'exp.experiments 20 10000 512 false  ::ExpResult))

 (defn pad-right [x n]
   (let [xs (str x)


Reduce heartbeat-ms config until heartbeat fix is in place.


Improve how exceptions are caught and printed.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -65,23 +65,26 @@
    The main difference is that if the first argument on a line is a keyword,
    all elements on that line will be forwarded in a vector instead of being
    forwarded seperately."
-  [cmds]
+  [cmds err-fn]
   (let [quit-commands (conj (:quit (get-cmd-aliases cmds)) :quit)]
     (fn [request-prompt request-exit]
-      (or ({:line-start request-prompt :stream-end request-exit}
-           (skip-whitespace *in*))
-          (loop [v []]
-            (let [input (read {:read-cond :allow} *in*)]
-              (if (and (not (symbol? input)) (empty? v))
-                (do
-                  (skip-if-eol *in*)
-                  input)
-                (if (= :line-start (skip-whitespace *in*))
-                  (if (and (symbol? input)
-                           (some #(= (keyword input) %) quit-commands))
-                    request-exit
-                    (conj v input))
-                  (recur (conj v input))))))))))
+      (try
+        (or ({:line-start request-prompt :stream-end request-exit}
+             (skip-whitespace *in*))
+            (loop [v []]
+              (let [input (read {:read-cond :allow} *in*)]
+                (if (and (not (symbol? input)) (empty? v))
+                  (do
+                    (skip-if-eol *in*)
+                    input)
+                  (if (= :line-start (skip-whitespace *in*))
+                    (if (and (symbol? input)
+                             (some #(= (keyword input) %) quit-commands))
+                      request-exit
+                      (conj v input))
+                    (recur (conj v input)))))))
+        (catch Exception e
+          (err-fn e))))))

 (defn create-arg-hint-completers
   "This function creates a vector of jline2 ArgumentCompleter instances for displaying hints related to commands via tab-completion."
@@ -118,24 +121,27 @@
   "This function creates a read function that leverages jline2 for handling input.
    Thanks to the functionality provided by jline2, this allows, e.g., command history, command editing, or tab-completion.
    The input that is read is then forwarded to a repl read function that was created with create-repl-read-fn."
-  [cmds prompt-string]
+  [cmds prompt-string err-fn]
   (let [in-rdr (doto (ConsoleReader. nil *jline-input-stream* *jline-output-stream* nil)
                  (.addCompleter (StringsCompleter. (map name (keys cmds))))
                  (.setPrompt prompt-string))
         arg-hint-completers (create-arg-hint-completers cmds)
         _ (doseq [compl arg-hint-completers]
             (.addCompleter in-rdr compl))
-        rdr-fn (create-repl-read-fn cmds)]
+        rdr-fn (create-repl-read-fn cmds err-fn)]
     (fn [request-prompt request-exit]
-      (let [line (if *mock-jline-readline-input*
-                   (read-line)
-                   (.readLine in-rdr))]
-        (if (and (not (nil? line))
-                 (not (.isEmpty line))
-                 (not (-> line (.trim) (.startsWith *comment-begin-string*))))
-          (binding [*in* (PushbackReader. (StringReader. (str line *cli4clj-line-sep*)))]
-            (rdr-fn request-prompt request-exit))
-          request-prompt)))))
+      (try
+        (let [line (if *mock-jline-readline-input*
+                     (read-line)
+                     (.readLine in-rdr))]
+          (if (and (not (nil? line))
+                   (not (.isEmpty line))
+                   (not (-> line (.trim) (.startsWith *comment-begin-string*))))
+            (binding [*in* (PushbackReader. (StringReader. (str line *cli4clj-line-sep*)))]
+              (rdr-fn request-prompt request-exit))
+            request-prompt))
+        (catch Exception e
+          (err-fn e))))))

 (defn resolve-cmd-alias
   "This function is used to resolve the full command definition for a given command alias.
@@ -283,5 +289,5 @@
          :eval ((options# :eval-factory) (options# :cmds) (options# :allow-eval) (options# :print-err))
          :print (options# :print)
          :prompt (options# :prompt-fn)
-         :read (*read-factory* (options# :cmds) (options# :prompt-string))))))
-
+         :read (*read-factory* (options# :cmds) (options# :prompt-string) (options# :print-err))))))
+


[base] Have cqrs/->ws-handler return :braid/ok (some code looks for that)

--- src/braid/base/server/cqrs.clj
+++ src/braid/base/server/cqrs.clj
@@ -13,7 +13,7 @@
       (tada/do! (:id command)
                 (assoc ?data
                   :user-id user-id))
-      (?reply-fn "OK")
+      (?reply-fn :braid/ok)
       (catch Exception e
         (timbre/debug "Command Error:" e)
         (?reply-fn {:cqrs/error {:message (.getMessage e)


use rabbitmq vhost from config

use rabbitmq vhost from config

--- src/brainbot/nozzle/manage.clj
+++ src/brainbot/nozzle/manage.clj
@@ -70,7 +70,7 @@
 (defn manage-filesystem*
   [rmq-settings id {:keys [fsid sleep-between-sync]}]
   (let [qname (rk/routing-key-string-from-map {:id id :filesystem fsid :command "*"})
-        get-num-messages* #(get-num-messages "/" id fsid)
+        get-num-messages* #(get-num-messages (:vhost rmq-settings) id fsid)
         wait-idle #(wait-for-zero-messages get-num-messages*)]
     (logging/debug "waiting for" qname "to become idle")
     (wait-idle)


adding a print

adding a print

--- src/fowles/gatherer.clj
+++ src/fowles/gatherer.clj
@@ -59,6 +59,7 @@
   ;; FIXME: don't send clj-hmap, send original json.
   (let [resp-body (json/read-str body)
         msg       (:msg opts)]
+    (println "ok")
     (let [new-acc    (conj (:resp-bodies msg) resp-body)
           page-token (get resp-body "nextPageToken")]
       (if page-token


pool selection function have been implemented for system

--- core/src/cljc/hellhound/system/impl/system.cljc
+++ core/src/cljc/hellhound/system/impl/system.cljc
@@ -45,11 +45,6 @@
         :fn #(= (first (:ret %))
                 (:hellhound.component/name (:component (:args %)))))

-(defn get-or-create-execute-pool
-  [system]
-  (let [ex-map (execution-map system)]))
-
-
 (extend-type clojure.lang.IPersistentMap
   protocols/ComponentManagement
   ;; The system map should have a `:component` key which its value
@@ -79,25 +74,33 @@
     (:workflow this))

   protocols/ExecutionManagement
+  (set-execution-pool
+    [system pool]
+    (let [ex-map (execution-map system)]
+      (if (= single-threaded? system)
+        system
+        (protocols/update-system system
+                                 :execution
+                                 (assoc ex-map :execution-pool pool)))))
   (execution-pool
     [system]
     (cond
       (single-threaded? system) nil
-      (multi-threaded? system)  (create-execution-pool system)
+      (multi-threaded? system)  (:execution-pool (execution-map system))
       :else (throw (ex-info "Don't know about the given execution mode."))))

   (wait-pool
     [system]
     (cond
       (single-threaded? system) nil
-      (multi-threaded? system)  (create-wait-pool system)
+      (multi-threaded? system)  (:wait-pool (execution-map system))
       :else (throw (ex-info "Don't know about the given execution mode."))))

   (schedule-pool
     [system]
     (cond
       (single-threaded? system) nil
-      (multi-threaded? system)  (create-schedule-pool system)
+      (multi-threaded? system)  (:schedule-pool (execution-map system))
       :else (throw (ex-info "Don't know about the given execution mode."))))

   (execution-mode


Remove duplicate line

Remove duplicate line

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -64,7 +64,6 @@
         lfs (local-filesystem)
         local-dir (:local-dir local-config)
         local-domain-root (str (path local-dir domain))
-        remote-path (-> global-config (:domains) (get domain))
         remote-path (-> global-config :domains (get domain))
         remote-vs (DomainStore. fs remote-path)
         local-vs (DomainStore. lfs local-domain-root (.getSpec remote-vs))]


Removed duplicate funcs.

Removed duplicate funcs.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -97,55 +97,6 @@
       (log-message "Successfully loaded domains: "
                    (s/join ", " (keys domains-info))))))

-(defn use-cache-or-update
-  [domain host-shards remote-path local-config update? state]
-  (let [{:keys [hdfs-conf local-dir local-db-conf]} local-config
-        fs  (filesystem hdfs-conf)
-        lfs (local-filesystem)
-        local-domain-root (str (path local-dir domain))
-        remote-vs (DomainStore. fs remote-path)
-        local-vs  (DomainStore. lfs local-domain-root (.getSpec remote-vs))]
-    (if (domain-has-data? local-vs)
-      (load-domain domain
-                   fs
-                   local-db-conf
-                   local-domain-root
-                   remote-path
-                   host-shards
-                   state)
-      (let [{:keys [finished-loaders shard-states]} state]
-        ;; use cached domain from local-dir (no update needed)
-        ;; signal all shards of domain are done loading
-        (swap! finished-loaders + (count (shard-states domain)))
-        (when-not update?
-          (open-domain local-db-conf
-                       local-domain-root
-                       host-shards))))))
-(defn load-and-sync-status!
-  "TRYING out just an initial load."
-  [remote-path-map local-config rw-lock domains-info]
-  (let [status (thrift/loading-status)
-        loaders (p-dofor [[domain info] domains-info
-                          :let [host-shards  (domain/host-shards info)
-                                remote-path  (get remote-path-map domain)
-                                loader-state (mk-loader-state {domain host-shards})]]
-                         (try (domain/set-domain-status! info status)
-                              (when-let [new-data (use-cache-or-update domain
-                                                                       host-shards
-                                                                       remote-path
-                                                                       local-config
-                                                                       update?
-                                                                       loader-state)]
-                                (domain/set-domain-data! rw-lock domain info new-data))
-                              (domain/set-domain-status! info (thrift/ready-status))
-                              (catch Throwable t
-                                (log-error t "Error when loading domain " domain)
-                                (domain/set-domain-status! info
-                                                           (thrift/failed-status t)))))]
-    (with-ret loaders
-      (log-message "Successfully loaded domains: "
-                   (s/join ", " (keys domains-info))))))
-
 (defn purge-unused-domains!
   "Walks through the supplied local directory, recursively deleting
   all directories with names that aren't present in the supplied


Update routes id lookup

Update routes id lookup

--- src/clj/gtfve/data/queries.clj
+++ src/clj/gtfve/data/queries.clj
@@ -18,13 +18,11 @@
           (map d/touch))))
   ([id]
    (let [db (d/db conn)]
-     (->> (d/q {:find ['?r]
-                :in ['$ '?id]
-                :where [['?r :route/id '?id]]}
-               db id)
-          (map first)
-          (map (partial d/entity db))
-          (map d/touch)))))
+     (->> (d/datoms db :avet :route/id id)
+          first
+          :e
+          (d/entity db)
+          d/touch))))

 (defn haversine
   [{lon1 :longitude lat1 :latitude} {lon2 :longitude lat2 :latitude}]


Clarify a few logs

Clarify a few logs

--- src/clj/runbld/tests/junit.clj
+++ src/clj/runbld/tests/junit.clj
@@ -105,7 +105,8 @@
                       :when xml]
                   (if-let [testsuite (x/select xml [[(x/tag= :testsuite)]])]
                     (merge-default (make-failure-report testsuite))
-                    (rio/log "No testsuite node found.")))]
+                    (rio/log "No testsuite node found in"
+                             (rio/abspath failure))))]
     (debug/log "Made" (count reports) "reports")
     (debug/log "Combining reports")
     (let [summary (reduce combine-failure-reports
@@ -115,7 +116,8 @@
                            :skipped 0
                            :failed-testcases []}
                           reports)]
-      (rio/log "Errors:" (:errors summary)
+      (rio/log "Test output logs contained:"
+               "Errors:" (:errors summary)
                "Failures:" (:failures summary)
                "Tests:" (:tests summary)
                "Skipped:" (:skipped summary))


Fix a bug in defmiddleware

Fix a bug in defmiddleware

--- src/clojure/picard/helpers.clj
+++ src/clojure/picard/helpers.clj
@@ -101,7 +101,7 @@
                           evt# val#))
                       ;; If there is no downstream handler, just
                       ;; pass the one we have in.
-                      ~downstream*))
+                      downstream*))

              ;; Setup the bindings that were passed in
              ~state      ~state*


Make derive-column to work with Datasets by delegating it to incanter.

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -202,6 +202,17 @@
 (defn take-rows [dataset n]
   "Drops the first n rows from the CSV."
   (map-rows dataset (partial take n)))
+
+(defn derive-column
+  "Adds a new column to the end of the row which is derived from
+column with position col-n.  f should just return the cells value.
+
+If no f is supplied the identity function is used, which results in
+the specified column being cloned."
+
+  ;; todo support multiple columns/arguments to f.
+  ([dataset new-column-name from-cols f]
+     (inc/add-derived-column new-column-name from-cols f dataset)))

 (defn- grep-row [dataset f]
   (let [filtered-data (filter f (:rows dataset))]


Close channels after use

Close channels after use

--- src/yorck_ratings/web.clj
+++ src/yorck_ratings/web.clj
@@ -21,11 +21,15 @@
   (if (= "/" (:uri req))
     (with-channel req ch
                   (a/go
-                    (let [movie-chs (a/<! (core/rated-movies))
+                    (let [yorck-ch (core/rated-movies)
+                          movie-chs (a/<! yorck-ch)
                           html-ch (a/map (fn [& movies] (view/markup movies)) movie-chs)
                           response (found (a/<! html-ch))]
                       (send! ch response)
-                      (close ch))))
+                      (close ch)
+                      (a/close! yorck-ch)
+                      (a/close! html-ch)
+                      (map a/close! movie-chs))))
     (not-found)))

 (defn -main [& args]


Simplify icon loading and fix reflection warning

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -210,15 +210,14 @@
       [id texture-id])))

 (defn png-bytes [path]
-  (let [input-stream (FileInputStream. (str path))
-        decoder (PNGDecoder. input-stream)
-        width (.getWidth decoder)
-        height (.getHeight decoder)
-        bytebuf (ByteBuffer/allocateDirect (* width height 4))]
-    (.decode decoder bytebuf (* width 4) PNGDecoder$Format/RGBA)
-    (.flip bytebuf)
-    (.close input-stream)
-    bytebuf))
+  (with-open [input-stream (jio/input-stream path)]
+    (let [decoder (PNGDecoder. input-stream)
+          width (.getWidth decoder)
+          height (.getHeight decoder)
+          bytebuf (ByteBuffer/allocateDirect (* width height 4))]
+      (.decode decoder bytebuf (* width 4) PNGDecoder$Format/RGBA)
+      (.flip bytebuf)
+      bytebuf)))

 ;; Extract native libs and setup system properties
 (defn init-natives []
@@ -245,20 +244,11 @@
                              (.withProfileCore true))
         icon-array         (when icon-paths
                              (condp = (LWJGLUtil/getPlatform)
-                               LWJGLUtil/PLATFORM_LINUX (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 1)
-                                                              data ^bytes (png-bytes (get icon-paths 1))]
-                                                          (aset icon-array 0 data)
-                                                          icon-array)
-                               LWJGLUtil/PLATFORM_MACOSX  (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 1)
-                                                                data ^bytes (png-bytes (get icon-paths 2))]
-                                                            (aset icon-array 0 data)
-                                                            icon-array)
-                               LWJGLUtil/PLATFORM_WINDOWS (let [icon-array ^"[Ljava.nio.ByteBuffer;" (make-array ByteBuffer 2)
-                                                                data0 ^bytes (png-bytes (get icon-paths 0))
-                                                                data1 ^bytes (png-bytes (get icon-paths 1))]
-                                                            (aset icon-array 0 data0)
-                                                            (aset icon-array 1 data1)
-                                                            icon-array)))
+
+                               LWJGLUtil/PLATFORM_LINUX (into-array ByteBuffer [(png-bytes (get icon-paths 1))])
+                               LWJGLUtil/PLATFORM_MACOSX  (into-array ByteBuffer [(png-bytes (get icon-paths 2))])
+                               LWJGLUtil/PLATFORM_WINDOWS (into-array ByteBuffer [(png-bytes (get icon-paths 0))
+                                                                                (png-bytes (get icon-paths 1))])))
         latch              (java.util.concurrent.CountDownLatch. 1)]
      ;; init-natives must be called before the Display is created
      (init-natives)
@@ -266,7 +256,9 @@
        (Display/setDisplayMode (DisplayMode. screen-width screen-height))
        (Display/setTitle title)
        (when icon-array
-         (Display/setIcon icon-array))
+         (log/info "Setting icons")
+         (Display/setIcon icon-array)
+         (Thread/sleep 100))
        (Display/create pixel-format context-attributes)
        (Keyboard/create)
        (Mouse/create)
@@ -587,7 +579,8 @@
           (loop-with-index col [c line]
             (let [chr        (or (get c :fx-character) (get c :character))
                   chr        (if (and (= layer-id base-layer-id)
-                                      (= chr (char 0)))
+                                      (char? chr)
+                                      (= (char chr) (char 0)))
                                  \space
                                  chr)
                   highlight  (= @cursor-xy [col (- rows row 1)])


Исправление бага транслитерации

Исправление бага транслитерации

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -925,7 +925,12 @@
                  ((partial prepare-date-to-sql-timestamp :cdate))
                  (assoc :udate (new java.util.Date))
                  ((partial prepare-date-to-sql-timestamp :udate))
-                 (assoc :ttitle (make-translit-ru-en (str keyname)))
+
+                 (as-> row
+                     (if keyname
+                       (assoc row :ttitle (make-translit-ru-en (str keyname)))
+                       row))
+
                  (assoc :plan_text (html-clean-tags web_description))
                  )))


removed stray println

removed stray println

--- src/corpus_utils/wikipedia.clj
+++ src/corpus_utils/wikipedia.clj
@@ -58,7 +58,6 @@
         {:keys [hiragana katakana kanji]
          :or {hiragana 0 katakana 0 kanji 0}}
         (->> text (map str) (map char-writing-system) frequencies)]
-    (println length)
     (if (and
          (> length 50)
          (> (/


updated es mapping relation maps

updated es mapping relation maps

--- src/ctia/stores/es/mapping.clj
+++ src/ctia/stores/es/mapping.clj
@@ -4,9 +4,10 @@
 (def string {:type "string" :index "not_analyzed"})

 (def related
-  {:confidence {:type "string"}
-   :source {:type "string"}
-   :relationship {:type "string"}})
+  {:type string
+   :confidence string
+   :source string
+   :relationship string})

 (def valid-time
   {:type "nested"


revert set-profiles to unmerge-profiles and merge-profiles

--- src/leiningen/droid.clj
+++ src/leiningen/droid.clj
@@ -4,7 +4,7 @@
 ;;
 (ns leiningen.droid
   (:refer-clojure :exclude [compile doall repl])
-  (:use [leiningen.core.project :only [set-profiles]]
+  (:use [leiningen.core.project :only [merge-profiles unmerge-profiles]]
         [leiningen.core.main :only [abort]]
         [leiningen.help :only (subtask-help-for)]
         [leiningen.droid.compile :only (compile clean-compile-dir code-gen)]
@@ -44,7 +44,8 @@
   "Takes a project map and replaces `:dev` profile with `:release` profile."
   [project]
   (-> project
-      (set-profiles [:release] [:dev])
+      (unmerge-profiles [:dev])
+      (merge-profiles [:release])
       android-parameters))

 (def ^{:doc "Default set of tasks to create an application release."}


search-box UI convenience: select the text automatically pasted to input line

--- src/lt/objs/search.cljs
+++ src/lt/objs/search.cljs
@@ -71,7 +71,9 @@
 (defui search-box [this]
   [:input.search {:type "text" :placeholder "Search"}]
   :focus (fn []
-           (ctx/in! :searcher.search this))
+           (ctx/in! :searcher.search this)
+           ; select the text automatically pasted to input line for some UI conveniece
+           (.select (dom/$ :input.search (object/->content this))))
   :blur (fn []
           (ctx/out! :searcher.search)))


Took out debugging lines

Took out debugging lines

--- src/mail_query/core.clj
+++ src/mail_query/core.clj
@@ -47,7 +47,6 @@
            (not-found (not-found-page)))

 (defn authenticated? [name pass]
-  (println "name: " name " pass: " pass)
   (and (= name "admin")
        (= pass mailgun-admin-pwd)))


fix issue with corp install logging

fix issue with corp install logging

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -332,7 +332,6 @@
               "Archives" [:servers :archives]
               "New remote" [:servers :remote (count (get-in @state [:corp :servers :remote]))]
               [:servers :remote (-> (split server " ") last js/parseInt)])]
-    (system-msg state side (str "installs a card in " server))
     (when (= server "New remote")
       (trigger-event state side :server-created card))
     (let [c (assoc card :advanceable (:advanceable (card-def card)))]
@@ -349,6 +348,7 @@
                 (when (#{"Asset" "Agenda"} (:type installed-card))
                   (trash state side installed-card)
                   (system-msg state side (str "trash a card in " server)))))
+            (system-msg state side (str "installs a card in " server))
             (move state side c slot)))))))

 (defn play [state side {:keys [card server]}]


[fix|ref] Action function.

[fix|ref] Action function.

--- src/ombs/view/event.clj
+++ src/ombs/view/event.clj
@@ -26,9 +26,9 @@
     ((h/set-attr :disabled "")     match)) )

 (defn fill-parts [parts match]
-  (if (nil? parts)
-    ((h/set-attr :hidden "") match)
-    (h/content (parts-snip parts)) match))
+  (if (= 0 parts)
+    nil
+    ((h/content (parts-snip parts)) match)))

 (defn participate-action [name date status match]
   (if (and
@@ -39,12 +39,13 @@

 (def event-sel [:.event])
 (h/defsnippet event-elem "../resources/public/event.html" event-sel [{:keys [name price date author status parts]}]
-  [:.name]   (h/set-attr :value name)
-  [:.date]   (h/set-attr :value date)
-  [:.author] (h/set-attr :value author)
-  [:.price]  (h/set-attr :value (str price))
-  [:.debt]   (h/set-attr :value (core/debt (sess/get :username) name date))
-  [:#parts-row]  (partial fill-parts parts)
-  [:.action.participate] (partial participate-action name date status)
-  [:.action.pay] (partial pay-action name date)
-  [:.action.start] (partial start-action name date author))
+  [:.name]              (h/set-attr :value name)
+  [:.date]              (h/set-attr :value date)
+  [:.author]            (h/set-attr :value author)
+  [:.price]             (h/set-attr :value (str price))
+  [:.debt]              (h/set-attr :value (core/debt (sess/get :username) name date))
+  [:#parts-row]         (partial fill-parts parts)
+  [:.action.participate](partial participate-action name date status)
+  [:.action.pay]        (partial pay-action name date)
+  [:.action.start]      (partial start-action name date author)
+  )


Remove unnecessary parameter in job exception handler

--- src/overseer/worker.clj
+++ src/overseer/worker.clj
@@ -51,7 +51,7 @@
   "Exception handler for job thunks; invokes the default handler,
    then returns a status keyword. Attempts to parse special signal
    status out of ex, else defaults to :failed"
-  [system job]
+  [system]
   (fn [ex]
     (let [default-handler (->default-exception-handler system)
           status (or (get (ex-data ex) :overseer/status)
@@ -79,11 +79,11 @@
       job)))

 (defn run-job
-  "Run a single job and transact an appropriate status update"
+  "Run a single job and return the appropriate status update txns"
   [{:keys [conn] :as system} job-handlers job]
   (let [job-id (:job/id job)
         job-handler (get job-handlers (:job/type job))
-        exit-status (try-thunk (->job-exception-handler system job)
+        exit-status (try-thunk (->job-exception-handler system)
                                (fn []
                                  (job-handler system job)
                                  :finished))


fix mixed-content warnings

fix mixed-content warnings

--- src/pc/product_hunt.clj
+++ src/pc/product_hunt.clj
@@ -3,6 +3,7 @@
             [clj-http.client :as http]
             [clojure.core.memoize :as memo]
             [clojure.tools.logging :as log]
+            [clojure.string :as str]
             [hiccup.core :as h]))

 (def ph-comments
@@ -52,6 +53,9 @@
       (log/infof "Error getting post info for %s" post-id)
       (fallback-info post-id))))

+(defn https-ify-url [url]
+  (str/replace url #"^http:" "https:"))
+
 (defn product-hunt-component [post-id]
   (let [info (post-info post-id)
         make-link (fn [content]
@@ -70,7 +74,7 @@
        [:div.ph-makers
         (for [maker (get info "makers")]
           [:div.ph-maker
-           [:img.ph-avatar {:src (get-in maker ["image_url" "30px"])}]])]
+           [:img.ph-avatar {:src (https-ify-url (get-in maker ["image_url" "30px"]))}]])]
        (when-let [voter (some-> info
                           (get "votes")
                           (#(remove (fn [u] (contains? maker-ids (get-in u ["user" "id"])))
@@ -80,6 +84,6 @@
                           last
                           (get "user"))]
          [:div.ph-hunter
-          [:img.avatar {:src (get-in voter ["image_url" "30px"])}]])]
+          [:img.avatar {:src (https-ify-url (get-in voter ["image_url" "30px"]))}]])]
       [:div.ph-comments-icon ph-comments]
       [:div.ph-comments-count (make-link (get info "comments_count"))]])))