s/pmap/map/

s/pmap/map/

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -494,35 +494,35 @@
                                                           {:comp {:synsem {:agr {:person person}}}})]
                                           (log/trace (str "generating from person: " person))
                                           (.size
-                                           (map (fn [number]
-                                                  (let [spec (unify spec
-                                                                    {:comp {:synsem {:agr {:number number}}}})]
-                                                    (log/debug (str "generating from spec: " spec "; input-spec was:" input-spec))
-                                                    (try
-                                                      (process [{:fill-one-language
-                                                                 {:count 1
-                                                                  :spec spec
-                                                                  :model model
-                                                                  }}]
-                                                               "it")
-                                                      (catch Exception e
-                                                        (cond
-
-                                                          ;; TODO: make this conditional on
-                                                          ;; there being a legitimate reason for the exception -
-                                                          ;; e.g. the verb is "funzionare" (which takes a non-human
-                                                          ;; subject), but we're trying to generate with
-                                                          ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
-                                                          ;; are human.
-
-                                                          (= true mask-populate-errors)
-                                                          (log/warn (str "ignoring exception: " e))
-
-                                                          true
-                                                          (throw e))))
-                                                    ))
-                                                numbers
-                                                ))))
+                                           (pmap (fn [number]
+                                                   (let [spec (unify spec
+                                                                     {:comp {:synsem {:agr {:number number}}}})]
+                                                     (log/debug (str "generating from spec: " spec "; input-spec was:" input-spec))
+                                                     (try
+                                                       (process [{:fill-one-language
+                                                                  {:count 1
+                                                                   :spec spec
+                                                                   :model model
+                                                                   }}]
+                                                                "it")
+                                                       (catch Exception e
+                                                         (cond
+
+                                                           ;; TODO: make this conditional on
+                                                           ;; there being a legitimate reason for the exception -
+                                                           ;; e.g. the verb is "funzionare" (which takes a non-human
+                                                           ;; subject), but we're trying to generate with
+                                                           ;; {:agr {:person :1st or :2nd}}, for which the only lexemes
+                                                           ;; are human.
+
+                                                           (= true mask-populate-errors)
+                                                           (log/warn (str "ignoring exception: " e))
+
+                                                           true
+                                                           (throw e))))
+                                                     ))
+                                                 numbers
+                                                 ))))
                                       persons
                                       ))))
                             genders))))


Add cats integration.

Add cats integration.


Add more stream transformers.

Add more stream transformers.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -227,14 +227,14 @@
   "Filters the elements of an observable sequence
   based on a predicate."
   [f ob]
-  {:pre [(observable? ob) (fn? f)]}
-  (.filter ob f))
+  {:pre [(observable? ob)]}
+  (.filter ob (fn [x] (f x))))

 (defn map
   "Apply a function to each element of an observable
   sequence."
   [f ob]
-  {:pre [(observable? ob) (fn? f)]}
+  {:pre [(observable? ob)]}
   (.map ob f))

 (defn flat-map
@@ -243,7 +243,7 @@
   observable sequences or Promises or array/iterable
   into one observable sequence."
   [f ob]
-  {:pre [(observable? ob) (fn? f)]}
+  {:pre [(observable? ob)]}
   (.flatMap ob f))

 (defn skip
@@ -253,6 +253,21 @@
   [n ob]
   {:pre [(observable? ob) (number? n)]}
   (.skip ob n))
+
+(defn skip-while
+  "Bypasses elements in an observable sequence as long
+  as a specified condition is true and then returns the
+  remaining elements."
+  [f ob]
+  {:pre [(observable? ob) (fn? f)]}
+  (.skipWhile ob f))
+
+(defn skip-until
+  "Returns the values from the source observable sequence
+  only after the other observable sequence produces a value."
+  [pob ob]
+  {:pre [(observable? ob) (observable? pob)]}
+  (.skipUntil ob pob))

 (defn take
   "Bypasses a specified number of elements in an
@@ -307,4 +322,30 @@
   {:pre [(observable? ob) (observable? pauser)]}
   (.pausable ob pauser))

-
+(defn dedupe
+  "Returns an observable sequence that contains only
+  distinct contiguous elements."
+  ([ob]
+   (.distinctUntilChanged ob))
+  ([f ob]
+   (.distinctUntilChanged ob f)))
+
+(defn dedupe'
+  "Returns an observable sequence that contains only d
+  istinct elements.
+  Usage of this operator should be considered carefully
+  due to the maintenance of an internal lookup structure
+  which can grow large."
+  ([ob]
+   (.distinct ob))
+  ([f ob]
+   (.distinct ob f)))
+
+(defn buffer
+  "Projects each element of an observable sequence into zero
+  or more buffers which are produced based on element count
+  information."
+  ([n ob]
+   (.bufferWithCount ob n))
+  ([n skip ob]
+   (.bufferWithCount ob n skip)))


refactor

refactor

