Improvements to flat; hierarchy still buggy in some cases, apparently suboptimal, slow.

--- src/exp/asplan.clj
+++ src/exp/asplan.clj
@@ -126,28 +126,15 @@
           :when (and (= s cur-val) (not (contains? (backward-sets t) s)))]
       t)))

-; TODO: take reduced arcs into account, etc.
-; Problem: this breaks state abstraction for hierarchy.
-; It will need to do detection at a higher level, i.e., notice deadlock
-
-; To notice deadlock, don't select var in parent chain of another.
-; More generally, don't select var s.t. resolving leads to cycle.
-;  Specifically, assigning to action which will be deadlocked on this precond.
-;  Recipe: keep parent links, add links from a--> b where a has lock on precond needed by b.
-;  If there is a cycle in this graph, we are deadlocked.
-
-(comment
-  (defn possible-activation-actions
-   "Return a list of possible activation actions for var v possible in state s.
-   To be possible parent, must be supported from below, and not cause deadlock
-   (by pointing to action whose other precondition is needing it. "
-   [s child-map v]
-   (for [c (child-map v)]
-     (make-set-parent-var-action v c))))
-
-;; TODO: do not count parent edges where action does not actually require precondition (top-down)
-(defn deadlocked? [s child-map]
-  (let [parent-edges (for [[p cs] child-map, c cs :when (env/get-var s (parent-var p c))] [p c])
+
+(defn activation-actions  "Return a list of all activation actions for var v"
+  [child-map v]
+  (for [c (child-map v)]
+    (make-set-parent-var-action v c)))
+
+(defn deadlocked? [s child-map extra-edges]
+  (let [parent-edges (concat extra-edges
+                       (for [[p cs] child-map, c cs :when (env/get-var s (parent-var p c))] [p c]))
         res-map      (into {} (filter (fn [[p c]]
                                         (when-let [a (env/get-var s (action-var c))]
                                           (contains? (:precond-map a) p)))
@@ -161,10 +148,40 @@
                        [res p])]
     (not (graphs/dag? (concat parent-edges extra-edges)))))

-(defn activation-actions  "Return a list of all activation actions for var v"
-  [child-map v]
-  (for [c (child-map v)]
-    (make-set-parent-var-action v c)))
+(defn var-not-usable? [s ancestor-map target-var a-var]
+  (if-let [a  (env/get-var s (action-var a-var))]
+      (let [pm (:precond-map a)]
+        (every?
+         (fn [pv] (or (= (env/get-var s pv) (pm pv)) (var-not-usable? s ancestor-map target-var pv)))
+         (remove #{a-var} (keys pm))))
+    (not (contains? (ancestor-map a-var) target-var))))
+
+;; TODO: dynamic bottom-up pruning.
+ ; i.e., exists precondition of some current action, NOT currently achieved,
+ ; that has every child of a parent-link in its ancestor-set.
+; Or, more simply, variables should "die off".
+;; TODO: generalize.  This is just special case for most logistics,
+(defn dead-end? [s ancestor-map child-map extra-edges]
+  (let [gpm      (:precond-map (env/get-var s (action-var sas/goal-var-name)))
+        live-set (apply clojure.set/union #{sas/goal-var-name}
+                        (for [pv (remove #{sas/goal-var-name} (keys gpm))
+                              :when (not (= (env/get-var s pv) (gpm pv)))]
+                          (ancestor-map pv)))]
+    (some #(not (live-set (second %)))
+          (concat extra-edges
+            (for [[p cs] child-map, c cs :when (env/get-var s (parent-var p c))] [p c])))))
+
+(defn possible-activation-actions
+   "Return a list of possible activation actions for var v possible in state s.
+   To be possible parent, must be supported from below, and not cause deadlock
+   (by pointing to action whose other precondition is needing it. "
+   [s ancestor-map child-map v]
+;   (activation-actions child-map v) #_
+
+ (for [c (child-map v) :when (not (or (deadlocked? s child-map [[v c]])
+                                      (dead-end? s ancestor-map child-map [[ v c]])))]
+   (make-set-parent-var-action v c)))
+

 (defn current-child [s child-var-map p-var]
   (when-not (env/get-var s (free-var p-var))
@@ -186,7 +203,7 @@

 (deftype ASPlanEnv [init actions-fn g-map
                     ; Following stuff is used by hierarchy.
-                    causal-graph dtgs child-var-map acyclic-succ-fn]
+                    causal-graph dtgs ancestor-var-map child-var-map acyclic-succ-fn]
   env/Env
     (initial-state [] init)
     (actions-fn    [] actions-fn)
@@ -197,8 +214,11 @@
 (defn make-asplan-env [sas-problem]
   (def *add-count* (util/sref 0))
   (let [causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
+        vars          (graphs/ancestor-set causal-graph [sas/goal-var-name])
+        causal-graph  (filter (fn [[v1 v2]] (and (vars v1) (vars v2))) causal-graph)
+        av-map        (into {} (for [v vars] [v (graphs/ancestor-set causal-graph [v])]))
         child-var-map (util/map-vals #(map second %) (util/group-by first causal-graph))
-        vars          (keys (:vars sas-problem))
+;        vars          (keys (:vars sas-problem))
         dtgs          (sas-analysis/domain-transition-graphs sas-problem)
         simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
         acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
@@ -207,8 +227,9 @@
     (ASPlanEnv
      (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
      (fn asplan-actions [s]
-      (if false ;(deadlocked? s child-var-map)
-        (do (println s) nil)
+;      (if false ;(deadlocked? s child-var-map)
+;        (do (println s) nil)
+      (when-not (dead-end? s av-map child-var-map []);)
        (let [[aa-vars na-vars] (util/separate #(env/get-var s (action-var %)) vars)
              aa-parent-edges   (for [av aa-vars
                                       :let [pm (:precond-map (env/get-var s (action-var av)))]
@@ -239,18 +260,22 @@

           ;; Inactive bottom-up var -- needs to be assigned.
           (util/find-first #(env/get-var s (free-var %)) (map first aa-parent-edges))
-            (activation-actions child-var-map x)
+            (possible-activation-actions s av-map child-var-map x)

           ;; Active top-down var -- add actions
           (util/find-first #(not (env/get-var s (free-var %))) (map second na-tuples))
-            (for [as (vals (util/safe-get-in dtgs [x (env/get-var s x)])), a as]
-              (make-add-action-action a))
+            (do (println "A!" x (env/get-var s x) (env/get-var s (parent-var x sas/goal-var-name)))
+             (for [as (vals (util/safe-get-in dtgs [x (env/get-var s x)])), a as]
+               (make-add-action-action a)))

           ;; Inactive top-down var -- activate it
-          (first (map second na-tuples))
-            (activation-actions child-var-map x)))))
+          (util/find-first #(env/get-var s (free-var %)) (map second na-tuples))
+            (do (println "I!")
+             (possible-activation-actions s av-map child-var-map x))
+
+            ))) )
      (env/goal-map sas-problem)
-     causal-graph dtgs child-var-map acyclic-succ-fn)))
+     causal-graph dtgs av-map child-var-map acyclic-succ-fn)))

 (defn asplan-solution-name [sol]
   (map second (filter #(= (first %) ::GreedyFire) sol)))
@@ -355,19 +380,30 @@

 ;; For now, just do simplest thing, PostFireAttempt and PostAchieveAttempt

-(defn make-if-deadlock-hla [hierarchy var dl-plan nodl-plan]
-  (let [name [:if-deadlock var (map env/action-name dl-plan) (map env/action-name nodl-plan)]
-        av   (action-var var)
-        pc   (util/safe-get-in hierarchy [:precondition-context-map var])]
-    (reify :as this
-      env/Action
-       (action-name [] name)
-       (primitive?  [] false)
-      env/ContextualAction
-       (precondition-context [s] pc)
-      hierarchy/HighLevelAction
-       (immediate-refinements- [s] (if (env/get-var s av) [dl-plan] [nodl-plan]))
-       (cycle-level-           [s] nil))))
+;; TODO: think about adaptive contexts.
+
+;; TODO: speed up somehow?
+
+(declare precond-deadlocked?)
+(defn action-deadlocked? [s var]
+  (when-let [a (env/get-var s (action-var var))]
+    (some #(precond-deadlocked? s % var) (remove #{var} (keys (:precond-map a))))))
+
+(defn precond-deadlocked? [s precond e-var]
+  (or (and (not (env/get-var s (free-var precond)))
+           (not (env/get-var s (parent-var precond e-var))))
+      (action-deadlocked? s precond)))
+
+(defn precond-deadlocked-ooc? [s precond e-var child-var-map context]
+  (or (and (not (env/get-var s (free-var precond)))
+           (not (env/get-var s (parent-var precond e-var)))
+           (not (contains? context (current-child s child-var-map precond))))
+      (when-let [a (env/get-var s (action-var precond))]
+        (some #(precond-deadlocked-ooc? s % precond child-var-map context)
+              (remove #{precond} (keys (:precond-map a)))))))
+
+
+

 (declare make-fire-action-hla)

@@ -384,35 +420,33 @@
       hierarchy/HighLevelAction
        (immediate-refinements- [s]
          (cond (= (env/get-var s var) dst-val)
-                 (do (assert (not (env/get-var s av))) [[]])
+                 (do ;(print "!S") (flush)
+                     (assert (not (env/get-var s av))) [[]])
                (env/get-var s av)
-                 [[(make-fire-action-hla hierarchy var (env/get-var s av))
-                   (make-if-deadlock-hla hierarchy var [] [this])]]
+                 (if (action-deadlocked? s var)
+                     (do ;(print "!D")
+                       [[]])
+                   (do ;(print "!A")
+                       [[(make-fire-action-hla hierarchy var (env/get-var s av)) this]]))
                :else
                  (let [p-val (env/get-var s var)
                        dtg   (util/safe-get-in hierarchy [:dtgs var p-val])]
+                   ;(print "!C")
                    (for [n-val ((:acyclic-succ-fn hierarchy) var p-val dst-val), a (dtg n-val)]
                      [(make-add-action-action a) this]))))
        (cycle-level-           [s] nil))))

-; Problem: even when an action comes back DL, it may have resolved DLs elsewhere...
-; So, either we:
- ; Do real deadlock detection (just walk causal chains?),
- ; Record deadlock causes,
- ; Don't try to detect deadlock, just infinitely cycle through preconds & let search take care of it?
-; Seems real deadlock detection is best.
-
-;; TODO: speed up somehow?
-(defn precond-deadlocked? [s precond e-var]
-  (or (and (not (env/get-var s (free-var precond)))
-           (not (env/get-var s (parent-var precond e-var))))
-      (when-let [a (env/get-var s (action-var precond))]
-        (some #(precond-deadlocked? s % precond) (remove #{precond} (keys (:precond-map a)))))))
+
+
+;; TODO: A/I support is incorrect for now, it seems.
+; OK, this is screwy for now, it seems.
+; We need to be able to transfer control to floating actions?

 (defn make-fire-action-hla  [hierarchy effect-var a]
   (let [name          [:fire-action effect-var]
         reduced-pm    (dissoc (:precond-map a) effect-var)
+        ancestor-vars (util/safe-get-in hierarchy [:ancestor-var-map effect-var])
         child-var-map (:child-var-map hierarchy)
         pc            (into #{(action-var effect-var)}
                         (apply concat
@@ -429,8 +463,9 @@
       (precondition-context [s] pc) ;; perhaps can do better?
     hierarchy/HighLevelAction
       (immediate-refinements- [s]
+;        (Thread/sleep 10)
         (assert (= (env/get-var s (action-var effect-var)) a))
-        (let [na-tuples         (for [nav (util/safe-get-in hierarchy [:ancestor-var-map effect-var])
+        (let [na-tuples         (for [nav   ancestor-vars
                                       :when (not #(env/get-var s (action-var %)))
                                       :let  [child (current-child s child-var-map nav)]
                                       :when (and child (not (env/get-var s (action-var child))))]
@@ -438,43 +473,65 @@
          (util/cond-let [x]
           ;; Greedy -- all preconditions satisfied and not assigned elsewhere
           (make-greedy-fire-action s effect-var)
-            [[x]]
+            (do ;(print "g") (flush)
+              [[x]])
+
+          ;; Real deadlock - fail
+          (deadlocked? s child-var-map [])
+            (do ;(print "d") (flush)
+                nil)
+
+          ;; Deadlocked by something out-of-context -- exit  (note -- need to check for goal means
+            ; we should catch these issues earlier..
+          (some #(precond-deadlocked-ooc? s % effect-var child-var-map ancestor-vars) (keys reduced-pm))
+            (do ;(print "x") (flush)
+                (when-not (= effect-var sas/goal-var-name) [[]]))

           ;; Active precondition -- assigned, needs its value changed, not deadlock
+          ;; TODO: order
           (util/find-first #(and (env/get-var s (parent-var % effect-var))
                                  (not (= (env/get-var s %) (reduced-pm %)))
                                  (not (precond-deadlocked? s % effect-var)))
                            (keys reduced-pm))
-            [[(make-achieve-precondition-hla hierarchy x (reduced-pm x)) this]]
+            (do ;(print "a" (if (env/get-var s (action-var x)) "o" "n")) (flush)
+             [[(make-achieve-precondition-hla hierarchy x (reduced-pm x)) this]])

           ;; Inactive precondition -- needs to be assigned.
-          (util/find-first #(env/get-var s (free-var %)) (keys reduced-pm))
-            (for [a (activation-actions child-var-map x)]
-              [a this])
+          (util/find-first #(and (env/get-var s (free-var %))
+                                 (not (= (env/get-var s %) (reduced-pm %))))
+                           (keys reduced-pm))
+            (do ;(print "i") (flush)
+             (for [a (activation-actions child-var-map x)]
+               [a this]))

           ;; Active top-down var -- add actions
           (util/find-first #(not (env/get-var s (free-var %))) (map second na-tuples))
-            (for [as (vals (util/safe-get-in (:dtgs hierarchy) [x (env/get-var s x)])), a as]
-              [(make-add-action-action a) this])
+            (do (println "A!");(print "a") (flush)
+             (for [as (vals (util/safe-get-in (:dtgs hierarchy) [x (env/get-var s x)])), a as]
+               [(make-add-action-action a) this]))

           ;; Inactive top-down var -- activate it
           (first (map second na-tuples))
-            (for [a (activation-actions child-var-map x)]
-              [a this])
+            (do (println "I!"); (flush)
+             (for [a (activation-actions child-var-map x)]
+               [a this]))

           ;; Nothing to do here -- return upwards, or fail if goal-var
           :else
-            (when-not (= effect-var sas/goal-var-name) [[]]))))
+            (do ;(print "f") (flush)
+              (when (and (= effect-var sas/goal-var-name) (not (deadlocked? s child-var-map  nil)))
+                (def *bs* s))
+              (when-not (= effect-var sas/goal-var-name) [[]])))))
        (cycle-level-           [s] nil))))

-
+;(def *bs* nil)

  ; include ancestor vars, action vars, free vars, in-pointing 'rents
 (defn make-asplan-skip-henv [sas-problem]
   (let [env    (make-asplan-env sas-problem)
         cg     (:causal-graph env)
         cvm    (:child-var-map env)
-        av-map (into {} (for [v (keys (:vars sas-problem))] [v (graphs/ancestor-set cg [v])]))
+        av-map (:ancestor-var-map env)
         pc-map (into {}
                  (for [[k as] av-map]
                    [k
@@ -520,6 +577,23 @@

+
+
+
+(comment
+ (defn make-if-deadlock-hla [hierarchy var dl-plan nodl-plan]
+   (let [name [:if-deadlock var (map env/action-name dl-plan) (map env/action-name nodl-plan)]
+         av   (action-var var)
+         pc   (util/safe-get-in hierarchy [:precondition-context-map var])]
+     (reify :as this
+            env/Action
+            (action-name [] name)
+            (primitive?  [] false)
+            env/ContextualAction
+            (precondition-context [s] pc)
+            hierarchy/HighLevelAction
+            (immediate-refinements- [s] (if (env/get-var s av) [dl-plan] [nodl-plan]))
+            (cycle-level-           [s] nil)))))


cyanite: make system map and dependencies a bit more explicit

--- src/io/cyanite.clj
+++ src/io/cyanite.clj
@@ -58,24 +58,21 @@
       (println "starting with configuration: " path))
     (let [config (config/load-path path)]
       (start-logging! (merge config/default-logging (:logging config)))
-      (-> config
-          (dissoc :logging)
+      (-> (component/system-map
+           :input  (input/build-input (:input config))
+           :clock  (map->SystemClock {})
+           :queues (queue/map->BlockingMemoryQueue (:queue config))
+           :drift  (build-drift (:drift config))
+           :engine (map->Engine (:engine config))
+           :writer (map->Writer (:writer config))
+           :api    (map->Api (:api config))
+           :index  (index/build-index (:index config))
+           :store  (store/build-store (:store config)))
           (build-components :input input/build-input)
-          (update :clock    #(map->SystemClock %))
-          (update :drift    #(component/using (build-drift %) [:clock]))
-          (update :queues   queue/map->BlockingMemoryQueue)
-          (update :engine   #(component/using (map->Engine %) [:drift
-                                                               :queues
-                                                               :writer]))
-          (update :writer   #(component/using (map->Writer %) [:index
-                                                               :store
-                                                               :queues]))
-          (update :api      #(component/using (map->Api {:options %}) [:index
-                                                                       :store
-                                                                       :queues
-                                                                       :engine]))
-          (update :index index/build-index)
-          (update :store store/build-store)))))
+          (component/system-using {:drift [:clock]
+                                   :engine [:drift :queues :writer]
+                                   :writer [:index :store :queues]
+                                   :api    [:index :store :queues :engine]})))))

 (defn -main
   "Our main function, parses args and launches appropriate services"


Added demo for Sprint 61.

Added demo for Sprint 61.

--- indexer-app/src/cmr/indexer/data/concepts/collection/opendata.clj
+++ indexer-app/src/cmr/indexer/data/concepts/collection/opendata.clj
@@ -40,8 +40,8 @@
   (let [{:keys [Title Description Relation URLs MimeType FileSize]} related-url
         {:keys [Size Unit]} FileSize
         size (when (or Size Unit) (str Size Unit))]
-    ;; The current UMM JSON RelatedUrlType is flawed in that there can be multiple URLs,
-    ;; but only a single Title, MimeType and FileSize. This model doesn't make sense.
+    ;; See CMR-3446. The current UMM JSON RelatedUrlType is flawed in that there can be multiple
+    ;; URLs, but only a single Title, MimeType and FileSize. This model doesn't make sense.
     ;; Talked to Erich and he said that we are going to change the model.
     ;; So for now, we make the assumption that there is only one URL in each RelatedUrlType.
     {:type (first Relation)


Fix error: http://openweathermap.org/faq#error401 Registered an API key for demo purposes.

--- src/main/core.cljs
+++ src/main/core.cljs
@@ -22,7 +22,7 @@
 ; weather-in-london shows server and client side calls
 ;
 (defn weather-in-london [{:keys [callback state]}]
-  (let [url "http://api.openweathermap.org/data/2.5/weather?q=London,uk"]
+  (let [url "http://api.openweathermap.org/data/2.5/weather?q=London,uk&appid=bd82977b86bf27fb59a04b61b657fb6f"]
     (ajax/GET url {:handler #(callback (assoc-js % "page" "weather"))})))

 ; render-page is the REQUIRED entry point for page rendering


Test value of compare-to in <= impl for durations

`<=` for durations would return `-1` or `1` instead of `true` and `false` because of a missing `neg?`.

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -1220,7 +1220,7 @@
   (= [x y] (clojure.core/= x y))
   Duration
   (< [x y] (neg? (cljc.java-time.duration/compare-to x y)))
-  (<= [x y] (or (clojure.core/= x y) (cljc.java-time.duration/compare-to x y)))
+  (<= [x y] (or (clojure.core/= x y) (neg? (cljc.java-time.duration/compare-to x y))))
   (> [x y] (pos? (cljc.java-time.duration/compare-to x y)))
   (>= [x y] (or (clojure.core/= x y) (pos? (cljc.java-time.duration/compare-to x y))))
   (= [x y] (clojure.core/= x y)))


Fix default of keyed

Fix default of keyed

--- src/useful/map.clj
+++ src/useful/map.clj
@@ -15,7 +15,7 @@
       "Create a map in which, for each symbol S in vars, (keyword S) is a
   key mapping to the value of S in the current scope. If passed an optional
   :strs or :syms first argument, use strings or symbols as the keys instead."
-    ([vars] `(keyed :keys ~keys))
+    ([vars] `(keyed :keys ~vars))
     ([key-type vars]
        (let [transform (comp (partial list `quote)
                              (transforms key-type))]


Use a multimethod to do the add-apple, add-snake

Signed-off-by: Stefan Marr <46f1a0bd5592a2f9244ca321b129902a06b53e03@stefan-marr.de>

--- Clojure/src/snake/board_view.clj
+++ Clojure/src/snake/board_view.clj
@@ -2,7 +2,12 @@
   (:use snake.terminal)
   (:require [clojure.contrib.string :as string]))

-(defn draw-boarder
+(defn create-view
+  "Create a new board view"
+  [board]
+  :not-yet-implemented)
+
+(defn draw-borders
   "Draws the surrounding border of the board."
   [{width :width height :height}]

@@ -23,20 +28,19 @@
   (put (string/repeat width "-"))
   (put "/"))

+(defmulti add-element :type)
+  (defmethod add-element :apple
+    [{x :x y :y}]
+
+    (set-cursor (+ x 1) (+ y 1))
+    (put "o"))
+  (defmethod add-element :snake
+    [{x :x y :y}]
+
+    (set-cursor (+ x 1) (+ y 1))
+    (put "#"))

-(defn add-apple
-  [{x :x y :y}]
-
-  (set-cursor (+ x 1) (+ y 1))
-  (put "o"))
-
-(defn add-snake
-  [{x :x y :y}]
-
-  (set-cursor (+ x 1) (+ y 1))
-  (put "#"))
-
-(defn remove
+(defn remove-element
   [{x :x y :y}]

   (set-cursor (+ x 1) (+ y 1))
@@ -49,6 +53,6 @@

   (doseq [[row] board]
     (doseq [[elem] row]
-      (add elem))))
+      (add-element elem))))

 ; REM: add the add function which will call add-apple or add-snake


* benchmark/cljs/benchmark_runner.cljs: bench seq ops on ChunkedSeq not PersistentVector

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -22,14 +22,12 @@
 (println)

 (println ";;; vector ops")
-(simple-benchmark [coll [1 2 3]] (first coll) 1000000)
-(simple-benchmark [coll (seq [1 2 3])] (first coll) 1000000)
 (simple-benchmark [coll [1 2 3]] (conj coll 4) 1000000)
 (simple-benchmark [coll [1 2 3]] (-conj coll 4) 1000000)
-(simple-benchmark [coll [1 2 3]] (nth coll 1) 1000000)
-(simple-benchmark [coll [1 2 3]] (-nth coll 1) 1000000)
-(simple-benchmark [coll [1 2 3]] (rest coll) 1000000)
-(simple-benchmark [coll [1 2 3]] (next coll) 1000000)
+(simple-benchmark [coll [1 2 3]] (seq coll) 1000000)
+(simple-benchmark [coll (seq [1 2 3])] (first coll) 1000000)
+(simple-benchmark [coll (seq [1 2 3])] (rest coll) 1000000)
+(simple-benchmark [coll (seq [1 2 3])] (next coll) 1000000)
 (println)

 (println ";;; transients")


sort maps (keys and values)

sort maps (keys and values)

--- clojure/grade-school/school.clj
+++ clojure/grade-school/school.clj
@@ -7,3 +7,13 @@
 (defn grade
   [db grade]
   (get db grade []))
+
+(defn- transform-values-in
+  [m f]
+  "walk kv sets and aply f on every v"
+  (into {} (for [[k v] m] [k (f v)])))
+
+(defn sorted
+  [db]
+  (into (sorted-map)
+        (transform-values-in db sort)))


sort jars by name

sort jars by name

--- src/cake/deps.clj
+++ src/cake/deps.clj
@@ -53,15 +53,18 @@
 (defn deps [type]
   (get @dep-jars type))

+(defn- jar-name [jar]
+  (if (:long *opts*)
+    (.getPath jar)
+    (.getName jar)))
+
 (defn print-deps []
   (println)
   (doseq [type dep-types]
     (when-let [jars (seq (deps type))]
       (println (str (name type) ":"))
-      (doseq [jar (sort jars)]
-        (println " " (if (:long *opts*)
-                       (.getPath jar)
-                       (.getName jar))))
+      (doseq [jar (sort (map jar-name jars))]
+        (println " " jar))
       (println))))

 (let [subdir {:dependencies     ""


Fix port number parsing.

Fix port number parsing.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -134,7 +134,7 @@
 (defn -main [& args]
   (let [{:keys [options arguments summary errors]} (parse-opts args argspec)
         docroot (:root options)
-        port (:port options)
+        port (Integer/parseInt (:port options))
         tmp (:tmp options)]
     (if errors
       (binding [*out* *err*]


Open CORS.

Open CORS.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -44,7 +44,8 @@
 ; web services

 (def trusted-hosts
-  #"https://[-_A-Za-z0-9]+.kilokluster.ucsc.edu|https://genome-cancer.ucsc.edu")
+  ;#"https://[-_A-Za-z0-9]+.kilokluster.ucsc.edu|https://genome-cancer.ucsc.edu"
+  #".*")

 (defn- wrap-access-control [handler]
   (fn [request]


using seq to get nil short circuiting

using seq to get nil short circuiting

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -515,9 +515,9 @@
                                                                                :on-success close-fn}])}
                                                                         "Add Variable")]
                                        :close-fn close-fn})))
-              (when-let [env-vars-entries (->> project-data
-                                               :envvars
-                                               (sort-by key))]
+              (when-let [env-vars-entries (->> (:envvars project-data)
+                                               (sort-by key)
+                                               seq)]
                 (om/build table/table
                           {:rows env-vars-entries
                            :key-fn key


Mention deployment key is now read-only

Mention deployment key is now read-only

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -898,7 +898,8 @@
                [:div.help-block
                 [:h2 "About checkout keys"]
                 [:h4 "What is a deploy key?"]
-                [:p "A deploy key is a repo-specific SSH key. GitHub has the public key, and we store the private key. Possession of the private key gives read/write access to a single repository."]
+                [:p "A deploy key is a repo-specific SSH key. GitHub has the public key, and we store the private key. The deployment key is read-only, so CircleCI cannot push to your repository with the key."]
+                [:p "If you want to push to your repository from builds, please add a user key as described below"]
                 [:h4 "What is a user key?"]
                 [:p "A user key is a user-specific SSH key. GitHub has the public key, and we store the private key. Possession of the private key gives the ability to act as that user, for purposes of 'git' access to repositories."]
                 [:h4 "How are these keys used?"]


Confirmation before removing environment variable

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -407,6 +407,34 @@
            [:hr]
            (clear-cache-button "source" project-data owner)]]]))))

+(defn remove-env-var-button [{:keys [env-var project-id]} owner]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:show-modal? false})
+    om/IRenderState
+    (render-state [_ {:keys [show-modal?]}]
+      (html
+       [:span
+        (table/action-button
+         "Remove"
+         (icon/delete)
+         #(om/set-state! owner :show-modal? true))
+        (when show-modal?
+          (let [close-fn #(om/set-state! owner :show-modal? false)]
+            (modal/modal-dialog {:title "Are you sure?"
+                                 :body (html
+                                        [:span
+                                         "Are you sure you want to remove the environment variable \""
+                                         (:name env-var)
+                                         "\"?"])
+                                 :actions [(button/button {:on-click close-fn} "Cancel")
+                                           (button/button {:primary? true
+                                                           :on-click #(raise! owner [:deleted-env-var {:project-id project-id
+                                                                                :env-var-name (:name env-var)}])}
+                                                          "Delete")]
+                                 :close-fn close-fn})))]))))
+
 (defn env-vars [project-data owner]
   (reify
     om/IRender
@@ -417,58 +445,55 @@
             new-env-var-value (:new-env-var-value inputs)
             project-id (project-model/id project)]
         (html
-          [:section
-           [:article
-            [:h2 "Environment Variables for " (vcs-url/project-name (:vcs_url project))]
-            [:div
-             [:p
-              "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
-              "The values can be any bash expression and can reference other variables, such as setting "
-              [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
-
-             [:p
-              " To disable string substitution you need to escape the " [:code "$"]
-              " characters by prefixing them with " [:code "\\"] "."
-              " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
-             [:form
-              [:div.form-group
-               [:label "Name"]
-               [:input.form-control#env-var-name
-                {:required true, :type "text", :value new-env-var-name
-                 :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
-              [:div.form-group
-               [:label "Value"]
-               [:input.form-control#env-var-value
-                {:required true
-                 :type "text"
-                 :value new-env-var-value
-                 :auto-complete "off"
-                 :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]
-
-              [:div.form-group
-               (forms/managed-button
-                 [:input.btn.btn-primary {:data-failed-text "Failed",
-                                          :data-success-text "Added",
-                                          :data-loading-text "Adding...",
-                                          :value "Add Variable",
-                                          :type "submit"
-                                          :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]]
-             (when-let [env-vars (seq (:envvars project-data))]
-               (om/build table/table
-                         {:rows env-vars
-                          :columns [{:header "Name"
-                                     :cell-fn :name}
-                                    {:header "Value"
-                                     :cell-fn :value}
-                                    {:header "Remove"
-                                     :type #{:shrink :right}
-                                     :cell-fn
-                                     (fn [env-var]
-                                       (table/action-button
-                                        "Remove"
-                                        (icon/delete)
-                                        #(raise! owner [:deleted-env-var {:project-id project-id
-                                                                          :env-var-name (:name env-var)}])))}]}))]]])))))
+         [:section
+          [:article
+           [:h2 "Environment Variables for " (vcs-url/project-name (:vcs_url project))]
+           [:div
+            [:p
+             "Add environment variables to the project build.  You can add sensitive data (e.g. API keys) here, rather than placing them in the repository. "
+             "The values can be any bash expression and can reference other variables, such as setting "
+             [:code "M2_MAVEN"] " to " [:code "${HOME}/.m2)"] "."]
+
+            [:p
+             " To disable string substitution you need to escape the " [:code "$"]
+             " characters by prefixing them with " [:code "\\"] "."
+             " For example, a value like " [:code "usd$"] " would be entered as " [:code "usd\\$"] "." ]
+            [:form
+             [:div.form-group
+              [:label "Name"]
+              [:input.form-control#env-var-name
+               {:required true, :type "text", :value new-env-var-name
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-name) %)}]]
+             [:div.form-group
+              [:label "Value"]
+              [:input.form-control#env-var-value
+               {:required true
+                :type "text"
+                :value new-env-var-value
+                :auto-complete "off"
+                :on-change #(utils/edit-input owner (conj state/inputs-path :new-env-var-value) %)}]]
+
+             [:div.form-group
+              (forms/managed-button
+               [:input.btn.btn-primary {:data-failed-text "Failed",
+                                        :data-success-text "Added",
+                                        :data-loading-text "Adding...",
+                                        :value "Add Variable",
+                                        :type "submit"
+                                        :on-click #(raise! owner [:created-env-var {:project-id project-id}])}])]]
+            (when-let [env-vars (seq (:envvars project-data))]
+              (om/build table/table
+                        {:rows env-vars
+                         :columns [{:header "Name"
+                                    :cell-fn :name}
+                                   {:header "Value"
+                                    :cell-fn :value}
+                                   {:header "Remove"
+                                    :type #{:shrink :right}
+                                    :cell-fn
+                                    (fn [env-var]
+                                      (om/build remove-env-var-button {:env-var env-var
+                                                                       :project-id project-id}))}]}))]]])))))

 (defn advance [project-data owner]
   (reify


hack around transaction unique problem

hack around transaction unique problem

--- src-cljs/frontend/sente.cljs
+++ src-cljs/frontend/sente.cljs
@@ -90,9 +90,23 @@

 (defmethod handle-message :issue/transaction [app-state message data]
   (let [datoms (:tx-data data)]
-    (d/transact! (:issue-db @app-state)
-                 (map ds/datom->transaction datoms)
-                 {:server-update true})))
+    (try
+      (d/transact! (:issue-db @app-state)
+                   (map ds/datom->transaction datoms)
+                   {:server-update true})
+      (catch js/Error e
+        (when (= :transact/unique (:error (ex-data e)))
+          (d/transact! (:issue-db @app-state)
+                       (let [translation-map (reduce (fn [m datom]
+                                                       (if (= :frontend/issue-id (:a datom))
+                                                         (assoc m (:e datom) (:v datom))
+                                                         m))
+                                                     {} datoms)]
+                         (map (fn [datom]
+                                (ds/datom->transaction (assoc datom :e [:frontend/issue-id
+                                                                        (translation-map (:e datom))])))
+                              datoms))
+                       {:server-update true}))))))

 (defmethod handle-message :frontend/subscriber-joined [app-state message data]
   (swap! app-state subs/add-subscriber-data (:client-id data) data))


begin adding colors

begin adding colors


Fix hash-combine, #53

Fix hash-combine, #53


Removed debug command

Removed debug command


added all namespaces back to browser tests

--- dev/cljs/user.cljs
+++ dev/cljs/user.cljs
@@ -2,21 +2,17 @@
   (:require-macros [cljs.test
                     :refer (is deftest run-tests testing)])
   (:require smooth-test.async-spec
-    smooth-test.assertion-spec
             smooth-test.stub-spec
             smooth-test.provided-spec
-  ;          smooth-test.specification-spec
             [smooth-test.runner.browser :as b]
             [cljs.test :as t]))

 (enable-console-print!)

 (defn run-all-tests []
-  ;(run-tests 'smooth-test.async-spec)
-  ;(run-tests 'smooth-test.stub-spec)
+  (run-tests 'smooth-test.async-spec)
+  (run-tests 'smooth-test.stub-spec)
   (run-tests 'smooth-test.provided-spec)
-  ;(run-tests 'smooth-test.specification-spec)
-
   )

 (defn on-load []


Start using the new CloudWatch alarm creation functionality


Clean typos

Clean typos

--- cljs-cheatsheet/cljs_cheatsheet/tooltips.cljs
+++ cljs-cheatsheet/cljs_cheatsheet/tooltips.cljs
@@ -17,8 +17,7 @@
 (def right-arrow-class "right-arr-d3345")
 (def arrow-classes (str left-arrow-class " " right-arrow-class))

-(def min-brwsr-wdth--tt-algn 1460)
-
+(def min-brwsr-wdth-tt-algn 1460)
 (def fade-speed 100)

 ;;------------------------------------------------------------------------------
@@ -121,7 +120,6 @@
         $tooltip-el ($ (str "#" (:id tt)))
         tooltip-height (.outerHeight $tooltip-el)
         tooltip-width (.outerWidth $tooltip-el)
-        tt-width-half (half tooltip-width)
         tooltip-left (- (+ link-x (half link-width)) (half tooltip-width))
         tooltip-right (+ (+ link-x (half link-width)) (half tooltip-width))
         tooltip-top (+ link-y link-height 4)
@@ -131,13 +129,13 @@

     ;; position the el
     (.css $tooltip-el (js-obj
-        "left" tooltip-left
-        "top" tooltip-top))
+      "left" tooltip-left
+      "top" tooltip-top))

     ;; position el to align with left edge of browser (plus padding) or
     ;; center on link if not on edge
     (when (and (<= tooltip-left 200)
-               (< $innerWidth min-brwsr-wdth--tt-algn))
+               (< $innerWidth min-brwsr-wdth-tt-algn))
       (.css $tooltip-el (js-obj
         "left" 10
         "top" tooltip-top)))
@@ -145,7 +143,7 @@
     ;; position el to align with right edge of browser (plus padding) or
     ;; center on link if not on edge
     (when (and (>= tooltip-right (- $innerWidth 25))
-               (< $innerWidth min-brwsr-wdth--tt-algn))
+               (< $innerWidth min-brwsr-wdth-tt-algn))
       (.css $tooltip-el (js-obj
         "left" right-align-position
         "top" tooltip-top)))


allow exception due to lack of feminine Spanish names

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -108,8 +108,10 @@
                                                                          (and
                                                                           (= (get-in spec [:root :espanol :espanol])
                                                                              "llamarse")
-                                                                          (= (get-in spec [:comp :synsem :arg :number])
-                                                                             :plur))
+                                                                          (or (= (get-in spec [:comp :synsem :agr :number])
+                                                                                :plur)
+                                                                              (= (get-in spec [:comp :synsem :agr :gender])
+                                                                                :fem)))
                                                                          (log/info (str "ignoring exception(llamarse): " e))

                                                                          true


allow for optional 'lexeme' argument to (todos)

e.g.: lein run -m babel.espanol.writer/todos 1 acertar

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -29,8 +29,10 @@
 (defn fo [expression]
   (morph/fo expression))

-(defn todos [ & [count]]
+(defn todos [ & [count lexeme]]
   (let [count (if count (Integer. count) 10)
+        lexemes (if lexeme (list (get @lexicon lexeme))
+                    (vals @lexicon))
         root-verbs
         (zipmap
          (keys @lexicon)
@@ -41,7 +43,7 @@
                            (= (get-in lexeme [:synsem :infl]) :top)
                            (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
                         lexeme-set))
-              (vals @lexicon)))
+              lexemes))
         root-verb-array
         (reduce concat
                 (map (fn [key]


Safe bounding for solved summaries

Safe bounding for solved summaries

--- src/angelic/search/summary.clj
+++ src/angelic/search/summary.clj
@@ -70,6 +70,7 @@

 (defn or-combine-b [summaries new-src bound]
   (let [best (apply-max-b summaries bound)]
+    (when (solved? best) (assert (>= bound (max-reward best))))
     (re-source best new-src bound :solved)))

@@ -128,10 +129,10 @@
                (clojure.core/>= (status-val (status s1))
                                 (status-val (status s2)))))))
   (+                [s other new-src bound]
-    (SimpleSummary.
-     (clojure.core/min (clojure.core/+ max-rew (max-reward other)) bound)
-     (min-key status-val stat (status other))
-     new-src [s other])))
+    (let [new-stat (min-key status-val stat (status other))
+	  r        (clojure.core/+ max-rew (max-reward other))]
+      (when (= new-stat :solved) (assert (>= bound r)))
+      (SimpleSummary. (clojure.core/min r bound) new-stat new-src [s other]))))

 (defn make-live-simple-summary [max-reward source] (SimpleSummary. max-reward :live source nil))
 (defn make-blocked-simple-summary [max-reward source] (SimpleSummary. max-reward :blocked source nil))


TCHECK-50: Add gen/generate for single samples

The name `generate` comes from QuickCheck which has a similar function.

--- src/main/clojure/clojure/test/check/generators.clj
+++ src/main/clojure/clojure/test/check/generators.clj
@@ -151,6 +151,16 @@
   ([generator num-samples]
    (assert (generator? generator) "First arg to sample must be a generator")
    (take num-samples (sample-seq generator))))
+
+
+(defn generate
+  "Returns a single sample value from the generator, using a default
+  size of 30."
+  ([generator]
+     (generate generator 30))
+  ([generator size]
+     (let [rng (random/make-random)]
+       (rose/root (call-gen generator rng size)))))

 ;; Internal Helpers


Add state-atom function.

Add state-atom function.

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -48,6 +48,21 @@
            (when-not (contains? state key)
              (throw (Exception. (str "Unable to find state with key: " key))))
            (get state key))))
+
+(defn
+  ^{:requires-bindings true
+    :category "State"
+    :subcategory nil
+    :added "1.0"}
+  state-atom
+  "Retrieve sketch-specific state-atom. All changes to the
+  atom will be reflected in the state.
+
+  (set-state! :foo 1)
+  (state :foo) ;=> 1
+  (swap! (state-atom) update-in [:foo] inc)
+  (state :foo) ;=> 2"
+  ([] (-> (current-applet) meta :state)))

 (defn
   ^{:requires-bindings true


CMR-687: Added test for using AND with facets.

--- test/cmr/system_int_test/search/collection_facets_search_test.clj
+++ test/cmr/system_int_test/search/collection_facets_search_test.clj
@@ -254,6 +254,42 @@
           (is (= expected-facets
                  (:facets (search/find-refs :collection {:include-facets true
                                                          :project "PROJ2"}))))))
+
+      (testing "AND conditions narrow facets via AND not OR"
+        (let [expected-facets [{:field "project" :value-counts [["PROJ2" 1] ["proj3" 1]]}
+                               {:field "platform" :value-counts [["B-p0" 1] ["B-p1" 1]]}
+                               {:field "instrument"
+                                :value-counts [["B-p0-i0" 1]
+                                               ["B-p0-i1" 1]
+                                               ["B-p1-i0" 1]
+                                               ["B-p1-i1" 1]]}
+                               {:field "sensor"
+                                :value-counts [["B-p0-i0-s0" 1]
+                                               ["B-p0-i1-s0" 1]
+                                               ["B-p1-i0-s0" 1]
+                                               ["B-p1-i1-s0" 1]]}
+                               {:field "two_d_coordinate_system_name" :value-counts []}
+                               {:field "processing_level_id" :value-counts [["pl1" 1]]}
+                               {:field "category" :value-counts [["Cat1" 1] ["Hurricane" 1]]}
+                               {:field "topic" :value-counts [["Popular" 1] ["Topic1" 1]]}
+                               {:field "term" :value-counts [["Extreme" 1]
+                                                             ["Term1" 1]
+                                                             ["UNIVERSAL" 1]]}
+                               {:field "variable_level_1":value-counts [["Level1-1" 1]
+                                                                        ["Level2-1" 1]]}
+                               {:field "variable_level_2" :value-counts [["Level1-2" 1]
+                                                                         ["Level2-2" 1]]}
+                               {:field "variable_level_3" :value-counts [["Level1-3" 1]
+                                                                         ["Level2-3" 1]]}
+                               {:field "detailed_variable" :value-counts [["Detail1" 1]
+                                                                          ["UNIVERSAL" 1]]}]]
+
+
+          (is (= expected-facets
+                 (:facets (search/find-refs :collection {:include-facets true
+                                                        :project ["PROJ2" "proj3"]
+                                                        "options[project][and]" true}))))))
+
       (testing "search finding one document"
         (let [expected-facets [{:field "project" :value-counts []}
                                {:field "platform" :value-counts []}


Change wpml/img option parameters

Change wpml/img option parameters

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -719,7 +719,11 @@
   [resource-id
    & {:as options
       :keys [name desc width height
-             no-select? no-move? no-resize? no-change-aspect?]}]
+             no-select? no-move? no-resize? no-change-aspect?]
+      :or {:no-select? false
+           :no-move? false
+           :no-resize? false
+           :no-change-aspect? true}}]
   (node :w:p {}
         (node :w:r {}
               (node :w:drawing {}
@@ -739,9 +743,9 @@
                           ;; Common DrawingML Non-Visual Properties
                           (node :wp:cNvGraphicFramePr {}
                                 ;; Graphic Frame Locks
-                                (node :a:graphicFrameLocks {:noSelect (if no-select? true false)
-                                                            :noMove (if no-move? true false)
-                                                            :noResize (if no-resize? true false)
-                                                            :noChangeAspect (if no-change-aspect? true false)}))
+                                (node :a:graphicFrameLocks {:noSelect no-select?
+                                                            :noMove no-move?
+                                                            :noResize no-resize?
+                                                            :noChangeAspect no-change-aspect?}))
                           ;; Graphic
                           (graphic resource-id options))))))


Introduce query* for embedded to bypass linting.

--- src/clj/fleetdb/embedded.clj
+++ src/clj/fleetdb/embedded.clj
@@ -90,9 +90,7 @@
             (alter-meta! dba assoc  :write-dos dos))))
       true)))

-(defn query [dba q]
-  (assert (dba? dba))
-  (lint/lint-query q)
+(defn query* [dba q]
   (if (core/write-query? q)
     (fair-lock/fair-locking (:write-lock (meta dba))
       (let [old-db          @dba
@@ -104,3 +102,8 @@
         (assert (compare-and-set! dba old-db new-db))
         result))
     (core/query* @dba q)))
+
+(defn query [dba q]
+  (rassert (dba? dba) "dba not recognized as a database")
+  (lint/lint-query q)
+  (query* dba q))


format input field numbers by default

format input field numbers by default

--- src/clj_money/web/shared.clj
+++ src/clj_money/web/shared.clj
@@ -7,6 +7,7 @@
             [hiccup.page :refer :all]
             [clojure.string :as s]
             [cemerick.friend :as friend]
+            [clj-money.util :refer [format-number]]
             [clj-money.validation :as validation]
             [clj-money.models.users :as users]
             [clj-money.models.entities :as entities])
@@ -213,28 +214,29 @@

 (defn- input-field
   "Renders a HTML input field"
-  ([model attribute options] (input-field model attribute options identity))
-  ([model attribute options format-fn]
+  ([model attribute options]
    [:div.form-group {:class (when (validation/has-error? model attribute)"has-error")}
     (when-not (:suppress-label? options)
       [:label.control-label {:for attribute} (humanize attribute)])
     [:input.form-control (merge options {:id attribute
                                          :name attribute
-                                         :value (format-fn (get model attribute))})]
+                                         :value ((or (:format-fn options)
+                                                     identity) (get model attribute))})]
     (when (validation/has-error? model)
       (map #(vector :span.help-block %) (validation/get-errors model attribute)))]))

 (defn text-input-field
   ([model attribute] (text-input-field model attribute {}))
-  ([model attribute options] (text-input-field model attribute options identity))
-  ([model attribute options format-fn]
-   (input-field model attribute (merge options {:type :text}) format-fn)))
+  ([model attribute options]
+   (input-field model attribute (merge options {:type :text}))))

 (defn number-input-field
   ([model attribute] (number-input-field model attribute {}))
   ([model attribute options]
-   (input-field model attribute (merge options {:type :number
-                                                :step "0.01"}))))
+   (input-field model attribute (merge {:format-fn #(format-number % {:format :no-comma})}
+                                       options
+                                       {:type :number
+                                        :step "0.01"}))))

 (defn password-input-field
   ([model attribute] (password-input-field model attribute {}))


Try add scroll handler

Try add scroll handler

--- src/clj_simple_chart/jfx.clj
+++ src/clj_simple_chart/jfx.clj
@@ -66,6 +66,9 @@

         :else (do #_(println "unhandled" v))))

+#_(defn scroll-handler [v]
+  (println "hello from scroll-handler" v))
+
 (defn window-width-change-handler [new]
   (when (number? new)
     (swap! window-width (fn [o] new))))
@@ -87,6 +90,9 @@
     (.setOnZoom internal-scene (reify EventHandler
                                  (handle [_ v]
                                    (zoom-handler (.getZoomFactor v)))))
+    #_(.setOnScroll internal-scene (reify EventHandler
+                                   (handle [_ v]
+                                     (scroll-handler v))))
     (.addListener (.widthProperty internal-scene) (reify ChangeListener
                                                     (changed [_ val old new]
                                                       (window-width-change-handler new))))


Make it easier to run queries at REPL

Make it easier to run queries at REPL

--- src/bgg_graphql_proxy/main.clj
+++ src/bgg_graphql_proxy/main.clj
@@ -1,6 +1,7 @@
 (ns bgg-graphql-proxy.main
   (:require
     [io.pedestal.http :as http]
+    [com.walmartlabs.graphql :refer [execute]]
     [bgg-graphql-proxy.schema :refer [bgg-schema]]
     [bgg-graphql-proxy.server :refer [pedestal-server]]))


CMR-5035: Plugged the new generator into the pipeline.

--- src/cmr/opendap/ous/v2_1.clj
+++ src/cmr/opendap/ous/v2_1.clj
@@ -1,7 +1,14 @@
 (ns cmr.opendap.ous.v2-1
   (:require
-   [cmr.opendap.ous.common :as common]
-   [taoensso.timbre :as log]))
+    [cmr.opendap.components.config :as config]
+    [cmr.opendap.ous.common :as common]
+    [cmr.opendap.ous.service :as service]
+    [cmr.opendap.ous.variable :as variable]
+    [cmr.opendap.results.core :as results]
+    [cmr.opendap.results.errors :as errors]
+    [cmr.opendap.results.warnings :as warnings]
+    [cmr.opendap.util :as util]
+    [taoensso.timbre :as log]))

 (defn apply-gridded-conditions
   "This function is responsible for identifying whether data is girdded or not.
@@ -28,89 +35,88 @@
     (log/error "bounding-box:" bounding-box)
     [vars params bounding-box warnings]))

-; (defn stage3
-;   [component coll search-endpoint user-token params bounding-box service-ids vars]
-;   ;; XXX coll is required as an arg here because it's needed in a
-;   ;;     workaround for different data sets using different starting
-;   ;;     points for their indices in OPeNDAP
-;   ;;
-;   ;; XXX This is being tracked in CMR-4982
-;   (log/debug "Starting stage 3 ...")
-;   (let [[vars params bounding-box gridded-warns]
-;         (apply-gridded-conditions vars
-;                                   params
-;                                   bounding-box)
-;         services-promise (service/async-get-metadata
-;                           search-endpoint user-token service-ids)
-;         bounding-infos (map #(variable/extract-bounding-info
-;                               coll % bounding-box)
-;                             vars)
-;         errs (apply errors/collect bounding-infos)
-;         warns (errors/collect-warnings gridded-warns)]
-;     (when errs
-;       (log/error "Stage 3 errors:" errs))
-;     (log/trace "variables bounding-info:" (vec bounding-infos))
-;     (log/debug "Finishing stage 3 ...")
-;     [services-promise vars params bounding-infos errs warns]))
+(defn stage3
+  [component coll search-endpoint user-token params bounding-box service-ids vars]
+  ;; XXX coll is required as an arg here because it's needed in a
+  ;;     workaround for different data sets using different starting
+  ;;     points for their indices in OPeNDAP
+  ;;
+  ;; XXX This is being tracked in CMR-4982
+  (log/debug "Starting stage 3 ...")
+  (let [[vars params bounding-box gridded-warns]
+        (apply-gridded-conditions vars
+                                  params
+                                  bounding-box)
+        services-promise (service/async-get-metadata
+                          search-endpoint user-token service-ids)
+        bounding-infos (map #(variable/extract-bounding-info
+                              coll % bounding-box)
+                            vars)
+        errs (apply errors/collect bounding-infos)
+        warns (warnings/collect gridded-warns)]
+    (when errs
+      (log/error "Stage 3 errors:" errs))
+    (log/trace "variables bounding-info:" (vec bounding-infos))
+    (log/debug "Finishing stage 3 ...")
+    [services-promise vars params bounding-infos errs warns]))

-; (defn get-opendap-urls
-;   [component user-token raw-params]
-;   (log/trace "Got params:" raw-params)
-;   (let [start (util/now)
-;         search-endpoint (config/get-search-url component)
-;         ;; Stage 1
-;         [params bounding-box grans-promise coll-promise s1-errs]
-;         (stage1 component
-;                 search-endpoint
-;                 user-token
-;                 raw-params)
-;         ;; Stage 2
-;         [coll params data-files service-ids vars s2-errs]
-;         (stage2 component
-;                 search-endpoint
-;                 user-token
-;                 params
-;                 coll-promise
-;                 grans-promise)
-;         ;; Stage 3
-;         [services vars params bounding-info s3-errs s3-warns]
-;         (stage3 component
-;                 coll
-;                 search-endpoint
-;                 user-token
-;                 params
-;                 bounding-box
-;                 service-ids
-;                 vars)
-;         ;; Stage 4
-;         [query s4-errs]
-;         (stage4 coll
-;                 bounding-box
-;                 services
-;                 bounding-info)
-;         ;; Warnings for all stages
-;         warns (errors/collect-warnings s3-warns)
-;         ;; Error handling for all stages
-;         errs (errors/collect
-;               start params bounding-box grans-promise coll-promise s1-errs
-;               data-files service-ids vars s2-errs
-;               services bounding-info s3-errs
-;               query s4-errs
-;               {:errors (errors/check
-;                         [not data-files errors/empty-gnl-data-files])})]
-;     (log/trace "Got data-files:" (vec data-files))
-;     (if errs
-;       (do
-;         (log/error errs)
-;         errs)
-;       (let [urls-or-errs (data-files->opendap-urls params
-;                                                    data-files
-;                                                    query)]
-;         ;; Error handling for post-stages processing
-;         (if (errors/erred? urls-or-errs)
-;           (do
-;             (log/error urls-or-errs)
-;             urls-or-errs)
-;           (do
-;             (log/debug "Generated URLs:" (vec urls-or-errs))
-;           (results/create urls-or-errs :elapsed (util/timed start))))))))
+(defn get-opendap-urls
+  [component user-token raw-params]
+  (log/trace "Got params:" raw-params)
+  (let [start (util/now)
+        search-endpoint (config/get-search-url component)
+        ;; Stage 1
+        [params bounding-box grans-promise coll-promise s1-errs]
+        (common/stage1 component
+                       search-endpoint
+                       user-token
+                       raw-params)
+        ;; Stage 2
+        [coll params data-files service-ids vars s2-errs]
+        (common/stage2 component
+                       search-endpoint
+                       user-token
+                       params
+                       coll-promise
+                       grans-promise)
+        ;; Stage 3
+        [services vars params bounding-info s3-errs s3-warns]
+        (stage3 component
+                coll
+                search-endpoint
+                user-token
+                params
+                bounding-box
+                service-ids
+                vars)
+        ;; Stage 4
+        [query s4-errs]
+        (common/stage4 coll
+                       bounding-box
+                       services
+                       bounding-info)
+        ;; Warnings for all stages
+        warns (warnings/collect s3-warns)
+        ;; Error handling for all stages
+        errs (errors/collect
+              start params bounding-box grans-promise coll-promise s1-errs
+              data-files service-ids vars s2-errs
+              services bounding-info s3-errs
+              query s4-errs
+              {:errors (errors/check
+                        [not data-files errors/empty-gnl-data-files])})]
+    (log/trace "Got data-files:" (vec data-files))
+    (if errs
+      (do
+        (log/error errs)
+        errs)
+      (let [urls-or-errs (common/data-files->opendap-urls
+                          params data-files query)]
+        ;; Error handling for post-stages processing
+        (if (errors/erred? urls-or-errs)
+          (do
+            (log/error urls-or-errs)
+            urls-or-errs)
+          (do
+            (log/debug "Generated URLs:" (vec urls-or-errs))
+          (results/create urls-or-errs :elapsed (util/timed start))))))))


Minor doc tweak and cleanup.

Minor doc tweak and cleanup.

--- src/com/lemonodor/gflags.clj
+++ src/com/lemonodor/gflags.clj
@@ -1,5 +1,5 @@
 (ns com.lemonodor.gflags
-  "Gflags for clojure."
+  "Google-style command-line flags for clojure."
   (:require [clojure.java.io :as io]
             [clojure.string :as string]
             [com.lemonodor.getopt :as getopt]
@@ -404,5 +404,3 @@
         [optlist, unparsed-args] (getopt/getopt args shortopts longopts)]
     (swap! *flags* update-flag-values optlist)
     unparsed-args))
-
-


Db spec generalization

Db spec generalization

--- src/ansel/db.clj
+++ src/ansel/db.clj
@@ -11,26 +11,46 @@
             [ansel.util :refer :all])
   (:import org.mindrot.jbcrypt.BCrypt))

-;; TODO: Generalize database configuration
-(def db-spec
+(defqueries "sql/queries.sql")
+(def tnow (comp to-timestamp now))
+
+(def config  (atom nil))
+(def running (atom true))
+
+(def save-interval (minutes 3))
+
+(def default-config {:upload-path nil
+                     :thumb-path nil
+                     :template-path nil
+                     :database {:user "postgres"
+                                :password nil
+                                :host "//localhost:5432/ansel"}})
+
+(defn load-config []
+  (let [data (if (exists? "config.json")
+               (parse-string (slurp "config.json") true)
+               default-config)]
+    (dosync
+      (reset! config data)
+      (info "data loaded from disk"))))
+
+(defn assert-fs []
+  (info "creating dirs")
+  (fs/mkdirs (get-uploads-path))
+  (fs/mkdirs (get-thumbs-path)))
+
+(defn init []
+  (load-config)
+  (assert-fs))
+
+;; This init is required when running the server via `lein ring server`
+;; (init)
+
+(defn get-db-spec []
   {:classname "org.postgresql.Driver"
    :subprotocol "postgresql"
-   :subname "//localhost:5432/ansel"
-   :user "honza"})
-
-(defqueries "sql/queries.sql")
-(def tnow (comp to-timestamp now))
-
-(def config  (atom nil))
-(def running (atom true))
-
-(def save-interval (minutes 3))
-
-(def default-config {:upload-path nil
-                     :thumb-path nil
-                     :template-path nil})
-
-;; User management ------------------------------------------------------------
+   :subname (get-in @config [:database :host])
+   :user (get-in @config [:database :user])})

 (defn hash-bcrypt [password]
   (BCrypt/hashpw password (BCrypt/gensalt)))
@@ -39,7 +59,7 @@
   (BCrypt/checkpw p h))

 (defn get-user [email]
-  (first (sql-get-user db-spec email)))
+  (first (sql-get-user (get-db-spec) email)))

 (defn sql-exists? [q]
   (-> q first :count pos?))
@@ -48,18 +68,18 @@
   (sql-exists? (sql-user-exists db email)))

 (defn users-exist? []
-  (sql-exists? (sql-user-count db-spec)))
+  (sql-exists? (sql-user-count (get-db-spec))))

 (defn like-exists? [db image user]
   (sql-exists? (sql-like-exists db image user)))

 (defn add-user-to-db [user & admin]
   (let [admin (if (and (seq admin) (first admin))
-            true
-            (if (users-exist?)
-              false
-              true))]
-    (with-db-transaction [connection db-spec]
+                true
+                (if (users-exist?)
+                  false
+                  true))]
+    (with-db-transaction [connection (get-db-spec)]
       (when-not (user-exists? connection (:email user))
         (sql-insert-user! connection
                           (hash-bcrypt (:password user))
@@ -67,8 +87,6 @@
                           (:name user)
                           admin)))))

-;; Image management -----------------------------------------------------------
-
 (defn get-thumb-name
   "(get-thumb-name 'dog.jpg' 200)
   => 'dog_200.jpg'"
@@ -94,18 +112,18 @@

 (defn get-images [& limit]
   (let [images (if (seq limit)
-                  (sql-get-images-limit db-spec (first limit))
-                  (sql-get-all-images db-spec))]
+                  (sql-get-images-limit (get-db-spec) (first limit))
+                  (sql-get-all-images (get-db-spec)))]
     (map beef-up-image images)))

 (defn get-image-by-id
   ([id] (get-image-by-id id 0))
   ([id user-id]
-   (when-let [images (sql-get-image-by-id db-spec user-id id)]
+   (when-let [images (sql-get-image-by-id (get-db-spec) user-id id)]
       (beef-up-image (first images)))))

 (defn add-image-to-db [image user-id]
-  (sql-insert-image! db-spec
+  (sql-insert-image! (get-db-spec)
                      (:filename image)
                      (:caption image)
                      (:focal-length image)
@@ -118,23 +136,23 @@
                      (to-timestamp (:captured image))))

 (defn add-image-to-album [image-id album-id]
-  (sql-insert-image-to-album! db-spec image-id album-id))
+  (sql-insert-image-to-album! (get-db-spec) image-id album-id))

 (defn add-album-to-db [album user]
   (sql-insert-album!
-    db-spec
+    (get-db-spec)
     (:name album)
     (slugify (:name album))
     (:id user)))

 (defn get-all-albums []
-  (sql-get-all-albums db-spec))
+  (sql-get-all-albums (get-db-spec)))

 (defn get-images-for-album [album-id]
-  (sql-get-images-for-album db-spec album-id))
+  (sql-get-images-for-album (get-db-spec) album-id))

 (defn get-album-by-slug [slug]
-  (sql-get-album-by-slug db-spec slug))
+  (sql-get-album-by-slug (get-db-spec) slug))

 (defn get-uploads-path []
   (or (:upload-path @config) "uploads/"))
@@ -146,7 +164,7 @@
   (:template-path @config))

 (defn like-image [image user]
-  (with-db-transaction [connection db-spec]
+  (with-db-transaction [connection (get-db-spec)]
     (when-not (like-exists? connection (:id image) (:id user))
       (sql-insert-like! (:id image) (:id user)))))

@@ -159,32 +177,13 @@
     (str num-likes " people like this")))

 (defn comment-on-image [image user c]
-  (sql-insert-comment! db-spec
+  (sql-insert-comment! (get-db-spec)
                        (:id image)
                        (:id user)
                        c))

 (defn get-comments-for-image [image]
-  (sql-get-comments-for-image db-spec (:id image)))
-
-;; Loading --------------------------------------------------------------------
-
-(defn load-data-from-disk []
-  (let [data (if (exists? "config.json")
-               (parse-string (slurp "config.json") true)
-               default-config)]
-    (dosync
-      (reset! config (:config data))
-      (info "data loaded from disk"))))
-
-(defn get-context []
-  {})
-
-(defn assert-fs []
-  (info "creating dirs")
-  (fs/mkdirs (get-uploads-path))
-  (fs/mkdirs (get-thumbs-path)))
-
+  (sql-get-comments-for-image (get-db-spec) (:id image)))

 (defn add-cover-to-album [images album]
   (assoc album :cover (or (:cover album)
@@ -210,7 +209,3 @@

 (defn add-recent-images [db]
   (assoc db :recent (take 5 (:images db))))
-
-(defn init []
-  (load-data-from-disk)
-  (assert-fs))


(MAINT) change clojure.lang.PersistentList to schema

--- src/puppetlabs/trapperkeeper/services_internal.clj
+++ src/puppetlabs/trapperkeeper/services_internal.clj
@@ -61,7 +61,7 @@
 (def ProtocolandDependenciesMap
   "Schema defining the map used to represent the protocol and dependencies
   of a service."
-  {:fns [clojure.lang.PersistentList]
+  {:fns (schema/pred seq?)
    :dependencies (schema/pred vector?)
    :service-protocol-sym (schema/maybe Symbol)})


Rough in status and metadata markup

Rough in status and metadata markup

--- src-cljs/frontend/components/pages/workflow.cljs
+++ src-cljs/frontend/components/pages/workflow.cljs
@@ -43,14 +43,26 @@
          (element :content
            (html
             [:div
-             [:.status (status/badge (status-class status) (name status))]
-             [:.started-at {:title (str "Started: " (datetime/full-datetime started-at))}
-              (build-legacy common/updating-duration {:start started-at} {:opts {:formatter datetime/time-ago-abbreviated}})]
-             [:.duration {:title (str "Duration: " (datetime/as-duration (- stopped-at started-at)))}
-              (build-legacy common/updating-duration {:start started-at
-                                                      :stop stopped-at})]
-             [:.branch-name branch-name]
-             [:.commit-sha (subs commit-sha 0 7)]])))))))
+             #_[:.status (status/badge (status-class status) (name status))]
+             [:.status {:class (name status)}]
+             [:div.metadata
+              [:div.metadata-row.timing
+               [:span.metadata-item.recent-time.start-time
+                [:i.material-icons "today"]
+                [:span.started-at {:title (str "Started: " (datetime/full-datetime started-at))}
+                 (build-legacy common/updating-duration {:start started-at} {:opts {:formatter datetime/time-ago-abbreviated}})[:span " ago"]]]
+               [:span.metadata-item.recent-time.duration
+                [:i.material-icons "timer"]
+                [:span.duration {:title (str "Duration: " (datetime/as-duration (- stopped-at started-at)))}
+                 (build-legacy common/updating-duration {:start started-at
+                                                         :stop stopped-at})]]]
+              [:div.metadata-row.pull-revision
+               [:span.metadata-item.pull-requests {:title "Pull Requests"}
+                (icon/git-pull-request)
+                [:a "#1234"]]
+               [:span.metadata-item.revision
+                [:i.octicon.octicon-git-commit]
+                [:a "1234345"]]]]])))))))

 (def run (om-next/factory Run {:keyfn :run/id}))


Changed indentation level in sparse-expander.

--- src/clj/forma/matrix/utils.clj
+++ src/clj/forma/matrix/utils.clj
@@ -64,10 +64,10 @@
               tup-seq tuples
               v (transient [])]
          (let [[pos val] (first tup-seq)]
-           (cond (halt? idx tup-seq) (persistent! v)
+           (cond (halt? idx tup-seq)    (persistent! v)
                  (when pos (= idx pos)) (recur (inc idx) (rest tup-seq) (conj! v val))
                  (when pos (> idx pos)) (recur (inc idx) (rest tup-seq) (conj! v placeholder))
-                 :else       (recur (inc idx) tup-seq (conj! v placeholder))))))))
+                 :else                  (recur (inc idx) tup-seq (conj! v placeholder))))))))

 (defn idx->colrow
   "Takes an index within a row vector, and returns the appropriate


Remove comment re making new-game handler pure #15

Not worth doing at this point. Willl probably revisit this later.

--- src/clj/zetawar/events/ui.cljs
+++ src/clj/zetawar/events/ui.cljs
@@ -163,6 +163,7 @@
                   [:db/retract (e app) :app/targeted-r to-r]]}
       {:dispatch [[::clear-selection]]})))

+
 (defmethod router/handle-event ::attack-targeted
   [{:as handler-ctx :keys [db]} _]
   (let [[attacker-q attacker-r] (app/selected-hex db)
@@ -204,7 +205,6 @@
     (app/set-url-game-state! @conn)
     {:notify [[:faction.color/all "testing"]]}))

-;; TODO: convert to pure function
 (defmethod router/handle-event ::new-game
   [{:as handler-ctx :keys [ev-chan conn db]} _]
   (when (js/confirm "Are you sure you want to end your current game and start a new one?")


Add grouping of Var list by object type

Add grouping of Var list by object type

... as determined by clj-info.doc2map/get-docs-map.

The new var group-vars-by-object-type could be replaced with an atom
controlled by a GUI widget if we want to allow the user to turn this
on/off.

--- src/clj_ns_browser/browser.clj
+++ src/clj_ns_browser/browser.clj
@@ -12,6 +12,8 @@
             [seesaw.bind :as b]
             [clojure.java.browse]
             [clojure.java.shell]
+            [clojure.string :as str]
+            [clj-info.doc2map :as d2m]
             [clj-ns-browser.inspector]
             [seesaw.meta]
             [clojure.java.javadoc]
@@ -175,6 +177,7 @@
 (defn ns-unloaded [] @all-ns-unloaded-atom)
 (swap! all-ns-unloaded-atom (fn [& a] (all-ns-unloaded)))
 (swap! all-ns-loaded-atom (fn [& a] (all-ns-loaded)))
+(def group-vars-by-object-type (atom true))

 ;; bind specific fns
@@ -199,6 +202,40 @@
                        (or (re-find r (:doc %))
                            (re-find r (str (:name %))))))
          (map #(str (:ns %) "/" (:name %))))))
+
+
+(defn better-get-docs-map [fqn]
+  (if (= fqn "clojure.core//")
+    {:object-type-str "Function"}
+    (d2m/get-docs-map fqn)))
+
+
+(defn simplify-object-type [obj-type-str]
+  (cond
+   (nil? obj-type-str) "(nil)"
+   (re-find #"^Var .*" obj-type-str) "Var"
+   :else obj-type-str))
+
+
+(defn group-by-object-type [symbol-str-seq fqns? ns-str]
+  (let [symbol-info (map (fn [s]
+                               (let [fqn (if fqns? s (str ns-str "/" s))
+                                     obj-type-str (-> fqn
+                                                      ;;d2m/get-docs-map
+                                                      better-get-docs-map
+                                                      :object-type-str
+                                                      simplify-object-type)]
+                                 {:orig-str s
+                                  :fqn-str fqn
+                                  :obj-type-str obj-type-str}))
+                             symbol-str-seq)
+        groups (group-by :obj-type-str symbol-info)]
+    (apply concat (interpose
+                   [ " " ]
+                   (map (fn [[obj-type-str l]]
+                          (concat [ (str "        " obj-type-str) ]
+                                  (sort (map :orig-str l))))
+                        (sort-by first (seq groups)))))))

 (defn widget-model-count
@@ -424,14 +461,22 @@
               v (selection (id :vars-cbx))
               f (get vars-cbx-value-fn-map v)]
           (if n
-            (if (= v "search-all-docs")
-              {:already-filtered true
-               :string-seq (seq (sort (find-in-doc-strings
-                                      (config (id :vars-filter-tf) :text))))}
-              {:already-filtered false
-               :string-seq (seq (sort (map str (keys (f n)))))})
+            (let [already-filtered (= v "search-all-docs")
+                  string-seq (if already-filtered
+                               (find-in-doc-strings (config (id :vars-filter-tf)
+                                                            :text))
+                               (map str (keys (f n))))]
+              {:already-filtered already-filtered :string-seq string-seq})
             {:already-filtered false :string-seq []}))))
       (b/transform regx-tf-filter (id :vars-filter-tf))
+      (b/transform (fn [symbol-str-seq]
+        (if @group-vars-by-object-type
+          (let [n-s (selection (id :ns-lb))
+                n (and n-s (find-ns (symbol n-s)))
+                v (selection (id :vars-cbx))
+                fqns? (#{"all-publics" "search-all-docs"} v)]
+            (group-by-object-type symbol-str-seq fqns? n-s))
+          symbol-str-seq)))
       (b/notify-soon)
       (b/property (id :vars-lb) :model))
     ;;


Print ajax response, debugging for #183

Print ajax response, debugging for #183

--- src/cljs/clojuredocs/ajax.cljs
+++ src/cljs/clojuredocs/ajax.cljs
@@ -67,6 +67,8 @@
                          (-> headers
                              (get "Content-Type"))
                          "")
+        _ (.log js/console (str "AJAX CONTENT TYPE " (pr-str content-type)))
+        _ (.log js/console (str "HEADERS " (pr-str headers)))
         body (condp #(re-find %1 %2) content-type
                #"application/json" (-> body
                                        json-parse


fix subdb process

fix subdb process

--- src/cljs/sm/sources/subdb.cljs
+++ src/cljs/sm/sources/subdb.cljs
@@ -80,6 +80,12 @@
     (download hash language version))
   (subtitle-language [_] language))

+(defn process-search-result [languages query-languages hash]
+  (comp (filter #(languages (:language %)))
+        (mapcat (partial expand-result hash))
+        (map #(update-in % [:language] (partial normalize-language query-languages)))
+        (map map->SubDBSubtitle)))
+
 (defrecord SubDBSource []
   INamed
   (-name [_] "SubDB")
@@ -91,13 +97,11 @@
   (search-subtitles [_ path languages]
     (go-catch
       (let [query-languages (mapv (fn [x] (.replace x "pb" "pt")) languages)
-            lang-set (set query-languages)
             hash (<? (hash-file path))
             results (<? (search-languages hash))]
-        (->> (filter #(lang-set (:language %)) results)
-             (mapcat (partial expand-result hash))
-             (map #(update-in % [:language] (partial normalize-language (set languages))))
-             (map map->SubDBSubtitle)))))
+        (sequence (process-search-result (set query-languages)
+                                         (set languages)
+                                         hash) results))))

   UploadProvider
   (upload-subtitle [_ path sub-path]


signal changes

signal changes

--- src/clojure2d/extra/signal.clj
+++ src/clojure2d/extra/signal.clj
@@ -79,7 +79,11 @@
   ([^Pixels p {:keys [planar? signed? little-endian? ^int bits channels coding]
                :or {planar? true little-endian? true bits 8 signed? false channels [0 1 2] coding :none}}]
    (let [channels (int-array (if (= :all channels) [0 1 2 3] channels))]
-     (Signal. (Converter/toSignal (.p p) channels (dec (>> bits 3)) little-endian? signed? planar? (coding-value coding)))))
+     (Signal. (Converter/toSignal
+               (.p p) channels
+               (dec (>> bits 3))
+               little-endian? signed? planar?
+               (coding-value coding)))))
   ([p]
    (pixels->signal p {})))

@@ -90,8 +94,13 @@
   ([^Pixels target ^Signal sig {:keys [planar? signed? little-endian? ^int bits channels coding]
                                 :or {planar? true little-endian? true bits 8 signed? false channels [0 1 2] coding :none}}]
    (let [channels (int-array (if (= :all channels) [0 1 2 3] channels))]
-     (Converter/fromSignal (.signal sig) (.p target) channels (dec (>> bits 3)) little-endian? signed? planar? (coding-value coding))
-
+     (Converter/fromSignal
+      (.signal sig)
+      (.p target)
+      channels
+      (dec (>> bits 3))
+      little-endian? signed? planar?
+      (coding-value coding))
      target))
   ([target sig]
    (signal->pixels target sig {})))


Two ways to get var "names"

Two ways to get var "names"

--- src/such/vars.clj
+++ src/such/vars.clj
@@ -11,3 +11,9 @@
   Rootable
   (has-root-value? [var] (.hasRoot var))
   (root-value [var] (alter-var-root var identity)))
+
+(defn name-as-symbol [var]
+  (:name (meta var)))
+
+(defn name-as-string [var]
+  (str (name-as-symbol var)))


Adjust main test application to execute from the project directory, not from src/test

--- src/test/main.clj
+++ src/test/main.clj
@@ -28,8 +28,7 @@
   ; Temporary: eventually we'll pass a couple of routes
   ;; into cr/initialize
   (GET "/hello" [] (cr/wrap-html hello-world))
-  ; Executes with src/test as the current directory
-  (cr/initialize "1.0" :public-folder "webapp")
+  (cr/initialize "1.0" :public-folder "src/test/webapp")
   (route/not-found "Cascade Demo: No such resource"))

 (def app


Support temporal adjusters

Support temporal adjusters

--- src/tick/core.clj
+++ src/tick/core.clj
@@ -1,7 +1,7 @@
 ;; Copyright © 2016-2017, JUXT LTD.

 (ns tick.core
-  (:refer-clojure :exclude [+ - / inc dec max min range time int long < <= > >=])
+  (:refer-clojure :exclude [+ - / inc dec max min range time int long < <= > >= next])
   (:require
    [clojure.spec.alpha :as s]
    [clojure.string :as str])
@@ -9,7 +9,7 @@
    [java.util Date]
    [java.time Clock ZoneId ZoneOffset Instant Duration Period DayOfWeek Month ZonedDateTime LocalTime LocalDateTime LocalDate Year YearMonth ZoneId OffsetDateTime OffsetTime]
    [java.time.format DateTimeFormatter]
-   [java.time.temporal ChronoUnit]))
+   [java.time.temporal ChronoUnit TemporalAdjusters]))

 (def ^{:dynamic true} *clock* nil)

@@ -218,6 +218,65 @@
   (instant [zdt] (.toInstant zdt))
   (zone [zdt] (.getZone zdt)))

+;; Adjusters
+
+(defn with
+  "Adjust a temporal with an adjuster"
+  [t adj]
+  (.with t adj))
+
+(defn day-of-week-in-month
+  ([ordinal day-of-week] (TemporalAdjusters/dayOfWeekInMonth ordinal (day day-of-week)))
+  ([t ordinal day-of-week] (with t (day-of-week-in-month ordinal day-of-week))))
+
+(defn first-day-of-month
+  ([] (TemporalAdjusters/firstDayOfMonth))
+  ([t] (with t (first-day-of-month))))
+
+(defn first-day-of-next-month
+  ([] (TemporalAdjusters/firstDayOfNextMonth))
+  ([t] (with t (first-day-of-next-month))))
+
+(defn first-day-of-next-year
+  ([] (TemporalAdjusters/firstDayOfNextYear))
+  ([t] (with t (first-day-of-next-year))))
+
+(defn first-day-of-year
+  ([] (TemporalAdjusters/firstDayOfYear))
+  ([t] (with t (first-day-of-year))))
+
+(defn first-in-month
+  ([day-of-week] (TemporalAdjusters/firstInMonth (day day-of-week)))
+  ([t day-of-week] (with t (first-in-month day-of-week))))
+
+(defn last-day-of-month
+  ([] (TemporalAdjusters/lastDayOfMonth))
+  ([t] (with t (last-day-of-month))))
+
+(defn last-day-of-year
+  ([] (TemporalAdjusters/lastDayOfYear))
+  ([t] (with t (last-day-of-year))))
+
+(defn last-in-month
+  ([day-of-week] (TemporalAdjusters/lastInMonth (day day-of-week)))
+  ([t day-of-week] (with t (last-in-month day-of-week))))
+
+(defn next
+  ([day-of-week] (TemporalAdjusters/next (day day-of-week)))
+  ([t day-of-week] (with t (next day-of-week))))
+
+(defn next-or-same
+  ([day-of-week] (TemporalAdjusters/nextOrSame (day day-of-week)))
+  ([t day-of-week] (with t (next-or-same day-of-week))))
+
+(defn previous
+  ([day-of-week] (TemporalAdjusters/previous (day day-of-week)))
+  ([t day-of-week] (with t (previous day-of-week))))
+
+(defn previous-or-same
+  ([day-of-week] (TemporalAdjusters/previousOrSame (day day-of-week)))
+  ([t day-of-week] (with t (previous-or-same day-of-week))))
+
 ;; Comparison

 (defprotocol ITimeComparison


wait for acquisition to finish.

wait for acquisition to finish.

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

--- acqEngine/src/org/micromanager/test.clj
+++ acqEngine/src/org/micromanager/test.clj
@@ -109,6 +109,7 @@

 (defn simple-test [n]
   (core startSequenceAcquisition n 0 true)
+  (while (core isSequenceRunning) (Thread/sleep 10))
   (time (dotimes [i n]
           (core popNextImage))))


CMR-3424 Clarifies comment on ACL unindexing

--- access-control-app/src/cmr/access_control/services/acl_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_service.clj
@@ -148,7 +148,7 @@
                        :revision-id (inc (:revision-id acl-concept))
                        :deleted true}
           resp (mdb/save-concept context tombstone)]
-      ;; unindexing is synchronous by default
+      ;; unindexing is synchronous
       (index/unindex-acl context concept-id)
       (info (acl-log-message context tombstone acl-concept :delete))
       resp)))


Resolved merge conflict.

Resolved merge conflict.

--- src/cmr/search/services/parameter_validation.clj
+++ src/cmr/search/services/parameter_validation.clj
@@ -11,6 +11,7 @@
             [cmr.search.services.messages.orbit-number-messages :as on-msg]
             [camel-snake-kebab :as csk])
   (:import clojure.lang.ExceptionInfo))
+

 (defn- concept-type->valid-param-names
   "A set of the valid parameter names for the given concept-type."


Use erroneously unused variables parameter

Addresses #1

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -35,6 +35,12 @@
   [java-json]
   (json/read-str (.toString (.asJsonNode java-json))))

+(defn xdm-var->str
+  "Returns a String representation of the given XDM variable"
+  [xdm-var]
+  (hash-map (.toString (.getName xdm-var))
+            (.toString (.getValue xdm-var))))
+
 (def types
   "Default mapping from MarkLogic XCC types (e.g. those that might be
   returned in a query's result set) to Clojure functions intended to
@@ -65,8 +71,7 @@
    "element()" #(.asString %) ;; XdmElement
    ;; XdmItem TODO
    "text()" #(.asString %) ;; XdmText
-   "variable()" #(hash-map (.toString (.getName %))
-                           (.asString (.getValue %))) ;; XdmVariable -- XXX unknown if the key used matches getValueType
+   "variable()" xdm-var->str ;; XdmVariable -- XXX unknown if the key used matches getValueType

    "xs:anyURI" str
    "xs:base64Binary" #(.asBinaryData %) ;; XSBase64Binary
@@ -146,7 +151,7 @@
     :timeout-millis
     :timezone})

-(defn- request-options
+(defn request-options
   "Creates a Request Options object (to pass to a Request or a
   Session) out of the given options map. See `valid-request-options`
   for supported keywords."
@@ -257,8 +262,9 @@
 (defn submit-request
   "Construct, submit, and return raw results of request for the given
   `session` using `request-factory` and `query`. Modify it
-  with (possibly empty) `options` and `variables` maps. Applies type
-  conversion according to defaults and `types`."
+  with (possibly empty) `options` and (String) `variables`
+  maps. Applies type conversion to response according to defaults and
+  `types`."
   [request-factory session query options variables types]
   (let [ro      (request-options options)
         request (reduce-kv (fn [acc vname vval]
@@ -266,7 +272,7 @@
                                               ValueType/XS_STRING (str vval))
                              acc)
                            (doto request-factory (.setOptions ro))
-                           options)]
+                           variables)]
     (cond (= :raw types) (.submitRequest session request)
           :else (convert-types (.submitRequest session request) types))))


CMR-6287: update response format and science keyword indexing. add field to response


Add stats to the 'remove-empty-paths'

Add stats to the 'remove-empty-paths'

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -571,7 +571,9 @@
 (defn- empty-paths-finder
   "Empty paths finder."
   [tree-impl pstore tpool tenant paths options]
-  (let [empty-paths (atom [])]
+  (let [empty-paths (atom [])
+        processed (atom 0)
+        non-leafs (atom 0)]
     (reify TreeProcessor
       (tp-get-title [this]
         "Checking paths")
@@ -580,11 +582,16 @@
                    (partial add-path-to-tree tree-impl)))
       (tp-process-path [this path]
         (if (t-path-leaf? tree-impl path)
-          (when-not @clog/print-log?
-            (prog/tick-by (t-get tree-impl path)))
+          (let [leafs (t-get tree-impl path)]
+            (swap! processed + leafs)
+            (when-not @clog/print-log?
+              (prog/tick-by leafs)))
           (let [spath (path-list2str path)]
-            (if (seq path)
-              (clog/info (str "Checking path: " spath)))
+            (when (seq path)
+              (swap! processed inc)
+              (swap! non-leafs inc)
+              (when-not @inspecting?
+                (clog/info (str "Checking path: " spath))))
             (when (t-path-empty? tree-impl path)
               (log/debug (str "Path '" spath "' is empty"))
               (t-delete-path tree-impl path)
@@ -594,7 +601,14 @@
       (tp-get-data [this]
         @empty-paths)
       (tp-show-stats [this]
-        ))))
+        (let [empty-count (count @empty-paths)]
+          (log/info (format "Stats: processed %s, non-leafs: %s, empty: %s"
+                            @processed @non-leafs empty-count))
+          (newline)
+          (println "Stats:")
+          (println "  Processed: " @processed)
+          (println "  Non-leafs: " @non-leafs)
+          (println "  Empty:     " empty-count))))))

 (defn- tree-walker
   "Tree walker."
@@ -621,10 +635,12 @@
         (when-not @clog/print-log?
           (prog/done))
         (let [empty-paths (tp-get-data processor)]
-          (clog/info (str "Found " (count empty-paths) " empty paths"))
+          (when @inspecting?
+            (clog/info (str "Found " (count empty-paths) " empty paths")))
           empty-paths)
         (finally
-          (tp-show-stats processor))))))
+          (when-not @inspecting?
+            (tp-show-stats processor)))))))

 (defn- remove-empty-paths-processor
   "Empty path removal processor."


get-sort-or-not-fn -> get-sort-or-dummy-fn

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -44,7 +44,7 @@
   []
   (swap! inspecting? (fn [_] true)))

-(defn- get-sort-or-not-fn
+(defn- get-sort-or-dummy-fn
   "Get sort or dummy function."
   [sort?]
   (if sort? sort #(do %)))
@@ -56,7 +56,7 @@
   (let [lookup-fn #(pstore/lookup pstore tenant leafs-only limit-depth %
                                   exclude-paths)
         sidefx-wrapper (if sidefx-fn #(do (sidefx-fn %) %) #(do %))
-        sort (get-sort-or-not-fn sort-paths?)]
+        sort (get-sort-or-dummy-fn sort-paths?)]
     (sort (map :path (map sidefx-wrapper (flatten (map lookup-fn paths)))))))

 (defn- get-paths
@@ -386,7 +386,7 @@
         from (timec/to-epoch (time/minus (time/now) (time/seconds threshold)))
         title "Checking metrics"
         paths-rollups (combine-paths-rollups paths [(first rollups)])
-        sort (get-sort-or-not-fn (:sort options))]
+        sort (get-sort-or-dummy-fn (:sort options))]
     (prog/set-progress-bar!
      "[:bar] :percent :done/:total Elapsed :elapseds ETA :etas")
     (prog/config-progress-bar! :width pbar-width)
@@ -475,7 +475,7 @@
       (dry-mode-warn options)
       (let [tpool (get-thread-pool options)
             pstore (pstore/elasticsearch-path-store es-url options)
-            sort (get-sort-or-not-fn (:sort options))
+            sort (get-sort-or-dummy-fn (:sort options))
             processed-data (process-metrics tenant rollups paths cass-hosts
                                             pstore options
                                             remove-obsolete-metrics-processor
@@ -499,7 +499,7 @@
     (let [tpool (get-thread-pool options)
           mstore (mstore/cassandra-metric-store cass-hosts options)
           pstore (pstore/elasticsearch-path-store es-url options)
-          sort (get-sort-or-not-fn (:sort options))
+          sort (get-sort-or-dummy-fn (:sort options))
           obsolete-data (->> (get-paths pstore tenant paths
                                         (:exclude-paths options)
                                         (:sort options))


Add docstring

Add docstring

--- src/discuss/integration.cljs
+++ src/discuss/integration.cljs
@@ -67,7 +67,9 @@
                        dom))
            doms))))

-(defn convert-reference [ref]
+(defn convert-reference
+  "Find parent of reference, split it into parts and wrap the original reference for highlighting and interaction."
+  [ref]
   (let [doms-raw  (.getElementsByTagName js/document "*")
         doms      (minify-doms doms-raw)
         parent    (get-parent doms ref)


New functions in config module: path-to-emender, path-to-tests

--- src/emender_service/config.clj
+++ src/emender_service/config.clj
@@ -55,6 +55,14 @@
     [request]
     (-> request :configuration :api :prefix))

+(defn path-to-emender
+    [request]
+    (-> request :configuration :emender :path))
+
+(defn path-to-tests
+    [request]
+    (-> request :configuration :emender :tests))
+
 (defn verbose?
     [request]
     (-> request :configuration :config :verbose))


Fix the normal exit

Fix the normal exit

--- src/github_changelog/cli.clj
+++ src/github_changelog/cli.clj
@@ -22,4 +22,4 @@
   (->> (read-config config-file)
        changelog
        format-tags
-       (exit 0 nil)))
+       (exit 0)))


remove unused code

remove unused code

--- src/graphql_clj/executor.clj
+++ src/graphql_clj/executor.clj
@@ -180,76 +180,3 @@
    (execute context validated-schema resolver-fn string-or-validated-document nil)))

-;; testing data
-(def test-schema
-  "enum DogCommand { SIT, DOWN, HEEL }
-
-type Dog implements Pet {
-  name: String!
-  nickname: String
-  barkVolume: Int
-  doesKnowCommand(dogCommand: DogCommand!): Boolean!
-  isHousetrained(atOtherHomes: Boolean): Boolean!
-  owner: Human
-}
-
-interface Sentient {
-  name: String!
-}
-
-interface Pet {
-  name: String!
-}
-
-type Alien implements Sentient {
-  name: String!
-  homePlanet: String
-}
-
-type Human implements Sentient {
-  name: String!
-}
-
-enum CatCommand { JUMP }
-
-type Cat implements Pet {
-  name: String!
-  nickname: String
-  doesKnowCommand(catCommand: CatCommand!): Boolean!
-  meowVolume: Int
-}
-
-union CatOrDog = Cat | Dog
-union DogOrHuman = Dog | Human
-union HumanOrAlien = Human | Alien
-
-type QueryRoot {
-  dog: Dog
-}")
-
-(def test-query-1
-  "query getDogName {
-  dog {
-    name
-  }
-}")
-
-(def test-validated-schema (-> test-schema
-                               parser/parse-schema
-                               sv/validate-schema))
-
-(defn validate-document [query-str]
-  (->> query-str
-       parser/parse-query-document
-       (qv/validate-query (second test-validated-schema))))
-
-(defn test-resolver-fn [type-name field-name]
-  (let [f (get-in {"QueryRoot" {"dog" (fn [& args]
-                                        {:name "Test Dog 1"})}}
-                  [(name type-name) (name field-name)])]
-    (if f
-      (println (f)))
-    f))
-
-;; (execute nil test-validated-schema test-resolver-fn (validate-document test-query-1) nil)
-


update show all

update show all

--- src/hivewing_core/worker.clj
+++ src/hivewing_core/worker.clj
@@ -11,9 +11,7 @@
         per-page (if (> (:per-page params) 100) 100 (:per-page params))
         page     (:page params)
         ]
-    (println params)
-    (println hive-uuid)
-    (jdbc/query sql-db ["SELECT uuid FROM workers WHERE hive_uuid = ? LIMIT ? OFFSET ?"
+    (jdbc/query sql-db ["SELECT * FROM workers WHERE hive_uuid = ? LIMIT ? OFFSET ?"
                         (ensure-uuid hive-uuid)
                         per-page
                         (* (- page 1) per-page)])))


LT UI doesn't really have a defined dir, you should be able to eval anything into it, fixes #1176

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/clients/local.cljs
+++ src/lt/objs/clients/local.cljs
@@ -63,7 +63,6 @@
 (defn init []
   (clients/handle-connection! {:name client-name
                                :tags [:client.local]
-                               :dir (files/lt-home)
                                :root-relative (files/lt-home "core")
                                :commands #{:editor.eval.cljs.exec
                                            :editor.eval.js


finished reading ch 15

finished reading ch 15

--- src/joy/ch15.clj
+++ src/joy/ch15.clj
@@ -1,4 +1,5 @@
-(ns joy.ch15)
+(ns joy.ch15
+  (:require [clojure.core.reducers :as r]))

 (set! *warn-on-reflection* true)

@@ -155,7 +156,7 @@
 (time (dotimes [_ 1e5] (factorial-d 20)))

 (factorial-d 21)
-(factorial-a 21)
+#_(factorial-a 21)

 (defn factorial-e [^double original-x]
   (loop [x original-x acc 1.0]
@@ -276,3 +277,97 @@
 (filter #(not= % 2)
         (map half
              (lazy-range 0 10 2)))
+
+(defn r-map [mapping-fn reducible]
+  (fn new-reducible [reducing-fn init]
+    (reducible ((mapping mapping-fn) reducing-fn) init)))
+
+(defn r-filter [filter-pred reducible]
+  (fn new-reducible [reducing-fn init]
+    (reducible ((filtering filter-pred) reducing-fn) init)))
+
+(def our-final-reducible
+  (r-filter #(not= % 2)
+            (r-map half
+                   (reducible-range 0 10 2))))
+
+(our-final-reducible conj [])
+
+(defn core-r-map [mapping-fn core-reducible]
+  (r/reducer core-reducible (mapping mapping-fn)))
+
+(defn core-r-filter [filter-pred core-reducible]
+  (r/reducer core-reducible (filtering filter-pred)))
+
+(reduce conj []
+        (core-r-filter #(not= % 2)
+                       (core-r-map half [0 2 4 6 8])))
+
+(defn reduce-range [reducing-fn init start end step]
+  (loop [result init i start]
+    (if (empty-range? i end step)
+      result
+      (recur (reducing-fn result i)
+             (+ i step)))))
+
+#_(defn core-reducible-range [start end step]
+  (reify protos/CollReduce
+    (coll-reduce [this reducing-fn init]
+      (reducing-range reducing-fn init start end step))
+    (coll-reduce [this reducing-fn]
+      (if (empty-range? start end step)
+        (reducing-fn)
+        (reduce-range reducing-fn start (+ start step) end step)))))
+
+#_(reduce conj []
+        (core-r-filter #(not= % 2)
+                       (core-r-map half
+                                   (core-reducible-range 0 10 2))))
+
+(reduce + [1 2 3 4 5])
+(r/fold + [1 2 3 4 5])
+
+(defn core-f-map [mapping-fn core-reducible]
+  (r/folder core-reducible (mapping mapping-fn)))
+
+(defn core-f-filter [filter-pred core-reducible]
+  (r/folder core-reducible (filtering filter-pred)))
+
+(r/fold +
+        (core-f-filter #(not= % 2)
+                       (core-f-map half
+                                   [0 2 4 6 8])))
+
+(r/fold +
+        (r/filter #(not= % 2)
+                  (r/map half
+                         [0 2 4 6 8])))
+
+(r/fold + (range 10))
+(r/fold + (r/filter odd? (range 10)))
+
+(r/fold (fn ([] 100) ([a b] (+ a b))) (range 10))
+
+(r/fold (r/monoid + (constantly 100)) (range 10))
+
+(r/fold 512
+        (r/monoid + (constantly 100))
+        +
+        (range 10))
+
+(r/fold 4 (r/monoid conj (constantly []))
+        conj (vec (range 10)))
+
+(r/fold 4 (r/monoid into (constantly []))
+        conj (vec (range 10)))
+
+(r/foldcat (r/filter even? (vec (range 1000))))
+
+(seq (r/foldcat (r/filter even? (vec (range 10)))))
+
+(def big-vector
+  (vec (range 0 (* 10 1000 1000) 2)))
+
+(time
+ (r/fold + (core-f-filter even?
+                          (core-f-map half big-vector))))


Fix sort of threads.

Fix sort of threads.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -295,7 +295,9 @@
                               (r/contains (vec (:unfollow-board-uuids follow-data)) (r/get-field row :board-uuid)))))))
          ;; Sort
          ; (if-not count (r/order-by query (order-fn :last-activity-at)) query)
-         (if-not count (r/order-by query (order-fn :created-at)) query)
+         (if-not count
+          (r/order-by query (order-fn :last-activity-at))
+          query)
          ;; Apply limit
          (if (pos? limit)
            (r/limit query limit)