update entries if permissions have changed

we put documents with changed permissions into the "import_file" loop.

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -89,7 +89,7 @@
               ["dir" "doc"]
               :size 1000000
               :query {:match_all {}}
-              :fields ["parent" "lastmodified"]
+              :fields ["parent" "lastmodified" "allow_token_document" "deny_token_document"]
               :filter {:term {:parent parent}}))

@@ -99,6 +99,8 @@
     [{:keys [_type _id fields]}]
     {:id _id
      :type (estype->type _type)
+     :allow (:allow_token_document fields)
+     :deny (:deny_token_document fields)
      :mtime (-> fields :lastmodified lastmodified->mtime)}))

 (defn enrich-es-entries
@@ -143,10 +145,24 @@
   [existing-map entries]
   (remove #(contains? existing-map (:id %)) entries))

+(declare simplify-permissions-for-es)
+
+(defn permset
+  "create a set. elasticsearch may give us a single string, handle that case"
+  [p]
+  (if (string? p)
+    #{p}
+    (set p)))
+
 (defn entry-needs-update?
   "compare es-entry with mq-entry and determine if we need to update it"
   [es-entry mq-entry]
-  (not= (:mtime es-entry) (:mtime mq-entry)))
+  (or (not= (:mtime es-entry) (:mtime mq-entry))
+      (let [mqperm (-> mq-entry :permissions simplify-permissions-for-es)
+            mqperm* (misc/remap permset mqperm)
+            esperm (select-keys es-entry [:allow :deny])
+            esperm* (misc/remap permset esperm)]
+        (not= mqperm* esperm*))))

 (defn find-updates
   "compare entries with those in es-file-map and return a seq of


use a common format for directory entries

the filesystem and elasticsearch directory entries now have a common
map format with :mtime, :id and :type keys.

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -62,6 +62,22 @@
               :fields ["parent" "lastmodified"]
               :filter {:term {:parent parent}}))

+(let [estype->type {"dir" "directory"
+                    "doc" "file"}]
+  (defn enrich-es-entries
+    [parent entries]
+    (let [convert-entry (fn [{:keys [_type _id fields]}]
+                          {:id _id
+                           :type (estype->type _type)
+                           :mtime (:lastmodified fields)})]
+      (loop [entries entries]
+        (if (map? entries)
+          (recur (:hits entries))
+          (map convert-entry entries))))))
+
+
+
+

 (defn es-recursive-delete
   [index-name parent]
@@ -78,20 +94,32 @@
   (string/replace (string/join "/" args) #"/+" "/"))

+(defn enrich-mq-entries
+  [directory entries]
+  (let [parent-id (make-id "" directory)
+        enrich-entry (fn [entry]
+                       (assoc entry
+                         :id (make-id "" directory (:relpath entry))
+                         :type (get-in entry [:stat :type])
+                         :mtime (get-in entry [:stat :mtime])))]
+    (map enrich-entry entries)))
+
+
+
 (defn simple-update_directory
   [fs es-index {:keys [directory entries] :as body} {publish :publish}]
   (let [parent-id (make-id "" directory)
-        entries-by-type (group-by #(get-in % [:stat :type]) entries)]
+        enriched-entries (enrich-mq-entries directory entries)
+        entries-by-type (group-by :type enriched-entries)]

     (println "update-directory" fs parent-id entries-by-type)

     (doseq [e (entries-by-type "directory")]
-      (let [id (make-id "" directory (:relpath e))]
-        (println "put" id e)
-        (esd/put es-index "dir"
-                 id
-                 {:lastmodified (get-in e [:stat :mtime])
-                  :parent parent-id})))))
+      (println "put" e)
+      (esd/put es-index "dir"
+               (:id e)
+               {:lastmodified (:mtime e)
+                :parent parent-id}))))


Minor changes on compact ns.

Minor changes on compact ns.

--- src/buddy/sign/compact.clj
+++ src/buddy/sign/compact.clj
@@ -139,7 +139,7 @@
     (when-not (verify-signature candidate signature key alg)
       (throw (ex-info "Message seems corrupt or manipulated."
                       {:type :validation :cause :signature})))