--- src/bløggr/core.clj
+++ src/bløggr/core.clj
@@ -12,7 +12,6 @@
 (html/deftemplate post-template "layouts/post.html" [header body]
                   [:div#article-content] (html/html-content body)
                   [:#article-title] (html/content (header :title)))
-

 (defn parse-datestring [date-str]
   (tf/parse (tf/formatter "yyyy-MM-dd HH:mm:ssZ") date-str))
@@ -39,7 +38,8 @@
 (defn- highlight-node [n]
   (let [lang (:class (:attrs n))]
     (if (nil? lang) n
-        (assoc n :content (html/html-snippet (pygments/highlight (apply str (:content n))
+        (assoc n :content
+              (html/html-snippet (pygments/highlight (apply str (:content n))
                                                                  (keyword lang)
                                                                  :html))))))
 (defn highlight [post]
@@ -57,13 +57,13 @@
 (defn get-posts []
     (->> (stasis/slurp-directory "posts/" #"test.*\.(md|markdown)$")
          (vals)
-         (map parse-post)
-         (map markdown)
-         (map enliveify)
-         (map highlight)
-         (map render)
-         (map apply-post-layout)
-         (map filename-body-map)
+         (map #(comp parse-post
+                     markdown
+                     enliveify
+                     highlight
+                     render
+                     apply-post-layout
+                     filename-body-map))
          (reduce merge)))

 (defn get-css []


load_all.clj added org.altlaw.test.internal

--- src/org/altlaw/load_all.clj
+++ src/org/altlaw/load_all.clj
@@ -2,6 +2,7 @@
   (:require
    org.altlaw.internal.application

+   org.altlaw.test.internal
    org.altlaw.test.run

    org.altlaw.util.context


Formatting.

Formatting.

--- clj_record/test/main.clj
+++ clj_record/test/main.clj
@@ -13,15 +13,15 @@

 (defn create-tables []
   (sql/create-table :manufacturers
-    [:id "INT" "GENERATED ALWAYS AS IDENTITY CONSTRAINT manufacturer_pk PRIMARY KEY"]
-    [:name "VARCHAR(32)" "NOT NULL"]
+    [:id      :int "GENERATED ALWAYS AS IDENTITY CONSTRAINT manufacturer_pk PRIMARY KEY"]
+    [:name    "VARCHAR(32)" "NOT NULL"]
     [:founded "VARCHAR(4)"]
-    [:grade "INT"])
+    [:grade   :int])
   (sql/create-table :products
-    [:id "INT" "GENERATED ALWAYS AS IDENTITY CONSTRAINT product_pk PRIMARY KEY"]
-    [:name "VARCHAR(32)" "NOT NULL"]
-    [:price "INT"]
-    [:manufacturer_id "INT" "NOT NULL"]))
+    [:id              :int "GENERATED ALWAYS AS IDENTITY CONSTRAINT product_pk PRIMARY KEY"]
+    [:name            "VARCHAR(32)" "NOT NULL"]
+    [:price           :int]
+    [:manufacturer_id :int "NOT NULL"]))

 (sql/with-connection clj-record.config/db
   (sql/transaction


Update clojure-lang licence

Update clojure-lang licence

- Update licence from Eclipse Public License to
  MIT License.

--- clojure-lang/project.clj
+++ clojure-lang/project.clj
@@ -1,8 +1,8 @@
-(defproject clojure-lang "0.1.0-SNAPSHOT"
+(defproject clojure-lang "0.1.0"
   :description "Redis in Action example in Clojure"
-  :url "http://example.com/FIXME"
-  :license {:name "Eclipse Public License"
-            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :url "https://github.com/josiahcarlson/redis-in-action"
+  :license {:name "MIT License"
+            :url "https://opensource.org/licenses/MIT"}
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [com.taoensso/carmine "2.18.1"]
                  [cheshire "5.8.0"]


pushing calendar-state around

pushing calendar-state around

--- src/callie/core.cljs
+++ src/callie/core.cljs
@@ -72,7 +72,7 @@

 (def today (Date.))

-(defn start-day
+(defn first-day
   "First day to display on the calendar. Count back from the given date until
   the day is sunday (0)."
   [d]
@@ -81,7 +81,6 @@
       d
       (recur (prev-day d)))))

-
 (defn is-event-on-date?
   [event date]
   (let [event-date (Date. (:start event))]
@@ -92,14 +91,15 @@
   [d events]
   (filter #(is-event-on-date? % d) events))

-(defn month-year-span [d]
-  [:span {:id "cal-month-year"} (.format month-week-formatter d)])
+(defn month-year-span [calendar-state]
+  (let [active-date (:active-date calendar-state)]
+    [:span {:id "cal-month-year"} (.format month-week-formatter active-date)]))

 (defn is-today? [d]
   (.equals d today))

-(defn is-active-month? [d]
-  (= (.getMonth (:active-date @calendar-state))
+(defn is-active-month? [d calendar-state]
+  (= (.getMonth (:active-date calendar-state))
      (.getMonth d)))

 (def weekday-row
@@ -107,32 +107,33 @@
    (for [x WEEKDAY-NAMES]
      [:th x])])

-(defn day-classes [d]
+(defn day-classes [d calendar-state]
   (cond-> []
     (is-today? d) (conj "today")
-    (is-active-month? d) (conj "active-month")
+    (is-active-month? d calendar-state) (conj "active-month")
     (not (is-active-month? d)) (conj "not-active-month")))

-(defn event-div [ev]
+(defn event-div [ev calendar-state]
   [:div {:class ["event"]}
    [:a [:span.time (.format event-time-formatter (:start ev))]
        [:span.title (:title ev)]]])

-(defn day-cell [d events]
-  [:td
-   {:class (string/join " " (day-classes d))}
-   [:span {:class "daynumber"} (.getDate d)]
-   (for [ev (days-events-filter d events)]
-     (event-div ev))])
+(defn day-cell [d calendar-state]
+  (let [days-events (days-events-filter d (:events calendar-state))]
+    [:td
+     {:class (string/join " " (day-classes d calendar-state))}
+     [:span {:class "daynumber"} (.getDate d)]
+     (for [ev days-events]
+       (event-div ev calendar-state))]))

 (defn calendar-body
   "6 weeks of days (The body of the calendar.)"
-  [d events]
-  (let [sd (start-day d)
-        all-days (take 6 (partition 7 (iterate next-day sd)))]
+  [calendar-state]
+  (let [start-day (first-day (:active-date calendar-state))
+        all-days (take 6 (partition 7 (iterate next-day start-day)))]
     (for [week all-days]
       [:tr
-       (for [day week] (day-cell day events))])))
+       (for [day week] (day-cell day calendar-state))])))

 (def prev-next-today-btns
   (list
@@ -150,14 +151,12 @@
 (defn calendar-hiccup
   "Hiccup tempate for the calendar"
   [calendar-state]
-  (let [d (:active-date calendar-state)
-        events (:events calendar-state)]
     [:div.callie-view
      prev-next-today-btns
-     [:h2 {:class "month-year"} (month-year-span d)]
+     [:h2 {:class "month-year"} (month-year-span calendar-state)]
      [:table.table.table-bordered
       [:thead weekday-row]
-      [:tbody (calendar-body d events)]]]))
+      [:tbody (calendar-body calendar-state)]]])

 (defn inject-cal! [calendar-state]


Fixed nil value bug for bounds.

Fixed nil value bug for bounds.

--- src/plan_schema/coerce.cljc
+++ src/plan_schema/coerce.cljc
@@ -101,7 +101,7 @@
   (to-set-of-keywords key value))

 (defmethod convert-property :value [key value]
-  (to-set-of-keywords key value))
+  {key value})

 (defmethod convert-property :args [key value]
   {key value})


fixed ByteBuffer management

fixed ByteBuffer management

this should be (.position 0) to ensure the buffer is at the beginning

--- src/play_clj/core_utils.clj
+++ src/play_clj/core_utils.clj
@@ -21,7 +21,7 @@
       (doto pixels
         (.clear)
         (.put pixel-data)
-        (.position))
+        (.position 0))
       pic))
   ([path]
     (let [pic (screenshot!)


Refactoring MVN

Refactoring MVN

--- src/carambar/mvn.clj
+++ src/carambar/mvn.clj
@@ -28,11 +28,26 @@
      {:project (zx/xml1-> xz :artifactId zx/text)}
      {:dependencies (dependencies xz)})))

+
+(defn mvn-output
+  "doc-string"
+  [output]
+  (if (not-empty output)
+    (format "-Doutput=%s" output)))
+
+(defn mvn-pom
+  "doc-string"
+  [pom]
+  (if (not-empty pom)
+    ["-f" pom]))
+
+
 (defn mvn
   "Runs mvn command"
-  [goal & options]
-  (let [mvn-ret (apply sh/sh "mvn" goal options)]
-    (if-not (= 0 (:exit mvn-ret))
+  [{goal :goal pom :pom output :output}]
+  (let [mvn-ret (apply sh/sh "mvn" goal (mvn-output output) (mvn-pom pom))]
+    (if (= 0 (:exit mvn-ret))
+       output
       (throw (Exception. (:out mvn-ret))))))

 (defn mvn-settings
@@ -41,20 +56,27 @@
   (let [xz (zip/xml-zip (xml/parse settings))]
     (zx/xml1-> xz :localRepository zx/text)))

+(def effective-settings-path (format "%s/mvn-settings.xml" (System/getProperty "java.io.tmpdir")))
+
+(def effective-pom-path
+  (format "%s/effective-pom.xml" (System/getProperty "java.io.tmpdir")))
+
+
 (defn mvn-help:effective-settings
   "Maven help:effective settings command."
   []
-  (mvn "help:effective-settings" "-Doutput=mvn-settings.xml"))
+  (mvn {:goal "help:effective-settings"
+        :output effective-settings-path}))

 (def local-repo
-  (do (mvn-help:effective-settings)
-      (mvn-settings "mvn-settings.xml")))
+  (-> (mvn-help:effective-settings)
+      (mvn-settings)))

 (defn mvn-help:effective-pom
   [project-dir]
-  (mvn "help:effective-pom"
-       "-f" (format "%s/pom.xml" project-dir)
-       "-Doutput=effective-pom.xml"))
+  (mvn {:goal "help:effective-pom"
+        :pom (format "%s/pom.xml" project-dir)
+        :output effective-pom-path}))

 (defn expand-dependency-path
   "Expand dependency path with maven repo path. "
@@ -69,9 +91,9 @@
 (defn read-pom
   "Process maven project from DIR"
   [project-dir]
-  (do
-    (mvn-help:effective-pom project-dir)
-    (project-info (format "%s/effective-pom.xml" project-dir))))
+  (->
+     (mvn-help:effective-pom project-dir)
+     (project-info)))

 (defn dependencies-path
   "Provide dependencies path"


will not auto load schemas

will not auto load schemas

--- src/clj/neb/core.clj
+++ src/clj/neb/core.clj
@@ -49,13 +49,9 @@
               {:keys [memory-size data-path]} config
               trunks-size (interpret-volume trunks-size)
               memory-size (interpret-volume memory-size)
-              schemas (or (try (:data (ds/get-configure :schemas)) (catch Exception _))
-                          (let [s (load-schemas-file (str data-path "/schemas"))]
-                            (ds/set-configure :schemas s) s))
               trunk-count (int (Math/floor (/ memory-size trunks-size)))]
           (println "Loading Store...")
           (clear-schemas)
-          (load-schemas schemas)
           (init-trunks trunk-count trunks-size)
           (start-defrag)
           (register-as-master (* 50 trunk-count))


2 updates

2 updates

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -23,7 +23,8 @@
 (defn sqlquery [name]

 ;(first (jdbc/query mysql-db [(str "select * from konten where Name='" name "'")])))
-(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand - 1 WHERE Kontostand > 0 AND Name = ?" name]))
+(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand - 1 WHERE Kontostand > 0 AND Name = ?" name])
+(jdbc/execute! mysql-db ["UPDATE konten SET Kontostand = Kontostand + 1 WHERE NurZahlen = 0 AND Name = ?" name]))
 ;(jdbc/update! mysql-db :konten {:Kontostand 99} ["Name = ?" name]))
 ; maybe this sets the guthaben to 99


CMR-418: Moving helper functions to add authentication information to the context to the acl lib.

--- src/cmr/acl/core.clj
+++ src/cmr/acl/core.clj
@@ -5,6 +5,37 @@
             [cmr.transmit.echo.acls :as echo-acls]
             [cmr.transmit.echo.tokens :as echo-tokens]
             [cmr.acl.collection-matchers :as cm]))
+
+(def BROWSER_CLIENT_ID "browser")
+(def CURL_CLIENT_ID "curl")
+(def UNKNOWN_CLIENT_ID "unknown")
+
+(def token-header
+  "echo-token")
+
+(defn- get-token
+  "Returns the token the user passed in the headers or parameters"
+  [params headers]
+  (or (:token params) (get headers token-header)))
+
+(defn- get-client-id
+  "Gets the client id passed by the client or tries to determine it from other headers"
+  [headers]
+  (or (get headers "client-id")
+      (when-let [user-agent (get headers "user-agent")]
+        (cond
+          (or (re-find #"^Mozilla.*" user-agent) (re-find #"^Opera.*" user-agent))
+          BROWSER_CLIENT_ID
+          (re-find #"^curl.*" user-agent)
+          CURL_CLIENT_ID))
+      UNKNOWN_CLIENT_ID))
+
+(defn add-authentication-to-context
+  "Adds information to the context including the current token and the client id"
+  [context params headers]
+  (-> context
+      (assoc :token (get-token params headers))
+      (assoc :client-id (get-client-id headers))))

 (defn context->sids
   "Returns the security identifiers (group guids and :guest or :registered) of the user identified


Implement ITransientCollection

Implement ITransientCollection

--- src/hodgepodge/core.cljs
+++ src/hodgepodge/core.cljs
@@ -56,6 +56,16 @@
   (-assoc! [^js/Storage s key val]
     (set-item s (serialize key) (serialize val)))

+  ITransientCollection
+  (-conj! [^js/Storage s ^IMapEntry kv]
+    (assoc! s (key kv) (key kv)))
+  (-persistent! [^js/Storage s]
+    (into {}
+          (for [i (range (count s))
+                :let [k (.key s i)
+                      v (get-item s k)]]
+              [k (deserialize v)])))
+
   ITransientMap
   (-dissoc! [^js/Storage s key]
     (remove-item s (serialize key)))


Make click reporting bolder.

Make click reporting bolder.

--- src/re_demo/row_button.cljs
+++ src/re_demo/row_button.cljs
@@ -81,7 +81,10 @@
                                           [label :label "Actions" :width (:actions col-widths)]]]
                               (for [[_ row first? last?] (enumerate (sort-by :sort (vals rows)))]
                                 ^{:key (:id row)} [data-row row first? last? col-widths mouse-over click-msg])]]
-                  [label :label (str "Last row-button click: " @click-msg)]]])))
+                  [h-box
+                   :gap "5px"
+                   :children [[label :label "clicked: "]
+                              [label :label (str @click-msg) :style {:font-weight "bold"}]]]]])))

 (defn row-button-demo


Fix bug in `is-true`.

Fix bug in `is-true`.

--- src/reforms/validation.cljs
+++ src/reforms/validation.cljs
@@ -160,7 +160,7 @@
      (is-true [:user :email] #(nil? (find-by-email %)) \"Email already exists\"]"
   [korks f error-message]
   (fn [cursor]
-    (when-not (f cursor)
+    (when-not (f (get-in cursor korks))
       (validation-error [korks] error-message))))

 (defn force-error


:bug: Fix ordering on undo operation on adding/duplicating shape.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -1046,14 +1046,12 @@
                                {:type :add-obj
                                 :id (:id obj)
                                 :frame-id frame-id
-                                :obj (assoc obj :frame-id frame-id)
-                                :session-id (:session-id state)}))
+                                :obj (assoc obj :frame-id frame-id)}))
                            (:shapes frame))

             uchanges (mapv (fn [rch]
                              {:type :del-obj
-                              :id (:id rch)
-                              :session-id (:session-id state)})
+                              :id (:id rch)})
                            rchanges)

             shapes (mapv :id rchanges)
@@ -1071,7 +1069,7 @@
                      :id frame-id
                      :session-id (:session-id state)}]
         (rx/of (commit-changes (d/concat [rchange] rchanges)
-                               (d/concat [uchange] uchanges)
+                               (d/concat [] uchanges [uchange])
                                {:commit-local? true}))))))


:lipstick: Fix naming of some functions on workspace data ns.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -52,8 +52,11 @@
 ;; --- Specs

 (s/def ::shape-attrs ::cp/shape-attrs)
+
 (s/def ::set-of-uuid
   (s/every uuid? :kind set?))
+(s/def ::set-of-string
+  (s/every string? :kind set?))

 ;; --- Expose inner functions

@@ -930,23 +933,57 @@
 ;; Shapes events
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;; --- Toggle shape's selection status (selected or deselected)
+
+(defn select-shape
+  [id]
+  (us/verify ::us/uuid id)
+  (ptk/reify ::select-shape
+    ptk/UpdateEvent
+    (update [_ state]
+      (update-in state [:workspace-local :selected]
+                 (fn [selected]
+                   (if (contains? selected id)
+                     (disj selected id)
+                     (conj selected id)))))))
+
+(defn select-shapes
+  [ids]
+  (us/verify ::set-of-uuid ids)
+  (ptk/reify ::select-shapes
+    ptk/UpdateEvent
+    (update [_ state]
+      (assoc-in state [:workspace-local :selected] ids))))
+
+(def deselect-all
+  "Clear all possible state of drawing, edition
+  or any similar action taken by the user."
+  (ptk/reify ::deselect-all
+    ptk/UpdateEvent
+    (update [_ state]
+      (update state :workspace-local #(-> %
+                                          (assoc :selected #{})
+                                          (dissoc :selected-frame))))))
+
+
 ;; --- Add shape to Workspace

