#5 - More precise state management. Also error handling.

--- src/bible/io.cljs
+++ src/bible/io.cljs
@@ -24,26 +24,121 @@
 (defprotocol ResourceStore
   (get-resource [this resid cb] "The cb should have this signature: (fn [{content :content err :err}] ...)."))

-(defn ^:private url-from-resid [state resid]
-  (let [short-hash (get-in state [:hash resid])]
+(defn set-resource-store [store]
+  (swap! state #(assoc % :store store)))
+
+(defmulti resource-event #(:type %))
+
+(defn ^:private url-from-resid [resid-map resid]
+  (let [short-hash (get resid-map resid)]
     (str "/" resid "-" short-hash ".d")))

 (deftype XhrManagerSource [mgr]
   ResourceStore
   (get-resource [this resid cb]
-    (let [url (url-from-resid @state resid)
-          on-response
+    (let [url (url-from-resid (:hash @state) resid)
+          reader (t/reader :json)
+          parse-body
             (fn [e]
-              (cb {:content (.getResponseText (obj/get e "target"))}))]
+              (let [target (obj/get e "target")]
+                (if (.isSuccess target)
+                  (try
+                    {:content
+                      (t/read reader (.getResponseText target))}
+                    (catch js/Object e
+                      {:err {:ex e}}))
+                  {:err {:status (.getStatus target)
+                         :statusText (.getStatusText target)}})))
+          on-response (fn [e] (cb (parse-body e)))]
       (.send mgr resid url "GET" nil nil 1 on-response))))

-(defn set-resource-store-to-xhr-manager []
-  (swap! state #(assoc % :store (XhrManagerSource. (goog.net.XhrManager. 3 nil nil nil 10000)))))
+(defn make-xhr-manager []
+  (XhrManagerSource. (goog.net.XhrManager. 3 nil nil nil 10000)))

 (defn ^:export set-resource-ids [resid-map]
   (if (object? resid-map)
     (recur (js->clj resid-map))
     (swap! state #(assoc % :hash resid-map))))
+
+(defn ^:private post-msg [eventloop msg] (put! eventloop msg))
+
+(defn ^:private fetch-resource-from-store [resid response-ch m cb-ch store eventloop]
+  (let [cb (fn [{content :content err :err}]
+             (post-msg eventloop
+               {:type :response
+                :resid resid
+                :content content
+                :err err
+                :chan cb-ch}))]
+    (tap m response-ch)
+    (get-resource store resid cb)))
+
+(defmethod resource-event :fetch [{resid :resid response-ch :response-ch}]
+  (loop [st @state]
+    (if-let [v (get-in st [:cache resid])]
+      (put! response-ch {:resid resid :val v})
+      (if-let [m (get-in st [:pending resid])]
+        (tap m response-ch)
+        (let [ch        (chan 1)
+              m2        (mult ch)
+              st2       (assoc-in st [:pending resid] m2)
+              store     (:store st2)
+              eventloop (:eventloop st2)]
+          (if (compare-and-set! state st st2)
+            (fetch-resource-from-store resid response-ch m2 ch store eventloop)
+            (recur @state)))))))
+
+(defmethod resource-event :response [{resid :resid data :content err :err ch :chan}]
+  (if err
+    (do
+      (swap! state (fn [st] (update-in st [:pending] #(dissoc % resid))))
+      (put! ch {:resid resid :err err}))
+    (do
+      (swap! state
+        (fn [st]
+          (-> st
+            (update-in [:pending] #(dissoc % resid))
+            (update-in [:cache] #(assoc % resid data)))))
+      (put! ch {:resid resid :val data}))))
+
+(defn ^:private fetch-resource [resid eventloop]
+  (let [ch (chan 1)]
+    (post-msg eventloop
+      {:type :fetch
+       :resid resid
+       :response-ch ch})
+    ch))
+
+(defn ^:private resource-loop []
+  (go-loop [msg (<! (:eventloop @state))]
+    (resource-event msg)
+    (recur (<! (:eventloop @state)))))
+
+(defn ^:private split-pending [resids cache eventloop]
+  (loop [ret {}
+         pending {}
+         ids (seq resids)]
+    (if ids
+      (let [id (first ids)
+            rst (seq (next ids))
+            entry (find cache id)]
+        (if entry
+          (recur (conj ret entry) pending rst)
+          (recur ret (conj pending [id (fetch-resource id eventloop)]) rst)))
+      [ret pending])))
+
+(defn ^:private park-while-pending [[ret pending]]
+  (go-loop [ret ret
+            pending pending]
+    (if (> (count pending) 0)
+      (let [d (alts! (vec (vals pending)))
+            [{resid :resid v :val err :err} _] d]
+        (if err
+          {:err err}
+          (recur
+            (assoc ret resid v)
+            (dissoc pending resid))))
+      ret)))

 (defn tryget-resources
   ([resids]
@@ -58,83 +153,16 @@
           nil)
         ret))))

-(defn ^:private post-msg
-  ([msg] (post-msg (:eventloop @state) msg))
-  ([eventloop msg] (put! eventloop msg)))
+(defn resources [resids]
+  (let [st @state
+        cache (:cache st)
+        eventloop (:eventloop st)]
+    (->>
+      (split-pending resids cache eventloop)
+      (park-while-pending))))

-(defmulti resource-event #(:type %))
-
-(defn ^:private do-fetch-resource [resid response-ch]
-  (let [ch (chan 1)
-        m (mult ch)
-        url (url-from-resid @state resid)
-        cb (fn [{content :content err :err}]
-            (post-msg {:type :response
-                       :resid resid
-                       :content content
-                       :chan ch}))]
-    (swap! state #(assoc-in % [:pending resid] m))
-    (tap m response-ch)
-    (get-resource (:store @state) resid cb)))
-
-(defmethod resource-event :fetch [{resid :resid response-ch :response-ch}]
-  (if-let [v (get-in @state [:cache resid])]
-    (put! response-ch {:resid resid :val v})
-    (if-let [m (get-in @state [:pending resid])]
-      (tap m response-ch)
-      (do-fetch-resource resid response-ch))))
-
-(defmethod resource-event :response [{resid :resid content :content ch :chan}]
-  (let [reader (t/reader :json)
-        data   (t/read reader content)]
-    (swap! state
-      (fn [st]
-        (-> st
-          (update-in [:pending] #(dissoc % resid))
-          (update-in [:cache] #(assoc % resid data)))))
-    (put! ch {:resid resid :val data})))
-
-(defn ^:private resource-loop []
-  (go-loop [msg (<! (:eventloop @state))]
-    (resource-event msg)
-    (recur (<! (:eventloop @state)))))
-
-(defn ^:private fetch-resource [resid]
-  (let [ch (chan 1)]
-    (post-msg
-      {:type :fetch
-       :resid resid
-       :response-ch ch})
-    ch))
-
-(defn ^:private split-pending [res resids]
-  (loop [ret {}
-         pending {}
-         ids (seq resids)]
-    (if ids
-      (let [id (first ids)
-            rst (seq (next ids))
-            entry (find res id)]
-        (if entry
-          (recur (conj ret entry) pending rst)
-          (recur ret (conj pending [id (fetch-resource id)]) rst)))
-      [ret pending])))
-
-(defn ^:private park-while-pending [[ret pending]]
-  (go-loop [ret ret
-            pending pending]
-    (if (> (count pending) 0)
-      (let [[{resid :resid v :val} _] (alts! (vec (vals pending)))]
-        (recur
-          (assoc ret resid v)
-          (dissoc pending resid)))
-      ret)))
-
-(defn resources [resids]
-  (->>
-    (split-pending (:cache @state) resids)
-    (park-while-pending)))
+;; default configuration
+(set-resource-store (make-xhr-manager))

 ;; fire up the event loop
-(set-resource-store-to-xhr-manager)
 (resource-loop)


Add test cases for problems that have 'value change' in them

--- test/pinpointer/trace_test.cljc
+++ test/pinpointer/trace_test.cljc
@@ -5,6 +5,8 @@

 (defmulti shape-spec :type)
 (s/def ::shape (s/multi-spec shape-spec :type))
+
+(s/def ::id integer?)

 (deftest trace-test
   (are [spec input expected]
@@ -35,4 +37,46 @@
     [[[{:spec `(s/multi-spec shape-spec :type)
         :val {:type :circle}
         :steps []
-        :reason "no method"}]]]))
+        :reason "no method"}]]]
+
+    (s/and string?
+           (s/conformer seq)
+           (s/coll-of #{\a \b \c}))
+    "abcdab"
+    [[[{:spec `(s/and string?
+                      (s/conformer seq)
+                      (s/coll-of #{\a \b \c}))
+        :val "abcdab"
+        ;; TODO: the following field value looks somewhat weird,
+        ;; so we may need to reconsider the result spec in the future
+        :steps [3]}]
+      [{:spec `(s/and string?
+                      (s/conformer seq)
+                      (s/coll-of #{\a \b \c}))
+        :val '(\a \b \c \d \a \b)
+        :steps []}
+       {:spec `(s/coll-of #{\a \b \c})
+        :val '(\a \b \c \d \a \b)
+        :steps [3]}
+       {:spec #{\a \b \c} :val \d :steps []}]]]
+
+    (s/and (s/map-of ::id (s/keys :req-un [::id]))
+           (s/coll-of (s/spec (fn [[id m]] (= id (:id m))))))
+    {1 {:id 1} 2 {:id 3}}
+    [[[{:spec `(s/and (s/map-of ::id (s/keys :req-un [::id]))
+                      (s/coll-of
+                        (s/spec (fn [[~'id ~'m]] (= ~'id (:id ~'m))))))
+        :val {1 {:id 1} 2 {:id 3}}
+        :steps []}
+       {:spec `(s/coll-of (s/spec (fn [[~'id ~'m]] (= ~'id (:id ~'m)))))
+        :val {1 {:id 1} 2 {:id 3}}
+        :steps [1]}]
+      [{:spec `(s/coll-of (s/spec (fn [[~'id ~'m]] (= ~'id (:id ~'m)))))
+        :val [[1 {:id 1}] [2 {:id 3}]]
+        :steps [1]}
+       {:spec `(s/spec (fn [[~'id ~'m]] (= ~'id (:id ~'m))))
+        :val [2 {:id 3}]
+        :steps []}
+       {:spec `(fn [[~'id ~'m]] (= ~'id (:id ~'m)))
+        :val [2 {:id 3}]
+        :steps []}]]]))


Effective function configurations dump #86 (#87)

* Effective function configurations dump #86

* Merge dump-configs! into dump-config task

--- plugin/src/leiningen/cljs_lambda.clj
+++ plugin/src/leiningen/cljs_lambda.clj
@@ -1,6 +1,7 @@
 (ns leiningen.cljs-lambda
   (:require [clojure.java.io     :as io]
             [clojure.string      :as str]
+            [cheshire.core :as json]
             [leiningen.core.main :as main]
             [leiningen.core.eval :as eval]
             [leiningen.cljs-lambda.zip-tedium :refer [write-zip]]
@@ -181,6 +182,14 @@
   [{:keys [cljs-lambda] :as project}]
   (aws/update-configs! cljs-lambda))

+(defn dump-config
+  "Dump effective function configs"
+  [{{:keys [keyword-args] :as cljs-lambda} :cljs-lambda}]
+  (-> cljs-lambda
+      (select-keys [:functions])
+      (json/generate-string (select-keys keyword-args [:pretty]))
+      println))
+
 (defn invoke
   "Invoke the named Lambda function"
   [{{:keys [positional-args] :as cljs-lambda} :cljs-lambda}]
@@ -209,18 +218,19 @@
    "deploy" deploy
    "invoke" invoke
    "default-iam-role" default-iam-role
-   "update-config"    update-config})
+   "update-config"    update-config
+   "dump-config"      dump-config})

 (defn cljs-lambda
   "Build & deploy AWS Lambda functions"
-  {:help-arglists '([alias build deploy update-config invoke default-iam-role])
-   :subtasks [#'create-alias #'build #'deploy #'update-config #'invoke #'default-iam-role]}
+  {:help-arglists '([alias build deploy update-config dump-config invoke default-iam-role])
+   :subtasks [#'create-alias #'build #'deploy #'update-config #'dump-config #'invoke #'default-iam-role]}

   ([project] (println (leiningen.help/help-for cljs-lambda)))

   ([project subtask & args]
    (if-let [subtask-fn (task->fn subtask)]
-     (let [[pos kw]    (args/split-args args #{:publish :quiet :managed-deps :print-files})
+     (let [[pos kw]    (args/split-args args #{:publish :quiet :managed-deps :print-files :pretty})
            [kw quiet]  [(dissoc kw :quiet) (kw :quiet)]
            project     (augment-project project pos kw)
            meta-config (-> project :cljs-lambda :meta-config)]


Use update.

Use update.

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -10,12 +10,12 @@
   (:require [cake.classloader :as classloader]))

 (defn- add-global-plugins [project]
-  (update-in project
-             [:dependencies]
-             merge
-             (filter-vals
-              (-> "project.clj" global-file read-project :dependencies)
-              :plugin)))
+  (update project
+          :dependencies
+          merge
+          (filter-vals
+           (-> "project.clj" global-file read-project :dependencies)
+           :plugin)))

 (defmacro defproject [& opts]
   `(let [project# '~(add-global-plugins (apply create-project opts))]


* map.cljs (addmarkers): Use destructuring.

--- src/cljs/map.cljs
+++ src/cljs/map.cljs
@@ -55,10 +55,7 @@
           (let [a (<! ch)]
             (macros/rpc
              (get-marker a dbb) [p]
-             (let [lat (first (first p))
-                   lng (last (first p))
-                   img (nth p 1)
-                   title (last p)
+             (let [[[lat lng] img title] p
                    icon ((get-in L [:mapbox :marker :icon])
                          {:marker-symbol ""
                           :marker-color (if img "FF0000" "0044FF")})


getting rid of system exit when trying to start a second server with similar port

--- sidecar/src/figwheel_sidecar/components/figwheel_server.clj
+++ sidecar/src/figwheel_sidecar/components/figwheel_server.clj
@@ -120,8 +120,7 @@
                         (assoc config :ip server-ip)
                         config))))
     (catch java.net.BindException e
-      (println "Port" server-port "is already being used. Are you running another Figwheel instance? If you want to run two Figwheel instances add a new :server-port (i.e. :server-port 3450) to Figwheel's config options in your project.clj")
-      (System/exit 0))))
+      (println "Port" server-port "is already being used. Are you running another Figwheel instance? If you want to run two Figwheel instances add a new :server-port (i.e. :server-port 3450) to Figwheel's config options in your project.clj"))))

 (defn append-msg [q msg] (conj (take 30 q) msg))


improve logging

improve logging

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -80,10 +80,10 @@
                         (add-complements-to-bolts [:head :comp])
                         (add-complements-to-bolts [:comp])))))))

-(defn lexemes-before-phrases []
-  ;; TODO: take depth as an argument; make phrases decreasingly likely as depth increases.
-  (let [result (= (rand-int 3) 0)]
-    (log/debug (str "lexemes-before-phrases => " result))
+(defn lexemes-before-phrases [depth]
+  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
+  (let [result (> (rand-int (+ 1 depth)) 0)]
+    (log/debug (str "lexemes-before-phrases: depth=" depth " => " result))
     result))

 ;; TODO: add usage of rule-to-lexicon cache (rather than using lexicon directly)


making public resources servable via the ring application

--- src/bitfondue/handler.clj
+++ src/bitfondue/handler.clj
@@ -4,7 +4,8 @@
   (:use [ring.adapter.jetty :as ring]))

 (defroutes app-routes
-  (GET "/" [] "Success!"))
+  (GET "/" [] "Success!")
+  (route/resources "/"))

 (def app app-routes)


sort select-keys keys in braid config

sort select-keys keys in braid config

--- src/braid/server/conf.clj
+++ src/braid/server/conf.clj
@@ -7,18 +7,18 @@
   (merge {:db-url "datomic:free://localhost:4334/braid"
           :api-domain (str "localhost:" (+ 2 (:port (mount/args))))}
          (select-keys env
-                      [:mailgun-domain
-                       :mailgun-password
-                       :site-url
-                       :hmac-secret
+                      [:api-domain
+                       :asana-client-id
+                       :asana-client-secret
+                       :aws-access-key
                        :aws-domain
-                       :aws-access-key
                        :aws-secret-key
                        :db-url
+                       :embedly-key
                        :environment
+                       :hmac-secret
+                       :mailgun-domain
+                       :mailgun-password
                        :s3-upload-key
                        :s3-upload-secret
-                       :asana-client-id
-                       :asana-client-secret
-                       :embedly-key
-                       :api-domain])))
+                       :site-url])))


Use insert instead of save when adding a user.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -26,7 +26,7 @@
   (mc/find-one-as-map "users" {:username username}))

 (defn add-user [user]
-  (mc/save "users"
+  (mc/insert "users"
            (assoc (select-keys
                     user
                     (for [[k v] user :when (vali/has-value? v)] k))


make it possible to diagnose mixpanel errors

--- src/pc/mixpanel.clj
+++ src/pc/mixpanel.clj
@@ -57,7 +57,7 @@
                                                            :verbose 1}})
         success? (-> resp :body json/decode (get "status") (= 1))]
     (when (or (-> resp :status (not= 200)) (not success?))
-      (throw+ resp))
+      (throw+ (assoc resp :mixpanel-data data)))
     resp))

 (defn api-call [url data]


Grab the product number out of the marc21

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -44,6 +44,7 @@
    :genre-raw [:datafield (attr= :tag "099") :subfield (attr= :code "b")]
    :genre-code [:datafield (attr= :tag "099") :subfield (attr= :code "a")] ; used for movie genre i.e. Filmkategorie
    :library-signature [:datafield (attr= :tag "091") :subfield (attr= :code "a")] ; Signaturen
+   :product-number [:datafield (attr= :tag "024") :subfield (attr= :code "a")] ; MVL-Bestellnummer
    :price [:datafield (attr= :tag "024") :subfield (attr= :code "c")] ; Preis
    :game_category [:datafield (attr= :tag "024") :fixme] ; Spiel-Systematikgruppe
    :game_description [:datafield (attr= :tag "300") :subfield (attr= :code "a")] ; Beschreibung von Spielen


Handle forced newlines better.

Handle forced newlines better.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -5,7 +5,7 @@
             [clojure.tools.reader.reader-types :as rt]
             [clojure.pprint :refer [pprint]]))

-(def OUT-WIDTH 50)
+(def OUT-WIDTH 80)

 (defn word-wrap [width s] ; Returns a sequence of strings from word-wrapping s.
   (re-seq (re-pattern (str ".{0," width "}\\s")) (str s " ")))
@@ -72,7 +72,7 @@
                forms))

 (defn cvt-fn [params body]
-  ["func" (cvt-fn-params params) "{" (cvt-fn-body params body) "}"])
+  ["func" (cvt-fn-params params) "{\n" (cvt-fn-body params body) "}\n"])

 (defn cvt-defn [name params body]
   ["func" (cvt-sym name) (rest (cvt-fn params body))])
@@ -100,7 +100,7 @@
     (let [oline (first olines)
           [i sline] (first slines)]
       (when (or oline sline)
-        (do (println (ljust OUT-WIDTH (or oline ""))
+        (do (println (ljust OUT-WIDTH (string/replace (or oline "") "\n" ""))
                      (when sline (str "// " i " " sline)))
             (recur (rest olines) (rest slines)))))))


adding yaml

adding yaml

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -5,11 +5,11 @@
         [metrics.ring.expose :only  (expose-metrics-as-json)]
         [metrics.ring.instrument :only  (instrument)]
         [ring.middleware.edn :only (wrap-edn-params)]
-        [clj-yaml.core :only (generate-string parse-string)]
         [ring.adapter.jetty :only (run-jetty)]
         [taoensso.timbre :only (debug info error warn set-config!)]
         [celestial.jobs :only (enqueue initialize-workers clear-all)])
   (:require
+    [clj-yaml.core :as yaml ]
     [celestial.persistency :as p]
     [celestial.jobs :as jobs]
     [compojure.handler :as handler]
@@ -47,11 +47,12 @@
   (GET "/host/machine/:h" [h]
        (generate-response (p/host h)))
   (GET "/host/type/:h" [h]
-       (generate-response (p/type (:type (p/host h)))))
+       (yaml/generate-string (select-keys (p/type (:type (p/fuzzy-host h))) [:classes])))
   (POST "/type" [type module classes]
         (p/new-type type {:module module :classes classes})
         (generate-response {:status "new type saved" :type type :classes classes}))
   )
+

 (defroutes app-routes
   (context "/stage" [] stage-routes)


cleanup

cleanup

--- template/project.clj
+++ template/project.clj
@@ -5,7 +5,6 @@
             :url "https://www.apache.org/licenses/LICENSE-2.0"
             :distribution :repo}
   :plugins [[lein-codox "0.9.5"]
-            [lein-parent "0.3.0"]
             [org.clojars.cvillecsteele/lein-git-version "1.0.3"]]
   :codox {:metadata {:doc/format :markdown}
           :project {:name "${project.name}"}


Fix default value for collapsed attribute.

--- frontend/src/uxbox/main/ui/workspace/sidebar/layers.cljs
+++ frontend/src/uxbox/main/ui/workspace/sidebar/layers.cljs
@@ -212,7 +212,7 @@
         toggle-blocking #(toggle-blocking item %)]
     (letfn [(toggle-collapse [event]
               (dom/stop-propagation event)
-              (if (:collapsed item)
+              (if (:collapsed item true)
                 (st/emit! (uds/uncollapse-shape id))
                 (st/emit! (uds/collapse-shape id))))
             (toggle-locking [event]


with-paging + default comparator fix

with-paging + default comparator fix

--- src/chazel/chazel.clj
+++ src/chazel/chazel.clj
@@ -245,47 +245,53 @@
   ([^IMap m index ordered?]
    (.addIndex m index ordered?)))

-
-
-(defn- run-query [m pred where as]
+(defn- run-query [m where as pred]
   (case as
-    :set (into #{} (.values m pred))
-    :map (into {} (.entrySet m pred))
-    :native (.entrySet m pred)
+    :set (into #{} (if pred (.values m pred)
+                            (.values m)))
+    :map (into {} (if pred (.entrySet m pred)
+                           (.entrySet m)))
+    :native (if pred (.entrySet m pred)
+                     (.entrySet m))
     (error (str "can't return a result of a distributed query as \"" as "\" (an unknown format you provided). "
                 "query: \"" where "\", running on: \"" (.getName m) "\""))))

 (defprotocol Pageable
   (next-page [_]))

-(deftype Pages [m pred where as]
+;; TODO: implement Seqable, mark with Sequential
+(deftype Pages [m where as pred]
   Pageable
   (next-page [_]
              (.nextPage pred)
-             (run-query m pred where as)))
-
-(defn comp-keys []
-  (comparator (fn [e1 e2]
-                (compare (.getKey e1)
-                         (.getKey e2)))))
-
-(defn limit
-  ([n] (limit n comp-keys))
-  ([n c]
-   (PagingPredicate. comp-keys n)))
+             (run-query m where as pred)))
+
+(def comp-keys
+  (comparator (fn [a b]
+                (> (compare (.getKey a)
+                            (.getKey b))
+                   0))))
+
+(defn with-paging [n & {:keys [comp-fn pred]
+                        :or {comp-fn comp-keys}}]
+  (if-not pred
+    (PagingPredicate. comp-fn n)
+    (PagingPredicate. pred comp-fn n)))

 ;; TODO: QUERY_RESULT_SIZE_LIMIT
 (defn select [m where & {:keys [as comp-fn page-size]
                          :or {as :set
                               comp-fn comp-keys}}]
-  (let [sql-pred (SqlPredicate. where)
+  (let [sql-pred (if-not (= "*" where)
+                   (SqlPredicate. where))
         pred (if-not page-size
                sql-pred
-               (PagingPredicate. sql-pred comp-fn page-size))
-        rset (run-query m pred where as)]
+               (with-paging page-size :comp-fn comp-fn
+                                      :pred sql-pred))
+        rset (run-query m where as pred)]
     (if-not page-size
       rset
-      {:pages (Pages. m pred where as) :results rset})))
+      {:pages (Pages. m where as pred) :results rset})))

 (defn add-entry-listener [m ml]
   (.addEntryListener m ml true))


fix type inference regression

fix type inference regression

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -294,7 +294,8 @@
   (if-let [tag (get-tag e)]
     tag
     (case (:op e)
-      :let (infer-tag (:ret e))
+      :let (infer-tag (:expr e))
+      :do  (infer-tag (:ret e))
       :if (let [then-tag (infer-tag (:then e))
                 else-tag (infer-tag (:else e))]
             (when (= then-tag else-tag)


Wrap new object names in Name.

Wrap new object names in Name.

--- src/clj/minijava/tree.clj
+++ src/clj/minijava/tree.clj
@@ -151,7 +151,7 @@

 (deftree minijava.ast.NewObject
   [x frame]
-  (Call (Name (tm/label "newObject")) [(.typeName x)]))
+  (Call (Name (tm/label "newObject")) [(Name (tm/label (.typeName x)))]))

 (deftree minijava.ast.Not
   [x frame]


don't create a temporary namespace for each context, just put them all into user. thanks hugoduncan

--- src/clj/portal/server.clj
+++ src/clj/portal/server.clj
@@ -13,8 +13,7 @@
       (clojure.main/with-bindings
         (binding [*pipe* (PipedWriter.)]
           (binding [*in* (LineNumberingPushbackReader. (PipedReader. *pipe*))]
-            (in-ns (gensym 'portal))
-            (refer 'clojure.core)
+            (ns user)
             (agent (get-thread-bindings)))))))

 (defn get-context [id]


Not really a fix, but try to get more data for #11

--- src/clj/runbld/system.clj
+++ src/clj/runbld/system.clj
@@ -19,10 +19,14 @@
     (assoc (clojure.edn/read-string
             (slurp "test/facter.edn"))
            :dev-profile true)
-    (if (facter-installed?)
-      (yaml/parse-string (:out (sh/sh "facter" "--yaml")))
-      (throw+ {:warning ::no-facter
-               :msg "facter cannot be found in PATH"}))))
+    (let [cmd ["facter" "--yaml"]]
+      (if (facter-installed?)
+        (if-let [facts (yaml/parse-string (:out (apply sh/sh cmd)))]
+          facts
+          (throw+ {:error ::empty-factor
+                   :msg (format "facter returned empty: %s" cmd)}))
+        (throw+ {:warning ::no-facter
+                 :msg "facter cannot be found in PATH"})))))

 (defn find-ram-mb
   "Hack until we can fix our facter versions, or get it to always


fix warning

fix warning

--- src/cljs/oxylab/core.cljs
+++ src/cljs/oxylab/core.cljs
@@ -1,6 +1,5 @@
 (ns oxylab.core
   (:require [oxylab.model :as m]
-            [oxylab.view :as v]
             [oxylab.components :as cmp]
             [oxylab.state :as s]
             [cljs.reader :refer [read-string]]))


add port

add port

--- src/cljs/signet/core.cljs
+++ src/cljs/signet/core.cljs
@@ -13,6 +13,9 @@

 (.log js/console "Kneel before Kordano!")
+
+
+(def uri (goog.Uri. js/location.href))

 (strokes/bootstrap)

@@ -117,7 +120,7 @@
     om/IWillMount
     (will-mount [_]
       (go
-        (let [{:keys [ws-channel error] :as ws-conn} (<! (ws-ch "ws://localhost:8091/data/ws"))]
+        (let [{:keys [ws-channel error] :as ws-conn} (<! (ws-ch (str "ws://localhost:" (.getPort uri) "/data/ws")))]
           (if-not error
             (do
               (om/set-state! owner :ws-ch ws-channel)


Print weekly hours.

Print weekly hours.

--- src/cljs/tunnit/core.cljs
+++ src/cljs/tunnit/core.cljs
@@ -45,6 +45,7 @@
     :entries {
               1 {:hours 4.5}
               2 {:hours 7.5}
+              7 {:hours 2.5}
               }
     }
    {:id 222
@@ -53,6 +54,7 @@
               1 {:hours 3.5}
               2 {:hours 0}
               3 {:hours 7.5}
+              7 {:hours 1.5}
               }
     }
    {:id 333
@@ -61,6 +63,10 @@
               1 {:hours 3.5}
               2 {:hours 0}
               3 {:hours 7.5}
+              4 {:hours 7.5}
+              5 {:hours 7.5}
+              6 {:hours 7.5}
+              7 {:hours 5.5}
               }
     }
    ])
@@ -88,15 +94,18 @@
 (defn week-dates []
   (map-kv day-map count-date))

-(defcomponent project-row [app owner m]
+(defcomponent project-row [project owner opts]
               (render [this]
-                      (print (str "day: " (:day m)))
-                      (print (str "proj: " (get (first (:projects app)) :id)))
-                      ;(print (str "proj: " (:projects app)))
-                      (.log js/console app)
+                      (let [todays-hours
+                            (map #(get-in % [:entries (:day opts) :hours])
+                                 (:projects opts))]
+
+                      (print "day: " (:day opts) ", hours: " todays-hours)
+                      ;(.log js/console opts)
+
                       (ot/div {:class "hour-input"} nil
                               (ot/input {:class "hour-entry" :value 7.5})
-                              )))
+                              ))))

 (defcomponent week-view [app]
               (render [this]
@@ -106,7 +115,9 @@
                                              (ot/output {:class "day-label"}
                                                         (str (:name day) " " (unparse-date (:date day))))

-                                             (om/build-all project-row (:projects app) {:opts {:day key}})
+                                             (om/build-all project-row (:projects app) {:opts
+                                                                                {:day key
+                                                                                :projects (:projects app)}})
                                              ))
                                    (week-dates))
                               )))


Correctly set faction/player-type when game starts

--- src/cljs/zetawar/app.cljs
+++ src/cljs/zetawar/app.cljs
@@ -69,9 +69,11 @@
       (doseq [[_ player] @players]
         (when player
           (players/stop player))))
-    (doseq [{:keys [faction/ai faction/color]} factions]
+    (doseq [{:as faction :keys [faction/ai faction/color]} factions]
       (let [player-type (if ai ::players/reference-ai ::players/human)
             player (players/new-player app-ctx player-type color)]
+        (d/transact! conn [{:db/id (e faction)
+                            :faction/player-type player-type}])
         (players/start player)
         (swap! players assoc color player)))))


Add evaluation for if

Add evaluation for if

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -134,6 +134,15 @@
   (let [[_ val] stmt]
     (create-string val)))

+(defmethod evaluate-one :if [stmt]
+ (let [[_ & branches] stmt]
+   (loop [branches branches]
+     (if-let [[branch & branches] branches]
+       (let [[_ predicate & body] branch]
+         (if (evaluate predicate)
+           (mapv evaluate body)
+           (recur branches)))))))
+
 (defmethod evaluate-one :while [stmt]
   (let [[_ predicate & body] stmt]
     (while (evaluate predicate)


Moar.

Moar.

--- src/clojurecraft/core.clj
+++ src/clojurecraft/core.clj
@@ -12,6 +12,7 @@
      0x03 :chat
      0x04 :timeupdate
      0x05 :equipment
+     0x06 :spawnposition
 })
 (def packet-ids (apply assoc {} (mapcat reverse packet-types)))

@@ -151,6 +152,12 @@
           (assoc :slot (-read-short conn))
           (assoc :itemid (-read-short conn))
           (assoc :unknown (-read-short conn))))
+
+(defn read-packet-spawnposition [conn]
+      (-> {}
+          (assoc :x (-read-int conn))
+          (assoc :y (-read-int conn))
+          (assoc :z (-read-int conn))))

 (defn read-packet [conn packet-id]
@@ -165,6 +172,7 @@
             (= packet-type :chat) (read-packet-chat conn)
             (= packet-type :timeupdate) (read-packet-timeupdate conn)
             (= packet-type :equipment) (read-packet-equipment conn)
+            (= packet-type :spawnposition) (read-packet-spawnposition conn)
             :else (str "UNKNOWN PACKET TYPE: " packet-id)
             ))
         (println "\n\n\n")))


CMR-3819: Removed unneeded require.

CMR-3819: Removed unneeded require.

--- indexer-app/test/cmr/indexer/test/data/elasticsearch.clj
+++ indexer-app/test/cmr/indexer/test/data/elasticsearch.clj
@@ -1,6 +1,5 @@
 (ns cmr.indexer.test.data.elasticsearch
   (:require [clojure.test :refer :all]
-            [clojurewerkz.elastisch.rest.bulk :as bulk]
             [cmr.indexer.data.elasticsearch :as es]
             [cmr.indexer.data.index-set :as i]))


* src/clj/cljs/core.clj: type-hint first arg of all extend-type implementation fns

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -365,7 +365,7 @@
                              (if (= p 'Object)
                                (let [adapt-params (fn [[sig & body]]
                                                     (let [[tname & args] sig]
-                                                      (list (vec args) (list* 'this-as tname body))))]
+                                                      (list (vec args) (list* 'this-as (vary-meta tname assoc :tag t) body))))]
                                  (map (fn [[f & meths :as form]]
                                         `(set! ~(symbol (core/str prototype-prefix f))
                                                ~(with-meta `(fn ~@(map adapt-params meths)) (meta form))))
@@ -375,13 +375,13 @@
                                        (mapcat (fn [[f & meths :as form]]
                                                  (if (= psym 'cljs.core.IFn)
                                                    (let [adapt-params (fn [[[targ & args :as sig] & body]]
-                                                                        (let [this-sym (gensym "this-sym")]
+                                                                        (let [this-sym (with-meta (gensym "this-sym") {:tag t})]
                                                                           `(~(vec (cons this-sym args))
                                                                             (this-as ~this-sym
-                                                                              (let [~targ ~this-sym]
-                                                                                ~@body)))))
+                                                                                (let [~targ ~this-sym]
+                                                                                ~@body)))))
                                                          meths (map adapt-params meths)
-                                                         this-sym (gensym "this-sym")
+                                                         this-sym (with-meta (gensym "this-sym") {:tag t})
                                                          argsym (gensym "args")]
                                                      [`(set! ~(symbol (core/str prototype-prefix 'call)) ~(with-meta `(fn ~@meths) (meta form)))
                                                       `(set! ~(symbol (core/str prototype-prefix 'apply))
@@ -390,12 +390,15 @@
                                                                    (.apply (.-call ~this-sym) ~this-sym
                                                                            (.concat (array ~this-sym) (aclone ~argsym))))
                                                                 (meta form)))])
-                                                   (let [pf (core/str prototype-prefix pprefix f)]
+                                                   (let [pf (core/str prototype-prefix pprefix f)
+                                                         adapt-params (fn [[[targ & args :as sig] & body]]
+                                                                        (cons (vec (cons (vary-meta targ assoc :tag t) args))
+                                                                              body))]
                                                      (if (vector? (first meths))
-                                                       [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@meths) (meta form)))]
+                                                       [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@(adapt-params meths)) (meta form)))]
                                                        (map (fn [[sig & body :as meth]]
                                                               `(set! ~(symbol (core/str pf "$arity$" (count sig)))
-                                                                     ~(with-meta `(fn ~meth) (meta form))))
+                                                                     ~(with-meta `(fn ~(adapt-params meth)) (meta form))))
                                                             meths)))))
                                                sigs)))))]
         `(do ~@(mapcat assign-impls impl-map))))))


`cljs.repl/*repl-opts*` is not correctly bound

previously bound before merging in -setup extensions

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -660,8 +660,7 @@
                  :undeclared-var warn-on-undeclared
                  :undeclared-ns warn-on-undeclared
                  :undeclared-ns-form warn-on-undeclared)
-               ana/*cljs-static-fns* static-fns
-               *repl-opts* opts]
+               ana/*cljs-static-fns* static-fns]
        ;; TODO: the follow should become dead code when the REPL is
        ;; sufficiently enhanced to understand :cache-analysis - David
        (let [env {:context :expr :locals {}}
@@ -696,46 +695,47 @@
                        (print value))))))]
          (comp/with-core-cljs opts
            (fn []
-             (try
-               (when analyze-path
-                 (analyze-source analyze-path opts))
-               (evaluate-form repl-env env "<cljs repl>"
-                 (with-meta
-                   '(ns cljs.user
-                      (:require [cljs.repl :refer-macros [source doc find-doc apropos dir pst]]))
-                   {:line 1 :column 1})
-                 identity opts)
-               (catch Throwable e
-                 (caught e repl-env opts)))
-             (when-let [src (:watch opts)]
-               (future
-                 (let [log-file (io/file (util/output-directory opts) "watch.log")]
-                   (print "Watch compilation log available at:" (str log-file))
-                   (try
-                     (binding [*out* (FileWriter. log-file)]
-                       (cljsc/watch src (dissoc opts :watch)))
-                     (catch Throwable e
-                       (caught e repl-env opts))))))
-             (binding [*in* (if (true? (:source-map-inline opts))
-                              *in*
-                              (reader))]
+             (binding [*repl-opts* opts]
                (try
-                 (init)
+                 (when analyze-path
+                   (analyze-source analyze-path opts))
+                 (evaluate-form repl-env env "<cljs repl>"
+                   (with-meta
+                     '(ns cljs.user
+                        (:require [cljs.repl :refer-macros [source doc find-doc apropos dir pst]]))
+                     {:line 1 :column 1})
+                   identity opts)
                  (catch Throwable e
                    (caught e repl-env opts)))
-               (prompt)
-               (flush)
-               (loop []
-                 (when-not
-                   (try
-                     (identical? (read-eval-print) request-exit)
-                     (catch Throwable e
-                       (caught e repl-env opts)
-                       nil))
-                   (when (need-prompt)
-                     (prompt)
-                     (flush))
-                   (recur)))))))
+               (when-let [src (:watch opts)]
+                 (future
+                   (let [log-file (io/file (util/output-directory opts) "watch.log")]
+                     (print "Watch compilation log available at:" (str log-file))
+                     (try
+                       (binding [*out* (FileWriter. log-file)]
+                         (cljsc/watch src (dissoc opts :watch)))
+                       (catch Throwable e
+                         (caught e repl-env opts))))))
+               (binding [*in* (if (true? (:source-map-inline opts))
+                                *in*
+                                (reader))]
+                 (try
+                   (init)
+                   (catch Throwable e
+                     (caught e repl-env opts)))
+                 (prompt)
+                 (flush)
+                 (loop []
+                   (when-not
+                     (try
+                       (identical? (read-eval-print) request-exit)
+                       (catch Throwable e
+                         (caught e repl-env opts)
+                         nil))
+                     (when (need-prompt)
+                       (prompt)
+                       (flush))
+                     (recur))))))))
          (-tear-down repl-env)))))

 (defn repl


order pings by ts by default

order pings by ts by default

--- src/clj/tictag/db.clj
+++ src/clj/tictag/db.clj
@@ -54,7 +54,7 @@
    :timestamp ts})

 (defn get-pings [db & [query]]
-  (map to-ping (j/query db (or query ["select * from pings"]))))
+  (map to-ping (j/query db (or query ["select * from pings order by ts"]))))

 (defn add-tags [{db :db} long-time tags local-time]
   (j/with-db-connection [db-handle db]


Updating schema

Updating schema

--- src/helda/schema.clj
+++ src/helda/schema.clj
@@ -5,7 +5,7 @@
   )

 (s/defschema Module {
-  :id s/Keyword
+  :module-id s/Keyword
   (s/optional-key :description) s/Str
   :url s/Str
   })


Add wrap and new cursor functionality to core.cljs

--- src/reagent/core.cljs
+++ src/reagent/core.cljs
@@ -152,6 +152,12 @@
   ([x] (ratom/atom x))
   ([x & rest] (apply ratom/atom x rest)))

+
+(defn wrap
+  [value reset-fn & args]
+  (util/make-wrapper value reset-fn args))
+
+
 ;; RCursor

 (defn cursor
@@ -165,7 +171,8 @@
     ... (swap! c inc) ;; equivalence to (swap! ra update-in [:nested :content] inc)
     )"
   ([path] (fn [ra] (cursor path ra)))
-  ([path ra] (ratom/cursor path ra)))
+  ([path ra] (ratom/cursor path ra))
+  ([path ra reset-fn & args] (ratom/cursor path ra reset-fn args)))

 ;; Utilities


more tweaks

more tweaks

--- src/codemash/core.clj
+++ src/codemash/core.clj
@@ -35,9 +35,9 @@

 (demo (sin-osc))
 (demo (lf-saw))
+(demo (lf-tri))
 (demo (pulse))
 (demo (square))
-(demo (lf-tri))

 (stop)

@@ -51,7 +51,6 @@

 (do (voice/synthesis))

-;; play{d=Duty;f=d.kr(1/[1,2,4],0,Dseq([0,3,7,12,17]+24,inf));GVerb.ar(Blip.ar(f.midicps*[1,4,8],LFNoise1.kr(1/4,3,4)).sum,200,8)}

 (defsynth wallop [freq 300  amp 1]
   (let [sin1 (sin-osc freq)
@@ -104,6 +103,16 @@
         env (env-gen:ar (env-perc :release 0.25) :action FREE :time-scale dur)]
     (out out-bus (pan2 (* env src)))))

+;; Based on Dawn by Schemawound: http://sccode.org/1-c
+(defsynth fallout-wind [decay 30 attack 30 out-bus 0]
+  (let [lfo  (+ 0.5 (* 0.5 (sin-osc:kr [(ranged-rand 0.5 1000) (ranged-rand 0.5 1000)] :phase (* 1.5 Math/PI))))
+        lfo3 (+ 0.5 (* 0.5 (sin-osc:kr [(ranged-rand 0.1 0.5) (ranged-rand 0.1 0.5)] :phase (* 1.5 Math/PI))))
+        lfo2 (+ 0.5 (* 0.5 (sin-osc:kr [(* (ranged-rand 0.5 1000) lfo lfo3) (* (ranged-rand 0.5 1000) (- 1 lfo) (- 1 lfo3))] :phase (* 1.5 Math/PI))))
+        fillers (map (fn [_] (* lfo2 (sin-osc:ar (ranged-rand 40 1000) :phase 0))) (range 0 100))]
+    (out:ar out-bus  (* (mix:ar fillers)
+                  (env-gen:kr (perc attack decay) :action FREE)))))
+
+(fallout-wind)
 (woody-beep :freq 400)

 (kill woody-beep)
@@ -125,6 +134,9 @@

 (def waves-s (sample (freesound-path 48412)))
 (def waves (waves-s :rate 0.3 :vol 0.5))
+(def waves-s (freesound-sample 163120))
+(def waves (waves-s :rate 0.8 :vol 0.5))
+(ctl waves :rate 1)
 (kill waves)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -157,10 +169,10 @@
   (let [freq (+ mid-freq (* (in:kr freq-bus) freq-amp))]
     (out 0 (pan2 (lf-tri freq)))))

-(def mft (modulated-freq-tri [:tail late-g] sin-bus))
+(def mft (modulated-freq-tri [:tail late-g] :freq-bus sin-bus))

 (ctl mft :freq-bus tri-bus)
-(ctl tri-synth-inst :freq 1)
+(ctl tri-synth-inst :freq 0.2)

 (kill mft)

@@ -173,10 +185,8 @@
   (voice/instruments))

 ;;Sampled
-(comment (require 'overtone.inst.sampled-piano))
+(comment (require '[overtone.inst.sampled-piano :as s-piano]))
 (require '[overtone.inst.piano :as piano])
-
-(require '[overtone.inst.sampled-piano :as s-piano])

 (piano/piano :note 50)
 (s-piano/sampled-piano :note 50)
@@ -244,7 +254,8 @@
 (def kick-s (load-sample "~/Workspace/music/samples/sliced-p5/kick.aif"))

 (defonce kick-sequencer-buffer (buffer 8))
-(buffer-get kick-sequencer-buffer 7)
+
+(buffer-get kick-sequencer-buffer 0)

 (sample-player kick-s)

@@ -440,7 +451,7 @@
 (spacey)
 (kill spacey)

-;; Extra Tweaks
+;; Improv

 (defonce clap-sequencer-buffer (buffer 8))


Updated slack default-formatter and extended-formatter

--- src/riemann/slack.clj
+++ src/riemann/slack.clj
@@ -9,10 +9,17 @@
   (escape message {\< "<" \> ">" \& "&"}))

 (defn default-formatter [events]
-  {:text (str "*Host:* " (:host events)
-              " *State:* " (:state events)
-              " *Description:* " (:description events)
-              " *Metric:* " (:metric events))})
+  {:attachments
+   [{:fields
+     [{:title "Riemann Event"
+       :value (slack-escape
+                (str "Host:   " (or (:host events) "-") "\n"
+                     "Service:   " (or (:service events) "-") "\n"
+                     "State:   " (or (:state events) "-") "\n"
+                     "Description:   " (or (:description events) "-") "\n"
+                     "Metric:   " (or (:metric events) "-") "\n"
+                     "Tag:   " (or (:tag events) "-") "\n"))
+       :short true}]}]})

 (defn extended-formatter [events]
   {:text "This event requires your attention!",
@@ -20,6 +27,8 @@
    [{:fallback
      (slack-escape
        (str
+         "*Service:* "
+         (:service events)
          "*Description:* "
          (:description events)
          " *Host:* "
@@ -29,7 +38,7 @@
          " *State:* "
          (:state events))),
      :text (slack-escape (or (:description events) "")),
-     :pretext "Event properties:",
+     :pretext "Event Details:",
      :color
      (case (:state events) "ok" "good" "critical" "danger" "warning"),
      :fields
@@ -42,6 +51,12 @@
       {:title "Metric", :value (or (:metric events) "-"), :short true}
       {:title "State",
        :value (slack-escape (or (:state events) "-")),
+       :short true}
+      {:title "Description",
+       :value (slack-escape (or (:description events) "-"))
+       :short true}
+      {:title "Tags",
+       :value (slack-escape (or (:tag events) "-"))
        :short true}]}]})

 (defn slack


format

format

--- modules/reitit-core/src/reitit/impl.cljc
+++ modules/reitit-core/src/reitit/impl.cljc
@@ -256,7 +256,7 @@
      (goog/inherits ~type ~base-type)

      ~@(map
-        (fn [method]
-          `(set! (.. ~type -prototype ~(symbol (str "-" (first method))))
-                 (fn ~@(rest method))))
-        methods)))
+         (fn [method]
+           `(set! (.. ~type -prototype ~(symbol (str "-" (first method))))
+                  (fn ~@(rest method))))
+         methods)))


return a map as opposed to an array

return a map as opposed to an array

--- src/crawler/extractor.clj
+++ src/crawler/extractor.clj
@@ -269,7 +269,10 @@
                                                   (into {} in-host-xpath-hrefs))})
                                 in-host-xpath-hrefs)]

-     explorations)))
+     {:src-link             url
+      :explorations         explorations
+      :xpaths-hrefs         xpaths-hrefs
+      :in-host-xpaths-hrefs in-host-xpath-hrefs})))

 (defn enum-candidates
   "Enumeration info"


Remove tx from search pattern.

Remove tx from search pattern.

--- src/datascript/query.cljs
+++ src/datascript/query.cljs
@@ -218,7 +218,7 @@
 (defn lookup-pattern-db [db pattern callback]
   ;; TODO optimize with bound attrs min/max values here
   (let [search-pattern (mapv #(if (symbol? %) nil %) pattern)
-        attr->prop     (->> (map vector pattern ["e" "a" "v" "tx"])
+        attr->prop     (->> (map vector pattern ["e" "a" "v"])
                             (filter (fn [[s _]] (free-var? s)))
                             (into {}))]
     (dc/-search db search-pattern (fn [datoms] (callback (Relation. attr->prop datoms))))))


Eliminate extra ns form

Eliminate extra ns form

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -48,7 +48,6 @@
   (and (seq? form) (= 'in-ns (first form))))

 (defn ^:export read-eval-print [line]
-  (ns cljs.user)
   (binding [ana/*cljs-ns* @current-ns
             *ns* (create-ns @current-ns)
             r/*data-readers* tags/*cljs-data-readers*]


Bad namespace for event keys

Bad namespace for event keys

--- resources/leiningen/new/onyx_plugin/medium_input.clj
+++ resources/leiningen/new/onyx_plugin/medium_input.clj
@@ -15,8 +15,8 @@
                     {:event-map-keys (keys event)})))

   (let [pipeline (:onyx.core/pipeline event)]
-    {:core.async/pending-messages (:pending-messages pipeline)
-     :core.async/drained? (:drained? pipeline)
+    {:{{medium}}/pending-messages (:pending-messages pipeline)
+     :{{medium}}/drained? (:drained? pipeline)
      :{{medium}}/example-datasource (:{{medium}}/example-datasource event)}))

 (def reader-calls


Fix join func.

Fix join func.

--- src/suricatta/dsl.clj
+++ src/suricatta/dsl.clj
@@ -29,6 +29,9 @@
             [suricatta.impl :as impl]
             [suricatta.types :as types :refer [defer]])
   (:import org.jooq.SQLDialect
+           org.jooq.SelectJoinStep
+           org.jooq.InsertReturningStep
+           org.jooq.Row
            org.jooq.impl.DSL
            org.jooq.impl.DefaultConfiguration
            org.jooq.impl.DefaultDataType
@@ -388,7 +391,9 @@
   "Create join clause."
   [q t]
   (defer
-    (.join @q t)))
+    (let [^SelectJoinStep q (deref q)
+          t (-unwrap t)]
+      (.join q t))))

 (defn cross-join
   [step tlike]


JSON writer can stringify java.sql.Date

JSON writer can stringify java.sql.Date

* cheated and stole from: https://github.com/clojure-liberator/liberator/issues/71

--- src/swanson/utils.clj
+++ src/swanson/utils.clj
@@ -4,7 +4,8 @@
     [clojure.java.io :as io]
     [clj-time.format :as format]
     [clj-time.core :as time-core]
-    [cheshire.core :refer :all]))
+    [cheshire.core :refer :all]
+    [clojure.data.json :as json]))

 ; TODO might be better to do this w/o filehandle hassles
 ; a la http://stackoverflow.com/a/19656800
@@ -55,10 +56,15 @@
     (read-string s)
     (first (or default (list 0)))))

+(extend-type java.sql.Date
+  json/JSONWriter
+  (-write [date out]
+    (json/-write (str date) out)))
+
 (defn json-response [data & [status]]
   {:status (or status 200)
    :headers {"Content-Type" "application/json"}
-   :body (generate-string data)})
+   :body (generate-string data {:date-format "yyyy-MM-dd"})})

 (defn pad-keys [numeric-map]
   (let [indices (keys numeric-map)


added pagination code

added pagination code

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -159,7 +159,7 @@
                                                                  first
                                                                  :path)}}]
                             (merge corpus corpus-entry)))))
-
+
                :else
                (let [{new-bodies  :bodies
                       new-visited :visited}
@@ -245,17 +245,53 @@
                (leaf? action-seq (first content-q))
                (do
                  (utils/sayln :reached-leaf)
-                 (recur {:content-queue (rest content-q)
-                         :paging-queue paging-q}
-                        (conj visited (-> content-q first :url))
-                        (+ 1 num-leaves)
+                 (let [pagination-extracted (if (pagination src-xpath)
+                                              (dom/eval-anchor-xpath
+                                               (pagination src-xpath)
+                                               (dom/html->xml-doc body)
+                                               (-> content-q first :url)
+                                               (clojure.set/union
+                                                visited
+                                                (map :url content-q)))
+                                              [])]
+                   (recur {:content-queue (concat
+                                           (map
+                                            (fn [x]
+                                              {:url x
+                                               :src-xpath src-xpath})
+                                            pagination-extracted)
+                                           (rest content-q))
+                           :paging-queue  paging-q}
+                          (conj visited (-> content-q first :url))
+                          (+ 1 num-leaves)
+                          leaf?
+                          stop?
+                          action-seq
+                          pagination
+                          (merge corpus {(-> content-q first :url)
+                                         body}))))
+
+               (and (empty? content-q)
+                    (not
+                     (empty? paging-q)))
+               (let [sorted-pagination-entries (sort-by
+                                                #(-> :src-xpath count)
+                                                paging-q)
+                     chosen-entry (last sorted-pagination-entries)
+                     remaining-pagination (filter
+                                           (fn [x] (not= x chosen-entry))
+                                           paging-q)]
+                 (recur {:content-queue (concat [chosen-entry]
+                                                content-q)
+                         :paging-queue remaining-pagination}
+                        visited
+                        num-leaves
                         leaf?
                         stop?
                         action-seq
                         pagination
-                        (merge corpus {(-> content-q first :url)
-                                       body})))
-
+                        corpus))
+
                :else
                (do
                  (utils/sayln :here)
@@ -269,6 +305,15 @@
                                     (clojure.set/union
                                      visited
                                      (map :url content-q)))))
+                       pagination-extracted (if (pagination src-xpath)
+                                              (dom/eval-anchor-xpath
+                                               (pagination src-xpath)
+                                               (dom/html->xml-doc body)
+                                               (-> content-q first :url)
+                                               (clojure.set/union
+                                                visited
+                                                (map :url content-q)))
+                                              [])
                        extracted-hrefs (map :href extracted)

                        new-content-q (concat (rest content-q)
@@ -276,14 +321,19 @@
                                               (fn [x]
                                                 {:url x
                                                  :src-xpath (cons action src-xpath)})
-                                              extracted-hrefs))]
+                                              extracted-hrefs))
+                       new-paging-q (concat paging-q (map
+                                                      (fn [x]
+                                                        {:url x
+                                                         :src-xpath src-xpath})
+                                                      pagination-extracted))]
                    (utils/sayln :items (count extracted-hrefs))
                    (recur {:content-queue new-content-q
-                           :paging-queue paging-q}
+                           :paging-queue new-paging-q}
                           (conj visited url)
                           num-leaves
                           leaf?
                           stop?
                           action-seq
                           pagination
-                          (merge corpus {url body})))))))))
+                          corpus))))))))


widget manager

widget manager

--- src/dasha/widgets.clj
+++ src/dasha/widgets.clj
@@ -1,28 +1,85 @@
 (ns dasha.widgets
-  (:require [clojure.core.async :as async :refer [<! >!! chan go-loop]]
-            [dasha.widgets.random :as random]
-            [dasha.widgets.chart :as chart]))
+  (:require [clojure.core.async :as async :refer [>!! <! >! chan go-loop go]]))

-(def management-channel (atom nil))
+(def srv-state (atom nil))
+
+(defn- dispatch
+  [widgets {:keys [widget-key command]}]
+  (if-let [channels (widgets widget-key)]
+    (go (>! (:in channels) command))))

 (defn start []
+  (when (compare-and-set! srv-state nil {})
+    (let [in (chan)
+          out (chan)]
+      (reset! srv-state {:mixer (async/mix out) :widgets {}})
+      (go-loop []
+               (let [cmd (<! in)]
+                 (dispatch (:widgets @srv-state) cmd))
+               (recur))
+      (swap! srv-state assoc :channels {:in in :out out})))
+  (:channels @srv-state))
+
+(defn- attach-widget
+  [widget-key widget-channels mixer]
+  (async/admix mixer (async/map (fn [msg] {:widget widget-key :message msg})
+                                [(:out widget-channels)]))
+  (swap! srv-state update-in [:widgets] assoc widget-key widget-channels))
+
+(defn- start-widget
+  [running? out {:keys [refresh-rate widget-fn]}]
+  (when (not @running?)
+    (reset! running? true)
+    (go-loop []
+             (when @running?
+               (<! (async/timeout refresh-rate))
+               (>! out (widget-fn))
+               (recur)))))
+
+(defn- create-widget-channels [widget]
   (let [in (chan)
         out (chan)
-        multiplier (async/mult in)
-        mixer (async/mix out)]
-    (async/admix mixer (random/widget multiplier :random))
-    (async/admix mixer (chart/widget multiplier :widget2 "Random Live Chart"))
-    (reset! management-channel in)
-    out))
+        running? (atom false)]
+    (go-loop []
+             (case (<! in)
+               :start (start-widget running? out widget)
+               :stop (reset! running? false)
+               ;; custom cmds
+               )
+             (recur))
+    {:in in :out out}))

-(defn stop []
-  (>!! @management-channel :stop))
+(defn new-widget
+  "Returns widget-key on success, nil otherwise (see start)"
+  [widget-key widget-fn]
+  (if-let [mixer (:mixer @srv-state)]
+    (attach-widget
+      widget-key
+      (create-widget-channels {:widget-fn widget-fn :refresh-rate 1000})
+      mixer))
+  widget-key)

-;; (dasha.widgets/stop)

-(defn test []
-  (let [c (start)]
-    (go-loop []
-      (println (<! c))
-      (recur))))
+;;
+;; Examples
+;;

+(comment
+  (def srv-chans (start))
+
+  (def all-out (:out srv-chans))
+  (def all-in (:in srv-chans))
+
+
+  (go-loop []
+           (println (<! all-out))
+           (recur))
+
+  (new-widget :w1 (constantly 12))
+  (new-widget :w2 (constantly 11))
+
+  (>!! all-in {:widget-key :w1 :command :start})
+  (>!! all-in {:widget-key :w2 :command :start}))
+
+;(>!! all-in {:widget-key :w1 :command :stop})
+;(>!! all-in {:widget-key :w2 :command :stop})


Improved formatting

Improved formatting

--- src/leiningen/new/onyx_app/src/onyx_app/lifecycles/sample_lifecycle.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/lifecycles/sample_lifecycle.clj
@@ -6,8 +6,8 @@
               [cheshire.core :as json]))

-;;;;================- Logging -===========================
-
+;;;;======================================================
+;;;;                 Logging
 (defn log-batch [event lifecycle]
   (let [task-name (:onyx/name (:onyx.core/task-map event))]
     (doseq [m (map :message (mapcat :leaves (:tree (:onyx.core/results event))))]
@@ -25,7 +25,8 @@
                                    :lifecycle/calls ::log-calls
                                    :lifecycle/doc "Lifecycle for printing the output of a task's batch"}]}))

-;;;;================- Core.Async  -===========================
+;;;;======================================================
+;;;;                 Core Async
 (def get-input-channel
   "Returns the same channel every time for an id."
   (memoize
@@ -82,9 +83,9 @@
                                 :core.async/id (or uuid (java.util.UUID/randomUUID))}
                                {:lifecycle/task output-task-name
                                 :lifecycle/calls :onyx.plugin.core-async/writer-calls}])])})))
+
 ;;;;======================================================
 ;;;;                 Kafka
-
 (defn deserialize-message [bytes]
   (try
     (json/parse-string (String. bytes "UTF-8"))
@@ -103,10 +104,8 @@
                                :kafka/offset-reset :smallest
                                :kafka/force-reset? true}
                               kafka-settings)
-        kafka-input    (u/find-task-by-key catalog :onyx/plugin
-                                           :onyx.plugin.kafka/read-messages)
-        kafka-output   (u/find-task-by-key catalog :onyx/plugin
-                                           :onyx.plugin.kafka/write-messages)]
+        kafka-input    (u/find-task-by-key catalog :onyx/plugin :onyx.plugin.kafka/read-messages)
+        kafka-output   (u/find-task-by-key catalog :onyx/plugin :onyx.plugin.kafka/write-messages)]
     (-> job
         (update-in [:catalog] (fn [entries]
                                 (mapv (fn [entry]
@@ -124,13 +123,10 @@

 ;;;;=======================================================
 ;;;;                     SQL
-
 (defn add-sql
   [{:keys [catalog lifecycles] :as job}]
-  (let [sql-input (u/find-task-by-key catalog :onyx/plugin
-                                      :onyx.plugin.sql/read-rows)
-        sql-output (u/find-task-by-key catalog :onyx/plugin
-                                       :onyx.plugin.sql/write-rows)]
+  (let [sql-input (u/find-task-by-key catalog :onyx/plugin :onyx.plugin.sql/read-rows)
+        sql-output (u/find-task-by-key catalog :onyx/plugin :onyx.plugin.sql/write-rows)]
     (-> job
         (u/add-to-job
          {:lifecycles
@@ -155,8 +151,7 @@

 (defn add-seq
   [{:keys [catalog lifecycles] :as job} seq]
-  (let [seq-input (u/find-task-by-key catalog :onyx/plugin
-                                      :onyx.plugin.seq/input)]
+  (let [seq-input (u/find-task-by-key catalog :onyx/plugin :onyx.plugin.seq/input)]
     (-> job
         (u/add-to-job
          {:lifecycles
@@ -168,7 +163,7 @@

 ;;;;============================================================
-;;;;                      Metrics
+;;;;                    Metrics
 (defn add-metrics
   [job task]
   (u/add-to-job job


pass configs as map

pass configs as map

--- src/shuppet/elb.clj
+++ src/shuppet/elb.clj
@@ -80,11 +80,12 @@
                                            :local-value v
                                            :remote-value remote-value}))))

-(defn check-fixed-values [local remote]
-  (map (fn [[k v]]
-         (cond
-          (string? v) (check-string-value remote k v)))
-       local))
+(defn check-fixed-values [{:keys [local remote] :as config}]
+  (dorun (map (fn [[k v]]
+                (cond
+                 (string? v) (check-string-value remote k v)))
+              local))
+  config)

 (defn create-listeners [config]
   (elb-request (merge {"Action" "CreateLoadBalancerListeners"} (to-aws-format config))))
@@ -98,11 +99,18 @@
   (elb-request {"Action" "DeleteLoadBalancer"
                 "LoadBalancerName" elb-name}))

+(defn ensure-health-check [{:keys [local remote] :as config}]
+config
+  )
+
 (defn ensure-config [local]
   (if-let [remote (find-elb (:LoadBalancerName local))]
-    (check-fixed-values local remote)
-      ;    (ensure-security-groups)
+    (-> {:local local :remote remote}
+        (check-fixed-values)
+        (ensure-health-check))
+    (create-elb local))
+
+        ;    (ensure-security-groups)
  ;   (ensure-listener)
-;    (ensure-subnet)
-
-    (create-elb local)))
+                                        ;    (ensure-subnet)
+  )


resource for get schedule

resource for get schedule

--- src/shuppet/web.clj
+++ src/shuppet/web.clj
@@ -2,7 +2,8 @@
   (:require
    [shuppet
     [core :as core]
-    [middleware :as middleware]]
+    [middleware :as middleware]
+    [util :refer [rfc2616-time]]]
    [slingshot.slingshot :refer [try+ throw+]]
    [clojure.data.json :refer [write-str]]
    [compojure.core :refer [defroutes context GET PUT POST DELETE]]
@@ -88,14 +89,14 @@
   (core/clean-config env name)
   (response {:message (str "Succesfully cleaned the configuration for application " name)}))

-(defn- apps-apply
+(defn- configure-apps
   [env]
   (core/apply-config env)
   (core/update-configs env))

 (defn- apply-apps-config
   [env]
-  (apps-apply env)
+  (configure-apps env)
   (response  {:message (str "Started applying the configuration for all applications in environment " env "."
                             "Please check the campfire room '" cf-error-room  "' for any error cases.")}))

@@ -118,8 +119,15 @@
     (response {:message "Succefully stopped the shuppet scheduler"})
     (do
       (let [interval (if interval (Integer/parseInt interval) default-interval)]
-         (at-at/every (* interval 60 1000) #(apps-apply env) shuppet-pool)
-        (response {:message (str "Succesfully started the shuppet scheduler. The scheduler will run in every " interval " minutes.") })))))
+         (at-at/every (* interval 60 1000) #(configure-apps env) shuppet-pool :desc (rfc2616-time))
+         (response {:message (str "Succesfully started the shuppet scheduler. The scheduler will run in every " interval " minutes.") })))))
+
+(defn- get-schedule
+  [env]
+  (if-let [job (first (at-at/scheduled-jobs shuppet-pool))]
+    (response {:created (:desc job)
+               :interval (str (/ (:ms-period job) (* 60 1000)) " minutes")})
+    (response {:message "No jobs are currently scheduled"} 404)))

 (def ^:private resources
   {:GET
@@ -132,6 +140,7 @@
     "/1.x/envs/:env-name" "Read and evaluate the environment configuration :env-name.clj from GIT repository :env-name, return the configuration in JSON"
     "/1.x/envs/:env-name/apply" "Apply the environment configuration"
     "/1.x/envs/:env-name/apps" "All available applications for the given environment"
+    "/1.x/envs/:env-name/schedule" "Shows the current shuppet schedule, if any"
     "/1.x/envs/:env-name/apps/apply" "Apply configuration for all applications listed in Onix"
     "/1.x/envs/:env-name/apps/:app-name" "Read the application configuration :app-name.clj from GIT repository :app-name and evaluate it with the environment configuration, return the configuration in JSON. Master branch is used for all environments except for production where prod branch is used instead."
     "/1.x/envs/:env-name/apps/:app-name/apply" "Apply the application configuration for the given environment")
@@ -159,13 +168,17 @@
        [env]
        (list-apps env))

+  (GET "/:env/apps/apply"
+       [env]
+       (apply-apps-config env))
+
+  (GET "/:env/schedule"
+        [env]
+        (get-schedule env))
+
   (POST "/:env/schedule"
         [env action interval]
         (schedule env action interval))
-
-  (GET "/:env/apps/apply"
-       [env]
-       (apply-apps-config env))

   (GET "/:env/apps/:name"
        [env name]


prepare project

prepare project

--- cascalog-intro/project.clj
+++ cascalog-intro/project.clj
@@ -3,4 +3,9 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.8.0"]])
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [cascalog "2.1.1"]]
+  :main ^:skip-aot cascalog-into.core
+  :target-path "target/%s"
+  :profiles {:uberjar {:aot :all}
+             :dev {:dependencies [[org.apache.hadop/hadop-core "1.2.1"]]}})


Minor reformatting

Minor reformatting

--- planck-cljs/src/planck/core.cljs
+++ planck-cljs/src/planck/core.cljs
@@ -1,11 +1,9 @@
 (ns planck.core
   (:require-macros [cljs.env.macros :refer [with-compiler-env]])
-  (:require
-    [cljs.analyzer :as ana]
-    [cljs.tools.reader :as r]
-    [cljs.tagged-literals :as tags]
-    [cljs.source-map :as sm]
-
+  (:require [cljs.analyzer :as ana]
+            [cljs.tools.reader :as r]
+            [cljs.tagged-literals :as tags]
+            [cljs.source-map :as sm]
             [cljs.js :as cljs]
             [cljs.repl :as repl]
             [cljs.stacktrace :as st]
@@ -19,7 +17,7 @@
   ;(println "Loading analysis cache")
   (let [rdr (transit/reader :json)
         cache (transit/read rdr json)]
-    (cljs.js/load-analysis-cache! st 'cljs.core cache)))
+    (cljs/load-analysis-cache! st 'cljs.core cache)))

 (defonce current-ns (atom 'cljs.user))

@@ -136,7 +134,7 @@
       (cb nil))))

 (defn require [macros-ns? sym reload]
-  (cljs.js/require
+  (cljs/require
     {:*compiler*     st
      :*load-fn*      load
      :*eval-fn*      cljs/js-eval}
@@ -197,8 +195,7 @@
   [source expression? print-nil-expression?]
   (binding [ana/*cljs-ns* @current-ns
             *ns* (create-ns @current-ns)
-            #_ #_ r/*data-readers* tags/*cljs-data-readers*
-            cljs.js/*eval-fn* cljs/js-eval]
+            cljs/*eval-fn* cljs/js-eval]
     (let [expression-form (and expression? (repl-read-string source))]
       (if (repl-special? expression-form)
         (let [env (assoc (ana/empty-env) :context :expr


Capture source for forms entered in REPL

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -1086,12 +1086,13 @@

 (defn- fetch-source
   [var]
-  (when-let [filepath (or (:file var) (:file (:meta var)))]
-    (when-let [file-source (get-file-source filepath)]
-      (let [rdr (rt/source-logging-push-back-reader file-source)]
-        (dotimes [_ (dec (:line var))] (rt/read-line rdr))
-        (-> (r/read {:read-cond :allow :features #{:cljs}} rdr)
-          meta :source)))))
+  (or (::repl-entered-source var)
+      (when-let [filepath (or (:file var) (:file (:meta var)))]
+        (when-let [file-source (get-file-source filepath)]
+          (let [rdr (rt/source-logging-push-back-reader file-source)]
+            (dotimes [_ (dec (:line var))] (rt/read-line rdr))
+            (-> (r/read {:read-cond :allow :features #{:cljs}} rdr)
+              meta :source))))))

 (defn- run-sync!
   "Like cljs.js/run-async!, but with the expectation that cb will be called
@@ -1483,6 +1484,11 @@
   [expression-form]
   (call-form? expression-form '#{require require-macros}))

+(defn- def-form?
+  "Determines if the expression is a def expression."
+  [expression-form]
+  (call-form? expression-form '#{def defn defn- defonce}))
+
 (defn- process-execute-source
   [source-text expression-form
    {:keys [expression? print-nil-expression? include-stacktrace? source-path session-id] :as opts}]
@@ -1519,6 +1525,9 @@
                           (not (nil? value)))
                   (print-result value {::as-code? (macroexpand-form? expression-form)}))
                 (process-1-2-3 expression-form value)
+                (when (def-form? expression-form)
+                  (let [{:keys [ns name]} (meta value)]
+                    (swap! st assoc-in [::ana/namespaces ns :defs name ::repl-entered-source] source-text)))
                 (reset! current-ns ns)
                 nil))
             (when error


Prevent nil users from clicking on certain menu items

--- src-cljs/frontend/components/pieces/page_header.cljs
+++ src-cljs/frontend/components/pieces/page_header.cljs
@@ -7,21 +7,25 @@
             [om.core :as om :include-macros true])
   (:require-macros [frontend.utils :refer [component html]]))

-(defn crumb-node [{:keys [active name path track-event-type]} owner]
+(defn crumb-node [{:keys [active name path track-event-type demo]} owner]
+  ;; demo intended for OSS users, external viewers of builds page
   (reify
     om/IRender
     (render [_]
       (component
-        (html
-          (if active
-            [:li.active
-             [:a {:disabled true :title name} name " "]]
+        (html
+          (if-not demo
             [:li
-             [:a {:href path
-                  :title name
-                  :on-click (when track-event-type
-                              #((om/get-shared owner :track-event) {:event-type track-event-type}))}
-                 name " "]]))))))
+             [:span name]]
+            (if active
+              [:li.active
+               [:a {:disabled true :title name} name " "]]
+              [:li
+               [:a {:href path
+                    :title name
+                    :on-click (when track-event-type
+                                #((om/get-shared owner :track-event) {:event-type track-event-type}))}
+                   name " "]])))))))

 (defmulti crumb
   (fn [{:keys [type]}] type))
@@ -34,14 +38,16 @@
   [{:keys [owner]}]
   (om/build crumb-node {:name "Builds"
                         :path (routes/v1-dashboard-path {})
-                        :track-event-type :breadcrumb-dashboard-clicked}))
+                        :track-event-type :breadcrumb-dashboard-clicked
+                        :demo false}))

 (defmethod crumb :project
   [{:keys [vcs_type username project active owner]}]
   (om/build crumb-node {:name project
                         :path (routes/v1-dashboard-path {:vcs_type vcs_type :org username :repo project})
                         :active active
-                        :track-event-type :breadcrumb-project-clicked}))
+                        :track-event-type :breadcrumb-project-clicked
+                        :demo true}))

 (defmethod crumb :project-settings
   [{:keys [vcs_type username project active]}]
@@ -55,18 +61,20 @@
                                 tag (utils/trim-middle (utils/display-tag tag) 45)
                                 branch (utils/trim-middle (utils/display-branch branch) 45)
                                 :else "...")
-                       :path (when branch
+                        :path (when branch
                                (routes/v1-dashboard-path {:vcs_type vcs_type
                                                           :org username
                                                           :repo project
                                                           :branch branch}))
-                       :track-event-type :breadcrumb-branch-clicked
-                       :active active}))
+                        :track-event-type :breadcrumb-branch-clicked
+                        :active active
+                        :demo true}))

 (defmethod crumb :build
   [{:keys [vcs_type username project build-num active]}]
   (om/build crumb-node {:name (str "build " build-num)
                         :track-event-type :breadcrumb-build-clicked
+                        :demo true
                         :path (routes/v1-build-path vcs_type username project build-num)
                         :active active}))

@@ -74,6 +82,7 @@
   [{:keys [vcs_type username active owner]}]
   (om/build crumb-node {:name username
                         :track-event-type :breadcrumb-org-clicked
+                        :demo false
                         :path (routes/v1-dashboard-path {:vcs_type vcs_type
                                                          :org username})
                         :active active}))


CMR-307: Added tests for int attribute searching.

--- test/cmr/system_int_test/search/granule_psa_search_test.clj
+++ test/cmr/system_int_test/search/granule_psa_search_test.clj
@@ -32,7 +32,10 @@
        "string,alpha,b,b" (am/max-must-be-greater-than-min-msg "b" "b")
        "float,alpha,a" (am/invalid-value-msg :float "a")
        "float,alpha,a,0" (am/invalid-value-msg :float "a")
-       "float,alpha,0,b" (am/invalid-value-msg :float "b"))
+       "float,alpha,0,b" (am/invalid-value-msg :float "b")
+       "int,alpha,a" (am/invalid-value-msg :int "a")
+       "int,alpha,a,0" (am/invalid-value-msg :int "a")
+       "int,alpha,0,b" (am/invalid-value-msg :int "b"))

     (is (= {:status 422 :errors [(am/attributes-must-be-sequence-msg)]}
          (search/get-search-failure-data
@@ -52,6 +55,8 @@
         gran3 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "bravo" ["aa" "bf"])]}))
         gran4 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "charlie" ["az"])]}))]
     (index/flush-elastic-index)
+
+    ;; TODO add additional deftest for datetime_string date_string, and time_string that they're treated as strings.

     (testing "search by value"
       (are [v items]
@@ -114,7 +119,46 @@
            "float,bravo,120," [gran2 gran3]

            ;; only max range provided
-           "float,bravo,,13.6" [gran2]))))
+           "float,bravo,,13.6" [gran1 gran2]))))
+
+(deftest int-psas-search-test
+  (let [psa1 (dc/psa "alpha" :int)
+        psa2 (dc/psa "bravo" :int)
+        psa3 (dc/psa "charlie" :int)
+        coll1 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2]}))
+        gran1 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes [(dg/psa "alpha" [10 123])
+                                                                                (dg/psa "bravo" [-12])]}))
+        gran2 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes [(dg/psa "bravo" [10 123])]}))
+
+        coll2 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2 psa3]}))
+        gran3 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "alpha" [14])
+                                                                                (dg/psa "bravo" [13 123])]}))
+        gran4 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes [(dg/psa "charlie" [14])]}))]
+    (index/flush-elastic-index)
+
+    (testing "search by value"
+      (are [v items]
+           (d/refs-match? items (search/find-refs :granule {"attribute[]" v}))
+           "int,bravo,123" [gran2, gran3]
+           "int,alpha,11" []
+           "int,bravo,-12" [gran1]))
+
+    (testing "search by range"
+      (are [v items]
+           (d/refs-match? items (search/find-refs :granule {"attribute[]" v}))
+
+           ;; inside range
+           "int,alpha,9,11" [gran1]
+           ;; beginning edge of range
+           "int,alpha,10,11" [gran1]
+           ;; ending edge of range
+           "int,alpha,9,10" [gran1]
+
+           ;; only min range provided
+           "int,bravo,120," [gran2 gran3]
+
+           ;; only max range provided
+           "int,bravo,,12" [gran1 gran2]))))


Revert broken test from f7dd6057

Revert broken test from f7dd6057


Add my email to the copyright notice on atomic ns.

--- src/futura/atomic.clj
+++ src/futura/atomic.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) 2015 Andrey Antukh
+;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without


Rewrite with dictionary instead of tree

Rewrite with dictionary instead of tree

--- src/ulam/connect4.clj
+++ src/ulam/connect4.clj
@@ -95,38 +95,37 @@
                        {:visited 0 :score 0 :children {}}}})

 (defn uct [node parent-visits]
-  (+ (/ (:score node)
-        (:visited node))
-     (Math/sqrt (/ (* 2 (Math/log parent-visits))
-                   (:visited node)))))
+  (if (zero? (:visited node))
+    Long/MAX_VALUE
+    (+ (/ (:score node)
+          (:visited node))
+       (Math/sqrt (/ (* 2 (Math/log parent-visits))
+                     (:visited node))))))

 #_(crit/quick-bench (uct {:score 3.0 :visited 10} 100))

 (defn update-node [root path result]
   (-> root
-      (update-in (concat (interleave (repeat :children) path) [:visited]) inc)
-      (update-in (concat (interleave (repeat :children) path) [:score]) #(+ % result))))
+      (update-in [path :visited] inc)
+      (update-in [path :score] #(+ % result))))

 (defn backprop [root path result]
   (if-not (empty? path)
     (recur (update-node root path result)
-           (butlast path)
+           (subvec path 0 (dec (count path)))
            result)
     (update-node root [] result)))

-(backprop {:visited 0 :score 0 :children {0 {:visited 0 :score 0}}}
-          [0]
-          15)
+(subvec [1 2 3] 0 (dec (count [1 2 3])))

-(defn traverse [node path]
-  (if (empty? path)
-    node
-    (recur (get (:children node) (first path))
-           (rest path))))

-(defn best-child [node]
-  (last (sort-by #(uct (second %) (:visited node)) (:children node))))
-
+(defn best-child [mtcs path]
+  (last (sort-by #(uct (second %) (:visited (mtcs path)))
+                 (filter (fn [[p node]]
+                           (and (= (count p)
+                                   (inc (count path)))
+                                (= (subvec p 0 (count path))
+                                   path))) mtcs))))

 (defn simulate-game [state]
   (if-let [result (check-terminal state)]
@@ -134,32 +133,44 @@
     (let [move (rand-nth (valid-moves state))]
       (recur (perform-move state move)))))

+(defn add-node [move state]
+  (if-let [result (check-terminal state)]
+    {:state state :terminal true :visited 0 :score 0 :result result}
+    {:state state :unvisited (set (valid-moves state)) :action move :visited 0 :score 0 :children {}})
+  )
+
+(defn generate-node [mtcs path state]
+  (if-let [result (check-terminal state)]
+    {:state state :terminal true :visited 0 :score 0 :result result}
+    (reduce (fn [coll move]
+              (assoc coll (conj path move) {:state (perform-move state move) :visited 0 :score 0})
+              )
+            mtcs
+            (valid-moves state)))
+  )
+
+(backprop (generate-node {[] {:visited 0 :score 0}} [] (init)) [6] 1)
+
 (defn process [mtcs path]
-  (if #_false (> (:visited mtcs) 1000)
-    (best-child mtcs)
-    (let [node (traverse mtcs path)
-          child-path (interleave (repeat :children) path)]
+  (let [node (mtcs path)]
       (cond
+        (> (:visited node) 100)
+        (sort mtcs)
+
+        (zero? (:visited node))
+        (recur (-> mtcs
+                 (generate-node path (:state node))
+                 (backprop path (simulate-game (:state node))))
+               [])
+
         (:terminal node)
         (recur (backprop mtcs path (:result node)) [])

-        (not (empty? (:unvisited node)))
-        (let [move (rand-nth (seq (:unvisited node)))
-              new-state (perform-move (:state node) move)
-              new-node (add-node move new-state)
-              result (simulate-game new-state)]
-          (recur (-> mtcs
-                     (update-in (concat child-path [:unvisited]) disj move)
-                     (assoc-in (concat child-path [:children move]) new-node)
-                     (backprop (concat path [move]) result)
-                     ) []))
+        :else (let [[child-path _] (best-child mtcs path)]
+                (recur mtcs child-path)))))

-        :else (let [[child-n _] (best-child node)]
-                (recur mtcs (conj path child-n)))))))
-
-(time (loop [root (add-node :root (init))]
+(time (loop [root {[] {:visited 0 :score 0 :state (init)}}]
    (process root [])))
-

 (defn simulate [state]
   (let [valids (valid-moves state)]


Patched up the multiple validation merge

--- src/themis/core.clj
+++ src/themis/core.clj
@@ -82,7 +82,7 @@
   in a vector."
   ([t rule-set]
    ;; TODO: This can definitely be done better
-   (apply merge-with #(conj [%1] %2) ;; TODO: this will only work well for 1-2 validation rules, otherwise it'll nest
+   (apply merge-with #(flatten (concat [%1] [%2]))
           (flatten (map (fn [result-seq]
                           (map #(apply hash-map %) (partition-all 2 result-seq)))
                         (validation-seq t (query/normalize rule-set))))))
@@ -105,7 +105,8 @@
   (def paul-rules [[[:name :first] [(fn [t-map data-point opt-map] (and (= data-point "Paul")
                                                                         {:a 1 :b 2}))]]
                    [[:pets 0 0] [::w-pets {:pet-name-starts ""}
-                                 (simple-predicate char?) {}]]
+                                 (simple-predicate char?) {}
+                                 (simple-predicate #(= % \w))]]
                    ;[[:*] ['degrandis-pets]] ;This is valid, but we can also just write:
                    [:* 'degrandis-pets]])


Add timeout when querying slave state

Add timeout when querying slave state

--- scheduler/src/cook/mesos/api.clj
+++ scheduler/src/cook/mesos/api.clj
@@ -177,8 +177,12 @@
   "Builds an indexed version of all executor states on the specified slave. Has no cache; takes 100-500ms
    to run."
   [framework-id hostname]
-  (let [slave-state (:body (http/get (str "http://" hostname ":5051/state.json")
-                                     {:as :json-string-keys
+  (let [timeout-millis (* 5 1000)
+        ;; Throw SocketTimeoutException or ConnectionTimeoutException when timeout
+        slave-state (:body (http/get (str "http://" hostname ":5051/state.json")
+                                     {:socket-timeout timeout-millis
+                                      :conn-timeout timeout-millis
+                                      :as :json-string-keys
                                       :spnego-auth true}))
         framework-executors (for [framework (concat (get slave-state "frameworks")
                                                     (get slave-state "completed_frameworks"))


internal workhorse functions are done.

internal workhorse functions are done.

--- clojure/meetup/meetup.clj
+++ clojure/meetup/meetup.clj
@@ -1,6 +1,9 @@
 (ns meetup
   (:require [clj-time.core :as t]
             [clj-time.predicates :as tpr]))
+
+(defn- simple-format [d]
+  [(t/year d) (t/month d) (t/day d)])

 (defn- dates-in
   "returns a list of dates, given the year and month and day-name.
@@ -22,14 +25,12 @@
    nil if position is not in the list.
    e.g. Fourth Sunday of March 2013:
           (schedule-by-week 2013 3 7 4)"
-  (get (dates-in yr mm dow) (dec pos)))
+  (simple-format
+   (nth (dates-in yr mm dow) (dec pos))))

-(defn- schedule-by-range [dates date-range]
-  "returns the first date that's also in the given range. nil if none match"
-  )
-
-;;; mon/tue... teenth
-;;; first/second/third/fourth/last mon/tue day
-
-;;; get last
-;; (get v (dec (count v)))
+(defn- schedule-by-range [yr mm dow date-range]
+  "returns the first date that's also in the given range. nil if none match.
+   e.g. monteenth in May 2013: (schedule-by-range 2013 5 1 (range 13 20))"
+  (simple-format
+   (first (filter #(= 13 (t/day %))
+                  (dates-in yr mm dow)))))


Set `:short-filename` for backwards compatibility

--- src/io/perun/meta.clj
+++ src/io/perun/meta.clj
@@ -13,8 +13,9 @@
 (defn path-meta
   [path out-dir & [file]]
   (let [file (or file (io/file path))
+        filename (.getName file)
+        slug (slug filename)
         match-out-dir (re-pattern (str "^" out-dir))
-        filename (.getName file)
         permalink (-> path
                       (string/replace match-out-dir "")
                       (string/replace #"(^|/)index\.html$" "/")
@@ -24,7 +25,8 @@
      :full-path (.getPath file)
      :permalink permalink
      :filename filename
-     :slug (slug filename)
+     :slug slug
+     :short-filename slug ;; for backwards compatibility
      :extension (perun/extension filename)}))

 (defn meta-from-file


cjl - Gameplay formatting

cjl - Gameplay formatting

--- src/icfp2015/gameplay.clj
+++ src/icfp2015/gameplay.clj
@@ -10,10 +10,15 @@
             ; (println board commands)
             (let [new-command (ai board)
                   new-board (transition-board board new-command)]
-              [new-board (conj commands new-command)]))]
-    (second (last (take-while
-      (fn [[{:keys [current-unit]} _]] current-unit)
-      (rest (iterate f [(assoc initial-board :current-unit unit) '()])))))))
+              [new-board (conj commands new-command)]))
+        while-unit-active (partial
+                            take-while
+                            (fn [[{:keys [current-unit]} _]] current-unit))]
+    (-> (iterate f [(assoc initial-board :current-unit unit) '()])
+        (rest)
+        (while-unit-active)
+        (last)
+        (second))))

 ; (defn get-commands
 ;   "Yields a seq of commands given a game and an AI"


improve API / stop-osc fn

improve API / stop-osc fn

- Make more explicit the difference between osc-impl and osc-model:
  - Make implementation functions private.
  - Rename the fields of osc-impl to :osc-node and :gain-node, making it clearer that they are nodes.
- The osc-model returned by play-note now only includes :osc-node and :gain-node if the osc-impl hasn't been stopped.
- Break out the stopping part into its own public function, stop-osc.

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -23,7 +23,7 @@
       (throw (js/Error. (str type " is not a valid oscillator type."))))
     (assoc osc-map :type type)))

-(defn osc*
+(defn- osc*
   "Creates a one-off oscillator based on a map, hooks it up to a gain node,
    and hooks the gain node up to the destination of the AudioContext.

@@ -36,45 +36,53 @@
     (set! (.-value (.-gain gain)) 0)
     (.connect osc gain)
     (.connect gain (.-destination *audio-context*))
-    {:osc  osc
-     :gain gain}))
+    {:osc-node  osc
+     :gain-node gain}))

-(defn freq [osc hz]
-  (set! (.-value (.-frequency osc)) hz))
+(defn- freq [osc-node hz]
+  (set! (.-value (.-frequency osc-node)) hz))

-(defn gain [gain level]
-  (set! (.-value (.-gain gain)) level))
+(defn- gain [gain-node level]
+  (set! (.-value (.-gain gain-node)) level))

-(defn gain-ramp [gain level]
+(defn- gain-ramp [gain-node level]
   (let [time (.-currentTime *audio-context*)]
-    (.linearRampToValueAtTime (.-gain gain) level (+ time 0.1))))
+    (.linearRampToValueAtTime (.-gain gain-node) level (+ time 0.1))))

-(defn silence [gain]
-  (gain gain 0))
+(defn- silence [gain-node]
+  (gain gain-node 0))

-(defn silence-ramp [gain]
-  (gain-ramp gain 0))
+(defn- silence-ramp [gain-node]
+  (gain-ramp gain-node 0))

+(declare stop-osc)
 (defn play-note
   "Uses a one-off oscillator to play a note.

-   If duration is present, the oscillator is stopped after duration ms.
-   Otherwise, the note rings out indefinitely.
-
-   Returns the input oscillator model, with the new oscillator and gain nodes
-   included so that the oscillator/gain can be stopped or modified later."
+   If duration is present, the oscillator is stopped after duration ms, and the
+   oscillator model is returned unmodified.
+
+   Otherwise, the note rings out indefinitely, and the oscillator model map is
+   returned with two new keys, :osc-node and :gain-node, allowing the osc and
+   gain nodes to be stopped or modified later."
   [osc-model {:keys [pitch duration volume]}]
-  (let [{:keys [osc gain]} (osc* osc-model)]
+  (let [{:keys [osc-node gain-node]} (osc* osc-model)]
     (.start osc 0)

     (when pitch
       (freq osc pitch))

-    (gain-ramp gain (or volume (:gain osc-model) 1))
+    (gain-ramp gain-node (or volume (:gain osc-model) 1))

-    (when duration
-      (js/setTimeout #(silence-ramp gain) duration)
-      (js/setTimeout #(.stop osc) (+ duration 1000)))
+    (if duration
+      (do
+        (js/setTimeout #(stop-osc osc-impl) duration)
+        osc-model)
+      (merge osc-model osc-impl))))

-    (assoc osc-model :osc-node osc :gain-node gain)))
+(defn stop-osc
+  "Silences and stops a currently playing oscillator."
+  [{:keys [osc-node gain-node] :as osc-model-or-impl}]
+  (silence-ramp gain-node)
+  (js/setTimeout #(.stop osc-node) 1000))


unify "mezzogiorno" with all the stuff it needs

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1611,10 +1611,13 @@
               :sem {:pred :lie}}}

    "mezzogiorno"
-   {:synsem {:cat :noun
-             :sem {:pred :noon
-                   :time true}}}
-
+   (unify agreement-noun
+          common-noun
+          countable-noun
+          masculine-noun
+          {:synsem {:cat :noun
+                    :sem {:pred :noon
+                          :time true}}})
    "mi"
    {:synsem {:cat :noun
                :pronoun true


Fix doc references on parallel parser docstring


don't lower-case urls (breaks links)

don't lower-case urls (breaks links)

the url->color helper fn still lower cases, but the title and, more
importantly, the href of the link should preserve case

--- src/braid/ui/views/message.cljs
+++ src/braid/ui/views/message.cljs
@@ -27,17 +27,16 @@
 (def replacements
   {:urls
    {:pattern helpers/url-re
-    :replace (fn [match]
-               (let [url (string/lower-case match)]
-                 [:a.external {:href url
-                               :title url
-                               :style {:background-color  (helpers/url->color url)}
-                               :target "_blank"
-                               ; rel to address vuln caused by target=_blank
-                               ; https://www.jitbit.com/alexblog/256-targetblank---the-most-underestimated-vulnerability-ever/
-                               :rel "noopener noreferrer"
-                               :tabIndex -1}
-                  (abridged-url url)]))}
+    :replace (fn [url]
+               [:a.external {:href url
+                             :title url
+                             :style {:background-color (helpers/url->color url)}
+                             :target "_blank"
+                             ; rel to address vuln caused by target=_blank
+                             ; https://www.jitbit.com/alexblog/256-targetblank---the-most-underestimated-vulnerability-ever/
+                             :rel "noopener noreferrer"
+                             :tabIndex -1}
+                (abridged-url url)])}
    :users
    {:pattern #"@([-0-9a-z]+)"
     :replace (fn [match]


Simplify audio chunker test code and make it more readable

--- src/devcards/audio_utils/devcards/audio_chunker.cljs
+++ src/devcards/audio_utils/devcards/audio_chunker.cljs
@@ -1,6 +1,8 @@
 (ns audio-utils.devcards.audio-chunker
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [devcards.core :refer-macros [defcard deftest dom-node]]
+            [goog.string :as gstring]
+            [goog.string.format]
             [sablono.core :refer-macros [html]]
             [audio-utils.audio-chunker :as c]
             [audio-utils.web-audio :as a]
@@ -12,26 +14,20 @@
 (defn run-test
   [state]
   (swap! state assoc :processing? true)
-  (let [ctx          (a/audio-context)
-        sample-rate  (.-sampleRate ctx)
-        input-data   ((:data-fn @state) sample-rate)
-        input-buffer (let [buffer (.createBuffer ctx 1
-                                                 (count input-data)
-                                                 sample-rate)
-                           data   (.getChannelData buffer 0)]
-                       (doseq [[i x] (map-indexed vector input-data)]
-                         (aset data i x))
-                       buffer)
-        source       (doto (.createBufferSource ctx)
-                       (aset "buffer" input-buffer))
-        chunks       #js []
-        chunker      (c/audio-chunker {:ctx     ctx
-                                       :samples 4410
-                                       :on-chunk-ready
-                                       (fn [channel chunk]
-                                         (when (= 0 channel)
-                                           (.push chunks chunk)))})
-        dest         (.createMediaStreamDestination ctx)]
+  (let [ctx         (a/audio-context)
+        sample-rate (.-sampleRate ctx)
+        input-data  ((:data-fn @state) sample-rate)
+        chunk-size  (:chunk-size @state)
+        source      (a/create-buffer-source ctx 1 sample-rate
+                                            input-data)
+        chunks      #js []
+        chunker     (c/audio-chunker {:ctx     ctx
+                                      :samples chunk-size
+                                      :on-chunk-ready
+                                      (fn [channel chunk]
+                                        (when (= 0 channel)
+                                          (.push chunks chunk)))})
+        dest        (.createMediaStreamDestination ctx)]
     (c/connect-source chunker source)
     (c/connect-destination chunker dest)
     (set! (.-onended source)
@@ -46,24 +42,26 @@
                      :finished?   true
                      :sample-rate sample-rate
                      :input-data  input-data
-                     :chunks      (apply concat (js->clj chunks))))))
+                     :chunks      (js->clj chunks)))))
     (.start source)))

-(defn plot-chunker-test
+(defn chunker-test
   [state]
   (let [{:keys [processing?
                 finished?
                 sample-rate
                 input-data
-                chunks]} @state]
+                chunks]} @state
+        combined-chunks  (apply concat chunks)]
     (cond
       finished?   (plot-buffers (count input-data)
-                                (str "Input Data "
-                                     "(" (count input-data) " samples)")
+                                (gstring/format "Input Data (%d samples)"
+                                                (count input-data))
                                 input-data
-                                (str "Concatenated Chunks "
-                                     "(" (count chunks) " samples)")
-                                chunks)
+                                (gstring/format "%d Chunks (%d samples)"
+                                                (count chunks)
+                                                (count combined-chunks))
+                                combined-chunks)
       processing? (html [:p "Processing..."])
       :else       (html [:button {:on-click #(run-test state)}
                          "Run test"]))))
@@ -75,13 +73,10 @@
    concatenating all chunks, which, if the audio chunker works correctly,
    should be exactly the same."
   (fn [state owner]
-    (plot-chunker-test state))
-  {:processing? false
-   :finished?   false
-   :chunk-size  4410
+    (chunker-test state))
+  {:chunk-size  4410
    :chunks      []
    :input-data  []
-   :sample-rate 0
    :data-fn     (fn [sample-rate]
                   (linear-distribution [-1.0 1.0] 32768))})

@@ -92,12 +87,9 @@
    result of concatenating all chunks, which, if the audio chunker
    works correctly, should be exactly the same."
   (fn [state owner]
-    (plot-chunker-test state))
-  {:processing? false
-   :finished?   false
-   :chunk-size  1000
+    (chunker-test state))
+  {:chunk-size  1000
    :chunks      []
    :input-data  []
-   :sample-rate 0
    :data-fn     (fn [sample-rate]
                   (sine-wave 10 sample-rate 32768))})