Fix tests

Fix tests

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -3,6 +3,10 @@
   (:import [com.datastax.driver.core.utils Bytes])
   (:require [clojure.test                          :refer :all]
             [clojurewerkz.cassaforte.new-query-api :refer :all]))
+
+(defn normalize-string
+  [s]
+  (clojure.string/replace s "\t" "  "))

 (deftest test-select-query

@@ -408,13 +412,16 @@
     d int,
     e int,
     PRIMARY KEY((a, b), c, d))"
-         (create-table :foo
-                       (column-definitions {:a :int
-                                            :b :varchar
-                                            :c :int
-                                            :d :int
-                                            :e :int
-                                            :primary-key [[:a :b] :c :d]}))))
+         (normalize-string
+          (create-table :foo
+                        (column-definitions {:a :int
+                                             :b :varchar
+                                             :c :int
+                                             :d :int
+                                             :e :int
+                                             :primary-key [[:a :b] :c :d]}))
+
+          )))

   (is (= "
   CREATE TABLE foo(
@@ -424,13 +431,14 @@
     e int,
     b varchar,
     PRIMARY KEY(a, c, d))"
-         (create-table :foo
-                       (column-definitions {:a :int
-                                            :b :varchar
-                                            :c :int
-                                            :d :int
-                                            :e :int
-                                            :primary-key [:a :c :d]}))))
+         (normalize-string
+          (create-table :foo
+                        (column-definitions {:a :int
+                                             :b :varchar
+                                             :c :int
+                                             :d :int
+                                             :e :int
+                                             :primary-key [:a :c :d]})))))

   (is (= "
@@ -438,25 +446,28 @@
     a int,
     b map<varchar, varchar>,
     PRIMARY KEY(a))"
-         (create-table :foo
-                       (column-definitions {:a :int
-                                            :b (map-type :varchar :varchar)
-                                            :primary-key [:a]}))))
+         (normalize-string
+          (create-table :foo
+                        (column-definitions {:a :int
+                                             :b (map-type :varchar :varchar)
+                                             :primary-key [:a]})))))

   (is (= "
   CREATE TABLE IF NOT EXISTS foo(
     a int,
     b varchar,
     PRIMARY KEY(a))"
-         (create-table :foo
-                       (column-definitions {:a :int
-                                            :b :varchar
-                                            :primary-key [:a]})
-                       (if-not-exists)
-                       )))
+         (normalize-string
+          (create-table :foo
+                        (column-definitions {:a :int
+                                             :b :varchar
+                                             :primary-key [:a]})
+                        (if-not-exists)
+                        ))))

   (is (= "
   ALTER TABLE foo ALTER foo TYPE int"
-         (alter-table :foo
-                      (alter-column :foo :int))))
+         (normalize-string
+          (alter-table :foo
+                       (alter-column :foo :int)))))
   )


Bump boot-reload and boot-http

Bump boot-reload and boot-http

--- resources/leiningen/new/tenzing/build.boot
+++ resources/leiningen/new/tenzing/build.boot
@@ -3,8 +3,8 @@
  :resource-paths  #{"resources"}
  :dependencies '[[adzerk/boot-cljs      "0.0-2814-4" :scope "test"]
                  [adzerk/boot-cljs-repl "0.1.9"      :scope "test"]
-                 [adzerk/boot-reload    "0.2.4"      :scope "test"]
-                 [pandeiro/boot-http    "0.6.1"      :scope "test"]{{{deps}}}])
+                 [adzerk/boot-reload    "0.3.1"      :scope "test"]
+                 [pandeiro/boot-http    "0.6.2"      :scope "test"]{{{deps}}}])

 (require
  '[adzerk.boot-cljs      :refer [cljs]]


Updated test results

Updated test results

--- test/emender_jenkins/config_test.clj
+++ test/emender_jenkins/config_test.clj
@@ -184,7 +184,7 @@
     (let [cfg (load-configuration-from-ini "test/test1.ini")]
         (are [x y] (= x y)
             (-> cfg :info  :version)                   "0.1.0"
-            (-> cfg :jenkins :jenkins-url)             "http://10.34.3.139:8080/"
+            (-> cfg :jenkins :jenkins-url)             "http://10.20.30.40:8080/"
             (-> cfg :jenkins :jenkins-job-prefix-url)  "job/"
             (-> cfg :jenkins :jenkins-job-list-url)    "api/json?tree=jobs[name,url,color,scm[userRemoteConfigs[url]],buildable,lastSuccessfulBuild[description]]"
             (-> cfg :jenkins :jenkins-auth)            "")))


[#89] Exclude variable-name key from required test parameters

--- api/test/clojure/org/akvo/flow_api/datastore/survey_test.clj
+++ api/test/clojure/org/akvo/flow_api/datastore/survey_test.clj
@@ -38,6 +38,7 @@
           question-group (first (:question-groups form))
           question (first (:questions question-group))]
       (are [x required-keys] (= (disj (set (keys x))
+                                      :variable-name
                                       :modified-at
                                       :created-at)
                                 required-keys)


Add a new assertion function

Add a new assertion function

--- test/test_helper.clj
+++ test/test_helper.clj
@@ -253,6 +253,21 @@
        (do-report {:type :fail :message ~msg
                    :expected nil :actual (next-msg)}))))

