Added bake.core/context?, a utility function that returns true when its argument names the current context.

--- bake/bake/core.clj
+++ bake/bake/core.clj
@@ -61,3 +61,8 @@
   `(try (set-context! ~context)
         (do ~@forms)
         (set-project! *project-root*)))
+
+(defn context? [ctx-name]
+  "Returns true iff the argument is the currently selected context. Argument can
+   be anything that clojure.core/name turns into a string."
+  (= (name (:context *project*)) (name ctx-name)))


lazy load inputs and outputs [risk: low] (#1472)

lazy-load cromwell metadata inputs and outputs when viewing workflows. fix task column in the inputs table.

--- src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
+++ src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
@@ -17,6 +17,7 @@
    [broadfcui.endpoints :as endpoints]
    [broadfcui.page.workspace.monitor.common :as moncommon]
    [broadfcui.utils :as utils]
+   [broadfcui.utils.ajax :as ajax]
    ))

 (defn- create-field [label & contents]
@@ -34,11 +35,19 @@
      (str gcs-uri))))

 (defonce default-metadata-includes ["backendLogs" "backendStatus" "end" "executionStatus" "callCaching:hit" "failures"
-                                    "id" "inputs" "jobId" "outputs" "start" "status" "stderr" "stdout" "submission" "subworkflowId"
-                                    "submittedFiles:inputs" "workflowLog" "workflowName" "workflowRoot"])
+                                    "id" "jobId" "start" "status" "stderr" "stdout" "submission" "subworkflowId"
+                                    "workflowLog" "workflowName" "workflowRoot"])

 (defonce metadata-timing-includes ["attempt" "description" "end" "endTime" "executionEvents" "executionStatus"
                                    "shardIndex" "start" "startTime" "workflowName"])
+
+(defonce metadata-inputs-includes ["submittedFiles:inputs" "inputs"])
+
+;; requesting executionStatus for outputs makes the response payload somewhat larger, but it forces Cromwell to return
+;; data about every call in a task scatter. Otherwise, if we request just includeKey=outputs and a scatter contains both
+;; successes and failures, Cromwell will return only those calls that have outputs, i.e. the successes. Since our CLJS code
+;; identifies calls by their index in an array, this causes off-by-one (or off-by-many) functional errors.
+(defonce metadata-outputs-includes ["executionStatus" "outputs"])

 (defn getTimingDiagramHeight [chartContainer]
   (let [e (-> chartContainer (.-childNodes)
@@ -64,30 +73,42 @@
      {:expanded false})
    :render
    (fn [{:keys [props state]}]
-     [:div {}
-      (create-field
-       (:label props)
-       (if (empty? (:data props))
-         "None"
-         (links/create-internal {:onClick #(swap! state update :expanded not)}
-           (if (:expanded @state) "Hide" "Show"))))
-      (when (:expanded @state)
-        [:div {:style {:padding "0.25em 0 0.25em 1em"}}
-         (let [namespace (get-in props [:workspace-id :namespace])
-               columns [{:header "Label"
-                         :column-data #(last (string/split (key %) #"\."))}
-                        {:header "Value"
-                         :initial-width :auto
-                         :sortable? false
-                         :column-data #(display-value namespace (second %))}]
-               task-column {:header "Task"
-                            :column-data #(second (string/split (key %) #"\."))}]
-           [Table
-            {:data (:data props)
-             :body {:style table-style/table-heavy
-                    :behavior {:reorderable-columns? false
-                               :filterable? false}
-                    :columns (if (:call-detail? props) columns (cons task-column columns))}}])])])})
+     (let [{:keys [data-fn data-path data workspace-id]} props]
+       [:div {}
+        (create-field
+         (:label props)
+           ;; when the user clicks to expand, trigger the request to get data
+           (links/create-internal {:onClick #(when (:expanded (swap! state update :expanded not)) (data-fn))}
+             (if (:expanded @state) "Hide" "Show")))
+        (when (:expanded @state)
+          (cond
+            (nil? data)
+              (spinner (str "Loading " (:label props) "...")) ;; show a spinner while data from the onClick loads
+            (not (:success? data))
+              (style/create-inline-error-message (:response data))
+            :else
+              ;; some portions of the metadata response from Cromwell are escaped json strings (e.g. submittedFiles/inputs),
+              ;; instead of valid json. Handle that transparently here: if we detect the target data is a string, attempt to parse it.
+              (let [raw-data (get-in data (cons :response data-path))
+                    usable-data (if (string? raw-data) (utils/parse-json-string raw-data) raw-data)]
+                (if (empty? usable-data)
+                  [:div {:style {:padding "0.25em 0 0.5em 1em" :font-style "italic"}} (str "No " (:label props) ".")]
+                  [:div {:style {:padding "0.25em 0 0.25em 1em"}}
+                    (let [namespace (get-in props [:workspace-id :namespace])
+                          columns [{:header "Label"
+                                    :column-data #(last (string/split (key %) #"\."))}
+                                   {:header "Value"
+                                    :initial-width :auto
+                                    :sortable? false
+                                    :column-data #(display-value namespace (second %))}]
+                          task-column {:header "Task"
+                                       :column-data #(second (rseq (string/split (key %) #"\.")))}]
+                      [Table
+                       {:data usable-data
+                        :body {:style table-style/table-heavy
+                               :behavior {:reorderable-columns? false
+                                          :filterable? false}
+                               :columns (if (:call-detail? props) columns (cons task-column columns))}}])]))))]))})

 (react/defc- WorkflowTimingDiagram
   {:render
@@ -220,54 +241,9 @@
 (defn- render-gcs-path [components]
   (str moncommon/google-storage-context (string/join "/" components) "/"))

-;; recursive partner of render-subworkflow-detail
+;; recursive partner of render-workflow-detail
 (declare CallDetail)
-
-;; Subworkflows contain a lot of information that is redundant to what can be seen from the Calls
-;; Only show new information
-(defn- render-subworkflow-detail [workflow raw-data workflow-name submission-id use-call-cache workspace-id gcs-path-prefix]
-  (let [inputs (ffirst (workflow "calls"))
-        input-names (string/split inputs ".")
-        workflow-name-for-path (first input-names)
-        subworkflow-path-components (conj gcs-path-prefix workflow-name-for-path (workflow "id"))]
-    [:div {:style {:padding "1em" :border style/standard-line :borderRadius 4
-                   :backgroundColor (:background-light style/colors)}}
-     (create-field "Subworkflow ID" (links/create-external {:href (render-gcs-path subworkflow-path-components)} (workflow "id")))
-     (when (seq (workflow "calls"))
-       [WorkflowTimingContainer (merge {:label "Workflow Timing"} (utils/restructure workspace-id submission-id workflow))])
-     (when-let [failures (workflow "failures")]
-       [Failures {:data failures}])
-     (when (seq (workflow "calls"))
-       [:div {:style {:marginTop "1em" :fontWeight 500}} "Calls:"])
-     (for [[call data] (workflow "calls")]
-       [CallDetail {:label call :data data :submission-id submission-id :use-call-cache use-call-cache :workflowId (workflow "id")
-                    :workspace-id workspace-id :gcs-path-prefix subworkflow-path-components}])]))
-
-(react/defc- SubworkflowDetails
-  {:render
-   (fn [{:keys [state props]}]
-     [:div {}
-      (let [server-response (:server-response @state)]
-        (cond
-          (nil? server-response)
-          (spinner "Loading subworkflow details...")
-          (not (:success? server-response))
-          (style/create-server-error-message (:response server-response))
-          :else
-          (render-subworkflow-detail (:response server-response) (:raw-response server-response)
-                                     (:workflow-name props) (:submission-id props) (:use-call-cache props)
-                                     (:workspace-id props) (:gcs-path-prefix props))))])
-      :component-did-mount
-      (fn [{:keys [props state]}]
-        (endpoints/call-ajax-orch
-          {:endpoint
-           (endpoints/get-workflow-details
-             (:workspace-id props) (:submission-id props) (:workflow-id props))
-           :on-done (fn [{:keys [success? get-parsed-response status-text raw-response]}]
-                      (swap! state assoc :server-response
-                             {:success? success?
-                              :response (if success? (get-parsed-response false) status-text)
-                              :raw-response raw-response}))}))})
+(declare WorkflowDetails)

 (react/defc- CallDetail
   {:get-initial-state
@@ -278,7 +254,8 @@
    (fn [{:keys [props state]}]
      (let [call-path-components (conj (:gcs-path-prefix props) (str "call-" (call-name (:label props))))
            all-call-statuses (set (map #(get % "executionStatus") (:data props)))
-           workspace-namespace (get-in props [:workspace-id :namespace])]
+           workspace-namespace (get-in props [:workspace-id :namespace])
+           {:keys [label inputs-fn inputs-data outputs-fn outputs-data]} props]
        [:div {:style {:marginTop "1em"}}
         (when (:show-operation-dialog? @state)
           [OperationDialog (:operation-dialog-props @state)])
@@ -297,7 +274,7 @@
                    (str "Call #" (inc index) " (Subworkflow ID " subWorkflowId "): ")
                    (if (contains? (:subworkflow-expanded @state) subWorkflowId)
                      [:span {}
-                      ;; click to hide this SubworkflowDetails and remove from the :subworkflow-expanded map in @state
+                      ;; click to hide this subworkflow's WorkflowDetails and remove from the :subworkflow-expanded map in @state
                       (links/create-internal {:onClick #(swap! state update :subworkflow-expanded
                                                                (fn [expanded-map]
                                                                  (dissoc expanded-map subWorkflowId)))}
@@ -306,8 +283,10 @@
                       (let [subworkflow-path-prefix (if (>= (data "shardIndex") 0)
                                                       (conj call-path-components (str "shard-" index))
                                                       call-path-components)]
-                        [SubworkflowDetails (merge (select-keys props [:workspace-id :submission-id :use-call-cache :workflow-name])
-                                                   {:workflow-id subWorkflowId
+                        [WorkflowDetails (merge (select-keys props [:workspace-id :submission-id :use-call-cache :workflow-name
+                                                                       :inputs-fn :inputs-data :outputs-fn :outputs-data])
+                                                   {:subworkflow? true
+                                                    :workflow-id subWorkflowId
                                                     :gcs-path-prefix subworkflow-path-prefix})])]
                      ;; click to show subworkflow details and add it to the :subworkflow-expanded map in @state
                      (links/create-internal {:onClick #(swap! state assoc-in
@@ -330,10 +309,9 @@
                 (when (and (:use-call-cache props) (some? (get (data "callCaching") "hit")))
                   (create-field "Cache Result" (moncommon/format-call-cache (get (data "callCaching") "hit"))))
                 (create-field "Started" (moncommon/render-date (data "start")))
-                ;(utils/cljslog data)
                 (create-field "Ended" (moncommon/render-date (data "end")))
-                [IODetail {:label "Inputs" :data (data "inputs") :call-detail? true :workspace-id (:workspace-id props)}]
-                [IODetail {:label "Outputs" :data (data "outputs") :call-detail? true :workspace-id (:workspace-id props)}]
+                [IODetail {:label "Inputs" :data-path ["calls" label index "inputs"] :data-fn inputs-fn :data inputs-data :call-detail? (not (data "subWorkflowId")) :workspace-id (:workspace-id props)}]
+                [IODetail {:label "Outputs" :data-path ["calls" label index "outputs"] :data-fn outputs-fn :data outputs-data :call-detail? (not (data "subWorkflowId")) :workspace-id (:workspace-id props)}]
                 (when-let [stdout (data "stdout")]
                   (create-field "stdout" (display-value workspace-namespace stdout (last (string/split stdout #"/")))))
                 (when-let [stderr (data "stderr")]
@@ -363,29 +341,33 @@
                          {:success? success?
                           :response (if success? (:cost (get-parsed-response)) (str "Error: " (or (:message (get-parsed-response)) status-text)))}))}))})

-(defn- render-workflow-detail [workflow raw-data workflow-name submission-id use-call-cache workspace-id gcs-path-prefix]
+(defn- render-workflow-detail [workflow raw-data workflow-name submission-id use-call-cache workspace-id gcs-path-prefix inputs-fn inputs-data outputs-fn outputs-data subworkflow?]
   (let [inputs (ffirst (workflow "calls"))
         input-names (string/split inputs ".")
         workflow-name-for-path (first input-names)
-        workflow-path-components (conj gcs-path-prefix workflow-name-for-path (workflow "id"))]
+        workflow-path-components (conj gcs-path-prefix workflow-name-for-path (workflow "id"))
+        unit-name (if subworkflow? "Subworkflow" "Workflow")]
     [:div {:style {:padding "1em" :border style/standard-line :borderRadius 4
                    :backgroundColor (:background-light style/colors)}}
-     (create-field "Workflow ID" (links/create-external {:href (render-gcs-path workflow-path-components)} (workflow "id")))
-     (let [status (workflow "status")]
-       (create-field "Status" (moncommon/icon-for-wf-status status) status))
-     [WorkflowCost {:workspace-id workspace-id
-                    :submission-id submission-id
-                    :workflow-id (workflow "id")}]
-     (when-let [submission (workflow "submission")]
-       (create-field "Submitted" (moncommon/render-date submission)))
-     (when-let [start (workflow "start")]
-       (create-field "Started" (moncommon/render-date start)))
-     (when-let [end (workflow "end")]
-       (create-field "Ended" (moncommon/render-date end)))
-     [IODetail {:label "Inputs" :data (utils/parse-json-string (get-in workflow ["submittedFiles", "inputs"])) :workspace-id workspace-id}]
-     [IODetail {:label "Outputs" :data (workflow "outputs") :workspace-id workspace-id}]
-     (when-let [workflowLog (workflow "workflowLog")]
-       (create-field "Workflow Log" (display-value (:namespace workspace-id) workflowLog (str "workflow." (workflow "id") ".log"))))
+     (create-field (str unit-name  " ID") (links/create-external {:href (render-gcs-path workflow-path-components)} (workflow "id")))
+     ;; Subworkflows contain a lot of information that is redundant to what can be seen from the Calls
+     ;; Only show new information
+     (when-not subworkflow? [:div {}
+      (let [status (workflow "status")]
+        (create-field "Status" (moncommon/icon-for-wf-status status) status))
+      [WorkflowCost {:workspace-id workspace-id
+                      :submission-id submission-id
+                      :workflow-id (workflow "id")}]
+      (when-let [submission (workflow "submission")]
+        (create-field "Submitted" (moncommon/render-date submission)))
+      (when-let [start (workflow "start")]
+        (create-field "Started" (moncommon/render-date start)))
+      (when-let [end (workflow "end")]
+        (create-field "Ended" (moncommon/render-date end)))
+      [IODetail {:label "Inputs" :data-path ["submittedFiles" "inputs"] :data-fn inputs-fn :data inputs-data :workspace-id workspace-id}]
+      [IODetail {:label "Outputs" :data-path ["outputs"] :data-fn outputs-fn :data outputs-data :workspace-id workspace-id}]
+      (when-let [workflowLog (workflow "workflowLog")]
+        (create-field "Workflow Log" (display-value (:namespace workspace-id) workflowLog (str "workflow." (workflow "id") ".log"))))])
      (when (seq (workflow "calls"))
        [WorkflowTimingContainer (merge {:label "Workflow Timing"} (utils/restructure workspace-id submission-id workflow))])
      (when-let [failures (workflow "failures")]
@@ -393,16 +375,25 @@
      (when (seq (workflow "calls"))
        [:div {:style {:marginTop "1em" :fontWeight 500}} "Calls:"])
      (for [[call data] (workflow "calls")]
-       [CallDetail {:label call :data data :submission-id submission-id :use-call-cache use-call-cache :workflowId (workflow "id")
-                    :workspace-id workspace-id :gcs-path-prefix workflow-path-components}])]))
+        [CallDetail (conj (utils/restructure data submission-id use-call-cache workspace-id
+                                             inputs-fn inputs-data outputs-fn outputs-data)
+                          {:label call
+                           :workflowId (workflow "id")
+                           :gcs-path-prefix workflow-path-components})])]))

 (react/defc- WorkflowDetails
-  {:render
-   (fn [{:keys [state props]}]
-     (let [metadata-response (:metadata-response @state)]
+  {:get-default-props
+   (fn [] {:subworkflow? false})
+   :get-initial-state
+   (fn [] {:metadata-inputs-lock? false
+           :metadata-outputs-lock? false})
+   :render
+   (fn [{:keys [state props this]}]
+     (let [metadata-response (:metadata-response @state)
+           unit-name (if (:subworkflow? props) "subworkflow" "workflow")]
        (cond
          (nil? metadata-response)
-         (spinner "Loading workflow details...")
+         [:div {} (spinner (str "Loading " unit-name " details..."))]
          (not (:success? metadata-response))
          (style/create-server-error-message (:response metadata-response))
          :else
@@ -412,7 +403,10 @@
          (let [workflow-path-prefix [(:bucketName props) (:submission-id props)]]
            (render-workflow-detail (:response metadata-response) (:raw-response metadata-response)
                                    (:workflow-name props) (:submission-id props) (:use-call-cache props)
-                                   (:workspace-id props) workflow-path-prefix)))))
+                                   (:workspace-id props) workflow-path-prefix
+                                   #(this :get-inputs) (:metadata-inputs @state)
+                                   #(this :get-outputs) (:metadata-outputs @state)
+                                   (:subworkflow? props))))))
    :component-did-mount
    (fn [{:keys [props state]}]
      (endpoints/call-ajax-orch
@@ -423,8 +417,29 @@
                   (swap! state assoc :metadata-response
                          {:success? success?
                           :response (if success? (get-parsed-response false) status-text)
-                          :raw-response raw-response}))}))})
-
+                          :raw-response raw-response}))}))
+  :get-outputs
+  (fn [{:keys [this]}]
+    (this :-get-io :metadata-outputs :metadata-outputs-lock? metadata-outputs-includes))
+  :get-inputs
+  (fn [{:keys [this]}]
+    (this :-get-io :metadata-inputs :metadata-inputs-lock? metadata-inputs-includes))
+  :-get-io
+  (fn [{:keys [props state]} data-key lock-key includes]
+    (when-not (or (lock-key @state) (data-key @state))
+      (do
+        (swap! state assoc lock-key true)
+        (endpoints/call-ajax-orch
+          {:endpoint
+          (endpoints/get-workflow-details
+            (:workspace-id props) (:submission-id props) (:workflow-id props) includes)
+          :on-done (fn [{:keys [success? get-parsed-response status-text status-code raw-response]}]
+                      (swap! state assoc data-key
+                            {:success? success?
+                              :response (if success? (get-parsed-response false)
+                                                     (ajax/extract-error-message get-parsed-response status-text status-code))
+                              :raw-response raw-response})
+                      (swap! state assoc lock-key false))}))))})

 (defn render [props]
   (assert (every? #(contains? props %) #{:workspace-id :submission-id :use-call-cache :workflow-id}))


whitespace fix

whitespace fix

--- search-app/src/cmr/search/data/elastic_relevancy_scoring.clj
+++ search-app/src/cmr/search/data/elastic_relevancy_scoring.clj
@@ -68,7 +68,7 @@
   (let [use-keyword-sort? (keywords-extractor/contains-keyword-condition? query)
         use-usage-sort? (seq (->> query
                                   :sort-keys
-                                  (filter #(= :usage-relevancy-score (:field %)))))
+                                  (filter #(= :usage-relevancy-score (:field %)))))
         use-temporal-sort? (and (temporal-conditions/contains-temporal-conditions? query)
                                 (sort-use-temporal-relevancy))]
     (seq


insert preparations

insert preparations

--- src/clj_hypergraph_db/sql_parser/uml_to_sql_persistance_manager.clj
+++ src/clj_hypergraph_db/sql_parser/uml_to_sql_persistance_manager.clj
@@ -93,15 +93,24 @@
   (let [extent-tables (find-all-items-by-type configuration-map :foreach)
         credentials (first access-map)
         statement (.createStatement (get-connection (:database-name credentials) (:user-name credentials) (:password credentials)))]
-    (println credentials)
-    (println statement)
-    (println extent-tables)
-      (doseq
-          [{table :table body :body} extent-tables
-           :let [{extent-entity-name :name
-                  extent-entity-mappings :mappings} (find-first-item-by-type body :add-entity)]
-           :when extent-entity-name]
-        (println extent-entity-name)
-        )
-    )
-  )
+    #_(println credentials)
+    #_(println statement)
+    #_(println extent-tables)
+    (doseq
+        [{name :name body :body} extent-tables
+         :let [iterator (iterator-create :class name)
+               curent-instance (atom (iterator-next iterator))]]
+      #_(println body)
+      (println curent-instance)
+        (while @curent-instance
+          (doseq
+              [{mappings :mappings [table] :table} (find-all-items-by-type body :add-entity)
+               :let [columns (StringBuilder.) values (StringBuilder.)]]
+
+            )
+          )
+          (reset! curent-instance (iterator-next iterator)))))
+
+;:let [{extent-entity-name :name
+;       extent-entity-mappings :mappings} (find-first-item-by-type body :add-entity)]
+;:when extent-entity-name


Removed android.routes

Removed android.routes

--- src/luno/android/routes.cljs
+++ src/luno/android/routes.cljs
@@ -1,7 +0,0 @@
-(ns luno.android.routes)
-
-(def routes
-  {:main  {:name  "main"
-           :index 1}
-   :about {:name  "about"
-           :index 2}})


Removed hardcoded client

Removed hardcoded client

--- src/ardoq/swagger/api.clj
+++ src/ardoq/swagger/api.clj
@@ -40,12 +40,6 @@
       true
       false))

-
-;;TODO Remove upon launch
-(def client (c/client {:url "http://127.0.0.1:8080"
-                       :token "2330f05eac3846f78a13b01930099b97"
-                       :org "ardoq"}))
-
 (defn get-spec [client url name headers swag]
   ;if swag is not null then use that as spec
   (let [spec (if (not (blank? swag)) (parse-string swag true) (get-resource-listing url headers))]


Simplify

Simplify

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

--- clojure/sequence_generator.clj
+++ clojure/sequence_generator.clj
@@ -26,7 +26,7 @@
       (assoc event
         dim-index-kw i
         dim (nth dim-vals i)))
-    events))
+    (map #(assoc % dim-index-kw 0) events)))

 (defn create-loops [dimensions]
   (reduce #(apply (partial nest-loop %1) %2) [{:task :snap}] dimensions))
@@ -83,16 +83,6 @@
         (assoc e2 :wait-time-ms interval-ms)
         e2))))

-(defn fill-in-missing-indices
-  ([events index]
-    (for [event events]
-      (if (contains? event index)
-        event
-        (assoc event index 0))))
-  ([events]
-    (reduce fill-in-missing-indices events
-      [:position-index :slice-index :channel-index :frame-index])))
-
 (defn generate-acq-sequence [settings]
   (let [{:keys [slices keep-shutter-open-channels keep-shutter-open-slices
          use-autofocus autofocus-skip interval-ms]} settings]
@@ -102,7 +92,7 @@
       (process-channel-skip-frames)
       (process-use-autofocus use-autofocus autofocus-skip)
       (process-wait-time interval-ms)
-      (fill-in-missing-indices))))
+      )))

 ; Testing:


CMR-1033: Refactor get-access-log-handler into its own function

--- common-lib/src/cmr/common/api/web_server.clj
+++ common-lib/src/cmr/common/api/web_server.clj
@@ -29,6 +29,14 @@
   Akamai recommend 860 bytes. We're transmitting UTF-8 which should be about a byte a character."
   860)

+(defn get-access-log-handler
+  [server]
+  (doto (RequestLogHandler.)
+    (.setHandler (.getHandler server))
+    (.setRequestLog
+      (doto (NCSARequestLog.)
+        (.setLogLatency true)))))
+
 (defrecord WebServer
   [
    ;; The port Jetty will be running on
@@ -56,19 +64,7 @@
                                                     :min-threads MIN_THREADS
                                                     :max-threads MAX_THREADS})]

-
-
-            ; ;; Replace the existing handler with the gzip handler
-            ; (doto server
-            ;   (.stop)
-            ;   (.setHandler new-handler)
-            ;   (.start))))
-
-        (let [access-log-handler (doto (RequestLogHandler.)
-                                   (.setHandler (.getHandler server))
-                                   (.setRequestLog
-                                     (doto (NCSARequestLog.)
-                                       (.setLogLatency true))))]
+        (let [access-log-handler (get-access-log-handler server)]


A unlimited semaphore does not need a max-concurrency level

--- src/beehive/semaphore.clj
+++ src/beehive/semaphore.clj
@@ -31,5 +31,5 @@
 (defn semaphore [max-concurrency reason]
   (LongSemaphore. reason (long max-concurrency)))

-(defn unlimited-semaphore [max-concurrency]
+(defn unlimited-semaphore []
   (UnlimitedSemaphore.))


compute tweet diffusion

compute tweet diffusion

--- src/clj/ceres/curator.clj
+++ src/clj/ceres/curator.clj
@@ -116,7 +116,7 @@
 (defn get-tweets
   "Fetches all tweets by a given twitter user"
   [user]
-  (->> (mc/find (:db @mongo-state) "tweets" {"user.screen_name" user})
+  (->> (mc/find (:db @mongo-state) "tweets" {:user.screen_name user :created_at {$gt (t/date-time 2014 7 1)}})
        seq
        (map #(from-db-object % true))))

@@ -189,6 +189,17 @@
                                                            {"retweeted_status.user.screen_name" user}
                                                            {"in_reply_to_screen_name" user}]}
                                                     {:created_at {$gt (t/date-time 2014 7 1)}}]})))
+
+(defn compute-tweet-diffusion [tweet-id]
+  (let [neighbor-tweets (->> (mc/find
+                              (:db @mongo-state)
+                              "tweets"
+                              {$and [{$or [{"retweeted_status.id_str" tweet-id}
+                                           {"in_reply_to_status_id_str" tweet-id}]}
+                                     {:created_at {$gt (t/date-time 2014 7 1)}}]})
+                             (pmap #(from-db-object % true)))
+        neightbar-ids (pmap :id_str neighbor-tweets)]
+    (merge neighbor-tweets (pmap #(compute-tweet-diffusion %) neightbar-ids))))

 (defn get-news-diffusion []
@@ -215,10 +226,9 @@

 (comment

-  (get-hashtag-distribution 6 16)
-
-
-  (compute-diffusion "SZ")
+  (let [ids (mapv :id_str (get-tweets "SPIEGELONLINE"))]
+    (compute-tweet-diffusion (nth ids 11)))
+

   (->>
    (mc/find
@@ -244,4 +254,8 @@
       (:db @mongo-state)
       "tweets"
       (:_id x)
-      (update-in x [:created_at] #(f/parse (:custom-formatter @mongo-state) (:created_at %)))))))
+      (update-in x [:created_at] #(f/parse (:custom-formatter @mongo-state) (:created_at %))))))
+
+
+
+)


add :build-options to the analysis evironment

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1712,7 +1712,7 @@
              (binding [*cljs-ns* 'cljs.user
                        *cljs-file* path
                        reader/*alias-map* (or reader/*alias-map* {})]
-               (let [env (empty-env)
+               (let [env (assoc (empty-env) :build-options opts)
                      ns  (loop [ns nil forms (seq (forms-seq res))]
                            (if forms
                              (let [form (first forms)


Fix stored failure mapping

Fix stored failure mapping

--- src/clj/runbld/schema.clj
+++ src/clj/runbld/schema.clj
@@ -200,26 +200,18 @@
   {(s/required-key :report-has-tests) s/Bool
    (s/optional-key :report) TestSummary})

-(def StoredFailure
-  {:error-type s/Str
-   :class      s/Str
-   :test       s/Str
-   :type       s/Str
-   :summary    s/Str
-   :message    s/Str})
-
 (def StoredTestSummary
   {:errors   s/Num
    :failures s/Num
    :tests    s/Num
    :skipped  s/Num
    :failed-testcases
-   {:error-type s/Str
-    :class      s/Str
-    :test       s/Str
-    :type       s/Str
-    :summary    s/Str
-    :message    s/Str}})
+   [{:error-type s/Str
+     :class      s/Str
+     :test       s/Str
+     :type       s/Str
+     :summary    s/Str
+     (s/optional-key :message) s/Str}]})

 (def StoredFailure
   (merge


wip, don't use

wip, don't use

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -8,7 +8,7 @@

 (ns cljs.reader
   (:require [goog.string :as gstring
-             goog.string.StringBuffer :as gstringbuf]))
+             goog.string.StringBuffer :as gsb]))

 (defprotocol PushbackReader
   (read-char [reader] "Returns the next char from the Reader,
@@ -47,11 +47,6 @@
   [ch]
   (= \; ch))

-(defn- meta-prefix?
-  "Checks whether the character begins metadata"
-  [ch]
-  (= \^ ch))
-
 (defn- number-literal?
   "Checks whether the reader is at the start of a number literal"
   [reader ch]
@@ -65,22 +60,7 @@
   "Checks whether the character starts a string"
   [ch])

-(defn- list-prefix?
-  "Checks whether the char is the start of a list literal"
-  [ch]
-  (= ch "("))
-
-(defn- vector-prefix?
-  "Checks whether the char is the start of a vector literal"
-  [ch]
-  (= ch "["))
-
-(defn- map-prefix?
-  "Checks whether the char is the start of a map literal"
-  [ch]
-  (= ch "{"))
-
-(declare read rmacros)
+(declare read macros dispatch-macros)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; read helpers
@@ -105,12 +85,12 @@

 (defn read-delimited-list
   [delim rdr recursive?]
-  (loop [a ()]
+  (loop [a []]
     (let [ch (read-past whitespace? rdr)]
       (when-not ch (throw "EOF"))
       (if (= delim ch)
         a
-        (if-let [macrofn (get rmacros ch)]
+        (if-let [macrofn (get dispatch-macros ch)]
           (let [mret (macrofn rdr ch)]
             (recur (if (= mret rdr) a (conj a mret))))
           (do
@@ -122,13 +102,29 @@
 ;; data structure readers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(defn not-implemented
+  [rdr ch]
+  (throw (str "Reader for " ch " not implemented yet")))
+
+(defn read-dispatch
+  [rdr _]
+  (let [ch (read-char rdr)
+        dm (get dispatch-macros ch)]
+    (if dm
+      (dm rdr _)
+      (throw (str "No dispatch macro for " ch)))))
+
+(defn read-unmatched-delimiter
+  [rdr ch]
+  (throw (str "Unmached delimiter " ch)))
+
 (defn read-list
   [rdr _]
-  (read-delimited-list ")" rdr true))
+  (apply list (read-delimited-list ")" rdr true)))

 (defn read-vector
   [rdr _]
-  (vec (read-delimited-list "]" rdr true)))
+  (read-delimited-list "]" rdr true))

 (defn read-map
   [rdr _]
@@ -141,7 +137,26 @@
   [rdr _]
   (set (read-delimited-list "}" rdr true)))

-(def rmacros
+(def macros
+  { \" read-string
+    \; read-comment
+    \' not-implemented
+    \@ not-implemented
+    \^ read-meta
+    \` not-implemented
+    \~ not-implemented
+    \( read-list
+    \) read-unmatched-delimiter
+    \[ read-vector
+    \] read-unmatched-delimiter
+    \{ read-map
+    \} read-unmatched-delimiter
+    \\ read-char
+    \% not-implemented
+    \# read-dispatch
+    })
+
+(def dispatch-macros
   {"{" read-set})

 (defn read-number
@@ -170,6 +185,16 @@
       (if (satisfies? IWithMeta o)
         (with-meta o (merge (meta o) m))
         (throw "Metadata can only be applied to IWithMetas")))))
+
+#_(defn read-token
+  [rdr initch]
+  (let [sb (gsb/StringBuffer. initch)]
+    (loop [ch (read-char rdr)]
+      (if (or (nil? ch)
+              (whitespace? ch)
+              (macro-terminating? ch))
+        (do (unread rdr ch) s)
+        (recur (.append sb ch))))))

 (defn read
   "Reads the first object from a PushbackReader. Returns the object read.
@@ -180,12 +205,7 @@
      (nil? ch) sentinel
      (whitespace? ch) (recur reader eof-is-error sentinel is-recursive)
      (comment-prefix? ch) (recur (skip-line reader) eof-is-error sentinel is-recursive)
-     (number-literal? reader) (read-number reader ch)
-     (string-prefix? ch) (read-string reader ch)
-     (list-prefix? ch) (read-list reader ch)
-     (vector-prefix? ch) (read-vector reader ch)
-     (map-prefix? ch) (read-map reader ch)
-     (meta-prefix? ch) (read-meta reader ch)
+     (macros ch) ((macros ch) reader ch)
      :default (read-symbol reader ch))))


* src/cljs/cljs/reader.cljs: remove comment

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -216,9 +216,6 @@
           (validate-unicode-escape unicode-4-pattern reader ch)
           (make-unicode-char))

-        ; unsure about how this might arise
-        ; - need was implied from original calling context in escape-char
-        ; can someone in the know please confirm
         (numeric? ch)
         (.fromCharCode js/String ch)


Reduce number of iterations to 20

Reduce number of iterations to 20

--- src/cljs/nchart/core.cljs
+++ src/cljs/nchart/core.cljs
@@ -514,7 +514,7 @@
                           (interleave nodes segment-containers))]
     (loop [seeded-graph (update-in sparse-graph [:layers 0] assoc :alternating alternating)
            counter 0]
-      (if (= counter 30)
+      (if (= counter 20)
         seeded-graph
         (let [ordered-graph (order-graph-once seeded-graph)
               last-alternating (-> ordered-graph :layers peek :alternating)


refactored out default reload method

refactored out default reload method

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -139,13 +139,19 @@
                                                 2000))))
       (set! (.-onerror socket) (fn [x] (log opts "Figwheel: socket error ")))))

-(defn watch-and-reload [& {:keys [retry-count websocket-url jsload-callback] :as opts}]
+(defn default-jsload-callback [url]
+  (.dispatchEvent (.querySelector js/document "body")
+                  (js/CustomEvent. "figwheel.js-reload"
+                                   (js-obj "detail" url))))
+
+(defn watch-and-reload-with-opts [opts]
   (defonce watch-and-reload-singleton
-    (watch-and-reload* (merge { :retry-count 100
-                                :jsload-callback (fn [url]
-                                                  (.dispatchEvent (.querySelector js/document "body")
-                                                                  (js/CustomEvent. "figwheel.js-reload"
-                                                                                (js-obj "detail" url))))
-                                :websocket-url (str "ws:" js/location.host "/figwheel-ws")}
-                              opts))))
+    (watch-and-reload*
+     (merge { :retry-count 100
+              :jsload-callback default-jsload-callback
+              :websocket-url (str "ws:" js/location.host "/figwheel-ws")}
+            opts))))

+(defn watch-and-reload [& opts]
+  (watch-and-reload-with-opts opts))
+


throw ex-infos with errors

throw ex-infos with errors

instead of setting error-values

--- src/er_cassandra/model/select.clj
+++ src/er_cassandra/model/select.clj
@@ -124,11 +124,13 @@
                                      record-or-key-value
                                      opts)

-           (d/error-deferred [:fail
-                              {:model model
-                               :key key
-                               :from from}
-                              :no-matching-table])))
+           (d/error-deferred (ex-info
+                              "no matching table"
+                              {:reason [:fail
+                                        {:model model
+                                         :key key
+                                         :from from}
+                                        :no-matching-table]}))))

        (if-let [table (or (if-primary-key-table model key)
                           (if-secondary-key-table model key))]
@@ -149,10 +151,12 @@
                                      record-or-key-value
                                      opts)

-           (d/error-deferred [:fail
-                              {:model model
-                               :key key}
-                              :no-matching-key])))))))
+           (d/error-deferred (ex-info
+                              "no matching key"
+                              {:reason [:fail
+                                        {:model model
+                                         :key key}
+                                        :no-matching-key]}))))))))

 (defn select
   ([session ^Model model key record-or-key-value]


aleph: Undo all my changes. I was fixing a non-problem.

--- frameworks/Clojure/aleph/hello/src/hello/handler.clj
+++ frameworks/Clojure/aleph/hello/src/hello/handler.clj
@@ -7,23 +7,21 @@
     [clj-tuple :as t])
   (:gen-class))

-(defn plaintext-response
-  []
+(def plaintext-response
   (t/hash-map
     :status 200
     :headers (t/hash-map "content-type" "text/plain; charset=utf-8")
     :body (bs/to-byte-array "Hello, World!")))

-(defn json-response
-  []
+(def json-response
   (t/hash-map
     :status 200
     :headers (t/hash-map "content-type" "application/json")))

 (defn handler [{:keys [uri] :as req}]
   (cond
-    (= "/plaintext" uri) (plaintext-response)
-    (= "/json" uri) (assoc (json-response)
+    (= "/plaintext" uri) plaintext-response
+    (= "/json" uri) (assoc json-response
                       :body (json/encode (t/hash-map :message "Hello, World!")))
     :else {:status 404}))


Fix typo.

Fix typo.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -45,6 +45,7 @@
         unread-cap-ms (if (zero? config/unread-cap-days)
                         (* 60 60 24 365 50 1000) ;; default is 50 years cap if no config is set
                         (* 60 60 24 config/unread-cap-days 1000))]
+    (println "DBG read-paginated-entries cap days" config/unread-cap-days "->" unread-cap-ms)
     (db-common/with-timeout db-common/default-timeout
       (as-> (r/table table-name) query
             (r/get-all query index-values {:index index-name})
@@ -93,14 +94,14 @@
                     unread-entry? (r/not (r/contains (r/keys read-items-map) (r/get-field post-row :uuid)))
                     unread-with-cap? (r/and unread-entry?
                                             (r/gt sort-value-base
-                                                  (-> (r/now) (r/to-epoch-time) (r/mul 1000) (r/round) (r/sub unread-cap-ms))))]
+                                                  (-> (r/now) (r/to-epoch-time) (r/mul 1000) (r/round) (r/sub unread-cap-ms))))
                     sort-value (r/branch unread-with-cap?
                                 ;; If the item is unread and was published (for recently posted) or bookmarked
                                 ;; (for bookmarks) or last activity was (for recent activity) in the cap window
                                 ;; let's add the cap window to the publish timestamp so it will sort before the read ones
                                 (r/add sort-value-base unread-cap-ms)
                                 ;; Or use the plain sort value in case it's read or it's out of the cap window
-                                sort-value-base)
+                                sort-value-base)]
                 {;; Date of the last added comment on this entry
                  :last-activity-at last-activity-at
                  ;; Last read for current user if applicable (we have a user-id and there is a read record)


Toggle off gizmos when clicking into card

--- frontend/src/faceboard/views/boards/people/card.cljs
+++ frontend/src/faceboard/views/boards/people/card.cljs
@@ -248,7 +248,8 @@
                              (fn [e]
                                (.stopPropagation e)
                                (if-not editing?
-                                 (router/switch-person (if-not extended? id nil)))))}
+                                 (router/switch-person (if-not extended? id nil))
+                                 (perform! :toggle-gizmo))))}
         (dom/div {:class (str "person-card-zoom")
                   :style (css-transform zoom-transform)}
           (when layout


Close down publication via publication manager

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -202,12 +202,9 @@
                              (filter (fn [[k v]] (>= (- t ^long @(:last-used v)) idle))
                                      snapshot))]
           (doseq [k to-remove]
-            (let [pub-manager (:publication (snapshot k))
-                  pub @(:publication pub-manager)
-                  conn @(:connection pub-manager)]
+            (let [pub-manager (:publication (snapshot k))]
               (swap! publications dissoc k)
-              (.close ^Publication pub)
-              (.close ^Aeron conn))))
+              (pubm/disconnect pub-manager))))
         (catch InterruptedException e
           (throw e))
         (catch Throwable e
@@ -327,7 +324,7 @@
 (defrecord AeronPeerConnection [channel stream-id id])

 (defmethod extensions/connect-to-peer AeronConnection
-  [messenger peer-id event {:keys [aeron/external-addr aeron/port aeron/id]}]
+  [messenger peer-id event {:keys [aeron/external-addr aeron/port aeron/id] :as peer-site}]
   (let [sub-count (:subscriber-count (:messaging-group messenger))
         ;; ensure that each machine spreads their use of a node/peer-group's
         ;; streams evenly over the cluster


Adds a screen to test initial number of pushups

--- src/hundred_pushups/ios/core.cljs
+++ src/hundred_pushups/ios/core.cljs
@@ -7,22 +7,40 @@
 (def ReactNative (js/require "react-native"))

 (def app-registry (.-AppRegistry ReactNative))
+(def linking (.-Linking ReactNative))
 (def text (r/adapt-react-class (.-Text ReactNative)))
 (def view (r/adapt-react-class (.-View ReactNative)))
 (def image (r/adapt-react-class (.-Image ReactNative)))
 (def touchable-highlight (r/adapt-react-class (.-TouchableHighlight ReactNative)))

-(def logo-img (js/require "./images/cljs.png"))
+(def pushup-form-url "http://www.100pushups.com/#technique")

 (defn alert [title]
   (.alert (.-Alert ReactNative) title))

 (defn get-started []
-  )
+  [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
+                        :on-press #(do
+                                     (dispatch [:append-progress :started])
+                                     (dispatch [:db/save]))}
+   [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Let's get started"]])

 (defn pushup-form []
-  [:text {:value "test"}]
-  )
+  [view {}
+   [text {:style {:text-align "center"}} "Before you start doing pushups, learn optimal pushup technique"]
+   [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
+                        :on-press #(.openURL linking pushup-form-url)}
+    [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Read article about form"]
+    ]
+   [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5 :margin 10}
+                         :on-press #(do
+                                      (dispatch [:append-progress :pushup-form])
+                                      (dispatch [:db/save]))}
+    [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "OK, I've got it."]]])
+
+(defn max-pushups-test []
+  [view {}
+   [text {:style {:text-align "center"}} "To start, let's see how many pushups you can do."]])

 (defn app-root []
   (let [last-stage (subscribe [:last-stage])
@@ -31,13 +49,11 @@
       [view {:style {:flex-direction "column" :margin 40 :align-items "center"}}
        [text {:style {:font-size 40 :font-weight "100" :margin-bottom 10 :text-align "center"}} "100 Pushup Challenge"]
        [text {:style {:font-size 20 :font-weight "100" :margin-bottom 20 :text-align "center"}} "Become a pushup master"]
-       (if @last-stage
-         [text {:style {:color "red" :text-align "center" :font-weight "bold"}} "Test!"]
-         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
-                               :on-press #(do
-                                            (dispatch [:append-progress :started])
-                                            (dispatch [:db/save]))}
-          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Let's get started"]])
+       (case @last-stage
+         nil [get-started]
+         :started [pushup-form]
+         :pushup-form [max-pushups-test]
+         )
        [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5 :margin-top 20}
                              :on-press #(do
                                           (dispatch [:db/reset])


Implement cmd0 ~ cmd15 unit test

Implement cmd0 ~ cmd15 unit test

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- test/emulator_4917/core_test.clj
+++ test/emulator_4917/core_test.clj
@@ -2,6 +2,83 @@
   (:require [clojure.test :refer :all]
             [emulator-4917.core :refer :all]))

-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
+(deftest cpu-test
+  (testing "Create cpu vector"
+    (is (= (make-cpu)
+           (->State (vec (repeat 16 0)) 0 0 0 0))))
+
+  ;; http://stackoverflow.com/questions/29289151/is-there-a-way-to-test-system-exit-in-clojure
+  (testing "cmd 0: Terminate application"
+    (with-redefs [terminate-application! (constantly "Terminate Application")]
+      (is (= "Terminate Application" (cmd0 (make-cpu))))))
+
+  (testing "cmd 1: R0 = R0 + R1"
+    (let [r0 5 r1 10
+          cpu (make-cpu :r0 r0 :r1 r1)]
+      (is (= (:r0 (cmd1 cpu)) (+ r0 r1)))))
+
+  (testing "cmd 2: R0 = R0 - R1"
+    (let [r0 10 r1 5
+          cpu (make-cpu :r0 r0 :r1 r1)]
+      (is (= (:r0 (cmd2 cpu)) (- r0 r1)))))
+
+  (testing "cmd 3: R0 = R0 + 1"
+    (let [r0 10
+          cpu (make-cpu :r0 r0)]
+      (is (= (:r0 (cmd3 cpu)) (+ r0 1)))))
+
+  (testing "cmd 4: R1 = R1 + 1"
+    (let [r1 5
+          cpu (make-cpu :r1 r1)]
+      (is (= (:r1 (cmd4 cpu)) (+ r1 1)))))
+
+  (testing "cmd 5: R0 = R0 - 1"
+    (let [r0 5
+          cpu (make-cpu :r0 r0)]
+      (is (= (:r0 (cmd5 cpu)) (- r0 1)))))
+
+  (testing "cmd 6: R1 = R1 - 1"
+    (let [r1 5
+          cpu (make-cpu :r1 r1)]
+      (is (= (:r1 (cmd6 cpu)) (- r1 1)))))
+
+  (testing "cmd 7: Ring the bell!!"
+    (let [r0 10
+          r1 5
+          cpu (make-cpu :r0 r0 :r1 r1)]
+      ;; the result should the same
+      ;; TODO: more accurate mock method
+      (is (= cpu (cmd7 cpu)))))
+
+  ;; FIXME: how to mock println correctly ?
+  (testing "cmd 8: Print <data>"
+    (let [cpu (make-cpu :memory [8 5 0])]
+      (is (= cpu (cmd8 cpu)))))
+
+  (testing "cmd 9: Load value from <data> to R0"
+    (let [cpu (make-cpu :memory [9 0 0])]
+      (is (= 9 (:r0 (cmd9 cpu))))))
+
+  (testing "cmd 10: Load value from <data> to R1"
+    (let [cpu (make-cpu :memory [9 0 0])]
+      (is (= 9 (:r1 (cmd10 cpu))))))
+
+  (testing "cmd 11: Store R0 into <data> position"
+    (let [cpu (make-cpu :memory [11 2 0] :r0 5)]
+      (is (= [11 2 5] (:memory (cmd11 cpu))))))
+
+  (testing "cmd 12: Store R1 into <data> position"
+    (let [cpu (make-cpu :memory [12 2 0] :r1 5)]
+      (is (= [12 2 5] (:memory (cmd12 cpu))))))
+
+  (testing "cmd 13: jump to address <data>"
+    (let [cpu (make-cpu :memory [13 2 0])]
+      (is (= 2 (:ip (cmd13 cpu))))))
+
+  (testing "cmd 14: jump to address <data> if R0 == 0"
+    (let [cpu (make-cpu :memory [13 2 0] :r0 0)]
+      (is (= 2 (:ip (cmd14 cpu))))))
+
+  (testing "cmd 15: jump to address <data> if R0 != 0"
+    (let [cpu (make-cpu :memory [13 2 0] :r0 1)]
+      (is (= 2 (:ip (cmd15 cpu)))))))


Make the data be contained in a set.

Make the data be contained in a set.

--- src/org/scode/httpgctest.clj
+++ src/org/scode/httpgctest.clj
@@ -23,7 +23,7 @@
      :headers {}
      :body "Garbage all around."}))

-(def data (ref ["data"]))
+(def data (ref #{}))

 (defn serve-gendata [request]
   (let [amount (let [amstr (:amount (:query-params request))]
@@ -31,7 +31,7 @@
                    (Integer/parseInt amstr)
                    (max 1 (count @data))))]
     (dosync
-     (alter data #(concat %1 (repeat amount "data"))))
+     (alter data (fn [d] (apply conj d (map (fn [f] (f)) (repeat amount #(str (rand) "data")))))))
     {:status 200
      :headers {}
      :body (str "size is now " (count @data) " after adding " amount)}))
@@ -40,8 +40,16 @@
   (let [old-size (count @data)]
     (if (contains? (:query-params request) :ratio)
       (let [ratio (Double/parseDouble (:ratio (:query-params request)))]
-        (dosync (alter data (fn [old] (filter (fn [e] (> (rand) ratio)) old)))))
-      (dosync (alter data (fn [d] {}))))
+        (dosync (alter data (fn [old] (loop [data old
+                                             tail (seq old)]
+                                        (if (seq tail)
+                                          (if (< (rand) ratio)
+                                            (recur (disj data (first tail))
+                                                   (rest tail))
+                                            (recur data
+                                                   (rest tail)))
+                                          data))))))
+      (dosync (alter data (fn [_] #{}))))
     {:status 200
      :headers {}
      :body (str "dropped " (- old-size (count @data)))}))


Update Catalog.

Update Catalog.

--- test/onyx/peer/register_test.clj
+++ test/onyx/peer/register_test.clj
@@ -63,11 +63,11 @@
     :onyx/consumption :concurrent
     :onyx/type :queue
     :onyx/medium :hornetq
-    :onyx/batch-size 2
-    :onyx/timeout 50
     :hornetq/queue-name out-queue
     :hornetq/host "localhost"
-    :hornetq/port 5445}])
+    :hornetq/port 5445
+    :hornetq/batch-size 2
+    :hornetq/timeout 50}])

 (def workflow {:in {:inc :out}})


match example input to output

match example input to output

--- src/overtone/music/pitch.clj
+++ src/overtone/music/pitch.clj
@@ -495,9 +495,9 @@

 (defn chord
   "Returns a set of notes for the specified chord. The root must be in
-  midi note format i.e. :C3.
-
-  (chord :c3 :major)  ; c major           -> #{60 64 67}
+  midi note format i.e. :C4.
+
+  (chord :c4 :major)  ; c major           -> #{60 64 67}
   (chord :a4 :minor)  ; a minor           -> #{57 60 64}
   (chord :Bb4 :dim)   ; b flat diminished -> #{70 73 76}
   "


fix bug where output desc could be nil

fix bug where output desc could be nil

--- src/crucible/template.clj
+++ src/crucible/template.clj
@@ -35,8 +35,9 @@

 (defn output
   [value & [description]]
-  [:output {::o/description description
-            ::o/value value}])
+  [:output (-> description
+               (when {::o/description description})
+               (assoc ::o/value value))])

 (defn xref [& options]
   (apply v/xref options))


extend previous commit to :js-provider :external

--- src/main/shadow/build/resolve.clj
+++ src/main/shadow/build/resolve.clj
@@ -354,7 +354,10 @@
                 ;; if `(:require [react ...])` was used we need to check if the package
                 ;; is actually installed. otherwise we will blindy return a shim for
                 ;; every symbol, no matter it was a typo or actually intended JS package.
-                (npm/find-package (:npm state) require))
+                (npm/find-package (:npm state) require)
+
+                ;; treat every symbol as valid when :npm-deps in deps.cljs on the classpath contain it
+                (npm/is-npm-dep? (:npm state) require))

         (js-support/shim-require-resource state require)))))


Fixed column count in classNames

Fixed column count in classNames

--- src/main/untangled/ui/layout.cljc
+++ src/main/untangled/ui/layout.cljc
@@ -51,11 +51,10 @@
                   width (str " u-column--" width)
                   halign (str " u-" (name halign))
                   valign (str " u-" (name valign))
-                  sm-width (str " u-column--" width "@sm")
-                  md-width (str " u-column--" width "@md")
-                  md-width (str " u-column--" width "@md")
-                  lg-width (str " u-column--" width "@lg")
-                  xl-width (str " u-column--" width "@xl")
+                  sm-width (str " u-column--" sm-width "@sm")
+                  md-width (str " u-column--" md-width "@md")
+                  lg-width (str " u-column--" lg-width "@lg")
+                  xl-width (str " u-column--" xl-width "@xl")
                   push (str " u-push--" push)
                   sm-push (str " u-push--" sm-push "@sm")
                   md-push (str " u-push--" md-push "@md")


caching in pretty OK shape

caching in pretty OK shape

--- src/annual_weather/web_cache.clj
+++ src/annual_weather/web_cache.clj
@@ -1,5 +1,6 @@
 (ns annual-weather.web-cache
-  (:import java.util.concurrent.TimeUnit)
+  (:import java.util.concurrent.TimeUnit
+           org.joda.time.DateTime)
   (:require
     [annual-weather [cdo :as cdo]
                     [geocode :as geocode]]
@@ -7,34 +8,54 @@
     [clojure.data [json :as json]]
     [clojure.core.rrb-vector :as fv]
     [clojure [pprint :as pp]]
-    [monger core collection [operators :as op]]
+    [monger core
+     collection
+     joda-time
+     [operators :as op]]
     [org.httpkit.client :as http]
     [schema [core :as s]
             [macros :as sm]])
   (:use [annual-weather utils]
+        [clojure.tools.logging]
         [clj-utils.core]))

 (defn db-init []
   (monger.core/connect!)
   (monger.core/use-db! "annual-weather")
+
   (monger.collection/ensure-index "geocodeWebCache"
-                                  (array-map :user-addr 1)
+                                  (array-map :user-addr 1))
+  (monger.collection/ensure-index "geocodeWebCache"
+                                  (array-map :created-at 1)
+                                  {:expireAfterSeconds
+                                   (.toSeconds TimeUnit/DAYS 365)})
+
+  (monger.collection/ensure-index "stationWebCache"
+                                  (array-map :longitudeLatitude "2dsphere"
+                                             :query-rest 1))
+  (monger.collection/ensure-index "stationWebCache"
+                                  (array-map :created-at 1)
                                   {:expireAfterSeconds
                                    (.toSeconds TimeUnit/DAYS 365)})
+
   (monger.collection/ensure-index "d3StyleDataWebCache"
-                                  (array-map :query-rest 1)
-                                  {:expireAfterSeconds
-                                   (.toSeconds TimeUnit/DAYS 365)})
-  (monger.collection/ensure-index "stationWebCache"
-                                  (array-map :longitudeLatitude "2dsphere"
-                                             :query-rest 1)
+                                  (array-map :query-rest 1))
+  (monger.collection/ensure-index "d3StyleDataWebCache"
+                                    (array-map :created-at 1)
                                   {:expireAfterSeconds
                                    (.toSeconds TimeUnit/DAYS 365)}))
+
+(def log-caching true)

 (def write-db true)
 (def read-db true)
 (def read-uc true)
 (if (or read-db write-db) (db-init))
+
+(defn success-log
+  [tag x]
+  (if log-caching (info "read" tag "from db successfully"))
+  x)

 (sm/defn query-geocode :- geocode/Geocoded
   "TODO is there a structure of cached reads, cache writes, and query
@@ -42,24 +63,35 @@
   TODO log or store cache statistics !
   But this works !"
   [q :- s/Str]
-  (or (and read-db
-           (some->> q
-             (array-map :user-addr)
-             (monger.collection/find-one-as-map "geocodeWebCache")
-             :geocoded))
-      (let [geocoded (if read-uc
-                       (geocode/query-geocode-uncached q))]
-        (pp/pprint geocoded)
-        (if geocoded
-          (do
-            (if write-db (monger.collection/insert "geocodeWebCache"
-              {:user-addr q
-               :geocoded geocoded }))
-            geocoded)))))
+  (letfn [(maybe-write-db [q geocoded]
+            (if log-caching (info "if" write-db "write geocode data"))
+            (if write-db
+              (monger.collection/insert "geocodeWebCache"
+                            {:user-addr q
+                             :geocoded geocoded
+                             :created-at (DateTime. )})))
+          (maybe-read-db [q]
+            (if log-caching (info "if" read-db "try read geocode data"))
+            (if read-db
+              (some->> q
+                       (array-map :user-addr)
+                       (monger.collection/find-one-as-map "geocodeWebCache")
+                       :geocoded
+                       (success-log "geocoded"))))]
+
+  (or (maybe-read-db q)
+    (if read-uc
+      (if-let [geocoded (geocode/query-geocode-uncached q)]
+        (do
+          (info "read uc geocoding")
+          (maybe-write-db q geocoded)
+          geocoded))))))

 (sm/defn query-data-d3-style-uncached [q] :- cdo/D3-Schema
   (->> q
+      ; ((fn [x] (info q) q))
       (cdo/query :data) ; Ask for weather data
+      ; ((fn [x] (info @x) x))
       unpack-http-kit-json-res ; parse the response
       :results
       cdo/group-results
@@ -67,32 +99,44 @@

 (sm/defn query-data-d3-style [q] :- cdo/D3-Schema
   (let [maybe-write-db (fn [q-date q-rest data]
+         (if log-caching (info "if" write-db "write d3 data"))
          (if write-db
           (monger.collection/insert "d3StyleDataWebCache"
-             {:query-date q-date :query-rest q-rest :data data})))
+             {:query-date q-date
+              :query-rest q-rest
+              :data data
+              :created-at (DateTime. )})))
         maybe-read-db (fn [q-rest]
+          (if log-caching (info "if" read-db "try read d3 data"))
           (and read-db
                    (some->> q-rest
                             (array-map :query-rest)
                             (monger.collection/find-one-as-map "d3StyleDataWebCache")
-                            :data)))
+                            :data
+                            (success-log "data"))))
         [q-date q-rest] (group-map-by-keys q [:startdate :enddate])]
     (or (maybe-read-db q-rest)
         (if read-uc
           (if-let [data (query-data-d3-style-uncached q)]
-            (do (maybe-write-db q-date q-rest data) data))))))
+            (do
+              (if log-caching (info "read uc d3 data"))
+              (maybe-write-db q-date q-rest data)
+              data))))))

 ; TODO write and read query to DB, and add secondary index
 (defn query-stations [q extent]
   (let [maybe-write-db (fn [q-rest stations]
+         (if log-caching (info "if " write-db " write stations"))
          (if write-db
            (doseq [station stations]
             (monger.collection/insert "stationWebCache"
                 {:longitudeLatitude
                  [(station :longitude) (station :latitude)]
                  :query-rest q-rest
-                 :station station}))))
+                 :station station
+                 :created-at (DateTime. ) }))))
         maybe-read-db (fn [q-rest extent]
+          (if log-caching (info "if " read-db "try read stations"))
           (and read-db
                (some->>
                  (monger.collection/find-maps "stationWebCache"
@@ -102,12 +146,18 @@
                    [[(.getLeftLongitude extent) (.getMinLatitude extent)]
                     [(.getRightLongitude extent) (.getMaxLatitude extent)]] }}
                    :query-rest q-rest })
-                 (map :station))))
+                 (map :station)
+                 not-empty
+                 (success-log "station"))))
         [q-date q-rest] (group-map-by-keys
                           (dissoc q :limit :offset :sortorder :sortfield)
                           [:startdate :enddate])]
     (or (maybe-read-db q-rest extent)
         (if read-uc
           (if-let [stations (cdo/query-stations-uncached q (geocode/window-to-gmaps-url extent))]
-            (do (maybe-write-db q-rest stations) stations))))))
+              (do
+                (if log-caching
+                  (info "read uc station data"))
+                (maybe-write-db q-rest stations)
+                stations))))))


allow : inside symbols

allow : inside symbols

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -141,7 +141,7 @@
 (defn macro-terminating? [ch]
   (and (not= \# ch)
        (not= \' ch)
-       ;;(not= ch \:) ;; why?
+       (not= ch \:)
        (macros ch)))

 (defn ^String read-token


test commit

test commit

--- src/checkin/core.clj
+++ src/checkin/core.clj
@@ -3,4 +3,4 @@
 (defn home [request]
   {:status 200
    :headers {"Content-Type" "text/html"}
-   :body "Hello World"})
+   :body "Hello World - !!!"})


Make sure generated metadata in acquisition engine takes precedence over default metadata.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -159,8 +159,8 @@
   {:pix (:pix img)
    :tags
    (merge
+     (:tags img)
      (generate-metadata event state)
-     (:tags img)
      {"ElapsedTime-ms" elapsed-time-ms}
      )}) ;; include any existing metadata


improve acq engine burst performance for high speed images

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -105,8 +105,8 @@
   (vec (map #(core getCameraChannelName %)
        (range (core getNumberOfCameraChannels)))))

-(defn super-channel-name [simple-channel-name camera-channel-name]
-  (if (>= 1 (core getNumberOfCameraChannels))
+(defn super-channel-name [simple-channel-name camera-channel-name num-camera-channels]
+  (if (>= 1 num-camera-channels)
     simple-channel-name
     (if (or (empty? simple-channel-name)
             (= "Default" simple-channel-name))
@@ -117,7 +117,7 @@

 (defn generate-metadata [event state]
   (merge
-    (map-config (core getSystemStateCache))
+    (state :system-state)
     (:metadata event)
     (let [[x y] (let [xy-stage (state :default-xy-stage)]
                   (when-not (empty? xy-stage)
@@ -382,16 +382,20 @@
     {:pix (.pix tagged-image)
      :tags (json-to-data (.tags tagged-image))}))

-(defn make-multicamera-channel [raw-channel-index camera-channel]
-  (+ camera-channel (* (core getNumberOfCameraChannels) (or raw-channel-index 0))))
+(defn make-multicamera-channel [raw-channel-index camera-channel num-camera-channels]
+  (+ camera-channel (* num-camera-channels (or raw-channel-index 0))))

 (defn make-multicamera-events [event]
   (let [num-camera-channels (core getNumberOfCameraChannels)
         camera-channel-names (get-camera-channel-names)]
     (for [camera-channel (range num-camera-channels)]
       (-> event
-          (update-in [:channel-index] make-multicamera-channel camera-channel)
-          (update-in [:channel :name] super-channel-name (camera-channel-names camera-channel))
+          (update-in [:channel-index] make-multicamera-channel
+                     camera-channel num-camera-channels)
+          (update-in [:channel :name]
+                     super-channel-name
+                     (camera-channel-names camera-channel)
+                     num-camera-channels)
           (assoc :camera-channel-index camera-channel)
           (assoc :camera (camera-channel-names camera-channel))))))

@@ -426,11 +430,17 @@
         image-number (if (first-trigger-missing?) (dec image-number) image-number)
         burst-event (nth burst-events image-number)
         camera-channel-name (nth camera-channel-names cam-chan)
+        num-camera-channels (count camera-channel-names)
         event (-> burst-event
-                  (update-in [:channel-index] make-multicamera-channel cam-chan)
-                  (update-in [:channel :name] super-channel-name camera-channel-name)
+                  (update-in [:channel-index]
+                             make-multicamera-channel
+                             cam-chan num-camera-channels)
+                  (update-in [:channel :name]
+                             super-channel-name
+                             camera-channel-name num-camera-channels)
                   (assoc :camera-channel-index cam-chan))
         time-stamp (burst-time (:tags image) @state)]
+    ;image))
     (annotate-image image event @state time-stamp)))

 (defn produce-burst-images
@@ -443,7 +453,8 @@
       (.put out-queue
             (-> (pop-burst-image timeout-ms)
                 (tag-burst-image burst-events camera-channel-names camera-index-tag)
-                make-TaggedImage))))
+                make-TaggedImage
+                ))))
   (burst-cleanup))

 (defn collect-burst-images [event out-queue]
@@ -451,7 +462,7 @@
     (when (first-trigger-missing?)
       (pop-burst-image pop-timeout-ms)) ; drop first image if first trigger doesn't happen
     (swap! state assoc :burst-time-offset nil)
-    (let [burst-events (assign-z-offsets (event :burst-data))
+    (let [burst-events (vec (assign-z-offsets (event :burst-data)))
           camera-channel-names (get-camera-channel-names)]
       (produce-burst-images burst-events camera-channel-names pop-timeout-ms out-queue))))

@@ -518,6 +529,7 @@
          (if (core getAutoShutter)
            [true (:close-shutter event)]
            [false false])]
+    (swap! state assoc :system-state (map-config (core getSystemStateCache)))
     (condp = (:task event)
       :snap (apply snap-image shutter-states)
       :burst (init-burst (count (:burst-data event))
@@ -679,8 +691,7 @@
     (event-fn)
     (await-resume)))

-(defn run-acquisition [this settings out-queue cleanup?]
-  (binding [state (.state this)]
+(defn run-acquisition [_ settings out-queue cleanup?]
     (try
       (def acq-settings settings)
       (log "Starting MD Acquisition: " settings)
@@ -692,11 +703,12 @@
         (def acq-sequence acq-seq)
         (execute (mapcat #(make-event-fns % out-queue) acq-seq)))
       (catch Throwable t
+             (def acq-error t)
              (ReportingUtils/showError t "Acquisition failed."))
       (finally
         (when cleanup?
           (cleanup))
-        (.put out-queue TaggedImageQueue/POISON)))))
+        (.put out-queue TaggedImageQueue/POISON))))

 ;; generic metadata

@@ -745,10 +757,11 @@
       (get {1 1 , 4 3} n))))

 (defn super-channels [simple-channel camera-channel-names]
-  (if (< 1 (count camera-channel-names))
-    (map #(update-in simple-channel [:name] super-channel-name %)
-         camera-channel-names)
-    simple-channel))
+  (let [n (count camera-channel-names)]
+    (if (< 1 n)
+      (map #(update-in simple-channel [:name] super-channel-name % n)
+           camera-channel-names)
+      simple-channel)))

 (defn all-super-channels [simple-channels camera-channel-names]
   (flatten (map #(super-channels % camera-channel-names) simple-channels)))
@@ -857,7 +870,8 @@
   (def last-acq this)
     (reset! (.state this) {:stop false :pause false :finished false})
     (let [out-queue (LinkedBlockingQueue. 10)
-          acq-thread (Thread. #(run-acquisition this settings out-queue cleanup?)
+          acq-thread (Thread. #(binding [state (.state this)]
+                                 (run-acquisition settings out-queue cleanup?))
                               "AcquisitionSequence2010 Thread (Clojure)")]
       (reset! (.state this)
               {:stop false
@@ -955,3 +969,16 @@
 (defn stop []
   (when-let [acq-thread (:acq-thread (.state last-acq))]
     (.stop acq-thread)))
+
+(defn drain-queue [blocking-queue]
+  (future (loop [i 0]
+            (let [obj (.take blocking-queue)]
+              (when (zero? (mod i 100))
+                (println i (core getRemainingImageCount)))
+              (when (not= obj blocking-queue)
+                (recur (inc i)))))))
+
+(defn null-queue []
+  (doto (LinkedBlockingQueue.)
+    drain-queue))
+


Fix typo in docstring

Fix typo in docstring

--- src/caesium/crypto/secretbox.clj
+++ src/caesium/crypto/secretbox.clj
@@ -40,7 +40,7 @@
     out))

 (defn secretbox-open-easy-to-buf!
-  "Encrypt with `crypto_secretbox_open_easy` into the given byte array.
+  "Decrypt with `crypto_secretbox_open_easy` into the given byte array.

   You only want this to manage the output byte array yourself. Otherwise,
   you want [[secretbox-open-easy]]."


don't set a z position during cleanup if z drive never moved

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -336,7 +336,8 @@
     (core stopSequenceAcquisition))
   (core setAutoShutter (@state :init-auto-shutter))
   (core setExposure (@state :init-exposure))
-  (set-z-stage-position (core getFocusDevice) (@state :init-z-position))
+  (when (not= (@state last-z-position) (@state :init-z-position))
+    (set-z-stage-position (core getFocusDevice) (@state :init-z-position))
   (when (and (@state :init-continuous-focus)
              (not (core isContinuousFocusEnabled)))
     (core enableContinuousFocus true))


extracting stats from wav

extracting stats from wav

--- src/clojure/core.clj
+++ src/clojure/core.clj
@@ -7,6 +7,7 @@
            [xtract_features_]
            [xtract_window_types_]
            [xtract_spectrum_]
+           [xtract_subband_scales_]

           [javax.sound.sampled AudioSystem]))

@@ -17,6 +18,8 @@
 (defonce xtract-equal-gain (.swigValue (xtract_mfcc_types_/XTRACT_EQUAL_GAIN)))

 (defonce xtract-spectrum-magnitude (.swigValue (xtract_spectrum_/XTRACT_MAGNITUDE_SPECTRUM)))
+
+(defonce xtract-linear-subbands  (.swigValue (xtract_subband_scales_/XTRACT_LINEAR_SUBBANDS)))

 (defn- double->clojure [vs len]
   (let [ls (map-indexed
@@ -32,6 +35,19 @@
       (fn [idx f] (xtract/double_array_setitem xtract-vs idx (double f)))
       vs))
     xtract-vs))
+
+(defn- xtract-args [& args] (xtract/doublea_to_voidp (make-double args)))
+
+(defn with-result [t xtract-fn]
+  (let [r t]
+    (xtract-fn r)
+    (let [out (nth (vec r) 0)]
+      out)))
+
+(defn spectral-inharmonicity [peaks-data block-size & args]
+  (with-result
+    (double-array [0])
+    (fn [r] (xtract/xtract_spectral_inharmonicity peaks-data block-size (apply xtract-args args) r))))

 (defn mean [vs]
   (let [result (double-array 1)
@@ -99,69 +115,97 @@
   )

-(let [path "test/fixtures/test.wav"  ;;             "test/fixtures/the_nature_of_sound.wav"
-      s    (sample/read-sound path)
-      MFCC_FREQ_BANDS (double 13)
-      MFCC_FREQ_MIN (double 20)
-      MFCC_FREQ_MAX (double 20000)
-      MFCC_FREQ_BANDS 13
-      SAMPLERATE 44100
-      data   (sample/chunks s SAMPLERATE)
-      data-slice (ffirst data)
-      data-size (count data-slice)
-      block-size 512
-      half-block-size (/ 512 2)
-
-      mel-filters  (xtract/create_filterbank  MFCC_FREQ_BANDS block-size)]
-
-  (xtract/xtract_init_mfcc (/ block-size 2)
-                           (/ SAMPLERATE 2)
-                           xtract-equal-gain
-                           MFCC_FREQ_MIN
-                           MFCC_FREQ_MAX
-                           MFCC_FREQ_BANDS
-                           (xtract_mel_filter/.getFilters mel-filters))
-
-  (let [w    (xtract/xtract_init_window block-size xtract-hann)
-        subw (xtract/xtract_init_window half-block-size xtract-hann)
-        argv (make-double [(double SAMPLERATE)])]
-
-    ;;LEAKING ALL THE MEMORY
-    (xtract/xtract_init_wavelet_f0_state)
-
-    (doseq [s data]
-      (doseq [v s]
-        (let [ds (make-double (vec v))
-              r  (double-array [1])]
-          (xtract/xtract_wavelet_f0 ds block-size (xtract/doublea_to_voidp argv) r)
-          (let [f0 (first (vec r))]
-            (xtract/xtract_midicent nil 0 (xtract/doublea_to_voidp (make-double (vec r))) r)
-            (let [cents (first (vec r))]
-              (when (not= f0 0.0)
-                (println "f0       :" f0)
-                (println "midi-note:" (/ cents 100)))))
-
-
-          ;;    xtract_windowed(&data[n], BLOCKSIZE, window, windowed);
-          ;;  public static int xtract_windowed(SWIGTYPE_p_double data, int N, SWIGTYPE_p_void argv, SWIGTYPE_p_double result)
-          (let [windowed (make-double (range 0 block-size))
-                spectrum (make-double (range 0 block-size))
-
-                argd (make-double [(/ SAMPLERATE block-size)
-                                   xtract-spectrum-magnitude
-                                   (double 0)
-                                   (double 0)])]
-            (xtract/xtract_windowed ds block-size (xtract/doublea_to_voidp w) windowed)
-            (xtract/xtract_init_fft block-size xtract-spectrum)
-            (xtract/xtract_spectrum windowed block-size (xtract/doublea_to_voidp argd) spectrum)
-            (xtract/xtract_free_fft)
-
-            (println "Magnitude Spectrum: " (pr-str (double->clojure spectrum block-size)))
-            ))))
-
-    (xtract/xtract_free_window w)
-    (xtract/xtract_free_window subw)
-    (xtract/destroy_filterbank mel-filters)))
+(defn peek-inside [sample-path]
+  (let [path sample-path ;;             "test/fixtures/the_nature_of_sound.wav"
+        s    (sample/read-sound path)
+        MFCC_FREQ_BANDS (double 13)
+        MFCC_FREQ_MIN (double 20)
+        MFCC_FREQ_MAX (double 20000)
+
+        NUM_HARMONICS  10
+
+        MFCC_FREQ_BANDS 13
+        SAMPLERATE 44100
+        data   (sample/chunks s SAMPLERATE)
+        data-slice (ffirst data)
+        data-size (count data-slice)
+        block-size 512
+        half-block-size (/ 512 2)
+
+        mel-filters  (xtract/create_filterbank  MFCC_FREQ_BANDS block-size)]
+
+    (xtract/xtract_init_mfcc (/ block-size 2)
+                             (/ SAMPLERATE 2)
+                             xtract-equal-gain
+                             MFCC_FREQ_MIN
+                             MFCC_FREQ_MAX
+                             MFCC_FREQ_BANDS
+                             (xtract_mel_filter/.getFilters mel-filters))
+
+    (let [w    (xtract/xtract_init_window block-size xtract-hann)
+          subw (xtract/xtract_init_window half-block-size xtract-hann)
+          argv (make-double [(double SAMPLERATE)])]
+
+      ;;LEAKING ALL THE MEMORY
+      (xtract/xtract_init_wavelet_f0_state)
+
+      (let [stats
+            (map-indexed
+             (fn [idx s]
+               (map
+                (fn [v]
+                  (let [ds (make-double (vec v))
+                        r  (double-array [1])]
+
+                    (xtract/xtract_wavelet_f0 ds block-size (xtract/doublea_to_voidp argv) r)
+
+                    (let [f0 (first (vec r))]
+                      (xtract/xtract_midicent nil 0 (xtract/doublea_to_voidp (make-double (vec r))) r)
+                      (let [cents (first (vec r))
+                            midi (/ cents 100)]
+
+                        (let [windowed (make-double (range 0 block-size))
+                              spectrum (make-double (range 0 block-size))
+
+                              argd (make-double [(/ SAMPLERATE block-size)
+                                                 xtract-spectrum-magnitude
+                                                 (double 0)
+                                                 (double 0)])]
+                          (xtract/xtract_windowed ds block-size (xtract/doublea_to_voidp w) windowed)
+                          (xtract/xtract_init_fft block-size xtract-spectrum)
+                          (xtract/xtract_spectrum windowed block-size (xtract/doublea_to_voidp argd) spectrum)
+                          (xtract/xtract_free_fft)
+
+                          (let [peaks (make-double (range 0 block-size))
+                                argv (make-double [(/ SAMPLERATE block-size)
+                                                   (double 10)
+                                                   (double 0)
+                                                   (double 0)])]
+
+                            (xtract/xtract_peak_spectrum spectrum (double (/ block-size 2)) (xtract/doublea_to_voidp argv) peaks)
+
+                            (let [spectral-inharmonicity (spectral-inharmonicity
+                                                          peaks block-size
+                                                          f0 0.5 NUM_HARMONICS 0)
+                                  r {:spectral-inharmonicity spectral-inharmonicity
+                                     :midi midi
+                                     :f0 f0}]
+                              [idx r]))
+                              ;;(println "Magnitude Spectrum: " (pr-str (double->clojure spectrum block-size)))
+                          )))))
+                s))
+             data)]
+
+        (xtract/xtract_free_window w)
+        (xtract/xtract_free_window subw)
+        (xtract/destroy_filterbank mel-filters)
+
+        (vec (flatten stats))
+        ))))
+
+(println
+ (doseq [r (peek-inside "test/fixtures/test.wav")]
+   (println r)))

 ;;f0: 167.04545454545453
 ;;f0: 196.875


fix shadowing

fix shadowing

--- src/gamma_driver/api.cljs
+++ src/gamma_driver/api.cljs
@@ -101,7 +101,7 @@

 (defn bind
   "Binds the program's variables as specified in spec. "
-  [this program spec]
+  [this prog spec]
   (if (satisfies? gdp/IBind this)
     (gdp/bind this program spec)
     (bind/bind
@@ -113,7 +113,7 @@
        :bind-attribute       bind-attribute
        :bind-texture-uniform bind-texture-uniform
        :bind-uniform         bind-uniform}
-      this program spec)))
+      this prog spec)))

 ;; IDraw


updated examples

updated examples

--- examples/blog/src/io/perun/example/index.clj
+++ examples/blog/src/io/perun/example/index.clj
@@ -12,7 +12,9 @@
       [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0, user-scalable=no"}]]
     [:body
       [:a {:href "/about.html"} "About Page"]
-         [:ul.items.columns.small-12
+      [:a {:href "/feed.rss"} "RSS"]
+      [:a {:href "/atom.xml"} "Atom Feed"]
+      [:ul.items.columns.small-12
           (for [post posts]
             [:li
               [:a {:href (:permalink post)}(:title post)]])]]))


Trying to figure out how to attach documentation to fns generated by do-template.

--- src/http/async/client.clj
+++ src/http/async/client.clj
@@ -43,10 +43,11 @@
 (do-template
  [fn-name method]
  (defn fn-name
-   [#^String url & {:as options}]
-   (apply execute-request
-          (apply prepare-request method url (apply concat options))
-          (apply concat *default-callbacks*)))
+    {:doc "TODO: figure out way to document those generated functions."}
+    [#^String url & {:as options}]
+    (apply execute-request
+           (apply prepare-request method url (apply concat options))
+           (apply concat *default-callbacks*)))
  GET :get
  POST :post
  PUT :put


Agriculture should develop in positions favourable for agriculture

--- src/civs/logic/tribe_choices.clj
+++ src/civs/logic/tribe_choices.clj
@@ -16,11 +16,16 @@
       0.0)))

 ; Must be at least a tribe society
-(defn chance-to-develop-agriculture [game tribe]
+(defn chance-to-develop-agriculture [game group]
   (if (and
-        (not (nomadic? tribe))
-        (not (know? tribe :agriculture))
-        (not (band-society? tribe))) 0.35 0.0))
+        (not (nomadic? group))
+        (not (know? group :agriculture))
+        (not (band-society? group)))
+    (let [agr-prosperity (base-prosperity-per-activity (.world game) (.position group) :agriculture)
+          prob (saturate (max 0.0 (* (- agr-prosperity 0.7) 3.0)) 0.5)]
+      ; agriculture is discovered in places good for agriculture
+      prob)
+    0.0))

 ; Must be at least a tribe society
 (defn chance-to-become-sedentary [game tribe]


Properly add globals to the global scope

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -232,7 +232,7 @@
       ;; Variable declaration
       (= (first form) 'def)
       (let [[_ var-name val] form]
-        (if (neg? (.indexOf @globals var-name))
+        (if (neg? (.indexOf @globals (name var-name)))
           (swap! globals conj (name var-name)))
         (concat
          (compile-form fns val)


Implement let*. We get let for free from clojure's macros!

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -248,6 +248,35 @@
           [:tsel (str "@" fn-end) (str "@" fn-end)]]
          (:code (compile-function  fn-form  fns))
          (tag-with fn-end [[:ldf (str "@" fn-name)]])))
+
+      (= (first form) 'let*)
+      (let [[_ args & forms] form
+            let-start (gensym (str *cur-fun* "-let"))
+            let-end  (str let-start "-end")
+            binding-pairs (partition 2 args)
+            binding-names (map first binding-pairs)
+            binding-size (count binding-names)]
+        (binding
+            [ *scope* (cons binding-names *scope*)]
+            (vec
+             (concat
+              [[:ldc 0]
+               [:tsel (str "@" let-end) (str "@" let-end)]]
+              (tag-with let-start
+                        (apply concat
+                               (map
+                                #(concat (compile-form fns (second %))
+                                         [(store-local (first %))])
+                                binding-pairs)))
+              (apply concat
+                     (map #(compile-form fns %) forms))
+              [[:rtn]]
+              (tag-with let-end
+                        [[:dum binding-size]])
+              (vec (repeat binding-size [:ldc 0]))
+              [[:ldf (str "@" let-start)]
+               [:rap binding-size]]
+              ))))

       ;; function call
       :else


Fix truncation of long middleware replies

--- src/refactor_nrepl/middleware.clj
+++ src/refactor_nrepl/middleware.clj
@@ -66,11 +66,13 @@
                  data))

 (defn- serialize-response [{:keys [serialization-format] :as msg} response]
-  (condp = serialization-format
-    "edn" (pr-str response)
-    "bencode" (bencode-friendly-data response)
-    (pr-str response) ; edn as default
-    ))
+  (binding [*print-length* nil
+            *print-level* nil]
+    (condp = serialization-format
+      "edn" (pr-str response)
+      "bencode" (bencode-friendly-data response)
+      (pr-str response) ; edn as default
+      )))

 (defn resolve-missing-reply [{:keys [transport] :as msg}]
   (reply transport msg :candidates (resolve-missing msg) :status :done))


Fix a typographical error

Fix a typographical error

--- src/clj/chili_dog_night/data.clj
+++ src/clj/chili_dog_night/data.clj
@@ -4,7 +4,7 @@

 (def make-movies-great-again [{:date "2016/08/17"
                                :address ""
-                               :synopsis "August 17th, 2016: Cult Films - Marth Marcy May Marlene, The Invitation."
+                               :synopsis "August 17th, 2016: Cult Films - Martha Marcy May Marlene, The Invitation."
                                :themes ["Cult Films"]
                                :food ["Spaghetti"]
                                :attendees ["Alex Sanchez"


Keep track of timers

Keep track of timers

--- src/clojure/nightmod/sandbox.clj
+++ src/clojure/nightmod/sandbox.clj
@@ -66,6 +66,8 @@
                                ; initialize bullet
                                @init-bullet)))

+(def timers (atom []))
+
 (defn set-policy!
   []
   (System/setProperty "java.security.policy"
@@ -79,27 +81,41 @@
   [path]
   (reset! u/error nil)
   (clear-ns! game-ns)
+  (doseq [t @timers]
+    (.stop t))
+  (reset! timers [])
   (on-gl (asset-manager! manager :clear))
   (-> (format "(do %s\n)" (slurp path))
       jail/safe-read
       sb
       (try (catch Exception e (reset! u/error e)))))

-(intern 'nightcode.completions
-        '*namespaces*
-        ['clojure.core
-         'nightmod.public
-         'play-clj.core
-         'play-clj.g2d
-         'play-clj.g3d
-         'play-clj.math
-         'play-clj.physics
-         'play-clj.ui])
-
-(intern 'nightcode.completions
-        'allow-symbol?
-        (fn [symbol-str ns]
-          (not (contains? blacklist-symbols (symbol symbol-str)))))
+(defn override-functions!
+  []
+  ; keep a reference to all timers to we can stop them later
+  (let [create-and-add-timer! (deref #'play-clj.core/create-and-add-timer!)]
+    (intern 'play-clj.core
+            'create-and-add-timer!
+            (fn [screen id]
+              (let [t (create-and-add-timer! screen id)]
+                (swap! timers conj t)
+                t))))
+  ; set namespaces we want to provide completions for
+  (intern 'nightcode.completions
+          '*namespaces*
+          ['clojure.core
+           'nightmod.public
+           'play-clj.core
+           'play-clj.g2d
+           'play-clj.g3d
+           'play-clj.math
+           'play-clj.physics
+           'play-clj.ui])
+  ; set function that prevents blacklisted symbols from being in completions
+  (intern 'nightcode.completions
+          'allow-symbol?
+          (fn [symbol-str ns]
+            (not (contains? blacklist-symbols (symbol symbol-str))))))

 (defn run-in-sandbox!
   [func]
@@ -118,3 +134,4 @@
       (run-in-sandbox! screen-fn))))

 (set-asset-manager! manager)
+(override-functions!)


:nail_care:

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -306,8 +306,8 @@
                                      (keep-indexed #(if (-> %2 :key (= key)) [%1 %2]))
                                      first)]
               (cond
-                (and (or (= :join (:type item) type)
-                         (= :prop (:type item) type)))
+                (or (= :join (:type item) type)
+                    (= :prop (:type item) type))
                 (if (= (:params item) params)
                   (update-in ast [:children idx] merge-queries* item-b)
                   (reduced nil))


Housekeeping

Housekeeping

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -17,12 +17,13 @@
 (defrecord Context [in-stream out-stream parser-queue])
 (def ^:dynamic *context* nil)
 (def ^:dynamic *parser*  nil)
-(def no-context-error
+(def ^:private no-context-error
   (Exception. (str "Redis commands must be called within the context of a"
                    " connection to Redis server. See `with-conn`.")))

-(def ^:private ^:const charset     "UTF-8")
-(def ^:private ^:const bytes-class (Class/forName "[B"))
+(def ^:const charset     "UTF-8")
+(def ^:const bytes-class (Class/forName "[B"))
+(defn bytes? [x] (instance? bytes-class x))

 ;;; Wrapper types to box values for which we'd like specific coercion behaviour
 (deftype Frozen [value])
@@ -65,21 +66,21 @@
                    (or (instance? Long    arg)
                        (instance? Double  arg)
                        (instance? Integer arg)
-                       (instance? Float   arg)) :simple-number
+                       (instance? Float   arg)) :simple-num
                    (instance? bytes-class arg)  :bytes
                    (instance? Raw         arg)  :raw
                    :else                        :frozen)

         ^bytes ba (case type
-                    :string        (bytestring arg)
-                    :keyword       (bytestring (name arg))
-                    :simple-number (bytestring (str arg))
-                    :bytes         arg
-                    :raw           (.value ^Raw arg)
-                    :frozen        (nippy/freeze-to-bytes
-                                    (if (instance? Frozen arg)
-                                      (.value ^Frozen arg)
-                                      arg)))
+                    :string     (bytestring arg)
+                    :keyword    (bytestring (name arg))
+                    :simple-num (bytestring (str arg))
+                    :bytes      arg
+                    :raw        (.value ^Raw arg)
+                    :frozen     (nippy/freeze-to-bytes
+                                 (if (instance? Frozen arg)
+                                   (.value ^Frozen arg)
+                                   arg)))

         payload-size (alength ba)
         marked-type? (case type (:bytes :frozen) true false)


Work around problems in Java's handling of windows command line escaping

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -124,8 +124,16 @@
           form `(do (def ~'*classpath* ~cp)
                     (set! ~'*warn-on-reflection*
                           ~(:warn-on-reflection project))
-                    ~form)]
-      (.setValue (.createArg java) (prn-str form)))
+                    ~form)
+	  readable-form (if (= (get-os) :windows)
+			  ;; work around java's command line handling on windows
+			  ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=6468220
+			  ;; This isn't perfect, but works for what's currently being passed
+			  ;; see http://www.perlmonks.org/?node_id=300286
+			  ;; for some of the landmines involved in doing it properly
+			  (pr-str (pr-str form))
+			  (prn-str form))]
+      (.setValue (.createArg java) readable-form))
     ;; to allow plugins and other tasks to customize
     (when handler (handler java))
     (.executeJava java)))