-    (let [now (util/timestamp)
+    (let [now (util/now)
           stamp (codecs/bytes->long stamp)]
       (when (and (number? max-age) (> (- now stamp) max-age))
         (throw (ex-info (format "Token is older than %s" max-age)


Badge import cache fix

Badge import cache fix

--- src/clj/salava/badge/importer.clj
+++ src/clj/salava/badge/importer.clj
@@ -10,7 +10,7 @@
 (defonce import-cache (atom {}))

 (defn- put-import-cache [key data]
-  (swap! import-cache assoc key {:ttl (+ (u/now) 600) :data data})
+  (swap! import-cache assoc key {:ttl (+ (u/now) 200) :data data})
   data)

 (defn- get-import-cache [key]
@@ -61,9 +61,9 @@
        (pmap (partial public-group-badges user base-url remote-id))
        flatten))

-(defn- all-public-badges [user base-url]
+(defn- all-public-badges [user base-url cached?]
   (let [cache-key [(:id user) base-url]]
-    (if-let [cached (get-import-cache cache-key)]
+    (if-let [cached (and cached? (get-import-cache cache-key))]
       cached
       (->> (remote-ids user base-url)
            (mapcat (partial public-badges user base-url))
@@ -103,7 +103,7 @@
   (try
     (let [base-url "https://backpack.openbadges.org/displayer" ;TODO support other sources
           user {:id user-id :emails (user/verified-email-addresses ctx user-id)}]
-      {:badges (->> (all-public-badges user base-url)
+      {:badges (->> (all-public-badges user base-url false)
                     (map (partial import-info ctx user))
                     (sort-by :message #(compare %2 %1)))
        :status "success"
@@ -122,7 +122,7 @@
     (let [base-url "https://backpack.openbadges.org/displayer" ;TODO support other sources
           user {:id user-id :emails (user/verified-email-addresses ctx user-id)}
           key-set (set keys)
-          badges-to-save (filter #(key-set (:checksum (meta %))) (all-public-badges user base-url))
+          badges-to-save (filter #(key-set (:checksum (meta %))) (all-public-badges user base-url true))
           badge-ids (remove nil? (map #(db/save-user-badge! ctx (assoc % :status "accepted")) badges-to-save))]
       {:status      "success"
        :message     "badge/Badgessaved"


step 7

step 7

--- src/cljs/cljs_repl_web/views.cljs
+++ src/cljs/cljs_repl_web/views.cljs
@@ -27,22 +27,24 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;

 (def tour
-  (make-tour [:step1 :step2 :step3 :step4 :step5 :step6 :step7]))
+  (make-tour [:step1 :step2 :step3 :step4 :step5 :step6 :step7 :step8]))

 (def tour-steps
-  {:step1 {:title "Tour 1 of 7"
+  {:step1 {:title "Tour 1 of 8"
            :body "Reset"}
-   :step2 {:title "Tour 2 of 7"
+   :step2 {:title "Tour 2 of 8"
            :body "Clear"}
-   :step3 {:title "Tour 3 of 7"
+   :step3 {:title "Tour 3 of 8"
            :body "Create Gist"}
-   :step4 {:title "Tour 4 of 7"
+   :step4 {:title "Tour 4 of 8"
            :body "Clear examples"}
-   :step5 {:title "Tour 5 of 7"
+   :step5 {:title "Tour 5 of 8"
            :body "Switch input mode"}
-   :step6 {:title "Tour 6 of 7"
+   :step6 {:title "Tour 6 of 8"
            :body "Console"}
-   :step7 {:title "Tour 7 of 7"
+   :step7 {:title "Tour 7 of 8"
+           :body "Symbol"}
+   :step8 {:title "Tour 8 of 8"
            :body "Send to repl"}})

 (defn create-tour-step
@@ -62,7 +64,7 @@
                 :body     [:div (get-in tour-steps [step-keyword :body])
                            [make-tour-nav tour]]
                 :on-cancel #(do (finish-tour tour)
-                                (local-storage/set-item! :closed-tour? true))]
+                                (local-storage/set-item! :closed-tour? true))]
       :style  (if style
                 style
                 (align-style :align-self :center))])))
@@ -468,23 +470,38 @@
        :size "0 1 auto"
        :align :center
        :class "api-panel-symbol-label-box"
-       :child (if-let [symbol (get-symbol-doc-map (str symbol))]
-                [popover-anchor-wrapper
-                 :showing? showing?
-                 :position @popover-position
-                 :anchor [button
-                          :class "btn btn-default api-panel-symbol-button"
-                          :label (:name symbol)
-                          ;; we use :attr's `:on-click` because button's `on-click` accepts
-                          ;; a parametless function and we need the mouse click coordinates
-                          :attr {:on-click
-                                 (handler-fn
-                                  ;; later we can refactor it into re-frame
-                                  ;; see also https://github.com/Day8/re-frame/wiki/Beware-Returning-False#user-content-usage-examples
-                                  (reset! popover-position
-                                          (utils/calculate-popover-position [(.-clientX event) (.-clientY event)]))
-                                  (reset! showing? true))}]
-                 :popover [symbol-popover showing? popover-position symbol]]
+       :child (if-let [symbol' (get-symbol-doc-map (str symbol))]
+                (if (and (= (str symbol) "+") (not @showing?))
+                  [create-tour-step 7
+                   :below-center
+                   [button
+                    :class "btn btn-default api-panel-symbol-button"
+                    :label (:name symbol')
+                    ;; we use :attr's `:on-click` because button's `on-click` accepts
+                    ;; a parametless function and we need the mouse click coordinates
+                    :attr {:on-click
+                           (handler-fn
+                            ;; later we can refactor it into re-frame
+                            ;; see also https://github.com/Day8/re-frame/wiki/Beware-Returning-False#user-content-usage-examples
+                            (reset! popover-position
+                                    (utils/calculate-popover-position [(.-clientX event) (.-clientY event)]))
+                            (reset! showing? true))}]]
+                  [popover-anchor-wrapper
+                   :showing? showing?
+                   :position @popover-position
+                   :anchor [button
+                            :class "btn btn-default api-panel-symbol-button"
+                            :label (:name symbol')
+                            ;; we use :attr's `:on-click` because button's `on-click` accepts
+                            ;; a parametless function and we need the mouse click coordinates
+                            :attr {:on-click
+                                   (handler-fn
+                                    ;; later we can refactor it into re-frame
+                                    ;; see also https://github.com/Day8/re-frame/wiki/Beware-Returning-False#user-content-usage-examples
+                                    (reset! popover-position
+                                            (utils/calculate-popover-position [(.-clientX event) (.-clientY event)]))
+                                    (reset! showing? true))}]
+                   :popover [symbol-popover showing? popover-position symbol']])
                 [label
                  :label (str symbol)
                  :class "api-panel-symbol-label"


initial move

initial move

--- src/cljs/triboard/logic/move.cljs
+++ src/cljs/triboard/logic/move.cljs
@@ -30,23 +30,26 @@
   [cell]
   (or (nil? cell) (= cell :empty) (= cell :wall)))

+(defn- walk-dir
+  [[x y] [dx dy]]
+  [(+ x dx) (+ y dy)])
+
 (defn- available-cells-by-dir
   "Indicates the convertible cells when clicking at [x y]"  ;; TODO - Refactor & Test
-  [board [xi yi :as coord] [dx dy]]
-  (loop [x (+ xi dx)
-         y (+ yi dy)
+  [board initial-coord direction]
+  (loop [coord (walk-dir initial-coord direction)
          looser nil
          taken []]
-    (let [cell (board/get-cell-at board [x y])]
+    (let [cell (board/get-cell-at board coord)]
       (cond
-        (is-not-convertible? cell) nil                      ;; No move: reached end and only 1 type of cell
-        (and looser (not= looser cell)) {:winner cell       ;; Who wins the cells
-                                         :looser looser     ;; Who looses the cells
-                                         :point coord       ;; The move performed
-                                         :taken taken}      ;; The cells taken
+        (is-not-convertible? cell) nil                        ;; No move: reached end and only 1 type of cell
+        (and looser (not= looser cell)) {:winner cell         ;; Who wins the cells
+                                         :looser looser       ;; Who looses the cells
+                                         :point initial-coord ;; The move performed
+                                         :taken taken}        ;; The cells taken
         :else (recur
-                (+ x dx) (+ y dy)
-                cell (conj taken [x y])))
+                (walk-dir coord direction)
+                cell (conj taken coord)))
       )))

 (defn- available-conversions-at


Ensure result of code_append is a non-lazy list.

--- src/clojush/instructions/code.clj
+++ src/clojush/instructions/code.clj
@@ -18,8 +18,9 @@
   ^{:stack-types [:code]}
   (fn [state]
     (if (not (empty? (rest (:code state))))
-      (let [new-item (concat (ensure-list (stack-ref :code 0 state))
-                             (ensure-list (stack-ref :code 1 state)))]
+      (let [new-item (ensure-list
+                       (concat (ensure-list (stack-ref :code 0 state))
+                               (ensure-list (stack-ref :code 1 state))))]
         (if (<= (count-points new-item) @global-max-points)
           (push-item new-item
                      :code
@@ -565,3 +566,4 @@
     (if (empty? (:environment state))
       state
       (end-environment state))))
+


Race between alsa startup and enqueue

Race between alsa startup and enqueue

--- src/ngale/player.clj
+++ src/ngale/player.clj
@@ -117,7 +117,10 @@
   we signal this by calling (completed).

   TODO: (completed) events can be handled out-of-order. This is by design, but
-  it might be nice to discard them if the current track has changed."
+  it might be nice to discard them if the current track has changed.
+
+  TODO: there is a small delay between returning and when alsa-player starts
+  responding to commands. This can lead to races."
   [reference path]
   (future
     ;(println "playing" path)
@@ -142,10 +145,12 @@
   [key reference old new]
   (if (= (current-track old) (current-track new))
     ; same track
-    (if-not (:playing? new)
-      (alsa-pause)
-      (if-not (= :done (alsa-resume))
-        (alsa-play reference (:path (current-track new)))))
+    (if-not (= (:playing? old) (:playing? new))
+      (if-not (:playing? new)
+        (alsa-pause)
+        (when-not (= :done (alsa-resume))
+          (alsa-kill)
+          (alsa-play reference (:path (current-track new))))))
     ; different track
     (do
       (alsa-kill)


fix to filter

fix to filter

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -58,8 +58,7 @@
       (update-in req [:uri] #(if (= "/" %) "/index.html" %)))))

 (defn monger-filter-from [params]
-  (let [{:keys [user tags sport]} params]
-    params))
+  (select-keys params [:user :tags :sport]))

 (defn get-page [params]
   (if (not= nil (:page params))
@@ -101,7 +100,7 @@
   (GET "/rest/v1/ex-list-all/:page" {params :params cookies :cookies}
        (json-response (get-latest-ex-list-default-order (user-from-cookie cookies) {} (get-page params))))

-  (GET "/rest/v1/ex-list-filter" {params :params cookies :cookies}
+  (GET "/rest/v1/ex-list-filter/:page" {params :params cookies :cookies}
        (json-response (get-latest-ex-list (user-from-cookie cookies) (monger-filter-from params) (get-page params) {:creationDate -1})))

   (GET "/rest/v1/ex-list-user/:user/:page" {params :params cookies :cookies}


hoisted conditional schema

hoisted conditional schema

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -160,6 +160,13 @@
              (= (:onyx/max-peers entry)
                 (:onyx/min-peers entry)))
         (= (:onyx/max-peers entry) 1))))
+
+(def InputTaskSchema
+  (let [base-input-schema (merge base-task-map partial-input-task)]
+    (s/conditional java?
+                   (merge base-input-schema partial-java-plugin)
+                   :else
+                   base-input-schema)))

 (def OutputTaskSchema
   (let [base-output-schema (merge base-task-map partial-output-task)
@@ -181,13 +188,6 @@
                                   :else
                                   (merge base-output-schema partial-clojure-plugin)))))

-(def InputTaskSchema
-  (let [base-input-schema (merge base-task-map partial-input-task)]
-    (s/conditional java?
-                   (merge base-input-schema partial-java-plugin)
-                   :else
-                   base-input-schema)))
-
 (def FunctionTaskSchema
   (let [base-function-task (merge base-task-map partial-fn-task)
         java-function-task (merge base-function-task partial-grouping-task partial-java-fn-task)
@@ -215,6 +215,86 @@
                  #(= (:onyx/type %) :function)
                  FunctionTaskSchema))

+(defn UniqueTaskMap [schema & schemas]
+  (let [customize (fn [s] (apply merge s (cons schema schemas)))]
+    (s/conditional
+     ;;;; Inputs
+     #(and (= (:onyx/type %) :input)
+           (java? %))
+     (customize (merge base-task-map
+                       partial-input-task
+                       partial-java-plugin))
+     #(and (= (:onyx/type %) :input)
+           (not (java? %)))
+     (customize (merge base-task-map
+                       partial-input-task))
+
+     ;;;; Outputs
+     #(and (= (:onyx/type %) :output)
+           (grouping-task? %)
+           (java? %))
+     (s/constrained (customize (merge
+                                base-task-map
+                                partial-output-task
+                                partial-grouping-task
+                                partial-java-plugin))
+                    valid-min-peers-max-peers-n-peers?
+                    'valid-flux-policy-min-max-n-peers)
+     #(and (= (:onyx/type %) :output)
+           (grouping-task? %)
+           (not (java? %)))
+     (s/constrained (customize (merge
+                                base-task-map
+                                partial-output-task
+                                partial-grouping-task
+                                partial-clojure-plugin))
+                    valid-min-peers-max-peers-n-peers?
+                    'valid-flux-policy-min-max-n-peers)
+     #(and (= (:onyx/type %) :output)
+           (not (grouping-task? %))
+           (java? %))
+     (customize (merge base-task-map
+                       partial-output-task
+                       partial-java-plugin))
+     #(and (= (:onyx/type %) :output)
+           (not (grouping-task? %))
+           (not (java? %)))
+     (customize (merge base-task-map
+                       partial-output-task
+                       partial-clojure-plugin))
+     ;;;; Functions
+     #(and (= (:onyx/type %) :function)
+           (grouping-task? %)
+           (java? %))
+     (s/constrained (customize (merge base-task-map
+                                      partial-fn-task
+                                      partial-grouping-task
+                                      partial-java-fn-task))
+                    valid-min-peers-max-peers-n-peers?
+                    'valid-flux-policy-min-max-n-peers)
+     #(and (= (:onyx/type %) :function)
+           (grouping-task? %)
+           (not (java? %)))
+     (s/constrained (customize (merge base-task-map
+                                      partial-fn-task
+                                      partial-grouping-task
+                                      partial-clojure-fn-task))
+                    valid-min-peers-max-peers-n-peers?
+                    'valid-flux-policy-min-max-n-peers)
+
+     #(and (= (:onyx/type %) :function)
+           (not (grouping-task? %))
+           (java? %)) (customize (merge base-task-map
+                                        partial-fn-task
+                                        partial-java-fn-task))
+
+     #(and (= (:onyx/type %) :function)
+           (not (grouping-task? %))
+           (not (java? %))) (customize (merge base-task-map
+                                              partial-fn-task
+                                              partial-clojure-fn-task)))))
+
+
 (def Catalog
   [TaskMap])

@@ -288,12 +368,12 @@
    UnsupportedWindowKey s/Any})

 (def Window
-  (s/constrained
-    WindowBase
-    (fn [v] (if (#{:fixed :sliding} (:window/type v))
-              (:window/range v)
-              true))
-    ":window/range must be defined for :fixed or :sliding window"))
+  (s/constrained
+   WindowBase
+   (fn [v] (if (#{:fixed :sliding} (:window/type v))
+             (:window/range v)
+             true))
+   ":window/range must be defined for :fixed or :sliding window"))

 (def StateAggregationCall
   {(s/optional-key :aggregation/init) Function


Falling-left state.

Falling-left state.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -552,7 +552,13 @@
                {:x speed :y (- fall-speed)}
                (bumping-transitions id :left :top :left walls others)
                (bumping-transitions id :left :falling-left walls others)
-               (bumping-transitions id :top :right walls others)))))
+               (bumping-transitions id :top :right walls others))
+             (make-state
+               :falling-left
+               {:x (- speed) :y (- fall-speed)}
+               (bumping-transitions id :right :top :right walls others)
+               (bumping-transitions id :right :falling-right walls others)
+               (bumping-transitions id :top :left walls others)))))

 (defn make-scene-a [x] (let [ids #{:ga :gb :gc :gd :ge}
                              walls #{[0 0 164 8]


initiates controlled time in with-test-env

--- src/riemann/test.clj
+++ src/riemann/test.clj
@@ -104,11 +104,12 @@
        persistent!))

 (defmacro with-test-env
-  "Prepares a fresh set of taps, binds *testing* to true, and runs body in an
-  implicit do. Wrap your entire test suite (including defining the streams
-  themselves) in this macro. Note that you'll have to use (eval) or
-  (load-file), etc, in order for this to work because the binding takes effect
-  at *run time*, not *compile time*--so make your compile time run time and wow
+  "Prepares a fresh set of taps, binds *testing* to true, initiates controlled
+  time and resets the schedulerand runs body in an implicit do. Wrap your entire
+  test suite (including defining the streams themselves) in this macro. Note that
+  you'll have to use (eval) or (load-file), etc, in order for this to work
+  because the binding takes effect at *run time*, not *compile time*--so make
+  your compile time run time and wow
   this gets confusing.

   (with-test-env
@@ -119,7 +120,9 @@
   [& body]
   `(binding [*testing* true
              *taps*    (atom {})]
-     ~@body))
+     (time.controlled/with-controlled-time!
+       (time.controlled/reset-time!)
+       ~@body)))

 (defn inject!
   "Takes a sequence of streams, initiates controlled time and resets the


Make branch url point straight to commit list

--- src/runbld/build.clj
+++ src/runbld/build.clj
@@ -58,7 +58,7 @@
                                           (-> opts :build :org)
                                           (-> opts :build :project)
                                           (:commit commit))
-                      :branch-url (format "https://github.com/%s/%s/tree/%s"
+                      :branch-url (format "https://github.com/%s/%s/commits/%s"
                                           (-> opts :build :org)
                                           (-> opts :build :project)
                                           (-> opts :build :branch))


Add a blank page after the cover-recto

Add a blank page after the cover-recto

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -450,7 +450,7 @@
 (defn- coverpage-recto [title year issue]
   (let [fill-color (format "fill:%s device-%s" (color-rgb issue) (color issue))]
     [:fo:page-sequence {:id "cover-recto" :master-reference "cover-recto"
-                        :force-page-count "no-force"
+                        :force-page-count "even"
                         :font-family  "StoneSansSemibold"}
      [:fo:static-content {:flow-name "xsl-region-start" :role "artifact"}
       [:fo:block]
@@ -572,12 +572,12 @@

 (defn- layout-master-set []
   [:fo:layout-master-set
-   (simple-page-master {:master-name "cover-recto"
+   (simple-page-master {:master-name "cover-recto-main"
                         :margin-left "0mm" :margin-right "0mm" :margin-top "0mm" :margin-bottom "0mm"}
                        [:fo:region-body
                         {:margin-left "30mm" :margin-right "5mm" :margin-top "178mm":margin-bottom "5mm"}]
                        [:fo:region-start {:extent "25mm" :reference-orientation "90"}])
-   (simple-page-master {:master-name "cover-verso"
+   (simple-page-master {:master-name "cover-verso-main"
                         :margin-left "0mm" :margin-right "0mm" :margin-top "0mm" :margin-bottom "0mm"}
                        [:fo:region-body
                         {:margin-left "5mm" :margin-right "30mm" :margin-top "86mm" :margin-bottom "5mm"}]
@@ -589,14 +589,20 @@

    [:fo:page-sequence-master {:master-name "main"}
     [:fo:repeatable-page-master-alternatives
-     [:fo:conditional-page-master-reference
-      {:master-reference "first" :page-position "first"}]
+     [:fo:conditional-page-master-reference {:master-reference "first" :page-position "first"}]
      [:fo:conditional-page-master-reference
       {:master-reference "verso" :odd-or-even "even" :blank-or-not-blank "not-blank"}]
      [:fo:conditional-page-master-reference
       {:master-reference "recto" :odd-or-even "odd" :blank-or-not-blank "not-blank"}]
-     [:fo:conditional-page-master-reference
-      {:master-reference "blank" :blank-or-not-blank "blank"}]]]])
+     [:fo:conditional-page-master-reference {:master-reference "blank" :blank-or-not-blank "blank"}]]]
+   [:fo:page-sequence-master {:master-name "cover-recto"}
+    [:fo:repeatable-page-master-alternatives
+     [:fo:conditional-page-master-reference {:master-reference "blank" :blank-or-not-blank "blank"}]
+     [:fo:conditional-page-master-reference {:master-reference "cover-recto-main"}]]]
+   [:fo:page-sequence-master {:master-name "cover-verso"}
+    [:fo:repeatable-page-master-alternatives
+     [:fo:conditional-page-master-reference {:master-reference "blank" :blank-or-not-blank "blank"}]
+     [:fo:conditional-page-master-reference {:master-reference "cover-verso-main"}]]]])

 (defn- declarations
   [title description]


Added another grouper test test.

Added another grouper test test.

--- src/cbfg/grouper-test.cljs
+++ src/cbfg/grouper-test.cljs
@@ -34,7 +34,14 @@
                   (e n
                      (atake tg (:take-all-ch g))
                      {:a :AA}
-                     nil))
+                     nil)
+                  (let [r (ago take-test tg
+                               (atake take-test (:take-all-ch g)))]
+                    (aput tg (:put-ch g) [:b (fn [_] :B)])
+                    (e n
+                       (atake tg r)
+                       {:b :B}
+                       (atake tg r))))
            "pass"
            (str "FAIL: on test-grouper #" @n)))))


formatting

formatting

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -59,8 +59,7 @@
 (defn set-group-and-page! [group-id page-id]
   (swap! app-state (fn [s] (assoc s
                              :open-group-id group-id
-                             :page page-id
-                             ))))
+                             :page page-id))))
 ; session

 (defn set-session! [session]


add ui for creating groups

add ui for creating groups

--- src/chat/client/views.cljs
+++ src/chat/client/views.cljs
@@ -5,7 +5,8 @@
             [chat.client.views.new-message :refer [new-message-view]]
             [chat.client.dispatcher :refer [dispatch!]]
             [chat.client.store :as store]
-            [chat.client.views.helpers :as helpers]))
+            [chat.client.views.helpers :as helpers])
+  (:import [goog.events KeyCodes]))

 (defn message-view [message owner]
   (reify
@@ -129,6 +130,16 @@
                                  (get-in @store/app-state [:users user-id :avatar]))})
             (dom/div #js {:className "extras"}
               (om/build tags-view grouped-tags)
+              (dom/div #js {:className "new-group"}
+                (dom/label nil "New Group"
+                  (dom/input #js {:placeholder "Group Name"
+                                  :onKeyDown
+                                  (fn [e]
+                                    (when (= KeyCodes.ENTER e.keyCode)
+                                      (.preventDefault e)
+                                      (let [group-name (.. e -target -value)]
+                                        (dispatch! :create-group {:name group-name})
+                                        (set! (.. e -target -value) "")))) })))
               (dom/div #js {:className "logout"
                             :onClick (fn [_] (dispatch! :logout nil))} "Log Out")))
           (apply dom/div #js {:className "threads"}


rename fn generating link for email

rename fn generating link for email

--- src/chat/server/invite.clj
+++ src/chat/server/invite.clj
@@ -22,14 +22,6 @@
     mac
     (hmac hmac-secret data)))

-(defn make-invite-link
-  [invite]
-  (let [secret-nonce (random-nonce 20)]
-    (cache-set! (str (invite :id)) secret-nonce)
-    (str (env :site-url)
-         "/accept?tok=" secret-nonce
-         "&invite=" (invite :id))))
-
 (defn verify-invite-nonce
   "Verify that the given nonce is valid for the invite"
   [invite nonce]
@@ -41,9 +33,17 @@
     (do (timbre/warnf "Expired nonce %s for invite %s" nonce invite)
         {:error "Expired token"})))

+(defn make-email-invite-link
+  [invite]
+  (let [secret-nonce (random-nonce 20)]
+    (cache-set! (str (invite :id)) secret-nonce)
+    (str (env :site-url)
+         "/accept?tok=" secret-nonce
+         "&invite=" (invite :id))))
+
 (defn invite-message
   [invite]
-  (let [accept-link (make-invite-link invite)]
+  (let [accept-link (make-email-invite-link invite)]
     {:text (str (invite :inviter-email) " has invited to join the " (invite :group-name)
                 " group on " (env :site-url) ".\n\n"
                 "Go to " accept-link " to accept.")


STOP READING FILES

STOP READING FILES

--- src/doctopus/web.clj
+++ src/doctopus/web.clj
@@ -140,10 +140,10 @@
   [handler]
   (fn [request]
     (let [response (handler request)
-          file (:body response)
+          body (:body response)
           tentacle-name (get-tentacle-from-uri (:uri request))]
-      (if (and tentacle-name file (html? file))
-        (assoc response :body (templates/add-omnibar (slurp file) {:tentacle-name tentacle-name}))
+      (if (and tentacle-name body (html? body))
+        (assoc response :body (templates/add-omnibar body {:tentacle-name tentacle-name}))
         response))))

 (def doctopus-ring-defaults


Remove assem.clj since we're using the gas.clj assembly representation

--- src/clj/minijava/assem.clj
+++ src/clj/minijava/assem.clj
@@ -1,32 +0,0 @@
-(ns minijava.assem
-  "Assembly code classes")
-
-(defprotocol Instr
-  (use [this])
-  (def [this])
-  (jumps [this])
-  (format [this]))
-
-(deftype AssemOper [fmt, dsts, srcs, jmps]
-  clojure.lang.IPersistentMap
-  Instr
-  (use [] srcs)
-  (def [] dsts)
-  (jumps [] jmps)
-  (format [] "unimplemented"))
-
-(deftype AssemMove [fmt, dst, src]
-  clojure.lang.IPersistentMap
-  Instr
-  (use [] (list src))
-  (def [] (list dst))
-  (jumps [] '())
-  (format [] "unimplemented"))
-
-(deftype AssemLabel [fmt, lbl]
-  clojure.lang.IPersistentMap
-  Instr
-  (use [] '())
-  (def [] '())
-  (jumps [] '())
-  (format [] "unimplemented"))


Wait until listeners are done before tallying bytes

--- src/clj/runbld/process.clj
+++ src/clj/runbld/process.clj
@@ -144,9 +144,7 @@
    :took           s/Num
    :cmd            [s/Str]
    :cmd-source     s/Str
-   :bytes          {:total  s/Num
-                    :stdout s/Num
-                    :stderr s/Num}}
+   :bytes          Ref}
   ([program args scriptfile]
    (exec program args scriptfile (System/getProperty "user.dir")))
   ([program args scriptfile cwd]
@@ -169,7 +167,7 @@
       res
       {:cmd cmd
        :cmd-source (slurp scriptfile)
-       :bytes @(:bytes res)}))))
+       :bytes (:bytes res)}))))

 (s/defn start-file-listener! :- [ManyToManyChannel]
   ([file]
@@ -219,9 +217,9 @@
                                    es-process
                                    stdout-process
                                    stderr-process]))
-         out-bytes (get-in result [:bytes :stdout])
-         err-bytes (get-in result [:bytes :stderr])
-         total-bytes (get-in result [:bytes :total])]
+         out-bytes (@(:bytes result) :stdout)
+         err-bytes (@(:bytes result) :stderr)
+         total-bytes (@(:bytes result) :total)]
      (store/after-log es-opts)
      (merge
       (dissoc result :bytes)


Most fundamental bugs seem gone

Most fundamental bugs seem gone

Seems to be going into an infinite loop (maybe blocking on put!) when I
try to use the Eval! button. It seems to totally lock the web page. Not
only can I not refresh it, but I can't even close it.

Still, it seems like a positive step forward.

--- src/cljs/frereth/repl.cljs
+++ src/cljs/frereth/repl.cljs
@@ -71,28 +71,7 @@
     (init-state
      [_]
      {:input ""
-      :namespace "user"
-      :evaluator (async/chan)})
-    om/IWillMount
-    (will-mount
-     [_]
-     ;; It seems as though this is what should handle
-     ;; the channel creation. Since there doesn't seem
-     ;; to be a better place to close! it than IWillUnmount
-     (let [evaluator (om/get-state owner :evaluator)]
-       (go (loop []
-             (when-let [forms (<! evaluator)]
-               ;; TODO: evaluate forms. Do this update inside the
-               ;; callback of the evaluation instead
-               (om/transact! data :output
-                             (fn [xs]
-                               (conj xs forms))))
-             (recur)))))
-    om/IWillUnmount
-    (will-unmount
-     [_]
-     (let [evaluator (om/get-state owner :evaluator)]
-       (async/close! evaluator)))
+      :namespace "user"})
     om/IRenderState
     (render-state
      [this {:keys [input namespace]}]
@@ -109,6 +88,7 @@
                                        evaluator (om/get-state owner :evaluator)]
                                    (println "I've been clicked! Sending\n"
                                             forms "\nto\n" evaluator)
+                                   (js/log evaluator)
                                    ;; I'm getting a warning about returning false from an event handler.
                                    ;; Q: Why?
                                    (if forms
@@ -120,28 +100,54 @@
 (defn repl-wrapper
   [data owner]
   (reify
-    om/IRender
-    (render
+    om/IInitState
+    (init-state [_]
+                {:evaluator (async/chan)})
+    om/IWillMount
+    (will-mount
      [_]
+     ;; It seems as though this is what should handle
+     ;; the channel creation. Since there doesn't seem
+     ;; to be a better place to close! it than IWillUnmount
+     (let [evaluator (om/get-state owner :evaluator)]
+       (go (loop []
+             (when-let [forms (<! evaluator)]
+               ;; TODO: evaluate forms. Do this update inside the
+               ;; callback of the evaluation instead
+               (om/transact! data :output
+                             (fn [xs]
+                               (conj xs forms))))
+             (recur)))))
+    om/IRenderState
+    (render-state
+     [this state]
      ;; Honestly, this is sideways.
      ;; Really want to build the result columns up,
-     ;; then combine those individual components into a table
-     (let [repls (:repls data)
-           headings (map :heading repls)
-           output-columns (mapv :output repls)
-           input (map :input repls)
-           namespaces (map :namespaces repls)
+     ;; then combine those individual components
+     ;; horizontally into a table
+     (let [repl (-> data :repls first)
+           heading (:heading repl)
+           output-rows (:output repl)
+           input (:input repl)
+           namespaces (:namespaces repl)
            table-style #js {:border "1px solid black;"}]
        (dom/table #js {:style table-style}
-                  ;; Header: which REPL is this?
-                  (apply dom/tr nil
-                         (map (partial dom/th #js {:style table-style}) headings))
-                  ;; Output: what's come from the printer?
-                  (om/build-all printer output-columns)
-                  ;; Input: What is the user entering?
-                  (apply dom/tr nil
-                         (map (partial dom/td #js {:style table-style})
-                              (om/build-all reader input))))))))
+                  (dom/tbody nil
+                             ;; Header: which REPL is this?
+                             (dom/tr nil
+                                     (dom/th #js {:style table-style} heading))
+                             ;; Output: what's come from the printer?
+                             (om/build printer output-rows)
+                             ;; Input: What is the user entering?
+                             (dom/tr nil
+                                     (dom/td #js {:style table-style}
+                                             (om/build reader input
+                                                       {:init-state state})))))))
+    om/IWillUnmount
+    (will-unmount
+     [_]
+     (let [evaluator (om/get-state owner :evaluator)]
+       (async/close! evaluator)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


Not really using the HR transformer

Not really using the HR transformer

--- src/cljs/memento/core.cljs
+++ src/cljs/memento/core.cljs
@@ -29,7 +29,6 @@
    transformers/autourl-transformer
    transformers/link
    transformers/reference-link
-   transformers/hr
    transformers/li
    transformers/italics
    transformers/em


The new tools.reader requires explicit binding of its resolve-symbol

--- src/cljs/replumb/repl.cljs
+++ src/cljs/replumb/repl.cljs
@@ -62,7 +62,10 @@
   "Try to read a string binding all the standard data readers. This
   function throws if a valid form cannot be found."
   [line]
-  (binding [r/*data-readers* tags/*cljs-data-readers*]
+  (binding [ana/*cljs-ns* (:current-ns @app-env)
+            env/*compiler* st
+            r/*data-readers* tags/*cljs-data-readers*
+            r/resolve-symbol ana/resolve-symbol]
     (r/read-string {:read-cond :allow :features #{:cljs}} line)))

 (defn ns-form?


Move debug fn to top

Move debug fn to top

--- src/cljs/russyll/core.cljs
+++ src/cljs/russyll/core.cljs
@@ -49,10 +49,14 @@

 ;; Handlers

-;; -- Self test
 (re-frame/reg-event-db
  :initiliaze
  (fn [_ _] app-db))
+
+;; -- Self test
+
+(defn debug [db]
+  (do (print db) db))

 (re-frame/reg-event-db
  :set-current-word
@@ -81,9 +85,6 @@
         (assoc :done true)
         )
     (set-new-word db [])))
-
-(defn debug [db]
-  (do (print db) db))

 (re-frame/reg-event-db
  :next-word


now words are processed in order

now words are processed in order

--- src/cljs/russyll/core.cljs
+++ src/cljs/russyll/core.cljs
@@ -13,7 +13,8 @@
     [orphoep :only [orpho-single ++ --]]
     [usertest :only [serve-words-rand calc-stats]]
     )
-  (:import goog.History))
+  (:import goog.History)
+  )

 ;; -------------------------
 ;; Views
@@ -62,6 +63,8 @@

 (def table-syllabied (r/atom {}))

+(def splitted-mapped-atom (r/atom []))
+
 (def current-model (r/atom 0))

 (defn syllaby [text-val]
@@ -69,8 +72,10 @@
         splitted-t (text/tokenize text-val "'")
         map-words (text/set-of-vals splitted-t)
         text-done (++ (text/text-by-model splitted-t map-words @current-model))
+        splitted-mapped (map #(vector % (get map-words %)) splitted-t)
         ]
     (do
+      (swap! splitted-mapped-atom #(-> splitted-mapped))
       (swap! table-syllabied #(-> map-words))
       (swap! text-syllabied #(-> text-done))
       )
@@ -86,24 +91,26 @@
    ])

 (defn textarea []
-  [:div
-   [:h2.ribbon "Put in some data!"]
-   [:select.form-control {:on-change (fn [evt] (do (swap! current-model #(-> evt .-target .-value)) (syllaby @text-in))) :value @current-model}
-    (for [{:keys [name i]} models]
-      [:option {:value i :key i} name])
-    ]
-   [:textarea {:style textarea-style :on-change (fn [evt] (do (swap! text-in #(-> evt .-target .-value)) (syllaby @text-in))) :value @text-in}]
-   [:pre @text-syllabied]
-   [:table.table.table-striped.table-bordered.table-hover.table-condensed.syllabied
-    [:tr [:th] (for [{:keys [short name]} models] [:th {:key name :title name} short])]
-    (for
-      [word-row @table-syllabied]
-      [:tr {:key (key word-row)} [:td (key word-row)]
-       (map-indexed (fn [ix word] [:td {:key ix} word]) (val word-row))
-       ]
-      )
-    ]
-   ]
+  (let [table @table-syllabied]
+    [:div
+     [:h2.ribbon "Put in some data!"]
+     [:select.form-control {:on-change (fn [evt] (do (swap! current-model #(-> evt .-target .-value)) (syllaby @text-in))) :value @current-model}
+      (for [{:keys [name i]} models]
+        [:option {:value i :key i} name])
+      ]
+     [:textarea {:style textarea-style :on-change (fn [evt] (do (swap! text-in #(-> evt .-target .-value)) (syllaby @text-in))) :value @text-in}]
+     [:pre @text-syllabied]
+     [:table.table.table-striped.table-bordered.table-hover.table-condensed.syllabied
+      [:tr [:th] (for [{:keys [short name]} models] [:th {:key name :title name} short])]
+      (for
+        [[word syll-models] @splitted-mapped-atom]
+        [:tr {:key (rand)} [:td word]
+         (map-indexed (fn [ix word] [:td {:key ix} word]) syll-models)
+         ]
+        )
+      ]
+     ]
+    )
   )

 (defn table-text []


refactor out common atom-input with overrides

--- src/cljs/todomvc/core.cljs
+++ src/cljs/todomvc/core.cljs
@@ -46,6 +46,15 @@
 (defn focus [component]
   (.focus (reagent/dom-node component)))

+(defn atom-input
+  ([value] (atom-input value nil))
+  ([value props]
+   [:input (merge
+            {:type "text"
+             :value @value
+             :on-change #(reset! value (-> % .-target .-value))}
+            props)]))
+
 (defn todo-input
   "Input box for todos. Pass in initial title and a callback for on-save."
   [{:keys [text on-save]}]
@@ -55,13 +64,11 @@
                                        (if-not (empty? v)
                                          (on-save v)))]
                            (fn []
-                             [:input {:type "text"
-                                      :value @val
-                                      :on-blur save
-                                      :on-change #(reset! val (.. % -target -value))
-                                      :on-key-down #(case (.-which %)
-                                                      13 (save)
-                                                      nil)}]))
+                             (atom-input val
+                                         {:on-blur save
+                                          :on-key-down #(case (.-which %)
+                                                          13 (save)
+                                                          nil)})))
                          :component-did-mount focus}))

 (defn todo-entry []
@@ -81,31 +88,21 @@
                       :on-save #(do (save! id %)
                                     (reset! editing false))}])])))

-(defn atom-input
-  ([value] (atom-input value nil))
-  ([value props]
-   [:input (merge
-            {:type "text"
-             :value @value
-             :on-change #(reset! value (-> % .-target .-value))}
-            props)]))
-

 (defn new-todo []
   (let [todo (atom "")]
     (reagent/create-class {:render
                            (fn []
-                              [:input#new-todo
-                               {:type "text"
-                                :value @todo
-                                :placeholder "What needs to be done?"
-                                :on-change #(reset! todo (.. % -target -value))
-                                :on-key-down #(case (.-which %)
-                                                13 ((fn [_] (if-not (empty? (-> @todo str clojure.string/trim))
-                                                              (do
-                                                                (add-todo! @todo)
-                                                                (reset! todo "")))))
-                                                nil)}])
+                             (atom-input
+                              todo
+                              {:id "new-todo"
+                               :placeholder "What needs to be done?"
+                               :on-key-down #(case (.-which %)
+                                               13 ((fn [_] (if-not (empty? (-> @todo str clojure.string/trim))
+                                                             (do
+                                                               (add-todo! @todo)
+                                                               (reset! todo "")))))
+                                               nil)}))
                            :component-did-mount focus})))

 (defn todo-app [_]


Fix bug in tests for layouts.base

Fix bug in tests for layouts.base

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

--- src/conexp/tests/layouts/base.clj
+++ src/conexp/tests/layouts/base.clj
@@ -101,15 +101,6 @@
     (is (= (upper-label-position layout 1) nil))
     (is (= (lower-label-position layout 1) [0 -1]))))

-(deftest test-lattice
-  (with-testing-data [lay testing-layouts]
-    (let [lattice (lattice lay)]
-      (and (= (nodes lay) (base-set lattice))
-           (forall [x (nodes lay),
-                    y (nodes lay)]
-             (<=> (directly-neighboured? lattice x y)
-                  (contains? (connections lay) [x y])))))))
-
 ;;;

 (defn- rand-layout []
@@ -128,6 +119,15 @@
    (repeatedly 10 rand-layout)))

 ;;;
+
+(deftest test-lattice
+  (with-testing-data [lay testing-layouts]
+    (let [lattice (lattice lay)]
+      (and (= (nodes lay) (base-set lattice))
+           (forall [x (nodes lay),
+                    y (nodes lay)]
+             (<=> (directly-neighboured? lattice x y)
+                  (contains? (connections lay) [x y])))))))

 (deftest test-update-positions
   (with-testing-data [layout testing-layouts]


It seems to be working correctly

It seems to be working correctly

--- slackbot/src/org/teamweek/slackbot.clj
+++ slackbot/src/org/teamweek/slackbot.clj
@@ -13,10 +13,6 @@
             [taoensso.timbre :as log]
             [byte-streams])
   (:gen-class))
-
-;; for testing
-(defonce slack-token (or (System/getenv "SLACK_TOKEN")
-                         (throw (ex-info "No SLACK_TOKEN provided" {}))) )

 (defn connect-url [token]
   (str "https://slack.com/api/rtm.start?token=" token))
@@ -155,7 +151,7 @@

 (defn submit-answers [db-conn domain user answers]
   (try
-    (log/infof "Submitting % answers to %s for %s" (count answers) domain user)
+    (log/infof "Submitting %s answers to %s for %s" (count answers) domain user)
     (let [db (d/db db-conn)
           user-eid (d/q '[:find ?member .
                           :in $ ?domain ?user
@@ -171,7 +167,7 @@
                 :answer/ts (:ts answer)
                 :question/_answers (:question-id answer)})]
       @(d/transact db-conn tx)
-      (log/infof "Successfully Submitted % answers to %s for %s" (count answers) domain user))
+      (log/infof "Successfully Submitted %s answers to %s for %s" (count answers) domain user))
     (catch Exception e
       (log/errorf e "Failed to submit answers %s for domain %s and user %s"
                   (pr-str answers) domain user)
@@ -201,7 +197,6 @@
                         (not-empty questions))
                (connect token))]
     (if conn
-      ;; TODO in parallell, but the job is not finished before all has answered/timeout
       (do
         (log/infof "Sending quesitonnaire for %s (%s users and %s questions)" domain users questions)
         (dorun
@@ -310,20 +305,14 @@
   (let [scheduler (scheduler/start (scheduler/initialize))
         db-conn (d/connect db-uri)]
     (init-start-jobs scheduler db-conn)
-    (listen-for-team-updates scheduler db-conn)))
+    (future (listen-for-team-updates scheduler db-conn))))

 (comment
-  (def conn (connect slack-token))
-
-  ((:shutdown-fn conn))
-
-  (send-to-user! conn "jonas" "ping!")
-
-
-  (async/thread
-    (let [answers (send-questionnaire conn "jonas" ["How are you today?"
-                                                    "What are your plans for tomorrow?"])]
-      (send-to-user! conn "jonas" (str "You answered: " (pr-str answers)))))
+
+  ;; for testing
+  (defonce slack-token (or (System/getenv "SLACK_TOKEN")
+                           (throw (ex-info "No SLACK_TOKEN provided" {}))) )
+

   ;; db stuff

@@ -336,13 +325,13 @@

   (def db-conn (d/connect db-uri))

-  (d/q '[:find (pull ?answer [:answer/author :answer/text :answer/ts])
+  (d/q '[:find ?answer ;(pull ?answer [:answer/author :answer/text :answer/ts])
          :where
          [?answer :answer/text]]
        (d/db db-conn))

-  (d/transact db-conn (read-string (slurp "../webapp/resources/schema.edn")))
+  @(d/transact db-conn (read-string (slurp "../webapp/resources/schema.edn")))

   (future (listen-for-team-updates nil db-conn))

@@ -355,18 +344,23 @@
      :team/members (for [[name email] members]
                      {:member/name name
                       :member/email email})
-     :team/questions (for [text questions]
-                       {:question/text text})})
+     :team/questions (for [{:keys [text order]} questions]
+                       {:question/text text
+                        :question/order order})})

   (def every-minute "0 * * * * ?")

-  (d/transact db-conn [(create-team "teamweek-org" slack-token every-minute
-                                    [#_["jonas" "jonas@gmail"]
-                                     ["ivan" "ivan@gmail"]]
-                                    ["How are you today?"
-                                     "What are your plans for tomorrow?"])])
-
-  (d/transact db-conn [[:db.fn/retractEntity [:team/domain "teamweek-org"]]])
+  @(d/transact db-conn [(create-team "teamweek-org" slack-token every-minute
+                                     [["jonas" "jonas@gmail"]
+                                      #_["ivan" "ivan@gmail"]]
+                                     [{:text "How are you today?"
+                                       :order 1}
+                                      {:text "What are your plans for tomorrow?"
+                                       :order 2}])])
+
+  @(d/transact db-conn [[:db.fn/retractEntity [:team/domain "teamweek-org"]]])
+
+  @(d/transact db-conn [[:db/add [:team/domain "teamweek-org"] :team/schedule "30 * * * * ?"]])


Get rid of BlockGraph

Get rid of BlockGraph

No real reason to have a type for BlockGraphs, as it's not really
a public API, and all the information is contained within ClassGraphs.
Seems better pulled apart in this way.

--- src/fatlip/plot.cljs
+++ src/fatlip/plot.cljs
@@ -16,8 +16,6 @@
   (mid-y [graph node-sep char-sep] "Midpoint of y-coordinates in the graph")
   (shift-ys [graph node-sep char-sep delta] "Shift the y-coordinate of every node by delta")
   (width [graph node-sep char-sep] "Width of the graph in y"))
-
-(defrecord BlockGraph [blocks succs preds sources])

 (defrecord BlockEdge [src dest weight]
   Reversible
@@ -232,47 +230,50 @@
         (recur sources' succs' (conj sorted node))))))

-(defn FlatGraph->BlockGraph
+(defn block-edges
+  [flat-graph roots blocks]
+  (let [edge->set #(update-in %1 [(:src %2)] (fnil conj #{}) %2)]
+    (reduce (fn [{:keys [succs preds] :as edges} block]
+              (let [b-succs (->> (map #(get-in flat-graph [:aboves %])
+                                      block)
+                                 (remove nil?)
+                                 (group-by #(get roots %))
+                                 (map (fn [[above-root above-nodes]]
+                                        (BlockEdge.
+                                         (get blocks above-root)
+                                         block
+                                         (apply max (map :weight
+                                                         above-nodes))))))
+                    b-preds (map rev b-succs)]
+                (-> edges
+                    (update-in [:succs] #(reduce edge->set % b-succs))
+                    (update-in [:preds] #(reduce edge->set % b-preds)))))
+            {:succs {} :preds {}}
+            (vals blocks))))
+
+
+(defn FlatGraph->block-info
   "Organizes all of the Nodes and Segments in a FlatGraph into horizontally-
   aligned blocks. These blocks are then organized into a graph of their own,
   where the nodes are blocks and the edges are determined by adjacency between
   their constituent Nodes and Segments in each FlatLayer."
   [flat-graph]
   (let [[roots blocks] (blockify flat-graph)
-        edge->set #(update-in %1 [(:src %2)] (fnil conj #{}) %2)
-        [succs preds]
-        (reduce (fn [[succs preds] block-item]
-                  (let [block (second block-item) ; we want the value
-                        b-succs (->> (map #(get-in flat-graph [:aboves %])
-                                          block)
-                                     (remove nil?)
-                                     (group-by #(get roots %))
-                                     (map (fn [[above-root above-nodes]]
-                                            (BlockEdge.
-                                             (get blocks above-root)
-                                             block
-                                             (apply max (map :weight
-                                                             above-nodes))))))
-                        b-preds (map rev b-succs)]
-                    [(reduce edge->set succs b-succs)
-                     (reduce edge->set preds b-preds)]))
-                [{} {}]
-                blocks)
-        simple-succs (->> (map (fn [[src edges]]
-                                 [src (set (map :dest edges))])
-                               succs)
-                          (into {}))
+        {:keys [succs preds]} (block-edges flat-graph roots blocks)
+        simple-succs (into {} (map (fn [[src edges]]
+                                     [src (set (map :dest edges))])
+                                   succs))
         block-set (set (vals blocks))
         long-block (first (filter #(> (count %) 1) block-set))
         layer-id-compare (if (< (-> long-block first :layer-id)
                                 (-> long-block second :layer-id))
                            < >)
-        sources (->> (set/difference block-set (keys preds))
-                     (sort-by #(:layer-id (get % 0))
-                              layer-id-compare))
+        sources (sort-by #(:layer-id (get % 0))
+                         layer-id-compare
+                         (set/difference block-set (keys preds)))
         topo-blocks (topo-sort sources simple-succs)]
-    (map->BlockGraph {:blocks topo-blocks :succs succs :preds preds
-                      :simple-succs simple-succs :sources sources})))
+    {:blocks topo-blocks :succs succs :preds preds
+     :simple-succs simple-succs :sources sources}))

 (defn classify-source
@@ -289,27 +290,28 @@

 (defn classify
-  "Given a BlockGraph, organizes the blocks into classes that are defined as
+  "Given block-info, organizes the blocks into classes that are defined as
   all blocks that are reachable from a block that is a source in its
-  BlockGraph, with preference given to the left-most sources"
-  [block-graph]
+  graph, with preference given to the left-most sources"
+  [block-info]
   (reduce (fn [classes root-block]
             (let [proto-class (classify-source root-block
-                                               (:simple-succs block-graph))
+                                               (:simple-succs block-info))
                   class-set (apply set/difference proto-class (vals classes))
                   class (filterv #(contains? class-set %)
-                                 (:blocks block-graph))]
+                                 (:blocks block-info))]
               (reduce #(assoc %1 %2 class) classes class)))
           {}
-          (:sources block-graph)))
-
-
-(defn BlockGraph->ClassGraph
-  "Given a BlockGraph, organizes the blocks into classes and then constructs a
+          (:sources block-info)))
+
+
+(defn FlatGraph->ClassGraph
+  "Given block-info, organizes the blocks into classes and then constructs a
   ClassGraph, where the nodes are classes and the edges are BlockEdges that
   span classes. This means there can be multiple edges per class pair."
-  [block-graph]
-  (let [block-classes (classify block-graph)
+  [flat-graph]
+  (let [block-info (FlatGraph->block-info flat-graph)
+        block-classes (classify block-info)
         classes (set (vals block-classes))
         edge->set #(update-in %1 [(get block-classes (:src %2))]
                               (fnil conj #{}) %2)
@@ -317,7 +319,7 @@
         (reduce (fn [[succs preds] class]
                   (let [class-set (set class)
                         block-succs (->> class
-                                         (mapcat #(-> block-graph :succs
+                                         (mapcat #(-> block-info :succs
                                                       (get %)))
                                          (remove #(contains? class-set
                                                              (:dest %)))
@@ -340,13 +342,8 @@
     (map->ClassGraph {:classes topo-classes
                       :succs succs :preds preds
                       :sources sources :sinks sinks
-                      :block-succs (:succs block-graph)
-                      :block-preds (:preds block-graph)})))
-
-
-(def FlatGraph->ClassGraph
-  (comp BlockGraph->ClassGraph
-        FlatGraph->BlockGraph))
+                      :block-succs (:succs block-info)
+                      :block-preds (:preds block-info)})))

 (defn FlatGraph->FlatGraphs


ensure name index is always present

ensure name index is always present

--- src/fileape/core.clj
+++ src/fileape/core.clj
@@ -85,15 +85,13 @@
                           ))

   (defn add-file-name-index [n i]
-    (if (= i 0)
-      n
-	    (let [s1 (interpose "." (-> n (clj-str/split #"\.")))]
+    (let [s1 (interpose "." (-> n (clj-str/split #"\.")))]
 	         (clj-str/join "" (flatten  [(drop-last s1)
 	                                         i
 	                                         "."
                                            (System/nanoTime)
                                            "."
-	                                      (last s1)])))))
+	                                      (last s1)]))))

   (defn close-and-roll [{:keys [file ^OutputStream out] :as file-data} i]
     "Close the output stream and rename the file by removing the last _[number] suffix"


increase version for release

increase version for release

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -1,4 +1,4 @@
-(defproject kafka-clj "3.6.6-SNAPSHOT"
+(defproject kafka-clj "3.6.6"
   :description "fast kafka library implemented in clojure"
   :url "https://github.com/gerritjvv/kafka-fast"
   :license {:name "Eclipse Public License"


lein-release plugin: preparing 0.4.0 release

--- backend/project.clj
+++ backend/project.clj
@@ -1,4 +1,4 @@
-(defproject lambdaui "0.4.0-SNAPSHOT"
+(defproject lambdaui "0.4.0"
   :description "LambdaCD-Plugin that provides a modern UI for your pipeline."
   :url "https://github.com/sroidl/lambda-ui"
   :license {:name "Apache License 2.0"


upgrade hikaricp dep version

upgrade hikaricp dep version

--- backend/project.clj
+++ backend/project.clj
@@ -18,7 +18,7 @@
                  [commons-io/commons-io "2.6"]
                  [compojure "1.6.0" :exclusions [medley]]
                  [duct "0.8.2"]
-                 [duct/hikaricp-component "0.1.1" :exclusions [org.slf4j/slf4j-nop]]
+                 [duct/hikaricp-component "0.1.2" :exclusions [org.slf4j/slf4j-nop]]
                  [environ "1.1.0"]
                  [funcool/cuerdas "2.0.5"]
                  [honeysql "0.9.1"]


menu entries

menu entries

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -67,6 +67,20 @@
 (defonce scroll-text
   (font/make-text "100 24px Indie Flower"
                   "Old School Demo on a New School platform??! Crispin, here, paying homage to the 8-bit and 16-bit wonderboxes of our childhood. Commodore lives! A big shout out to Team Farnarkle and to the Inversion crew. Best wishes to everyone out there and enjoy the games!\n"))
+
+(def menu
+  [
+   {:title "Alien Forest Explorer"
+    :date "Global Game Jam, Feb 2015"
+    :desc "You are an alien away team of one, sent on a reconnosaince mission to recover a stranded alien new born. Your captain, Rex, is there to talk you through the adventure and help you find poor Ruddiger. Unique graphical style makes this one a visual treat, but a bit of a stomach churner."
+    :url "http://forest.procrustes.net"}
+   {:title "Marty Funk"
+    :date "Ludum Dare 32 Jam, April 2015"
+    :desc "The townsfolk grow angry, and you as the only man of cloth, must soothe their strained nerves by chanting to them. You can fly around by using the great trouser-breath yoga to help get in ear shot. But don't get hit by stones. The years of sitting have made you frail and weak."
+    :url "http://marty-funk.procrustes.net"}
+])
+
+(def selected (atom 0))

 (defn main []
   (go


Support absolute file path in deploy descriptor,
again.

Partially reverts: aa3c251cfd821434181741750bf88f2aece3b02a

--- src/containium/modules.clj
+++ src/containium/modules.clj
@@ -90,7 +90,10 @@
     ; else if not a Directory:
       (if-let [module-map (try (edn/read-string (slurp file))
                             (catch Throwable ex (throw (Exception. (str "Failed reading module descriptor: " file) ex))))]
-        (let [file (File. (System/getProperty "user.dir") (str (:file module-map)))]
+        (let [file-str (str (:file module-map))
+              file (if-not (. (:file module-map) startsWith "/")
+                           (File. file file-str)
+                    #_else (File. file-str))]
           (when-not (. file exists) (throw (IllegalArgumentException. (str file " does not exist."))))
           (merge descriptor-defaults module-map {:file file}))
       ; else if not a module descriptor file:


[#952] Don't require exporter-api-url

[#952] Don't require exporter-api-url

--- backend/src/akvo/lumen/config.clj
+++ backend/src/akvo/lumen/config.clj
@@ -10,7 +10,7 @@
   (assert (:lumen-keycloak-client-secret env)
           (error-msg "LUMEN_KEYCLOAK_CLIENT_SECRET"))
   (assert (:lumen-keycloak-url env) (error-msg "LUMEN_KEYCLOAK_URL"))
-  (assert (:exporter-api-url env) (error-msg "EXPORTER_API_URL"))
+  #_(assert (:exporter-api-url env) (error-msg "EXPORTER_API_URL"))
   (assert (:lumen-file-upload-path env) (error-msg "LUMEN_FILE_UPLOAD_PATH"))
   (when-not (= "yes" (:ci-build env))
     (assert (:lumen-email-password env) (error-msg "LUMEN_EMAIL_PASSWORD"))


[#1189] Fixed typo in previous commit

[#1189] Fixed typo in previous commit

--- backend/src/akvo/lumen/update.clj
+++ backend/src/akvo/lumen/update.clj
@@ -69,7 +69,7 @@
                                         :type (keyword (:type %))
                                         :title (:title %)}
                                  (contains? % :key) (assoc :key (boolean (:key %))))
-                              (map keywordzie-keys imported-columns))
+                              (map keywordize-keys imported-columns))
         columns (map #(update % :title string/trim) (map keywordize-keys columns))]
     (set/subset? (set imported-columns)
                  (set columns))))


Remove unused import.

Remove unused import.

--- backend/src/uxbox/cli/collimp.clj
+++ backend/src/uxbox/cli/collimp.clj
@@ -24,7 +24,6 @@
             [uxbox.util.uuid :as uuid]
             [uxbox.util.data :as data])
   (:import [java.io Reader PushbackReader]
-           [javax.imageio ImageIO]
            [org.im4java.core Info]))

 ;; --- Constants & Specs


use shorter map access syntax

use shorter map access syntax

--- src/herring/core.clj
+++ src/herring/core.clj
@@ -91,8 +91,8 @@

 (defn -main [& args]
   (println "Launching Herring...")
-  (let [conn (rmq/connect {:host (get config :broker-host)
-                           :port (get config :broker-port)})
+  (let [conn (rmq/connect {:host (:broker-host config)
+                           :port (:broker-port config)})
         ch   (lch/open conn)]
     (println "Starting herring...")
     (le/declare ch herring-exchange


DNS

DNS

Google to OpenDNS

--- orange_livebox.boot
+++ orange_livebox.boot
@@ -250,8 +250,8 @@
             level admin
         }
     }
-    name-server 8.8.8.8
-    name-server 8.8.4.4
+    name-server 208.67.222.222
+    name-server 208.67.220.220
     ntp {
         server 0.ubnt.pool.ntp.org {
         }


unquote no longer required

unquote no longer required

--- src/insn/clojure.clj
+++ src/insn/clojure.clj
@@ -46,28 +46,29 @@
       prims
       [{:name "invokePrim", :desc prims, :emit body}
        {:name "invoke", :desc objs
-        :emit `[[:aload 0]
-                ~@(mapcat
-                   (clojure.core/fn [i arg]
-                     `[[:aload ~i]
-                       ~@(condp = arg
-                           :long [[:invokestatic `RT "longCast" [`Object :long]]]
-                           :double [[:invokestatic `RT "doubleCast" [`Object :double]]]
-                           nil)
-                       [:ldc nil]
-                       [:astore ~i]])
-                   (next (range))
-                   (butlast prims))
-                [:invokevirtual :this "invokePrim" ~prims]
-                ~@(condp = (last prims)
-                    :long [[:invokestatic `Long "valueOf" [:long `Long]]]
-                    :double [[:invokestatic `Double "valueOf" [:double `Double]]]
-                    nil)
-                [:areturn]]}]
+        :emit [[:aload 0]
+               (vec
+                (mapcat
+                 (clojure.core/fn [i arg]
+                   [[:aload i]
+                    (condp = arg
+                      :long [:invokestatic `RT "longCast" [`Object :long]]
+                      :double [:invokestatic `RT "doubleCast" [`Object :double]]
+                      nil)
+                    [:ldc nil]
+                    [:astore i]])
+                 (next (range))
+                 (butlast prims)))
+               [:invokevirtual :this "invokePrim" prims]
+               (condp = (last prims)
+                 :long [:invokestatic `Long "valueOf" [:long `Long]]
+                 :double [:invokestatic `Double "valueOf" [:double `Double]]
+                 nil)
+               [:areturn]]}]
       vararg?
       [{:name "getRequiredArity", :desc [:int]
-        :emit `[[:ldc ~(dec nargs)]
-                [:ireturn]]}
+        :emit [[:ldc (dec nargs)]
+               [:ireturn]]}
        {:name "doInvoke", :desc objs, :emit body}]
       :else
       [{:name "invoke", :desc objs, :emit body}])))


tweaks

tweaks

--- src/jsx_fun/core.clj
+++ src/jsx_fun/core.clj
@@ -71,7 +71,7 @@
     (visit [_ node]
       (println (Token/name (.getType node)))
       (when-let [js-doc (.getJSDocInfo node)]
-        (println js-doc)))))
+        (println (.toStringVerbose js-doc))))))

 ;(defn transform-commonjs
 ;  [filename src]
@@ -110,4 +110,7 @@
       (.comments parse-result))
     (NodeUtil/visitPreOrder
       (.ast parse-result) visitor (Predicates/alwaysTrue)))
+
+  ;; the above is super useful but we should probably use a regex
+  ;; to grab @providesModules
   )


PUT proxy respects a returned response

PUT proxy respects a returned response

--- src/yada/methods.clj
+++ src/yada/methods.clj
@@ -166,6 +166,22 @@

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

+(defprotocol PutResult
+  (interpret-put-result [_ ctx]))
+
+(extend-protocol PutResult
+  Response
+  (interpret-put-result [response ctx]
+    (assoc ctx :response response))
+  Object
+  (interpret-put-result [o ctx]
+    ctx)
+  clojure.lang.Fn
+  (interpret-put-result [f ctx]
+    (interpret-put-result (f ctx) ctx))
+  nil
+  (interpret-put-result [_ ctx] ctx))
+
 (deftype PutMethod [])

 (extend-protocol Method
@@ -177,17 +193,24 @@
     (let [f (get-in ctx [:resource :methods (:method ctx) :response]
                     (fn [_] (d/error-deferred
                              (ex-info (format "Resource %s does not provide a handler for :put" (type (:resource ctx)))
-                                     {:status 500}))))]
+                                      {:status 500}))))]
       (d/chain
-       (f ctx)
+       (when-let [f (get-in ctx [:resource :methods (:method ctx) :response])]
+         (f ctx))
        (fn [res]
-         (assoc-in ctx [:response :status]
-                   (cond
-                     ;; TODO: A 202 may be not what the user wants!
-                     ;; TODO: See RFC7240
-                     (d/deferred? res) 202
-                     (ctx/exists? ctx) 204
-                     :otherwise 201)))))))
+         (interpret-put-result res ctx))
+       (fn [ctx]
+         (let [status (get-in ctx [:response :status])]
+           (cond-> ctx
+             (not status) (assoc-in [:response :status]
+                                    (cond
+                                      ;; TODO: A 202 may be not what the user wants!
+                                      ;; TODO: See RFC7240
+                                      ;;(d/deferred? (-> ctx :response :body)) 202
+                                      (ctx/exists? ctx) 204
+                                      :otherwise 201))
+             (not (-> ctx :response :body)) zero-content-length
+             )))))))

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


Check that font file exists before returning it

--- src/zaffre/font.cljc
+++ src/zaffre/font.cljc
@@ -71,19 +71,21 @@
                      :linux (linux-font-paths)
                      :macosx (macosx-font-paths)
                      :window (windows-font-paths))]
-    (remove nil?
-      (for [path font-paths
-            ^File file (files path)
-            :when (some (fn [extension] (.endsWith (.getAbsolutePath file)  extension))
-                        extensions)]
-        (let [^Path file-path (.toPath file)]
-          (if (Files/isSymbolicLink file-path)
-            (let [^Path link (Files/readSymbolicLink file-path)]
-              (try
-                (Files/readSymbolicLink link)
-                (catch IOException e
-                  nil)))
-            (.toPath file)))))))
+    (filter (fn [^Path path]
+              (.exists (File. (str path))))
+      (remove nil?
+        (for [path font-paths
+              ^File file (files path)
+              :when (some (fn [extension] (.endsWith (.getAbsolutePath file)  extension))
+                          extensions)]
+          (let [^Path file-path (.toPath file)]
+            (if (Files/isSymbolicLink file-path)
+              (let [^Path link (Files/readSymbolicLink file-path)]
+                (try
+                  (Files/readSymbolicLink link)
+                  (catch IOException e
+                    nil)))
+              (.toPath file))))))))

 (declare make-font)
 (declare font-data)


note length abstractions, WIP

note length abstractions, WIP

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -129,6 +129,35 @@
   (doseq [osc @*oscillators*]
     (stop-osc osc)))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:dynamic *tempo* (atom 60))
+
+(defn set-tempo [bpm]
+  (reset! *tempo* bpm))
+
+(defn update-tempo [f & args]
+  (apply swap! *tempo* f args))
+
+(def note-lengths
+  ; TODO:
+  ; - dotted notes
+  ; - British note names (crotchet, quaver, etc.)
+  ; - a way to tie notes together (maybe a vector of note lengths)
+  {:sixty-fourth  64
+   :thirty-second 32
+   :sixteenth     16
+   :eighth        8
+   :quarter       4
+   :half          2
+   :whole         1})
+
+(defn parse-duration [duration]
+  (cond
+    (number? duration)     duration
+    (keyword? duration)    "TODO"
+    (sequential? duration) (apply + (map parse-duration duration))))
+
 (defn- play-note*
   [osc-model {:keys [pitch duration volume] :as note-model}]
   (let [{:keys [osc-node gain-node clock] :as osc-impl} (osc* osc-model)]
@@ -138,7 +167,8 @@
     (start-osc osc-impl)

     (when duration
-      (c/set-timeout! clock #(stop-osc osc-impl) duration))))
+      (let [duration-ms (parse-duration duration)]
+        (c/set-timeout! clock #(stop-osc osc-impl) duration)))))

 (defn play-note
   "Uses a one-off oscillator to play a note.


Refactor RSWN to have error function stand alone

--- src/clojush/problems/software/replace_space_with_newline.clj
+++ src/clojush/problems/software/replace_space_with_newline.clj
@@ -82,45 +82,6 @@
                   (count (filter #(not= \space %) in))]))
        inputs))

-(defn make-replace-space-with-newline-error-function-from-cases
-  [train-cases test-cases]
-  (fn the-actual-replace-space-error-function
-    ([program]
-      (the-actual-replace-space-error-function program :train))
-    ([program data-cases] ;; data-cases should be :train or :test
-                          (the-actual-replace-space-error-function program data-cases false))
-    ([program data-cases print-outputs]
-      (let [behavior (atom '())
-            errors (flatten
-                     (doall
-                       (for [[input [correct-output correct-int]] (case data-cases
-                                                                    :train train-cases
-                                                                    :test test-cases
-                                                                    [])]
-                         (let [final-state (run-push program
-                                                     (->> (make-push-state)
-                                                       (push-item input :input)
-                                                       (push-item "" :output)))
-                               printed-result (stack-ref :output 0 final-state)
-                               int-result (stack-ref :integer 0 final-state)]
-                           (when print-outputs
-                             (println (format "\n| Correct output: %s\n| Program output: %s" (pr-str correct-output) (pr-str printed-result)))
-                             (println (format "| Correct integer: %2d | Program integer: %s" correct-int (str int-result))))
-                           ; Record the behavior
-                           (when @global-print-behavioral-diversity
-                             (swap! behavior conj [printed-result int-result]))
-                           ; Error is Levenshtein distance for printed string and
-                           ; integer distance for returned integer
-                           (vector
-                             (levenshtein-distance correct-output printed-result)
-                             (if (number? int-result)
-                               (abs (- int-result correct-int)) ;distance from correct integer
-                               1000) ;penalty for no return value
-                             )))))]
-        (when @global-print-behavioral-diversity
-          (swap! population-behaviors conj @behavior))
-        errors))))
-
 (defn get-replace-space-train-and-test
   "Returns the train and test cases."
   [data-domains]
@@ -131,6 +92,43 @@
 ; Define train and test cases
 (def replace-space-train-and-test-cases
   (get-replace-space-train-and-test replace-space-data-domains))
+
+(defn replace-space-error-function
+  ([program]
+   (replace-space-error-function program :train))
+  ([program data-cases] ;; data-cases should be :train or :test
+   (replace-space-error-function program data-cases false))
+  ([program data-cases print-outputs]
+   (let [behavior (atom '())
+         errors (flatten
+                 (doall
+                  (for [[input [correct-output correct-int]] (case data-cases
+                                                               :train (first replace-space-train-and-test-cases)
+                                                               :test (second replace-space-train-and-test-cases)
+                                                               [])]
+                    (let [final-state (run-push program
+                                                (->> (make-push-state)
+                                                     (push-item input :input)
+                                                     (push-item "" :output)))
+                          printed-result (stack-ref :output 0 final-state)
+                          int-result (stack-ref :integer 0 final-state)]
+                      (when print-outputs
+                        (println (format "\n| Correct output: %s\n| Program output: %s" (pr-str correct-output) (pr-str printed-result)))
+                        (println (format "| Correct integer: %2d | Program integer: %s" correct-int (str int-result))))
+                                        ; Record the behavior
+                      (when @global-print-behavioral-diversity
+                        (swap! behavior conj [printed-result int-result]))
+                                        ; Error is Levenshtein distance for printed string and
+                                        ; integer distance for returned integer
+                      (vector
+                       (levenshtein-distance correct-output printed-result)
+                       (if (number? int-result)
+                         (abs (- int-result correct-int)) ;distance from correct integer
+                         1000)        ;penalty for no return value
+                       )))))]
+     (when @global-print-behavioral-diversity
+       (swap! population-behaviors conj @behavior))
+     errors)))

 (defn replace-space-with-newline-initial-report
   [argmap]
@@ -167,8 +165,7 @@

 ; Define the argmap
 (def argmap
-  {:error-function (make-replace-space-with-newline-error-function-from-cases (first replace-space-train-and-test-cases)
-                                                                              (second replace-space-train-and-test-cases))
+  {:error-function replace-space-error-function
    :atom-generators replace-space-atom-generators
    :max-points 3200
    :max-genome-size-in-initial-program 400


xml/parse seems to drop the xmlns attribute

When updating the meta data in ncc.html. We have to fudge it back in.

--- src/mdr2/dtb/xml.clj
+++ src/mdr2/dtb/xml.clj
@@ -28,6 +28,9 @@
 (defn title-node? [node] (= (:tag node) :title))

 (defn update-title-node [node v] (assoc-in node [:content] (list v)))
+
+(defn insert-xmlns [node]
+  (update-in node [:attrs] assoc :xmlns "http://www.w3.org/1999/xhtml"))

 (defn handle-manifest-node
   "Handle one node in the xml tree. Replace all content in the meta
@@ -61,6 +64,8 @@
     (meta-node? node "ncc:sourceEdition") (update-meta-node node source_edition)
     (meta-node? node "ncc:sourcePublisher") (update-meta-node node source_publisher)
     (meta-node? node "ncc:multimediaType") (update-meta-node node multimedia_type)
+    ;; FIXME: xml/parse seems to drop the xmlns attribute. We have to fudge it back in
+    (= (:tag node) :html) (insert-xmlns node)
     :else node))

 (defn handle-smil-node


add boot.util/dosh-timed (#561)

add boot.util/dosh-timed (#561)

The regular `dosh` will block indefinitely if the called process does.
This can lead to tricky-to-debug behavior.

In many cases where `dosh` is used the commands are short-lived and could
be wrapped in a 1 or 2 second timeout, greatly improving the debugging
experience if commands happen to take longer than they should.

--- boot/pod/src/boot/util.clj
+++ boot/pod/src/boot/util.clj
@@ -410,6 +410,25 @@
         (throw (Exception. (-> "%s: non-zero exit status (%d)"
                                (format (first args) status))))))))

+(defn dosh-timed
+  "Evaluates args as a shell command, blocking on completion up to `timeout-ms`
+   and throwing an exception on non-zero exit status. Output from the shell is
+   streamed to stdout and stderr as it is produced."
+  [timeout-ms & args]
+  (let [args (remove nil? args)]
+    (assert (every? string? args))
+    (let [opts   (into [:redirect-err true] (when *sh-dir* [:dir *sh-dir*]))
+          proc   (apply conch/proc (concat args opts))
+          _      (future (conch/stream-to-out proc :out))
+          status (conch/exit-code proc timeout-ms)]
+      (cond
+        (= status :timeout)
+        (throw (Exception. (-> "%s: timed out after %sms"
+                               (format (first args) timeout-ms))))
+        (not (zero? status))
+        (throw (Exception. (-> "%s: non-zero exit status (%d)"
+                               (format (first args) status))))))))
+
 (defmacro without-exiting
   "Evaluates body in a context where System/exit doesn't work. Returns result
   of evaluating body, or nil if code in body attempted to exit."


Use html form in position-form

Use html form in position-form

--- src/discuss/views/add.cljs
+++ src/discuss/views/add.cljs
@@ -77,30 +77,32 @@
                     [:h5.text-center (t :discussion :add-position-heading) "..."]
                     (valerts/error-alert (om/props this))

-                    [:div.input-group
-                     [:span.input-group-addon.input-group-addon-left "... " (t :common :that)]
-                     [:input.form-control {:onChange #(om/update-state! this assoc :position (.. % -target -value))
-                                           :value (or position "")
-                                           :placeholder (t :discussion :add-position-placeholder)}]]
+                    [:form {:onSubmit #(do (.preventDefault %)
+                                           (com/post-position {:position position
+                                                               :reason reason
+                                                               :reference current-selection
+                                                               :search/selected selected-search}))}
+                     [:div.input-group
+                      [:span.input-group-addon.input-group-addon-left "... " (t :common :that)]
+                      [:input.form-control {:onChange #(om/update-state! this assoc :position (.. % -target -value))
+                                            :value (or position "")
+                                            :placeholder (t :discussion :add-position-placeholder)}]]

-                    [:div.input-group
-                     [:span.input-group-addon.input-group-addon-left "... " (t :common :because)]
-                     [:input.form-control {:style {:backgroundColor (when-not (nil? selected-search) "rgb(250,250,250)")}
-                                           :onChange #(do (om/update-state! this assoc :reason (.. % -target -value))
-                                                          (search/search reason))
-                                           :value (or (:text selected-search) reason "")
-                                           :placeholder (t :discussion :add-reason-placeholder)}]
-                     (when-not (nil? selected-search)
-                       [:span.input-group-addon.pointer {:onClick search/remove-selected-search-result!}
-                        (vlib/fa-icon "fa-times")])]
+                     [:div.input-group
+                      [:span.input-group-addon.input-group-addon-left "... " (t :common :because)]
+                      [:input.form-control {:style {:backgroundColor (when-not (nil? selected-search) "rgb(250,250,250)")}
+                                            :onChange #(do (om/update-state! this assoc :reason (.. % -target -value))
+                                                           (search/search reason))
+                                            :value (or (:text selected-search) reason "")
+                                            :placeholder (t :discussion :add-reason-placeholder)}]
+                      (when-not (nil? selected-search)
+                        [:span.input-group-addon.pointer {:onClick search/remove-selected-search-result!}
+                         (vlib/fa-icon "fa-times")])]

-                    (vlib/show-selection)
-                    [:button.btn.btn-default
-                     {:onClick #(com/post-position {:position position
-                                                    :reason reason
-                                                    :reference current-selection
-                                                    :search/selected selected-search})
-                      :disabled (disabled? selected-search current-selection smaller-input)}
-                     (vlib/remaining-characters smaller-input selected-search)]]])))
+                     (vlib/show-selection)
+                     [:button.btn.btn-default
+                      {:type :submit
+                       :disabled (disabled? selected-search current-selection smaller-input)}
+                      (vlib/remaining-characters smaller-input selected-search)]]]])))
   (componentDidMount [this] (search/remove-all-search-related-results-and-selections)))
 (def position-form (om/factory PositionForm))


fixed make-proxy to accept robot instead of session

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -1,6 +1,6 @@
 (ns naojure.core)

-(def proxy-classes {
+(def proxy-names {
                     :audio-player "ALAudioPlayer"
                     :backlight-detection "ALBacklightingDetection"
                     :battery "ALBattery"
@@ -52,13 +52,13 @@
 ;; (defn make-proxy
 ;;   "Build a proxy from a robot and the symbol representing a proxy"
 ;;   [robot proxy-sym]
-;;   (construct (Class/forName (proxy-classes proxy-sym))
+;;   (construct (Class/forName (proxy-names proxy-sym))
 ;;              (:hostname robot) (:port robot)))

 (defn make-proxy
   "Build a proxy from a session and the symbol for the service"
-  [session proxy-sym]
-  (.service session (proxy-classes proxy-sym)))
+  [robot proxy-sym]
+  (.service (:session robot) (proxy-names proxy-sym)))

 (defn add-proxies
   "Adds the proxies passed as symbols to the robot definition"


use namespacing for measure functions in middleware

--- src/github_bot_app/middleware.clj
+++ src/github_bot_app/middleware.clj
@@ -3,10 +3,7 @@
             [clojure.tools.logging :as log]
             [ring.util.response :refer [response status]]
             [ring.util.request :refer [content-length]]
-            [measure.core :refer [counter increment decrement
-                                  histogram update
-                                  meter mark
-                                  timer time!]])
+            [measure.core :as m])
   (:import com.codahale.metrics.SharedMetricRegistries))

@@ -14,37 +11,37 @@
   "Instrument a ring handler."
   [handler]
   (let [registry (SharedMetricRegistries/getOrCreate "github-bot-app")
-        active-request-counter (counter registry "ring.requests.active")
-        request-meter (meter registry "ring.requests.rate")
-        request-size-hist (histogram registry "ring.requests.size")
-        request-method-timers {:get     (timer registry "ring.handling-time.GET")
-                               :put     (timer registry "ring.handling-time.PUT")
-                               :post    (timer registry "ring.handling-time.POST")
-                               :head    (timer registry "ring.handling-time.HEAD")
-                               :delete  (timer registry "ring.handling-time.DELETE")
-                               :options (timer registry "ring.handling-time.OPTIONS")
-                               :trace   (timer registry "ring.handling-time.TRACE")
-                               :other   (timer registry "ring.handling-time.OTHER")}
-        response-status-meters {1 (meter registry "ring.responses.rate.1xx")
-                                2 (meter registry "ring.responses.rate.2xx")
-                                3 (meter registry "ring.responses.rate.3xx")
-                                4 (meter registry "ring.responses.rate.4xx")
-                                5 (meter registry "ring.responses.rate.5xx")}]
+        active-request-counter (m/counter registry "ring.requests.active")
+        request-meter (m/meter registry "ring.requests.rate")
+        request-size-hist (m/histogram registry "ring.requests.size")
+        request-method-timers {:get     (m/timer registry "ring.handling-time.GET")
+                               :put     (m/timer registry "ring.handling-time.PUT")
+                               :post    (m/timer registry "ring.handling-time.POST")
+                               :head    (m/timer registry "ring.handling-time.HEAD")
+                               :delete  (m/timer registry "ring.handling-time.DELETE")
+                               :options (m/timer registry "ring.handling-time.OPTIONS")
+                               :trace   (m/timer registry "ring.handling-time.TRACE")
+                               :other   (m/timer registry "ring.handling-time.OTHER")}
+        response-status-meters {1 (m/meter registry "ring.responses.rate.1xx")
+                                2 (m/meter registry "ring.responses.rate.2xx")
+                                3 (m/meter registry "ring.responses.rate.3xx")
+                                4 (m/meter registry "ring.responses.rate.4xx")
+                                5 (m/meter registry "ring.responses.rate.5xx")}]
     (fn [request]
-      (increment active-request-counter)
+      (m/increment active-request-counter)
       (try
         (let [request-method (:request-method request)]
-          (mark request-meter)
+          (m/mark request-meter)
           (when-let [n (content-length request)]
-            (update request-size-hist n))
+            (m/update request-size-hist n))
           (let [t (get request-method-timers
                               request-method
                               (:other request-method-timers))
-                resp (time! t #(handler request))
+                resp (m/time! t #(handler request))
                 status-code (:status resp)]
-            (mark (get response-status-meters (quot status-code 100)))
+            (m/mark (get response-status-meters (quot status-code 100)))
             resp))
-        (finally (decrement active-request-counter))))))
+        (finally (m/decrement active-request-counter))))))

 (defn wrap-request-logger


Allow different cases for 'clone' to indicate clonal samples

--- services/sfj-breseq-runs.clj
+++ services/sfj-breseq-runs.clj
@@ -16,7 +16,7 @@
                              (let [[[q1r1 q1r2] q1-refgbk q1-outdir] q1
                                    _ (infof "Fut (%s),  %s start..."
                                             i q1-outdir)
-                                   poly (if (re-find #"clone" q1-outdir)
+                                   poly (if (re-find #"[Cc]lone" q1-outdir)
                                           []
                                           ["-p"])
                                    ret (apply


refactored a bit

refactored a bit

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -229,13 +229,17 @@
   (let [bs (set (get-ids ids focus-ids all-builds))]
     (filter #(bs (:id %)) all-builds)))

+(defn focused-builds [ids]
+  (filter-builds* (map name ids)
+                  (:focus-ids @(:state-atom *autobuild-env*))
+                  (:all-builds *autobuild-env*)))
+
 ;; API

 (defn analyze-build [build]
   ;; put some guards here for expectations
   (when (and (:compiler-env build)
              (:source-paths build))
-
     (env/with-compiler-env (:compiler-env build)
       (let [files (map :source-file
                        (cbuild/files-like [".cljs" ".cljc"]
@@ -246,41 +250,23 @@
         nil))))

 (defn analyze-builds [ids]
-  (let [ids (map name ids)
-        builds (filter-builds* ids
-                               (:focus-ids @(:state-atom *autobuild-env*))
-                               (:all-builds *autobuild-env*))]
-    (doseq [build builds]
-      (analyze-build build))
-    nil))
+  (doseq [build (focused-builds ids)]
+    (analyze-build build)))

 (defn analyze-core-cljs [ids]
-  (let [ids (map name ids)
-        builds (filter-builds* ids
-                               (:focus-ids @(:state-atom *autobuild-env*))
-                               (:all-builds *autobuild-env*))]
-    (doseq [build builds]
-      (env/with-compiler-env (:compiler-env build)
+  (doseq [build (focused-builds ids)]
+    (env/with-compiler-env (:compiler-env build)
         (let [opts (or (:build-options build) (:compiler build))]
-          (cljs.compiler/with-core-cljs opts (fn []))
-          nil)))
-    nil))
+          (cljs.compiler/with-core-cljs opts (fn []))))))

 (defn build-once [ids]
-  (let [ids (map name ids)
-        builds (filter-builds* ids
-                               (:focus-ids @(:state-atom *autobuild-env*))
-                               (:all-builds *autobuild-env*))]
+  (let [builds (->> (focused-builds ids)
+                 (map #(assoc % :reload-clj-files false)))]
     (display-focus-ids (map :id builds))
-    (mapv auto/build-once (mapv #(assoc % :reload-clj-files false)
-                                builds))
-    nil))
+    (doseq [build builds] (auto/build-once build))))

 (defn clean-builds [ids]
-  (let [ids (map name ids)
-        builds (filter-builds* ids
-                               (:focus-ids @(:state-atom *autobuild-env*))
-                               (:all-builds *autobuild-env*))]
+  (let [builds (focused-builds ids)]
     (display-focus-ids (map :id builds))
     (mapv cbuild/clean-build (map :build-options builds))
     (repl-println "Deleting ClojureScript compilation target files.")))


profile post

profile post

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -62,6 +62,7 @@
   (GET "/rest/v1/summary/:user/:year/:month" [user year month] (json-response (get-month-summary-sport user (Integer. year) (Integer. month))))

   (GET "/rest/v1/profile/:user" [user] (json-response (get-profile user)))
+  (POST "/rest/v1/profile" {params :params cookies :cookies} (post-profile (user-from-cookie cookies) params))

   (GET "/rest/v1/avatar/:user" [user] (json-response {:url (get-avatar-url user)}))
   (GET "/rest/v1/search" {params :params} (json-response (search-wrapper params)))


print proper error page for unknown pronouns

--- src/pronouns/web.clj
+++ src/pronouns/web.clj
@@ -51,7 +51,7 @@
        {:status 200
         :headers {"Content-Type" "text/plain"}
         :body (let [pronouns (parse-pronouns-with-lookup (:* params))]
-                (apply render-examples-page pronouns))})
+                (apply render-examples-page (or pronouns [:error])))})

   (ANY "*" []
        (route/not-found (slurp (io/resource "404.html")))))


Wrap all links in description to use `shell.openExternal`

--- src/front/ui/viewport.cljs
+++ src/front/ui/viewport.cljs
@@ -106,12 +106,27 @@
              "empty"
              "")}])

-(defn- inject-md
+(defn- inject-md!
   [project]
-  (set! (.-innerHTML (.get ($ :#description-output)
-                           0))
-        (.toHTML js/markdown
-                (:description project))))
+  (let [output ($ :#description-output)
+        shell  (js/require "shell")]
+    (set! (.-innerHTML (.get output
+                             0))
+          (.toHTML js/markdown
+                   (:description project)))
+    (doall (for [a ($ "#description-output a")]
+             (.on ($ a)
+                  "click"
+                  (fn [e]
+                    (let [url (.attr ($ a)
+                                     "href")
+                          url (if (= -1 (.indexOf url "://"))
+                                (str "http://" url)
+                                url)]
+                      (.openExternal shell
+                                     url)
+                      (.preventDefault e)
+                      (.stopPropagation e))))))))

 (defn- add-autogrow
   [input]
@@ -127,7 +142,7 @@
                        :callback (fn [event]
                                    (when (= (.-value event)
                                             (.-old_value event))
-                                     (inject-md project))
+                                     (inject-md! project))
                                    (description-changed project
                                                         (.-value event)))})))

@@ -135,7 +150,7 @@
   [project]
   (with-meta plain-description-editor
     {:component-did-mount (fn []
-                            (inject-md project)
+                            (inject-md! project)
                             (.attr ($ :#description-output)
                                    "editable-src"
                                    (:description project))


fixed formatting

fixed formatting

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -180,8 +180,7 @@
                                 artist)
                       (dom/span #js {:className "track-uploader"
                                      :title (str "Added by " username)} "Added by " username))]
-                  (dom/div #js {:className "track-view"}
-                    content)))))
+        (dom/div #js {:className "track-view"} content)))))

 (defn track-queue [data owner]
   (reify


Bind! only closes possible old open channel

This means that old data will not disappear until overwritten.

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -114,7 +114,7 @@
   (swap! data dissoc-in path))

 (defn bind! [data path ref binder]
-  (unbind! data path)
+  (close-channel! data path)
   (let [close-chan (chan)
         fbc (fb->chan ref close-chan)]
     (save-channel-closer! data path close-chan)