Fix verbage for unnamed guests

Fix verbage for unnamed guests

--- src/app/core.cljs
+++ src/app/core.cljs
@@ -374,14 +374,30 @@
                          (if (get-in infos [id :attending]) " will " " will not ")
                          "attend.")])
              guests)
-        (map (fn [[_ {:keys [name attending] :as plus}]]
-               [:li (str name
-                         (if attending " will " " will not ")
-                         "attend.")])
-             plusses)])
+        (let [unnamed-guests (filter (comp str/blank? :name)
+                                     (vals plusses))
+              unnamed-attending (count (filter (comp true? :attending)
+                                               unnamed-guests))
+              unnamed-regrets   (count (filter (comp false? :attending)
+                                               unnamed-guests))]
+          (when (pos? unnamed-attending)
+            [:li (str unnamed-attending
+                      " additional "
+                      (if (= 1 unnamed-attending)
+                        "guest"
+                        "guests")
+                      " will attend.")])
+          (when (pos? unnamed-regrets)
+            [:li (str unnamed-regrets
+                      " additional "
+                      (if (= 1 unnamed-regrets)
+                        "guest"
+                        "guests")
+                      " will not attend.")]))])
      [:h2 "Doesn't look right?"]
-     [:p "Please " [:a {:href "mailto:anhthuandzane@googlegroups.com"}
-                    "email us"]
+     [:p
+      "Please "
+      [:a {:href "mailto:anhthuandzane@googlegroups.com"} "email us"]
       " and let us know!"]])))

 (defn rsvp-search-results-view [{:keys [name results] :as data} owner]


Expose the temporary state utils via GET

--- src/bzzz/core.clj
+++ src/bzzz/core.clj
@@ -94,7 +94,11 @@
                                               (.toString s)))]))
              "/favicon.ico" "" ;; XXX

-             ;; FIXME use post instead?
+             "/_state/temp_assoc_in"           (state/temp-assoc-in (:data input))
+             "/_state/temp_empty"              (state/temp-empty)
+             "/_state/ro_replace_with_temp"    (state/ro-replace-with-temp)
+             "/_state/ro_merge_with_temp"      (state/ro-merge-with-temp)
+             "/_state/ro_deep_merge_with_temp" (state/ro-deep-merge-with-temp)
              "/_state/ro_merge"      (state/ro-merge input)
              "/_state/ro_deep_merge" (state/ro-deep-merge input)
              "/_state/ro_rename_key" (state/ro-rename-key (:from_key input) (:to_key input))


plugins should now put their task namespace in cake.tasks.name

--- src/cake/task.clj
+++ src/cake/task.clj
@@ -94,7 +94,7 @@
 (defn plugin-namespace [dep]
   (let [plugin-name (-> dep first name)]
     (when-let [ns (second (re-matches #"^cake-(.*)$" plugin-name))]
-      (symbol (str ns ".tasks")))))
+      (symbol (str "cake.tasks." ns)))))

 (defn get-tasks []
   (reduce


Set vary: origin to prevent caching proxy issues.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -122,9 +122,11 @@
             (assoc-in [:headers "Access-Control-Allow-Headers"] "Cancer-Browser-Api, X-Redirect-To"))
         response))))

-(defn- add-version-header [handler]
+(defn- add-headers [handler]
   (fn [request]
-    (assoc-in (handler request) [:headers "Xena-API"] version)))
+    (-> (handler request)
+        (assoc-in [:headers "Xena-API"] version)
+        (update-in [:headers "Vary"] #(if % (s/join ", " [% "Origin"]) "Origin")))))

 (defn- attr-middleware [app k v]
   (fn [req]
@@ -212,7 +214,7 @@
       (attr-middleware :db db)
       (wrap-access-control allow-hosts)
       (wrap-reload) ; XXX only in dev? Does this slow things down?
-      (add-version-header)))
+      (add-headers)))

 ; jetty default thread use is availableProcessors/4 acceptor threads,
 ; and selector threads equal to acceptor threads. For https + http, that


Workaround as getCurrentPosition does not work on non-https URLs

--- src/cljs/map.cljs
+++ src/cljs/map.cljs
@@ -74,8 +74,10 @@
         stop (dom/by-id "stop")
         per (dom/by-id "per")
         sh (dom/by-id "showhere")]