+(defmethod assert-expr 'receiving [msg form]
+  (let [expected (rest form)]
+    `(let [in#       in
+           expected# (str ~@expected)
+           actual#   (.get (future (->> (http-read in#)
+                                        (take (count expected#))
+                                        (map char)
+                                        (apply str)))
+                           100 TimeUnit/MILLISECONDS)]
+       (if (= expected# actual#)
+         (do-report {:type :pass :message ~msg
+                     :expected expected# :actual actual#})
+         (do-report {:type :fail :message ~msg
+                     :expected expected# :actual actual#})))))
+
 (defmethod assert-expr 'received-response [msg form]
   (let [expected (rest form)]
     `(let [in#       in


Update cursor test

Update cursor test

--- test/testcursor.cljs
+++ test/testcursor.cljs
@@ -205,19 +205,19 @@
                                 :on-dispose #(reset! disposed-cns true))]
       @cns
       (is (= @res 2))
-      (is (= (+ 3 runs) (running)))
+      (is (= (+ 4 runs) (running)))
       (is (= @count-b 1))
       (is (= {:a 0 :b 0} @a-base))
       (reset! a -1)
       (is (= @res 1))
       (is (= @disposed nil))
       (is (= @count-b 2))
-      (is (= (+ 3 runs) (running)) "still running")
+      (is (= (+ 4 runs) (running)) "still running")
       (is (= {:a -1 :b 0} @a-base))
       (reset! a 2)
       (is (= @res 1))
       (is (= @disposed true))
-      (is (= (+ 2 runs) (running)) "less running count")
+      (is (= (+ 3 runs) (running)) "less running count")
       (is (= {:a 2 :b 0} @a-base))

       (reset! disposed nil)


Move superfluous `when-let`

Move superfluous `when-let`

--- src/io/perun/markdown.clj
+++ src/io/perun/markdown.clj
@@ -78,8 +78,7 @@

 (defn parse-file-metadata [file-content]
   (when-let [metadata-str (substr-between file-content *yaml-head* *yaml-head*)]
-    (when-let [parsed-yaml (normal-colls (yaml/parse-string metadata-str))]
-      parsed-yaml)))
+    (normal-colls (yaml/parse-string metadata-str))))

 (defn remove-metadata [content]
   (let [splitted (str/split content *yaml-head* 3)]


Bump vinyasa and alembic versions.

Bump vinyasa and alembic versions.

Add hara, switch iroh to vinyasa.reflection.

--- lein/profiles.clj
+++ lein/profiles.clj
@@ -2,14 +2,10 @@
 ;; Have a :plugins vector.
 ;; Add [lein-outdated "1.0.0"] to it
 {:user {:aliases {"slamhound" ["run" "-m" "slam.hound"]}
-        :dependencies [[alembic "0.2.1"]
+        :dependencies [[alembic "0.3.2"]
                        #_[clj-ns-browser "1.3.1" :exclusions [hiccup]]
-                       [im.chit/iroh "0.1.11"]
-                       ;; TODO: figure out how to exclude plexus-utils
-                       ;; The obvious approach doesn't work
-                       ;; This is up to 0.3.4 now
-                       ;; TODO: Upgrade to that
-                       [im.chit/vinyasa "0.2.2"]  ; :exclusions [org.codehaus.plexus/plexus-utils]
+                       [im.chit/hara "2.1.11"]
+                       [im.chit/vinyasa "0.3.4"]  ; :exclusions [org.codehaus.plexus/plexus-utils]
                        [io.aviso/pretty "0.1.16"]
                        [leiningen #= (leiningen.core.main/leiningen-version)  :exclusions [cheshire
                                                                                com.fasterxml.jackson.core/jackson-core
@@ -37,10 +33,11 @@
                      (inject/in
                       [vinyasa.inject :refer [inject [in inject-in]]]
                       #_[vinyasa.lein :exclude [*project*]]
-                      [vinyasa.pull :all]
+                      #_[vinyasa.pull :all]
+                      [alembic.still [distill pull]]
                       [cemerick.pomegranate add-classpath add-dependencies get-classpath resources]

-                      clojure.core [iroh.core .> .? .* .% .%>]
+                      clojure.core [vinyasa.reflection .& .> .? .* .% .%>]

                       clojure.core >
                       [clojure.pprint pprint]
@@ -51,7 +48,7 @@
         ;;:local-repo "repo"
         :plugins [[com.jakemccrary/lein-test-refresh "0.7.0"]
                   [jonase/eastwood "0.2.1"]
-                  [lein-ancient "0.5.5" :exclusions [cheshire common-codec commons-codec slingshot]]
+                  [lein-ancient "0.5.5" :exclusions [cheshire common-codec commons-codec #_org.clojure/tools.reader slingshot]]
                   ;; This next one's super useful, but its dependencies are out of date
                   ;; TODO: Update!
                   #_[lein-kibit "0.0.8"]


update cider version

update cider version

--- lein/profiles.clj
+++ lein/profiles.clj
@@ -1 +1 @@
-{:user {:plugins [[cider/cider-nrepl "0.8.0"]]}}
+{:user {:plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]]}}


include Micro-Manager version in summary metadata

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@6295 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -396,6 +396,7 @@
       "IJType" (get-IJ-type depth)
       "KeepShutterOpenChannels" (settings :keep-shutter-open-channels)
       "KeepShutterOpenSlices" (settings :keep-shutter-open-slices)
+      "MicroManagerVersion" (.getVersion gui)
       "MetadataVersion" 10
       "PixelAspect" 1.0
       "PixelSize_um" (core getPixelSizeUm)


factor out generate-metadata; cleanup

factor out generate-metadata; cleanup

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7353 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -191,33 +191,38 @@

 ;; image metadata

+(defn generate-metadata [event state]
+  (merge
+    (map-config (core getSystemStateCache))
+    {
+     "AxisPositions" (when-let [axes (get-in event [:position :axes])] (JSONObject. axes))
+     "Binning" (state :binning)
+     "BitDepth" (state :bit-depth)
+     "Channel" (get-in event [:channel :name])
+     "ChannelIndex" (:channel-index event)
+     "Exposure-ms" (:exposure event)
+     "Frame" (:frame-index event)
+     "Height" (state :init-height)
+     "NextFrame" (:next-frame-index event)
+     "PixelSizeUm" (state :pixel-size-um)
+     "PixelType" (state :pixel-type)
+     "PositionIndex" (:position-index event)
+     "PositionName" (if-let [pos (:position event)] (if-args #(.getLabel %) (get-msp pos)))
+     "Slice" (:slice-index event)
+     "SlicePosition" (:slice event)
+     "Source" (state :source)
+     "Time" (get-current-time-str)
+     "UUID" (UUID/randomUUID)
+     "Width"  (state :init-width)
+     "ZPositionUm" (state :last-z-position)
+    }))
+
 (defn annotate-image [img event state]
   {:pix (:pix img)
-   :tags (merge
-      (map-config (core getSystemStateCache))
-      {
-       "AxisPositions" (when-let [axes (get-in event [:position :axes])] (JSONObject. axes))
-       "Binning" (state :binning)
-       "BitDepth" (state :bit-depth)
-       "Channel" (get-in event [:channel :name])
-       "ChannelIndex" (:channel-index event)
-       "Exposure-ms" (:exposure event)
-       "Frame" (:frame-index event)
-       "Height" (state :init-height)
-       "NextFrame" (:next-frame-index event)
-       "PixelSizeUm" (state :pixel-size-um)
-       "PixelType" (state :pixel-type)
-       "PositionIndex" (:position-index event)
-       "PositionName" (if-let [pos (:position event)] (if-args #(.getLabel %) (get-msp pos)))
-       "Slice" (:slice-index event)
-       "SlicePosition" (:slice event)
-       "Source" (state :source)
-       "Time" (get-current-time-str)
-       "UUID" (UUID/randomUUID)
-       "Width"  (state :init-width)
-       "ZPositionUm" (state :last-z-position)
-      }
-       (:tags img))})
+   :tags
+   (merge
+     (generate-metadata event state)
+     (:tags img))}) ;; include any existing metadata

 (defn make-TaggedImage [annotated-img]
   (TaggedImage. (:pix annotated-img) (JSONObject. (:tags annotated-img))))
@@ -319,7 +324,7 @@
       (or (= task :snap) (= task :init-burst))
         (list
           #(log event)
-          (fn [] (doall (map #(.run %) (event :runnables))))
+          #(doall (map (fn [x] (.run x)) (event :runnables)))
           #(when-let [wait-time-ms (event :wait-time-ms)]
             (acq-sleep wait-time-ms))
           #(run-actions (create-presnap-actions event))


Use doseq instead of dorun

Use doseq instead of dorun

doseq is like for, but specifically for performing side effects.

--- src/karmanaut/crawler.clj
+++ src/karmanaut/crawler.clj
@@ -33,4 +33,4 @@
   (mc/upsert db/db "samples" (create-query-document user-map) (create-sample-document user-map) {:upsert true}))

 (defn insert-samples! [user-maps]
-  (dorun (map create-sample! user-maps)))
+  (doseq [u user-maps] (create-sample! u)))


new schema for setting user name

new schema for setting user name

--- src/pc/datomic/schema.clj
+++ src/pc/datomic/schema.clj
@@ -139,6 +139,11 @@
               :db/index true
               :db/doc "User email")

+   (attribute :cust/name
+              :db.type/string
+              :db/index false
+              :db/doc "User-submitted name")
+
    (attribute :cust/verified-email
               :db.type/boolean)


use default port for repl

use default port for repl

--- src/threepape/rs/core.clj
+++ src/threepape/rs/core.clj
@@ -64,5 +64,5 @@
   (start-app args))

 (comment
-  (start-app [12321])
+  (start-app [])
   )


Changing the update handler to only 4 times a day

It's a heavy process, we don't want it grabbing all the cores all the
time, and can live with a slightly outdated incoming/outgoing link
count.

We may actually want to update those when a node is scanned, or linked
to.

--- src/tropefest/handler.clj
+++ src/tropefest/handler.clj
@@ -52,7 +52,7 @@
 (def update-task
   {:id       "update-task"
    :handler  update-handler
-   :schedule "0 0 /2 * * * *"
+   :schedule "0 0 /6 * * * *"
    :opts     {}})

 (def cj (cronj/cronj :entries [crawl-task update-task]))


Make comment match reality

Make comment match reality

--- src/circle/backend/build/inference/rails.clj
+++ src/circle/backend/build/inference/rails.clj
@@ -182,9 +182,6 @@
         :environment {:RAILS_GROUP :test}
         :name "bundle install"))

-
-;;; TODO: only use bundler when there is a Gemfile. If using bundler, do `bundle
-;;; exec $@`, else just do `$@` (aka the command)
 (defn spec
   "Returns the set of actions necessary for this project"
   [repo]


fix user emails mobile view

fix user emails mobile view

--- src/cljs/salava/user/ui/email_addresses.cljs
+++ src/cljs/salava/user/ui/email_addresses.cljs
@@ -106,7 +106,7 @@
          (t :user/Sendverifylink)]])]))

 (defn email-address-table [state]
-  [:table.table
+  [:table.table.hidden-xs
    [:thead
     [:tr
      [:th (t :user/Email)]
@@ -122,6 +122,22 @@
                    (t :user/Loginaddress)
                    (email-options email verified primary_address state))]]))])

+(defn email-address-table-mobile [state]
+  [:table.table.visible-xs
+   [:thead
+    [:tr
+     [:th (t :user/Email) ]
+
+     [:th (t :user/Actions)]]]
+   (into [:tbody]
+         (for [address (sort-by :ctime (:emails @state))
+               :let [{:keys [email verified primary_address]} address]]
+           [:tr
+            [:td [:div email (if verified [:i {:class "fa fa-check" }])]]
+            [:td (if (and primary_address verified)
+                   (t :user/Loginaddress)
+                   (email-options email verified primary_address state))]]))])
+
 (defn content [state]
   (let [new-address-atom (cursor state [:new-address])
         message-atom (cursor state [:message])]
@@ -133,6 +149,7 @@
         [:div {:class (str "alert " (:class @message-atom))}
          (:content @message-atom)])
       (email-address-table state)
+      (email-address-table-mobile state)
       [:form
        [:div.form-group
         [:label {:for "input-new-address"}


verify badge

verify badge

--- src/cljs/salava/badge/ui/verify.cljs
+++ src/cljs/salava/badge/ui/verify.cljs
@@ -1,5 +1,5 @@
 (ns salava.badge.ui.verify
-  (:require [reagent.core :refer [atom]]
+  (:require [reagent.core :refer [atom cursor]]
             [salava.core.i18n :refer [t]]
             [salava.core.ui.ajax-utils :as ajax]
             [salava.core.ui.helper :refer [path-for]]
@@ -10,31 +10,32 @@
             [salava.core.time :refer [date-from-unix-time unix-time unix-time]]
             ))

-(defn init-badge-info [badgeid state]
+(defn init-verify-info [state]
   (ajax/GET
-    (path-for (str "/obpv1/badge/verify/" badgeid))
+    (path-for (str "/obpv1/badge/verify/" (:id @state)))
     {:handler (fn [data]
-                (reset! state (assoc data
-                                :verifying false
-                                :display "none"
-                                :style "success")))}))
+                (swap! state assoc :result data
+                                   :verifying false
+                                   :display "none"))}))

 (defn bottom-links [state]
-  [:div
-   [:div
-    [:a.link {:style {:float "right" :padding-bottom "5px"}
-              :href     "#"
-              :on-click #(do (.preventDefault %)
-                           (if (= (:display @state) "none") (swap! state assoc :display "block") (swap! state assoc :display "none"))
-                           )} (if (= (:display @state) "none") (str (t :badge/Openassertion) "...") (str (t :badge/Hideassertion) "..."))]
-    #_[:a {:style {:float "right"} :href (str "https://badgecheck.io/?url="(:asr @state)) :target "_blank" :rel "nofollow noopener"} "use external validator"]]
-   [:div {:style {:display (:display @state) :padding-top "30px"}}
-    [a/assertion-content (dissoc (:assertion @state) :evidence)]]
-   [:br]])
+  (let [assertion (get-in @state [:result :assertion])]
+    [:div
+     [:div
+      [:a.link {:style {:float "right" :padding-bottom "5px"}
+                :href     "#"
+                :on-click #(do (.preventDefault %)
+                             (if (= (:display @state) "none") (swap! state assoc :display "block") (swap! state assoc :display "none"))
+                             )} (if (= (:display @state) "none") (str (t :badge/Openassertion) "...") (str (t :badge/Hideassertion) "..."))]
+      #_[:a {:style {:float "right"} :href (str "https://badgecheck.io/?url="(:asr @state)) :target "_blank" :rel "nofollow noopener"} "use external validator"]]
+     [:div {:style {:display (:display @state) :padding-top "30px"}}
+      [a/assertion-content (dissoc assertion :evidence)]]
+     [:br]]))

-(defn verify-badge-content [badge-id state]
+(defn verify-badge-content [state]
   (fn []
-    (let [{:keys [assertion-status badge-image-status revoked? expired? assertion badge-issuer-status badge-criteria-status asr revocation_reason message]} @state]
+    (let [data (:result @state)
+          {:keys [assertion-status badge-image-status revoked? expired? assertion badge-issuer-status badge-criteria-status asr revocation_reason message]} data]
       [:div {:id "verify-badge" :style {:display (:show-result @state)}}
        (if (= true (:verifying @state))
          [:div.ajax-message {:style {:padding-top "20px"}}
@@ -42,106 +43,80 @@
           [:span (str (t :core/Loading) "...")]]
          [:div.panel {:style {:padding-top "20px"}}
           [:div.panel-body
+           [:div.close-button
+            [:button {:type       "button"
+                      :class      "close"
+                      :aria-label "OK"
+                      :on-click   #(do
+                                     (.preventDefault %)
+                                     (swap! state assoc :show-result "none"
+                                                        :show-link "block"
+                                                        :display "none"))}
+             [:span {:aria-hidden "true"
+                     :dangerouslySetInnerHTML {:__html "×"}}]]]

-          (case assertion-status
-            404  [:div
-                  [:div {:class "alert alert-danger"} (t :badge/Badgecheckfailed)]
-                  [:p [:i "404 not found"]]]
-            410  [:div
-                  [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))]
+           (case assertion-status
+             404  [:div
+                   [:div {:class "alert alert-danger"} (t :badge/Badgecheckfailed)]
+                   [:p [:i "404 not found"]]]
+             410  [:div
+                   [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))]
+                   #_[:a {:target "_blank" :rel "nofollow noopener" :href (str "https://badgecheck.io/?url="asr) :style {:float "right"}} "use external validator"]]
+             500 [:div
+                  [:div {:class "alert alert-danger"}
+                   (t :badge/Badgecheckfailed)]
+                  [:br]
+                  [:p [:i message]]
                   #_[:a {:target "_blank" :rel "nofollow noopener" :href (str "https://badgecheck.io/?url="asr) :style {:float "right"}} "use external validator"]]
-            500 [:div
-                 [:div {:class "alert alert-danger"}
-                  (t :badge/Badgecheckfailed)]
-                 [:br]
-                 [:p [:i message]]
-                 #_[:a {:target "_blank" :rel "nofollow noopener" :href (str "https://badgecheck.io/?url="asr) :style {:float "right"}} "use external validator"]]
-            [:div
-             (cond
-               revoked? [:div [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))] [:p revocation_reason]]
-               expired? [:div [:div {:class "alert alert-danger"} (t :badge/Badgeisexpired)] [bottom-links state]]
-               :else [:div
-                      [:p.validation-header (t :badge/Badgevaliditycheck)]
+             [:div
+              (cond
+                revoked? [:div [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))] [:p revocation_reason]]
+                expired? [:div [:div {:class "alert alert-danger"} (t :badge/Badgeisexpired)] [bottom-links state]]
+                :else [:div
+                       #_[:p.validation-header (t :badge/Badgevaliditycheck)]
+                       [:h2.uppercase-header.validation-header (t :badge/Badgevaliditycheck)]

-                      [:table
-                       [:tbody
-                        [:tr
-                         [:td.validation-result  (t :badge/Retrievefromassertionurl)]
-                         [:td [:i {:class "fa fa-check-circle fa-lg"}]]]
-                        (if (= 200 badge-image-status)
-                          [:tr
-                           [:td.validation-result  (t :badge/Retrievefromimageurl)]
-                           [:td [:i {:class "fa fa-check-circle fa-lg"}]]])
-                        (if (= 200 badge-criteria-status)
-                          [:tr
-                           [:td.validation-result  (t :badge/Retrievefromcriteriaurl)]
-                           [:td [:i {:class "fa fa-check-circle fa-lg"}]]])
-                        (if (= 200 badge-issuer-status)
-                          [:tr
-                           [:td.validation-result  (t :badge/Retrievefromissuerurl)]
-                           [:td [:i {:class "fa fa-check-circle fa-lg"}]]])]]
+                       [:table
+                        [:tbody
+                         [:tr
+                          [:td.validation-result  (t :badge/Retrievefromassertionurl)]
+                          [:td [:i {:class "fa fa-check-circle fa-lg"}]]]
+                         (if (= 200 badge-image-status)
+                           [:tr
+                            [:td.validation-result  (t :badge/Retrievefromimageurl)]
+                            [:td [:i {:class "fa fa-check-circle fa-lg"}]]])
+                         (if (= 200 badge-criteria-status)
+                           [:tr
+                            [:td.validation-result  (t :badge/Retrievefromcriteriaurl)]
+                            [:td [:i {:class "fa fa-check-circle fa-lg"}]]])
+                         (if (= 200 badge-issuer-status)
+                           [:tr
+                            [:td.validation-result  (t :badge/Retrievefromissuerurl)]
+                            [:td [:i {:class "fa fa-check-circle fa-lg"}]]])]]

-                      [:div  {:class "alert alert-success "} [:i {:class "fa fa-check-circle fa-2x"}] (t :badge/Validbadge)]
-                      [bottom-links state]])])]])])))
+                       [:div  {:class "alert alert-success "} [:i {:class "fa fa-check-circle fa-2x"}] (t :badge/Validbadge)]
+                       [bottom-links state]])])]])])))