Fix troll button

Fix troll button

--- src/lolitemsets/core.cljs
+++ src/lolitemsets/core.cljs
@@ -257,8 +257,9 @@
              [name calc])))

 (defn troll []
-  (swap! app #(assoc % :champ (rand-nth (vals (:champs %)))
-                       :props (conj {} (rand-nth (seq troll-objectives)))))
+  (swap! app assoc
+         :champ (rand-nth (vals @champs))
+         :props (conj {} (rand-nth (seq troll-objectives))))
   (recommend))

 (defn dorans-button [trolling]


Fixed NPE in reload-all-results

Fixed NPE in reload-all-results

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -100,18 +100,22 @@
     (results/reload-all-results (:configuration request))
     previous-response)

-(defn reload-all-results
-    [request]
-    (results/reload-all-results (:configuration request))
-    (let [response @results/results]
-        (send-response response request)))
-
 (defn create-error-response
     [job-name command message]
     {:status "error"
      :job-name job-name
      :command command
      :message message})
+
+(defn reload-all-results
+    [request]
+    (try
+        (results/reload-all-results (:configuration request))
+        (let [response @results/results]
+            (send-response response request))
+        (catch Exception e
+                (-> (create-error-response "(not needed)" "reload-all-results" (.getMessage e))
+                    (send-error-response request)))))

 (defn job-does-not-exist-response
     [job-name command]


all vehicles

all vehicles