some reviews on records

some reviews on records

--- src/language/protocol.clj
+++ src/language/protocol.clj
@@ -1,6 +1,6 @@
 (ns language.protocol)

-
+;extend protocols to existing types
 (defprotocol Matrix
   "Protocol for working with 2d data structures"
   (lookup [matrix i j])
@@ -22,7 +22,6 @@
         (apply map vector vov))
   (dims [vov]
         [(count vov) (count (first vov))])
-
   nil
   (lookup [x i j])
   (update [x i j val])
@@ -30,15 +29,11 @@
   (cols [x] [])
   (dims [x] [0 0])

-  (Class/forName "[[D")
+  #_((Class/forName "[[D")
   (lookup [arr i j]
           (aget arr i j))
   (update [arr i j val]
-          (let [clone (aclone arr)]
-            (aset clone i
-                  (doto (aclone (aget clone i))
-                    (aset j val)))
-            clone))
+          (aset arr i j val))
   (rows [arr]
         (map vec arr))
   (cols [arr]
@@ -48,6 +43,8 @@
           (if (zero? rs)
             [0 0]
             [rs (count (aget arr 0))]))))
+
+)

 (defn vov [h v]
@@ -63,6 +60,17 @@
 ;(cols (update vov-a 2 4 3))

+;define types
+
+(defrecord NamedPoint [^String name ^long x ^long y])
+
+(NamedPoint/getBasis)
+
+(map meta (NamedPoint/getBasis))
+
+(->NamedPoint "haha" 3 4)
+
+(map->NamedPoint {:name "haha" :x 2 :y 4})

@@ -73,5 +81,15 @@
 (vec "123")
 (apply map vector [[1 2 3] [4 5 6] [7 8]])

+;add a pre to your function
+
+(defn try-pre
+  [x]
+  {:pre [(pos? x)]}
+  (+ x 2))
+
+;(try-pre -2)
+(try-pre 2)

+


move filtering function

move filtering function

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -44,13 +44,14 @@
 ;; TODO: lightning-bolts should use this.
 (defn get-lexemes [model spec]
   (if (= false (get-in spec [:phrasal] false))
-    (if-let [index-fn (:index-fn model)]
-      (lazy-seq (index-fn spec))
-      (do
-        (log/warn (str "get-lexemes: no index found: using entire lexicon."))
-        (flatten (vals
-                  (or (:lexicon (:generate model)) (:lexicon model))))))
-    []))
+    (filter not-fail?
+            (map #(unify % spec)
+                 (if-let [index-fn (:index-fn model)]
+                   (lazy-seq (index-fn spec))
+                   (do
+                     (log/warn (str "get-lexemes: no index found: using entire lexicon."))
+                     (flatten (vals
+                               (or (:lexicon (:generate model)) (:lexicon model))))))))))

 (declare comp-path-to-complements)
 (declare create-mapping)