-#_(defn verify-badge [badgeid]
-  (let [state (atom {:verifying true})]
-      (init-badge-info badgeid state)
-      (verify-badge-content state)
-      (fn []
-        (let [{:keys [assertion-status badge-image-status revoked? expired? assertion badge-issuer-status badge-criteria-status asr revocation_reason message]} @state]
-          (if (= true (:verifying @state))
-            [:div.ajax-message {:style {:padding-top "20px"}}
-             [:i {:class "fa fa-cog fa-spin fa-2x "}]
-             [:span (str (t :core/Loading) "...")]]
-            [:div {:style {:padding-top "20px"}}
+(defn check-badge-link [state]
+  (fn []
+    [:div
+     [:a {:href "#"
+          :style {:display (:show-link @state)}
+          :on-click #(do
+                       (swap! state assoc :show-result "block"
+                                          :show-link "none")
+                       (when (empty? (:result @state)) (init-verify-info state))
+                       (.preventDefault %))} (str (t :badge/Verifybadge) "...")]]))

-             (case assertion-status
-               404  [:div {:id "verify-badge"}
-                     [:div {:class "alert alert-danger"} (t :badge/Badgecheckfailed)]
-                     [:p "404 not found"]]
-               410  [:div {:id "verify-badge"}
-                     [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))]
-                     #_[:a {:target "_blank" :rel "nofollow noopener" :href (str "https://badgecheck.io/?url="asr) :style {:float "right"}} "use external validator"]]
-               500 [:div {:id "verify-badge"}
-                    [:div {:class "alert alert-danger"}
-                     (t :badge/Badgecheckfailed)]
-                    [:br]
-                    [:p [:i message]]
-                    #_[:a {:target "_blank" :rel "nofollow noopener" :href (str "https://badgecheck.io/?url="asr) :style {:float "right"}} "use external validator"]]
-               [:div
-                (cond
-                  revoked? [:div {:id "verify-badge"} [:div {:class "alert alert-danger"} (str (t :badge/Badge) " " (t :badge/Revoked))] [:p revocation_reason]]
-                  expired? [:div {:id "verify-badge"} [:div {:class "alert alert-danger"} (t :badge/Badgeisexpired)] [bottom-links state]]
-                  :else [:div {:id "verify-badge"}
-                         [:p.validation-header (t :badge/Badgevaliditycheck)]

-                         [:table
-                          [:tr
-                           [:td.validation-result  (t :badge/Retrievefromassertionurl)]
-                           [:td [:i {:class "fa fa-check-circle fa-lg"}]]]
-                          (if (= 200 (or badge-image-status badge-criteria-status badge-issuer-status))
-                            [:tr
-                             [:td.validation-result  (t :badge/Retrievefromimageurl)]
-                             [:td [:i {:class "fa fa-check-circle fa-lg"}]]]
-                            [:tr
-                             [:td.validation-result  (t :badge/Retrievefromcriteriaurl)]
-                             [:td [:i {:class "fa fa-check-circle fa-lg"}]]]
-                            [:tr
-                             [:td.validation-result  (t :badge/Retrievefromissuerurl)]
-                             [:td [:i {:class "fa fa-check-circle fa-lg"}]]])]
-                         [:div  {:class "alert alert-success "} [:i {:class "fa fa-check-circle fa-2x"}] (t :badge/Validbadge)]
-                         [bottom-links state]])])])))))
-
-(defn verify-badge-link [badgeid]
-  (let [state (atom {:verifying true
-                     :show-result "none"})]
+(defn check-badge [badgeid]
+  (let [state (atom {:id badgeid
+                     :verifying true
+                     :show-result "none"
+                     :show-link "block"
+                     :result {}})]
     [:div {:id "verify-link"}
      [:br]
-     [:a {:href "#"
-          :on-click #(do
-                       (.preventDefault %)
-                       (swap! state assoc :show-result "block")
-                       (init-badge-info badgeid state))} (str (t :badge/Verifybadge) "...")]
-     [verify-badge-content badgeid state]]))
+     [check-badge-link state]
+     [verify-badge-content state]]))


Adding plugins to lein profile

Adding plugins to lein profile