-(defn impl-retrieve-used-names
+(defn- retrieve-used-names
   [objects]
   (into #{} (map :name) (vals objects)))

-(defn extract-numeric-suffix
+(defn- extract-numeric-suffix
   [basename]
   (if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
     [p1 (+ 1 (d/parse-integer p2))]
     [basename 1]))

-(defn impl-generate-unique-name
+(defn- generate-unique-name
   "A unique name generator"
-  [objects basename]
-  (let [used (impl-retrieve-used-names objects)
-        [prefix initial] (extract-numeric-suffix basename)]
+  [used basename]
+  (s/assert ::set-of-string used)
+  (s/assert ::us/string basename)
+  (let [[prefix initial] (extract-numeric-suffix basename)]
     (loop [counter initial]
       (let [candidate (str prefix "-" counter)]
         (if (contains? used candidate)
@@ -1014,16 +1051,6 @@
 (declare prepare-duplicate-change)
 (declare prepare-duplicate-frame-change)
 (declare prepare-duplicate-shape-change)
-
-(defn impl-generate-unique-name2
-  "A unique name generator"
-  [used basename]
-  (let [[prefix initial] (extract-numeric-suffix basename)]
-    (loop [counter initial]
-      (let [candidate (str prefix "-" counter)]
-        (if (contains? used candidate)
-          (recur (inc counter))
-          candidate)))))

 (def ^:private change->name #(get-in % [:obj :name]))

@@ -1056,7 +1083,7 @@
 (defn- prepare-duplicate-shape-change
   [objects names obj delta frame-id parent-id]
   (let [id (uuid/next)
-        name (impl-generate-unique-name2 names (:name obj))
+        name (generate-unique-name names (:name obj))
         renamed-obj (assoc obj :id id :name name)
         moved-obj (geom/move renamed-obj delta)
         frame-id (if frame-id
@@ -1093,8 +1120,8 @@

 (defn- prepare-duplicate-frame-change
   [objects names obj delta]
-  (let [frame-id (uuid/next)
-        frame-name (impl-generate-unique-name2 names (:name obj))
+  (let [frame-id   (uuid/next)
+        frame-name (generate-unique-name names (:name obj))
         sch (->> (map #(get objects %) (:shapes obj))
                  (mapcat #(prepare-duplicate-shape-change objects names % delta frame-id frame-id)))

@@ -1124,7 +1151,7 @@
             selected (get-in state [:workspace-local :selected])
             objects (get-in state [:workspace-data page-id :objects])
             delta (gpt/point 0 0)
-            unames (impl-retrieve-used-names objects)
+            unames (retrieve-used-names objects)

             rchanges (prepare-duplicate-changes objects unames selected delta)
             uchanges (mapv #(array-map :type :del-obj :id (:id %))
@@ -1137,39 +1164,6 @@

         (rx/of (commit-changes rchanges uchanges {:commit-local? true})
                (select-shapes selected))))))
-
-
-;; --- Toggle shape's selection status (selected or deselected)
-
-(defn select-shape
-  [id]
-  (us/verify ::us/uuid id)
-  (ptk/reify ::select-shape
-    ptk/UpdateEvent
-    (update [_ state]
-      (update-in state [:workspace-local :selected]
-                 (fn [selected]
-                   (if (contains? selected id)
-                     (disj selected id)
-                     (conj selected id)))))))
-
-(defn select-shapes
-  [ids]
-  (us/verify ::set-of-uuid ids)
-  (ptk/reify ::select-shapes
-    ptk/UpdateEvent
-    (update [_ state]
-      (assoc-in state [:workspace-local :selected] ids))))
-
-(def deselect-all
-  "Clear all possible state of drawing, edition
-  or any similar action taken by the user."
-  (ptk/reify ::deselect-all
-    ptk/UpdateEvent
-    (update [_ state]
-      (update state :workspace-local #(-> %
-                                          (assoc :selected #{})
-                                          (dissoc :selected-frame))))))

 ;; --- Select Shapes (By selrect)
@@ -2189,7 +2183,7 @@

             page-id (::page-id state)
             unames (-> (get-in state [:workspace-data page-id :objects])
-                       (impl-retrieve-used-names))
+                       (retrieve-used-names))

             rchanges (prepare-duplicate-changes objects unames selected delta)
             uchanges (mapv #(array-map :type :del-obj :id (:id %))


:fire: Remove commented code.

:fire: Remove commented code.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -197,7 +197,6 @@

 (defn initialize-viewport
   [{:keys [width height] :as size}]
-  (js/console.log "initialize-viewport" size)
   (ptk/reify ::initialize-viewport
     ptk/UpdateEvent
     (update [_ state]
@@ -208,11 +207,7 @@
                     (update :vbox (fn [vbox]
                                     (if (nil? vbox)
                                       (assoc size :x 0 :y 0)
-                                      vbox)))))))
-
-    ptk/WatchEvent
-    (watch [_ state stream]
-      #_(rx/of zoom-to-fit-all))))
+                                      vbox)))))))))

 (defn update-viewport-position
   [{:keys [x y] :or {x identity y identity}}]


Utility function for forcing invalidation

--- src/derive/core.cljs
+++ src/derive/core.cljs
@@ -284,6 +284,14 @@
       (doseq [l (get listeners ldeps)]
         (l store deps)))))

+(defn force-invalidation
+  "Force invalidate all listeners to this store"
+  [store]
+  (let [listeners (.-listeners store)]
+    (doseq [ldeps (keys listeners)]
+      (doseq [l (get listeners ldeps)]
+        (l store nil)))))
+
 (defn derive-listener
   "Helper. Handle source listener events"
   [derive store deps]
@@ -292,7 +300,7 @@
         param-set (set (invalidate! cache store deps))]
     (when-not (empty? param-set)
       (notify-listeners derive param-set))))
-
+
 (defn invalidate-all-listeners
   "Helper. Inform upstream when we're redefined"
   [derive]


core: get-in

core: get-in

--- core/data/core.clj
+++ core/data/core.clj
@@ -2686,6 +2686,24 @@
   {:added "1.0"}
   [coll] (not (seq coll)))

+(defn get-in
+  "Returns the value in a nested associative structure,
+  where ks is a sequence of keys. Returns nil if the key
+  is not present, or the not-found value if supplied."
+  {:added "1.0"}
+  ([m ks]
+   (reduce1 get m ks))
+  ([m ks not-found]
+   (loop [sentinel {}
+          m m
+          ks (seq ks)]
+     (if ks
+       (let [m (get m (first ks) sentinel)]
+         (if (identical? sentinel m)
+           not-found
+           (recur sentinel m (next ks))))
+       m))))
+
 (defmacro cond->
   "Takes an expression and a set of test/form pairs. Threads expr (via ->)
   through each form for which the corresponding test


[#1787] Add text support for `count` aggregation

--- backend/src/akvo/lumen/lib/aggregation/bubble.clj
+++ backend/src/akvo/lumen/lib/aggregation/bubble.clj
@@ -20,7 +20,8 @@
 (defn sql-aggregation-subquery [aggregation-method column-string column-type]
   (case aggregation-method
     nil ""
-    ("min" "max" "count" "sum") (str aggregation-method "(" (cast-to-decimal column-string column-type) "::decimal)")
+    ("min" "max" "sum") (str aggregation-method "(" (cast-to-decimal column-string column-type) "::decimal)")
+    "count" (str aggregation-method "(" column-string (if (#{"number" "data"} column-type) "::decimal" "::text") ")")
     "mean" (str "avg(" (cast-to-decimal column-string column-type) "::decimal)")
     "median" (str "percentile_cont(0.5) WITHIN GROUP (ORDER BY " (cast-to-decimal column-string column-type) ")")
     "distinct" (str "COUNT(DISTINCT " (cast-to-decimal column-string column-type) ")")


CMR-7853 (#1461)

CMR-7853 (#1461)

* use default quartz naming convention

--- ingest-app/src/cmr/ingest/services/jobs.clj
+++ ingest-app/src/cmr/ingest/services/jobs.clj
@@ -44,7 +44,7 @@

 (def EMAIL_SUBSCRIPTION_PROCESSING_JOB_KEY
   "Quartz job key for EmailSubscriptionProcessing job."
-  "email-subscription-processing")
+  "EmailSubscriptionProcessing.job")

 (defn acls->provider-id-hashes
   "Converts acls to a map of provider-ids to hashes of the ACLs."


patches due to upstream bug fix for numbers into attributes

--- medications/medications.clj
+++ medications/medications.clj
@@ -34,7 +34,7 @@
        :create (pattern
                  (node 'tf2 {:asserts {:frame "'&frame'" :frequency "'&freq'" :kind "'TimeFrame'"}})
                  (edge 'e {:label "timeframe" :src 'i1 :tar 'tf2})
-                 (assign "i1.duration='&duration'")
+                 (assign "i1.duration=&duration")
                )
       }
 )


props can be nil

props can be nil

--- src/main/om_css/dom.cljc
+++ src/main/om_css/dom.cljc
@@ -120,12 +120,13 @@
   [params]
   (let [props (first params)]
     (update
-      (if #?(:clj (and (map? props)
+      (if (or (nil? props)
+            #?(:clj  (and (map? props)
                        (not (record? props)))
-             :cljs (or (and (cljs.core/object? props)
-                            (not (aget props "$$typeof"))
-                            (not= (goog/typeOf (aget props "$$typeof")) "symbol"))
-                       (map? props)))
+               :cljs (or (and (cljs.core/object? props)
+                           (not (aget props "$$typeof"))
+                           (not= (goog/typeOf (aget props "$$typeof")) "symbol"))
+                       (map? props))))
         [props (rest params)]
         [nil params])
       1 flatten)))


Metabot support spaces in card names :robot_face:

--- src/metabase/metabot.clj
+++ src/metabase/metabot.clj
@@ -92,7 +92,7 @@
   "Implementation of the `metabot show card <name-or-id>` command."
   ([]
    "Show which card? Give me a part of a card name or its ID and I can show it to you. If you don't know which card you want, try `metabot list`.")
-  ([card-id-or-name & _]
+  ([card-id-or-name]
    (if-let [{card-id :id} (id-or-name->card card-id-or-name)]
      (do
        (do-async (let [attachments (pulse/create-and-upload-slack-attachments! [(pulse/execute-card card-id)])]
@@ -100,7 +100,10 @@
                                              nil
                                              attachments)))
        "Ok, just a second...")
-     (throw (Exception. "Not Found")))))
+     (throw (Exception. "Not Found"))))
+  ;; If the card name comes without spaces, e.g. (show 'my 'wacky 'card) turn it into a string an recur: (show "my wacky card")
+  ([word & more]
+   (show (apply str (interpose " " (cons word more))))))

 (defn meme:up-and-to-the-right


More naming improvements

More naming improvements

$ -> stream, g -> goal

--- src/micro_logic/core.clj
+++ src/micro_logic/core.clj
@@ -193,9 +193,9 @@
 ;;   along the way.
 (def empty-stream
   (reify IStream
-    (merge-streams [$1 $2] $2)
-    (mapcat-stream [$ g] $)
-    (realize-stream-head [$] $)))
+    (merge-streams [stream-1 stream-2] stream-2)
+    (mapcat-stream [stream g] stream)
+    (realize-stream-head [stream] stream)))

 ;; ### Mature streams (StreamNode)
 ;;
@@ -210,11 +210,11 @@
 ;; `mapcat-stream` to `mapcat`.
 (deftype StreamNode [head next]
   IStream
-  (merge-streams [$1 $2] (StreamNode. head
-                                      (merge-streams next $2)))
-  (mapcat-stream [$ g] (merge-streams (g head)
+  (merge-streams [stream-1 stream-2] (StreamNode. head
+                                      (merge-streams next stream-2)))
+  (mapcat-stream [stream g] (merge-streams (g head)
                                       (mapcat-stream next g)))
-  (realize-stream-head [$] $))
+  (realize-stream-head [stream] stream))

 ;; ### Immature streams (IFn)
 ;;
@@ -231,12 +231,12 @@
 ;; interleaving. Let's examine the definition:
 ;;
 ;;     clojure.lang.IFn
-;;     (merge-streams [$1 $2] #(merge-streams $2 ($1)))
-;;
-;; Working from the inside out: we know that $1 is a function because
+;;     (merge-streams [stream-1 stream-2] #(merge-streams stream-2 (stream-1)))
+;;
+;; Working from the inside out: we know that stream-1 is a function because
 ;; we're extending IStream onto IFn; calling it will perform one 'step
 ;; of computation', whatever that might be. It returns a stream.
-;; Then we merge that stream with $2, the second parameter of this merge operation,
+;; Then we merge that stream with stream-2, the second parameter of this merge operation,
 ;; *but the order is reversed*.
 ;;
 ;; Finally, the above operation is all wrapped in a thunk. So we end up with a
@@ -263,7 +263,7 @@
 ;; mapcat-stream is somewhat simpler.
 ;;
 ;;     clojure.lang.IFn
-;;     (mapcat-stream [$ g] #(mapcat-stream ($) g))
+;;     (mapcat-stream [stream g] #(mapcat-stream (stream) g))
 ;;
 ;; The basic concept here is pretty straightforward: make a new thunk which,
 ;; when executed later, will do some work and then mapcat `g` over the result.
@@ -271,11 +271,11 @@
 ;; TODO: explain why this needs to be wrapped in a thunk
 (extend-protocol IStream
   clojure.lang.IFn
-  (merge-streams [$1 $2] #(merge-streams $2 ($1)))
-  (mapcat-stream [$ g] #(mapcat-stream ($) g))
-  (realize-stream-head [$] (trampoline $)))
-
-(defn stream [s] (StreamNode. s empty-stream))
+  (merge-streams [stream-1 stream-2] #(merge-streams stream-2 (stream-1)))
+  (mapcat-stream [stream g] #(mapcat-stream (stream) g))
+  (realize-stream-head [stream] (trampoline stream)))
+
+(defn make-stream [s] (StreamNode. s empty-stream))

 ;; #### Seq conversion
 ;;
@@ -283,12 +283,12 @@
 ;; fairly straightforward to convert it. Running realize-stream-head
 ;; bounces the trampoline until a result comes out, at which point we
 ;; can give it to the caller.
-(defn stream-to-seq [$]
+(defn stream-to-seq [stream]
   (lazy-seq
-   (let [$' (realize-stream-head $)]
-     (if (= empty-stream $')
+   (let [stream (realize-stream-head stream)]
+     (if (= empty-stream stream)
        '()
-       (cons (.head $') (stream-to-seq (.next $')))))))
+       (cons (.head stream) (stream-to-seq (.next stream)))))))

 ;; ## Goals
@@ -321,7 +321,7 @@
   [u v]
   (fn unify-goal [{:keys [s-map] :as state}]
     (if-let [s-map' (unify u v s-map)]
-      (stream (with-s-map state s-map'))
+      (make-stream (with-s-map state s-map'))
       empty-stream)))

 (defn call-fresh
@@ -335,18 +335,18 @@

 (defn ldisj
   "Logical disjuction ('or'). Construct a new goal that succeeds
-  whenever *g1* or *g2* succeed. `merge-streams` is used on each
+  whenever *goal-1* or *goal-2* succeed. `merge-streams` is used on each
   goal's output to ensure fair scheduling between the two."
-  [g1 g2]
+  [goal-1 goal-2]
   (fn disj-goal [state]
-    (merge-streams (g1 state) (g2 state))))
+    (merge-streams (goal-1 state) (goal-2 state))))

 (defn lconj
   "Logical conjunction ('and'). Construct a new goal that succeeds
-  when both *g1* and *g2* succeed."
-  [g1 g2]
+  when both *goal-1* and *goal-2* succeed."
+  [goal-1 goal-2]
   (fn conj-goal [state]
-    (mapcat-stream (g1 state) g2)))
+    (mapcat-stream (goal-1 state) goal-2)))

@@ -364,9 +364,9 @@
   realize-stream-head.

   This is useful for defining recursive goals."
-  [g]
+  [goal]
   `(fn delayed-goal-outer [state#]
-     (fn delayed-goal-inner [] (~g state#))))
+     (fn delayed-goal-inner [] (~goal state#))))

 (defmacro ldisj+
   "Extended version of the `ldisj` function. This one handles multiple
@@ -374,13 +374,13 @@
   with `delay-goal`, so you don't need to worry about adding them yourself.

   (This does have a performance cost, but speed is not the point of this port)"
-  ([g] `(delay-goal ~g))
-  ([g & gs] `(ldisj (delay-goal ~g) (ldisj+ ~@gs))))
+  ([goal] `(delay-goal ~goal))
+  ([goal & goals] `(ldisj (delay-goal ~goal) (ldisj+ ~@goals))))

 (defmacro lconj+
   "Like `ldisj+`, but for `lconj`."
-  ([g] `(delay-goal ~g))
-  ([g & gs] `(lconj (delay-goal ~g) (lconj+ ~@gs))))
+  ([goal] `(delay-goal ~goal))
+  ([goal & goals] `(lconj (delay-goal ~goal) (lconj+ ~@goals))))

@@ -443,7 +443,7 @@

 (defmacro fresh
   "Provide a more convenient syntax for `call-fresh`. `fresh` lets you
-  declare multiple logic variables and once, and it takes care of the
+  declare multiple logic variables at once, and it takes care of the
   function declaration mechanics for you.

   The body of fresh is passed to `lconj+`, a logical 'and'.
@@ -460,19 +460,14 @@
                    (fresh [~@(rest var-vec)]
                      ~@clauses)))))

-(defn call-empty-state [g]
-  (g empty-state))
-
-(defmacro basic-run*
-  "reify-fn: state -> thing you want"
-  [reify-fn query-var-vec & gs]
-  `(->> (fresh [~@query-var-vec] ~@gs)
+(defn call-empty-state [goal]
+  (goal empty-state))
+
+(defmacro run* [fresh-var-vec & goals]
+  `(->> (fresh [~@fresh-var-vec] ~@goals)
      call-empty-state
      stream-to-seq
-     (map ~reify-fn)))
-
-(defmacro run* [query-var-vec & gs]
-  `(basic-run* reify-state-first-var [~@query-var-vec] ~@gs))
-
-(defmacro run [n query-var-vec & gs]
-  `(take ~n (run* ~query-var-vec ~@gs)))
+     (map reify-state-first-var)))
+
+(defmacro run [n fresh-var-vec & goals]
+  `(take ~n (run* ~fresh-var-vec ~@goals)))


Allow autocomplete typing in the middle of a message

--- src/braid/core/client/ui/views/new_message.cljs
+++ src/braid/core/client/ui/views/new_message.cljs
@@ -111,7 +111,8 @@
         state (r/atom {:text thread-text
                        :force-close? false
                        :highlighted-result-index 0
-                       :results nil})
+                       :results nil
+                       :pos 0})

         reset-state! (fn []
                        (swap! state assoc
@@ -161,8 +162,11 @@
                       (update-thread-text! thread-id text)))

         update-text! (fn [f]
-                       (swap! state update :text f)
-                       (update-thread-text! thread-id (@state :text)))
+                       (let [{:keys [text pos]} @state
+                             updated-text (f (.slice text 0 pos))
+                             new-text (str updated-text (.slice text pos))]
+                         (swap! state assoc :text new-text)
+                         (update-thread-text! thread-id (@state :text))))

         choose-result!
         (fn [result]
@@ -175,9 +179,9 @@
                          ;TODO

-        handle-text-change! (fn [text]
+        handle-text-change! (fn [cursor text]
                               (clear-force-close!)
-                              (put! autocomplete-chan text))
+                              (put! autocomplete-chan {:text text :pos cursor}))

         ; returns a function that can be used in a textarea's :on-key-down handler
         ; takes a callback fn, the textareas intended submit action
@@ -215,7 +219,9 @@
         autocomplete-on-change
         (fn [{:keys [on-change]}]
           (fn [e]
-            (handle-text-change! (.. e -target -value))
+            (let [cursor-pos (.. e -target -selectionStart)]
+              (handle-text-change! cursor-pos (.. e -target -value))
+              (swap! state assoc :pos cursor-pos))
             (on-change e)))]

     (r/create-class
@@ -224,12 +230,14 @@
        (fn [c]
          (let [config (r/props c)]
            (go (loop []
-                 (let [[text ch] (alts! [throttled-autocomplete-chan kill-chan])]
+                 (let [[data ch] (alts! [throttled-autocomplete-chan kill-chan])]
                    (when (= ch throttled-autocomplete-chan)
-                     (when-not (inside-code-block? text)
-                       (set-results!
-                         (seq (mapcat (fn [e] (e text)) @autocomplete-engines)))
-                       (highlight-first!))
+                     (let [{:keys [text pos]} data
+                           text (.slice text 0 pos)]
+                       (when-not (inside-code-block? text)
+                         (set-results!
+                           (seq (mapcat (fn [e] (e text)) @autocomplete-engines)))
+                         (highlight-first!)))
                      (recur)))))
            (go (loop []
                  (let [[v ch] (alts! [throttled-thread-text-chan


Add support for yet another mysql adapter. Fixes a problem with soundcloud

--- src/circle/backend/build/inference/gems_map.clj
+++ src/circle/backend/build/inference/gems_map.clj
@@ -23,4 +23,5 @@
    "sqlite3" "sqlite3"
    "mysql" "mysql"
    "mysql2" "mysql2"
-   "do_mysql" "mysql"})+   "do_mysql" "mysql"
+   "jberkel-mysql-ruby" "mysql"})


Formatting and just warn on edge creation problem

--- src/clj/cglossa/data_import/metadata_values.clj
+++ src/clj/cglossa/data_import/metadata_values.clj
@@ -92,12 +92,13 @@
                               rest
                               (filter #(not (get #{"startpos" "endpos"} %1))))
           cat-edges      (map (fn [cat]
-                                {:edge {:class                "HasMetadataValue"
-                                        :lookup               (str "SELECT from MetadataValue WHERE corpus_cat = '"
-                                                                   (str corpus "_" cat)
-                                                                   "' AND value = ?")
-                                        :joinFieldName        cat
-                                        :unresolvedLinkAction "ERROR"}})
+                                {:edge
+                                 {:class                "HasMetadataValue"
+                                  :lookup               (str "SELECT from MetadataValue WHERE corpus_cat = '"
+                                                             (str corpus "_" cat)
+                                                             "' AND value = ?")
+                                  :joinFieldName        cat
+                                  :unresolvedLinkAction "WARNING"}})
                               other-cats)
           field-removals (map (fn [cat]
                                 {:field {:fieldName cat


Replace variance by math3 impl

Replace variance by math3 impl

--- src/clj/clojurewerkz/statistiker/statistics.clj
+++ src/clj/clojurewerkz/statistiker/statistics.clj
@@ -12,11 +12,7 @@

 (defn variance
   [values]
-  (let [m (mean values)]
-    (/ (->> values
-            (map #(pow (- % m) 2))
-            (reduce +))
-       (- (count values) 1))))
+  (StatUtils/variance (double-array values)))

 (defn standard-deviation
   [values]


more simplification

more simplification

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -13,10 +13,12 @@
 (def concurrent false)

 (declare add-complement)
+(declare lexemes-before-phrases)
 (declare lightning-bolt)
 (declare generate-all)
 (declare in-case-of-no-phrasal-complements)
 (declare path-to-map)
+(declare show-bolt)

 (defn exception [error-string]
   #?(:clj
@@ -56,7 +58,9 @@
             (log/debug (str "generate-all: cat: " (get-in spec [:synsem :cat])))
             (let [add-complements-to-bolts
                   (fn [bolts path]
-                    (mapcat #(add-complement % path :top grammar lexicon index morph 0)
+                    (mapcat #(if (not (= :none (get-in % path :none)))
+                               (add-complement % path :top grammar lexicon index morph 0)
+                               [%])
                             bolts))]
               (-> (lightning-bolt (lazy-shuffle grammar)
                                      lexicon
@@ -67,19 +71,13 @@
                   (add-complements-to-bolts [:head :comp])
                   (add-complements-to-bolts [:comp]))))))

-(defn lexemes-before-phrases [depth]
-  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
-  (let [result (> (rand-int (+ 1 depth)) 0)]
-    (log/trace (str "lexemes-before-phrases: depth=" depth " => " result))
-    result))
-
 ;; TODO: add usage of rule-to-lexicon cache (rather than using lexicon directly)
 (defn lightning-bolt [grammar lexicon spec depth index morph]
   "Returns a lazy-sequence of all possible trees given a spec, where
 there is only one child for each parent, and that single child is the
 head of its parent. generate (above) 'decorates' each returned lightning bolt
 of this function with complements."
-  (log/debug (str "lightning-bolt(depth=" depth ",cat=" (get-in spec [:synsem :cat]) ")"))
+  (log/debug (str "lightning-bolt(depth=" depth "):" (strip-refs spec)))
   (let [maxdepth 3 ;; maximum depth of a lightning bolt: H1 -> H2 -> H3 where H3 must be a lexeme, not a phrase.
         morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
         depth (if depth depth 0)
@@ -110,46 +108,41 @@
 (defn add-complement [bolt path spec grammar lexicon cache morph depth]
   (let [input-spec spec
         from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
-        bolt-spec (get-in bolt path :no-path)
         depth (if depth depth 0)
         spec (unifyc spec bolt-spec)]
-    (if (not (= bolt-spec :no-path)) ;; check if this bolt has this path in it.
-      (let [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 [complement-pre-check (fn [child parent path-to-child]
-                                     (let [child-in-bolt (get-in bolt path-to-child)]
-                                       (and (not (fail?
-                                                  (unifyc (get-in child [:synsem] :top)
-                                                          (get-in child-in-bolt [:synsem] :top)))))))
-              filtered-lexical-complements (filter (fn [lexeme]
-                                                     (complement-pre-check lexeme bolt path))
-                                                   complement-candidate-lexemes)
-              shuffled-candidate-lexical-complements (lazy-shuffle filtered-lexical-complements)]
-          (filter (fn [complement]
-                    (if (fail? complement)
-                      true
-                      (do
-                        (log/debug (str "add-complement(depth=" depth ",path=" path ")=>"
-                                        (get-in complement [:synsem :cat] :none) "):" (morph complement)))
-                        false)))
-                  (map (fn [complement]
-                         (unify (copy bolt)
-                                (path-to-map path
-                                             (copy complement))))
-                       (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
-                         (if (lexemes-before-phrases depth)
-                           (lazy-cat shuffled-candidate-lexical-complements phrasal-complements)
-                           (lazy-cat phrasal-complements shuffled-candidate-lexical-complements)))))))
-
-      ;; path doesn't exist in bolt: simply return the bolt unmodified.
-      (list bolt))))
+    (let [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))))
+          complement-pre-check (fn [child parent path-to-child]
+                                 (let [child-in-bolt (get-in bolt path-to-child)]
+                                   (and (not (fail?
+                                              (unifyc (get-in child [:synsem] :top)
+                                                      (get-in child-in-bolt [:synsem] :top)))))))
+          filtered-lexical-complements (filter (fn [lexeme]
+                                                 (complement-pre-check lexeme bolt path))
+                                               complement-candidate-lexemes)
+          shuffled-candidate-lexical-complements (lazy-shuffle filtered-lexical-complements)]
+      (filter (fn [complement]
+                (if (fail? complement)
+                  true
+                  (do
+                    (log/debug (str "add-complement(depth=" depth ",path=" path ",bolt=(" (show-bolt bolt path) ")=>"
+                                    "'" (morph complement) "'"))
+                    false)))
+              (map (fn [complement]
+                     (unify (copy bolt)
+                            (path-to-map path
+                                         (copy complement))))
+                   (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
+                     (if (lexemes-before-phrases depth)
+                       (lazy-cat shuffled-candidate-lexical-complements phrasal-complements)
+                       (lazy-cat phrasal-complements shuffled-candidate-lexical-complements))))))))

 (defn path-to-map [path val]
   (let [feat (first path)]
@@ -204,3 +197,16 @@
     (if (and throw-exception-if-no-complements-found
              (not (= true (get-in bolt (concat path [:phrasal])))))
       (exception message))))
+
+(defn lexemes-before-phrases [depth]
+  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
+  (let [result (> (rand-int (+ 1 depth)) 0)]
+    (log/trace (str "lexemes-before-phrases: depth=" depth " => " result))
+    result))
+
+(defn show-bolt [bolt path]
+  (if (not (empty? path))
+    (str (get-in bolt [:rule])
+         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path))]
+           (if (not (nil? rest-str))
+             (str " -> " rest-str))))))


s/(count) > 0 /not(empty?)/

s/(count) > 0 /not(empty?)/

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -279,7 +279,7 @@
                              (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
                                (log/debug (str "number of phrasal components given spec: " spec ":"
                                                (count phrasal-complements)))
-                               (if (> (count phrasal-complements) 0)
+                               (if (not (empty? phrasal-complements))
                                  (log/debug (str "phrasal complements given spec: " spec ":"
                                                  (string/join "," (map morph phrasal-complements))))
                                  ;; phrasal complements were empty.


Make sure the first name is used even if the user map has only :name and not :first-name. Also use assignee instead of author for the notification.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -428,8 +428,11 @@

 ;; Reminder alert

+(defn- first-name [user-map]
+  (or (:first-name user-map) (first (s/split (:name user-map) #"\s"))))
+
 (defn reminder-alert-headline [reminder-data]
-  (str "Hi " (:first-name (:author reminder-data)) ", it's time to update your team"))
+  (str "Hi " (first-name (:author reminder-data)) ", it's time to update your team"))

 (defn reminder-alert-settings-footer [frequency]
   [:table {:class "row reminders-footer"
@@ -494,7 +497,7 @@
 ;; Reminder notification

 (defn reminder-notification-headline [reminder-data]
-  (str (:first-name (:author reminder-data)) " created a new reminder for you"))
+  (str (first-name (:author reminder-data)) " created a new reminder for you"))

 (defn reminder-notification-subline [reminder-data]
   (str (:frequency reminder-data) " starting " (post-date (:start-date reminder-data))))


Change digest footer.

Change digest footer.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -263,19 +263,19 @@
             (when digest?
               [:tr [:th {:class "small-12 lrge-12"}
                 [:p {:class "footer-paragraph bottom-footer"}
-                  "You’re setup to receive the daily digest each morning at 7 AM."]]])
+                  (str "You received this digest because you are part f the " (:org-name data) " team.")]]])
             (when digest?
               [:tr [:th {:class "small-12 lrge-12"}
                 [:p {:class "footer-paragraph bottom-footer underline-link"}
                   [:a {:href (str config/web-url "/" (:org-slug data) "/all-posts?user-settings=notifications")}
-                    "Manage your daily digest settings"]]]])
+                    "Manage your digest settings"]]]])
             (when digest?
               [:tr [:th {:class "small-12 lrge-12"}
                 (vspacer 16 "footer-table" "footer-table")]])
             (when digest?
               [:tr [:th {:class "small-12 lrge-12"}
                 [:p {:class "footer-paragraph bottom-footer"}
-                  "Have a feature idea or request?"]]])
+                  "Questions or ideas for Carrot?"]]])
             (when digest?
               [:tr [:th {:class "small-12 lrge-12"}
                 [:p {:class "footer-paragraph bottom-footer underline-link"}


pagination works

pagination works

--- src/ontrail/exercise.clj
+++ src/ontrail/exercise.clj
@@ -53,7 +53,7 @@
   (let [results (mq/with-collection EXERCISE
                (mq/find rule)
                (mq/fields [ :_id :heading :body :duration :distance :sport :creationDate :comments ])
-               (mq/paginate :page 0 :per-page 20)
+               (mq/paginate :page (Integer. page) :per-page 20)
                (mq/sort {:lastModifiedDate -1}))]
     (println "Ex list" rule page)
     (as-ex-result-list results)))


wrap multiple calls within an anonymous fn inside a do block to remove null pointer exception when calling anonymous fn.

--- src/overtone/sc/info.clj
+++ src/overtone/sc/info.clj
@@ -108,8 +108,9 @@
     (let [info (server-info)]
       (reset! buffer-count*  (:num-buffers info)))))

-(on-sync-event :shutdown #((reset! output-bus-count* nil)
-                           (reset! input-bus-count* nil)
-                           (reset! audio-bus-count* nil)
-                           (reset! buffer-count* nil))
+(on-sync-event :shutdown #(do
+                            (reset! output-bus-count* nil)
+                            (reset! input-bus-count* nil)
+                            (reset! audio-bus-count* nil)
+                            (reset! buffer-count* nil))
                ::reset-cached-server-info)


Grab the format of tactile books

Grab the format of tactile books

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -211,6 +211,11 @@
     :or {genre "x01" ; an invalid genre
          genre-code "x0"}}] ; an invalid genre-code
   (let [fmt (get-format format)
+        ;; tactile books aren't properly tagged in the format field.
+        ;; They are tagged as :ludo and their library signature starts
+        ;; with "TB"
+        fmt (if (and (= fmt :ludo) (re-find #"^TB " library-signature))
+              :taktilesbuch fmt)
         item (-> {}
                  (assoc-some
                   :record-id record-id


CLJS-403 REPL is changed to analyze forms in an :expr context.

Thereby making explicit, that the REPL actually compiles each input in an :expr context; in a wrapper form, to capture the return value. When an exception is printed, the REPL attaches the js compiled from the original.

Several builtin forms, however, don't get emitted in a :statement context, which could lead to apparent inconsistencies when looking at the js on a stacktrace.

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -166,7 +166,7 @@
   (binding [ana/*cljs-ns* 'cljs.user
             *cljs-verbose* verbose
             ana/*cljs-warn-on-undeclared* warn-on-undeclared]
-    (let [env {:context :statement :locals {}}
+    (let [env {:context :expr :locals {}}
           special-fns (merge default-special-fns special-fns)
           is-special-fn? (set (keys special-fns))]
       (-setup repl-env)
@@ -185,4 +185,3 @@
            :else
            (do (eval-and-print repl-env env form) (recur)))))
       (-tear-down repl-env))))
-


CLJS-1003: Cannot pass custom env to run-tests

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -239,11 +239,11 @@
              (fn [[quote ns]] (and (= quote 'quote) (symbol? ns)))
              namespaces)
      "All arguments to run-tests must be quoted symbols")
-   (let [is-ns (ns? env-or-ns)]
-     `(do
-        ~(if is-ns
-           `(cljs.test/set-env! (cljs.test/empty-env))
-           `(cljs.test/set-env! ~env-or-ns))
+   (let [is-ns (ns? env-or-ns)
+         env   (gensym "env")]
+     `(let [~env ~(if is-ns
+                    `(cljs.test/empty-env)
+                    env-or-ns)]
         ;; TODO: support async - David
         (let [summary# (assoc
                          (reduce
@@ -254,7 +254,7 @@
                            {:test 0 :pass 0 :fail 0 :error 0}
                            [~@(map
                                 (fn [ns]
-                                  `(cljs.test/test-ns ~ns))
+                                  `(cljs.test/test-ns ~env ~ns))
                                 (if is-ns
                                   (concat [env-or-ns] namespaces)
                                   namespaces))])


add core function for updating run position

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -983,6 +983,10 @@

 (defn trash-cards [state side cards]
   (doseq [c cards] (trash state side c)))
+
+(defn trash-ice-in-run [state]
+  (when-let [run (:run @state)]
+    (swap! state update-in [:run :position] dec)))

 (defn all-installed [state side]
   (if (= side :runner)


Trim username

Trim username

--- src/cljs/ji/main.cljs
+++ src/cljs/ji/main.cljs
@@ -10,6 +10,7 @@
             [ji.util.helpers
              :refer [clear! event-chan map-source map-sink copy-chan into-chan]]
             [clojure.set :as s]
+            [clojure.string :as str]
             [cljs.core.async :as async
              :refer [<! >! chan close! put! timeout]]
             [cljs.core.match]
@@ -190,7 +191,8 @@
     (go (let [e (<! join-submit)
               t (.-target e)
               game-id (dom/value (sel1 t "input[name='game-id']"))
-              player-id (dom/value (sel1 t "input[name='player-id']"))
+              player-id (-> (sel1 t "input[name='player-id']")
+                            (dom/value) (str/trim))
               result-chan (run-game! container game-id player-id)]
           (clear! (sel1 :#messages))
           (dom/remove! (sel1 :form.join-game))


Add helpful warnings when post event callback fns find a problem

--- src/re_frame/router.cljc
+++ src/re_frame/router.cljc
@@ -1,6 +1,7 @@
 (ns re-frame.router
   (:require [re-frame.events :refer [handle]]
-            [re-frame.interop :refer [after-render empty-queue next-tick]]))
+            [re-frame.interop :refer [after-render empty-queue next-tick]]
+            [re-frame.loggers :refer [console]]))

 ;; -- Router Loop ------------------------------------------------------------
@@ -99,12 +100,16 @@

   ;; register a callback function which will be called after each event is processed
   (add-post-event-callback [_ id callback-fn]
+    (if (contains? post-event-callback-fns id)
+      (console :warn "re-frame: overwriting existing post event call back with id: " id))
     (->> (assoc post-event-callback-fns id callback-fn)
          (set! post-event-callback-fns)))

   (remove-post-event-callback [_ id]
-    (->> (dissoc post-event-callback-fns id)
-         (set! post-event-callback-fns)))
+    (if-not (contains? post-event-callback-fns id)
+      (console :warn "re-frame: could not remove post event call back with id: " id)
+      (->> (dissoc post-event-callback-fns id)
+           (set! post-event-callback-fns))))

   ;; -- FSM Implementation ---------------------------------------------------


Don't send content type headers when no body is available.

--- src/uxbox/repo/core.cljs
+++ src/uxbox/repo/core.cljs
@@ -43,7 +43,7 @@
 (defn- send!
   [{:keys [body headers auth method] :or {auth true} :as request}]
   (let [headers (merge {}
-                       (when (not= method :get) +headers+)
+                       (when body +headers+)
                        headers
                        (when auth (auth-headers)))
         request (merge (assoc request :headers headers)


Log in the beginning of main to force-initialize Logback so that it won't create substitute loggers

--- src/varjocafe/system.clj
+++ src/varjocafe/system.clj
@@ -6,7 +6,8 @@
             [varjocafe.backend :as backend]
             [varjocafe.server :as server]
             [varjocafe.settings :as settings]
-            [varjocafe.updater :as updater]))
+            [varjocafe.updater :as updater]
+            [clojure.tools.logging :as log]))

 (defn init [settings]
   (let [clock (if (:development-mode settings)
@@ -33,6 +34,7 @@
   (component/stop system))

 (defn -main [& args]
+  (log/info "Starting up")
   (->
     (settings/read-configuration settings/default-settings)
     (init)


write barriers

write barriers

--- src/xrosslexior/core.clj
+++ src/xrosslexior/core.clj
@@ -115,6 +115,12 @@
             puzzle
             (for [[square letter] (zip (comprising-squares address) word)]
               [square letter]))))
+
+(defn write-barriers [grid locations]
+  (reduce (fn [state location]
+            (write state location black-square))
+          grid
+          locations))

 (defn solved? [grid]
   (every? identity


fix "YYYY" not being a valid date format on openjdk 6

--- test/cheshire/test/core.clj
+++ test/cheshire/test/core.clj
@@ -271,9 +271,9 @@
     (gen/add-encoder CTestR (fn [obj jg] (gen/encode-seq [:foo :bar] jg)))
     (is (= ["foo" "bar"] (json/decode (json/encode thing) true)))
     (remove)
-    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-date (Date. 0) jg)))
-    (binding [gen/*date-format* "YYYY"]
-      (is (= "1970" (json/decode (json/encode thing) true))))
+    (gen/add-encoder CTestR (fn [obj jg] (gen/encode-date (Date. (long 0)) jg)))
+    (binding [gen/*date-format* "yyyy-MM-dd'T'HH:mm:ss'Z'"]
+      (is (= "1970-01-01T00:00:00Z" (json/decode (json/encode thing) true))))
     (remove)
     (gen/add-encoder CTestR (fn [obj jg] (gen/encode-bool true jg)))
     (is (= true (json/decode (json/encode thing) true)))


Fixed bug with scum detection

Fixed bug with scum detection

--- src/demogorgon/nh.clj
+++ src/demogorgon/nh.clj
@@ -215,8 +215,8 @@

 (defn handle-xlogfile-line [irc line]
   (let [data (parse-line line)]
-    (if (and (or (< (:turns data) 10)
-                 (< (:score data) 10))
+    (if (and (or (< (Integer/parseInt (:turns data)) 10)
+                 (< (Integer/parseInt (:points data)) 10))
              (or (= (:death data) "quit")
                  (= (:death data) "escaped")))
       (add-scum (:player data)))
@@ -333,6 +333,9 @@

 (defn nh-start [nh]
   (doseq [thread nh]
+   (.setUncaughtExceptionHandler thread (proxy [Thread$UncaughtExceptionHandler] []
+    (uncaughtException [thread throwable]
+    (stacktrace/pst throwable))))
     (.start thread)))

 (defn nh-stop [nh]


round out core tests

round out core tests

--- test/clj_http/core_test.clj
+++ test/clj_http/core_test.clj
@@ -13,7 +13,13 @@
     [:head "/head"]
       {:status 200}
     [:get "/content-type"]
-      {:status 200 :body (:content-type req)}))
+      {:status 200 :body (:content-type req)}
+    [:get "/header"]
+      {:status 200 :body (get-in req [:headers "x-my-header"])}
+    [:post "/post"]
+      {:status 200 :body (io/slurp* (:body req))}
+    [:get "/error"]
+      {:status 500 :body "o noes"}))

 (def base-req
   {:scheme "http"
@@ -23,17 +29,44 @@
 (defn request [req]
   (core/request (merge base-req req)))

+(defn slurp-body [req]
+  (io/slurp* (:body req)))
+
 (deftest makes-get-request
   (let [resp (request {:request-method :get :uri "/get"})]
     (is (= 200 (:status resp)))
-    (is (= "get\n" (io/slurp* (:body resp))))))
+    (is (= "get\n" (slurp-body resp)))))

 (deftest makes-head-request
   (let [resp (request {:request-method :head :uri "/head"})]
-    (is (= 200 (:status resp)))))
+    (is (= 200 (:status resp)))
+    (is (nil? (:body resp)))))

 (deftest sets-content-type-with-charset
   (let [resp (request {:request-method :get :uri "/content-type"
                        :content-type "text/plain" :character-encoding "UTF-8"})]
+    (is (= "text/plain; charset=UTF-8\n" (slurp-body resp)))))
+
+(deftest sets-content-type-without-charset
+  (let [resp (request {:request-method :get :uri "/content-type"
+                       :content-type "text/plain"})]
+    (is (= "text/plain\n" (slurp-body resp)))))
+
+(deftest sets-arbitrary-headers
+  (let [resp (request {:request-method :get :uri "/header"
+                       :headers {"X-My-Header" "header-val"}})]
+    (is (= "header-val\n" (slurp-body resp)))))
+
+(deftest sends-and-returns-byte-array-body
+  (let [resp (request {:request-method :post :uri "/post"
+                       :body (.getBytes "contents" "UTF-8")})]
     (is (= 200 (:status resp)))
-    (is (= "text/plain; charset=UTF-8\n" (io/slurp* (:body resp))))))
+    (is (= "contents\n" (slurp-body resp)))))
+
+(deftest returns-arbitrary-headers
+  (let [resp (request {:request-method :get :uri "/get"})]
+    (is (string? (get-in resp [:headers "date"])))))
+
+(deftest returns-status-on-exceptional-responses
+  (let [resp (request {:request-method :get :uri "/error"})]
+    (is (= 500 (:status resp)))))


Warn user when Boot replaces compiler-options

Fixes #100

--- src/adzerk/boot_cljs/middleware.clj
+++ src/adzerk/boot_cljs/middleware.clj
@@ -1,6 +1,7 @@
 (ns adzerk.boot-cljs.middleware
   (:require [adzerk.boot-cljs.util :as util]
             [boot.file :as file]
+            [boot.util :as butil]
             [clojure.java.io :as io]
             [clojure.string :as string]))

@@ -43,6 +44,11 @@
                           compiler-options
                           (:compiler-options main))))

+(defn set-option [ctx k value]
+  (when-let [current-value (get-in ctx [:opts k])]
+    (butil/warn "WARNING: Replacing ClojureScript compiler option %s with automatically set value.\n" k))
+  (assoc-in ctx [:opts k] value))
+
 (defn main
   "Middleware to create the CLJS namespace for the build's .cljs.edn file and
   set the compiler :output-to option accordingly. The :output-to will be derived
@@ -67,9 +73,9 @@
         (spit (format-ns-forms (main-ns-forms cljs-ns init-nss init-fns)))))
     (-> ctx
         (update-in [:opts :asset-path] #(if % % asset-path))
-        (assoc-in [:opts :output-dir] out-path)
-        (assoc-in [:opts :output-to] js-path)
-        (assoc-in [:opts :main] cljs-ns))))
+        (set-option :output-dir out-path)
+        (set-option :output-to js-path)
+        (set-option :main main))))

 (defn modules
   "If .cljs.edn file contains modules declaration, use it to create options
@@ -85,11 +91,11 @@
             :core      {:output-to \"<tmp-dir>/js/main/core.js\" ...}}"
   [{:keys [tmp-out main] :as ctx}]
   (if-let [modules (:modules main)]
-    (assoc-in ctx [:opts :modules] (assoc (into {} (map (fn [[k v]]
-                                                          (let [js-path (util/path tmp-out (cljs-edn-path->module-path (:rel-path main) k))]
-                                                            [k (assoc v :output-to js-path)]))
-                                                        modules))
-                                          :cljs-base {:output-to (:output-to (:opts ctx))}))
+    (set-option ctx :modules (assoc (into {} (map (fn [[k v]]
+                                                    (let [js-path (util/path tmp-out (cljs-edn-path->module-path (:rel-path main) k))]
+                                                      [k (assoc v :output-to js-path)]))
+                                                  modules))
+                                    :cljs-base {:output-to (:output-to (:opts ctx))}))
     ctx))

 (defn source-map


Rename execution -> job; prepare v3 phase 1

--- src/cider_ci/storage/web/public.clj
+++ src/cider_ci/storage/web/public.clj
@@ -19,8 +19,8 @@

 (defn- build-basequery []
   (-> (hh/select :true)
-      (hh/from :executions)
-      (hh/merge-join :commits [:= :commits.tree_id :executions.tree_id])
+      (hh/from :jobs)
+      (hh/merge-join :commits [:= :commits.tree_id :jobs.tree_id])
       (hh/merge-join :branches_commits [:= :branches_commits.commit_id :commits.id])
       (hh/merge-join :branches [:= :branches.id :branches_commits.branch_id])
       (hh/merge-join :repositories [:= :repositories.id :branches.repository_id])
@@ -30,7 +30,7 @@
 (defn- tree-attachment-public-viewable? [request]
   (let [tree-id (-> request :route-params :tree_id)
         query (-> (build-basequery)
-                  (hh/merge-where [:= :executions.tree_id tree-id])
+                  (hh/merge-where [:= :jobs.tree_id tree-id])
                   hc/format)
         qres (first (jdbc/query (rdbms/get-ds) query)) ]
     ; this is not used as a http response
@@ -43,7 +43,7 @@
   (let [trial-id (-> request :route-params :trial_id
                      rdbms.conversion/convert-to-uuid)
         query (-> (build-basequery)
-                  (hh/merge-join :tasks [:= :tasks.execution_id :executions.id])
+                  (hh/merge-join :tasks [:= :tasks.job_id :jobs.id])
                   (hh/merge-join :trials [:= :trials.task_id :tasks.id])
                   (hh/merge-where [:= :trials.id trial-id])
                   hc/format)


Docu: simply typed lambda calculus denotation

--- test/latte/simple_types.clj
+++ test/latte/simple_types.clj
@@ -7,8 +7,9 @@
 ;;{
 ;;  # Simple types
 ;;
-;; The tests in this file are for simple types,
-;; and mostly taken from the book:
+;; Simply typed lambda calculus is denoted as: λ⟶
+;;
+;; The tests here are for simple types and mostly taken from the book:
 ;;
 ;; > Type Theory and Formal Proofs - an Introduction
 ;; > (Chapter 2: Simply typed lambda calculus)


shutdown code

shutdown code

--- src/evalback/core.clj
+++ src/evalback/core.clj
@@ -168,14 +168,18 @@
 (defn mk-worker [tn]
   (let [animator (.. (.b_load (get-api) tn) getStateSpace)]
     (fn [request]
-      (assoc (let [result-future (future (run-eval animator request))
+      (assoc (if request
+               (let [result-future (future (run-eval animator request))
                    result (deref
                            result-future
                            prob-timeout
                            (into request {:status :error :result "Timeout"}))]
-               (future-cancel result-future)
-               result)
-             :animator-id (.getId animator)))))
+                (future-cancel result-future)
+                result)
+               {}
+              )
+             :animator-id (.getId animator)
+             :kill-fn (fn [] (.kill animator))))))

 (defn create-empty-machine []
   (let [tf (java.io.File/createTempFile "evalb" ".mch" nil)
@@ -194,7 +198,7 @@
   (println :init))

 (defn destroy []
-  (doseq [_ (range instances)] (<!! @worker))
+  (doseq [_ (range instances)] ((:kill-fn ((<!! @worker) nil))))
   (reset! worker nil)
   (println :destroy))


Fix exception message regexp

Fix exception message regexp

--- test/riemann/index_test.clj
+++ test/riemann/index_test.clj
@@ -12,7 +12,7 @@
    (let [i (wrap-index (index))
          e (event {:host 1 :service 2})]
      (is (thrown-with-msg? clojure.lang.ExceptionInfo
-                           #"cannot index events with no time"
+                           #"^cannot index event.*$"
                            (i {:host 1 :service 2})))
      (i e)
      (is (= (set i) #{e})))))


The latest liberator returns an empty string body.

--- test/shale/test/handler.clj
+++ test/shale/test/handler.clj
@@ -107,7 +107,7 @@
         (is-body "[]\n"))
       (doto resp-refresh
         (is-status 201)
-        (is-body nil))
+        (is-body ""))
       (is-200 resp-2)
       (let [parsed (is-json resp-2)
             node-list (:node-list (:config system))]


working on b+tree

working on b+tree

--- sample/src/sample/btree.clj
+++ sample/src/sample/btree.clj
@@ -9,16 +9,24 @@
   (search [this k]))

-(defrecord B+Tree [b slots])
+(defrecord B+Tree [b key-fn
+                   slots root? leaf?])

 (extend-type B+Tree

   TreeModify

-  (add [{:keys [slots] :as this} v]
-    )
+  (add [{:keys [key-fn slots] :as this} v]
+    (assoc slots (key-fn v) v))

   TreeSearch

   (search [this k]
     ))
+
+
+(defn b+tree [b key-fn & {:keys [root? leaf?]
+                          :or {root? true
+                               leaf? true}}]
+  (->B+Tree b key-fn
+            (rm/range-map :find-ceiling) root? leaf?))


Fixes the sign in

Fixes the sign in

--- src/freecoin/core.clj
+++ src/freecoin/core.clj
@@ -201,7 +201,7 @@
                        email-conf (clojure.edn/read-string (slurp (:email-config config-m)))
                        db (:db @app-state)
                        stores-m (storage/create-mongo-stores db)
-                       blockchain (blockchain/new-stub db)
+                       blockchain (blockchain/new-stub stores-m)
                        email-activator (freecoin.email-activation/->ActivationEmail email-conf (:account-store stores-m))]
                    (prn "Restarting server....")
                    (create-app config-m stores-m blockchain email-activator)))))


Suggested refinement

Suggested refinement

--- luhn/example.clj
+++ luhn/example.clj
@@ -5,24 +5,24 @@
   [n]
   (->> [n 0]
        (iterate (fn [[i _]] [(quot i 10) (mod i 10)]))
-       (take-while #(not= [0 0] %))
+       (take-while (complement #{[0 0]}))
        (map second)
        rest))

 (defn checksum
   "returns the luhn checksum of n, assuming it has a check digit"
   [n]
-  (->> n
-       to-reversed-digits
-       (map #(* %1 %2) (cycle [1 2]))
-       (map #(if (>= % 10) (- % 9) %))
-       (apply +)
-       (#(mod % 10))))
+  (-> (->> n
+           to-reversed-digits
+           (map * (cycle [1 2]))
+           (map #(if (>= % 10) (- % 9) %))
+           (apply +))
+      (mod 10)))

 (defn valid?
   "whether n has a valid luhn check-digit"
   [n]
-  (= 0 (checksum n)))
+  (zero? (checksum n)))

 (defn add-check-digit
   "given a number, adds a luhn check digit at the end"


(TK-119) Remove some sleeps from the graceful shutdown tests

This commit replaces a sleep, done inside of the graceful shutdown tests
to ensure that the request is in process at the point the server
shutdown is initiated, with the use of a Clojure promise.  The Clojure
promise would better ensure that the Ring handler on the server had been
engaged at the point the server shutdown is triggered.

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
@@ -656,12 +656,16 @@
       [jetty9-service]
       jetty-plaintext-config
       (let [s (tk-app/get-service app :WebserverService)
-            add-ring-handler (partial add-ring-handler s)
-            ring-handler (fn [_] (Thread/sleep 3000) {:status 200 :body "Hello, World!"})]
+            add-ring-handler   (partial add-ring-handler s)
+            in-request-handler (promise)
+            ring-handler       (fn [_]
+                                 (deliver in-request-handler true)
+                                 (Thread/sleep 3000)
+                                 {:status 200 :body "Hello, World!"})]
         (add-ring-handler ring-handler "/hello")
         (with-open [async-client (async/create-client {})]
           (let [response (http-client-common/get async-client "http://localhost:8080/hello" {:as :text})]
-            (Thread/sleep 50)
+            @in-request-handler
             (tk-app/stop app)
             (is (= (:status @response) 200))
             (is (= (:body @response) "Hello, World!")))))))
@@ -672,12 +676,16 @@
       [jetty9-service]
       {:webserver {:port 8080 :shutdown-timeout-seconds 1}}
       (let [s (tk-app/get-service app :WebserverService)
-            add-ring-handler (partial add-ring-handler s)
-            ring-handler (fn [_] (Thread/sleep 2000) {:status 200 :body "Hello, World!"})]
+            add-ring-handler   (partial add-ring-handler s)
+            in-request-handler (promise)
+            ring-handler       (fn [_]
+                                 (deliver in-request-handler true)
+                                 (Thread/sleep 2000)
+                                 {:status 200 :body "Hello, World!"})]
         (add-ring-handler ring-handler "/hello")
         (with-open [async-client (async/create-client {})]
           (let [response (http-client-common/get async-client "http://localhost:8080/hello" {:as :text})]
-            (Thread/sleep 50)
+            @in-request-handler
             (tk-app/stop app)
             (is (not (nil? (:error @response)))))))))

@@ -687,12 +695,16 @@
       [jetty9-service]
       {:webserver {:port 8080 :shutdown-timeout-seconds 0}}
       (let [s (tk-app/get-service app :WebserverService)
-            add-ring-handler (partial add-ring-handler s)
-            ring-handler (fn [_] (Thread/sleep 300) {:status 200 :body "Hello, World!"})]
+            add-ring-handler   (partial add-ring-handler s)
+            in-request-handler (promise)
+            ring-handler       (fn [_]
+                                 (deliver in-request-handler true)
+                                 (Thread/sleep 300)
+                                 {:status 200 :body "Hello, World!"})]
         (add-ring-handler ring-handler "/hello")
         (with-open [async-client (async/create-client {})]
           (let [response (http-client-common/get async-client "http://localhost:8080/hello" {:as :text})]
-            (Thread/sleep 50)
+            @in-request-handler
             (tk-app/stop app)
             (is (not (nil? (:error @response))))))))))


(maint) Disable intermittently failing test

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
@@ -705,60 +705,64 @@
               (tk-app/stop app))
             (is (not (nil? (:error @response)))))))))

-  (testing "no graceful shutdown when stop timeout is set to 0"
-    (let [response (atom nil)]
-      ;; For this test, an active web request should exist at the time the
-      ;; webserver service is stopped.  Because the shutdown timeout is set to
-      ;; 0, though, the request should be terminated immediately as the
-      ;; webserver service is shut down, without waiting for ring handler
-      ;; to complete the request.
-      (with-open [async-client (async/create-client
-                                ;; Setting the socket timeout to something much
-                                ;; larger than the sleep delay done in the ring
-                                ;; handler below.  This timeout allows the HTTP
-                                ;; client request to not hang the test
-                                ;; indefinitely in the event of an unexpected
-                                ;; test failure.
-                                {:socket-timeout-milliseconds 120000})]
-        (tk-log-testutils/with-test-logging
-         (with-app-with-config
-          app
-          [jetty9-service]
-          {:webserver {:port 8080 :shutdown-timeout-seconds 0}}
-          (let [s (tk-app/get-service app :WebserverService)
-                add-ring-handler (partial add-ring-handler s)
-                in-request-handler (promise)
-                ring-handler (fn [_]
-                               (deliver in-request-handler true)
-                               ;; Sleeping for a long time to allow an HTTP
-                               ;; request to still be active at the point the
-                               ;; webserver is shutdown
-                               (Thread/sleep 60000)
-                               {:status 200 :body "Hello, World!"})]
-            (add-ring-handler ring-handler "/hello")
-            (reset! response (http-client-common/get
-                              async-client
-                              "http://localhost:8080/hello"
-                              {:as :text}))
-            @in-request-handler)))
-        ;; The web server should have been stopped by the time we get here.
-        ;; Depending upon timing, the Jetty webserver may provide an HTTP 404
-        ;; response or just terminate the socket for the web request which could
-        ;; not be completed, which should cause a ConnectionClosedException to
-        ;; be thrown.
-        ;;
-        ;; Note that per TK-437, we have occasionally seen this assertion fail
-        ;; due to a SocketTimeoutException being thrown.  In this case, there
-        ;; appears to be a timing-related bug in Jetty where the server socket
-        ;; isn't closed down even though the server otherwise appears to have
-        ;; been stopped properly - leaving the server-side of the connection in
-        ;; an indefinite CLOSE_WAIT state.
-        (let [resp (deref (deref response))
-              error (:error resp)]
-          (is (or
-               (instance? ConnectionClosedException error)
-               (= 404 (:status resp)))
-              (str "request did not error as expected. response: " resp))))))
+; Per [TK-437](https://tickets.puppetlabs.com/browse/TK-437) we've been having issues
+; with this test randomly hanging, but the fixes applied for TK-437 didn't seem to resolve
+; the issue. This test is disabled until we can work out a reliable fix.
+;
+;  (testing "no graceful shutdown when stop timeout is set to 0"
+;    (let [response (atom nil)]
+;      ;; For this test, an active web request should exist at the time the
+;      ;; webserver service is stopped.  Because the shutdown timeout is set to
+;      ;; 0, though, the request should be terminated immediately as the
+;      ;; webserver service is shut down, without waiting for ring handler
+;      ;; to complete the request.
+;      (with-open [async-client (async/create-client
+;                                ;; Setting the socket timeout to something much
+;                                ;; larger than the sleep delay done in the ring
+;                                ;; handler below.  This timeout allows the HTTP
+;                                ;; client request to not hang the test
+;                                ;; indefinitely in the event of an unexpected
+;                                ;; test failure.
+;                                {:socket-timeout-milliseconds 120000})]
+;        (tk-log-testutils/with-test-logging
+;         (with-app-with-config
+;          app
+;          [jetty9-service]
+;          {:webserver {:port 8080 :shutdown-timeout-seconds 0}}
+;          (let [s (tk-app/get-service app :WebserverService)
+;                add-ring-handler (partial add-ring-handler s)
+;                in-request-handler (promise)
+;                ring-handler (fn [_]
+;                               (deliver in-request-handler true)
+;                               ;; Sleeping for a long time to allow an HTTP
+;                               ;; request to still be active at the point the
+;                               ;; webserver is shutdown
+;                               (Thread/sleep 60000)
+;                               {:status 200 :body "Hello, World!"})]
+;            (add-ring-handler ring-handler "/hello")
+;            (reset! response (http-client-common/get
+;                              async-client
+;                              "http://localhost:8080/hello"
+;                              {:as :text}))
+;            @in-request-handler)))
+;        ;; The web server should have been stopped by the time we get here.
+;        ;; Depending upon timing, the Jetty webserver may provide an HTTP 404
+;        ;; response or just terminate the socket for the web request which could
+;        ;; not be completed, which should cause a ConnectionClosedException to
+;        ;; be thrown.
+;        ;;
+;        ;; Note that per TK-437, we have occasionally seen this assertion fail
+;        ;; due to a SocketTimeoutException being thrown.  In this case, there
+;        ;; appears to be a timing-related bug in Jetty where the server socket
+;        ;; isn't closed down even though the server otherwise appears to have
+;        ;; been stopped properly - leaving the server-side of the connection in
+;        ;; an indefinite CLOSE_WAIT state.
+;        (let [resp (deref (deref response))
+;              error (:error resp)]
+;          (is (or
+;               (instance? ConnectionClosedException error)
+;               (= 404 (:status resp)))
+;              (str "request did not error as expected. response: " resp))))))

   (testing "tk app can still restart even if stop timeout expires"
     (let [in-request-handler? (promise)


added test for adding a class to a node with not class defined yet

--- test/kioo/core_test.cljs
+++ test/kioo/core_test.cljs
@@ -70,6 +70,11 @@
     (let [comp (component "class-span.html" [:span]
                           {[:#s] (add-class "suc")})]
       (is (= "testing"
+             (render-dom comp)))))
+  (testing "add-class when no class exists"
+    (let [comp (component "simple-div.html"
+                          {[:div] (add-class "suc")})]
+      (is (= "
test
"
              (render-dom comp)))))
   (testing "remove-class test"
     (let [comp (component "class-span.html" [:span]


Доработка функционала для nav-tabs

Доработка функционала для nav-tabs

--- radiolamp-6P3S/src/r6p3s/cpt/nav_tabs.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/nav_tabs.cljs
@@ -28,6 +28,12 @@

 (defn active-tab [app]
   (get app :active-tab 0))
+
+(defn set-active-tab [app i]
+  (assoc app :active-tab i))
+
+(defn set-active-tab! [app i]
+  (om/update! app :active-tab i))

 (defn enable-inly-one [app ii]
   (om/transact!


Skip the test prefix for those that use this naming convention

--- agiledox.clj
+++ agiledox.clj
@@ -17,7 +17,7 @@
   (str (.replaceFirst (.replaceFirst filename "\\.java" "") "Test" "") ":"))

 (defn as-feature [line]
-  (.toLowerCase (.replaceAll line "([A-Z])" " $1")))
+  (.replaceFirst (.toLowerCase (.replaceAll line "([A-Z])" " $1")) "- test" "-"))

 (def empty-line "")


[outputs] track model outputs by key of layer id rather than through aligning order/indexes

--- keras/src/think/cortex/keras/core.clj
+++ keras/src/think/cortex/keras/core.clj
@@ -385,6 +385,17 @@
                  :layer-name out-name
                  :parsed-as  parts})))))

+(defn layer-output-by-id
+  "Given an output file (hdf5 opened already) we return a map from keyword layer-id to
+  a core matrix object that contains the values of the outputs at that layer from the
+  test image during keras export process."
+  [output-file]
+  (let [by-id (-> output-file hdf5-child-map :layer_outputs hdf5-child-map)]
+    (apply merge (for [[lyr-id hdf5-node] by-id]
+                   (let [raw-data (-> hdf5-node hdf5/->clj :data)
+                         as-mat   (to-core-matrix raw-data [(m/ecount raw-data)]) ]
+                     {lyr-id as-mat})))))
+
 (defn layer-output->ordered-data
   [layer-outputs]
   (->> (hdf5-child-map layer-outputs)


Removing num-pending from pending-jobs-to-considerable span (#2114)

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -703,7 +703,7 @@
    Further limit the considerable jobs to a maximum of num-considerable jobs."
   [db pending-jobs user->quota user->usage num-considerable pool-name]
   (tracing/with-span [s {:name "scheduler.pending-jobs-to-considerable"
-                         :tags {:pool pool-name :component tracing-component-tag :num-pending-jobs pending-jobs}}]
+                         :tags {:pool pool-name :component tracing-component-tag}}]
     (log-structured/debug (print-str "There are pending jobs:" pending-jobs)
                           {:pool pool-name :num-pending-jobs (count pending-jobs)})
     (let [enforcing-job-launch-rate-limit? (ratelimit/enforce? quota/per-user-per-pool-launch-rate-limiter)
@@ -727,7 +727,6 @@
                  :total-passed-count (->> @user->passed-count vals (reduce +))
                  :user->passed-count @user->passed-count
                  :pool pool-name})
-      (tracing/set-tags {:num-considerable (count considerable-jobs)})
       considerable-jobs)))


Delete -main

Delete -main

--- src/bookshelf/core.clj
+++ src/bookshelf/core.clj
@@ -3,11 +3,6 @@
   (:use ring.adapter.jetty)
   (:use ring.middleware.reload)
   (:use ring.middleware.stacktrace))
-
-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))

 (defn handler [request]
   {:status 200


Updated jar/war tasks to place a have a small cake.clj file that allows access to the cake/*context* configured at build time.


Use relative links when creating project link in box-add.

The previous behavior used absolute symlinks. This change allows box
directories to be renamed and moved.


Add tests for mention detection.

Add tests for mention detection.

--- test/linkification.clj
+++ test/linkification.clj
@@ -42,3 +42,17 @@
   (is (=
       (linkify "hello foo@example.org how are you")
       "hello foo@example.org how are you")))
+
+(deftest linkify-mentions []
+  (is (=
+      (linkify "@foo")
+      "@foo"))
+  (is (=
+      (linkify "@foo how are you")
+      "@foo how are you"))
+  (is (=
+      (linkify "how are you @foo")
+      "how are you @foo"))
+  (is (=
+      (linkify "nice to see @foo again")
+      "nice to see @foo again")))


catch and log exceptions in controls handler

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -151,13 +151,14 @@
   [value state browser-state]
   (when-not (keyword-identical? :mouse-moved (first value))
     (mlog "Controls Verbose: " value))
-  (binding [frontend.async/*uuid* (:uuid (meta value))]
-    (let [previous-state @state
-          ;; TODO: control-event probably shouldn't get browser-state
-          current-state (swap! state (partial controls-con/control-event browser-state (first value) (second value)))]
-      (controls-con/post-control-event! browser-state (first value) (second value) previous-state current-state)
-      ;; TODO: enable a way to set the event separate from the control event
-      (analytics/track-control (first value) current-state))))
+  (utils/swallow-errors
+   (binding [frontend.async/*uuid* (:uuid (meta value))]
+     (let [previous-state @state
+           ;; TODO: control-event probably shouldn't get browser-state
+           current-state (swap! state (partial controls-con/control-event browser-state (first value) (second value)))]
+       (controls-con/post-control-event! browser-state (first value) (second value) previous-state current-state)
+       ;; TODO: enable a way to set the event separate from the control event
+       (analytics/track-control (first value) current-state)))))

 (defn nav-handler
   [value state history]


Test test-substring-3

Test test-substring-3

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -166,6 +166,16 @@
             "world"  (substring "Hello world!" 6 11)
             "world!" (substring "Hello world!" 6 12))))

+(deftest test-substring-3
+    "Check the function zg.utils/substring."
+    (testing "the function zg.utils/substring."
+        (are [x y] (= x y)
+            "Hello world!" (substring "Hello world!" 0)
+            "ello world!"  (substring "Hello world!" 1)
+            "world!"       (substring "Hello world!" 6)
+            "!"            (substring "Hello world!" 11)
+            ""             (substring "Hello world!" 12))))
+
 (deftest test-substring-empty-result
     "Check the function zg.utils/substring."
     (testing "the function zg.utils/substring."