@@ -133,9 +134,7 @@
   [bolt path model depth max-depth]
   (log/debug (str "comp-path-to-complements:" depth "/" max-depth ":" ((:morph-ps model) bolt) "@" path))
   (let [spec (get-in bolt path)
-        lexemes (shufflefn (filter not-fail? (map #(unify %
-                                                          (get-in bolt path))
-                                                  (get-lexemes model spec))))
+        lexemes (shufflefn (get-lexemes model spec))
         bolts-at (if (< depth max-depth)
                    (nugents
                     model


Fix loading issues.

Fix loading issues.

Apparently it is a terrible, horrible idea to kick off a thread that
tries to do things while namespaces are still in the process of loading
and compiling. You get tons of random "No such var: ..." exceptions from
unpredictable places.

--- src/afterglow/controllers.clj
+++ src/afterglow/controllers.clj
@@ -22,21 +22,34 @@
   200)

 (defonce ^{:private true
-           :doc "Loads all the built-in controller implementations, so
-           they can register their recognizers. Performed in a future,
-           after the namespace itself loads, to avoid circular
-           dependency issues. Functions like [[bind-to-show]]
-           and [[auto-bind]] which rely on controller implementations
-           being registered should `deref` this future to ensure it
-           has finished."}
-  controller-binding-loader
-  (future
-    (Thread/sleep 100)
-    (require 'afterglow.controllers.ableton-push)
-    (require 'afterglow.controllers.ableton-push-2)
-    (require 'afterglow.controllers.launchpad-pro)
-    (require 'afterglow.controllers.launchpad-mini)
-    (require 'afterglow.controllers.launchpad-mk2)))
+           :doc "Lists all the built-in controller implementations
+           that need to be loaded, so they can register their
+           recognizers. This needs to happen after the namespace
+           itself loads, to avoid circular dependency issues. Once
+           that is done, this atom will be set to `nil`. Functions
+           like [[bind-to-show]] and [[auto-bind]] which rely on
+           controller implementations being registered must call
+           [[load-built-in-controllers]] to ensure this has
+           happened."}
+  built-in-controllers
+  (atom '[afterglow.controllers.ableton-push afterglow.controllers.ableton-push-2
+          afterglow.controllers.launchpad-pro afterglow.controllers.launchpad-mk2
+          afterglow.controllers.launchpad-mini]))
+
+(defn- load-built-in-controllers
+  "Makes sure that the namespaces defining the grid controllers that
+  Afterglow supports natively have been loaded. Because of circular
+  dependency issues, this has to wait until after the namespace itself
+  has been loaded. Functions like [[bind-to-show]] and [[auto-bind]]
+  which rely on controller implementations need to call this function
+  to ensure loading has occurred. After the first call, the list of
+  namespaces will be replaced by `nil`, so it will no longer do
+  anything."
+  []
+  (swap! built-in-controllers
+         (fn [namespaces]
+           (doseq [n namespaces]
+             (require n)))))

 (defonce
   ^{:private true
@@ -660,7 +673,7 @@
   function."
   [show device-filter & args]
   {:pre [(some? show) (some? device-filter)]}
-  @controller-binding-loader  ; Make sure controller implementations are finished registering
+  (load-built-in-controllers)  ; Make sure controller implementations are registered
   (let [port-in  (first (amidi/filter-devices device-filter (amidi/open-inputs-if-needed!)))
         port-out (first (amidi/filter-devices device-filter (amidi/open-outputs-if-needed!)))
         identity (when (every? some? [port-in port-out]) (identify port-in port-out))]
@@ -790,7 +803,7 @@
   detected."
   [show device-filter & args]
   {:pre [(have? some? show) (have? some? device-filter)]}
-  @controller-binding-loader  ; Make sure controller implementations are finished registering
+  (load-built-in-controllers)  ; Make sure controller implementations are registered
   (let [idle (atom true)
         controller (atom nil)]
     (letfn [(disconnection-handler []


add root route

add root route

--- src/annual_weather/routes.clj
+++ src/annual_weather/routes.clj
@@ -20,7 +20,8 @@
 (defroutes site-routes
   (GET "/site/search" [] (search-page))
   (GET "/site/chart" [] (chart-page))
-  (route/resources "/res" :root "public"))
+  (route/resources "/res" :root "public")
+  (route/resources "/" :root "public") )

 (defroutes api-routes
   (-> (POST "/api/data" {params :params} []


Fix redis connection

Fix redis connection

--- src/antlion_clojure/redis.clj
+++ src/antlion_clojure/redis.clj
@@ -4,7 +4,7 @@

 (defmacro wcar*
   [& body]
-  `(car/wcar {:uri (env :redis-url)}
+  `(car/wcar {:pool {} :spec {:uri (env :redis-url)}}
              ~@body))

 (def key-leaving-allowed?


Add blake2 hash function.

Add blake2 hash function.

--- src/buddy/core/hash.clj
+++ src/buddy/core/hash.clj
@@ -26,6 +26,7 @@
            org.bouncycastle.crypto.digests.SHA256Digest
            org.bouncycastle.crypto.digests.SHA384Digest
            org.bouncycastle.crypto.digests.SHA512Digest
+           org.bouncycastle.crypto.digests.Blake2bDigest
            clojure.lang.IFn
            clojure.lang.Keyword))

@@ -152,6 +153,32 @@
   (let [engine (resolve-digest alg-or-engine)]
     (-digest input engine)))

+(defn blake2b
+  "BLAKE2 is a cryptographic hash function faster than MD5,
+  SHA-1, SHA-2, and SHA-3, yet is at least as secure as the
+  latest standard SHA-3."
+  [input length]
+  (let [engine (Blake2b. nil length nil nil)]
+    (-digest input engine)))
+
+(defn blake2b-128
+  "BLAKE2 cryptographic hash function with fixed output
+  digest size to 128 bits."
+  [input]
+  (blake2b input 128))
+
+(defn blake2b-256
+  "BLAKE2 cryptographic hash function with fixed output
+  digest size to 256 bits."
+  [input]
+  (blake2b input 256))
+
+(defn blake2b-512
+  "BLAKE2 cryptographic hash function with fixed output
+  digest size to 512 bits."
+  [input]
+  (blake2b input 512))
+
 (defn sha256
   [input]
   (digest input :sha256))


semantics of how "name" takes possessive article as its argument

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -959,11 +959,16 @@
                    :pred :I}
              :subcat '()}}
    "name"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          {:synsem {:sem {:pred :name
-                          :animate false}}})
+   (let [of (ref :top)]
+     (unify agreement-noun
+            common-noun
+            countable-noun
+            {:synsem {:sem {:animate false
+                            :pred :name
+                            :subj of}
+                      :subcat {:1 {:cat :det
+                                   :def :possessive
+                                   :sem of}}}}))

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


Fix job status handling for accumulated stages

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -115,8 +115,10 @@

 (defn build-for-job [job-instance]
   (if-let [jobs-for-accumulation (:jobs-for-accumulation job-instance)]
-    (let [builds (map build-for jobs-for-accumulation)]
-      (accumulate-builds builds))
+    (->> jobs-for-accumulation
+         (map #(merge job-instance %))
+         (map build-for)
+         accumulate-builds)
     (build-for job-instance)))

 (defn job-data-for-instance [jobInstance]


Allegedly disable IgnoreError

Allegedly disable IgnoreError

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -225,7 +225,7 @@
 (def ^Sodium sodium
   "The sodium library singleton instance."
   (-> (LibraryLoader/create Sodium)
-      (.option LibraryOption/IgnoreError Boolean/TRUE)
+;;      (.option LibraryOption/IgnoreError Boolean/TRUE)
       (.load "sodium")))

 (assert (#{0 1} (.sodium_init sodium)))


segregate uri-matching calls by partial and dynamic URIs

--- src/calfpath/route.cljc
+++ src/calfpath/route.cljc
@@ -331,69 +331,94 @@
                                 (string? uri-str-token))]
             (-> spec
               (assoc :matcher (if uri-string?
+                                ;; static string
                                 (if partial?
-                                  (fn uri-matcher-token-partial [request]
+                                  (fn static-uri-matcher-partial [request]
                                     (let [end-index (int (i/get-uri-match-end-index request))
                                           new-index (i/partial-match-uri-string (:uri request)
                                                       end-index
                                                       uri-str-token)]
                                       (when (>= new-index i/FULL-MATCH-INDEX)
                                         (i/assoc-uri-match-end-index request new-index))))
-                                  (fn uri-matcher-token-full [request]
+                                  (fn static-uri-matcher-full [request]
                                     (let [end-index (int (i/get-uri-match-end-index request))
                                           new-index (i/full-match-uri-string (:uri request)
                                                       end-index
                                                       uri-str-token)]
                                       (when (= new-index i/FULL-MATCH-INDEX)
-                                        (i/assoc-uri-match-end-index request new-index)))))
-                                (fn uri-matcher [request]
-                                  (let [begin-index (int (i/get-uri-match-end-index request))
-                                        params-map (if (zero? begin-index)
-                                                     nil
-                                                     (get request params-key))]
-                                    (when-some [^"[Ljava.lang.Object;"
-                                                match-result (i/match-uri (:uri request)
-                                                               begin-index
-                                                               uri-template partial? params-map)]
-                                      (let [params    (aget match-result 0)
-                                            end-index (aget match-result 1)]
-                                        (if (empty? params)
-                                          (i/assoc-uri-match-end-index request end-index)
+                                        request))))
+                                ;; dynamic string, with path params
+                                (if partial?
+                                  (fn dynamic-uri-matcher-partial [request]
+                                    (let [begin-index (int (i/get-uri-match-end-index request))
+                                          params-map (if (zero? begin-index)
+                                                       nil
+                                                       (get request params-key))]
+                                      (when-some [^"[Ljava.lang.Object;"
+                                                  match-result (i/match-uri (:uri request)
+                                                                 begin-index
+                                                                 uri-template partial? params-map)]
+                                        (let [params    (aget match-result 0)
+                                              end-index (aget match-result 1)]
                                           (-> request
                                             (i/assoc-uri-match-end-index end-index)
-                                            (i/assoc-path-params params-key params)))))))))
+                                            (i/assoc-path-params params-key params))))))
+                                  (fn dynamic-uri-matcher-full [request]
+                                    (let [begin-index (int (i/get-uri-match-end-index request))
+                                          params-map (if (zero? begin-index)
+                                                       nil
+                                                       (get request params-key))]
+                                      (when-some [^"[Ljava.lang.Object;"
+                                                  match-result (i/match-uri (:uri request)
+                                                                 begin-index
+                                                                 uri-template partial? params-map)]
+                                        (let [params (aget match-result 0)]
+                                          (i/assoc-path-params request params-key params))))))))
               (ensure-matchex (if uri-string?
+                                ;; static string
                                 (if partial?
                                   (fn uri-matcher-token-partial [request]
                                     `(let [end-index# (int (i/get-uri-match-end-index ~request))
                                            new-index# (i/partial-match-uri-string (:uri ~request)
                                                         end-index#
                                                         ~uri-str-token)]
-                                      (when (>= new-index# i/FULL-MATCH-INDEX)
-                                        (i/assoc-uri-match-end-index ~request new-index#))))
+                                       (when (>= new-index# i/FULL-MATCH-INDEX)
+                                         (i/assoc-uri-match-end-index ~request new-index#))))
                                   (fn uri-matcher-token-full [request]
                                     `(let [end-index# (int (i/get-uri-match-end-index ~request))
                                            new-index# (i/full-match-uri-string (:uri ~request)
                                                         end-index#
-                                                      ~uri-str-token)]
+                                                        ~uri-str-token)]
                                        (when (= new-index# i/FULL-MATCH-INDEX)
-                                         (i/assoc-uri-match-end-index ~request new-index#)))))
-                                (fn [request]
-                                  `(let [begin-index# (int (i/get-uri-match-end-index ~request))
-                                         params-map# (if (zero? begin-index#)
+                                         ~request))))
+                                ;; dynamic string, with path params
+                                (if partial?
+                                  (fn [request]
+                                    `(let [begin-index# (int (i/get-uri-match-end-index ~request))
+                                           params-map# (if (zero? begin-index#)
                                                        nil
                                                        (get ~request ~params-key))]
-                                     (when-some [^"[Ljava.lang.Object;"
-                                                 match-result# (i/match-uri (:uri ~request)
-                                                                 begin-index#
-                                                                 ~uri-template ~partial? params-map#)]
-                                       (let [~params-sym    (aget match-result# 0)
-                                             ~end-index-sym (aget match-result# 1)]
-                                         (if (empty? ~params-sym)
-                                           (i/assoc-uri-match-end-index ~request ~end-index-sym)
+                                       (when-some [^"[Ljava.lang.Object;"
+                                                   match-result# (i/match-uri (:uri ~request)
+                                                                   begin-index#
+                                                                   ~uri-template ~partial? params-map#)]
+                                         (let [~params-sym    (aget match-result# 0)
+                                               ~end-index-sym (aget match-result# 1)]
                                            (-> ~request
                                              (i/assoc-uri-match-end-index ~end-index-sym)
-                                             (i/assoc-path-params ~params-key ~params-sym))))))))))))
+                                             (i/assoc-path-params ~params-key ~params-sym))))))
+                                  (fn [request]
+                                    `(let [begin-index# (int (i/get-uri-match-end-index ~request))
+                                           params-map# (if (zero? begin-index#)
+                                                         nil
+                                                         (get ~request ~params-key))]
+                                       (when-some [^"[Ljava.lang.Object;"
+                                                   match-result# (i/match-uri (:uri ~request)
+                                                                   begin-index#
+                                                                   ~uri-template ~partial? params-map#)]
+                                         (let [~params-sym (aget match-result# 0)]
+                                           (i/assoc-path-params
+                                             ~request ~params-key ~params-sym)))))))))))
         spec))))


Last minute fixes to dtbook

Last minute fixes to dtbook

--- src/catalog/layout/dtbook.clj
+++ src/catalog/layout/dtbook.clj
@@ -20,7 +20,7 @@
    [:p {:brl:class "ann"} (wrap description)]
    (if rucksackbuch?
      [:p {:brl:class "pro"} (wrap producer-brief "" ", " false) (wrap rucksackbuch-number "Rucksackbuch Nr. ")]
-     [:p (wrap producer-brief)])
+     [:p {:brl:class "pro"} (wrap producer-brief)])
    (when library-signature
      [:p {:brl:class "aus"} "Ausleihe: " (layout/braille-signatures library-signature)])
    (when product-number
@@ -55,7 +55,7 @@
                       language "de"}}]
   [:dtbook {:xmlns "http://www.daisy.org/z3986/2005/dtbook/"
             :xmlns:brl "http://www.daisy.org/z3986/2009/braille/"
-            :version "2005-3" :xml:lang language}
+            :version "2005-3-sbs-minimal" :xml:lang language}
    [:head
     (for [[k v]
           {:dc:Title title
@@ -69,37 +69,38 @@
     [:frontmatter
      [:doctitle title]
      [:docauthor creator]
-     [:level1 [:h1]
+     [:level1
       [:p {:brl:class (format "nr_%s" volume)}]
       [:p {:brl:class (format "jr_%s" (layout/year date))}]]]
     [:bodymatter
-     [:level1 [:h1 "Editorial"] [:p]]
+     [:level1 [:h1 "Editorial"] [:p "..."]]
      (for [genre layout/braille-genres] (genre-entries genre items))]
-    [:rearmatter
-     [:level1 [:h1 "Impressum"]
-      [:level2 [:h2 title]
-       [:p "Für Kundinnen und Kunden der SBS sowie für Interessenten"]
-       [:p "Erscheint kostenlos sechsmal jährlich und listet alle seit der letzten Ausgabe neu in die SBS aufgenommenen Braillebücher auf"]
-       [:p (str "Herausgeber: " creator)]
-       [:p "Abonnement: medienverlag@sbs.ch"]]
-      [:level2 [:h2 "Ausleihe und Verkauf"]
-       [:p creator]
-       [:p "Grubenstrasse 12"]
-       [:p "CH-8045 Zürich"]
-       [:p "Fon +41 43 333 32 32"]
-       [:p "Fax +41 43 333 32 33"]
-       [:p "www.sbs.ch"]
-       [:p "Ausleihe/Verkauf Privatpersonen: nutzerservice@sbs.ch"]
-       [:p "Verkauf Institutionen: medienverlag@sbs.ch"]]]
-     [:level1 [:h1 "Einführungsrabatt"]
-      [:p "Die in dieser Ausgabe vorgestellten Rucksackbücher können während zweier Monate mit einem Einführungsrabatt von 20% (ringgebunden ohne Deckel) bestellt werden. Danach gilt der in diesem Heft angegebene Buchhandelspreis (ringgebunden mit Deckel)."]]
-     [:level1 [:h1 "Abkürzungen"]
-      [:p
-       [:list {:type "pl"}
-        [:li "Bd. = Band, Bände"]
-        [:li "K = Kurzschrift"]
-        [:li "V = Vollschrift"]
-        [:li "wtz = weitzeilige Vollschrift"]]]]]]])
+    ;; [:rearmatter
+    ;;  [:level1 [:h1 "Impressum"]
+    ;;   [:level2 [:h2 title]
+    ;;    [:p "Für Kundinnen und Kunden der SBS sowie für Interessenten"]
+    ;;    [:p "Erscheint kostenlos sechsmal jährlich und listet alle seit der letzten Ausgabe neu in die SBS aufgenommenen Braillebücher auf"]
+    ;;    [:p (str "Herausgeber: " creator)]
+    ;;    [:p "Abonnement: medienverlag@sbs.ch"]]
+    ;;   [:level2 [:h2 "Ausleihe und Verkauf"]
+    ;;    [:p creator]
+    ;;    [:p "Grubenstrasse 12"]
+    ;;    [:p "CH-8045 Zürich"]
+    ;;    [:p "Fon +41 43 333 32 32"]
+    ;;    [:p "Fax +41 43 333 32 33"]
+    ;;    [:p "www.sbs.ch"]
+    ;;    [:p "Ausleihe/Verkauf Privatpersonen: nutzerservice@sbs.ch"]
+    ;;    [:p "Verkauf Institutionen: medienverlag@sbs.ch"]]]
+    ;;  [:level1 [:h1 "Einführungsrabatt"]
+    ;;   [:p "Die in dieser Ausgabe vorgestellten Rucksackbücher können während zweier Monate mit einem Einführungsrabatt von 20% (ringgebunden ohne Deckel) bestellt werden. Danach gilt der in diesem Heft angegebene Buchhandelspreis (ringgebunden mit Deckel)."]]
+    ;;  [:level1 [:h1 "Abkürzungen"]
+    ;;   [:p
+    ;;    [:list {:type "pl"}
+    ;;     [:li "Bd. = Band, Bände"]
+    ;;     [:li "K = Kurzschrift"]
+    ;;     [:li "V = Vollschrift"]
+    ;;     [:li "wtz = weitzeilige Vollschrift"]]]]]
+    ]])

 (defn dtbook
   [items]


Shorten the docauthor

Shorten the docauthor

--- src/catalog/layout/dtbook.clj
+++ src/catalog/layout/dtbook.clj
@@ -84,7 +84,10 @@
    [:book
     [:frontmatter
      [:doctitle title]
-     [:docauthor creator]
+     ;; apparently a long docauthor is annoying, as it wraps around and
+     ;; messes up the sbsform macros. So, as this isn't shown anyway
+     ;; just use a fake value
+     [:docauthor "SBS"]
      [:level1
       [:p {:brl:class (format "nr_%s" volume)}]
       [:p {:brl:class (format "jr_%s" (layout/year date))}]]]


Add namespaces to mobile nav on core lib page

--- src/clj/clojuredocs/pages.clj
+++ src/clj/clojuredocs/pages.clj
@@ -48,6 +48,11 @@
      :title "Clojure's Core Library | ClojureDocs - Community-Powered Clojure Documentation and Examples"
      :user user
      :page-uri uri
+     :mobile-nav [{:title "Namespaces"
+                   :links (->> search/clojure-lib
+                               :namespaces
+                               (map (fn [{:keys [name]}]
+                                      [:a {:href (str "/" name)} name])))}]
      :content
      [:div.row
       [:div.col-sm-2


improve Shattered Remains prompt and add log message

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -543,10 +543,12 @@
    "Shattered Remains"
    (advance-ambush 1 {:effect (req (let [shat card]
                                      (resolve-ability
-                                      state side
+                                      state side
                                       (-> trash-hardware
                                           (assoc-in [:choices :max] (:advance-counter shat))
-                                          (assoc :effect (effect (trash-cards targets))))
+                                          (assoc :prompt (msg "Choose " (:advance-counter shat) " pieces of hardware to trash")
+                                                 :effect (effect (trash-cards targets))
+                                                 :msg (msg "trash " (join ", " (map :title targets)))))
                                       shat nil)))})

    "Shi.Kyū"


copies of DBS hosted on Worlds Plaza will be included in count

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -180,8 +180,8 @@
               :once-key :daily-business-show
               :req (req (first-event state side :corp-draw))
               :effect (req
-                        (let [dbs (->> (:corp @state) :servers seq flatten (mapcat :content)
-                                       (filter #(and (:rezzed %) (= (:title %) "Daily Business Show")))  count)
+                        (let [dbs (count (filter #(and (rezzed? %) (= (:title %) "Daily Business Show"))
+                                                  (all-installed state :corp)))
                               newcards (take dbs (:deck corp))
                               drawn (conj newcards (last (:hand corp)))]
                           (doseq [c newcards] (move state side c :hand))


add a stub for Run Amok

add a stub for Run Amok

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -543,6 +543,10 @@
                         :choices (req (filter #(is-type? % "Program") (:discard runner)))
                         :effect (effect (runner-install target {:no-cost true}))}} card))}

+   "Run Amok"
+   {:prompt "Choose a server" :choices (req servers)
+    :effect (effect (run target {:end-run {:msg " trash 1 piece of ICE that was rezzed during the run"}} card))}
+
    "Running Interference"
    {:prompt "Choose a server" :choices (req servers)
     :effect (effect (run target nil card)


Make the REPL use pretty printing

Make the REPL use pretty printing

--- src/clojure/nightmod/repl.clj
+++ src/clojure/nightmod/repl.clj
@@ -29,7 +29,8 @@

 (defn run-repl!
   [in-out]
-  (start-thread! in-out (clojure.main/repl :init #(in-ns u/game-ns))))
+  (start-thread! in-out (clojure.main/repl :init #(in-ns u/game-ns)
+                                           :print clojure.pprint/pprint)))

 (def ^:dynamic *widgets* [:restart])


functions functions functions(fn, def fn, defn)

--- src/clojure_learning/core.clj
+++ src/clojure_learning/core.clj
@@ -231,4 +231,46 @@
      {:keys [email company]} (apply hash-map tail)]
   (str id "works at " company "and has the email " email))

-
+(fn[x] (* x x))
+((fn [x] (* x x)) 2); 4
+(def square (fn[x] (* x x)))
+(pr-str (square 2))
+
+(def minus-1 (fn[x y](do (- x y))))
+(def minus-2 (fn[x y] (- x y)))
+(minus-1 3 2); 1
+(minus-2 5 2); 3
+
+((fn [x y z] (+ x y z)) 1 2 3); same as the following "let" block
+
+(let[[x y z] '(1 2 3)] (+ x y z)); same with:
+
+(let[ x 1
+      y 2
+      z 3]
+  (+ x y z))
+
+;; defn is a macro that encapsulates: def + fn
+;; it uses the let functionality to BIND the arguments for the scope of the function body
+;; arity functions are functions overloaded; here's an example:
+(def make-sum (fn sum-nrs
+                ([x] (sum-nrs x 1))  ; 1-arity overloading -> calling the second arity with a default 1
+                ([x y] (+ x y))))
+(make-sum 1 3); 4
+;; naming the fn allows for recursive calls
+;; implementing the my-map using variadic functions
+(def my-map (fn map-rec
+                ([func [head & tail]]
+                  (if(nil? head)
+                    []
+                    (cons (func head) (map-rec func tail)))
+                )))
+
+(def inc-by-one (my-map (fn[x] (+ x 1))  '(1 2 3)))
+(pr-str inc-by-one)
+(def append-prefix (my-map (fn[each] (str "prefix: " each)) '("cc" "ll")))
+(pr-str append-prefix)
+
+; (cons 1 (conj '() 2))
+; (def inc-by-one (map (fn[x] (+ x 1)) '(1 2 3)))
+; (pr-str inc-by-one)


Moved more HTTP code over from CMR OPeNDAP.

--- src/cmr/http/kit/response.clj
+++ src/cmr/http/kit/response.clj
@@ -6,11 +6,15 @@
   by single use or composition."
   (:require
    [cheshire.core :as json]
+   [cheshire.generate :as json-gen]
    [clojure.data.xml :as xml]
    [clojure.string :as string]
+   [cmr.exchange.common.results.errors :as errors]
    [ring.util.http-response :as response]
    [taoensso.timbre :as log]
    [xml-in.core :as xml-in])
+  (:import
+    (java.lang.ref SoftReference))
   (:refer-clojure :exclude [error-handler]))

 (defn stream->str
@@ -18,6 +22,24 @@
   (if (string? body)
     body
     (slurp body)))
+
+(defn soft-reference->json!
+  "Given a soft reference object and a Cheshire JSON generator, write the
+  data stored in the soft reference to the generator as a JSON string.
+
+  Note, however, that sometimes the value is not a soft reference, but rather
+  a raw value from the response. In that case, we need to skip the object
+  conversion, and just do the realization."
+  [obj json-generator]
+  (let [data @(if (isa? obj SoftReference)
+                (.get obj)
+                obj)
+        data-str (json/generate-string data)]
+    (log/trace "Encoder got data: " data)
+    (.writeString json-generator data-str)))
+
+;; This adds support for JSON-encoding the data cached in a SoftReference.
+(json-gen/add-encoder SoftReference soft-reference->json!)

 (defn parse-json-body
   [body]
@@ -144,3 +166,51 @@

 (def json-handler #(client-handler % error-handler parse-json-body))
 (def xml-handler #(client-handler % error-handler parse-xml-body))
+
+(defn process-ok-results
+  [data]
+  {:headers {"CMR-Took" (:took data)
+             "CMR-Hits" (:hits data)}
+   :status 200})
+
+(defn process-err-results
+  [data]
+  {:status errors/default-error-code})
+
+(defn process-results
+  ([data]
+    (process-results process-err-results data))
+  ([err-fn data]
+    (process-results err-fn process-ok-results data))
+  ([err-fn ok-fn data]
+    (if (:errors data)
+      (err-fn data)
+      (ok-fn data))))
+
+(defn json
+  ([request data]
+    (json request process-results data))
+  ([_request process-fn data]
+    (log/trace "Got data for JSON:" data)
+    (-> data
+        process-fn
+        (assoc :body (json/generate-string data))
+        (response/content-type "application/json"))))
+
+(defn text
+  ([request data]
+    (text request process-results data))
+  ([_request process-fn data]
+    (-> data
+        process-fn
+        (assoc :body data)
+        (response/content-type "text/plain"))))
+
+(defn html
+  ([request data]
+    (html request process-results data))
+  ([_request process-fn data]
+    (-> data
+        process-fn
+        (assoc :body data)
+        (response/content-type "text/html"))))


Added resolve-and-load-namespace helper

Added resolve-and-load-namespace helper

--- src/de/kotka/gorilla/util.clj
+++ src/de/kotka/gorilla/util.clj
@@ -214,3 +214,11 @@
 (defmethod clj->vim Number
   [thing]
   (str thing))
+
+; Namespace helpers
+(defn resolve-and-load-namespace
+  "Loads and returns the namespace named by the given string or symbol."
+  [namespace]
+  (let [namespace (if (symbol? namespace) namespace (symbol namespace))]
+    (require namespace)
+    (the-ns namespace)))


Fix a macro issue

Fix a macro issue

Can't call functions from inside this quoted form, so jank it out for now

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -509,7 +509,7 @@
                                       "pull request page."]
                                        [:p
                                         "There are serious security concerns with this setting (see "
-                                        [:a (open-ext {:href "/docs/fork-pr-builds"}) "the documentation"] " for details.) "
+                                        [:a {:data-external true :href "/docs/fork-pr-builds"} "the documentation"] " for details.) "
                                         "If you have SSH keys, sensitive env vars or AWS credentials stored in your project settings and "
                                         "untrusted forks can make pull requests against your repo, then this option "
                                         "isn't for you!"])})


added category list to main page

added category list to main page

--- src/distillery/view/index.clj
+++ src/distillery/view/index.clj
@@ -54,10 +54,17 @@
       (render-main-glossary args)
       (render-main-word-frame args)]])

+(defn- render-categories-list-item
+  [{:keys [id name] :as category}]
+  (list-item (link (str "categories/" id "/index.html") name)))
+
 (defn- render-categories-list
   [{:keys [categories] :as args}]
-  (innerpage "overview" "Übersicht" true
-             [(TODO "Kategorieliste")]))
+  (->> categories
+       (into (sorted-set-by (key-comp :name)))
+       (map render-categories-list-item)
+       (ulist)
+       (innerpage "overview" "Übersicht" true)))

 (defn render-categories-page
   "Renders the categories main page."
@@ -68,7 +75,7 @@
      [(headline 2 "Kategorien")
       (render-categories-list args)]])

-(defn- render-video-list-item
+(defn- render-videos-list-item
   "Renders a video link as list item."
   [{:keys [id name] :as video}]
   (list-item (link (str "videos/" id "/index.html") name)))
@@ -77,7 +84,7 @@
   [{:keys [videos] :as args}]
   (let [video-list (into (sorted-set-by (key-comp :name)) videos)]
     (innerpage "overview" "Übersicht" true
-               (ulist (map render-video-list-item video-list)))))
+               (ulist (map render-videos-list-item video-list)))))

 (defn render-videos-page
   "Renders the videos main page."
@@ -88,3 +95,4 @@
      [(headline 2 "Videos")
       (render-videos-list args)]])

+


even more readable

even more readable

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -287,8 +287,7 @@
 (defmethod api-event [:github-repos :failed]
   [target message status {:keys [status-code]} state]
   (cond-> state
-    (= 401 status-code) (update-in state/user-path (fn [user]
-                                                     (user-model/deauthorize-github user)))
+    (= 401 status-code) (update-in state/user-path user-model/deauthorize-github)
     true (assoc-in state/github-repos-loading-path false)))

 (defmethod api-event [:bitbucket-repos :success]
@@ -300,8 +299,7 @@
 (defmethod api-event [:bitbucket-repos :failed]
   [target message status {:keys [status-code]} state]
   (cond-> state
-    (= 401 status-code) (update-in state/user-path (fn [user]
-                                                     (user-model/deauthorize-bitbucket user)))
+    (= 401 status-code) (update-in state/user-path user-model/deauthorize-bitbucket)
     true (assoc-in state/bitbucket-repos-loading-path false)))

 (defn filter-piggieback [orgs]


Repository should be in data/ dir.

Repository should be in data/ dir.

--- resources/config.clj
+++ resources/config.clj
@@ -2,7 +2,7 @@
       :subprotocol "sqlite"
       :subname "data/db"}
  :key-file "data/authorized_keys"
- :repo "repo"
+ :repo "data/repo"
  :mail {:hostname "smtp.gmail.com"
         :username "clojars@pupeno.com"
         :password "fuuuuuu"


Show total amount

Show total amount

--- src/clojurescript/skuld/show_group/app.cljs
+++ src/clojurescript/skuld/show_group/app.cljs
@@ -40,13 +40,22 @@
        (re-find #"/groups/([\d\w-]*)")
        (#(% 1))))

+(defn expenses []
+  (:group-expenses @app-state))
+
+(defn total-expenses []
+  (->> @(r/track expenses)
+      (map :amount)
+      (reduce + 0)))
+
 (defn show-group []
   [:div
    [:p (str "Group id: " (-> @app-state :group-info :id))]
    [:h1 (:name @app-state)]
    [:h2 "Members"]
    [:ul (for [m (-> @app-state :group-info :members)]
-          ^{:key m} [:li m])]])
+          ^{:key m} [:li m])]
+   [:p (str "Den här gruppen har spenderat totalt " (total-expenses) " kr.")]])

 (defn debug-state []
   [:div


Added a docstring to scf.storage/insert-facts!

--- src/com/puppetlabs/puppetdb/scf/storage.clj
+++ src/com/puppetlabs/puppetdb/scf/storage.clj
@@ -662,7 +662,9 @@
             (dissociate-all-catalogs-for-certname! certname)
             (associate-catalog-with-certname! catalog-hash certname timestamp)))))

-(defn insert-facts! [certname facts]
+(defn insert-facts!
+  "Given a certname and map of fact/value keypairs, insert them into the facts table"
+  [certname facts]
   (let [default-row {:certname certname}
         rows        (for [[fact value] facts]
                       (assoc default-row :name fact :value value))]


Add sensible buffers to i/o channels

Add sensible buffers to i/o channels

--- src/neovim_client/rpc.clj
+++ src/neovim_client/rpc.clj
@@ -21,14 +21,13 @@
 (defn create-input-channel
   "Read messages from the input stream, put them on a channel."
   [input-stream]
-  (let [chan (async/chan)
+  (let [chan (async/chan 1024)
         input-stream (DataInputStream. input-stream)]
-    (async/go
-      (while true
-        (log/info "waiting for input stream")
-        (let [msg (msgpack/unpack-stream input-stream)]
-          (log/info "stream -> msg -> in chan: " msg)
-          (async/>! chan msg))))
+    (async/go-loop []
+      (let [msg (msgpack/unpack-stream input-stream)]
+        (log/info "stream -> msg -> in chan: " msg)
+        (async/>! chan msg))
+      (recur))
     chan))

 (defn write-msg!
@@ -40,13 +39,13 @@
 (defn create-output-channel
   "Make a channel to read messages from, write to output stream."
   [output-stream]
-  (let [chan (async/chan)
+  (let [chan (async/chan 1024)
         output-stream (DataOutputStream. output-stream)]
-    (async/go
-      (while true
-        (let [msg (async/<! chan)]
-          (log/info "stream <- msg <- out chan: " msg)
-          (write-msg! (msgpack/pack msg) output-stream))))
+    (async/go-loop []
+      (let [msg (async/<! chan)]
+        (log/info "stream <- msg <- out chan: " msg)
+        (write-msg! (msgpack/pack msg) output-stream))
+      (recur))
     chan))

 (declare send-message-async!)
@@ -57,21 +56,21 @@
   (reset! out-chan (create-output-channel output-stream))

   ;; Handle stuff on the input channel -- where should this live?
-  (async/go
-    (while true
-      ;; TODO - let the in-chan, if we leave this code here.
-      (let [msg (async/<! @in-chan)]
-        (condp = (msg-type msg)
+  (async/go-loop []
+    ;; TODO - let the in-chan, if we leave this code here.
+    (let [msg (async/<! @in-chan)]
+      (condp = (msg-type msg)

-          msg/+response+
-          (let [f (:fn (get @msg-table (id msg)))]
-            (swap! msg-table dissoc (id msg))
-            (f (value msg)))
+        msg/+response+
+        (let [f (:fn (get @msg-table (id msg)))]
+          (swap! msg-table dissoc (id msg))
+          (f (value msg)))

-          msg/+request+
-          (let [f (get @method-table (method msg) method-not-found)
-                result (f msg)]
-            (send-message-async! (->response-msg (id msg) result) nil)))))))
+        msg/+request+
+        (let [f (get @method-table (method msg) method-not-found)
+              result (f msg)]
+          (send-message-async! (->response-msg (id msg) result) nil))))
+    (recur)))

 ;; ***** Public *****


Adds support for multiple selection in Mail script

--- src/great_things_done/application_info.cljs
+++ src/great_things_done/application_info.cljs
@@ -3,14 +3,16 @@

 (def ^:private osx-mail-applescript
   "tell application \"Mail\"
-    set _sel to get selection
-    set _links to {}
-    set the selected_message to item 1 of the _sel
-    set _messageURL to \"message://%3c\" & selected_message's message id & \"%3e\"
-    set AppleScript's text item delimiters to return
-  end tell
+     set _sel to get selection
+     set _links to {}
+     repeat with _msg in _sel
+       set _messageURL to \"message://%3c\" & _msg's message id & \"%3e\"
+       set end of _links to _messageURL
+     end repeat
+     set AppleScript's text item delimiters to return
+   end tell

-  return _messageURL")
+   return _links")

 (defmulti retrieve-current-app-data-osx
   #(:id %1))


Clean up squirrel-play

Clean up squirrel-play

There were some poor names and places where a little more commenting seemed to be in order.

--- src/clojush/problems/ec_ai_demos/squirrel_play.clj
+++ src/clojush/problems/ec_ai_demos/squirrel_play.clj
@@ -71,8 +71,8 @@
   [program inputs]
   (let [start-state (make-start-state inputs)
         end-state (run-push program start-state)
-        top-int (top-item :boolean end-state)]
-    top-int))
+        result (top-item :boolean end-state)]
+    result))

 (defn all-errors
   [program]
@@ -85,12 +85,20 @@
           1)))))

 (def atom-generators
-  (concat (registered-for-stacks [:integer :boolean :exec])
-          (list (fn [] (lrand-int 100))
-                60 90 100
-                'in1 'in2)))
+  (concat
+    ; Include all the instructions that act on integers and booleans
+    ; Could have :exec here, but I just am limiting things to exec-if
+    (registered-for-stacks [:integer :boolean])
+    (list 'exec_if)
+    ; A bunch of random numbers in case that's useful.
+    ; (list (fn [] (lrand-int 100)))
+    ; The three numeric constants that are specified in the problem statement
+    (list 60 90 100)
+    ; The two inputs
+    (list 'in1 'in2)))

 (def argmap
   {:error-function all-errors
    :atom-generators atom-generators
+   :population-size 500
    })


Whitespace / improve TODO

Whitespace / improve TODO

--- src/onyx/peer/barrier.clj
+++ src/onyx/peer/barrier.clj
@@ -5,16 +5,13 @@
             [taoensso.timbre :as timbre :refer [debug info]]
             [onyx.types :refer [->Barrier]]))

-
-
-
 (defn all-barriers-seen? [job-allocations global-watermarks-val this-task-id this-peer-id ingress-ids barrier]
   (empty?
    (filter nil?
            (mapcat (fn [task-id]
                      (let [upstream-task-peers (get job-allocations task-id)]
                        (map (fn [peer-id]
-                              ;; TODO: should lookup by barrier id, not message id because the message-id won't necessarily be the same for all barriers
+                              ;; TODO: should lookup by barrier id, not message id because the message-id won't necessarily be stable for all barriers
                               (get-in global-watermarks-val [this-task-id peer-id :barriers (:msg-id barrier) this-peer-id]))
                             upstream-task-peers)))
                    ingress-ids))))


Formatting.

Formatting.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -56,7 +56,8 @@
 (defn find-brokers [task-map]
   (let [zk-addr (:kafka/zookeeper task-map)
         _ (when-not zk-addr
-            (throw (ex-info "Either :kafka/bootstrap-servers or :kafka/zookeeper must be defined." {:task-map task-map})))
+            (throw (ex-info "Either :kafka/bootstrap-servers or :kafka/zookeeper must be defined."
+                            {:task-map task-map})))
         results (vals (h/id->broker zk-addr))]
     (if (seq results)
       results


make `compile-file` function public

make `compile-file` function public

--- src/optimus_sass/core.clj
+++ src/optimus_sass/core.clj
@@ -1,5 +1,6 @@
 (ns optimus-sass.core
-  (:require [clojure.string :as str]
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
             [optimus.assets.creation :refer [last-modified existing-resource]]
             [optimus.assets.load-css :refer [create-css-asset]])
   (:import [org.jruby.embed ScriptingContainer LocalContextScope]))
@@ -9,12 +10,12 @@
                                 ENV['GEM_HOME']='deps'
                                 require 'sass'
                                 Sass")]
-  (defn- compile-sass [^String path]
-    (.callMethod ruby sass "compile_file" path String)))
+  (defn compile-file [^java.io.File file]
+    (.callMethod ruby sass "compile_file" (.getPath file) String)))

 (defn- load-sass-asset [public-dir path]
   (let [resource (existing-resource public-dir path)
-        css (-> resource .getFile compile-sass)
+        css (-> resource io/file compile-file)
         css-asset (create-css-asset (str/replace path #"\.sass\z|\.scss\z" ".css")
                                     css
                                     (last-modified resource))]


Ensure leaves are a set as in Clojure 1.5, contains? is not supported on type: clojure.lang.APersistentMap$KeySeq. Fixes #201.

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -424,25 +424,25 @@

     (if (empty? leaves)
       sorted-ugens
-      (let [last-ugen (last sorted-ugens)
-            ; try to always place the downstream ugen from the last-ugen if all other
-            ; deps are satisfied, which keeps internal buffers in cache as long as possible
-            next-ugen (first (filter #((set (ugen-children %)) last-ugen) leaves))
+      (let [last-ugen          (last sorted-ugens)
+            ;; try to always place the downstream ugen from the last-ugen if all other
+            ;; deps are satisfied, which keeps internal buffers in cache as long as possible
+            next-ugen          (first (filter #((set (ugen-children %)) last-ugen) leaves))
             [next-ugen leaves] (if next-ugen
                                  [next-ugen (disj leaves next-ugen)]
-                                 [(first leaves) (next leaves)])
-            sorted-ugens (conj sorted-ugens next-ugen)
-            sorted-ugen-set (set sorted-ugens)
-            ugens (set/difference ugens sorted-ugen-set leaves)
-            leaves (set
-                     (reduce
-                       (fn [rleaves ug]
-                         (let [children (ugen-children ug)]
-                           (if (set/subset? children sorted-ugen-set)
-                             (conj rleaves ug)
-                             rleaves)))
-                       leaves
-                       ugens))]
+                                 [(first leaves) (set (next leaves))])
+            sorted-ugens       (conj sorted-ugens next-ugen)
+            sorted-ugen-set    (set sorted-ugens)
+            ugens              (set/difference ugens sorted-ugen-set leaves)
+            leaves             (set
+                                (reduce
+                                 (fn [rleaves ug]
+                                   (let [children (ugen-children ug)]
+                                     (if (set/subset? children sorted-ugen-set)
+                                       (conj rleaves ug)
+                                       rleaves)))
+                                 leaves
+                                 ugens))]
         (recur ugens leaves sorted-ugens (inc rec-count))))))

 (comment


Fix whitespace

Fix whitespace

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -222,19 +222,19 @@
   (for [[p-name p-val] (partition 2 params)]
     (let [param-map
           (cond
-            (vector? p-val) (do
-                              (ensure-valid-control-proxy-vec! p-val)
-                              {:name (str p-name)
-                               :default (first p-val)
-                               :rate (second p-val)})
-
-            (associative? p-val) (merge
-                                  {:name  (str p-name)
-                                   :rate  DEFAULT-RATE} p-val)
-
-            :else {:name (str p-name)
-                   :default `(float (to-id ~p-val))
-                   :rate DEFAULT-RATE})]
+           (vector? p-val) (do
+                             (ensure-valid-control-proxy-vec! p-val)
+                             {:name (str p-name)
+                              :default (first p-val)
+                              :rate (second p-val)})
+
+           (associative? p-val) (merge
+                                 {:name  (str p-name)
+                                  :rate  DEFAULT-RATE} p-val)
+
+           :else {:name (str p-name)
+                  :default `(float (to-id ~p-val))
+                  :rate DEFAULT-RATE})]
       (ensure-param-keys! param-map)
       param-map)))


Add "scale" function as per TCHECK-68

Add "scale" function as per TCHECK-68

--- src/main/clojure/clojure/test/check/generators.clj
+++ src/main/clojure/clojure/test/check/generators.clj
@@ -197,6 +197,13 @@
     (make-gen
      (fn [rnd _size]
        (gen rnd n)))))
+
+(defn scale
+  "Create a new generator that modifies the size parameter by the given function. Intended to
+   support generators with sizes that need to grow at different rates compared to the normal
+   linear scaling."
+  ([f generator]
+    (sized (fn [n] (resize (f n) generator)))))

 (defn choose
   "Create a generator that returns numbers in the range


goog events use keyCode

goog events use keyCode

--- src-cljs/frontend/components/key_queue.cljs
+++ src-cljs/frontend/components/key_queue.cljs
@@ -56,8 +56,8 @@
   This fn will never return just 'shift' or any other lone modifier key."
   [event]
   (let [mods (event-modifiers event)
-        which (.-which event)
-        key (or (code->key which) (.toLowerCase (js/String.fromCharCode which)))]
+        code (.-keyCode event)
+        key (or (code->key code) (.toLowerCase (js/String.fromCharCode code)))]
     (if (and key (not (empty? key)) (not (some #{key} mod-keys)))
       (join "+" (conj mods key)))))


Replace flatten with mapcat (#312)

Replace flatten with mapcat (#312)

mapcat better expresses what is intended here

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -566,8 +566,7 @@
   [matches]
   (let [category->jobs (group-by util/categorize-job
                                  (->> matches
-                                      (map #(-> % :tasks vec))
-                                      flatten
+                                      (mapcat #(-> % :tasks))
                                       (map #(-> % .getRequest :job))))
         category->job-uuids (pc/map-vals #(set (map :job/uuid %)) category->jobs)]
     (log/debug "matched jobs:" (pc/map-vals count category->job-uuids))


Simplify tsplot code by factoring out common expressions and switching to a more data driven configuration for line styles.

--- metlog-vault/src-client/metlog_client/tsplot.cljs
+++ metlog-vault/src-client/metlog_client/tsplot.cljs
@@ -9,6 +9,61 @@
 (def x-axis-space 20)
 (def tsplot-right-margin 5)
 (def y-axis-space 40)
+
+(def pixels-per-y-label 20)
+
+(def y-line-intervals [0.1 0.2 0.5
+                       1 2 5
+                       10 20 50
+                       100 200 500])
+
+(def stroke-styles
+  {:grid
+   {:line-width 0
+    :stroke-style "#707070"
+    :line-dash #js [ 2 2]}
+
+   :grid-emphasis
+   {:line-width 0
+    :stroke-style "#000000"
+    :line-dash #js [ ]}
+
+   :series-line
+   {:line-width 0
+    :stroke-style "#0000FF"
+    :line-dash #js [ ]}
+
+   :frame
+   {:line-width 1
+    :stroke-style "#000000"
+    :line-dash #js [ ]}})
+
+(defn floor [ x ]
+  (.floor js/Math x))
+
+(defn pixel-snap [ t ]
+  (+ 0.5 (floor t)))
+
+(defn range-contains-zero? [ range ]
+  (and (< (:min range) 0.0)
+       (> (:max range) 0.0)))
+
+(defn range-magnitude [ range ]
+  (- (:max range) (:min range)))
+
+(defn clip-rect [ ctx x y w h ]
+  (.beginPath ctx)
+  (.rect ctx x y w h)
+  (.clip ctx))
+
+(defn first-that [ pred? xs ]
+  (first (filter pred? xs)))
+
+(defn draw-line [ ctx [ x-1 y-1 ] [ x-2 y-2 ] ]
+  (.beginPath ctx)
+  (.moveTo ctx x-1 y-1)
+  (.lineTo ctx x-2 y-2)
+  (.stroke ctx))

 (defn s-yrange [ samples ]
   (loop [samples (next samples)
@@ -22,7 +77,7 @@
                (if (> val max) val max))))))

 (defn rescale-range [ range factor ]
-  (let [ scaled-delta (* (/ (- factor 1) 2) (- (:max range) (:min range) )) ]
+  (let [ scaled-delta (* (/ (- factor 1) 2) (range-magnitude range)) ]
     {:max (+ (:max range) scaled-delta)
      :min (- (:min range) scaled-delta)}))

@@ -67,34 +122,12 @@
 (defn format-ylabel [ val ]
   (.toFixed val 2))

-(defn clip-rect [ ctx x y w h ]
-  (.beginPath ctx)
-  (.rect ctx x y w h)
-  (.clip ctx))
-
-(def y-line-intervals [0.1 0.2 0.5
-                       1 2 5
-                       10 20 50
-                       100 200 500])
-
-(defn range-contains-zero? [ range ]
-  (and (< (:min range) 0.0)
-       (> (:max range) 0.0)))
-
-(defn range-magnitude [ range ]
-  (- (:max range) (:min range)))
-
 (defn largest-y-range-magnitude [ y-range ]
   (if (range-contains-zero? y-range)
     (if (> (:max y-range) (.abs js/Math (:min y-range)))
       {:t (/ (:max y-range) (range-magnitude y-range)) :magnitude (:max y-range)}
       {:t (/ (:max y-range) (range-magnitude y-range)) :magnitude (- (:min y-range))})
-    {:t 1.0 :magnitude (- (:max y-range) (:min y-range)) }))
-
-(def pixels-per-y-label 20)
-
-(defn first-that [ pred? xs ]
-  (first (filter pred? xs)))
+    {:t 1.0 :magnitude (range-magnitude y-range) }))

 (defn find-y-grid-interval [ h y-range ]
   (let [{ t :t magnitude :magnitude } (largest-y-range-magnitude y-range)
@@ -104,44 +137,41 @@
                  (map #(vector % (* pixels-per-y-label (/ magnitude %)))
                       y-line-intervals)))))

+(defn set-stroke-style [ ctx style-name ]
+  (if-let [ style (get stroke-styles style-name false) ]
+    (do
+      (aset ctx "lineWidth" (:line-width style))
+      (aset ctx "strokeStyle" (:stroke-style style))
+      (.setLineDash ctx (:line-dash style)))
+    (.error js/console "Unknown stroke style:" (pr-str style-name))))
+
 (defn draw-y-grid-line [ ctx w y value emphasize? ]
   (with-preserved-ctx ctx
     (draw-ylabel ctx (format-ylabel value) -2 y)
-    (aset ctx "lineWidth" 0)
-    (if emphasize?
-      (aset ctx "strokeStyle" "#000000")
-      (aset ctx "strokeStyle" "#707070"))
-    (unless emphasize?
-       (.setLineDash ctx #js [ 2 2 ]))
-    (.beginPath ctx)
-    (.moveTo ctx 0 y)
-    (.lineTo ctx w y)
-    (.stroke ctx)))
-
-(defn pixel-snap [ t ]
-  (+ 0.5 (.floor js/Math t)))
+    (set-stroke-style ctx (if emphasize? :grid-emphasis :grid))
+    (draw-line ctx [ 0 y ] [ w y ])))

 (defn draw-y-grid [ ctx w h y-range ]
   (with-preserved-ctx ctx
     (let [ty (translate-fn-invert y-range h)
           y-interval (find-y-grid-interval h y-range)]
       (if (range-contains-zero? y-range)
-        (let [positive-lines (.floor js/Math (/ (:max y-range) y-interval))
-              negative-lines (.floor js/Math (/ (- (:min y-range)) y-interval))]
+        (let [positive-lines (floor (/ (:max y-range) y-interval))
+              negative-lines (floor (/ (- (:min y-range)) y-interval))]
           (draw-y-grid-line ctx w (pixel-snap (ty 0.0)) 0.0 true)
           (doseq [ii (range positive-lines)]
             (draw-y-grid-line ctx w (pixel-snap (ty (* y-interval (+ ii 1)))) (* y-interval (+ ii 1)) false))
           (doseq [ii (range negative-lines)]
             (draw-y-grid-line ctx w (pixel-snap (ty (* (- y-interval) (+ ii 1)))) (* (- y-interval) (+ ii 1)) false)))
-        (let [ lines (.floor js/Math (/ (- (:max y-range) (:min y-range)) y-interval))]
+        (let [ lines (floor (/ (range-magnitude y-range) y-interval))]
           (doseq [ii (range lines)]
             (draw-y-grid-line ctx w (pixel-snap (ty (+ (:min y-range) (* y-interval (+ ii 1)))))
                               (+ (:min y-range) (* y-interval (+ ii 1))) false)))))))

 (defn draw-series [ ctx w h data x-range ]
   (with-preserved-ctx ctx
-    (aset ctx "lineWidth" 0)
-    (aset ctx "strokeStyle" "#0000FF")
+    (set-stroke-style ctx :series-line)
+
     (aset ctx "font" "12px Arial")
     (let [y-range (rescale-range (s-yrange data) 1.2)]
       (unless (empty? data)
@@ -159,12 +189,8 @@

 (defn draw-frame [ ctx w h ]
   (with-preserved-ctx ctx
-    (.beginPath ctx)
-    (aset ctx "lineWidth" 1)
-    (aset ctx "strokeStyle" "#000000")
-    (.moveTo ctx 0.5 0.5)
-    (.lineTo ctx 0.5 (- h 0.5))
-    (.stroke ctx)))
+    (set-stroke-style ctx :frame)
+    (draw-line ctx [ 0.5 0.5 ] [ 0.5 (- h 0.5) ] )))

 (defn draw [ ctx w h data begin-t end-t]
   (draw-series-background ctx w h)


Use getWriteApiBlocking to post data to InfluxDB (#1028)

getWriteApi creates a new background thread on each invocation and is
supposed to run as a singleton.

--- src/riemann/influxdb2.clj
+++ src/riemann/influxdb2.clj
@@ -47,7 +47,7 @@
   "Post datapoint to InfluxDB endpoint."
   [connection data]
   (try
-    (let [api (.getWriteApi connection)]
+    (let [api (.getWriteApiBlocking connection)]
       (.writePoints api data))
     (catch Exception e
       (println "caught exception" (.getMessage e)))))


reflection

reflection

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -5,6 +5,8 @@

 (set! *warn-on-reflection* true)
+;; (set! *unchecked-math* :warn-on-boxed)
+

 (defmacro expension-report
   "Debugging macro to show the result of the expension"


nrepl -- require clojure.stacktrace

nrepl -- require clojure.stacktrace

--- src/com/billpiel/sayid/nrepl_middleware.clj
+++ src/com/billpiel/sayid/nrepl_middleware.clj
@@ -1,5 +1,6 @@
 (ns com.billpiel.sayid.nrepl-middleware
-  (:require [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
+  (:require [clojure.stacktrace :as st]
+            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
             [clojure.tools.nrepl.misc :refer [response-for]]
             [clojure.tools.nrepl.transport :as t]
             [com.billpiel.sayid.core :as sd]
@@ -398,7 +399,7 @@
                                          :value out)))
        (catch Exception e
          (t/send transport (response-for msg
-                                         :value (with-out-str (clojure.stacktrace/print-stack-trace e)))))
+                                         :value (with-out-str (st/print-stack-trace e)))))
        (finally
          (send-status-done msg))))

@@ -420,9 +421,9 @@
     (catch Exception e
       (println e)
       (println (with-out-str ;; I don't know why this is necessary
-                 (clojure.stacktrace/print-stack-trace e)))
+                 (st/print-stack-trace e)))
       (t/send transport (response-for msg
-                                      :value (with-out-str (clojure.stacktrace/print-stack-trace e)))))
+                                      :value (with-out-str (st/print-stack-trace e)))))
     (finally
       (send-status-done msg))))

@@ -667,7 +668,7 @@
       ((get sayid-nrepl-ops op handler) msg)
       (catch Throwable e
           (println (.getMessage e))
-          (clojure.stacktrace/print-stack-trace e)
+          (st/print-stack-trace e)
           (reply:clj->nrepl msg (.getMessage e))))))


idempotent joined chat msg

idempotent joined chat msg

Former-commit-id: dbfbd18eaf100ad9732799a2b432703953740b8b

--- src/syng_im/handlers.cljs
+++ src/syng_im/handlers.cljs
@@ -148,7 +148,7 @@
 (defn joined-chat-msg [chat-id from msg-id]
   (let [contact-name (:name (contacts/contact-by-identity from))]
     (save-message chat-id {:from         "system"
-                           :msg-id       msg-id
+                           :msg-id       (str msg-id "_" from)
                            :content      (str (or contact-name from) " received chat invitation")
                            :content-type text-content-type})))


remove completed TODO

remove completed TODO

--- src/babel/korma.clj
+++ src/babel/korma.clj
@@ -2,8 +2,6 @@
 ;; use a clojure wrapper around JDBC.
 ;; TODO: rename this file - misleading name 'korma.clj'.
 ;; It uses korma, but it is not itself part of korma.
-;; TODO: clean up and remove verbcoach-specific stuff
-;; (e.g. classes,students,etc).
 (ns babel.korma
   (:refer-clojure :exclude [test update])
   (:require [clojure.data.json :as json]


Remove dead code and comment TODOs

Remove dead code and comment TODOs

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -217,49 +217,40 @@
      ;;(GLFW/glfwSetErrorCallback (GLFWErrorCallback/createPrint System/out))
      (GLFW/glfwSetErrorCallback (proxy [GLFWErrorCallback] []
                                            (invoke [error description] (log/error "GLFW error:" error description))))
-     ;(future
-       ;(GLUtil/setupDebugMessageCallback System/out)
-       (when-not (= (GLFW/glfwInit) GLFW/GLFW_TRUE)
-         (assert "Unable to initialize GLFW"))
-       (GLFW/glfwDefaultWindowHints)
-       (GLFW/glfwWindowHint GLFW/GLFW_VISIBLE GLFW/GLFW_FALSE)
-       (GLFW/glfwWindowHint GLFW/GLFW_RESIZABLE GLFW/GLFW_FALSE)
-
-       (GLFW/glfwWindowHint GLFW/GLFW_CONTEXT_VERSION_MAJOR 3)
-       (GLFW/glfwWindowHint GLFW/GLFW_CONTEXT_VERSION_MINOR 2)
-       (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_PROFILE GLFW/GLFW_OPENGL_CORE_PROFILE)
-       (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_FORWARD_COMPAT GLFW/GLFW_TRUE)
-       (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_DEBUG_CONTEXT GLFW/GLFW_TRUE)
-       (if-let [window (GLFW/glfwCreateWindow (int screen-width) (int screen-height) (str title) 0 0)]
-         (do
-           ;(Display/setDisplayMode (DisplayMode. screen-width screen-height))
-           ;(Display/setTitle title)
-           #_(when icon-array
-             (log/info "Setting icons")
-             ;(Display/setIcon icon-array)
-             (Thread/sleep 100))
-           (log/info "byte-buffer" icon-array)
-           (let [vidmode      (GLFW/glfwGetVideoMode (GLFW/glfwGetPrimaryMonitor))]
-             (GLFW/glfwSetWindowPos
-               window
-               (/ (- (.width vidmode) screen-width) 2)
-               (/ (- (.height vidmode) screen-height) 2))
-             (GLFW/glfwMakeContextCurrent window)
-             (GLFW/glfwSwapInterval 1)
-             (GLFW/glfwShowWindow window)
-             (let [capabilities (GL/createCapabilities)]
-               (GL11/glViewport 0 0 screen-width screen-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))
-               ;(GLFW/glfwSwapBuffers window)
-               ;; Release the Display so that any thread can aquire it including this thread - the thread that
-               ;; created it.
-               ;(Display/releaseContext)
-               (GLFW/glfwMakeContextCurrent 0)
-               ;; Signal to parent that display has been created
-               [window capabilities])))
-       (throw (RuntimeException. "Failed to create the GLFW window")))))
+     ;(GLUtil/setupDebugMessageCallback System/out)
+     (when-not (= (GLFW/glfwInit) GLFW/GLFW_TRUE)
+       (assert "Unable to initialize GLFW"))
+     (GLFW/glfwDefaultWindowHints)
+     (GLFW/glfwWindowHint GLFW/GLFW_VISIBLE GLFW/GLFW_FALSE)
+     (GLFW/glfwWindowHint GLFW/GLFW_RESIZABLE GLFW/GLFW_FALSE)
+
+     (GLFW/glfwWindowHint GLFW/GLFW_CONTEXT_VERSION_MAJOR 3)
+     (GLFW/glfwWindowHint GLFW/GLFW_CONTEXT_VERSION_MINOR 2)
+     (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_PROFILE GLFW/GLFW_OPENGL_CORE_PROFILE)
+     (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_FORWARD_COMPAT GLFW/GLFW_TRUE)
+     (GLFW/glfwWindowHint GLFW/GLFW_OPENGL_DEBUG_CONTEXT GLFW/GLFW_TRUE)
+     (if-let [window (GLFW/glfwCreateWindow (int screen-width) (int screen-height) (str title) 0 0)]
+       (do
+         ; TODO: set window icons
+         #_(when icon-array
+           (log/info "Setting icons")
+           ;(Display/setIcon icon-array)
+           (Thread/sleep 100))
+         (log/info "byte-buffer" icon-array)
+         (let [vidmode      (GLFW/glfwGetVideoMode (GLFW/glfwGetPrimaryMonitor))]
+           (GLFW/glfwSetWindowPos
+             window
+             (/ (- (.width vidmode) screen-width) 2)
+             (/ (- (.height vidmode) screen-height) 2))
+           (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])))
+     (throw (RuntimeException. "Failed to create the GLFW window")))))

 (defn- load-shader
   [^String shader-str ^Integer shader-type]
@@ -321,12 +312,12 @@
   ([viewport-width viewport-height]
     (ortho-matrix-buffer viewport-width viewport-height (BufferUtils/createFloatBuffer 16)))
   ([viewport-width viewport-height ^FloatBuffer matrix-buffer]
+    ; TODO: use simpler method to construct matrix
     #_(let [ortho-matrix (doto (Matrix4f.)
                              (.ortho2D 0 viewport-width 0 viewport-height))
           matrix-buffer matrix-buffer]
           (.clear matrix-buffer)
-          (.get ortho-matrix matrix-buffer)
-          (.flip matrix-buffer))
+          (.get ortho-matrix matrix-buffer))
     (let [ortho-matrix (doto (Matrix4f.) (.identity))
           matrix-buffer matrix-buffer
           zNear   10
@@ -500,7 +491,7 @@
             ^ByteBuffer bbnil nil]
         (log/info "screen size" screen-width "x" screen-height)
         (try
-          ;; TODO: fix
+          ;; TODO: fix fullscreen
           #_(when-not @fullscreen
             (Display/setDisplayMode (DisplayMode. screen-width screen-height)))
           ;; resize FBO
@@ -559,11 +550,6 @@
         (loop-with-index row [line (reverse @character-map)]
           (loop-with-index col [c line]
             (let [chr        (or (get c :fx-character) (get c :character))
-                  #_#_chr        (if (and (= layer-id base-layer-id)
-                                      (char? chr)
-                                      (= (char chr) (char 0)))
-                                 \space
-                                 chr)
                   highlight  (= @cursor-xy [col (- rows row 1)])
                   [fg-r fg-g fg-b] (if highlight
                                      (or (get c :fx-bg-color)  (get c :bg-color))
@@ -805,7 +791,8 @@
                              line))
                      cm)))))
   (destroy! [_]
-    (reset! destroyed true)))
+    (reset! destroyed true)
+    (async/put! term-chan :close)))

 (defn make-terminal
@@ -964,7 +951,7 @@
                                            (with-gl-context gl-lock window capabilities
                                              (log/info "getting location of uniform" uniform-name)
                                              (let [location (GL20/glGetUniformLocation fb-pgm-id (str uniform-name))]
-                                               #_(assert (not (neg? jocation)) (str "Could not find location for uniform " uniform-name location))
+                                               #_(assert (not (neg? location)) (str "Could not find location for uniform " uniform-name location))
                                                (log/info "got location of uniform" uniform-name location)
                                                location))]))
                                  {}
@@ -1075,6 +1062,7 @@
       (when @fullscreen
         (zat/fullscreen! terminal (first (zat/fullscreen-sizes terminal))))
       ;; Start font file change listener thread
+      ; TODO: fix resource reloader
       #_(cwc/start-watch [{:path "./fonts"
                          :event-types [:modify]
                          :bootstrap (fn [path] (println "Starting to watch " path))
@@ -1093,57 +1081,6 @@
       (GLFW/glfwSetCharCallback window char-callback)
       (GLFW/glfwSetMouseButtonCallback window mouse-button-callback)
       (GLFW/glfwSetCursorPosCallback window cursor-pos-callback)
-      #_(go-loop []
-        (with-gl-context gl-lock window capabilities
-          (try
-            (loop []
-              (when (Keyboard/next)
-                (when (Keyboard/getEventKeyState)
-                  (let [character (Keyboard/getEventCharacter)
-                        key       (Keyboard/getEventKey)]
-                    (convert-key-code character key on-key-fn)))
-                (recur)))
-            (catch Exception e
-              (log/error "Error getting keyboard input" e)))
-          (try
-            (loop []
-              (when (Mouse/next)
-                (let [button (Mouse/getEventButton)
-                      state  (if (Mouse/getEventButtonState) :mousedown :mouseup)
-                      event-x ^int (Mouse/getEventX)
-                      event-y ^int (Mouse/getEventY)
-                      {:keys [screen-height
-                              character-width
-                              character-height]} (get @font-textures (font-key @normal-font))
-                      col    (quot event-x (int character-width))
-                      row    (quot (- (int screen-height) event-y) (int character-height))]
-                  (when (<= 0 button 2)
-                    (async/put! term-chan (case button
-                      0 {:button :left :state state :col col :row row}
-                      1 {:button :right :state state :col col :row row}
-                      2 {:button :middle :state state :col col :row row}))))
-                (recur)))
-            (catch Exception e
-              (log/error "Error getting mouse input" e)))
-          (try
-            (let [{:keys [screen-height
-                          character-width
-                          character-height]} (get @font-textures (font-key @normal-font))
-                  mouse-x ^int (Mouse/getX)
-                  mouse-y ^int (Mouse/getY)
-                  col     (quot mouse-x (int character-width))
-                  row     (quot (- (int screen-height) mouse-y) (int character-height))]
-              (when (not= [col row] @mouse-col-row)
-                (async/>! term-chan {:mouse-leave @mouse-col-row})
-                (reset! mouse-col-row [col row])
-                (async/>! term-chan {:mouse-enter @mouse-col-row})))
-            (catch Throwable e
-              (log/error "Error getting mouse movement" e))))
-        (if @gl-lock
-          (do
-            (Thread/sleep 5)
-            (recur))
-          (on-key-fn :exit)))
       (future
         ;; Wait for Display to be created
         (.await latch)


Don't cache block hash codes.

Don't cache block hash codes.

--- src/blocks/data.clj
+++ src/blocks/data.clj
@@ -31,8 +31,7 @@
    ^long size
    ^Instant stored-at
    content
-   _meta
-   ^:unsynchronized-mutable _hash]
+   _meta]

   :load-ns true

@@ -56,12 +55,9 @@

   (hashCode
     [this]
-    (let [hc _hash]
-      (if (zero? hc)
-        (let [hc (hash [(class this) id size])]
-          (set! _hash hc)
-          hc)
-        hc)))
+    (-> (hash (class this))
+        (hash-combine (hash id))
+        (hash-combine size)))

   java.lang.Comparable
@@ -86,7 +82,7 @@

   (withMeta
     [this meta-map]
-    (Block. id size content stored-at meta-map _hash))
+    (Block. id size content stored-at meta-map))

   clojure.lang.ILookup
@@ -246,7 +242,7 @@
    (when-not content
      (throw (ex-info "Block must have a content reader"
                      {:id id, :size size, :stored-at stored-at})))
-   (Block. id size stored-at content nil 0)))
+   (Block. id size stored-at content nil)))

 (defn load-block
@@ -291,8 +287,7 @@
           (.size right)
           (.stored-at right)
           (.content right)
-          (not-empty (merge (._meta left) (._meta right)))
-          0))
+          (not-empty (merge (._meta left) (._meta right)))))

 (defn wrap-content
@@ -304,5 +299,4 @@
           (.size block)
           (.stored-at block)
           (f (.content block))
-          (._meta block)
-          0))
+          (._meta block)))


testsssss

testsssss

--- markov-clj/test/markov_clj/markov_test.clj
+++ markov-clj/test/markov_clj/markov_test.clj
@@ -7,10 +7,8 @@
 (def corpus (re-seq #"\w+" (slurp "resources/corpus.txt")))

 (def baby-corpus (re-seq #"\w+" (slurp "resources/corpus2.txt")))
-
 (println baby-corpus)
-(build-database baby-corpus 2)
-
+(time (count (build-database corpus 4)))
 (fact "Database is generated properly for small corpus"
   (build-database baby-corpus 3) => {["off" "The"] {"car" 1},
                                      ["jumped" "off"] {"The" 1},
@@ -42,6 +40,11 @@
   )
 ;; The above data generated using clojure.pprint/pprint

-(lookup ["The"] (build-database baby-corpus 2))
+(fact "lookup function behaves properly"
+  (lookup ["The"] (build-database baby-corpus 2)) => {"car" 1, "kid" 1, "sky" 4})
+
+(fact "select randomly function behaves properly"
+  (select-randomly {"foggy" 1, "sunny" 5, "cloudy" 1, "blue" 1}) => (some-checker
+                                                                     "foggy" "sunny" "cloudy" "blue"))

 (create-sentence "The car" (build-database baby-corpus 3))


STORM-859 Add regression test of STORM-856

--- storm-core/test/clj/backtype/storm/nimbus_test.clj
+++ storm-core/test/clj/backtype/storm/nimbus_test.clj
@@ -1180,3 +1180,32 @@
         (is (thrown-cause? InvalidTopologyException
           (submit-local-topology-with-opts nimbus "test" bad-config topology
                                            (SubmitOptions.))))))))
+
+(deftest test-stateless-with-scheduled-topology-to-be-killed
+  ; tests regression of STORM-856
+  (with-inprocess-zookeeper zk-port
+    (with-local-tmp [nimbus-dir]
+      (letlocals
+        (bind conf (merge (read-storm-config)
+                     {STORM-ZOOKEEPER-SERVERS ["localhost"]
+                      STORM-CLUSTER-MODE "local"
+                      STORM-ZOOKEEPER-PORT zk-port
+                      STORM-LOCAL-DIR nimbus-dir}))
+        (bind cluster-state (cluster/mk-storm-cluster-state conf))
+        (bind nimbus (nimbus/service-handler conf (nimbus/standalone-nimbus)))
+        (bind topology (thrift/mk-topology
+                         {"1" (thrift/mk-spout-spec (TestPlannerSpout. true) :parallelism-hint 3)}
+                         {}))
+        (submit-local-topology nimbus "t1" {TOPOLOGY-MESSAGE-TIMEOUT-SECS 30} topology)
+        ; make transition for topology t1 to be killed -> nimbus applies this event to cluster state
+        (.killTopology nimbus "t1")
+        ; shutdown nimbus immediately to achieve nimbus doesn't handle event right now
+        (.shutdown nimbus)
+
+        ; in startup of nimbus it reads cluster state and take proper actions
+        ; in this case nimbus registers topology transition event to scheduler again
+        ; before applying STORM-856 nimbus was killed with NPE
+        (bind nimbus (nimbus/service-handler conf (nimbus/standalone-nimbus)))
+        (.shutdown nimbus)
+        (.disconnect cluster-state)
+        ))))


refactor polling loop for readability

refactor polling loop for readability

--- src/byplay/core.clj
+++ src/byplay/core.clj
@@ -184,13 +184,13 @@
   "Creates a thread which will infinitely call the function with the specified interval."
   [on-poll interval-msec]
   (Thread.
-    #(try
-      (while (not (Thread/interrupted))
-        (on-poll)
-        (Thread/sleep interval-msec))
-
-      ; allow thread to exit on interruption
-      (catch InterruptedException _))))
+    #(while (not (Thread/interrupted))
+      (on-poll)
+
+      (try
+        (Thread/sleep interval-msec)
+        (catch InterruptedException _
+          (.interrupt (Thread/currentThread)))))))

 (defn ^:no-doc -work-threads
   "Creates several working threads."


fixing action facts

fixing action facts

--- test/celestial/integration/persistency/actions.clj
+++ test/celestial/integration/persistency/actions.clj
@@ -8,7 +8,7 @@
   [celestial.persistency.actions :as a])
  (:use midje.sweet))

-(def redis-deploy-provided (assoc redis-deploy :provided nil))
+(def redis-deploy-provided (assoc redis-deploy :provided '()))

 (with-conf
   (with-state-changes [(before :facts (re-initlize))]


Reworded definition of transitive-closure

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -161,24 +161,24 @@

 (defn transitive-closure
   "Computes transitive closure of a given set of pairs."
-  ([set-of-pairs]
-     (transitive-closure set-of-pairs set-of-pairs #{}))
-  ([set-of-pairs new old]
-     (if (= new old)
-       new
-       (recur set-of-pairs
-	      (union new
-		     (set-of [x y]
-			     [[x z_1] (difference new old)
-			      [z_2 y] set-of-pairs
-                             :when (= z_1 z_2)]))
-	      new))))
+  [pairs]
+  (let [pairs  (set pairs),
+        runner (fn runner [new old]
+                 (if (= new old)
+                   new
+                   (recur (union new
+                                 (set-of [x y]
+                                         [[x z_1] (difference new old)
+                                          [z_2 y] pairs
+                                          :when (= z_1 z_2)]))
+                          new)))]
+    (runner pairs #{})))

 (defn reflexive-transitive-closure
   "Computes the reflexive, transitive closure of a given set of pairs
   on base-set."
-  [base-set set-of-pairs]
-  (transitive-closure (union set-of-pairs
+  [base-set pairs]
+  (transitive-closure (union (set pairs)
 			     (set-of [x x] [x base-set]))))

 (defn graph-of-function?


fix it

fix it

--- src/leiningen/new/clanhr_service/routes.clj
+++ src/leiningen/new/clanhr_service/routes.clj
@@ -52,7 +52,7 @@
   "Gets the port to run the service"
   []
   (or (get (System/getenv) "PORT")
-      (get (System/getenv) "CLANHR_{{upper-and-sanitized-name}}_PORT")
+      (get (System/getenv) "CLANHR_{{upper-and-sanitized-name}}_API_PORT")
       "5000"))

 (defn -main [& args]


Improved the way how first day of range is determined

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -246,6 +246,9 @@
   (+ previous-number
      (count day-ranges)
      (if (= previous-type :day) -1 0)))
+
+(defn- get-first-day [cycle-number cycle-type]
+  (+ cycle-number (if (= cycle-type :day) 0 1)))

 (defn- scan-votes [player-message-maps hosts first-index cycle-number cycle-type]
   (let [first-page-index (inc (* (quot (dec first-index) POSTS-PER-PAGE) POSTS-PER-PAGE))
@@ -262,8 +265,9 @@
     {:cycle-number (last-cycle-number cycle-number cycle-type day-ranges)
      :last-index (-> indexed (last) (first) (#(if % % first-index)))
      :cycle-type last-cycle-type
-     :votes (days-into-votes (range (max cycle-number 1) (+ cycle-number (count day-ranges) 1))
-                      (map #(get-votes-in-range indexed %) day-ranges))}))
+     :votes (days-into-votes (range (get-first-day cycle-number cycle-type)
+                                    (+ cycle-number (count day-ranges) 1))
+                             (map #(get-votes-in-range indexed %) day-ranges))}))

 (defn scan-all-votes-after [url hosts first-index cycle-number cycle-type]
   (let [player-message-maps (get-player-message-maps url first-index)


See if this makes the test more reliable.

--- messaging/test/immutant/messaging_test.clj
+++ messaging/test/immutant/messaging_test.clj
@@ -199,8 +199,10 @@
           [:username "testuser" :password "testuser" :remote-type :hornetq-wildfly])]
     (with-open [c (apply connection :host "localhost" :port (u/messaging-remoting-port)
                     extra-connect-opts)]
-      (let [start (System/currentTimeMillis)
-            q (queue "remote" :connection c)]
+      (let [q (queue "remote" :connection c)
+            start (System/currentTimeMillis)]
+        ;; warm up the connection
+        (receive q :timeout 1)
         (is (= :success (receive q :timeout 100 :timeout-val :success)))
         (is (< (- (System/currentTimeMillis) start) 200))))))


fix broken --config-merge CLI

fix broken --config-merge CLI

--- src/main/shadow/cljs/devtools/cli_opts.cljc
+++ src/main/shadow/cljs/devtools/cli_opts.cljc
@@ -22,7 +22,7 @@
    ;; don't actually need to parse this on the npm side
    ;; since it never compiles anything
    (defn parse-merge-data [edn-str]
-     edn-str)
+     {})

    :clj
    (defn parse-merge-data [edn-str]


improve test

improve test

--- test/chess/board_test.clj
+++ test/chess/board_test.clj
@@ -127,7 +127,7 @@
          moves-from-idx (filter #(= (to-idx square) (% :from)) all-valid-moves)]
      (set (map #(to-sqr (% :to)) moves-from-idx)))))

-(deftest test-attacked-indexes-on-empty-board
+(deftest test-find-moves-on-empty-board
   (testing "king on empty board"
     (is (= #{:d5 :e4 :d3 :c4 :e5 :e3 :c3 :c5} (accessible-squares :K :d4)))
     (is (= #{:a2 :b1 :b2} (accessible-squares :k :a1))))
@@ -151,7 +151,7 @@
     (is (= #{:g6 :g5} (accessible-squares :p :g7)))
     (is (= #{:g8} (accessible-squares :P :g7)))))

-(deftest test-attacked-indexes-on-non-empty-board
+(deftest test-find-moves-on-non-empty-board
   (testing "king on non-empty board"
     (is (= #{:d5 :d3 :c4 :e5 :e3 :c3} (accessible-squares :K :d4 [:Q :e4 :R :c5 :b :d3])))
     (is (= #{:d1 :d2 :e2 :f2 :f1} (accessible-squares :K :e1 [:R :a1 :R :h1]))))
@@ -168,7 +168,8 @@
     (is (= #{:a5} (accessible-squares :P :a4 [:B :b5])))
     (is (= #{:e3} (accessible-squares :P :e2 [:b :e4])))
     (is (= #{} (accessible-squares :p :h7 [:p :h6])))
-    (is (= #{:d6 :f6} (accessible-squares :p :e7 [:N :e6 :Q :f6 :R :d6])))))
+    (is (= #{:d6 :f6} (accessible-squares :p :e7 [:N :e6 :Q :f6 :R :d6])))
+    (is (= #{:d6 :f6 :e6 :e5} (accessible-squares :p :e7 [:N :d6 :Q :f6])))))

 (deftest test-find-castlings
   (testing "passage is free"


Re-organise coordinator state data structure.

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -60,10 +60,8 @@
                          (map second))
           new-remaining (sequence offer-xf (:remaining barrier))]
       (if (empty? new-remaining)
-        (-> state
-            (assoc :checkpoint-version nil)
-            (update :barrier merge {:remaining nil
-                                    :offering? false}))
+        (update state :barrier merge {:remaining nil
+                                      :offering? false})
         (do
          ;; sleep for two milliseconds before retrying the offer
          (LockSupport/parkNanos (* 2 1000000))
@@ -105,8 +103,8 @@
                                         :remaining (m/publishers new-messenger)
                                         :opts {:recover-coordinates coordinates}})
                 (update :checkpoint merge {:epoch 0})
-                (assoc :curr-replica new-replica
-                       :messenger new-messenger)))
+                (assoc :messenger new-messenger)
+                (assoc :curr-replica new-replica)))

           :else
           (assoc state :curr-replica new-replica))))
@@ -117,7 +115,6 @@
         replica-version (m/replica-version messenger)
         epoch (m/epoch messenger)]
     (let [coordinates {:tenancy-id tenancy-id :job-id job-id :replica-version replica-version :epoch epoch}
-          _ (assert (:write-version checkpoint))
           next-write-version (write-coordinate (:write-version checkpoint) log tenancy-id job-id coordinates)]
       (-> state
           (complete-job! job-id)
@@ -164,22 +161,21 @@
                        :epoch checkpointed-epoch}
           ;; get the next version of the zk node, so we can detect when there are other writers
           write-version (:write-version checkpoint)
-          _ (assert write-version)
           next-write-version (if write-coordinate?
                                (write-coordinate write-version log tenancy-id job-id coordinates)
                                write-version)
           checkpoint? (first (shuffle [true #_false]))
           messenger (m/set-epoch! messenger (inc (m/epoch messenger)))]
       (-> state
-          (update :checkpoint merge {:epoch (if checkpoint? (m/epoch messenger) (:epoch checkpoint))
+          (update :checkpoint merge {:initiated? true
+                                     :epoch (if checkpoint? (m/epoch messenger) (:epoch checkpoint))
                                      :write-version next-write-version})
           (update :barrier merge {:scheduled false
                                   :offering? true
                                   :remaining (m/publishers messenger)
                                   :opts {:completed? (:sealing? (:job state))
                                          :checkpoint? checkpoint?}})
-          (assoc :checkpointing? checkpoint?
-                 :messenger messenger)))))
+          (assoc :messenger messenger)))))

 (defn shutdown [{:keys [peer-config log workflow-depth job-id messenger] :as state}]
   (assoc state :messenger (component/stop messenger)))
@@ -192,28 +188,23 @@
         (assoc-in [:checkpoint :write-version] write-version)
         (assoc :last-heartbeat-time (System/nanoTime)))))

-(defn checkpointing? [state status]
+(defn checkpointing? [{:keys [initiated? epoch] :as state} status]
   (and ;; we've initiated a snapshot
-       (:checkpointing? state)
+       initiated?
        ;; none of the statuses are saying they're checkpointing
        (or (:checkpointing? status)
            ;; and they are all at least up to the checkpoint barrier
            ;; which means that we are not getting a stale status
-           (< (:min-epoch status)
-               (:epoch (:checkpoint state))))))
+           (< (:min-epoch status) epoch))))

 (defn coordinator-iteration
-  [{:keys [messenger last-heartbeat-time next-barrier-time allocation-ch shutdown-ch peer-config barrier job] :as state}
+  [{:keys [messenger last-heartbeat-time  allocation-ch shutdown-ch peer-config barrier job] :as state}
    coordinator-max-sleep-ns
    barrier-period-ns
    heartbeat-ns]
-  (println "COORDINATOR ITERATION STATE" barrier job)
   (let [_ (run! pub/poll-heartbeats! (m/publishers messenger))
         status (merged-statuses messenger)
         {:keys [sealing? completed?]} job]
-    (assert (not (nil? sealing?)))
-    (assert (not (nil? completed?)))
-    ;(println "COORDINATOR STATUS" status (m/replica-version messenger) (m/epoch messenger) :sealing? (:sealing? state))
     (cond (> (System/nanoTime) (+ last-heartbeat-time heartbeat-ns))
           ;; Immediately offer heartbeats
           (offer-heartbeats state)
@@ -222,7 +213,7 @@
           ;; Continue offering barriers until success
           (offer-barriers state)

-          (and sealing? (not (checkpointing? state status)))
+          (and sealing? (not (checkpointing? (:checkpoint state) status)))
           (complete-job state)

           (or completed? sealing?
@@ -236,15 +227,15 @@
           ;; emit final completion barrier
           (periodic-barrier (assoc-in state [:job :sealing?] true))

-          (and (:scheduled? barrier) (> (System/nanoTime) next-barrier-time))
+          (and (:scheduled? barrier) (> (System/nanoTime) (:next-barrier-time barrier)))
           (periodic-barrier state)

           (and (not (:scheduled? barrier))
-               (not (checkpointing? state status)))
+               (not (checkpointing? (:checkpoint state) status)))
           (-> state
-              (assoc-in [:barrier :scheduled?] true)
-              (assoc :next-barrier-time (+ (System/nanoTime) barrier-period-ns)
-                     :checkpointing? false))
+              (update :barrier {:scheduled? true
+                                :next-barrier-time (+ (System/nanoTime) barrier-period-ns)})
+              (assoc-in [:checkpoint :initiated?] false))

           :else
           (do
@@ -261,7 +252,6 @@
           barrier-period-ns (ms->ns (arg-or-default :onyx.peer/coordinator-barrier-period-ms peer-config))
           heartbeat-ns (ms->ns (arg-or-default :onyx.peer/heartbeat-ms peer-config))
           result (loop [state (initialise-state state)]
-                   (assert (:write-version (:checkpoint state)))
                    (if-let [scheduler-event (poll! shutdown-ch)]
                      (do (shutdown (assoc state :scheduler-event scheduler-event))
                          :shutdown)


Exempt input tasks from running ackers, bump acker percentages to 20.

--- src/onyx_benchmark/submit.clj
+++ src/onyx_benchmark/submit.clj
@@ -92,5 +92,7 @@
       {:catalog catalog
        :workflow workflow
        :lifecycles lifecycles
+       :acker/percentage 20
+       :acker/exempt-input-tasks? true
        :task-scheduler :onyx.task-scheduler/balanced})))


[#9686] Fix brief change of identiocon on keycard login

--- src/status_im/ui/screens/keycard/views.cljs
+++ src/status_im/ui/screens/keycard/views.cljs
@@ -13,7 +13,8 @@
             [status-im.utils.core :as utils.core]
             [status-im.ui.components.list-item.views :as list-item]
             [status-im.ui.screens.chat.photos :as photos]
-            [status-im.ui.components.topbar :as topbar]))
+            [status-im.ui.components.topbar :as topbar]
+            [reagent.core :as reagent]))

 (defn welcome []
   [react/view {:flex            1
@@ -217,6 +218,20 @@
        [react/text {:style {:color colors/blue}}
         (i18n/label :t/ok-got-it)]]]]]])

+(defn photo [_ _]
+  (reagent/create-class
+   {:should-component-update
+    (fn [_ [_ old-account] [_ new-account]]
+      (and (not (nil? new-account))
+           (and (not (:photo-path old-account))
+                (nil? (:photo-path new-account)))))
+
+    :reagent-render
+    (fn [account small-screen?]
+      ;;TODO this should be done in a subscription
+      [photos/photo (multiaccounts/displayed-photo account)
+       {:size (if small-screen? 45 61)}])}))
+
 (defview login-pin []
   (letsubs [pin [:hardwallet/pin]
             enter-step [:hardwallet/pin-enter-step]
@@ -251,8 +266,7 @@
                       :height          (if small-screen? 50 69)
                       :justify-content :center
                       :align-items     :center}
-          ;;TODO this should be done in a subscription
-          [photos/photo (multiaccounts/displayed-photo account) {:size (if small-screen? 45 61)}]
+          [photo account small-screen?]
           [react/view {:justify-content  :center
                        :align-items      :center
                        :width            (if small-screen? 18 24)


insights: change text of "no builds"

insights: change text of "no builds"

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -242,7 +242,7 @@
         [:h1 (gstring/format "%s/%s" username reponame)]
         [:h4 "Branch: " branch]
         (cond (nil? recent-builds) [:div.loading-spinner common/spinner]
-              (empty? builds) [:div.no-builds "No builds."]
+              (empty? builds) [:div.no-builds "No tests for this repo"]
               :else
               (list
                [:div.above-info


Align chart bars to the *right* of the chart

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -57,9 +57,7 @@
                                    (map #(->> builds
                                               (map %)
                                               (apply max))))
-        y-zero (->> [:height :positive-y%]
-                    (map plot-info)
-                    (apply *))
+        y-zero (apply * ((juxt :height :positive-y%) plot-info))
         y-pos-scale (-> (js/d3.scale.linear)
                         (.domain #js[0 y-pos-max])
                         (.range #js[y-zero 0]))
@@ -67,7 +65,7 @@
                         (.domain #js[0 y-neg-max])
                         (.range #js[y-zero (:height plot-info)]))
         y-pos-floored-max (datetime/nice-floor-duration y-pos-max)
-        y-pos-tick-values (list y-pos-floored-max 0)
+        y-pos-tick-values [y-pos-floored-max 0]
         y-neg-tick-values [(datetime/nice-floor-duration y-neg-max)]
         [y-pos-axis y-neg-axis] (for [[scale tick-values] [[y-pos-scale y-pos-tick-values]
                                                            [y-neg-scale y-neg-tick-values]]]
@@ -78,13 +76,12 @@
                                       (.tickFormat #(first (datetime/millis-to-float-duration % {:decimals 0})))
                                       (.tickSize 0 0)
                                       (.tickPadding 3)))
-        scale-filler (->> (list (:max-bars plot-info) (count builds))
-                          (apply -)
+        scale-filler (->> (- (:max-bars plot-info) (count builds))
                           range
                           (map (partial str "xx-")))
         x-scale (-> (js/d3.scale.ordinal)
                     (.domain (clj->js
-                              (concat (map :build_num builds) scale-filler)))
+                              (concat scale-filler (map :build_num builds))))
                     (.rangeBands #js[0 (:width plot-info)] 0.4))
         plot (-> js/d3
                  (.select el)


better automated doc chat message with more info

--- src-cljs/frontend/components/chat.cljs
+++ src-cljs/frontend/components/chat.cljs
@@ -181,12 +181,17 @@
             chat-bot (:document/chat-bot (d/entity @db (ffirst (d/q '[:find ?t :where [?t :document/name]] @db))))
             dummy-chat {:chat/body [:span
                                     "Welcome to Precursor! "
-                                    "Create fast prototypes and share your url to collaborate. "
-                                    "Chat "
-                                    [:a {:on-click #(cast! :chat-user-clicked {:id-str (:chat-bot/name chat-bot)})
-                                         :role "button"}
-                                     (str "@" (:chat-bot/name chat-bot))]
-                                    " for help."]
+                                    [:br]
+                                    "Check out "
+                                    [:a {:href "/document/17592197661008" :target "_blank"}
+                                     "how to doc"]
+                                    " and what's "
+                                    [:a {:href "/blog/ideas-are-made-with-precursor" :target "_blank"}
+                                     "made with Precursor"]
+                                    " or just "
+                                    [:a {:on-click #(cast! :chat-user-clicked {:id-str (:chat-bot/name chat-bot)}) :role "button"}
+                                     "ask us anything"]
+                                    "!"]
                         :cust/uuid (:cust/uuid state/subscriber-bot)
                         :server/timestamp (js/Date.)}]
         (html


- fix winning screen not appearing at end

--- src/app/cljs/one/sample/animation.cljs
+++ src/app/cljs/one/sample/animation.cljs
@@ -728,7 +728,7 @@
              background (doto (CAAT/Actor.)
                           (.setBackgroundImage (.getImage director "room")))
              object-count 7
-             counter (gen-count-actor object-count :on-total-reached (fn [e] (add! scene (gen-winning-screen director))))
+             counter (gen-count-actor object-count :on-total-reached (fn [e] (add! scene (gen-winning-screen scene))))
              basket (gen-basket director :x 440 :y 240)
              objects (map (fn [index object]
                             ;; make sure to pass mouse events to the basket


small cosmetic change

small cosmetic change

--- src/clj_ldap/client.clj
+++ src/clj_ldap/client.clj
@@ -272,9 +272,7 @@
         (if (and
               (not-nil? control)
               (> (.getValueLength (.getCookie control)) 0))
-          (recur
-            newres
-            (.getCookie control))
+          (recur newres (.getCookie control))
           (seq newres))))))

 (defn- search-results