--- profiles.clj
+++ profiles.clj
@@ -1,2 +1,6 @@
-{:user {:dependencies [[slamhound "RELEASE"]]
+{:user {:plugins [[jonase/eastwood "0.1.2"]
+                  [lein-ancient "0.5.5"]
+                  [cider/cider-nrepl "0.6.0"]
+                  [lein-midje "3.1.3"]]
+        :dependencies [[slamhound "RELEASE"]]
         :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


flatten the uberkey

flatten the uberkey

--- src/er_cassandra/model/alia/relationship.clj
+++ src/er_cassandra/model/alia/relationship.clj
@@ -53,7 +53,7 @@
    target-record :- t/RecordSchema
    denorm-op :- DenormalizeOp
    opts :- fns/DenormalizeOptsSchema]
-  (let [target-uberkey (-> target-entity :primary-table :key)
+  (let [target-uberkey (-> target-entity :primary-table :key flatten)
         target-uberkey-value (t/extract-uber-key-value
                               target-entity
                               target-record)


Rotation now sets Freese Layout by itself

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

--- src/conexp/contrib/draw/lattices.clj
+++ src/conexp/contrib/draw/lattices.clj
@@ -339,6 +339,8 @@
       (if-not (nil? @rotate-thread)
         (reset! rotate-thread nil)
         (do
+          (update-layout-of-scene scn (layout (get-value)))
+          (fit-scene-to-layout scn)
           (reset! rotate-thread
                   (Thread. #(doseq [angle (drop-while (let [y (get-value)]
                                                         (fn [x] (<= x y)))


Fix queue name

Fix queue name

--- src/edu/berkeley/ai/util/cluster.clj
+++ src/edu/berkeley/ai/util/cluster.clj
@@ -7,7 +7,7 @@
 (def *default-qsub-options*
      ["-r" "n"
       "-M" "jawolfe@berkeley.edu"
-      "-q" "batch"
+      "-q" "zen"
       "-l" "nodes=1:ppn=1:cpu3000"
       "-l" "mem=1200m"
       "-l" "walltime=24:00:00"])
@@ -24,7 +24,6 @@
        (println
 	(apply util/sh
                (util/prln (concat ["qsub"
-                  "-q" "zen"
 		  "-N" name
 		  "-o" (str (util/file-stem f) ".out")
 		  "-e" (str (util/file-stem f) ".err")]


Junior: fixing static resources access

Junior: fixing static resources access

--- src/billbo/core.clj
+++ src/billbo/core.clj
@@ -13,6 +13,7 @@
     (routes
       (ANY "/" [] (io/resource "public/index.html"))
       (ANY "/bills" [] bills-resource)
+      (route/resources "/")
       (route/not-found {:resource "" :body "Not found"}))))

 (def handler


Be a good citizen and wrap io! around store functions.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -85,12 +85,13 @@
   ([file algorithm]
    (let [file (io/file file)
          hash-fn (data/hasher algorithm)]
-     (when (and (.exists file) (pos? (.length file)))
-       (data/create-block
-         (hash-fn (FileInputStream. file))
-         (.length file)
-         (Instant/ofEpochMilli (.lastModified file))
-         (fn reader [] (FileInputStream. file)))))))
+     (io!
+       (when (and (.exists file) (pos? (.length file)))
+         (data/create-block
+           (hash-fn (FileInputStream. file))
+           (.length file)
+           (Instant/ofEpochMilli (.lastModified file))
+           (fn reader [] (FileInputStream. file))))))))

 (defn open
@@ -120,7 +121,7 @@
        (throw (IllegalArgumentException.
                 (format "Range start %d must be less than range end %d"
                         start end))))
-     (data/content-stream block start end))))
+     (io! (data/content-stream block start end)))))

 (defn read!
@@ -129,7 +130,7 @@
   ([source]
    (read! source default-algorithm))
   ([source algorithm]
-   (data/read-block algorithm source)))
+   (io! (data/read-block algorithm source))))

 (defn write!
@@ -147,13 +148,14 @@
   block. If the block is already loaded, it is returned unchanged. The returned
   block will have the same metadata as the one given."
   [block]
-  (if (lazy? block)
-    (with-meta
-      (data/read-block
-        (:algorithm (:id block))
-        (data/content-stream block nil nil))
-      (meta block))
-    block))
+  (io!
+    (if (lazy? block)
+      (with-meta
+        (data/read-block
+          (:algorithm (:id block))
+          (data/content-stream block nil nil))
+        (meta block))
+      block)))

 (defn validate!
@@ -201,9 +203,9 @@
 (defmacro ^:private measure-method
   "Anophoric macro to measure a store method."
   [[method-kw args] & body]
-  `(meter/measure-method*
-     ~'store ~(name method-kw) ~args
-     (fn body# [] ~@body)))
+  `(io! (meter/measure-method*
+          ~'store ~(name method-kw) ~args
+          (fn body# [] ~@body))))

 (defn list
@@ -270,7 +272,7 @@
                           (str "Unknown options passed to list: " (pr-str bad-opts))))))]
     ; TODO: should be metering the stream of blocks somehow, not time-to-stream
     (measure-method [:list opts]
-      (store/select-blocks opts (store/-list store opts)))))
+      (io! (store/select-blocks opts (store/-list store opts))))))

 (defn list-seq
@@ -287,6 +289,10 @@
   [store & opts]
   (let [opts (args->map opts)
         timeout (:timeout opts 10000)]
+    (when-not (pos-int? timeout)
+      (throw (IllegalArgumentException.
+               (str "Option :timeout is not a positive integer: "
+                     (pr-str timeout)))))
     (letfn [(stream->seq
               [s]
               (lazy-seq
@@ -365,10 +371,11 @@
    (store! store source default-algorithm))
   ([store source algorithm]
    (d/chain
-     (d/future
-       (if (instance? File source)
-         (from-file source algorithm)
-         (read! source algorithm)))
+     (io!
+       (d/future
+         (if (instance? File source)
+           (from-file source algorithm)
+           (read! source algorithm))))
      (fn put-block
        [block]
        (when block
@@ -449,12 +456,14 @@
   This is not guaranteed to be atomic; readers may see the store in a partially
   erased state."
   [store]
-  (if (satisfies? store/ErasableStore store)
-    (measure-method [:erase! nil]
-      (store/-erase! store))
-    (s/consume-async
-      (comp (partial delete! store) :id)
-      (list store))))
+  (io!
+    (if (satisfies? store/ErasableStore store)
+      (measure-method [:erase! nil]
+        (store/-erase! store))
+      ; TODO: should be able to parallelize this, actually - how to communicate errors?
+      (s/consume-async
+        (comp (partial delete! store) :id)
+        (list store)))))

 (defn scan
@@ -465,11 +474,11 @@
    (scan store nil))
   ([store p]
    (->
-     (store/-list store nil)
+     (list-seq store)
      (cond->>
-       p (s/filter p))
+       p (filter p))
      (->>
-       (s/reduce sum/update (sum/init))))))
+       (reduce sum/update (sum/init))))))

 (defn sync!
@@ -482,9 +491,10 @@
   [source dest & opts]
   (let [opts (args->map opts)]
     (->
-      (store/missing-blocks
-        (store/-list source nil)
-        (store/-list dest nil))
+      (io!
+        (store/missing-blocks
+          (store/-list source nil)
+          (store/-list dest nil)))
       (cond->>
         (:filter opts) (s/filter (:filter opts)))
       (->>


Move stat functions around in core ns.

Move stat functions around in core ns.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -1,8 +1,11 @@
 (ns blocks.core
-  "Block storage protocol and utility functions.
+  "Block storage protocol and utilities. Functions which may cause IO to occur
+  are marked with bangs; for example `(read! \"foo\")` doesn't have
+  side-effects, but `(read! some-input-stream)` will consume bytes from the
+  stream.

   When blocks are returned from a block store, they may include 'stat' metadata
-  about the blocks:
+  about the blocks, including:

   - `:stored-at`   time block was added to the store
   - `:origin`      resource location for the block
@@ -24,18 +27,19 @@
     multihash.core.Multihash))

-;; ## Block Functions
-
-(defn with-stats
-  "Adds stat information to a block's metadata."
-  [block stats]
-  (vary-meta block assoc :block/stats stats))
-
-
-(defn meta-stats
-  "Returns stat information from a block's metadata, if present."
-  [block]
-  (:block/stats (meta block)))
+;; ## Block IO
+
+(defn from-file
+  "Creates a lazy block from a local file. The file is read once to calculate
+  the identifier."
+  ([file]
+   (from-file file :sha2-256))
+  ([file algorithm]
+   (let [file (io/file file)
+         hash-fn (data/checked-hash algorithm)
+         reader #(io/input-stream file)
+         id (hash-fn (reader))]
+     (data/lazy-block id (.length file) reader))))

 (defn open
@@ -50,19 +54,6 @@
       reader  (reader)
       :else   (throw (IOException.
                         (str "Cannot open empty block " (:id block)))))))
-
-
-(defn from-file
-  "Creates a lazy block from a local file. The file is read once to calculate
-  the identifier."
-  ([file]
-   (from-file file :sha2-256))
-  ([file algorithm]
-   (let [file (io/file file)
-         hash-fn (data/checked-hash algorithm)
-         reader #(io/input-stream file)
-         id (hash-fn (reader))]
-     (data/lazy-block id (.length file) reader))))

 (defn read!
@@ -130,6 +121,12 @@
 (defprotocol BlockStore
   "Protocol for content-addressable storage keyed by multihash identifiers."

+  (stat
+    [store id]
+    "Returns a map with an `:id` and `:size` but no content. The returned map
+    may contain additional data like the date stored. Returns nil if the store
+    does not contain the identified block.")
+
   (-list
     [store opts]
     "Enumerates the ids of the stored blocks with some filtering options. See
@@ -148,18 +145,12 @@

   (delete!
     [store id]
-    "Removes a block from the store. Returns true if the block was stored.")
-
-  (stat
-    [store id]
-    "Returns a map with an `:id` and `:size` but no content. The returned map
-    may contain additional data like the date stored. Returns nil if the store
-    does not contain the identified block."))
+    "Removes a block from the store. Returns true if the block was stored."))

 ; TODO: BlockEnumerator
 ; Protocol which returns a lazy sequence of every block in the store, along with
-; an opaque token which can be used to resume the stream in the same position.
+; an opaque marker which can be used to resume the stream in the same position.
 ; Blocks are explicitly **not** returned in any defined order; it is assumed the
 ; store will enumerate them in the most efficient order available.

@@ -218,7 +209,8 @@

 (defn store!
   "Stores content from a byte source in a block store and returns the block
-  record."
+  record. This function reads the content into memory, so may not be suitable
+  for large sources."
   [store source]
   (when-let [block (read! source)]
     (put! store block)))
@@ -227,23 +219,30 @@

 ;; ## Utility Functions

-(defn select-hashes
-  "Selects multihash identifiers from a sequence based on some criteria.
-
-  Available options:
-
-  - `:algorithm`  only return hashes using this algorithm
-  - `:after`      start enumerating ids lexically following this string
-  - `:limit`      return at most 'limit' hashes
-  "
-  [opts ids]
-  ; TODO: this is an awkward way to search the store, think of a better approach
-  (let [{:keys [algorithm prefix encoder], :or {encoder multihash/hex}} opts
-        after (:after opts prefix)]
-    (cond->> ids
-      algorithm  (filter #(= algorithm (:algorithm %)))
-      after      (drop-while #(pos? (compare after (encoder %))))
-      prefix     (take-while #(.startsWith ^String (encoder %) prefix)))))
+(defn with-stats
+  "Adds stat information to a block's metadata."
+  [block stats]
+  (vary-meta block assoc :block/stats stats))
+
+
+(defn meta-stats
+  "Returns stat information from a block's metadata, if present."
+  [block]
+  (:block/stats (meta block)))
+
+
+(defn select-stats
+  "Selects block stats from a sequence based on the criteria spported in
+  `list`."
+  [opts stats]
+  (let [{:keys [algorithm after limit]} opts]
+    (cond->>
+      algorithm
+        (filter (comp #{algorithm} :algorithm :id))
+      after
+        (drop-while #(pos? (compare after (multihash/hex (:id %)))))
+      limit
+        (take limit))))

 (defn scan-size


Add fetch mechanims for box-add to address #36.

If a specific repo is specified in the box add metadata, it will be
cloned or fetched as needed. If a project is not found among the
current repos, all repos will be fetched to be brought up-to-date and
the project search will be retried.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -176,7 +176,7 @@
   [^String repo]
   (let [repo-dir (->> repo .getBytes ^bytes b64/encode String. (io/file voom-repos))]
     (if (.exists repo-dir)
-      true
+      (:bool (git {:gitdir repo-dir} "fetch"))
       (let [clone-repo (if (and (github-ssh-repo? repo) (https-credentials))
                          (let [https-repo (https-url-for (https-credentials) (github-ssh-path repo))]
                            (println (format "Using %s instead of %s to clone" https-repo repo))
@@ -716,26 +716,34 @@
         (conj deps fdep))
       deps)))

-(defn box-add
-  "Add a lein project to this box"
-  [proj & adeps]
+(defn box-add-helper
+  [retry? proj & adeps]
   (let [deps (fold-args-as-meta (map edn/read-string adeps))
         _ (ensure-deps-repos deps)
         repo-dbs (all-repo-dbs)]
     (doseq [dep deps
             :let [repo-infos (newest-voom-ver-by-spec repo-dbs dep (-> dep meta :voom))]]
-      (println "box adding" (str (-> dep meta :voom)) dep)
       (case (count repo-infos)
-        0 (throw (ex-info "Could not find matching projects" {:dep dep}))
+        0 (if retry?
+            (do
+              (fetch-all)
+              (apply box-add-helper false proj adeps))
+            (throw (ex-info "Could not find matching projects" {:dep dep})))
         1 (let [repo-info (first repo-infos)
                 pname (proj-id->name (:proj repo-info))
                 pdir (adj-path *pwd* pname)]
+            (println "box adding" (str (-> dep meta :voom)) dep)
             (box-repo-add repo-info)
             (when (= dep (first deps))
               (box-cmd "target_dir='" (.getAbsolutePath pdir) "'")))
         (do
           (print "Multiple projects / locations match" (str \" dep \"\:))
           (print-repo-infos repo-infos))))))
+
+(defn box-add
+  "Add a lein project to this box"
+  [proj & adeps]
+  (apply box-add-helper true proj adeps))

 (defn box-init
   "Initilize existing directory as a box and add named lein projects to it"


Update all datasets on file change, during autoload.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -1,11 +1,7 @@
 (ns cavm.core
   (:require [clojure.string :as s])
   (:require [cavm.h2 :refer [create-xenadb]])
-  (:require [digest])
-  (:require [cavm.test-data :as data])
   (:require [clojure.java.io :as io])
-  (:require [clj-time.coerce :refer [from-long]])
-  (:require [clj-time.core :refer [now]])
   (:require [ring.adapter.jetty :refer [run-jetty]])
   (:require [clojure.data.json :as json])
   (:require [me.raynes.fs :as fs])
@@ -51,7 +47,7 @@
 (comment (defn- print-datasets []
    (dorun (map println (datasets)))))

-; XXX should add ring jsonp
+; XXX add ring jsonp?
 (defn- get-app [db loader]
   (-> cavm.views.datasets/routes
       (wrap-trace :header :ui)
@@ -105,10 +101,12 @@
   [cgdata/detect-cgdata
    cgdata/detect-tsv])

-(defn file-changed [loader kind file]
-  (cond
-    (= :created kind) (loader file)
-    (= :modified kind) (loader file))) ; XXX ignoring deletes, for the moment.
+; Full reload metadata. The loader will skip
+; data files with unchanged hashes.
+(defn file-changed [loader docroot kind file]
+  (doseq [f (rest (file-seq (io/file docroot)))] ; skip docroot (the first element)
+    (try (loader f)
+      (catch Exception e (println (str "caught exception: " (.getMessage e))))))) ; XXX this is unhelpful. Log it somewhere.

 (def xenadir-default (str (io/file (System/getProperty  "user.home") "xena")))
 (def docroot-default (str (io/file xenadir-default "files")))
@@ -142,15 +140,24 @@
                   (println "Unable to create directory" docroot))
                 (do
                   (when (:auto opts)
-                    (watch (partial file-changed loader) docroot))
+                    (watch (partial file-changed loader docroot) docroot))
                   (when (:serve opts)
                     (serv (get-app db loader) port)))))))
   (shutdown-agents))
+
+; When logging to the repl from a future, *err* gets lost.
+; This will set it to the repl terminal, for reasons I don't understand.
+(comment (defn snoop [msg x]
+   (.start (Thread. #(binding [*out* *err*]
+                       (println msg x)
+                       (flush))))
+   x))

 ; (def testdb (create-xenadb "test;TRACE_LEVEL_FILE=3"))
 ; (def testdb (create-xenadb "/inside/home/craft/xena/database;TRACE_LEVEL_FILE=3"))
 ; (def testdetector (apply cr/detector "/inside/home/craft/xena/files" detectors))
 ; (def testloader (partial cl/loader testdb testdetector "/inside/home/craft/xena/files"))
+;            (watch (partial file-changed #'testloader docroot-default) docroot-default)
 ; (def app (get-app testdb testloader))
 ; (defonce server (ring.adapter.jetty/run-jetty #'app {:port 7222 :join? false}))
 ; (.start server)


bug fixes, default beat, new chase test fn

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -284,6 +284,7 @@
 (afterglow.show/set-variable! :lightness-max-general-percent 0.5)
 (afterglow.show/set-variable! :lightness-max-front-percent 0.2)
 (afterglow.show/set-variable! :use-hue-chase false)
+(afterglow.show/set-variable! :osc-beat-ratio 4)

 (defn light-sawtooth-phase
   "Change light of fixtures with phase shift. WIP."
@@ -512,7 +513,7 @@
     (cues/cue :color  (fn [_] (afterglow.effects/scene
       "Sawtooth All"
       (let [light-param (params/build-oscillated-param
-        (oscillators/sawtooth :interval :beat :interval-ratio :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-general)]
+        (oscillators/sawtooth :interval :beat :interval-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-general)]
         (global-color-effect (params/build-color-param :h :main-hue :s 100 :l light-param))
       )
     ))))
@@ -526,6 +527,21 @@
       )
     ))))

+  (ct/set-cue! (:cue-grid *show*) 2 1
+    (cues/cue :color  (fn [_] (afterglow.effects/scene
+      "Saw all, change colors 16B"
+      (let [light-param (params/build-oscillated-param
+        (oscillators/sawtooth :interval :beat :interval-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-general)]
+        (fx/chase "Saw all, hue adjust" [(global-color-effect (params/build-color-param :h :main-hue :s 100 :l light-param))
+          (global-color-effect (params/build-color-param :h :main-hue :adjust-hue 60 :s 100 :l light-param))
+          (global-color-effect (params/build-color-param :h :main-hue :adjust-hue 120 :s 100 :l light-param))
+          (global-color-effect (params/build-color-param :h :main-hue :adjust-hue 180 :s 100 :l light-param))
+          (global-color-effect (params/build-color-param :h :main-hue :adjust-hue 240 :s 100 :l light-param))
+          (global-color-effect (params/build-color-param :h :main-hue :adjust-hue 300 :s 100 :l light-param))]
+          (params/build-step-param :interval :phrase :fade-fraction 0.3 :fade-curve :sine)
+          :beyond :loop
+          ))))))
+
   (ct/set-cue! (:cue-grid *show*) 0 0
     (cues/cue :set-main-hue (fn [_] (var-fx/variable-effect @var-binder :main-hue 0))
       :short-name "Red"
@@ -561,11 +577,6 @@
       :short-name "MIDI"
       )
     )
-  (ct/set-cue! (:cue-grid *show*) 7 0
-    (cues/cue :set-main-hue (fn [_] (var-fx/variable-effect @var-binder :use-hue-chase true))
-      :short-name "Change every phrase +30"
-      )
-    )
 )

 (new-cues)


welcome back to the repl, (pst)

welcome back to the repl, (pst)

--- src/cake/server.clj
+++ src/cake/server.clj
@@ -24,6 +24,9 @@
     (defn print-stacktrace [e]
       (stacktrace/print-cause-trace e)
       (flush))))
+
+(defn pst []
+  (print-stacktrace *e))

 (defonce num-connections (atom 0))

@@ -63,7 +66,7 @@
   (let [marker (read)]
     (try (swap! num-connections inc)
          (clojure.main/repl
-          :init   #(ns user)
+          :init   #(ns user (:use [cake.server :only [pst]]))
           :caught #(do (reset-in) (clojure.main/repl-caught %))
           :prompt #(println (str marker (ns-name *ns*))))
          (finally (swap! num-connections dec)))))


search limit to 100

search limit to 100

--- src/ontrail/search.clj
+++ src/ontrail/search.clj
@@ -35,7 +35,7 @@
   `(do (reset! inverted-index {})
        (log "INFO" "built " (reduce + (map insert-exercise-inmem-index (mc/find-maps EXERCISE {}))) "terms")))

-(def search-limit 1000)
+(def search-limit 100)

 (defn search-ids [& terms]
   (take search-limit (reduce clojure.set/intersection (map #(get @inverted-index (.toLowerCase %)) terms))))


remove commented-out code

remove commented-out code

--- src/metabase/api/common/internal.clj
+++ src/metabase/api/common/internal.clj
@@ -149,65 +149,6 @@

 ;;; ## ARG ANNOTATION FUNCTIONALITY

-;;; ### Args Form Deannotation
-
-;; (defn deannotate-arg
-;;   "If FORM is a symbol, strip off any annotations.
-
-;;     (deannotate-arg 'password.required) -> password"
-;;   [form]
-;;   (if-not (symbol? form) form
-;;           (let [[arg & _] (clojure.string/split (name form) #"\.")]
-;;             (symbol arg))))
-
-;; (defn deannotate-args-form
-;;   "Walk ARGS-FORM and strip off any annotations.
-
-;;     (deannotate-args-form [id :as {{:keys [password.required old_password.required]} :body}])
-;;       -> [id :as {{:keys [password old_password]} :body}]"
-;;   [args-form]
-;;   (if (= args-form []) '[:as _]
-;;       (->> args-form
-;;            (mapv (partial clojure.walk/prewalk deannotate-arg)))))
-
-
-;;; ### Args Form Annotation Gathering
-
-;; (defn args-form->symbols
-;;   "Recursively walk ARGS-FORM and return a sequence of symbols.
-
-;;     (args-form->symbols [id :as {{:keys [password.required old_password.required]} :body}])
-;;       -> (id password.required old_password.required)"
-;;   [args-form]
-;;   {:post [(sequential? %)
-;;           (every? symbol? %)]}
-;;   (cond
-;;     (symbol? args-form) [args-form]
-;;     (map? args-form) (->> args-form
-;;                           (mapcat (fn [[k v]]
-;;                                     [(args-form->symbols k) (args-form->symbols v)]))
-;;                           (mapcat args-form->symbols))
-;;     (sequential? args-form) (mapcat args-form->symbols
-;;                                     args-form)
-;;     :else []))
-
-;; (defn symb->arg+annotations
-;;   "Return a sequence of pairs of `[annotation-kw deannotated-arg-symb]` for an annotated ARG.
-
-;;     (symb->arg+annotations 'password)              -> nil
-;;     (symb->arg+annotations 'password.required)     -> [[:required password]]
-;;     (symb->arg+annotations 'password.required.str) -> [[:required password], [:str password]]"
-;;   [arg]
-;;   {:pre [(symbol? arg)]}
-;;   (let [[arg & annotations] (clojure.string/split (name arg) #"\.")]
-;;     (when (seq annotations)
-;;       (->> annotations
-;;            (map (fn [annotation]
-;;                   [(keyword annotation) (symbol arg)]))))))
-
-
-;;; ### let-annotated-args
-
 (defn arg-annotation-let-binding
   "Return a pair like `[arg-symb arg-annotation-form]`, where `arg-annotation-form` is the result of calling the `arg-annotation-fn` implementation
    for ANNOTATION-KW."


slightly nicer indentation

slightly nicer indentation

--- src/metabase/api/dash.clj
+++ src/metabase/api/dash.clj
@@ -39,8 +39,8 @@

 (defendpoint DELETE "/:id" [id]
   (let-404 [{:keys [can_write]} (sel :one Dashboard :id id)]
-    (check-403 @can_write)
-    (del Dashboard :id id)))
+    (check-403 @can_write))
+  (del Dashboard :id id))

 (defendpoint POST "/:id/cards" [id :as {{:keys [cardId]} :body}]
   (let-404 [{:keys [can_write]} (sel :one Dashboard :id id)]


Improved docstrings on main execute sql api.

--- src/cljooq/core.clj
+++ src/cljooq/core.clj
@@ -4,6 +4,8 @@
             [cljooq.proto :as proto]))

 (defn context
+  "Creates new context. It usually created from
+  dbspec or open jdbc connection."
   [source]
   (proto/make-context source))

@@ -44,14 +46,17 @@
     (proto/result-query query' (proto/get-context ctx) opts)))

 (defn get-sql
+  "Get SQL string from previously builded query."
   ([query] (get-sql query :indexed))
   ([query type]
      (proto/get-sql query type)))

 (defn get-bind-values
+  "Get bind values from previously builded query."
   [query]
   (proto/get-bind-values query))

 (defn sqlvec
+  "Get sql with bind values in a `sqlvec` format."
   [query]
   (proto/sqlvec query))


backend socket address changes now have effect

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -320,23 +320,27 @@
   {:pre [(s/valid? ::conf/backend spec)]
    :post [(s/valid? ::backend-state %)]}
   (let [last-seen (or (:last-seen-at spec) 0)
-        be (assoc backend
-                  :last-seen-at last-seen
-                  :socket-address (resolve-socket-address
-                                   (:listen-address spec)))
+        be (assoc backend :last-seen-at last-seen)
+        old-address (:socket-address be)
+        new-address (resolve-socket-address (:listen-address spec))
         unavailable? (log/spy (backend-unavailable? margin (log/spy be)))
         disabled? (or (:disabled spec) unavailable?)]
     (if-let [c (and disabled? (:chan backend))]
       (async/put! c :quit))
     (assoc be
            :unavailable unavailable?
-           :chan (if disabled?
-                   nil
-                   (or (:chan backend)
-                       (backend-chan
-                        (:socket-address be)
-                        listener
-                        #(async/put! exit-chan [[(:name spec) listener] %])))))))
+           :socket-address new-address
+           :chan (cond
+                   disabled? nil
+
+                   (and (:chan backend) (= old-address new-address))
+                   (:chan backend)
+
+                   :else
+                   (backend-chan
+                    new-address
+                    listener
+                    #(async/put! exit-chan [[(:name spec) listener] %]))))))

 (defn update-backends [backends config listener exit-chan]
   (log/spy config)
@@ -446,9 +450,12 @@
                           (log/spy (public-backend-state (log/spy backends))))))
         (let [next-check-interval (log/spy (time-to-next-expire config backends))
               timeout-ch (async/timeout (or next-check-interval (* 1000 1000)))
-              [val ch] (alts! [config-ch shutdown backend-exits timeout-ch])]
-          (cond (= ch config-ch)
-                (let [l (update-listener listener val)]
+              poll-config-ch (async/timeout (* 1000 30))
+              [val ch] (alts! [config-ch shutdown backend-exits
+                               poll-config-ch timeout-ch])]
+          (cond (or (= ch config-ch) (= ch poll-config-ch))
+                (let [val (or val config)
+                      l (update-listener listener val)]
                   (log/debug (pr-str "new config " val))
                   (if (:config val)
                     (recur (update-backends backends val l backend-exits)


At DJ's suggestion, change to "Parameters" title, removing the leading "Named".

--- src/re_demo/utils.cljs
+++ src/re_demo/utils.cljs
@@ -102,7 +102,7 @@
       []
       [v-box
        :children (concat
-                   [[title2 "Named Parameters"]
+                   [[title2 "Parameters"]
                     [gap :size "10px"]]
                    (map (partial arg-row name-width)  args (cycle [true false])))])))


Update core.cljc

Update core.cljc

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -20,7 +20,7 @@

 ;; -- dispatch ----------------------------------------------------------------
 (defn dispatch
-  "Queue `event` for processing by the event handling machinery.
+  "Queue `event` for processing by re-frame's event handling machinery.

    `event` is a vector and the first element is typically a keyword which
    identifies the kind of event.
@@ -39,12 +39,12 @@
   (router/dispatch event))

 (defn dispatch-sync
-  "Synchronously (immediately) process `event`. Does not queue the event
+  "Synchronously (immediately) process `event`. It does not queue the event
    for handling later as `dispatch` does.

    Generally, don't use this and, instead, use `dispatch`. It is an error
    to use `dispatch-sync` within an event handler because you can't immediately
-   process an new event when one is already being processed.
+   process an new event when one is already part way through being processed.

    Useful when any delay in processing will be a problem:

@@ -71,11 +71,13 @@
   'the template' or 'the mechanism' by which nodes in the Signal Graph can be created.

   Repeating: calling `reg-sub` does not create a node. It only creates the template
-  from which nodes can be created later.
+  from which nodes can be created later, when they are bought into existence via use of
+  `subscribe` in a `View Function`.

   `reg-sub` arguments are:
+
   - a `query-id` (typically a namespaced keyword)
-  - a function which returns the inputs required by this kind of node (can be supplied  in one of three ways)
+  - a function which returns the inputs required by this kind of node (which can be supplied in one of three ways)
   - a function which computes the value of this kind of node

   The `computation function` is always the last argument supplied and it is expected to have the signature:
@@ -90,16 +92,16 @@
  values \"flow into\" the `computation function` gets when it is called.

   `reg-sub` can be called in one of three ways, because there are three ways to define the input signals part.
-  But note, the 2nd method, in which a `signal-fn` is explicitly supplied, is the most canonical and instructive. The other
+  But note, the 2nd method, in which a `signals function` is explicitly supplied, is the most canonical and instructive. The other
   two are really just sugary variations.

-  First, No input signals given:
+  First, No input signal fucntion given:

       (reg-sub
         :query-id
         a-computation-fn)   ;; has signature:  (fn [db query-vec]  ... ret-value)

-     In the absence of an explicit `input-fn`, the node's input signal defaults to `app-db`
+     In the absence of an explicit `signals function`, the node's input signal defaults to `app-db`
      and, as a result, the value within `app-db` (a map) is
      is given as the 1st argument when `a-computation-fn` is called.

@@ -113,23 +115,23 @@

   This is the most canonical and instructive of the three variations.

-  When a node is created from the template, the `signal-fn` will be called and it
+  When a node is created from the template, the `signal function` will be called and it
   is expected to return the input signal(s) as either a singleton, if there is only
   one, or a sequence if there are many, or a map with the signals as the values.

-  The values from returned nominated signals will be supplied as the 1st argument to
+  The current values of the returned signals will be supplied as the 1st argument to
   the `a-computation-fn` when it is called - and subject to what this `signal-fn` returns,
   this value will be either a singleton, sequence or map of them (paralleling
-  the structure returned by the `signal-fn`).
-
-  This example `signal-fn` returns a vector of input signals.
+  the structure returned by the `signal function`).
+
+  This example `signal function` returns a 2-vector of input signals.

       (fn [query-vec dynamic-vec]
          [(subscribe [:a-sub])
           (subscribe [:b-sub])])

   The associated computation function must be written
-  to expect a vector of values for its first argument:
+  to expect a 2-vector of values for its first argument:

       (fn [[a b] query-vec]     ;; 1st argument is a seq of two values
         ....)
@@ -137,7 +139,7 @@
   If, on the other hand, the signal function was simpler and returned a singleton, like this:

      (fn [query-vec dynamic-vec]
-       (subscribe [:a-sub]))
+       (subscribe [:a-sub]))      ;; <-- returning a singleton

   then the associated computation function must be written to expect a single value
   as the 1st argument:
@@ -156,7 +158,7 @@

       (reg-sub
         :query-id
-        (fn [_ _]  re-frame/app-db)   ;; <--- explicit input-fn
+        (fn [_ _]  re-frame/app-db)   ;; <--- explicit signal-fn
         a-computation-fn)             ;; has signature:  (fn [db query-vec]  ... ret-value)

   Third, Syntax Sugar
@@ -188,8 +190,8 @@
   (apply subs/reg-sub (into [query-id] args)))

 (defn subscribe
-  "Given a `query` vector, returns a Reagent `reaction` which, over
-  time, reactively delivers a stream of values. So in FRP-ish terms,
+  "Given a `query` vector, returns a Reagent `reaction` which will, over
+  time, reactively deliver a stream of values. So in FRP-ish terms,
   it returns a `Signal`.

   To obtain the returned Signal/Stream's current value, it must be `deref`ed.
@@ -235,11 +237,13 @@
    (subs/subscribe query dynv)))

 (defn clear-sub ;; think unreg-sub
-  "When called with no args, unregisters all subscription handlers. When given
-   one arg, assumed to be a `query-id` of a registered subscription handler,
-   unregisters the associated handler.
-
-   NOTE: Depending on the usecase it may also be necessary to call
+  "When called with no args, unregisters all subscription handlers.
+
+  When given
+  one arg, assumed to be a `query-id` of a registered subscription handler,
+  unregisters the associated handler.
+
+  NOTE: Depending on the usecase it may also be necessary to call
          `clear-subscription-cache!`."
   ([]
    (registrar/clear-handlers subs/kind))
@@ -249,8 +253,8 @@
 (defn clear-subscription-cache!
   "Removes all subscriptions from the cache.

-  This is for development time use. Useful when hot realoding reloading
-  to subscription code or after a React/render exception, because React components won't have been
+  For use at development time or test time. Useful when hot realoding reloading
+  to subscription handler code or after a React/render exception, because React components won't have been
   cleaned up properly. And this, in turn, means the subscriptions within those
   components won't have been cleaned up correctly. So this forces the issue.


removed unnecessary complement call

removed unnecessary complement call

--- src/moomoo/core.cljs
+++ src/moomoo/core.cljs
@@ -56,8 +56,7 @@
         (.pipe stream (.createWriteStream fs absolute-file-path))))))

 (defn -main []
-  (.on io "connection"
-    (complement connection))
+  (.on io "connection" connection)
   (.get app "/" #(.send %2 "MooMoo!"))
   (println (string/join ["Listening on port " port]))
   (.listen server port))


simplifying imports

simplifying imports

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -1,15 +1,14 @@
 (ns ontrail.core
   (:use aleph.http
-        compojure.core)
+        compojure.core
+        ring.middleware.file
+        ring.middleware.cookies
+        [ring.middleware.params :only (wrap-params)]
+        [clojure.data.json :only (read-json json-str)])
   (:use [ontrail summary auth crypto user exercise])
   (:gen-class)
-  (:require [compojure.route :as route]))
-
-(require '[monger.collection :as mc])
-(use 'ring.middleware.file)
-(use 'ring.middleware.cookies)
-(use '[ring.middleware.params :only (wrap-params)])
-(use '[clojure.data.json :only (read-json json-str)])
+  (:require [compojure.route :as route]
+            [monger.collection :as mc]))

 (defn json-response [data & [status]]
   {:status (or status 200)


Remove an errant print.

Remove an errant print.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -464,7 +464,6 @@
   true)

 (s/defn view-model :- SessionView [session-id :- s/Str]
-  (prn "SESSION " (model SessionInRedis session-id))
   (->> (model SessionInRedis session-id)
        keywordize-keys
        (merge {:id session-id})))


Fix spurious <td> element

Fix spurious <td> element

Oops. Remnant from early attempt using tables to render the board.

--- src/sojoban/views.cljs
+++ src/sojoban/views.cljs
@@ -20,7 +20,7 @@
            (for [row (:board data)]
              [:div {:className "row"}
               (for [cell row]
-                [:td [:img {:src (image-url cell)}]])])])))
+                [:span [:img {:src (image-url cell)}]])])])))

 (defn level-info-widget [data owner]
   (om/component


Pass game rather than player to Turn function

--- src/tttclj/render.cljs
+++ src/tttclj/render.cljs
@@ -1,6 +1,7 @@
 (ns tttclj.render
   (:require [quiescent :as q :include-macros true]
             [quiescent.dom :as d]))
+

 (def state {:tiles [:x :o :-
                     :x :- :o
@@ -11,7 +12,7 @@
 (q/defcomponent Turn
   "Renders a component saying whose turn it is"
   [game]
-  (d/p {} (str "It is " player "'s turn:")))
+  (d/p {} (str "It is " (name (:player game)) "'s turn:")))

 (q/defcomponent Cell
   "Renders a cell in the TicTacToe grid"


Updated mappify docstring for :header

Updated mappify docstring for :header

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -66,7 +66,8 @@
   "Comsumes the first item as a header, and returns a seq of the remaining items as a maps with the header
   values as keys. Note that an optional `opts` map can be passed as a first arg, with the following option:

-  * `:keyify` - specify whether header/column names should be turned into keywords (deafults to true)"
+  * `:keyify` - specify whether header/column names should be turned into keywords (deafults to true)
+  * `:header` - specify the header to use for map keys, preventing first row of data from bein gconsumed as header"
   ([rows]
    (mappify {} rows))
   ([{:keys [keyify header] :or {keyify true} :as opts}


kibit cleanup

kibit cleanup

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -12,8 +12,8 @@
   "A filtered tree seq on java.io.Files"
   [pred dir]
   (tree-seq
-    (fn [^File f] (. f (isDirectory)))
-    (fn [^File d] (filter pred (. d (listFiles))))
+    (fn [^File f] (.isDirectory f))
+    (fn [^File d] (filter pred (.listFiles d)))
     dir))

 (defn visible-file-seq [file]


bump thrift version to pull in d2r changes

--- storm-core/project.clj
+++ storm-core/project.clj
@@ -5,7 +5,7 @@
   :dependencies [[org.clojure/clojure "1.4.0"]
                  [commons-io "1.4"]
                  [org.apache.commons/commons-exec "1.1"]
-                 [storm/libthrift7 "0.7.0"
+                 [storm/libthrift7 "0.7.0-1"
                   :exclusions [org.slf4j/slf4j-api]]
                  [clj-time "0.4.1"]
                  [com.netflix.curator/curator-framework "1.0.1"


fix q3

fix q3

--- q3.clj
+++ q3.clj
@@ -8,7 +8,7 @@
              [num side]))
        cards))

-(defn reverse [cards num]
+(defn reverse-recur [cards num]
   (if (= num (count cards))
       (reverse-cards cards num)
       (recur (reverse-cards cards num) (inc num))))
@@ -17,7 +17,7 @@
   (let [cards (make-cards card-num)]
     (map (fn [[num _]] num)
          (filter (fn [[_ side]] (not side))
-                 (reverse cards start-num)))))
+                 (reverse-recur cards start-num)))))

 (def N 100)
 (def START 2)


whitespace

whitespace

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -906,13 +906,12 @@

       "donna"
       (unify agreement-noun
-              common-noun
-              countable-noun
-              feminine-noun
-              {:synsem {:sem {:human true
-                              :pred :donna
-                              :child false}}})
-
+             common-noun
+             countable-noun
+             feminine-noun
+             {:synsem {:sem {:human true
+                             :pred :donna
+                             :child false}}})
       "dopodomani"
       (unify sentential-adverb
               {:synsem {:cat :sent-modifier
@@ -920,7 +919,6 @@
                         :subcat {:1 {:infl :future
                                      :sem {:tense :future}
                                      :subcat '()}}}})
-
       "dormire"
       {:synsem {:cat :verb
                 :essere false


remove "l'" (apostrophe L): should be handled in parsing and generation

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1403,60 +1403,6 @@
                           :buyable true
                           :consumable false
                           :artifact true}}})
-
-   ;; TODO: parser should turn 'l' into 'lo' and 'la'.
-   "l"
-   [{:synsem {:cat :noun
-              :pronoun true
-              :case pronoun-acc
-              :agr {:gender :masc
-                    :person :3rd
-                    :number :sing}
-              :sem {:human true
-                    :pred :lui}
-              :subcat '()}}
-
-    {:synsem {:cat :noun
-              :pronoun true
-              :case pronoun-acc
-              :agr {:gender :masc
-                    :person :3rd
-                    :number :sing}
-              :sem {:human false
-                    :place false
-                    :pred :lui}
-              :subcat '()}
-       :italiano {:initial true
-                  :pronoun true
-                  :cat :noun
-                  :case pronoun-acc}}
-
-    {:synsem {:cat :noun
-              :pronoun true
-              :case pronoun-acc
-              :agr {:gender :fem
-                    :person :3rd
-                    :number :sing}
-              :sem {:human true
-                    :pred :lei}
-              :subcat '()}}
-
-    {:synsem {:cat :noun
-              :pronoun true
-              :case pronoun-acc
-              :agr {:gender :fem
-                    :person :3rd
-                    :number :sing}
-              :sem {:human false
-                    :place false
-                    :pred :lei}
-              :subcat '()}
-     :italiano {:initial true
-                :pronoun true
-                :cat :noun
-                :case pronoun-acc}}
-    ]
-
    "lo"
    [{:synsem {:cat :noun
               :pronoun true


Missing add

Missing add

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -148,6 +148,7 @@
 (defn render-app
   []
   (let [filter (r/cursor app-state [:filter])
+        cards (reaction (filter-by-title @filter (:cards @app-state)))]
     [:div
      (render-filter filter)
      [render-board @cards]]


Setup includes for using re-frame

Setup includes for using re-frame

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -8,4 +8,6 @@
              :refer [comic-list]]
             [comic-reader.pages.viewer
              :refer [comic-viewer]]
-            [reagent.core :as reagent :refer [atom]]))
+            [reagent.core :as reagent :refer [atom]]
+            [reagent.ratom :refer-macros [reaction]]
+            [re-frame.core :as rf]))


Add a component for rendering the site-list

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -30,12 +30,18 @@
    "There's nothing to see here."
    [:a {:href "/#"}]])

+(defn site-list []
+  (let [site-list (rf/subscribe [:site-list])]
+    (fn []
+      (when-let [site-list @site-list]
+        [:ul (vec (map #([:li %]) site-list))]))))
+
 (defn comic-reader []
   (let [page (rf/subscribe [:page])]
     (fn []
       [:div
        (case @page
-         :sites "Display the sites."
+         :sites [site-list]
          :comics "Display the comics available."
          :read "Display the comic itself!"
          nil ""


multimethods for -call

multimethods for -call

--- src/clojure/flambo/function.clj
+++ src/clojure/flambo/function.clj
@@ -65,12 +65,26 @@
 (gen-function PairFunction pair-function)

 ;; Replaces the PairFunction-call and PairFlatMapFunction-call defined by the gen-function macro.
-;; (defn PairFunction-call [this x]
-;;   (let [[a b] (-call this x)]
-;;     (Tuple2. a b)))
+(defmulti PairFunction-call (fn [_ x] (class x)))

-;; (defn PairFlatMapFunction-call [this x]
-;;   (let [ret (-call this x)]
-;;     (for [v ret
-;;           :let [[a b] v]]
-;;       (Tuple2. a b))))
+(defmethod PairFunction-call Tuple2
+  [this x]
+  (-call this x))
+
+(defmethod PairFunction-call :default
+  [this x]
+  (let [[a b] (-call this x)]
+    (Tuple2. a b)))
+
+(defmulti PairFlatMapFunction-call (fn [_ x] (class x)))
+
+(defmethod PairFlatMapFunction-call Tuple2
+  [this x]
+  (-call this x))
+
+(defmethod PairFlatMapFunction-call :default
+  [this x]
+  (let [ret (-call this x)]
+    (for [v ret
+          :let [[a b] v]]
+      (Tuple2. a b))))


riemann.pool/with-pool: fix an issue with destructuring bind.

--- src/riemann/pool.clj
+++ src/riemann/pool.clj
@@ -68,20 +68,20 @@
   ([open opts]
    (fixed-pool open identity opts))
   ([open close opts]
-   (let [opts (merge {:size (* 2 (.availableProcessors (Runtime/getRuntime)))
-                      :regenerate-interval  5
-                      :block-start          true}
-                     opts)]
-   (let [pool (FixedQueuePool.
-                (ArrayBlockingQueue. (opts :size) true)
+   (let [size                 (or (:size opts) (* 2 (.availableProcessors
+                                                      (Runtime/getRuntime))))
+         regenerate-interval  (or (:regenerate-interval opts) 5)
+         block-start          (or (:block-start opts) true)
+         pool (FixedQueuePool.
+                (ArrayBlockingQueue. size true)
                 open
                 close
-                (opts :regenerate-interval))
+                regenerate-interval)
          openers (map (fn open-pool [_] (future (grow pool)))
-                      (range (opts :size)))]
-     (when (:block-start opts)
+                      (range size))]
+     (when block-start
        (doseq [worker openers] @worker))
-     pool))))
+     pool)))

 (defmacro with-pool
   "Evaluates body in a try expression with a symbol 'thingy claimed from the
@@ -93,11 +93,14 @@
   (with-pool [client connection-pool 5]
     (send client a-message))"
   [[thingy pool timeout] & body]
-  `(let [~thingy (claim ~pool ~timeout)]
+  ; Destructuring bind could change nil to a, say, vector, and cause
+  ; unbalanced claim/release.
+  `(let [thingy# (claim ~pool ~timeout)
+         ~thingy thingy#]
      (try
        (let [res# (do ~@body)]
-         (release ~pool ~thingy)
+         (release ~pool thingy#)
          res#)
        (catch Throwable t#
-         (invalidate ~pool ~thingy)
+         (invalidate ~pool thingy#)
          (throw t#)))))


Fixed a typo in comments

Fixed a typo in comments

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -306,7 +306,7 @@
             (.. socket -broadcast (to "lobby") (emit "new-message" (pr-str data)))
             (.join socket "lobby")
             ; socket.io provides no way get a count of players in a room
-            ; so we need to mark players as in the lobby in order to lnow
+            ; so we need to mark players as in the lobby in order to know
             ; who is waiting for the next game
             (swap! players update-in [pid] assoc :in-lobby true)
             (signal-num-players-in-lobby!)))


Checking for app-name before validating

Checking for app-name before validating

--- src/shuppet/core.clj
+++ src/shuppet/core.clj
@@ -67,7 +67,8 @@
   [env & [app-name]]
   (with-ent-bindings env
     (when-let [config (shuppet/load-config env app-name)]
-      (validate config)
+      (when app-name
+        (validate config))
       config)))

 (defn- env-config? [config]
@@ -79,7 +80,8 @@
     (if (env-config? config)
       (shuppet/try-env-config config)
       (when-let [config (shuppet/try-app-config (or env "poke") (or app-name "app-name") config)]
-        (validate config)
+        (when app-name
+          (validate config))
         config))))

 (defn create-config


start on subscribe and unsubscribe.

start on subscribe and unsubscribe.

--- src/takehome/web.clj
+++ src/takehome/web.clj
@@ -33,6 +33,19 @@
   [nickname]
   {:status 200 :body (format "Hello %s!\n" nickname)})

+
+(defn subscribe
+  "Subscribe username to topic"
+  [topic username]
+  {:status 200 :body (format "SUBSCRIBED\n")})
+
+
+(defn unsubscribe
+  "Unsubscribe username from topic"
+  [topic username]
+  {:status 200 :body (format "UNSUBSCRIBED\n")})
+
+
 (defroutes routes

   (GET "/healthcheck"
@@ -43,6 +56,12 @@

   (GET "/hello"
        [nickname] (greet nickname))
+
+  (POST "/:topic/:username"
+       [topic username] (subscribe topic username))
+
+  (DELETE "/:topic/:username"
+       [topic username] (unsubscribe topic username))

   (route/not-found (error-response "Resource not found" 404)))


improve log messages for git

improve log messages for git

--- src/shuppet/git.clj
+++ src/shuppet/git.clj
@@ -202,13 +202,13 @@
       (get-head name branch)
       (catch InvalidRemoteException e
         (rm "-rf" (repo-path name branch))
-        (send-error 404 (str "Missing shuppet configuration for application '" name  "'")))
+        (send-error 404 (str "Missing shuppet configuration for application '" name  "' in branch " branch)))
       (catch NullPointerException e
         (rm "-rf" (repo-path name branch))
-        (send-error (str "Missing branch '" branch "' for application '" name "'.")))
+        (send-error (str "Missing branch '" branch "' for application '" name "'")))
       (catch MissingObjectException e
         (rm "-rf" (repo-path name branch))
-        (send-error (str "Missing object for revision HEAD in repo '" name "': " e))))))
+        (send-error (str "Missing object for revision HEAD in repo '" name "' in branch " branch ":" e))))))

 (defn- remote-branches
   [name]


Fixed arity when starting watcher

Fixed arity when starting watcher

--- src/video_server/main.clj
+++ src/video_server/main.clj
@@ -103,7 +103,7 @@
       errors (exit 1 (str/join \newline errors)))
     (set-log-level (:log-level options))
     (start-processing (:encode options) fmt size)
-    (start-watcher url folder)
+    (start-watcher folder)
     (let [server (start-server url folder (:port options) app)]
       (start-discovery url discovery-port)
       (.join server))))


Friendly error message when starting up in a mode that does not exist

--- src/engulf/core.clj
+++ src/engulf/core.clj
@@ -31,6 +31,11 @@
     (alter-var-root (var settings/all) (fn [s] (merge s opts))))
   (log/info "Initializing in" (:mode settings/all) " mode")

+  (when (not (#{:combined :master :worker} (:mode settings/all)))
+    (binding [*out* *err*]
+      (println "Aborting! Invalid mode option: " (:mode settings/all))
+      (System/exit 1)))
+
   (when (#{:combined :master} (:mode settings/all))
     (log/info "Connecting to DB")
     (database/connect)


disable validation

disable validation

--- src/gangway/web.clj
+++ src/gangway/web.clj
@@ -19,7 +19,8 @@
                                          (auth/validate-token ctx db-conn))
                           :handle-unauthorized "You are not authorized to access this resource."
                           :malformed? (fn  [ctx]
-                                        (let [message (slurp (get-in ctx [:request :body]))]
+                                        false
+                                        #_(let [message (slurp (get-in ctx [:request :body]))]
                                           (not (gw-validation/valid-batch? message))))
                           :handle-malformed (fn [ctx]  (do
                                                          ;; TODO: make these go somewhere better


Fixed Neo4j stuff

Fixed Neo4j stuff

--- src/webapp/neo_stuff.cljs
+++ src/webapp/neo_stuff.cljs
@@ -9,12 +9,10 @@
     [cljs.core.async.macros :refer [go alt!]])

   (:use
-        [webapp.framework.client.coreclient  :only [remote]]
-        [webapp.framework.client.neo4j       :only [neo4j-fn]]
+        [webapp.framework.client.coreclient  :only [remote-fn neo4j-fn sql-fn]]
     )
     (:use-macros
-        [webapp.framework.client.coreclient  :only [ns-coils sql log neo4j]]
-        [webapp.framework.client.neo4j       :only [neo4j]]
+        [webapp.framework.client.coreclient  :only [ns-coils sql log neo4j neo4j-1 sql-1]]
      )
 )
 (ns-coils 'webapp)
@@ -22,22 +20,22 @@

 ; return the raw data for a neo4j node
 (comment go
-    (.log js/console (str (<! (neo4j "START x = node(*) RETURN count(x) LIMIT 1" {} ))))
-)
+    (.log js/console (str  (neo4j "START x = node(*) RETURN count(x) LIMIT 1" {} ))))

-(comment go (log (str (<!
+
+(comment go (log (str
   (neo4j
    "create (u:User { email : { email2 }, title : 'Developer' }) return u"
-   {:email2 "dfsfdsf@gmail.com"} "u")))))
+   {:email2 "dfsfdsf@gmail.com"} "u"))))

-(comment go (log (str (<!
+(comment go (log (str
   (neo4j
    "create (u:User { email : { email2 }, title : 'Developer' }) return u"
-   {:email2 "dffds@gmail.com"} "u")))))
+   {:email2 "dffds@gmail.com"} "u"))))


Use framebuffer dimensions instead of screen dimensions when rendering

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -245,11 +245,19 @@
            (GLFW/glfwMakeContextCurrent window)
            (GLFW/glfwSwapInterval 1)
            (GLFW/glfwShowWindow window)
-           (let [capabilities (GL/createCapabilities)]
-             (GL11/glViewport 0 0 screen-width screen-height)
-             (GLFW/glfwMakeContextCurrent 0)
-             ;; Signal to parent that display has been created
-             [window capabilities])))
+           (let [capabilities (GL/createCapabilities)
+                 width-buffer (BufferUtils/createIntBuffer 1)
+                 height-buffer (BufferUtils/createIntBuffer 1)]
+             (GLFW/glfwGetFramebufferSize window width-buffer height-buffer)
+             (let [frame-buffer-width (.get width-buffer)
+                   frame-buffer-height (.get height-buffer)]
+               (GL11/glViewport 0 0 frame-buffer-width frame-buffer-height)
+               (GLFW/glfwMakeContextCurrent 0)
+               ;; Signal to parent that display has been created
+               [window
+                capabilities
+                frame-buffer-width
+                frame-buffer-height]))))
      (throw (RuntimeException. "Failed to create the GLFW window")))))

 (defn- load-shader
@@ -480,8 +488,8 @@
               (if (= (Platform/get) Platform/WINDOWS)
                 windows-font
                 else-font))
-      (let [{:keys [screen-width
-                    screen-height
+      (let [{:keys [frame-buffer-width
+                    frame-buffer-height
                     character-width
                     character-height
                     font-texture-width
@@ -489,14 +497,14 @@
                     font-texture-image]} (get @font-textures (font-key @normal-font))
             ;; type nil as ByteBuffer to avoid reflection on glTexImage2D
             ^ByteBuffer bbnil nil]
-        (log/info "screen size" screen-width "x" screen-height)
+        (log/info "framebuffer size" frame-buffer-width "x" frame-buffer-height)
         (try
           ;; TODO: fix fullscreen
           #_(when-not @fullscreen
             (Display/setDisplayMode (DisplayMode. screen-width screen-height)))
           ;; resize FBO
           (GL11/glBindTexture GL11/GL_TEXTURE_2D fbo-texture)
-          (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB (int screen-width) (int screen-height) 0 GL11/GL_RGB GL11/GL_UNSIGNED_BYTE bbnil)
+          (GL11/glTexImage2D GL11/GL_TEXTURE_2D 0 GL11/GL_RGB (int frame-buffer-width) (int frame-buffer-height) 0 GL11/GL_RGB GL11/GL_UNSIGNED_BYTE bbnil)
           (swap! font-textures update (font-key @normal-font) (fn [m] (assoc m :font-texture (texture-id-2d font-texture-image))))
           (catch Throwable t
             (log/error "Error changing font" t))))))
@@ -518,8 +526,8 @@
             glyph-image-data glyph-image-data
             fg-image-data fg-image-data
             bg-image-data bg-image-data
-            {:keys [screen-width
-                    screen-height
+            {:keys [frame-buffer-width
+                    frame-buffer-height
                     character-width
                     character-height
                     character->col-row
@@ -615,17 +623,17 @@
             (log/info (vec line))))
         (try
           (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER, fbo-id)
-          (GL11/glViewport 0 0 screen-width screen-height)
-          (except-gl-errors (str "glViewport " screen-width screen-height))
+          (GL11/glViewport 0 0 frame-buffer-width frame-buffer-height)
+          (except-gl-errors (str "glViewport " frame-buffer-width frame-buffer-height))
           (GL11/glClearColor 0.0 0.0 1.0 1.0)
           (except-gl-errors (str "glClearColor  " 0.0 0.0 1.0 1.0))
           (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
           (except-gl-errors (str "glClear  " (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT)))
           (GL20/glUseProgram program-id)
-          (GL20/glUniformMatrix4fv u-PMatrix false (ortho-matrix-buffer screen-width screen-height p-matrix-buffer))
+          (GL20/glUniformMatrix4fv u-PMatrix false (ortho-matrix-buffer frame-buffer-width frame-buffer-height p-matrix-buffer))
           (except-gl-errors (str "u-PMatrix - glUniformMatrix4  " u-PMatrix))
-          (GL20/glUniformMatrix4fv u-MVMatrix false (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0]
-                                                                          [screen-width screen-height 1.0]
+          (GL20/glUniformMatrix4fv u-MVMatrix false (position-matrix-buffer [(- (/ frame-buffer-width 2)) (- (/ frame-buffer-height 2)) -1.0 0.0]
+                                                                          [frame-buffer-width frame-buffer-height 1.0]
                                                                           mv-matrix-buffer))
           (except-gl-errors (str "u-MVMatrix - glUniformMatrix4  " u-MVMatrix))
           ; Bind VAO
@@ -688,14 +696,14 @@

           ;; Draw fbo to screen
           (GL30/glBindFramebuffer GL30/GL_FRAMEBUFFER 0)
-          (GL11/glViewport 0 0 screen-width screen-height)
+          (GL11/glViewport 0 0 frame-buffer-width frame-buffer-height)
           (GL11/glClearColor 0.0 1.0 0.0 1.0)
           (GL11/glClear (bit-or GL11/GL_COLOR_BUFFER_BIT GL11/GL_DEPTH_BUFFER_BIT))
           (GL20/glUseProgram fb-program-id)
-          (GL20/glUniformMatrix4fv u-fb-PMatrix false (ortho-matrix-buffer screen-width screen-height p-matrix-buffer))
+          (GL20/glUniformMatrix4fv u-fb-PMatrix false (ortho-matrix-buffer frame-buffer-width frame-buffer-height p-matrix-buffer))
           (except-gl-errors (str "u-fb-PMatrix - glUniformMatrix4  " u-fb-PMatrix))
-          (GL20/glUniformMatrix4fv u-fb-MVMatrix false (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0]
-                                                                          [screen-width screen-height 1.0]
+          (GL20/glUniformMatrix4fv u-fb-MVMatrix false (position-matrix-buffer [(- (/ frame-buffer-width 2)) (- (/ frame-buffer-height 2)) -1.0 0.0]
+                                                                          [frame-buffer-width frame-buffer-height 1.0]
                                                                           mv-matrix-buffer))
           (except-gl-errors (str "u-fb-MVMatrix - glUniformMatrix4  " u-fb-MVMatrix))
           (GL20/glEnableVertexAttribArray 0);pos-vertex-attribute)
@@ -733,7 +741,7 @@
   (fullscreen! [_ v]
     (with-gl-context gl-lock window capabilities
       (if (false? v)
-        (let [{:keys [screen-width screen-height]} (get @font-textures (font-key @normal-font))]
+        (let [{:keys [frame-buffer-width frame-buffer-height]} (get @font-textures (font-key @normal-font))]
           (reset! fullscreen false)
           #_(Display/setDisplayMode (DisplayMode. screen-width screen-height)))
         (let [[width height mode] v]
@@ -836,8 +844,8 @@
                                  (log/info "Created font texture " font-parameters " screen-width" screen-width "screen-height" screen-height)
                                  (swap! font-textures assoc
                                                      (font-key new-font)
-                                                     {:screen-width screen-width
-                                                      :screen-height screen-height
+                                                     {:frame-buffer-width screen-width
+                                                      :frame-buffer-height screen-height
                                                       :character-width character-width
                                                       :character-height character-height
                                                       :character->col-row character->col-row
@@ -855,16 +863,21 @@
           destroyed          (atom false)
           gl-lock            (atom true)
           latch              (java.util.concurrent.CountDownLatch. 1)
-          {:keys [screen-width
-                  screen-height
+          {:keys [frame-buffer-width
+                  frame-buffer-height
                   character-width
                   character-height
                   font-texture-width
                   font-texture-height
                   font-texture-image]} (get @font-textures (font-key @normal-font))
-          _                  (log/info "screen size" screen-width "x" screen-height)
-          [window capabilities] (init-display title screen-width screen-height icon-paths gl-lock destroyed)
-          _                  (log/info "window" window "capabilities" capabilities)
+          _                  (log/info "screen size" (* columns character-width) "x" (* rows character-height))
+          _                  (log/info "framebuffer size" frame-buffer-width "x" frame-buffer-height)
+          [window
+           capabilities
+           frame-buffer-width
+           frame-buffer-height]
+                             (init-display title (* columns character-width) (* rows character-height) icon-paths gl-lock destroyed)
+          _                  (log/info "window" window "capabilities" capabilities "fb" frame-buffer-width "x" frame-buffer-height)

           font-texture       (with-gl-context gl-lock window capabilities (texture-id-2d font-texture-image))
           _                  (swap! font-textures update (font-key @normal-font) (fn [m] (assoc m :font-texture font-texture)))
@@ -902,7 +915,7 @@
           ;fg-texture       (texture-id next-pow-2-columns next-pow-2-rows (count layer-order) fg-image-data)
           bg-texture       (with-gl-context gl-lock window capabilities (texture-id next-pow-2-columns next-pow-2-rows (count layer-order) bg-image-data))
           [fbo-id fbo-texture]
-                           (with-gl-context gl-lock window capabilities (fbo-texture screen-width screen-height))
+                           (with-gl-context gl-lock window capabilities (fbo-texture frame-buffer-width frame-buffer-height))
           ; init shaders
           [^int pgm-id
            ^int fb-pgm-id]      (with-gl-context gl-lock window capabilities (init-shaders (get fx-shader :name)))
@@ -1017,9 +1030,9 @@
                            layer-order
                            cursor-xy
                            fx-uniforms
-                           {:p-matrix-buffer (ortho-matrix-buffer screen-width screen-height)
-                            :mv-matrix-buffer (position-matrix-buffer [(- (/ screen-width 2)) (- (/ screen-height 2)) -1.0 0.0]
-                                                                      [screen-width screen-height 1.0])
+                           {:p-matrix-buffer (ortho-matrix-buffer frame-buffer-width frame-buffer-height)
+                            :mv-matrix-buffer (position-matrix-buffer [(- (/ frame-buffer-width 2)) (- (/ frame-buffer-height 2)) -1.0 0.0]
+                                                                      [frame-buffer-width frame-buffer-height 1.0])
                             :buffers {:vertices-vbo-id vertices-vbo-id
                                       :vertices-count vertices-count
                                       :texture-coords-vbo-id texture-coords-vbo-id


Job data fetcher should use pretty printing only in devel mode

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -163,12 +163,19 @@
           preview-jobs-suffix (-> configuration :jobs :preview-test-jobs-suffix)
           stage-jobs-suffix   (-> configuration :jobs :stage-test-jobs-suffix)
           prod-jobs-suffix    (-> configuration :jobs :prod-test-jobs-suffix)
+          verbose             (-> configuration :config :verbose)
+          pretty-print        (-> configuration :config :pretty-print)
           job-list (read-list-of-test-jobs (-> configuration :jenkins :jenkins-url)
                                            (-> configuration :jenkins :jenkins-job-list-url)
                                            test-jobs-prefix
                                            preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
           job-results (read-update-job-info (-> configuration :jenkins :jenkins-url) job-list   preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)]
-          (clojure.pprint/pprint job-results)
+          (log/info "Job read:" (count job-results))
+
+          ; print pretty printed tree of all jobs to the standard output
+          (if (and verbose pretty-print)
+              (clojure.pprint/pprint job-results))
+
           ;(spit "test.edn" (with-out-str (clojure.pprint/pprint job-results)))
           ;job-results (read-all-test-results configuration job-list)]
           (reset! results job-results)


clojure.set/unions requires at least 1 set to work.

--- src/onyx/scheduling/common_job_scheduler.clj
+++ src/onyx/scheduling/common_job_scheduler.clj
@@ -134,14 +134,16 @@
 (defn find-displaced-peers [replica current-allocations max-util]
   (clojure.set/union
    (find-unused-peers replica)
-   (remove
-    nil?
-    (mapcat
-     (fn [job]
-       (let [overflow (- (get current-allocations job) (get max-util job))]
-         (when (pos? overflow)
-           (cts/drop-peers replica job overflow))))
-     (:jobs replica)))))
+   (into
+    #{}
+    (remove
+     nil?
+     (mapcat
+      (fn [job]
+        (let [overflow (- (get current-allocations job) (get max-util job))]
+          (when (pos? overflow)
+            (cts/drop-peers replica job overflow))))
+      (:jobs replica))))))

 (defn exempt-from-acker? [replica job task]
   (or (some #{task} (get-in replica [:exempt-tasks job]))


[DC] Removed joda-time exclusion from kraken project template

--- resources/leiningen/new/kraken/project.clj
+++ resources/leiningen/new/kraken/project.clj
@@ -8,7 +8,7 @@
                  [turbovote.resource-config "0.1.4"]
                  [com.novemberain/langohr "3.2.0"]
                  [democracyworks/datomic-toolbox "1.0.0" :exclusions [com.datomic/datomic-pro]]
-                 [com.datomic/datomic-pro "0.9.5153" :exclusions [joda-time]]
+                 [com.datomic/datomic-pro "0.9.5153"]
                  [org.immutant/core "2.0.0"]
                  [democracyworks/kehaar "0.3.0"]]
   :plugins [[lein-immutant "2.0.0"]]


[EN] Merge problem.

[EN] Merge problem.

--- resources/leiningen/new/kraken/project.clj
+++ resources/leiningen/new/kraken/project.clj
@@ -8,7 +8,7 @@
                  [turbovote.resource-config "0.1.4"]
                  [com.novemberain/langohr "3.2.0"]
                  [democracyworks/datomic-toolbox "1.0.0" :exclusions [com.datomic/datomic-pro]]
-                 [prismatic/schema "0.4.3"]]
+                 [prismatic/schema "0.4.3"]
                  [com.datomic/datomic-pro "0.9.5153"]
                  [org.immutant/core "2.0.1"]
                  [democracyworks/kehaar "0.3.0"]]