-    (when (= local 1)
-      (.getCurrentPosition (.-geolocation js/navigator) geolocalize))
+    ;; FIXME: first switch to https for panoramap.org
+    ;; http://stackoverflow.com/questions/32106849/getcurrentposition-and-watchposition-are-deprecated-on-insecure-origins
+    ;; (when (= local 1)
+    ;;   (.getCurrentPosition (.-geolocation js/navigator) geolocalize))
     (set! (.-onclick stop) #(set! stopper "stop"))
     (set! (.-onclick sh)
           #(let [z (.getZoom mymap)]


Add timing functions returning the times

--- src/atom_finder/util/10_clj_util.clj
+++ src/atom_finder/util/10_clj_util.clj
@@ -167,6 +167,26 @@

 (defn now [] (java.time.LocalDateTime/now))

+(defmacro time-ns-data
+  "Return time spent in nanoseconds"
+  [expr]
+  `(let [start# (. System (nanoTime))
+         ret#   ~expr
+         end#   (. System (nanoTime))
+         diff#  (- end# start#)]
+     diff#))
+
+(def ns-per-sec
+  (* 1000 1000000.0))
+
+(def ns-per-min
+  (* 60 ns-in-sec))
+
+(defmacro time-secs-data
+  "Return time spent in nanoseconds"
+  [expr]
+  `(/ (time-ns-data ~expr) ns-per-min))
+
 ; https://github.com/clojure/clojure/blob/clojure-1.9.0-alpha14/src/clj/clojure/core.clj#L3836
 (defmacro time-mins
   "Evaluates expr and prints the time it took.  Returns the value of expr."
@@ -175,7 +195,7 @@
          ret#   ~expr
          end#   (. System (nanoTime))
          diff#  (- end# start#)
-         mins-raw#   (/ (double diff#) (* 60 1000 1000000.0))
+         mins-raw#   (/ (double diff#) ns-per-min)
          mins#  (int mins-raw#)
          secs#  (* 60 (- mins-raw# mins#))]
      (prn (format "Elapse time: %d:%05.2f mins" mins# secs#))


Add benchmark helpers to user ns.

Add benchmark helpers to user ns.

--- test/user.clj
+++ test/user.clj
@@ -1,11 +1,19 @@
 (ns user
   (:require [clojure.tools.namespace.repl :as r]
-            [criterium.core :refer [quick-bench]]
+            [criterium.core :refer [quick-bench with-progress-reporting]]
             [clojure.walk :refer [macroexpand-all]]
             [clojure.pprint :refer [pprint]]
             [clojure.test :as test]
             [promesa.core :as p]
-            [promesa.exec :as exec]))
+            [promesa.protocols :as pt]))
+
+(defmacro bench
+  [& exprs]
+  `(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
+
+(defmacro bench'
+  [& exprs]
+  `(quick-bench (do ~@exprs)))

 (defn- run-test
   ([] (run-test #"^promesa.tests.*"))


add log CLI option

add log CLI option

--- src/clojure/zensols/actioncli/log4j2.clj
+++ src/clojure/zensols/actioncli/log4j2.clj
@@ -9,7 +9,8 @@

 (defn change-log-level
   "Change the Log4j2 log level.
-  *level-thing* is the log level as either the Level instance or a string."
+
+  **level-thing** the log level as either the Level instance or a string."
   [level-thing]
   (log/debugf "changing log level to %s" level-thing)
   (let [ctx (LogManager/getContext false)
@@ -24,8 +25,24 @@
       (.setLevel logger level))
     (.updateLoggers ctx)))

-(defn configure [xml-resource]
+(defn configure
+  "Congigure the Log4j2 system with an XML resource."
+  [xml-resource]
   (let [resource (io/resource xml-resource)
         stream (.openStream resource)
         source (ConfigurationSource. stream) ]
     (Configurator/initialize nil source)))
+
+(defn log-level-set-option
+  ([]
+   (log-level-set-option "-l" "--level"))
+  ([short long]
+   [short long "Log level to set in the Log4J2 system."
+    :required "LOG LEVEL"
+    :default (org.apache.logging.log4j.Level/toLevel "info")
+    :parse-fn #(org.apache.logging.log4j.Level/toLevel % nil)
+    :validate [(fn [level]
+                 (when level
+                   (change-log-level level)
+                   true))
+               "Invalid level (error warn info debug trace)"]]))


func: bucketing

func: bucketing

--- src/clojure/zensols/dataset/elsearch.clj
+++ src/clojure/zensols/dataset/elsearch.clj
@@ -176,3 +176,19 @@
   "Return all documents as a lazy sequence."
   []
   (search {:query (q/match-all)}))
+
+(defn buckets
+  "Do an aggregation search and bucket **by-field**.
+
+  Return maps with keys:
+
+  * **:name** value of name given by **by-field**
+  * **:count** the count of the bucket"
+  [by-field]
+  (let [search-key :bucket_key
+        query {:aggs {search-key
+                      {:terms {:field by-field :size 0}}}
+               :size 0}]
+    (->> (search-literal query)
+         :aggregations search-key :buckets
+         (map #(rename-keys % {:key :name :doc_count :count})))))


more minor fixes

more minor fixes

--- src/clj_highlight/syntax/general.clj
+++ src/clj_highlight/syntax/general.clj
@@ -2,8 +2,7 @@

 (def didgets "0123456789abcdefghijklmnopqrstuvwxyz")

-(declare *do-profile*)
-
+(def *do-profile* false)

 (def *profile* (agent {}))


[REFACTOR] Use destructuring

[REFACTOR] Use destructuring

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -635,9 +635,11 @@
               ; FOUR:
               ; |------- exist -------|
               ;      |-- new --|
-              (filter (fn [[ttLessonInfo _]]
-                        (and (>= (dec endTime) (:startTime ttLessonInfo))
-                             (< startTime (:endTime ttLessonInfo))))
+              (filter (fn [[{existingLessonStartTime :startTime
+                             existingLessonEndTime   :endTime}
+                            _]]
+                        (and (>= (dec endTime) existingLessonStartTime)
+                             (< startTime existingLessonEndTime)))
                       ttRow))
             (assoc result :foundFreeRow true)


Refactor histogram

Refactor histogram

--- src/cljs/load_test_om/histogram.cljs
+++ src/cljs/load_test_om/histogram.cljs
@@ -1,6 +1,9 @@
 (ns load-test-om.histogram
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]))
+
+(def chart-width 446)
+(def chart-height 150)

 (defn x-axis [x-scale]
   (-> (.-svg js/d3)
@@ -8,41 +11,29 @@
       (.scale x-scale)
       (.orient "bottom")))

-(defn get-y-scale [height data]
+(defn get-y-scale [data]
   (-> (.. js/d3 -scale linear)
       (.domain #js [0 (.max js/d3 data #(.-y %))])
-      (.range #js [height 0])))
+      (.range #js [chart-height 0])))

-(defn get-x-scale [width values]
+(defn get-x-scale [response-times]
   (-> (.. js/d3 -scale linear)
-      (.domain #js [0 (apply max values)])
-      (.range #js [0 width])))
-
-(defn create-chart [el load-test]
-  (let [height 150]
-
-    ;; axis
-    (-> (.select (.select js/d3 el) "svg g")
-        (.append "g")
-        (.attr "class" "x axis")
-        (.attr "transform" (str "translate(0," height ")")))))
-
-(def label-formatter (.format js/d3 ",.0f"))
+      (.domain #js [0 (apply max response-times)])
+      (.range #js [0 chart-width])))

 (defn format-label [x]
-  (label-formatter (.-y x)))
+  (let [v (.-y x)]
+    (when (pos? v) v)))

-(defn update-chart [el load-test]
-  (let [width 446
-        height 150
-        values (apply array (map :response-time (:data-points load-test)))
-        x-scale (get-x-scale width values)
+(defn update-chart [el data-points]
+  (let [response-times (map :response-time data-points)
+        x-scale (get-x-scale response-times)

         data ((-> (.. js/d3 -layout histogram)
                   (.bins (.ticks x-scale 20)))
-              values)
+              (apply array response-times))

-        y-scale (get-y-scale height data)
+        y-scale (get-y-scale data)

         svg (.select (.select js/d3 el) "svg g")

@@ -51,6 +42,7 @@
                 (.data data)
                 (.attr "transform" #(str "translate(" (x-scale (.-x %)) "," (y-scale (.-y %)) ")")))]

+    ;; new bars
     (doto (-> bar
               (.enter)
               (.append "g")
@@ -61,7 +53,7 @@
       (-> (.append "rect")
           (.attr "x" 1)
           (.attr "width" (dec (x-scale (.-dx (aget data 0)))))
-          (.attr "height" #(- height (y-scale (.-y %)))))
+          (.attr "height" #(- chart-height (y-scale (.-y %)))))

       ;; new texts
       (-> (.append "text")
@@ -76,39 +68,54 @@
         (.selectAll ".bar text")
         (.data data)
         (.attr "x" (/ (x-scale (.-dx (aget data 0))) 2))
-        (.text format-label))
+        (.text format-label)
+        (.exit)
+        (.remove))

     ;; existing rects
     (-> svg
         (.selectAll "rect")
         (.data data)
         (.attr "width" (dec (x-scale (.-dx (aget data 0)))))
-        (.attr "height" #(- height (y-scale (.-y %)))))
+        (.attr "height" #(- chart-height (y-scale (.-y %))))
+        (.exit)
+        (.remove))
+
+    ;; cleanup old bars
+    (-> bar .exit .remove)

     (-> svg
         (.select ".x.axis")
         (.call (x-axis x-scale)))))

+(defn create-x-axis [el]
+  (-> (.select js/d3 el)
+      (.select "svg g")
+      (.append "g")
+      (.attr "class" "x axis")
+      (.attr "transform" (str "translate(0," chart-height ")"))))
+
+(defn create-chart [el data-points]
+  (create-x-axis el)
+  (update-chart el data-points))
+
 (defn component [load-test owner]
   (reify
     om/IDidMount
     (did-mount [_]
-      (create-chart (om/get-node owner) load-test)
-      (update-chart (om/get-node owner) load-test))
+      (create-chart (om/get-node owner) (:data-points load-test)))

     om/IDidUpdate
     (did-update [_ _ _]
-      (update-chart (om/get-node owner) load-test))
+      (update-chart (om/get-node owner) (:data-points load-test)))

     om/IRender
     (render [_]
-      (let [width 446
-            height 150
-            top 20
+      (let [top 20
             right 10
             bottom 30
             left 30]
         (dom/div #js {:className "chart response-time-histogram"}
-                 (dom/svg #js {:width (+ width left right)
-                               :height (+ height top bottom)}
+                 (dom/svg #js {:width (+ chart-width left right)
+                               :height (+ chart-height top bottom)}
                           (dom/g #js {:transform (str "translate(" left "," top ")")})))))))


CMR-3228: Address review comments.

CMR-3228: Address review comments.

--- search-app/src/cmr/search/services/query_execution/granule_counts_results_feature.clj
+++ search-app/src/cmr/search/services/query_execution/granule_counts_results_feature.clj
@@ -56,17 +56,17 @@
     query
     ;; Matches spatial or temporal conditions
     (fn [condition-path condition]
-      (let [cond-type (type condition)]
-        (when (or (= cond-type SpatialCondition)
-                  (= cond-type TemporalCondition))
-          ;; Validate that the parent of the spatial or temporal condition is acceptable
-          (validate-path-to-condition query condition-path)
-          true)))))
+      (when (or (instance? SpatialCondition condition)
+                (instance? TemporalCondition condition))
+        ;; Validate that the parent of the spatial or temporal condition is acceptable
+        (validate-path-to-condition query condition-path)
+        true))))
+

 (defn- convert-spatial-or-temporal-condition
   "Applies any necessary changes to spatial or temporal condition to make them work with granules"
   [condition]
-  (if (= TemporalCondition (type condition))
+  (if (instance? TemporalCondition condition)
     ;; Turn off limit to granules so that the correct fields will be searched. limit to granules is a
     ;; collection applicable parameter.
     (assoc condition :limit-to-granules false)


Refactor URI from frereth.server

Refactor URI from frereth.server

--- src/com/frereth/common/communication.clj
+++ src/com/frereth/common/communication.clj
@@ -49,6 +49,22 @@
   "Really pretty useless, except as an intermediate step"
   (dissoc router-message :socket))

+(comment
+  (s/defrecord URI [protocol :- s/Str
+                    address :- s/Str
+                    port :- s/Int]
+    ;; TODO: This could really just as easily
+    ;; be a plain dictionary.
+    ;; More importantly, it conflicts with native
+    ;; Java's URI. This will be confusing
+    component/Lifecycle
+    (start [this] this)
+    (stop [this] this)))
+
+(def URI {:protocol s/Str
+          :address s/Str
+          :port s/Int})
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal

@@ -80,6 +96,14 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public
+
+(s/defn build-url :- s/Str
+  [url :- URI]
+  (str (:protocol url) "://"
+       (:address url)
+       ;; port is meaningless for inproc
+       (when-let [port (:port url)]
+         (str ":" port))))

 (s/defn router-recv! :- (s/maybe router-message)
   ([s :- mq/Socket]


Learning about Collection Abstraction

Learning about Collection Abstraction

--- Clojure-Core/clojure_core.clj
+++ Clojure-Core/clojure_core.clj
@@ -463,3 +463,143 @@

 ; ------------------------------------------------------------------------------
 ; Infinite Sequences
+
+;; Finally! - One of the best aspects of a lazy seq is our ability to work with
+;; and construct infinite sequences. One of the ways we can construct these
+;; infinite seqs is calling upon the 'repeat' function - creating a seq
+;; where every member is the arg passed to it.
+
+(concat (take 6 (repeat "oy")) ["'Cause I'm T.N.T. I'm dynamite!"])
+; => ("oy" "oy" "oy" "oy" "oy" "oy" "'Cause I'm T.N.T. I'm dynamite!")
+
+(take 3 (repeatedly (fn [] (rand-int 10))))
+; => (9 2 7)
+
+(defn even-numbers
+  ([] (even-numbers 0))
+  ([n] (cons n (lazy-seq (even-numbers (+ n 2))))))
+
+(take 10 (even-numbers))
+; => (0 2 4 6 8 10 12 14 16 18)
+
+;; cons vs conj (I confuse these being so new, so I needed a way to memorize):
+
+;; cons => 's' => adds x to the 's'tart of a seq
+(cons 0 '(2 4 6))
+; => (0 2 4 6)
+
+;; conj => 'j' => 'j'oins the existing seq and some xs
+(conj '(2 4 6) 8 10)
+; => (10 8 2 4 6)
+
+(conj [2 4 6] 8 10)
+; => [2 4 6 8 10]
+
+;; Note: Depending on the type, `conj` will con`join` the new xs to the seq
+;; in varying order, as shown above
+
+; ------------------------------------------------------------------------------
+; The Collection Abstraction
+
+;; Like the sequence abstraction we've been working with - there's another
+;; closely related abstraction known as the 'collection abstraction.' All of
+;; Clojure's core data structures take part in both abstractions.
+
+;; Just as we understood the sequence collection to be about operating on
+;; members individually, the collection abstraction is about operating on
+;; the data structure as a whole.
+
+;; Some examples of these 'whole collection' concerns include:
+;; - Count (count coll)
+;; - Empty? (empty? coll)
+;; - Every? (every? pred coll)
+;; - Into (into to from) (into to xform form)
+;; - Conj (conj coll x) (conj coll x & xs)
+;; ...et cetera...
+
+(empty? [])
+; => true
+
+(empty? ["metal"])
+; => false
+
+;; Let's explore 'into' and 'conj' in more depth!
+
+; into
+
+;; Into is doing the work of transforming, because so many seq
+;; functions return a seq rather than any original data structure,
+;; into is a great utility function that transforms the return value
+;; back into the original value
+
+(map identity {:favorite-guitar "Flying V"})
+; => ([:favorite-guitar "Flying V"])
+
+(into {} (map identity {:favorite-guitar "Flying V"}))
+; => {:favorite-guitar "Flying V"}
+
+;; We don't have to work with just maps, we can use other structures, as well:
+
+(map identity [:favorite-guitar-pedal :favorite-amplifier])
+; => (:favorite-guitar-pedal :favorite-amplifier)
+
+(into [] (map identity [:favorite-guitar-pedal :favorite-amplifier]))
+; => [:favorite-guitar-pedal :favorite-amplifier]
+
+;; Heck, we can even transform one data structure into another, entirely.
+;; Here, we'll map over a vector returning a seq and then transform
+;; this returned seq value into a set
+
+(map identity [:favorite-guitar-lick :favorite-guitar-lick])
+
+(into #{} (map identity [:favorite-guitar-lick :favorite-guitar-lick]))
+
+;; We can also add to a non-empty data structure:
+
+(into {:favorite-musical-scale "Phrygian"} [[:favorite-guitar-solo "Black Star"]])
+; => {:favorite-musical-scale "Phrygian" :favorite-guitar-solo "Black Star"}
+
+(into ["Gibson"] '("Fender" "Ibanez"))
+; => ["Gibson" "Fender" "Ibanez"]
+
+(into {:favorite-metal-city "Kopervik, Norway"} {:favorite-metal-pet "Dragon"
+                                                 :favorite-metal-moment "1980 Winter Olympics"})
+; => {:favorite-metal-city "Kopervik, Norway"
+; =>  :favorite-metal-pet "Dragon"
+; =>  :favorite-metal-moment "1980 Winter Olympics"}
+
+; conj
+
+;; We already looked at conj, but it's worth a second pass:
+
+(conj [6] [6])
+; => [6 [6]]
+
+(into [6] [6])
+; => [6 6]
+
+(conj [6] 6)
+; => [6 6]
+
+;; Notice here that conj takes a scalar value, whereas into takes a collection
+
+(conj [6] 6 6)
+; => [6 6 6]
+
+(conj {:time "the witching hour"} [:place "the halls of valhalla"])
+; => {:place "the halls of valhalla" :time "the witching hour"}
+
+;; There are obvious similarities here, so much so that we can write:
+(defn my-conj
+  [target & additions]
+  (into target additions))
+
+(my-conj [6] 6)
+; => [6 6]
+
+;; "This kind of pattern isn't that uncommon. You'll often see two functions
+;; that do the same thing, except one takes a rest param ('conj') and one takes
+;; a seqable data structure ('into')"
+
+; ------------------------------------------------------------------------------
+; Function Functions


Transition to partial-results, partial SAHTN implementation.

--- src/exp/sahdd.clj
+++ src/exp/sahdd.clj
@@ -63,27 +63,34 @@

 ;; TODO: generalize goal condition, etc.

+(deftype PartialResult [result-pairs max-reward])
+
 (defn incremental-dijkstra
   "Expand queue items until (1) goal, or (2) (queue-cutoff queue min-reward).
    Safe against recursive calls in expand-fn, which takes a node and min-reward and
-   returns [[old-node new-reward] & [new-node reward]*]"
+   returns a PartialResult of nodes."
   [queue min-reward expand-fn goal-fn]
   (loop []
     (or (let [cutoff (queue-best-reward queue)]
-          (when (not (viable? cutoff min-reward)) cutoff))
+          (when (not (viable? cutoff min-reward)) (PartialResult nil cutoff)))
         (let [[best best-reward] (pop-queue queue)]
-          (or (when-let [g (goal-fn best)] [g best-reward])
+          (or (when-let [g (goal-fn best)] (PartialResult [[g best-reward]] (queue-best-reward queue)))
               (let [next-min-reward (max min-reward (queue-best-reward queue))]
                 (queues/pq-replace! queue best (make-queue-priority best-reward))
-                (let [[[_ new-reward] & new-items] (expand-fn best next-min-reward)]
-                  (assert (identical? _ best))
-                  (queues/pq-replace! queue best (make-queue-priority new-reward))
-                  (doseq [[ni nr] new-items]
+                (let [{:keys [result-pairs max-reward]} (expand-fn best next-min-reward)]
+                  (queues/pq-replace! queue best (make-queue-priority max-reward))
+                  (doseq [[ni nr] result-pairs]
                     (queues/pq-add! queue ni (make-queue-priority nr)))
                   (recur))))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outcome maps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+
+(defn make-descendents [state action prim-constructor ref-constructor]
+  (if (env/primitive? action)
+      (when-let [[ss sr] (and (env/applicable? action state) (env/successor action state))]
+        [(prim-constructor ss sr)])
+    (map ref-constructor (hierarchy/immediate-refinements action state))))

 (defn generalize-outcome-pair [[outcome-state reward] gen-state reward-to-gen-state]
   [(vary-meta (env/apply-effects gen-state (env/extract-effects outcome-state)) assoc
@@ -100,8 +107,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defprotocol IncrementalSearch
-  (next-solution-or-cutoff [sp min-reward]
-     "Output is [new-outcome-state reward] where reward >= min, or new threshold < min."))
+  (next-partial-solution [sp min-reward]
+     "Output is PartialResult, where results are states."))

 (declare extract-goal-state expand-node)

@@ -110,15 +117,29 @@
 (defn make-incremental-dijkstra-search [initial-nodes]
   (let [q (make-queue initial-nodes)]
     (reify IncrementalSearch
-      (next-solution-or-cutoff [min-reward]
+      (next-partial-solution [min-reward]
         (incremental-dijkstra q min-reward expand-node extract-goal-state)))))

-; (util/print-debug 1 "\nRefining " (second  name) (first name) "with min-reward [" min-reward "]" "\n" (map #(vector (pretty-state (:initial-state (first %))) (map env/action-name (:remaining-actions (first %))) (next %)) (queues/pq-peek-pairs child-queue)))
+
+;; TODO: need "generalized-goal" dijkstra search.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Exhaustive Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; No reason to use this except to emulate SAHTN.
+;; Note: destroys cost order, but should still work correctly.
+
+(defn make-exhaustive-search [sp]
+  (reify IncrementalSearch
+    (next-partial-solution [min-reward]
+      (loop [results []]
+        (let [{:keys [result-pairs max-reward]} (next-partial-solution sp Double/NEGATIVE_INFINITY)]
+          (let [next-results (into results result-pairs)]
+            (if (= max-reward Double/NEGATIVE_INFINITY)
+                (PartialResult next-results max-reward)
+              (recur next-results))))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cached Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; TODO: split refine into PartialResult type, always give new reward -- more accurate.

 (defn make-cached-search-factory
   "Return a cache-fn, where (cache-fn) returns fresh IncrementalSearch views on
@@ -129,21 +150,21 @@
     (fn cache-factory []
       (let [index-atom   (atom 0)]
         (reify IncrementalSearch
-          (next-solution-or-cutoff [min-reward]
+          (next-partial-solution [min-reward]
             (if (< @index-atom (count @result-vec-atom))
                 (let [[_ rew :as result] (nth @result-vec-atom @index-atom)]
                   (if (>= rew min-reward)
-                      (do (swap! index-atom inc) result)
-                    rew))
+                      (do (swap! index-atom inc)
+                          (PartialResult [result]
+                                         (max (get @result-vec-atom @index-atom Double/NEGATIVE_INFINITY)
+                                              @next-reward-atom)))
+                    (PartialResult nil rew)))
               (if (viable? @next-reward-atom min-reward)
-                  (let [result (next-solution-or-cutoff search-problem min-reward)]
-                    (if (number? result)
-                        (reset! next-reward-atom result)
-                      (do (swap! result-vec-atom conj result)
-                          (reset! next-reward-atom (nth result 1))))
+                  (let [{:keys [result-pairs max-reward]} (next-partial-solution search-problem min-reward)]
+                    (reset! next-reward-atom max-reward)
+                    (swap!  result-vec-atom into result-pairs)
                     (recur min-reward))
-                @next-reward-atom))))))))
-; (util/print-debug 2 "SSPC" min-reward (Thread/sleep 10))
+                (PartialResult nil @next-reward-atom)))))))))

 (def #^HashMap *problem-cache*)

@@ -153,12 +174,16 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; State-Abstracted Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(defn lift-partial-result [partial-result context-state context-reward]
+  (let [{:keys [result-pairs max-reward]} partial-result]
+    (PartialResult (map #(generalize-outcome-pair % context-state context-reward) result-pairs)
+                   (+ max-reward context-reward))))
+
 (defn make-search-in-context [subsearch context-state context-reward]
   (reify IncrementalSearch
-    (next-solution-or-cutoff [min-reward]
-      (let [result (next-solution-or-cutoff subsearch (- min-reward context-reward))]
-        (if (number? result) (+ result context-reward)
-          (generalize-outcome-pair result context-state context-reward))))))
+    (next-partial-solution [min-reward]
+      (lift-partial-result (next-partial-solution subsearch (- min-reward context-reward))
+                           context-state context-reward))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -170,7 +195,7 @@
   (extract-goal-state [se]
     "This entire node is one solution state, which is returned.")
   (expand-node        [se new-threshold]
-    "Returns list of [SearchNode reward] pairs; first is always self"))
+    "Returns PartialResult of SearchNodes."))

 (deftype GoalNode [goal-state]
   SearchNode
@@ -178,49 +203,74 @@
   (expand-node        [min-reward] (throw (UnsupportedOperationException.))))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Recursive Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare make-sp-recursive-node)
-
-(deftype SPRecursiveNode [name subproblem remaining-actions] :as this
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Named Node (Helper) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Named node is simple non-terminal node whose equality semantics are given by name.
+(deftype NamedNode [name expand-fn] :as this
   Object
   (equals [y] (= name (:name y)))
   (hashCode [] (hash name))
   SearchNode
   (extract-goal-state []  nil)
-  (expand-node        [min-reward]
-    (let [result (next-solution-or-cutoff (force subproblem) min-reward)]
-      (if (number? result)
-          [[this result]]
-        [[this (nth result 1)]
-         (make-sp-recursive-node result remaining-actions)]))))
+  (expand-node        [min-reward] (expand-fn min-reward)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Recursive Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare make-sp-recursive-node)

 (defn make-initial-sp-nodes [state action]
-  (if (env/primitive? action)
-    (when-let [[ss sr] (and (env/applicable? action state) (env/successor action state))]
-      [[(GoalNode ss) sr]])
-    (for [ref (hierarchy/immediate-refinements action state)]
-      (make-sp-recursive-node [state 0] ref))))
+  (make-descendents state action
+    (fn [ss sr] [(GoalNode ss) sr])
+    (fn [ref] (make-sp-recursive-node [state 0] ref))))

 (defn make-sp-recursive-node [[state reward] remaining-actions]
   [(if-let [[f & r] (seq remaining-actions)]
-     (let [context          (env/precondition-context f state)
-           state-in-context (env/extract-context state context)
-           sub-name         [state-in-context (env/action-name f)]
-           sup-name         [state-in-context (map env/action-name remaining-actions)]]
-       (SPRecursiveNode sup-name
-         (delay
-          (make-search-in-context
-           (get-cached-search sub-name
-             (make-incremental-dijkstra-search
-              (make-initial-sp-nodes (env/get-logger state context) f)))
-           state reward))
-         r))
+     (let [context (env/precondition-context f state)
+           sp      (delay
+                    (make-search-in-context
+                     (get-cached-search [(env/extract-context state context) (env/action-name f)]
+                       (make-incremental-dijkstra-search
+                        (make-initial-sp-nodes (env/get-logger state context) f)))
+                     state reward))]
+       (NamedNode [state (map env/action-name remaining-actions)]
+          (fn sp-recursive-expand [min-reward]
+            (let [{:keys [result-pairs max-reward]} (next-partial-solution (force sp) min-reward)]
+              (PartialResult (map #(make-sp-recursive-node % r) result-pairs) max-reward)))))
      (GoalNode state))
    reward])

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Drivers  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Transparent Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn make-sp-transparent-node [[state reward] remaining-actions]
+  [(if-let [[f & r] (seq remaining-actions)]
+       (NamedNode [state (map env/action-name remaining-actions)]
+         (fn sp-transparent-expand [min-reward]
+           (PartialResult
+            (make-descendents state f
+              (fn [ss sr] (make-sp-transparent-node [ss (+ sr reward)] r))
+              (fn [ref]   (make-sp-transparent-node [state reward] (concat ref r))))
+            Double/NEGATIVE_INFINITY)))
+     (GoalNode state))
+   reward])
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Semi-Transparent Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Need method on search to return node-list to implement this...
+(defn make-sp-semi-transparent-node [[state reward] remaining-actions]
+  )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Inverted Node ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; TODO: how to switch between these as we go?!
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Drivers  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn sahucs-simple [henv]
   (binding [*problem-cache* (HashMap.)]
@@ -228,9 +278,28 @@
           init (env/initial-logging-state e)
           tla  (hierarchy/TopLevelAction e [(hierarchy/initial-plan henv)])
           top  (make-incremental-dijkstra-search (make-initial-sp-nodes init tla))
-          result (next-solution-or-cutoff top Double/NEGATIVE_INFINITY)]
-      (when (not (number? result))
-        (second result)))))
+          result (next-partial-solution top Double/NEGATIVE_INFINITY)]
+      (assert (< (count (:result-pairs result 1))))
+      (second (first (:result-pairs result))))))
+
+
+(defn blablabla [henv]
+  (binding [*problem-cache* (HashMap.)]
+    (let [e    (hierarchy/env henv)
+          init (env/initial-logging-state e)
+          tla  (hierarchy/TopLevelAction e [(hierarchy/initial-plan henv)])
+          top  (make-incremental-dijkstra-search (make-initial-sp-nodes init tla))]
+      (next-partial-solution (make-exhaustive-search top) Double/NEGATIVE_INFINITY))))
+
+(defn sahucs-transparent [henv]
+  (binding [*problem-cache* (HashMap.)]
+    (let [e    (hierarchy/env henv)
+          init (env/initial-logging-state e)
+          tla  (hierarchy/TopLevelAction e [(hierarchy/initial-plan henv)])
+          top  (make-incremental-dijkstra-search [(make-sp-transparent-node [init 0] [tla])])
+          result (next-partial-solution top Double/NEGATIVE_INFINITY)]
+      (assert (< (count (:result-pairs result 1))))
+      (second (first (:result-pairs result))))))

 ;; For SAHA, nothing is open.
 ;  Or strcture is same.


Module db-interface: added read-db-stats and read-record-count

--- src/emender_service/db_interface.clj
+++ src/emender_service/db_interface.clj
@@ -132,6 +132,25 @@
             (println e)
             [])))

+(defn read-record-count
+    [table-name]
+    (try
+        (:cnt
+            (first
+                (jdbc/query db-spec/emender-service-db
+                            [(str "select count(*) as cnt from " table-name)])))
+        (catch Exception e
+            (println e)
+            0)))
+
+(defn read-db-stats
+    []
+    {:log            (read-record-count "log")
+     :errors         (read-record-count "errors")
+     :requests       (read-record-count "requests")
+     :job-operations (read-record-count "job_operations")
+     :results        (read-record-count "results")})
+
 (defn record-error
     [job-name repo-url branch datetime message stacktrace]
     (try


Pairing-taulukon rivi omaksi komponentikseen

--- mtg-pairings-server/src/cljs/mtg_pairings_server/components/tournament.cljs
+++ mtg-pairings-server/src/cljs/mtg_pairings_server/components/tournament.cljs
@@ -41,6 +41,26 @@
   {:class (when (not= column sort-key) "inactive")
    :on-click #(dispatch [:sort-pairings column])})

+(defn pairing-row [cls pairing]
+  [:tr {:class cls}
+   [:td.table (:table_number pairing)]
+   [:td.players
+    (:team1_name pairing)
+    [:br.hidden-sm.hidden-md.hidden-lg]
+    [:span.hidden-sm.hidden-md.hidden-lg
+     (:team2_name pairing)]]
+   [:td.players2.hidden-xs (:team2_name pairing)]
+   [:td.points
+    (:team1_points pairing)
+    [:span.hidden-xs " - "]
+    [:br.hidden-sm.hidden-md.hidden-lg]
+    [:span (:team2_points pairing)]]
+   [:td.result
+    (:team1_wins pairing)
+    [:span.hidden-xs " - "]
+    [:br.hidden-sm.hidden-md.hidden-lg]
+    [:span (:team2_wins pairing)]]])
+
 (defn pairings [id round]
   (let [data (subscribe [:sorted-pairings id round])
         sort-key (subscribe [:pairings-sort])]
@@ -59,23 +79,6 @@
          [:th.points "Pisteet"]
          [:th.result "Tulos"]]]
        [:tbody
-        (for [[i p] (indexed @data)]
-          ^{:key [(:team1_name p)]}
-          [:tr {:class (if (even? i) "even" "odd")}
-           [:td.table (:table_number p)]
-           [:td.players
-            (:team1_name p)
-            [:br.hidden-sm.hidden-md.hidden-lg]
-            [:span.hidden-sm.hidden-md.hidden-lg
-             (:team2_name p)]]
-           [:td.players2.hidden-xs (:team2_name p)]
-           [:td.points
-            (:team1_points p)
-            [:span.hidden-xs " - "]
-            [:br.hidden-sm.hidden-md.hidden-lg]
-            [:span (:team2_points p)]]
-           [:td.result
-            (:team1_wins p)
-            [:span.hidden-xs " - "]
-            [:br.hidden-sm.hidden-md.hidden-lg]
-            [:span (:team2_wins p)]]])]])))
+        (for [[i pairing] (indexed @data)]
+          ^{:key [(:team1_name pairing)]}
+          [pairing-row (if (even? i) "even" "odd") pairing])]])))


change validate-schema api to support parsed/unparsed schema

--- src/graphql_clj/schema_validator.clj
+++ src/graphql_clj/schema_validator.clj
@@ -300,7 +300,7 @@
   (let [query-root (get-in schema [:roots :query])]
     (update-in schema [:type-map query-root] update-root-query-with-introspection)))

-(defn validate-schema
+(defn- validate-schema*
   [schema]
   ;; after validation add
   ;; {:type-system-definitions [ ... ]
@@ -318,3 +318,10 @@
       schema-with-updated-root-query
       (throw (ex-info "schema validation failed"
                       {:errors errors})))))
+
+(defn validate-schema
+  [schema]
+  (let [validated-schema (if (string? schema)
+                           (parser/parse-schema schema)
+                           schema)]
+    (validate-schema* validated-schema)))


Logger middleware improved to have a cleaner look n feel

--- src/hellhound/middlewares/logger.clj
+++ src/hellhound/middlewares/logger.clj
@@ -1,8 +1,34 @@
 (ns hellhound.middlewares.logger
+  "Log requests and responses for better development."
   (:require [colorize.core         :as color]
             [hellhound.logger.core :as logger]))

+;; TODO: We need to refactore this function to include the parameterize
+;;       keys and values
 (defn wrap-logger [handler]
+  "Log the requests and responses."
   (fn [request]
-    (logger/info (format "[REQUEST] %s %s" (color/green "PATH: ") (:uri request)))
-    (handler request)))
+    (let [start (System/currentTimeMillis)]
+      (logger/info (format "%s %s %s, %s %s"
+                           (color/bold (color/white "[REQUEST]"))
+                           (color/blue "Started,")
+                           (color/bold (color/yellow (clojure.string/upper-case (:request-method request))))
+                           (color/green "PATH:")
+                           (:uri request)))
+
+      (let [response (handler request)
+            status   (:status response)
+            finish   (System/currentTimeMillis)
+            total    (- finish start)]
+
+        (logger/info (format "%s %s %s %s %s %s"
+                             (color/bold (color/white "[Response]"))
+                             (color/cyan "Finished,")
+                             (color/magenta "TIME:")
+                             (str  total "ms")
+                             (color/white "Status:")
+                             (cond
+                               (and (< status 300) (> status 199)) (color/green status)
+                               (and (< status 600) (> status 399)) (color/red   status)
+                               :else (color/yellow status))))
+        response))))


Reduce probability of catching a statistical fluctuation.

--- src/iacomus_alerts/core.clj
+++ src/iacomus_alerts/core.clj
@@ -101,13 +101,14 @@

 (defn is-outlier? [timeseries [date point]]
   ;; Returns true if the datapoint can be considered an outlier in the timeseries
-  (let [count-points (count timeseries)
-        timeseries (->> timeseries
-                        (map second)
-                        (filter identity))]
-    (when (> (count timeseries) (/ count-points 2)) ;; Ignore timeseries with many NAs
-      (when-let [[mean sd threshold] (outlier-sd? timeseries point)]
-        {:mean mean, :sd sd, :threshold threshold}))))
+  (when (and timeseries date point)
+    (let [count-points (count timeseries)
+          timeseries (->> timeseries
+                          (map second)
+                          (filter identity))]
+      (when (> (count timeseries) (/ count-points 2)) ;; Ignore timeseries with many NAs
+        (when-let [[mean sd threshold] (outlier-sd? timeseries point)]
+          {:mean mean, :sd sd, :threshold threshold})))))

 (defn box-plot [attr xs value date]
   (let [xs (filter identity xs)
@@ -133,18 +134,22 @@

 (defn alerts [config time]
   ;; Runs the detection system for the specified iacomus configuration file
+  ;; After seeing some of the (probably) misclassified alerts I start thinking
+  ;; that using bayesian inference on windows would be better suited for this problem...
   (let [pk (primary-key config)
         attrs (sort-attributes config)
         reports-source (reports config time)
         latest-report (first reports-source)
         reports (->> reports-source
-                     (take 8)
+                     (take 9)
                      (map (partial index-by-primary-keys pk)))]
     (->> (for [[attr-name attr] attrs]
            (let [metrics (top-metrics pk latest-report attr)]
              (for [metric metrics]
-               (let [[latest & series] (timeseries reports metric attr)]
-                 (when-let [statistic (is-outlier? series latest)]
+               (let [[f latest & series :as ts] (timeseries reports metric attr)
+                     statistic (is-outlier? series latest)
+                     statistic-f (is-outlier? series f)] ;; Reduce the probability of dealing with a statistical fluctuation...
+                 (when (and statistic statistic-f)
                    (generate-alert config
                                    attr-name
                                    (merge statistic


added 3 functions that work toward implementing tfidf

--- src/help_me_im_dumb/query_engine.clj
+++ src/help_me_im_dumb/query_engine.clj
@@ -19,3 +19,34 @@
       q-tokens))))

 (def bquery->results (partial query->results boolean-query-matcher))
+
+
+
+(defn list-all-docs
+  "for a given query list all documents that at least one appears in"
+  [q]
+  (apply clojure.set/union
+         (distinct
+           (map
+             #(into #{} (index/term->postings %))
+             (clojure.string/split q #"\s+")
+             ))))
+
+
+(defn idf-score
+  "for a given docs and a term find idf"
+  [term docs]
+  (/
+    (float (count docs))
+    (float (count (index/term->postings term)))
+    )
+  )
+
+
+(defn tf-score
+  "given 1 doc and 1 term find term freq"
+  [term docid]
+  (count
+    (re-seq(re-pattern term)
+            (get (index/docid->doc docid) :title))))
+


add missing closing brackets

add missing closing brackets

--- src/pc/render.clj
+++ src/pc/render.clj
@@ -125,10 +125,10 @@
                    {:style "background: #333"}))
            [:defs
             [:style {:type "text/css"}
-             (format "@font-face { font-family: 'Roboto'; src: url('data:application/x-font-ttf;base64, %s') format('truetype');"
+             (format "@font-face { font-family: 'Roboto'; src: url('data:application/x-font-ttf;base64, %s') format('truetype');}"
                      (:roboto-regular (fonts)))]
             [:style {:type "text/css"}
-             (format "@font-face { font-family: 'FontAwesome'; src: url('data:application/x-font-ttf;base64, %s') format('truetype');"
+             (format "@font-face { font-family: 'FontAwesome'; src: url('data:application/x-font-ttf;base64, %s') format('truetype');}"
                      (:fontawesome (fonts)))]]
            ;; hack to make pngs work
            (when invert-colors?


add ability to set layer threshold

add ability to set layer threshold

--- src/pc/server.clj
+++ src/pc/server.clj
@@ -72,6 +72,17 @@
                             (format "
%s
" doc-id doc-id)))
                      ["Nothing interesting today :("]))
                 "</html")})
+
+   (GET ["/interesting/:layer-count" :layer-count #"[0-9]+"] [layer-count]
+        {:status 200
+         :body (str
+                ""
+                (clojure.string/join
+                 " "
+                 (or (seq (for [doc-id (db-admin/interesting-doc-ids {:layer-threshold (Integer/parseInt layer-count)})]
+                            (format "
%s
" doc-id doc-id)))
+                     ["Nothing interesting today :("]))
+                "</html")})
    (compojure.route/resources "/" {:root "public"
                                    :mime-types {:svg "image/svg"}})
    (GET "/chsk" req ((:ajax-get-or-ws-handshake-fn sente-state) req))


Leave path in parse when running through transformers.

--- src/incise/parsers/html.clj
+++ src/incise/parsers/html.clj
@@ -85,7 +85,7 @@
     (-> out-file
         (.getParentFile)
         (.mkdirs))
-    (spit out-file (:content (transform (dissoc parse-data :path))))
+    (spit out-file (:content (transform parse-data)))
     out-file))

 (defn html-parser


Ensure that several more request properties are captured and transferred across a loopback

--- src/io/aviso/rook/async.clj
+++ src/io/aviso/rook/async.clj
@@ -201,6 +201,12 @@
        (context path handler')
        handler'))))

+(def request-copy-properties
+  "Properties of a Ring request that should be copied into a chained request."
+  [:server-port :server-name :remote-addr :scheme :content-type :character-encoding
+   :ssl-client-cert :headers
+   :server-uri])
+
 (defn wrap-with-loopback
   "Wraps a set of asynchronous routes with a loopback: a function that calls back into the same asynchronous routes.
   This is essentially the whole point of of the asynchronous support: to allow individual resource handler functions
@@ -223,17 +229,22 @@
   to the loopback by providing an argument with a matching name. The default Ring request key is :loopback-handler.

   The loopback handler will capture some request data when first invoked (in a non-loopback request); this information
-  is merged into the request map provided to the handler. The keys :scheme, :server-port, :server-name,
-  and :server-uri are captured, so that the :resource-uri argument can be calculated.
-
-  In addition, the [:rook :arg-resolvers] key is capture, since often default argument resolvers are
+  is merged into the request map provided to the handler. This includes :scheme, :server-port, :server-name,
+  and several others. Specifically :server-uri is captured, so that the :resource-uri argument can be calculated.
+
+  What's not captured: the :body, :params, :uri, :query-string, and all the various :*-params generated
+  by standard middleware. Essentially, enough information is captured and restored to allow the eventual
+  handler to make determinations about the originating request, but not know the specific URI, query parameters,
+  or posted data.
+
+  In addition, the [:rook :arg-resolvers] key is captured, since often default argument resolvers are
   defined higher in the pipeline."
   ([handler]
    (wrap-with-loopback handler :loopback-handler))
   ([handler k]
    (fn [request]
      (let [arg-resolvers (-> request :rook :arg-resolvers)
-           captured-request-data (select-keys request [:scheme :server-port :server-name :server-uri])]
+           captured-request-data (select-keys request request-copy-properties)]
        (letfn [(handler' [nested-request]
                          (let [wrapped (rook/arg-resolver-middleware handler (rook/build-map-arg-resolver k handler'))
                                request' (-> nested-request
@@ -255,11 +266,11 @@
        (let [response-ch (chan 1)]
          ;; To keep things fully asynchronous, we first invoke the downstream handler.
          (take! (try
-                   (req-handler request)
-                   (catch Throwable t
-                     (result->channel
-                       (utils/response HttpServletResponse/SC_INTERNAL_SERVER_ERROR
-                                       {:exception (exceptions/to-message t)}))))
+                  (req-handler request)
+                  (catch Throwable t
+                    (result->channel
+                      (utils/response HttpServletResponse/SC_INTERNAL_SERVER_ERROR
+                                      {:exception (exceptions/to-message t)}))))
                 (fn [handler-response]
                   (put! response-ch
                         (->


Hack together limited source map support for Less4J

--- src/io/aviso/twixt/less.clj
+++ src/io/aviso/twixt/less.clj
@@ -1,7 +1,7 @@
 (ns io.aviso.twixt.less
   "Provides asset pipeline middleware for compiling Less source files to CSS."
   (:import
-    [com.github.sommeri.less4j LessSource LessSource$FileNotFound Less4jException LessCompiler$Problem LessCompiler]
+    [com.github.sommeri.less4j LessSource LessSource$FileNotFound Less4jException LessCompiler$Problem LessCompiler LessCompiler$CompilationResult LessSource$StringSource LessCompiler$Configuration]
     [com.github.sommeri.less4j.core DefaultLessCompiler])
   (:require
     [clojure.java.io :as io]
@@ -62,16 +62,26 @@

 (defn- compile-less
   [^LessCompiler less-compiler asset {:keys [asset-resolver] :as context}]
-  (let [name (:resource-path asset)]
+  (let [path (:resource-path asset)]
     (t/timer
-      #(format "Compiled `%s' to CSS in %.2f ms" name %)
+      #(format "Compiled `%s' to CSS in %.2f ms" path %)
       (t/track
-        #(format "Compiling `%s' from Less to CSS" name)
+        #(format "Compiling `%s' from Less to CSS" path)
         (try
           (let [dependencies (atom {})
                 root-source (create-less-source asset-resolver dependencies asset context)
-                output (.compile less-compiler root-source)]
-            (utils/create-compiled-asset asset "text/css" (.getCss output) @dependencies))
+                ;; A bit of work to trick the Less compiler into writing the right thing into the output CSS.
+                ^LessCompiler$CompilationResult output (.compile less-compiler root-source)
+                complete-css (str
+                               (.getCss output)
+                               "\n/*# sourceMappingURL="
+                               (utils/path->name path)
+                               "@source.map */")
+                source-map (.getSourceMap output)]
+            (->
+              asset
+              (utils/create-compiled-asset "text/css" complete-css @dependencies)
+              (utils/add-attachment "source.map" "application/json" (utils/as-bytes source-map))))
           (catch Less4jException e
             (throw (RuntimeException. (format-less-exception e) e))))))))


Fixed measurements bug on content-type switching.

--- src/kixi/hecuba/api/measurements.clj
+++ src/kixi/hecuba/api/measurements.clj
@@ -85,15 +85,15 @@
              (update-in [:timestamp] util/db-to-iso)
              (dissoc :month :metadata :device_id))) measurements))

-(defmulti format-measurements (fn [request measurements] (:content-type request)))
-
-(defmethod format-measurements "application/json" [request measurements]
+(defmulti format-measurements (fn [ctx measurements] (-> ctx :representation :media-type)))
+
+(defmethod format-measurements "application/json" [ctx measurements]
   {:measurements (parse-measurements measurements)})

-(defmethod format-measurements "text/csv" [request measurements]
+(defmethod format-measurements "text/csv" [ctx measurements]
   (->> measurements
        parse-measurements
-       (util/render-items request)))
+       (util/render-items (:request ctx))))

 (defn measurements-slice-handle-ok [store store-new ctx]
   (let [request                (:request ctx)
@@ -107,7 +107,7 @@
         end-date               (util/to-db-format (string/replace (get decoded-params "endDate") "%20" " "))
         measurements           (retrieve-measurements querier start-date end-date device_id reading-type)]

-    (format-measurements request measurements)))
+    (format-measurements ctx measurements)))

 (defn- min-date [dt1 dt2]
   (let [dt1' (tc/to-date-time dt1)


Restructure junit xml tests

Restructure junit xml tests

--- test/buildviz/junit_xml_test.clj
+++ test/buildviz/junit_xml_test.clj
@@ -15,61 +15,71 @@

 (deftest Parsing
   (testing "parse-testsuites"
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :fail}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase name=\"a test\"><failure/></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :error}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase name=\"a test\"><error/></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :skipped}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase name=\"a test\"><skipped/></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase name=\"a test\"></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
+    (testing "status"
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :fail}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"><failure/></testcase></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :error}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"><error/></testcase></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :skipped}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"><skipped/></testcase></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :pass}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"></testcase></testsuite>"))))
+
+    (testing "testsuite nesting"
+      (is (= [{:name "a suite"
+               :children [{:name "a sub suite"
+                           :children [{:name "a test"
+                                       :classname "the class"
+                                       :status :pass}]}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testsuite name=\"a sub suite\"><testcase classname=\"the class\" name=\"a test\"></testcase></testsuite></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :pass}]}]
+             (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"></testcase></testsuite></testsuites>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "some class"
+                           :status :pass}]}
+              {:name "another suite"
+               :children [{:name "another test"
+                           :classname "the class"
+                           :status :pass}]}]
+             (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase classname=\"some class\" name=\"a test\"></testcase></testsuite><testsuite name=\"another suite\"><testcase classname=\"the class\" name=\"another test\"></testcase></testsuite></testsuites>"))))
+
+    (testing "optional runtime"
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :pass
+                           :runtime 1234}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\" time=\"1.234\"></testcase></testsuite>"))))
+
+    (testing "ignored nodes"
+      (is (= [{:name "a suite"
              :children [{:name "a test"
                          :classname "the class"
-                         :status :fail}]}]
-       (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"><failure/></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a sub suite"
-                         :children [{:name "a test"
-                                     :status :pass}]}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testsuite name=\"a sub suite\"><testcase name=\"a test\"></testcase></testsuite></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass}]}
-             {:name "another suite"
-              :children [{:name "another test"
-                          :status :pass}]}]
-           (junit-xml/parse-testsuites "<testsuites><testsuite name=\"a suite\"><testcase name=\"a test\"></testcase></testsuite><testsuite name=\"another suite\"><testcase name=\"another test\"></testcase></testsuite></testsuites>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
                          :status :pass}]}]
-           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase name=\"a test\"></testcase></testsuite>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass
-                         :runtime 1234}]}]
-           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase name=\"a test\" time=\"1.234\"></testcase></testsuite>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass
-                         :runtime 1234}]}]
-           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><properties></properties><testcase name=\"a test\" time=\"1.234\"></testcase></testsuite>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass
-                         :runtime 1234}]}]
-           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase name=\"a test\" time=\"1.234\"></testcase><system-out>some sys out</system-out></testsuite>")))
-    (is (= [{:name "a suite"
-             :children [{:name "a test"
-                         :status :pass
-                         :runtime 1234}]}]
-           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase name=\"a test\" time=\"1.234\"></testcase><system-err><![CDATA[]]></system-err></testsuite>")))
-    ))
+           (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><properties></properties><testcase classname=\"the class\" name=\"a test\"></testcase></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :pass}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"></testcase><system-out>some sys out</system-out></testsuite>")))
+      (is (= [{:name "a suite"
+               :children [{:name "a test"
+                           :classname "the class"
+                           :status :pass}]}]
+             (junit-xml/parse-testsuites "<testsuite name=\"a suite\"><testcase classname=\"the class\" name=\"a test\"></testcase><system-err><![CDATA[]]></system-err></testsuite>"))))))


add 'time' for altering insert

add 'time' for altering insert

--- sample/src/sample/btree.clj
+++ sample/src/sample/btree.clj
@@ -407,7 +407,8 @@
                      (b+tree 3)
                      kvs)
              time)
-      t2 (t/insert t1 [:b "y" 3] "____")]
+      t2 (-> (t/insert t1 [:b "y" 3] "____")
+             time)]
   #_(clojure.pprint/pprint t)
   [(t/lookup t1 [:b "y" 3])
    (t/lookup t2 [:b "y" 3])])


CMR-313: Added test for search by value and range for date time attributes.

--- test/cmr/system_int_test/search/granule_psa_search_test.clj
+++ test/cmr/system_int_test/search/granule_psa_search_test.clj
@@ -1,6 +1,8 @@
 (ns cmr.system-int-test.search.granule-psa-search-test
   "Tests searching for granules by product specific attributes."
   (:require [clojure.test :refer :all]
+            [clj-time.core :as t]
+            [clj-time.format :as f]
             [cmr.system-int-test.utils.ingest-util :as ingest]
             [cmr.system-int-test.utils.search-util :as search]
             [cmr.system-int-test.utils.index-util :as index]
@@ -37,7 +39,9 @@
        "int,alpha,a,0" (am/invalid-value-msg :int "a")
        "int,alpha,0,b" (am/invalid-value-msg :int "b"))

-    (is (= {:status 422 :errors [(am/attributes-must-be-sequence-msg)]}
+  ; TODO datetime searches
+
+  (is (= {:status 422 :errors [(am/attributes-must-be-sequence-msg)]}
          (search/get-search-failure-data
            (search/find-refs :granule {"attribute" "string,alpha,a"})))))

@@ -160,7 +164,70 @@
            ;; only max range provided
            "int,bravo,,12" [gran1 gran2]))))

-
-
-
-
+(defn make-datetime
+  "Creates a datetime from a number added onto a base datetime"
+  [n]
+  (when n
+    (f/unparse (f/formatters :date-time)
+               (t/plus (t/date-time 2012 1 1 0 0 0)
+                       (t/days n)
+                       (t/hours n)))))
+
+
+(deftest datetime-psas-search-test
+  (let [psa1 (dc/psa "alpha" :datetime)
+        psa2 (dc/psa "bravo" :datetime)
+        psa3 (dc/psa "charlie" :datetime)
+        coll1 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2]}))
+        gran1 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes
+                                                   [(dg/psa "alpha"
+                                                            [(make-datetime 10) (make-datetime 123)])
+                                                    (dg/psa "bravo"
+                                                            [(make-datetime 0)])]}))
+        gran2 (d/ingest "PROV1" (dg/granule coll1 {:product-specific-attributes
+                                                   [(dg/psa "bravo"
+                                                            [(make-datetime 10) (make-datetime 123)])]}))
+
+        coll2 (d/ingest "PROV1" (dc/collection {:product-specific-attributes [psa1 psa2 psa3]}))
+        gran3 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes
+                                                   [(dg/psa "alpha"
+                                                            [(make-datetime 14)])
+                                                    (dg/psa "bravo"
+                                                            [(make-datetime 13) (make-datetime 123)])]}))
+        gran4 (d/ingest "PROV1" (dg/granule coll2 {:product-specific-attributes
+                                                   [(dg/psa "charlie"
+                                                            [(make-datetime 14)])]}))]
+    (index/flush-elastic-index)
+
+    (testing "search by value"
+      (are [v n items]
+           (d/refs-match?
+             items (search/find-refs :granule {"attribute[]" (str v (make-datetime n))}))
+           "datetime,bravo," 123 [gran2, gran3]
+           "datetime,alpha," 11 []
+           "datetime,bravo," 0 [gran1]))
+
+    (testing "search by range"
+      (are [v min-n max-n items]
+           (let [min-v (make-datetime min-n)
+                 max-v (make-datetime max-n)
+                 full-value (str v min-v "," max-v)]
+             (d/refs-match? items (search/find-refs :granule {"attribute[]" full-value})))
+
+           ;; inside range
+           "datetime,alpha," 9 11 [gran1]
+           ;; beginning edge of range
+           "datetime,alpha," 10 11 [gran1]
+           ;; ending edge of range
+           "datetime,alpha," 9 10 [gran1]
+
+           ;; only min range provided
+           "datetime,bravo," 120 nil [gran2 gran3]
+
+           ;; only max range provided
+           "datetime,bravo," nil 12 [gran1 gran2]))))
+
+
+
+
+


(maint) Specify cipher suites when testing TLS 1.3

This commit ensures that the test http client uses the appropriate cipher suites
when testing TLSv1.3. Previously, this test would fail with
`javax.net.ssl.SSLHandshakeException: Received fatal alert: protocol_version` on
newer Java 8 versions.

--- test/unit/puppetlabs/puppetserver/ruby/http_client_test.clj
+++ test/unit/puppetlabs/puppetserver/ruby/http_client_test.clj
@@ -287,7 +287,7 @@
   (testing "Can connect via TLSv1.3 by default"
     (with-webserver-with-protocols ["TLSv1.3"] nil
       (with-scripting-container sc
-        (with-http-client sc {}
+        (with-http-client sc {:cipher-suites ["TLS_AES_256_GCM_SHA384" "TLS_AES_128_GCM_SHA256"]}
           (let [url (str "https://localhost:10080")]
             (.runScriptlet sc (format "$response = $c.get(URI('%s'))" url))
             (is (= 200 (.runScriptlet sc "$response.code")))


Use an atom instead of a Ref for *repls*

--- src/main/clojure/vimclojure/repl.clj
+++ src/main/clojure/vimclojure/repl.clj
@@ -30,13 +30,13 @@
   #^{:doc
   "A map holding the references to all running repls indexed by their repl id."}
   *repls*
-  (ref {}))
+  (atom {}))

-(let [id (ref 0)]
+(let [id (atom 0)]
   (defn repl-id
     "Get a new Repl id."
     []
-    (dosync (alter id inc))))
+    (swap! id inc)))

 (def
   #^{:doc
@@ -81,16 +81,15 @@
   ; Make sure user namespace exists.
   (let [id       (repl-id)
         the-repl (make-repl id nspace)]
-    (dosync (commute *repls* assoc id the-repl))
+    (swap! *repls* assoc id the-repl)
     id))

 (defn stop
   "Stop the Repl with the given id."
   [id]
-  (dosync
-    (when-not (@*repls* id)
-      (throw (Exception. "Not Repl of that id or Repl currently active: " id)))
-    (commute *repls* dissoc id)))
+  (when-not (@*repls* id)
+    (throw (Exception. "Not Repl of that id or Repl currently active: " id)))
+  (swap! *repls* dissoc id))

 (defn root-cause
   "Drill down to the real root cause of the given Exception."
@@ -111,13 +110,12 @@
   to use a one-shot context. Sets the file line accordingly."
   [id nspace file line thunk]
   (let [the-repl (if (not= id -1)
-                   (dosync
-                     (let [the-repls (deref *repls*)
-                           the-repl  (the-repls id)]
-                       (when-not the-repl
-                         (throw (Exception. (str "No Repl of that id: " id))))
-                       (alter *repls* dissoc id)
-                       the-repl))
+                   (locking *repls*
+                     (if-let [the-repl (get @*repls* id)]
+                       (do
+                         (swap! *repls* dissoc id)
+                         the-repl)
+                       (throw (Exception. (str "No Repl of that id: " id)))))
                    (make-repl -1))
         line     (if (= line 0)
                    (the-repl :line)
@@ -143,24 +141,23 @@
       (thunk)
       (finally
         (when (not= id -1)
-          (dosync
-            (commute *repls* assoc id
-                     (struct-map repl
-                                 :id                 id
-                                 :ns                 *ns*
-                                 :warn-on-reflection *warn-on-reflection*
-                                 :print-meta         *print-meta*
-                                 :print-length       *print-length*
-                                 :print-level        *print-level*
-                                 :compile-path       *compile-path*
-                                 :command-line-args  *command-line-args*
-                                 :expr1              *1
-                                 :expr2              *2
-                                 :expr3              *3
-                                 :exception          *e
-                                 :print-pretty       vimclojure.repl/*print-pretty*
-                                 :line               (dec (.getLineNumber *in*))))))
-        (Var/popThreadBindings)))))
+          (swap! *repls* assoc id
+                 (struct-map repl
+                             :id                 id
+                             :ns                 *ns*
+                             :warn-on-reflection *warn-on-reflection*
+                             :print-meta         *print-meta*
+                             :print-length       *print-length*
+                             :print-level        *print-level*
+                             :compile-path       *compile-path*
+                             :command-line-args  *command-line-args*
+                             :expr1              *1
+                             :expr2              *2
+                             :expr3              *3
+                             :exception          *e
+                             :print-pretty       vimclojure.repl/*print-pretty*
+                             :line               (dec (.getLineNumber *in*))))))
+        (Var/popThreadBindings))))

 (defmacro with-repl
   "Executes body in the context of the Repl with the given id. id may be -1


make main friendly

make main friendly

--- src/sbsk/core.clj
+++ src/sbsk/core.clj
@@ -109,11 +109,11 @@
      :content-type "application/json"
      :documents (io/input-stream tf))))

-(defn local
+(defn -main
   []
   (let [records (crawl)
         tf      (fs/temp-file "fbrecords")]
     (spit tf (generate-string records))
     (println (str tf))))

-;; aws cloudsearchdomain --profile sbsk-fb-crawler --endpoint-url "http://doc-fbvideos-7em3llq7mvfiuqoshymtrg3acu.us-east-1.cloudsearch.amazonaws.com" upload-documents --content-type application/json --documents /tmp/fbrecords1471985133411-1995262256
+;; aws cloudsearchdomain --profile sbsk-fb-crawler --endpoint-url "http://doc-fbvideos-7em3llq7mvfiuqoshymtrg3acu.us-east-1.cloudsearch.amazonaws.com" upload-documents --content-type application/json --documents $(lein run)


Used transient for speed up in creating enum to value map

--- src/mavlink/mavlink_xml.clj
+++ src/mavlink/mavlink_xml.clj
@@ -183,9 +183,9 @@
                                                  (loop [last-value -1
                                                         entry (first entries)
                                                         rest-entries (rest entries)
-                                                        values-map {}]
+                                                        values-map (transient {})]
                                                    (if (nil? entry)
-                                                     values-map
+                                                     (persistent! values-map)
                                                      (let [enum-name  (zip-xml/attr entry :name)
                                                            value (get-value (str "In " file-name " " enum-name " value")
                                                                             (zip-xml/attr entry :value))
@@ -193,9 +193,9 @@
                                                        (recur enum-value
                                                               (first rest-entries)
                                                               (rest rest-entries)
-                                                              (assoc values-map
-                                                                     (keywordize enum-name)
-                                                                     enum-value)))))))))
+                                                              (assoc! values-map
+                                                                      (keywordize enum-name)
+                                                                      enum-value)))))))))
        enums-by-group
         (apply merge (zip-xml/xml-> zipper :mavlink :enums :enum
                       (fn [e]


midi-controller-gui: added ability to specify play and stop keys on midi device

--- src/overtime/midi_controller_gui.clj
+++ src/overtime/midi_controller_gui.clj
@@ -7,9 +7,9 @@

 (defn- init-xs-hdlrs
-  [frame-key & {:keys [device instr-type instr sliders] :or {sliders []}}]
-  (mc/add-handler! device :play-left frame-key (fn [_x] (instr/play-sound-at (+ (ot/now) 500) instr-type instr)))
-  (mc/add-handler! device :cue-left frame-key (fn [_x] (instr/stop-sound-at (+ (ot/now) 500) instr-type instr)))
+  [frame-key & {:keys [instr-type instr device sliders play stop] :or {sliders []}}]
+  (mc/add-handler! device play frame-key (fn [_x] (instr/play-sound-at (+ (ot/now) 500) instr-type instr)))
+  (mc/add-handler! device stop frame-key (fn [_x] (instr/stop-sound-at (+ (ot/now) 500) instr-type instr)))
   (doseq [[slider-key {:keys [knob-key min max slider-f] :or {slider-f u/num-lin-lin}}] sliders]
     (mc/add-handler! device knob-key frame-key #(gui/change-slider-val frame-key slider-key (slider-f % 0 127 min max)))))


remove double db initialization; refactor loop over resources

--- cimi/src/com/sixsq/slipstream/ssclj/resources/common/dynamic_load.clj
+++ cimi/src/com/sixsq/slipstream/ssclj/resources/common/dynamic_load.clj
@@ -3,7 +3,6 @@
   (:require
     [clojure.tools.logging :as log]
     [com.sixsq.slipstream.db.impl :as db]
-    [com.sixsq.slipstream.ssclj.resources.common.debug-utils :as du]
     [com.sixsq.slipstream.ssclj.util.namespace-utils :as dyn]))

 (defn resource?
@@ -44,17 +43,6 @@
       (catch Exception e
         (log/error "initializing" (ns-name resource-ns) "failed:" (.getMessage e))))))

-(defn- initialize-db-for-resource
-  "Run a resource's initialization function on db if it exists."
-  [resource-ns]
-  (if-let [fvar (dyn/resolve "resource-url" resource-ns)]
-    (try
-      (let [index-name (deref fvar)]
-        (db/initialize index-name nil))
-      (log/info "initialized db for resource" (ns-name resource-ns))
-      (catch Exception e
-        (log/error "initializing" (ns-name resource-ns) "for db failed:" (.getMessage e))))))
-
 (defn resource-routes
   "Returns a lazy sequence of all of the routes for resources
    discovered on the classpath."
@@ -75,6 +63,5 @@
 (defn initialize
   "Runs the initialize function for all resources that define it."
   []
-  (doall
-    (map
-      (juxt initialize-db-for-resource initialize-resource) (resource-namespaces))))
+  (doseq [resource-namespace resource-namespaces]
+    (initialize-resource resource-namespace)))


use new deps-satisfied in rig booting

use new deps-satisfied in rig booting

--- src/overtone/studio/rig.clj
+++ src/overtone/studio/rig.clj
@@ -27,23 +27,21 @@
 (defonce mixer-id*     (ref nil))
 (defonce fx-group*     (ref nil))
 (defonce record-group* (ref nil))
-(defonce studio-status* (ref nil))
 (defonce MIXER-BUS 10)

 (on-event "/server-audio-clipping" (fn [msg]
                                      (println "TOO LOUD!! (audio clipped)"))
           ::server-audio-clipping-warner)

+(def RIG-BOOT-DEPS [:server-connected :studio-setup-completed])
+
 (defn rig-booted? []
-  (= :rig-booted @studio-status*))
-
-(on-deps [:connected :studio-setup-completed] ::fully-booted #(dosync (ref-set studio-status* :rig-booted)))
+  (deps-satisfied? RIG-BOOT-DEPS))

 (defn wait-until-rig-booted
   "Makes the current thread sleep until the rig completed its boot process."
   []
-  (while (not (rig-booted?))
-    (Thread/sleep 100)))
+  (wait-until-deps-satisfied RIG-BOOT-DEPS))

 (defn boot-rig
   "Boots the server and waits until the studio rig has complete set up"
@@ -152,7 +150,7 @@
                                       @instruments*)))
     (satisfy-deps :studio-setup-completed)))

-(on-deps :connected ::setup-studio setup-studio)
+(on-deps :server-connected ::setup-studio setup-studio)

 ;; Clear and re-create the instrument groups after a reset
 ;; TODO: re-create the instrument groups


reset text input after editing message

reset text input after editing message

Signed-off-by: Michele Balistreri <47483730395cccb6448ad7313d5cedb48de25e40@bitgamma.com>

--- src/status_im/chat/models/input.cljs
+++ src/status_im/chat/models/input.cljs
@@ -236,7 +236,7 @@
                       :js-response true
                       :on-error #(log/error "failed to edit message " %)
                       :on-success #(re-frame/dispatch [:sanitize-messages-and-process-response %])}]}
-   (clean-input (:current-chat-id db))
+   (cancel-message-edit)
    (process-cooldown)))

 (fx/defn send-current-message


Add options to dev-server

Add options to dev-server

--- src/tailrecursion/boot/task/ring.clj
+++ src/tailrecursion/boot/task/ring.clj
@@ -52,5 +52,10 @@
                (jetty/run-jetty {:port port :join? join?}))))))

 (core/deftask dev-server
-  []
-  (comp (head) (dev-mode) (session-cookie) (files) (jetty)))
+  [& {:keys [port join? key docroot]
+      :or {port    8000
+           join?   false
+           key     "a 16-byte secret"
+           docroot (core/get-env :out-path)}}]
+  (comp (head) (dev-mode) (session-cookie key) (files docroot)
+        (jetty :port port :join? join?)))


Add XAResource to request options description

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -296,6 +296,7 @@
   {:default-request-options (.getDefaultRequestOptions session)
    :effective-request-options (.getEffectiveRequestOptions session)
    :logger (.getLogger session)
+   :xaresource (.getXAResource session)
    :user-object (.getUserObject session)
    :transaction-timeout (.getTransactionTimeout session)
    :transaction-mode ((clojure.set/map-invert transaction-modes)


Story ID: develop added remote load helper for mutation loading

--- src/untangled/client/data_fetch.cljs
+++ src/untangled/client/data_fetch.cljs
@@ -55,9 +55,9 @@
   but usable from within a mutation.

   To use this function make sure your mutation specifies a return value with a remote. The remote
-  should include the abstract mutation `(app/load)` as well as any desired `(tx/fallback)`:
+  should use the helper function `remote-load` as it's value:

-  { :remote (om/query->ast '[(app/load)])
+  { :remote (df/remote-load env)
     :action (fn []
        (load-field-action ...)
        ; other optimistic updates/state changes)}"
@@ -72,13 +72,13 @@
     :post-mutation post-mutation))

 (defn load-data-action
-  "Queue up a remote load from within an already-running mutation. Similar to `load-collection`, but usable from
+  "Queue up a remote load from within an already-running mutation. Similar to `load-data`, but usable from
   within a mutation.

   To use this function make sure your mutation specifies a return value with a remote. The remote
-  should include the abstract mutation `(app/load)` as well as any desired `(tx/fallback)`:
+  should use the helper function `remote-load` as it's value:

-  { :remote (om/query->ast '[(app/load)])
+  { :remote (df/remote-load env)
     :action (fn []
        (load-data-action ...)
        ; other optimistic updates/state changes)}"
@@ -90,6 +90,15 @@
     :params params
     :without without
     :post-mutation post-mutation))
+
+(defn remote-load
+  "Returns the correct value for the `:remote` side of a mutation that should act as a
+  trigger for remote loads. Must be used in conjunction with running `load-data-action` or
+  `load-data-field` in the `:action` side of the mutation (which queues the exact things to
+  load)."
+  [parsing-env]
+  (let [ast (:ast parsing-env)]
+    (assoc ast :key 'app/load :dispatch-key 'app/load)))

 ;; Predicate functions
 (defn data-state? [state] (impl/data-state? state))


fixed wallet screens

fixed wallet screens

--- src/status_im/ui/screens/views.cljs
+++ src/status_im/ui/screens/views.cljs
@@ -40,7 +40,9 @@
             [status-im.profile.screen :refer [profile my-profile]]
             [status-im.profile.edit.screen :refer [edit-my-profile]]
             [status-im.profile.photo-capture.screen :refer [profile-photo-capture]]
-            [status-im.profile.qr-code.screen :refer [qr-code-view]]))
+            [status-im.profile.qr-code.screen :refer [qr-code-view]]
+            [status-im.ui.screens.wallet.send.views :refer [send-transaction]]))
+-           ;;[status-im.ui.screens.wallet.receive.views :refer [receive-transaction]]

 (defn validate-current-view
   [current-view signed-up?]
@@ -57,6 +59,8 @@
       (let [current-view (validate-current-view view-id signed-up?)]
         (let [component (case current-view
                           :wallet main-tabs
+                          :wallet-send-transaction send-transaction
+                          ;;:wallet-receive-transaction receive-transaction
                           :discover main-tabs
                           :discover-search-results discover-search-results
                           :chat-list main-tabs


remove unecessary line

remove unecessary line

--- src/cake/main.clj
+++ src/cake/main.clj
@@ -32,7 +32,6 @@
        (:use cake.core))
      (doseq [file project-files :when (.exists file)]
        (load-file (.getPath file)))
-     (when-not *project* (require '[cake.tasks help new]))
      (init-multi-out ".cake/cake.log")
      (server/create port process-command
        :reload (reloader classpath project-files (File. "lib/dev")))


wow, does basic http

wow, does basic http

--- src/caws/core.clj
+++ src/caws/core.clj
@@ -5,7 +5,8 @@
            (java.nio.charset Charset)
            (java.net InetSocketAddress)
            (java.io IOException))
-  (:require [clojure.core.async :as async :refer [go go-loop >! <! <!! >!! chan]]))
+  (:require [clojure.core.async :as async :refer [go go-loop >! <! <!! >!! chan]]
+            [clojure.string :as string :refer [join split]]))

 ;; concept...
 ;; every view gets an in-port and an out-port
@@ -54,13 +55,18 @@
       (.configureBlocking false)
       (.register selector SelectionKey/OP_READ))))

+
+(defn header-string-to-keyword [header-string]
+  (keyword (.trim (.toLowerCase header-string))))
+
 (defn parse-header [header]
-  (let [bits (seq (.split header "\\s+"))]
-    [(first bits) (second bits)])) ;; TODO: I want to use symbols for the header names...
+  (let [bits (seq (.split header "\\s*:\\s*"))]
+    [(header-string-to-keyword (first bits)) (second bits)])) ;; TODO: I want to use symbols for the header names...

 (defn parse-headers [header-lines]
+  "Returns a map of keyword -> string value"
   (if header-lines
-    (apply array-map (map parse-header header-lines))
+    (apply array-map (apply concat (map parse-header header-lines)))
     {}))

 (defn parse-request [request-string]
@@ -69,21 +75,24 @@
         head-lines (seq (.split (first parts) "\r?\n"))
         request-line (first head-lines)
         header-lines (rest head-lines)
-        body (if (> (count parts) 1) (.join "\n" (rest parts)) nil)]
+        body (if (> (count parts) 1) (join "\n" (rest parts)) nil)]
     (let [_ (seq (.split request-line "\\s+"))
           command (.trim (first _))
           path (.trim (second _))]
       [command path (parse-headers header-lines) body])))

 (defn is-full-request? [content]
-  (or (.endsWith content "\n\n") (.endsWith content "\r\n\r\n")))
-
-(defn route [command path in-port out-port]
-  (println "routing" command path)
-  )
-
-(defn route-request [request-string socket-channel]
+  (re-find #"\r?\n\r?\n" content))
+
+(defn write-headers [headers socket-channel]
+  (doseq [pair (seq headers)]
+    (let [k (first pair) v (second pair)]
+      (.write socket-channel
+              (string->buffer (str (.substring (str k) 1) ":" v "\n"))))))
+
+(defn route-request [request-string socket-channel route]
   (apply
+
    (fn [command path headers body]
      (println command path headers body)
      (let [in-chan (chan 10) out-chan (chan)] ;; hm... should out-chan be unbuffered?
@@ -95,12 +104,30 @@
          (>!! in-chan :content)
          (>!! in-chan body))

-       (route command path in-chan out-chan)
-       )
-     )
+       (route (keyword (.toLowerCase command)) path in-chan out-chan)
+       (go-loop [token (<! out-chan)]
+                (println "TOKEN" token)
+                (cond
+                 (instance? Long token)
+                 (do (.write socket-channel (string->buffer (str "HTTP " token "\n")))
+                     (recur (<! out-chan)))
+
+                 (= :headers token)
+                 (do (write-headers (<! out-chan) socket-channel)
+                     (recur (<! out-chan)))
+
+                 (= :body token)
+                 (do (.write socket-channel (string->buffer "\n\n"))
+                     (loop [part (<! out-chan)]
+                       (if (= :end part)
+                         (.close (.socket socket-channel))
+                         (do (.write socket-channel (string->buffer part))
+                             (recur (<! out-chan)))
+                         )))))))
+
    (parse-request request-string)))

-(defn read-socket [selected-key]
+(defn read-socket [selected-key rout]
   (let [socket-channel (.channel selected-key)]
     (.clear *buffer*)
     (.read socket-channel *buffer*)
@@ -114,10 +141,10 @@
         (let [existing-content (.attachment selected-key)]
           (.attach selected-key (str existing-content (buffer->string *buffer*))))
         (if (is-full-request? (.attachment selected-key))
-          (route-request (.attachment selected-key) socket-channel)))
+          (route-request (.attachment selected-key) socket-channel rout)))
       )))

-(defn react [selector server-socket]
+(defn react [selector server-socket rout]
   (while true
     (when (> (.select selector) 0)
       (let [selected-keys (.selectedKeys selector)]
@@ -126,13 +153,13 @@
             SelectionKey/OP_ACCEPT
             (accept-connection server-socket selector)
             SelectionKey/OP_READ
-            (read-socket k)))
+            (read-socket k rout)))
         (.clear selected-keys)))))

 (defn run [router & {:keys [ip port]
                      :or {ip "0.0.0.0" port 8080}}]
-  (apply react (setup port)))
+  (apply react (conj (setup port) router)))

 ;; what I want to do:
@@ -149,20 +176,49 @@
 ;; if/when I get more content, I dump that onto in-chan as well,
 ;; and I dump a :closed token onto in-chan when I get there.
 ;;
-;;
-
-(defn routes [mappings]
-
-  ;; (loop [prefixes (keys mappings)]
-  ;;   (let [prefix (first prefixes)]
-  ;;     (if (.startsWith path prefix)
-  ;;       (let [next (mappings prefix)]
-  ;;         (if (instance? java.util.Map next)
-  ;;           (invoke-view (.substring path (count prefix)) next)
-  ;;           (next))))))
-  )
-
-(defn bing [in-port out-port]
-  )
-
-(run (routes {"/foo" {"/bing" bing}}))
+;;
+
+(defn route [mappings]
+  "TODO: add regex support, too, cuz we should."
+  (let [route** (fn route* [mappings full-path path in-chan out-chan]
+                  (loop [prefixes (keys mappings)]
+                    (let [prefix (first prefixes)]
+                      (println "prefix = " prefix)
+                      (println "path is " path)
+                      (if (.startsWith path prefix)
+                        (let [next (mappings prefix)]
+                          (if (instance? java.util.Map next)
+                            (route* next full-path (.substring path (count prefix)) in-chan out-chan)
+                            (do
+                              (println "invoking" next)
+                              (next path in-chan out-chan))
+                            ))
+                        (recur (rest prefixes))
+                        )
+                      )))]
+    (fn [command path in-chan out-chan]
+      (println "command = " command)
+      (route** (mappings command) path path in-chan out-chan))))
+
+(defn home [path in-port out-port]
+  (println "HOME")
+  (go (>! out-port 200)
+      (>! out-port :headers)
+      (>! out-port {:content-type "text"})
+      (>! out-port :body)
+      (>! out-port (str path " INDEX\n"))
+      (>! out-port :end)))
+
+(defn bing [path in-port out-port]
+  (println "BING")
+  (go (>! out-port 200)
+      (>! out-port :headers)
+      (>! out-port {:content-type "text"})
+      (>! out-port :body)
+      (>! out-port (str path " BING\n"))
+      (>! out-port :end)))
+
+
+(run (route {:get
+             {"/foo" {"/bing" bing}
+              "/" home}}))


refactor

refactor

--- examples/lesson-carousel-starter-kit/src/carousel/core.cljs
+++ examples/lesson-carousel-starter-kit/src/carousel/core.cljs
@@ -102,7 +102,9 @@
                                           :zIndex        "2"
                                           :content       ">"}]]}]

-    [:node {:id "pager"}
+    [:node {:id "pager"
+            :align [0.5 0.5 0]
+            :mount-point [0.5 0.5 0]}
      (let [url-base "http://demo.famo.us.s3.amazonaws.com/hub/apps/carousel/Museo_del_Prado_-_Goya_-_Caprichos_-_No._"
            image-names ["01_-_Autorretrato._Francisco_Goya_y_Lucientes2C_pintor_thumb.jpg"
                         "02_-_El_si_pronuncian_y_la_mano_alargan_al_primero_que_llega_thumb.jpg"
@@ -187,14 +189,22 @@
         _ (.. context (addChild root-node))
         children (.. root-node getChildren)

-        back-node (first children)
+        back-node (nth children 0)
         back-clicks (events->chan back-node "tap")

-        next-node (second children)
+        next-node (nth children 1)
         next-clicks (events->chan next-node "tap")

-        pages (.. children (slice 2 (count children)))
-
+        pager-node (nth children 2)
+        node-to-box (into {}  (for [page-node (.. pager-node getChildren)
+                                    :let [box (FamousBox. (clj->js {:mass 100 :size [100 100 100]}))
+                                          anchor (Vec3. 1 0 0)
+                                          spring (Spring. nil box (clj->js {:period 0.5 :dampingRatio 0.5 :anchor anchor}))
+                                          quaternion (.. (Quaternion.) (fromEuler 0 (/ (.. js/Math -PI) -2) 0))
+                                          rotational-spring (RotationalSpring. nil box (clj->js {:period 1 :dampingRatio 0.2 :anchor quaternion}))
+                                          _ (.. simulation (add box spring rotational-spring))]]
+                                [page-node box]))
+
         dot-container-node (last children)
         dot-nodes (.. dot-container-node getChildren)
         resize (clj->js {:onSizeChange (fn [^Float32Array size]
@@ -214,18 +224,16 @@
                                                                              (+ dotWidth spacing)))
                                                                        0
                                                                        0)))))})
-        current-index (atom 0)]
-    (.. dot-container-node (addComponent resize))
-
-
-
-                                        ;(add-watch current-index :watcher (fn [key atom old-index new-index]
-                                        ;                                      (let [old-page (nth pages old-index)
-                                        ;                                            new-page (nth pages new-index)]
-                                        ;                                           (.. (:anchor old-page) (set 1 0 0))
-                                        ;                                           (.. (:quaternion old-page) (fromEuler 0 (/ (.. js/Math -PI) -2) 0))
-                                        ;                                           (.. (:anchor new-page) (set 0 0 0))
-                                        ;                                           (.. (:quaternion new-page) (set 1 0 0 0)))))
+        _ (.. dot-container-node (addComponent resize))
+        current-index (atom 1)]
+
+    ;; (add-watch current-index :watcher (fn [key atom old-index new-index]
+    ;;                                     (let [old-page (nth pages old-index)
+    ;;                                           new-page (nth pages new-index)]
+    ;;                                       (.. (:anchor old-page) (set 1 0 0))
+    ;;                                       (.. (:quaternion old-page) (fromEuler 0 (/ (.. js/Math -PI) -2) 0))
+    ;;                                       (.. (:anchor new-page) (set 0 0 0))
+    ;;                                       (.. (:quaternion new-page) (set 1 0 0 0)))))

     (go
       (while true
@@ -239,7 +247,8 @@
                                       (println "next" @current-index)
                                       (swap! current-index inc)
                                       )))))
-
+
+
     ;; (.. FamousEngine (requestUpdate (clj->js {:onUpdate (fn [time]
     ;;                                                       (.. simulation (update time))
     ;;                                                       (doseq [page pages


refactor to be more idiomatic in clojure

--- examples/lesson-carousel-starter-kit/src/carousel/core.cljs
+++ examples/lesson-carousel-starter-kit/src/carousel/core.cljs
@@ -25,53 +25,28 @@
      :el        el
      :direction direction}))

-(defn Dot [node]
-  (let [el (.. (DOMElement. node)
-               (setProperty "borderRadius" "5px")
-               (setProperty "border" "2px solid white")
-               (setProperty "boxSizing" "border-box"))]
-    {:node node
-     :el el
-     :select (fn []
-               (.. el (setProperty "backgroundColor" "white")))
-     :deslect (fn []
-                (.. el (setProperty "backgroundColor" "transparent")))}))
-
-(defn Dots [node options]
-  (let [numPages (:numPages options)
-        dotWidth (or (:dotWidth options) 10)
-        dots (for [i (range numPages)
-                   :let [dotNode (.. node addChild)]]
-               (do
-                 (.. dotNode (setSizeMode 1 1))
-                 (.. dotNode (setAbsoluteSize dotWidth dotWidth))
-                 (Dot dotNode)
-                 ))
-        resizeComponent {:onSizeChange (fn [size]
-                                         )}]
-    (.. (first dots) select)
-    (.. node (addComponent resizeComponent))
-
-    {:node node
-     :dots dots
-     :dotWidth dotWidth
-     :spacing  (or (:spacing options) 5)
-     :numPages numPages
-     :layoutDots (fn [size]
-                   )
-     })
-  )
-

 (defn Carousel [selector data]
   (let [context (.. FamousEngine (createScene selector))
         root (.. context addChild)
-        arrows {:back (Arrow. (.. root addChild) {:direction -1})
-                :next (Arrow. (.. root addChild) {:direction 1})}
+        back (Arrow. (.. root addChild) {:direction -1})
+        next (Arrow. (.. root addChild) {:direction 1})
         carousel-obj {:context  context
                       :root     root
-                      :arrows arrows}]
-
+                      :back back
+                      :next next}]
+    (.. (:node back)
+        (setSizeMode 1 1)
+        (setAbsoluteSize 40 40)
+        (setPosition 40 0 0)
+        (setAlign 0 0.5 0)
+        (setMountPoint 0 0.5 0))
+    (.. (:node next)
+        (setSizeMode 1 1)
+        (setAbsoluteSize 40 40)
+        (setPosition -40 0 0)
+        (setAlign 1 0.5 0)
+        (setMountPoint 1 0.5 0))
     carousel-obj))

 (Carousel "body" {})


Fix access control from genome-cancer, cancer-beta, etc.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -41,13 +41,18 @@
 ;
 ; web services

-; XXX change Access-Control-Allow-Origin in production.
+(def trusted-hosts
+  #"https://[-_A-Za-z0-9]+.kilokluster.ucsc.edu|https://genome-cancer.ucsc.edu")
+
 (defn- wrap-access-control [handler]
   (fn [request]
     (let [response (handler request)]
-      (-> response
-          (assoc-in [:headers "Access-Control-Allow-Origin"] "https://tcga1.kilokluster.ucsc.edu")
-          (assoc-in [:headers "Access-Control-Allow-Headers"] "Cancer-Browser-Api")))))
+      (info "request" request)
+      (if-let [origin (re-matches trusted-hosts (get-in request [:headers "origin"] ""))]
+        (-> response
+            (assoc-in [:headers "Access-Control-Allow-Origin"] origin)
+            (assoc-in [:headers "Access-Control-Allow-Headers"] "Cancer-Browser-Api"))
+        response))))

 (defn- attr-middleware [app k v]
   (fn [req]