Add tooltip to 'Failed Tests' Card

Add tooltip to 'Failed Tests' Card

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -167,26 +167,29 @@
        (take 10)))

 (defn- failed-tests-card [failed-tests junit-enabled?]
-  [:div.card
-   [:div.card-header
-    [:h2 "Failed Tests"]]
-   [:div.card-body.failed-tests
-    (cond
-      (not-empty failed-tests)
-      (om/build failed-tests-table failed-tests)
-
-      (false? junit-enabled?)
-      [:span "Implement test metadata to view output. Find out more in the "
-       [:a {:href "https://circleci.com/docs/1.0/test-metadata/"
-            :target "_blank"}
-        "test metadata documentation"]
-       "."]
-
-      (and (not (nil? failed-tests))
-           (empty? failed-tests))
-      [:span "No failed tests to show."]
-
-      :else (spinner))]])
+  (popover/tooltip {:placement :top-left
+                    :body "Results pulled from the last ten failed builds."
+                    :trigger-mode :click}
+    [:div.card
+     [:div.card-header
+      [:h2 "Failed Tests"]]
+     [:div.card-body.failed-tests
+      (cond
+        (not-empty failed-tests)
+        (om/build failed-tests-table failed-tests)
+
+        (false? junit-enabled?)
+        [:span "Implement test metadata to view output. Find out more in the "
+         [:a {:href "https://circleci.com/docs/1.0/test-metadata/"
+              :target "_blank"}
+          "test metadata documentation"]
+         "."]
+
+        (and (not (nil? failed-tests))
+          (empty? failed-tests))
+        [:span "No failed tests to show."]
+
+        :else (spinner))]]))

 (defn- build-status-card [chartable-builds bar-chart-builds]
   [:div.card


remove junit from advanced project settings

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -627,16 +627,6 @@
           [:article
            [:legend "Advanced Settings"]
            [:ul
-            (describe-flag {:flag :junit
-                            :title "JUnit support"
-                            :blurb [:p
-                                    "This flag enables collection of test data via junit xml or cucumber json files,"
-                                    " which we use to better display test results and make parallel builds more"
-                                    " efficient.  It also adds the necessary flags for collecting this to automatically"
-                                    " inferred ruby or python test commands, though for RSpec of Minitest you'll need"
-                                    " to add the necessary formatter gem - see "
-                                    [:a {:href "https://circleci.com/docs/test-metadata/#metadata-collection-in-custom-test-steps"}
-                                     "the docs"] " for more information."]})

             (let [pretty-vcs (utils/prettify-vcs_type (:vcs-type project))]
               (describe-flag {:flag :set-github-status


Added unit tests.

Added unit tests.

--- test/dragon/util_test.clj
+++ test/dragon/util_test.clj
@@ -4,4 +4,11 @@
             [dragon.util :as util]))

 (deftest path->date
-  (is (= (util/path->date "posts/2017-01/07-050909/content.rfc5322"))))
+  (is (= (util/path->date "posts/2017-01/07-050909/content.rfc5322")
+         {:year "2017" :month "01" :day "07"
+          :hour "05" :minute "09" :second "09"})))
+
+(deftest format-date
+  (is (= (util/format-date {:year "2017" :month "01" :day "07"
+                            :hour "05" :minute "09" :second "09"})
+         "2017-01-07 05:09:09")))


Removes datomic-extras since it is not used and causes a conflict with datomic (breaks isComponent nesting)

--- modules/datomic/project.clj
+++ modules/datomic/project.clj
@@ -6,10 +6,5 @@
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
   :dependencies [[prismatic/schema "0.2.1"]
-                 [juxt/datomic-extras "1.0.3"
-                  :exclusions [org.slf4j/slf4j-nop
-                               org.slf4j/jul-to-slf4j
-                               org.slf4j/jcl-over-slf4j
-                               org.slf4j/log4j-over-slf4j]]
                  [org.clojure/tools.reader "0.8.3"]
                  ])


test: don't look for artist name in table header

--- test/sledge/core_test.clj
+++ test/sledge/core_test.clj
@@ -62,7 +62,7 @@
   (first
    (filter #(= (tx/text (tx/find-element-under % {:class "artist"}))
                artist)
-           (tx/elements "div.results.tracks div.track"))))
+           (rest (tx/elements "div.results.tracks div.track")))))

 (deftest the-more-tests
   (testing  "search for text"


Fix typo

Fix typo

--- planck-cljs/src/planck/repl.clj
+++ planck-cljs/src/planck/repl.clj
@@ -42,7 +42,7 @@
    `(planck.repl/pst* '~e)))

 (defmacro ^:private with-err-str
-  "Evaluates exprs in a context in which *print-fn* is bound to .append
+  "Evaluates exprs in a context in which *print-err-fn* is bound to .append
   on a fresh StringBuffer.  Returns the string created by any nested
   printing calls."
   [& body]


maybe fix terminators

maybe fix terminators

--- src/oi_lang/obj.cljs
+++ src/oi_lang/obj.cljs
@@ -29,7 +29,7 @@
    send = exp <' '+> message
         | exp <' '*> op-message

-   <terminator> = <'\n'> | <';'>
+   <terminator> = <' '*> <'\n'> <' '*> | <' '*> <';'> <' '*>
    ")

 (defn reduce-arglist [& params]


using config for building mongo indexes

using config for building mongo indexes

--- src/ophion/mongo.clj
+++ src/ophion/mongo.clj
@@ -2,6 +2,7 @@
   (:require
    [clojure.string :as string]
    [taoensso.timbre :as log]
+   [ophion.config :as config]
    [monger.core :as db]
    [monger.conversion :as convert]
    [monger.collection :as mongo])
@@ -146,7 +147,8 @@

 (defn -main
   [& args]
-  (let [db (connect! {:database (or (second args) "ophion")})]
+  (let [config (config/read-config "config/ophion.clj")
+        db (connect! (get config :mongo))]
     (condp = (first args)
       "list"
       (do


Fixed namespacing omission

Fixed namespacing omission

--- src/polismath/db.clj
+++ src/polismath/db.clj
@@ -194,7 +194,7 @@
             (mc/ensure-index db c (array-map :zid 1) {:name (str c "_zid_index") :unique true})))
         ; set up rolling limit on profile data
         (let [prof-coll (mongo-collection-name "profile")]
-          (if (exists? db prof-coll)
+          (if (mc/exists? db prof-coll)
             (mc/create db (mongo-collection-name "profile") {:capped true :max 200000})))
         ; make sure to return db
         db))))


More logical ordering of relations.

More logical ordering of relations.

--- EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/weaverworld.clj
@@ -69,13 +69,9 @@
     (equals ?hierarchy (.getHierarchy ?model))))

-
-
-
-
 ;; ProgramElement hierarchy
-;; but not what we want
-;; -----------------------
+;; (but prefer not to use these)
+;; -----------------------------

 (defn
   root
@@ -158,8 +154,6 @@
 ;; Actual Reification of WeaverWorld
 ;; ---------------------------------

-
-
 (defn-
   weaverworld-typemap
   "Relation between an AspectJ weaverworld and its non-expandable TypeMap."
@@ -211,7 +205,133 @@
                                      ?set)
         ?aspect))))

+
+
+;todo:
+;filter out synthetic ones
+(defn
+  aspect-field
+  [?aspect ?field]
+  (all
+    (aspect ?aspect)
+    (contains (.getDeclaredJavaFields ?aspect) ?field)))
+
+(defn
+  aspect-method
+  [?aspect ?method]
+  (all
+    (aspect ?aspect)
+    (contains (.getDeclaredJavaMethods ?aspect) ?method)))
+
+(defn
+  aspect-declaredinterface
+  "Relation between an aspect and one of the interfaces it declares to be implementing."
+  [?aspect ?interface]
+  (all
+    (aspect ?aspect)
+    (contains (.getDeclaredInterfaces ?aspect) ?interface)))
+
+(defn
+  aspect-declaredsuper
+  "Relation between an aspect and its super class (including java.lang.Object for aspects
+   that do not declare a super aspect)."
+  [?aspect ?super]
+  (all
+    (aspect ?aspect)
+    (equals ?super (.getSuperclass ?aspect))))
+
+(defn
+  aspect-declaredsuperaspect
+  "Relation between an aspect and its declared super aspect.
+   Excludes non-aspect super types (e.g., the implicit java.lang.Object). "
+  [?aspect ?super]
+  (all
+    (aspect-declaredsuper ?aspect ?super)
+    (aspect ?super)))
+
+(defn
+  aspect-declaredsuperclass
+  "Relation between an aspect and its declared super class.
+   Excludes aspect super types."
+  [?aspect ?super]
+  (all
+    (aspect-declaredsuper ?aspect ?super)
+    (succeeds (.isClass  ?super))))
+
+
+(def
+  aspect-declaredsuper+
+  "Relation between an aspect and one of the ancestors in its declared super hierarchy."
+  (tabled
+    [?aspect ?ancestor]
+    (conde
+      [(aspect-declaredsuper ?aspect ?ancestor) ]
+      [(fresh [?inbetween]
+              (aspect-declaredsuper+ ?aspect ?inbetween)
+              (aspect-declaredsuper ?inbetween ?ancestor))])))
+
+(defn
+  aspect-declaredsuperaspect+
+  "Relation between an aspect and one of the ancestor aspects in its declared super hierarchy."
+  [?aspect ?ancestor]
+  (all
+    (aspect-declaredsuper+ ?aspect ?ancestor)
+    (aspect ?ancestor)))
+
+(defn
+  aspect-declaredsuperclass+
+  "Relation between an aspect and one of the ancestor classes in its declared super hierarchy."
+  [?aspect ?ancestor]
+  (all
+    (aspect-declaredsuper+ ?aspect ?ancestor)
+    (succeeds (.isClass  ?ancestor))))
+
+
+;todo: wantgenerics is false, check whether this is compatible with the types returned by the other predicates
+;(i.e., test with a parameterized aspec)
+(defn
+  aspect-super+
+  "Relation between an aspect and one of its direct or indirect
+   super types (classes, aspects as well as interfaces),
+   including those that stem from an intertype declaration."
+  [?aspect ?type]
+  (all
+    (!= ?type ?aspect)
+    (aspect ?aspect)
+    (contains (iterator-seq (.getHierarchy ?aspect false true)) ?type)))
+
+(defn
+  aspect-superaspect+
+  "Relation between an aspect and one of its direct or indirect
+   super aspects, including those that stem from an intertype declaration."
+  [?aspect ?type]
+  (all
+    (aspect-super+ ?aspect ?type)
+    (aspect ?type)))
+
+
+(defn
+  aspect-superinterface+
+  "Relation between an aspect and one of its direct or indirect
+   super interfaces, including those that stem from an intertype declaration."
+  [?aspect ?type]
+  (all
+    (aspect-super+ ?aspect ?type)
+    (succeeds (.isInterface ?type))))
+
+(defn
+  aspect-superclass+
+  "Relation between an aspect and one of its direct or indirect
+   super classes, including those that stem from an intertype declaration."
+  [?aspect ?type]
+  (all
+    (aspect-super+ ?aspect ?type)
+    (succeeds (.isClass ?type))))
+
+
+
 ;; Advice
+;; ------

 (defn
   aspect-advice
@@ -256,8 +376,18 @@
     (equals ?handle
             (AsmRelationshipProvider/getHandle  (-> ?aspect .getWorld .getModel) ?advice))))

+(defn
+  advice-sourcelocation
+  "Relation between an advice and its location in the source code (an ISourceLocation)."
+  [?advice ?location]
+  (all
+    (advice ?advice)
+    (equals ?location (.getSourceLocation ?advice))))
+

 ;; Intertype declarations
+;; ----------------------
+

 ;Only returned one ITD of XCutTest
 ;(defn
@@ -367,6 +497,8 @@

 ;; SourceLocation
+;; --------------
+

 (defn
   sourcelocation-filename-startline-endline-column-offset
@@ -382,14 +514,7 @@
     (equals ?offset (.getOffset ?sourcelocation))))

 ;; Pointcuts
-
-(defn
-  advice-sourcelocation
-  "Relation between an advice and its location in the source code (an ISourceLocation)."
-  [?advice ?location]
-  (all
-    (advice ?advice)
-    (equals ?location (.getSourceLocation ?advice))))
+;; ---------

 (defn
@@ -416,6 +541,7 @@

 ;; Pointcut definitions
+;; --------------------

 (defn
   aspect-pointcutdefinition
@@ -440,143 +566,6 @@

-
-;;alternatief:
-;;neem crosscuttingmembersset
-;;de keys van die map daarin (ook al is die private, kan er misschien via reflectie aan),
-;;zouden de aspecten zijn
-;;en daarna alles baseren op hun shadowmungers
-;;en de pointcut instances die zij hebben
-;;dus niet aan een resolvedtype vragen welke declarations ze hebben
-;; --> heb het getest, geen verschil
-;;--> probleem: vanuit een pointcut is het niet mogelijk om terug te gaan naar de oorspronkelijk pointcutdefinition
-;; (ald die er was) ... misschien wel via sourcelocation
-;;				IProgramElement ipe = asm.getHierarchy().findElementForSourceLine(sl);
-
-
-;todo:
-;filter out synthetic ones
-(defn
-  aspect-field
-  [?aspect ?field]
-  (all
-    (aspect ?aspect)
-    (contains (.getDeclaredJavaFields ?aspect) ?field)))
-
-(defn
-  aspect-method
-  [?aspect ?method]
-  (all
-    (aspect ?aspect)
-    (contains (.getDeclaredJavaMethods ?aspect) ?method)))
-
-(defn
-  aspect-declaredinterface
-  "Relation between an aspect and one of the interfaces it declares to be implementing."
-  [?aspect ?interface]
-  (all
-    (aspect ?aspect)
-    (contains (.getDeclaredInterfaces ?aspect) ?interface)))
-
-(defn
-  aspect-declaredsuper
-  "Relation between an aspect and its super class (including java.lang.Object for aspects
-   that do not declare a super aspect)."
-  [?aspect ?super]
-  (all
-    (aspect ?aspect)
-    (equals ?super (.getSuperclass ?aspect))))
-
-(defn
-  aspect-declaredsuperaspect
-  "Relation between an aspect and its declared super aspect.
-   Excludes non-aspect super types (e.g., the implicit java.lang.Object). "
-  [?aspect ?super]
-  (all
-    (aspect-declaredsuper ?aspect ?super)
-    (aspect ?super)))
-
-(defn
-  aspect-declaredsuperclass
-  "Relation between an aspect and its declared super class.
-   Excludes aspect super types."
-  [?aspect ?super]
-  (all
-    (aspect-declaredsuper ?aspect ?super)
-    (succeeds (.isClass  ?super))))
-
-
-(def
-  aspect-declaredsuper+
-  "Relation between an aspect and one of the ancestors in its declared super hierarchy."
-  (tabled
-    [?aspect ?ancestor]
-    (conde
-      [(aspect-declaredsuper ?aspect ?ancestor) ]
-      [(fresh [?inbetween]
-              (aspect-declaredsuper+ ?aspect ?inbetween)
-              (aspect-declaredsuper ?inbetween ?ancestor))])))
-
-(defn
-  aspect-declaredsuperaspect+
-  "Relation between an aspect and one of the ancestor aspects in its declared super hierarchy."
-  [?aspect ?ancestor]
-  (all
-    (aspect-declaredsuper+ ?aspect ?ancestor)
-    (aspect ?ancestor)))
-
-(defn
-  aspect-declaredsuperclass+
-  "Relation between an aspect and one of the ancestor classes in its declared super hierarchy."
-  [?aspect ?ancestor]
-  (all
-    (aspect-declaredsuper+ ?aspect ?ancestor)
-    (succeeds (.isClass  ?ancestor))))
-
-
-;todo: wantgenerics is false, check whether this is compatible with the types returned by the other predicates
-;(i.e., test with a parameterized aspec)
-(defn
-  aspect-super+
-  "Relation between an aspect and one of its direct or indirect
-   super types (classes, aspects as well as interfaces),
-   including those that stem from an intertype declaration."
-  [?aspect ?type]
-  (all
-    (!= ?type ?aspect)
-    (aspect ?aspect)
-    (contains (iterator-seq (.getHierarchy ?aspect false true)) ?type)))
-
-(defn
-  aspect-superaspect+
-  "Relation between an aspect and one of its direct or indirect
-   super aspects, including those that stem from an intertype declaration."
-  [?aspect ?type]
-  (all
-    (aspect-super+ ?aspect ?type)
-    (aspect ?type)))
-
-
-(defn
-  aspect-superinterface+
-  "Relation between an aspect and one of its direct or indirect
-   super interfaces, including those that stem from an intertype declaration."
-  [?aspect ?type]
-  (all
-    (aspect-super+ ?aspect ?type)
-    (succeeds (.isInterface ?type))))
-
-(defn
-  aspect-superclass+
-  "Relation between an aspect and one of its direct or indirect
-   super classes, including those that stem from an intertype declaration."
-  [?aspect ?type]
-  (all
-    (aspect-super+ ?aspect ?type)
-    (succeeds (.isClass ?type))))
-
-
-
 ;(defn
 ;  aspect-pointcut+
 ;  [?aspect ?pointcut]
@@ -584,7 +573,9 @@
 ;    (aspect ?aspect)
 ;    (contains (iterator-seq (.getPointcuts ?aspect)) ?pointcut)))

-;; Declare
+;; Declare declarations
+;; --------------------
+

 (defn
   aspect-declare
@@ -646,7 +637,6 @@

 ;; Link between World (aka weaverworld) and AJProjectModelFacade (aka xcut)
-;;

 (defn
   weaverworld-xcut
@@ -664,6 +654,8 @@
               (projectmodel/aspectj-project-models)))
     (succeeds (.hasModel ?xcut))))

+;; Shadows
+

 ;(defn
 ;  advice-shadow
@@ -702,7 +694,6 @@
                        (xcut/xcut-aje-pe ?xcut ?shadowh ?shadow)))))

-;; Shadows

 ;;todo:
@@ -722,6 +713,8 @@
   (damp.ekeko/ekeko* [?aspect ?pointcut] (aspect-pointcutdefinition ?aspect ?pointcut))

   (damp.ekeko/ekeko* [?advice] (advice ?advice))
+
+  (damp.ekeko/ekeko* [?advice ?location] (advice-sourcelocation ?advice ?location))

   (damp.ekeko/ekeko* [?advice ?pointcut]  (advice-pointcut ?advice ?pointcut))


Replace two further uses of :id.

Replace two further uses of :id.

--- src/re_com/tabs.cljs
+++ src/re_com/tabs.cljs
@@ -25,7 +25,7 @@
   {:pre [(validate-args-macro tabs-args-desc args "tabs")]}
   (let [current  (deref-or-value model)
         tabs     (deref-or-value tabs)
-        _        (assert (not-empty (filter #(= current (:id %)) tabs)) "model not found in tabs vector")]
+        _        (assert (not-empty (filter #(= current (id-fn %)) tabs)) "model not found in tabs vector")]
     [:ul
      {:class "rc-tabs nav nav-tabs noselect"
       :style (flex-child-style "none")}
@@ -50,7 +50,7 @@
   [& {:keys [model tabs on-change id-fn label-fn vertical?]}]
   (let [current  (deref-or-value model)
         tabs     (deref-or-value tabs)
-        _        (assert (not-empty (filter #(= current (:id %)) tabs)) "model not found in tabs vector")]
+        _        (assert (not-empty (filter #(= current (id-fn %)) tabs)) "model not found in tabs vector")]
     [:div
      {:class (str "rc-tabs noselect btn-group" (if vertical? "-vertical"))
       :style (flex-child-style "none")}


riemann.time: log exceptions using standard format.

--- src/riemann/time.clj
+++ src/riemann/time.clj
@@ -152,8 +152,7 @@
             (try
               (run task)
               (catch Throwable t
-                (warn "running task threw"
-                  (with-out-str (clojure.stacktrace/print-stack-trace t)))))
+                (warn t "running task threw")))
             (when-let [task' (succ task)]
               ; Schedule the next task.
               (schedule-sneaky! task')))
@@ -166,8 +165,7 @@
           ; No task available; park for a bit and try again.
           (LockSupport/parkNanos (ceil (* 1000000000 park-interval)))))
       (catch Throwable t
-        (warn "caught"
-              (with-out-str (clojure.stacktrace/print-stack-trace t)))))))
+        (warn t "riemann.time task threw")))))

 (defn stop!
   "Stops the task threadpool. Waits for threads to exit."


riemann.time: minor formatting & notes

riemann.time: minor formatting & notes

--- src/riemann/time.clj
+++ src/riemann/time.clj
@@ -9,8 +9,8 @@
         clojure.tools.logging))

 (defn unix-time-real
-  "The current unix epoch time in seconds, taken from System/currentTimeMillis."
-
+  "The current unix epoch time in seconds, taken from
+  System/currentTimeMillis."
   []
   (/ (System/currentTimeMillis) 1000))

@@ -68,6 +68,7 @@
     (fn [a b] (compare [(:t a) (:id a)]
                        [(:t b) (:id b)]))))

+; Processor-dependent threadpool sizing will happen. It's on the list. ;-)
 (def thread-count 4)
 (def park-interval 0.1)
 (def threadpool (atom []))


(SERVER-876) Update assertion to test for nil in non-catalog routes

--- test/unit/puppetlabs/services/master/master_core_test.clj
+++ test/unit/puppetlabs/services/master/master_core_test.clj
@@ -94,7 +94,7 @@
                :head ["file_bucket_file"]}
               path paths]
         (let [resp (request method (str "/v3/" path "/bar"))]
-          (is (= "wtf-no-code-id" (get-in resp [:request :params "code_id"] "wtf-no-code-id"))))))))
+          (is nil? (get-in resp [:request :params "code_id"])))))))

 (defn assert-failure-msg
   "Assert the message thrown by validate-memory-requirements! matches re"


Removed up :import and used play-clj pixmap-format

--- pixel-ship-play-clj/desktop/src-common/pixel_ship_play_clj/core.clj
+++ pixel-ship-play-clj/desktop/src-common/pixel_ship_play_clj/core.clj
@@ -1,10 +1,9 @@
 (ns pixel-ship-play-clj.core
-  (:require [play-clj.core :refer [bundle clear! color defgame defscreen key-code
-                                   pixmap* pixmap! render! set-screen! shape stage update!]]
+  (:require [play-clj.core :refer [bundle clear! color defgame defscreen key-code pixmap*
+                                   pixmap! pixmap-format render! set-screen! shape stage update!]]
             [play-clj.g2d :refer [texture]]
             [pixel-ships.core :as psc :refer [create-pixel-ship color-pixel-ship]]
-            [pixel-ships.bollinger :as bollinger :refer [model]])
-  (:import [com.badlogic.gdx.graphics Pixmap Texture TextureData Pixmap$Format]))
+            [pixel-ships.bollinger :as bollinger :refer [model]]))

 (declare create-pixel-ship-play-clj custom-shape play-clj-color hsv-to-rgb change-ship draw-rect-pixelmap)

@@ -37,7 +36,7 @@
    (create-pixel-ship-texture (rand-int Integer/MAX_VALUE)))
   ([seed]
    (let [pixel-map-list (create-pixel-map-list seed)
-         pix-map (pixmap* 16 16 Pixmap$Format/RGBA8888)]
+         pix-map (pixmap* 16 16 (pixmap-format :r-g-b-a8888))]
      (doseq [pixel pixel-map-list] (draw-rect-pixelmap pix-map pixel))
      (texture pix-map))))


export adjudicators

export adjudicators

--- src/tango/export.clj
+++ src/tango/export.clj
@@ -8,13 +8,105 @@
             [clojure.data.xml :as xml]
             [clojure.xml :as cxml]
             [clojure.zip :as zip]
-            [clojure.data.zip.xml :as zx]))
+            [clojure.data.zip.xml :as zx]
+            ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; AdjPanelList/AdjList
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn make-adjudicator-node [adjudicator-infos]
+  (let [name (:adjudicator/name adjudicator-infos)
+        id (:adjudicator/id adjudicator-infos)
+        country (:adjudicator/country adjudicator-infos)]
+    (xml/element :Adjudicator {:Seq (dec id)
+                               :Name name
+                               :Country country})
+    ))
+
+(defn make-adj-list-node [query-result]
+  (let [adjudicator-infos (map first query-result)]
+    (xml/element
+      :AdjList
+      {:Qty (count adjudicator-infos)}
+      (map make-adjudicator-node (sort-by :adjudicator/id adjudicator-infos)))
+    ))
+
+(defn export-adj-list [db]
+  (let [query-result (d/q '[:find (pull ?id [*])
+                            :where
+                            [?id :adjudicator/id]] db)]
+    (make-adj-list-node query-result)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; AdjPanelList/PanelList
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn make-panel-adj-node [query-result seq-number]
+  (xml/element
+    :PanelAdj
+    {:Seq seq-number
+     :AdjNumber (:adjudicator/id query-result)}))
+
+(defn make-panel-node [panel seq-number]
+  (let [adjudicator-infos (:adjudicator-panel/adjudicators panel)]
+    (xml/element
+      :Panel
+      {:Seq seq-number
+       :Qty (count adjudicator-infos)}
+      (reduce
+        (fn [state adj-info] (conj state (make-panel-adj-node adj-info (count state))))
+        []
+        adjudicator-infos))))
+
+(defn make-panel-list-node [adjudicator-panels]
+  (xml/element
+    :PanelList
+    {:Qty (count adjudicator-panels)}
+    (reduce (fn [elements panel]
+              (conj elements (make-panel-node panel (count elements))))
+            []
+            adjudicator-panels)
+  ))
+
+(defn export-panel-list [db]
+  (let [adjudicator-panels
+        (map first (d/q '[:find (pull ?id [{:adjudicator-panel/adjudicators
+                                            [:adjudicator/id]}])
+                          :where
+                          [?id :adjudicator-panel/id]] db))]
+    (make-panel-list-node adjudicator-panels)
+    ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; AdjPanelList
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn export-adj-panel-list [db]
+  (xml/element
+    :AdjPanelList
+    {}
+    (export-adj-list db)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utils
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn get-db [data]
+  (let [clean-data (uidb/sanitize data)
+        conn (d/create-conn uidb/schema)]
+    (d/transact! conn [clean-data])
+    (d/db conn)))
+
+(defn export-dance-perfect [db]
+  (xml/element
+      :DancePerfect
+      {:Version "4.1"}
+      [(export-adj-panel-list db)
+       (export-panel-list db)]
+      ))

 (defn export [data]
-  (let [clean-data (uidb/sanitize data)
-        db (d/create-conn uidb/schema)]
-    (d/transact! db [clean-data])
+  (let [db (get-db data)]
+    (export-dance-perfect db)
     ))
-(export u/expected-small-example)

+(xml/indent-str
+  (export u/expected-small-example))


Moved the nil-if-empty generator helper function to cmr-common

--- src/cmr/common/test/test_check_ext.clj
+++ src/cmr/common/test/test_check_ext.clj
@@ -55,6 +55,14 @@
   "Returns either nil or the given generator. This should be used for optional fields"
   [generator]
   (gen/one-of [(gen/return nil) generator]))
+
+(defn nil-if-empty
+  "Creates a generator that takes another sequence generator. If the sequence produced is empty then
+  a nil value will be returned"
+  [gen]
+  (gen/fmap #(when (not (empty? %))
+               %)
+            gen))

 (defn model-gen
   "Creates a generator for models. Takes the constructor function for the model and generators


:smirk: tweak test so it won't have to be rewritten if we change max-results-rows

--- test/metabase/driver/generic_sql/query_processor_test.clj
+++ test/metabase/driver/generic_sql/query_processor_test.clj
@@ -4,6 +4,7 @@
             [colorize.core :as color]
             [expectations :refer :all]
             [metabase.driver :as driver]
+            [metabase.driver.query-processor :refer [max-result-rows]]
             [metabase.test-data :refer [db-id table->id field->id]]))

 ;; # ERROR RESPONSES
@@ -11,7 +12,7 @@
 ;; Check that we get an error response formatted the way we'd expect
 (expect
     {:status :failed
-     :error "Column \"CHECKINS.NAME\" not found; SQL statement:\nSELECT \"CHECKINS\".* FROM \"CHECKINS\" WHERE (\"CHECKINS\".\"NAME\" = ?) LIMIT 10000"}
+     :error (format "Column \"CHECKINS.NAME\" not found; SQL statement:\nSELECT \"CHECKINS\".* FROM \"CHECKINS\" WHERE (\"CHECKINS\".\"NAME\" = ?) LIMIT %d" max-result-rows)}
   ;; This will print a stacktrace. Better to reassure people that that's on purpose than to make people question whether the tests are working
   (do (log/info (color/green "NOTE: The following stacktrace is expected <3"))
       (driver/process-query {:database @db-id


delete old lookup maintenance code

delete old lookup maintenance code

--- src/er_cassandra/model/alia/upsert.clj
+++ src/er_cassandra/model/alia/upsert.clj
@@ -167,105 +167,6 @@
        (stream/realize-each)
        (stream/reduce into [])))

-;; (s/defn upsert-lookups-for-table
-;;   [session :- ModelSession
-;;    entity :- Entity
-;;    table :- t/LookupTableSchema
-;;    old-record :- t/MaybeRecordSchema
-;;    record :- t/MaybeRecordSchema
-;;    opts :- fns/UpsertUsingOnlyOptsWithTimestampSchema]
-;;   (with-context deferred-context
-;;     (mlet
-;;       [:let [uber-key (t/uber-key entity)
-;;              uber-key-value (t/extract-uber-key-value entity record)]
-;;        lookup-records (->> (l/generate-lookup-records-for-table
-;;                             session entity table old-record record)
-;;                            combine-responses)
-;;        acquire-responses (->> (for [lr lookup-records]
-;;                                 (upsert-index-record
-;;                                  session
-;;                                  entity
-;;                                  table
-;;                                  lr
-;;                                  opts))
-;;                               combine-responses)]
-;;       (return acquire-responses))))
-
-;; (s/defn upsert-lookups
-;;   [session :- ModelSession
-;;    entity :- Entity
-;;    old-record :- t/MaybeRecordSchema
-;;    record :- t/MaybeRecordSchema
-;;    opts :- fns/UpsertUsingOnlyOptsWithTimestampSchema]
-;;   (with-context deferred-context
-;;     (mlet [all-acquire-responses (->> (for [t (t/mutable-lookup-tables entity)]
-;;                                         (upsert-lookups-for-table
-;;                                          session
-;;                                          entity
-;;                                          t
-;;                                          old-record
-;;                                          record
-;;                                          opts))
-;;                                       combine-responses)]
-;;       (return
-;;        (apply concat all-acquire-responses)))))
-
-;; (s/defn copy-unique-keys
-;;   [entity :- Entity
-;;    from :- t/MaybeRecordSchema
-;;    to :- t/MaybeRecordSchema]
-;;   (let [unique-key-tables (:unique-key-tables entity)]
-;;     (reduce (fn [r t]
-;;               (let [key-col (last (:key t))]
-;;                 (assoc r key-col (get from key-col))))
-;;             to
-;;             unique-key-tables)))
-
-;; (s/defn update-secondaries-and-lookups
-;;   "update non-LWT secondary and lookup entries"
-
-;;   [session :- ModelSession
-;;    entity :- Entity
-;;    old-record :- t/MaybeRecordSchema
-;;    updated-record-with-keys :- t/MaybeRecordSchema
-;;    opts :- fns/UpsertOptsWithTimestampSchema]
-;;   (with-context deferred-context
-;;     (mlet [:let [index-delete-opts (-> opts
-;;                                        fns/upsert-opts->using-only
-;;                                        fns/upsert-opts->delete-opts)
-;;                  index-insert-opts (-> opts
-;;                                        fns/upsert-opts->using-only)]
-
-;;            stale-secondary-responses (alia.delete/delete-stale-secondaries
-;;                                       session
-;;                                       entity
-;;                                       old-record
-;;                                       updated-record-with-keys
-;;                                       index-delete-opts)
-
-;;            stale-lookup-responses (alia.delete/delete-stale-lookups
-;;                                    session
-;;                                    entity
-;;                                    old-record
-;;                                    updated-record-with-keys
-;;                                    index-delete-opts)
-
-;;            secondary-reponses (upsert-secondaries
-;;                                session
-;;                                entity
-;;                                old-record
-;;                                updated-record-with-keys
-;;                                index-insert-opts)
-
-;;            lookup-responses (upsert-lookups
-;;                              session
-;;                              entity
-;;                              old-record
-;;                              updated-record-with-keys
-;;                              index-insert-opts)]
-
-;;       (return updated-record-with-keys))))
-
 (s/defn change-lookup
   [session :- ModelSession
    entity :- Entity


only got part way throgh 10.1, need to debug

--- src/joy/ch11.clj
+++ src/joy/ch11.clj
@@ -1 +1,43 @@
-(ns joy.ch11)
+(ns joy.ch11
+  (:require (clojure [xml :as xml]))
+  (:require (clojure [zip :as zip]))
+  (:import (java.util.regex Pattern)))
+(time (let [x (future (do (Thread/sleep 5000)
+                          (+ 41 1)))]
+        [@x @x]))
+
+(defn feed->zipper [uri-str]
+  (->> xml/parse uri-str)
+  zip/xml-zip)
+
+(defn normalize [feed]
+  (if (= :feed (:tag (first feed)))
+    feed
+    (zip/down feed)))
+
+(defn feed-children [uri-str]
+  (->> uri-str
+       feed->zipper
+       normalize
+       zip/children
+       (filter (comp #{:item :entry} :tag))))
+
+(defn title [entry]
+  (some->> entry
+           :content
+           (some #(when (= :title (:tag %)) %))
+           :content
+           first))
+
+(defn count-text-task [extractor txt feed]
+  (let [items (feed-children feed)
+        re (Pattern/compile (str "(?i" txt ))]
+    (->> items
+         (map extractor)
+         (mapcat #(re-seq re %))
+         count)))
+
+(count-text-task
+ title
+ "Erlang"
+ "http://feeds.feedburner.com/ElixirLang")


CMR-3093: fixed the description of the test

--- umm-spec-lib/test/cmr/umm_spec/test/location_keywords.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/location_keywords.clj
@@ -25,7 +25,7 @@
           actual (lk/find-shortest-spatial-keyword-map (:spatial-keywords lkt/sample-keyword-map) keyword-map)]
       (is (= expected actual))))

-  (testing "Looking up a non-existing root keyword-map returns the top hierarchy result."
+  (testing "Looking up a non-existing root keyword-map returns the keyword-map"
     (let [keyword-map {:category "CONTINENT", :type "UNKNOWN"}
           context lkt/setup-context-for-test
           expected {:category "CONTINENT", :type "UNKNOWN"}


Get rid of `:repl-options {:init (go)}`

Get rid of `:repl-options {:init (go)}`

Just starting a REPL should not start the system, otherwise it becomes
impossible to run multiple repls in parallel. Chestnut has always had an extra
step to kick things into gear (before: `(run)`, now: `(go)`), and I think that's
the better way to do things.

--- src/leiningen/new/chestnut/project.clj
+++ src/leiningen/new/chestnut/project.clj
@@ -34,10 +34,9 @@
   :main {{{project-ns}}}.application

   ;; nREPL by default starts in the :main namespace, we want to start in `user`
-  ;; because that's where our development helper functions like (run) and
+  ;; because that's where our development helper functions like (go) and
   ;; (browser-repl) live.
-  :repl-options {:init-ns user
-                 :init (go)}
+  :repl-options {:init-ns user}

   :cljsbuild {:builds
               [{:id "app"


add cljs.analyzer.api/get-js-index

add cljs.analyzer.api/get-js-index

--- src/main/clojure/cljs/analyzer/api.clj
+++ src/main/clojure/cljs/analyzer/api.clj
@@ -57,6 +57,13 @@
   ([] (get-options env/*compiler*))
   ([state]
    (get @state :options)))
+
+(defn get-js-index
+  "Return the currently computed Google Closure js dependency index from the
+  compiler state."
+  ([] (get-options env/*compiler*))
+  ([state]
+   (get @state :js-dependency-index)))

 (defn analyze
   "Given an environment, a map containing {:locals (mapping of names to bindings), :context


Add styling point for layers

Add styling point for layers

--- src-cljs/frontend/svg.cljs
+++ src-cljs/frontend/svg.cljs
@@ -13,7 +13,8 @@
                                                   (get-in layer [:offset :y]))
                   layer)]
     (merge
-     {:x             (:layer/start-x layer)
+     {:className     (when shape? "layer")
+      :x             (:layer/start-x layer)
       :y             (:layer/start-y layer)
       :width         (- (or (:layer/current-x layer)
                             (:layer/end-x layer)) (:layer/start-x layer))


ДОбавление кнопок быстрого смещения интервала времени в компонент выбора интервала времени select_date_time_interval

--- radiolamp-6P3S/src/r6p3s/cpt/select_datetime_interval.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/select_datetime_interval.cljs
@@ -9,6 +9,7 @@
    [r6p3s.ui.button :as button]
    [r6p3s.ui.glyphicon :as glyphicon]
    [r6p3s.ui.form-group :as form-group]
+   [r6p3s.ui.datetime :as datetime]

    [r6p3s.cpt.modal :as modal]
    [r6p3s.cpt.input :as input]
@@ -37,7 +38,25 @@
   (:interval app))

+(defn- add-time [date time]
+  (-> date .getTime (+ time ) (js/Date.)))

+
+(defn move-interval [time app]
+  (-> app
+      (update-in [:interval :from-date] add-time time)
+      (update-in [:interval :to-date  ] add-time time)))
+
+
+(defn move-to-now [app]
+  (let [now (js/Date.)
+        int (or (- (.getTime (get-in app [:interval :to-date  ] now))
+                   (.getTime (get-in app [:interval :from-date] now)))
+                (* 1000 60 60 30))]
+    (-> app
+        (assoc-in [:interval :from-date]
+                  (-> now .getTime (- int) (js/Date.)))
+        (assoc-in [:interval :to-date] now))))

 (defn interval-as-string [from-date to-date]
@@ -49,69 +68,106 @@

 (defn component [app own {:keys [on-selected-fn] :as opts}]
-  (reify
-    om/IRender
-    (render [_]
-      (let [app-v                       @app
-            {:keys [from-date to-date]} (get-selected app-v)
-            app-modal                   (app :modal)]
-        (dom/div #js {:className "well well-sm"
-                      :style     #js {:backgroundColor "inherit"}}
+  (letfn [(on-selected-fn-2 []
+            (when on-selected-fn (on-selected-fn)))]
+    (reify
+      om/IRender
+      (render [_]
+        (let [app-v                       @app
+              {:keys [from-date to-date]} (get-selected app-v)
+              app-modal                   (app :modal)]
+          (dom/div #js {:className "well well-sm"
+                        :style     #js {:backgroundColor "inherit"}}

-                 (button/render {:type     :default
-                                 :style    #js {:float "right"}
-                                 :on-click (fn []
-                                             (om/transact!
-                                              app-modal
-                                              (fn [app-modal]
-                                                (-> app-modal
-                                                    (set-input-datetime-value :from-date from-date)
-                                                    (set-input-datetime-value :to-date   to-date))))
-                                             (modal/show app-modal))
-                                 :text     (glyphicon/render "time")})

-                 (dom/div #js {:className "text-primary"}
-                          (dom/div #js{:style #js {:width 20 :float "left"}} "от")
-                          (c/format-date input-datetime/date-str-format from-date)
-                          (dom/br nil)
-                          (dom/div #js{:style #js {:width 20 :float "left"}} "до")
-                          (c/format-date input-datetime/date-str-format to-date))
-                 (dom/b nil "выбрано: ")
-                 (interval-as-string from-date to-date)
+                   (dom/div #js {:className "text-primary"}
+                            (dom/div #js{:style #js {:width 20 :float "left"}} "от")
+                            (datetime/render from-date)
+                            (dom/br nil)
+                            (dom/div #js{:style #js {:width 20 :float "left"}} "до")
+                            (datetime/render to-date))
+                   (dom/b nil "выбрано: ")
+                   (interval-as-string from-date to-date)
+
+
+                   (dom/div
+                    #js {:className "btn-toolbar"}
+
+                    (dom/div
+                     #js {:className "btn-group"}
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "calendar")
+                                     :on-click (fn []
+                                                 (om/transact!
+                                                  app-modal
+                                                  (fn [app-modal]
+                                                    (-> app-modal
+                                                        (set-input-datetime-value :from-date from-date)
+                                                        (set-input-datetime-value :to-date   to-date))))
+                                                 (modal/show app-modal))})
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "time")
+                                     :on-click (fn []
+                                                 (om/transact! app move-to-now)
+                                                 (on-selected-fn-2))}))
+
+                    (dom/div
+                     #js {:className "btn-group"}
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "fast-backward")
+                                     :on-click (fn []
+                                                 (om/transact! app (partial move-interval (* 1000 60 60 24 -7)))
+                                                 (on-selected-fn-2))})
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "step-backward")
+                                     :on-click (fn []
+                                                 (om/transact! app (partial move-interval (* 1000 60 60 24 -1)))
+                                                 (on-selected-fn-2))})
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "step-forward")
+                                     :on-click (fn []
+                                                 (om/transact! app (partial move-interval (* 1000 60 60 24  1)))
+                                                 (on-selected-fn-2))})
+                     (button/render {:type     :default
+                                     :text     (glyphicon/render "fast-forward")
+                                     :on-click (fn []
+                                                 (om/transact! app (partial move-interval (* 1000 60 60 24  7)))
+                                                 (on-selected-fn-2))})
+                     ))

-                 (let [from-date (get-input-datetime-value @app-modal :from-date)
-                       to-date   (get-input-datetime-value @app-modal :to-date)]
-                   (om/build modal-yes-no/component app-modal
-                             {:opts {:label "Указать интервал времени"
+                   (let [from-date (get-input-datetime-value @app-modal :from-date)
+                         to-date   (get-input-datetime-value @app-modal :to-date)]
+                     (om/build modal-yes-no/component app-modal
+                               {:opts {:label "Указать интервал времени"

-                                     :body
-                                     (dom/div
-                                      #js{:className "row"}
-                                      (om/build input-datetime/component-form-group (app-modal :from-date)
-                                                {:opts {:label      "От"
-                                                        :spec-input {:type               "datetime-local" :placeholder "yyyy-MM-ddTHH:mm"
-                                                                     :onChange-valid?-fn common-input/vldfn-not-empty-date}}})
-                                      (om/build input-datetime/component-form-group (app-modal :to-date)
-                                                {:opts {:label      "До "
-                                                        :spec-input {:type               "datetime-local" :placeholder "yyyy-MM-ddTHH:mm"
-                                                                     :onChange-valid?-fn common-input/vldfn-not-empty-date}}})
+                                       :body
+                                       (dom/div
+                                        #js{:className "row"}
+                                        (om/build input-datetime/component-form-group (app-modal :from-date)
+                                                  {:opts {:label      "От"
+                                                          :spec-input {:type               "datetime-local" :placeholder "yyyy-MM-ddTHH:mm"
+                                                                       :onChange-valid?-fn common-input/vldfn-not-empty-date}}})
+                                        (om/build input-datetime/component-form-group (app-modal :to-date)
+                                                  {:opts {:label      "До "
+                                                          :spec-input {:type               "datetime-local" :placeholder "yyyy-MM-ddTHH:mm"
+                                                                       :onChange-valid?-fn common-input/vldfn-not-empty-date}}})

-                                      (form-group/render
-                                       {:label "продолжитльность"
-                                        :body  (dom/b #js {:className "text-primary"}
-                                                      (interval-as-string from-date to-date))}))
+                                        (form-group/render
+                                         {:label "продолжитльность"
+                                          :body  (dom/b #js {:className "text-primary"}
+                                                        (interval-as-string from-date to-date))}))

-                                     :act-yes-fn
-                                     (fn []
-                                       (om/update!
-                                        app :interval
-                                        {:from-date from-date
-                                         :to-date   to-date})
-                                       (modal/hide app-modal)
-                                       (when on-selected-fn (on-selected-fn)))
-                                     }})))))))
+                                       :act-yes-fn
+                                       (fn []
+                                         (om/update!
+                                          app :interval
+                                          {:from-date from-date
+                                           :to-date   to-date})
+                                         (modal/hide app-modal)
+                                         (on-selected-fn-2))
+                                       }}))))))))


system.store has been marked to unload from ns refresh

--- core/src/cljc/hellhound/system/store.cljc
+++ core/src/cljc/hellhound/system/store.cljc
@@ -1,6 +1,5 @@
-(ns hellhound.system.store
-  (:import
-   (clojure.lang IPersistentMap)))
+(ns ^{:clojure.tools.namespace.repl/load false} hellhound.system.store)
+

 (defn valid-system?
   [value]
@@ -8,10 +7,12 @@
     (nil? value) false
     :else true))

+
 ;; Main storage for system data.
-(def system
+(defonce system
   (atom {}
         :validator valid-system?))
+

 (defn get-system
   "A shortcut function for derefing `system`."
@@ -21,5 +22,5 @@

 (defn set-system!
   "Sets the system of HellHound."
-  [^IPersistentMap system-map]
+  [system-map]
   (reset! system system-map))


warn when shard-set returns nil

warn when shard-set returns nil

--- elephantdb-server/src/clj/elephantdb/common/domain.clj
+++ elephantdb-server/src/clj/elephantdb/common/domain.clj
@@ -367,10 +367,10 @@
     (if (.exists remote-fs (h/path remote-path))
       (do
         (try
-          (log/info (format "Copying %s to %s." remote-path local-path))
+          (log/info (format "Copying %s to %s" remote-path local-path))
           (transfer/rcopy remote-fs remote-path local-path
                           :throttle throttle)
-          (log/info (format "Copied %s to %s." remote-path local-path))
+          (log/info (format "Copied %s to %s" remote-path local-path))
           (catch Throwable e
             (log/error (format "Error transferring shard %s to %s: %s" remote-path local-path e))
             (throw e))))
@@ -383,10 +383,15 @@
   agent with the optional `:throttle` keyword argument."
   [domain version]
   (let [local-store  (.localStore domain)
-        version-path (.createVersion local-store version)]
+        version-path (.createVersion local-store version)
+        shards (shard-set domain)]
+    (when (nil? shards)
+      (log/warning
+       (format
+        "shard-set returned nil; no shards to download. Verify that %s is included in the :hosts key of the global configuration map"
+        (.hostname domain))))
     (try
-      (u/do-pmap (partial transfer-shard! domain version)
-                 (shard-set domain))
+      (u/do-pmap (partial transfer-shard! domain version) shards)
       (.succeedVersion local-store version-path)
       (catch Throwable e
         (log/error (format "Error transferring version %s: %s" version-path e))


Slight changes to mode protocol.

Slight changes to mode protocol.

--- src/org/playasophy/wonderdome/mode.clj
+++ src/org/playasophy/wonderdome/mode.clj
@@ -4,13 +4,13 @@
 (defprotocol Mode
   "A protocol for visualizations running on the Wonderdome."

-  (update!
+  (update
     [mode dt events]
-    "Computes an updated mode state from the current state, an elapsed time in
-    millseconds, and a sequence of input events.")
+    "Computes an updated mode state from an elapsed time in millseconds and a
+    sequence of input events. Returns the new state.")

-  (render-pixel
-    [mode coordinates]
+  (render
+    [mode pixel]
     "Queries the mode for the color which should be assigned to a given pixel.
-    The coordinates are a map which gives the strip and pixel index, along with
-    the radial coordinates assigned to the pixel by the layout."))
+    The pixel is a map which gives the strip and pixel index, along with the
+    spherical and cartesian coordinates assigned to the pixel by the layout."))


format interaction with 1 interactor as Interaction involving x

--- src/wb_es/datomic/data/interaction.clj
+++ src/wb_es/datomic/data/interaction.clj
@@ -40,7 +40,10 @@

                )
        (sort)
-       (clojure.string/join " : ")))
+       (#(case (count %)
+           0 nil
+           1 (format "Interaction involving %s" (first %))
+           (clojure.string/join " : " %)))))

 (deftype Interaction [entity]
   data-util/Document


added img, tab_info and html fields to the required fields list

--- src/bitfondue/handler.clj
+++ src/bitfondue/handler.clj
@@ -61,8 +61,11 @@
   (log/debug "received a request")
   (spit "validated_request.edn" (b/validate (:params request)
                                             :username v/required
-                                            :email v/required))
 )
+                                            :email    v/required
+                                            :img      v/required
+                                            :tab_info v/required
+                                            :html     v/required))

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


Set min and max interval on query terms

Set min and max interval on query terms

--- src/cljs/cglossa/search_inputs/cwb/impl/extended.cljs
+++ src/cljs/cglossa/search_inputs/cwb/impl/extended.cljs
@@ -1,4 +1,6 @@
 (ns cglossa.search-inputs.cwb.impl.extended
+  "Implementation of search view component with text inputs, checkboxes
+  and menus for easily building complex and grammatically specified queries."
   (:require [clojure.string :as str]))

 (defn- combine-regexes [regexes]
@@ -22,42 +24,52 @@
 (defn- multiword-term [term]
   )

-(defn- split-query [query]
+(defn split-query [query]
   (let [terms (re-seq terms-regex query)]
     (if (str/blank? terms)
       ["[]"]
       terms)))

-(defn- construct-query-terms [parts]
-  (for [item parts]
-    (condp re-matches (first item)
-      interval (let [values (second item)
-                     min    (some->> values
-                                     (re-find #"(\d+),")
-                                     last)
-                     max    (some->> values
-                                     (re-find #",(\d+)")
-                                     last)]
-                 [min max])
-      attribute-value (let [attrs (str/split (last item) #"\s*&\s*")]
-                        (reduce (fn [m attr]
-                                  (let [[_ name val]
-                                        (re-find #"\(?(\S+)\s*=\s*\"(\S+)\"" attr)]
-                                    (case name
-                                      ("word" "lemma" "phon")
-                                      (cond-> (assoc m :word val)
-                                              (= name "lemma") (assoc :lemma? true)
-                                              (= name "phon") (assoc :phon? true)
-                                              (re-find #"\.\+$" val) (assoc :start? true)
-                                              (re-find #"^\.\+" val) (assoc :end? true))
+(defn- process-attr [term attr]
+  (let [[_ name val] (re-find #"\(?(\S+)\s*=\s*\"(\S+)\"" attr)]
+    (case name
+      ("word" "lemma" "phon")
+      (cond-> (assoc term :word val)
+              (= name "lemma") (assoc :lemma? true)
+              (= name "phon") (assoc :phon? true)
+              (re-find #"\.\+$" val) (assoc :start? true)
+              (re-find #"^\.\+" val) (assoc :end? true))

-                                      "pos"
-                                      (assoc m :pos val)
+      "pos"
+      (assoc term :pos val)

-                                      ;; default
-                                      (update-in m [:features] assoc name val))))
-                                {}
-                                attrs))
-      quoted-or-empty-term (.log js/console "quoted-or-empty")
-      "hei")))
+      ;; default
+      (update-in term [:features] assoc name val))))

+
+(defn construct-query-terms [parts]
+  ;; Use an atom to keep track of interval specifications so that we can set
+  ;; them as the value of the :minmax key in the map representing the following
+  ;; query term.
+  (let [minmax (atom [nil nil])]
+    (reduce (fn [terms part]
+              (condp re-matches (first part)
+                interval (let [values (second part)
+                               min    (some->> values
+                                               (re-find #"(\d+),")
+                                               last)
+                               max    (some->> values
+                                               (re-find #",(\d+)")
+                                               last)]
+                           (reset! minmax [min max])
+                           terms)
+                attribute-value (let [attrs (str/split (last part) #"\s*&\s*")
+                                      term  (as-> {} $
+                                                  (reduce process-attr $ attrs)
+                                                  (assoc $ :minmax @minmax))]
+                                  (reset! minmax [nil nil])
+                                  (conj terms term))
+                quoted-or-empty-term (.log js/console "quoted-or-empty")
+                "hei"))
+            []
+            parts)))


Add docstrings to logging system and add per-app log levels

Also, what stream or channel to log to is abstracted away in a LogWriter
protocol.

--- systems/logging/src/containium/systems/logging.clj
+++ systems/logging/src/containium/systems/logging.clj
@@ -3,23 +3,53 @@
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

 (ns containium.systems.logging
+  "A logging system for containium systems and modules.
+
+  The modules simply use the Logging interface, and use the level
+  macros, such as `info` and `warn`, for logging on the returned
+  AppLogger.
+
+  Systems have some more options. The AppLogger interface can be used
+  directly, just as a module would. But they can also add more
+  LogWriter instances, called sessions, which receive all console
+  logging. LogWriter is an abstraction around types that can write a
+  line to some stream or channel.
+
+  Furthermore, systems can create CommandLogger instances, which are
+  used by (other) systems for logging messages to only the caller of
+  the command.
+
+  Finally, the SystemLogger interface allows for setting the log-level
+  per module. This overrides the global log-level, although the timbre
+  compile-time level (if set) still takes precedence."
   (:require [containium.systems :refer (Startable Stoppable)]
             [containium.systems.config :refer (Config get-config)]
-            [taoensso.timbre :as timbre])
+            [taoensso.timbre :as timbre]
+            [clojure.string :refer (upper-case)])
   (:import [java.io PrintStream]))

 ;;; Public API for apps

 (defprotocol Logging
-  (get-logger [this app-name]))
+  (get-logger [this app-name]
+    "Retrieve a logger for a module. This returns an AppLogger instance,
+    which can be used to log messages to the console. The most
+    convenient way of logging is calling one of the level macros, such
+    as `info` or `warn`."))

 (defprotocol AppLogger
-  (log-console [this level msg] [this level ns msg]))
+  (log-console [this level msg] [this level ns msg]
+    "Log the given message on the given level. Optionally one can supply
+    the namespace the log statment is executed in. This is done
+    automatically by the level macros, such as `info` and `warn`."))

 (defmacro log*
+  "Used by the level macros and calls the `log-console` function with
+  the namespace the macro is compiled in. It is not recommended to
+  call this directly."
   [app-logger level & vals]
   (let [ns (str *ns*)]
     `(log-console ~app-logger ~level ~ns (apply str (interpose " " [~@vals])))))
@@ -32,49 +62,95 @@
            `(log* ~app-logger# ~~level ~@vals#))))

+(defn refer-logging
+  "Shorthand for:
+  (require
+    '[containium.systems.logging :as logging
+      :refer (trace debug info warn error fatal report)])"
+  []
+  (require
+   '[containium.systems.logging :as logging
+     :refer (trace debug info warn error fatal report)]))
+
+
 ;;; Systems API for systems

 (defprotocol SystemLogger
-  (add-session [this out])
-  (remove-session [this out])
-  (get-command-logger [this out]))
+  (add-session [this log-writer]
+    "Add a LogWriter to the console sessions. Make sure the underlying
+    stream IO is buffered, so it does not hinder the logging. The
+    following classes are already extending LogWriter: PrintStream.")
+
+  (remove-session [this log-writer]
+    "Removes a LogWriter from the console sessions.")
+
+  (get-command-logger [this log-writer]
+    "Creates a CommandLogger instance, which can be used for logging
+    messages to only the command invoker (i.e., to the given
+    LogWriter), or both the console and command invoker.")
+
+  (set-level [this app-name level]
+    "Overrides the currently set log-level of timbre for a logger
+    retrieved using the Logging protocol. If the level argument is
+    nil, the override is removed."))
+

 (defprotocol CommandLogger
-  (log-command [this level msg])
-  (log-all [this level msg]))
+  (log-command [this level msg]
+    "Log a message to the caller of the command.")
+
+  (log-all [this level msg]
+    "Log a message to both the caller of the command and the console
+    sessions."))
+
+
+(defprotocol LogWriter
+  (write-line [this line]))

 ;;; Default implementation

+(extend-type java.io.PrintStream
+  LogWriter
+  (write-line [^PrintStream this line]
+    (.println this line)))
+
+
 (defn mk-appender
-  [sessions-atom prefix ^PrintStream out]
+  [sessions-atom prefix log-writer]
   {:timestamp-pattern "yyyy-MMM-dd HH:mm:ss ZZ"
    :appenders
    {:containium
     {:enabled? true
      :async? false
-     :fn (fn [{:keys [args timestamp]}]
+     :fn (fn [{:keys [args timestamp level]}]
            (let [message (first args)
                  prefixed (if-let [ns (and (map? message) (::ns message))]
                             (str "[" (when prefix (str prefix "@")) ns "] " (::msg message))
                             (str (when prefix (str "[" prefix "] ")) message))]
-             (when out
-               (.println out (str timestamp " " prefixed)))
+             (when log-writer
+               (write-line log-writer (str timestamp " " (upper-case (name level)) " " prefixed)))
              (when sessions-atom
-               (doseq [^PrintStream out @sessions-atom]
-                 (.println out (str timestamp " " prefixed))))))}}})
+               (doseq [log-writer @sessions-atom]
+                 (write-line log-writer
+                             (str timestamp " " (upper-case (name level)) " " prefixed))))))}}})

-;; sessions = (atom #{PrintStream})
-(defrecord Logger [sessions console-appender]
+;; sessions = (atom #{LogWriter})
+;; levels = (atom {"app-name", :level})
+(defrecord Logger [sessions levels console-appender]
   Logging
   (get-logger [this app-name]
     (let [appender (mk-appender sessions app-name nil)]
       (reify AppLogger
         (log-console [_ level msg]
-          (timbre/log appender level msg))
+          (if-let [log-level (get @levels app-name)]
+            (timbre/with-log-level log-level (timbre/log appender level msg))
+            (timbre/log appender level msg)))
         (log-console [_ level ns msg]
-          (timbre/log appender level {::ns ns ::msg msg})))))
+          (if-let [log-level (get @levels app-name)]
+            (timbre/with-log-level log-level (timbre/log appender level {::ns ns ::msg msg}))
+            (timbre/log appender level {::ns ns ::msg msg}))))))

   AppLogger
   (log-console [_ level msg]
@@ -83,24 +159,27 @@
     (timbre/log console-appender level {::ns ns ::msg msg}))

   SystemLogger
-  (add-session [_ out]
-    (swap! sessions conj out))
+  (add-session [_ log-writer]
+    (swap! sessions conj log-writer))

-  (remove-session [_ out]
-    (swap! sessions disj out))
+  (remove-session [_ log-writer]
+    (swap! sessions disj log-writer))

-  (get-command-logger [this out]
-    (let [all-appender (mk-appender sessions nil out)
-          command-appender (mk-appender nil nil out)]
+  (get-command-logger [this log-writer]
+    (let [all-appender (mk-appender sessions nil log-writer)
+          command-appender (mk-appender nil nil log-writer)]
       (reify CommandLogger
         (log-command [_ level msg]
           (timbre/log command-appender level msg))
         (log-all [_ level msg]
-          (timbre/log all-appender level msg))))))
+          (timbre/log all-appender level msg)))))
+
+  (set-level [this app-name level]
+    (swap! levels assoc app-name level)))

 (def logger
   (reify Startable
     (start [this systems]
       (let [sessions-atom (atom #{System/out})]
-        (Logger. sessions-atom (mk-appender sessions-atom nil nil))))))
+        (Logger. sessions-atom (atom {}) (mk-appender sessions-atom nil nil))))))


asynchronous callback

asynchronous callback

--- src/chessground/data.cljs
+++ src/chessground/data.cljs
@@ -27,16 +27,17 @@

 (defn- callback [function & args]
   "Call a user supplied callback function, if any"
-  (when function (apply function (map clj->js args))))
+  (when function
+    (js/setTimeout #(apply function (map clj->js args)) 40)))

 (defn with-fen [state fen]
   (assoc state :chess (chess/make (or fen "start"))))

 (defn make [config]
-    (-> (common/deep-merge defaults config)
-        (with-fen (:fen config))
-        (dissoc :fen)
-        (update-in [:movable :dests] common/stringify-keys)))
+  (-> (common/deep-merge defaults config)
+      (with-fen (:fen config))
+      (dissoc :fen)
+      (update-in [:movable :dests] common/stringify-keys)))

 (defn movable? [state orig]
   (when-let [piece (chess/get-piece (:chess state) orig)]


[fix] auth with 4.1.0 sdk

[fix] auth with 4.1.0 sdk

--- src/clj/aliyuncs/core.clj
+++ src/clj/aliyuncs/core.clj
@@ -17,9 +17,10 @@
     provider))

 (defn mk-acs-profile
-  [region access-key secret-key]
+  [^String region access-key secret-key]
   (let [^BasicICredentialProvider creds-provider (mk-creds-provider access-key secret-key)
-        ^DefaultProfile profile (DefaultProfile/getProfile region creds-provider)]
+        ^DefaultProfile profile (DefaultProfile/getProfile region)]
+        (.setCredentialsProvider profile creds-provider)
     profile))

 (defn mk-acs-client


refactor confirm-ns

refactor confirm-ns

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -168,21 +168,16 @@
   (let [sym (symbol name)]
     (get (:requires (:ns env)) sym sym)))

+;; TODO: our internal conventions around data structures
+;; should probably be changed so we don't special case
+;; cljs.core namespaces, they won't be properly checked
 (defn confirm-ns [env ns-sym]
-  ;; ignore if ns-nsym is same as env ns
-  (if (= (-> env :ns :name) ns-sym)
-    ns-sym
-    (condp get ns-sym
-      '#{cljs.core goog Math} :>> identity
-      (-> env :ns :requires) :>> identity
-      ;; our internal conventions around data structures
-      ;; should not be allowed elsewhere
-      (if-not (== (.indexOf (str ns-sym) "cljs.core") -1)
-        ns-sym
-        (do (when (:undeclared *cljs-warnings*)
-              (warning env
-                (str "WARNING: No such namespace: " ns-sym)))
-          ns-sym)))))
+  (when (and (nil? (get '#{cljs.core goog Math} ns-sym))
+             (nil? (get (-> env :ns :requires) ns-sym))
+             (:undeclared *cljs-warnings*)
+             (== (.indexOf (str ns-sym) "cljs.core") -1))
+    (warning env
+      (str "WARNING: No such namespace: " ns-sym))))

 (defn core-name?
   "Is sym visible from core in the current compilation namespace?"
@@ -207,7 +202,8 @@
                  ns (if (= "clojure.core" ns) "cljs.core" ns)
                  full-ns (resolve-ns-alias env ns)]
              (when confirm
-               (confirm-ns env full-ns)
+               (when (not= (-> env :ns :name) full-ns)
+                 (confirm-ns env full-ns))
                (confirm env full-ns (symbol (name sym))))
              (merge (get-in @namespaces [full-ns :defs (symbol (name sym))])
                     {:name (symbol (str full-ns) (str (name sym)))


fix imports

fix imports

--- src/clj/dbquery/model.clj
+++ src/clj/dbquery/model.clj
@@ -7,7 +7,8 @@
              [conf :refer :all]
              [databases :as db]]
             [korma
-             [core :as k]
+             [core :as k :refer [defentity transform entity-fields belongs-to
+                                 many-to-many prepare fields exec-raw values]]
              [db :refer :all]])
   (:import com.rinconj.dbupgrader.DbUpgrader
            org.h2.jdbcx.JdbcDataSource


reorganize transfer logic

reorganize transfer logic

--- src/clj_money/trading.clj
+++ src/clj_money/trading.clj
@@ -412,61 +412,80 @@
    (coercion/rule :decimal [:shares])])

 (defn- validate-transfer
-  [storage transfer]
+  [transfer]
   (->> transfer
        (coercion/coerce transfer-coercion-rules)
        (validation/validate ::transfer)))

-(defn transfer
-  [storage-spec transfer]
-  (with-transacted-storage [s storage-spec]
-    (let [{:keys [commodity-id
-                  from-account-id
-                  to-account-id
-                  shares
-                  transfer-date]
-           :as validated} (validate-transfer s transfer)]
-      (if (validation/valid? validated)
-        (let [commodity (commodities/find-by-id s commodity-id)
-              [from-account
-               to-account] (map #(accounts/find-by-id s %) [from-account-id
-                                                            to-account-id])
-              [from-commodity-account
-               to-commodity-account] (map #(find-or-create-commodity-account
-                                             s
-                                             %
-                                             commodity)
-                                          [from-account to-account])
-              lots (lots/search s {:commodity-id (:id commodity)
-                                   :account-id (:id from-account)
-                                   :shares-owned [:> 0M]})
-              updated-lots (mapv #(lots/update
-                                    s
-                                    (assoc % :account-id (:id to-account)))
-                                 lots)
-              price (prices/most-recent s (:id commodity) transfer-date)
-              value (* shares (:price price))
-              transaction (transactions/create s {:entity-id (:entity-id commodity)
-                                                  :transaction-date transfer-date
-                                                  :description (format "Transfer %s shares of %s"
-                                                                       shares
-                                                                       (:symbol commodity))
-                                                  :items [{:action :credit
-                                                           :amount shares
-                                                           :value value
-                                                           :account-id (:id from-commodity-account)}
-                                                          {:action :debit
-                                                           :amount shares
-                                                           :value value
-                                                           :account-id (:id to-commodity-account)}]})]
-
-          {:lots updated-lots
-           :transaction transaction})
-        validated))))
-
 (defn- append-commodity
   [{:keys [storage commodity-id] :as context}]
   (assoc context :commodity (commodities/find-by-id storage commodity-id)))
+
+(defn- append-transfer-accounts
+  [{:keys  [storage from-account-id to-account-id commodity] :as context}]
+  (let [[from-account
+         to-account] (map #(accounts/find-by-id storage %)
+                          [from-account-id
+                           to-account-id])
+        [from-commodity-account
+         to-commodity-account] (map #(find-or-create-commodity-account
+                                       storage
+                                       %
+                                       commodity)
+                                    [from-account to-account])]
+    (assoc context
+           :from-account from-account
+           :from-commodity-account from-commodity-account
+           :to-account to-account
+           :to-commodity-account to-commodity-account)))
+
+(defn- process-transfer-lots
+  [{:keys [storage commodity from-account to-account] :as context}]
+  (assoc context :lots (mapv #(lots/update
+                                storage
+                                (assoc % :account-id (:id to-account)))
+                             (lots/search storage {:commodity-id (:id commodity)
+                                                   :account-id (:id from-account)
+                                                   :shares-owned [:> 0M]}))))
+
+(defn- create-transfer-transaction
+  [{:keys [commodity
+           from-commodity-account
+           to-commodity-account
+           transfer-date
+           shares]
+    s :storage
+    :as context}]
+  (let [price (prices/most-recent s (:id commodity) transfer-date)
+        value (* shares (:price price))
+        transaction (transactions/create s {:entity-id (:entity-id commodity)
+                                            :transaction-date transfer-date
+                                            :description (format "Transfer %s shares of %s"
+                                                                 shares
+                                                                 (:symbol commodity))
+                                            :items [{:action :credit
+                                                     :amount shares
+                                                     :value value
+                                                     :account-id (:id from-commodity-account)}
+                                                    {:action :debit
+                                                     :amount shares
+                                                     :value value
+                                                     :account-id (:id to-commodity-account)}]})]
+    (assoc context :transaction transaction)))
+
+(defn transfer
+  [storage-spec transfer]
+  (let [validated (validate-transfer transfer)]
+    (if (validation/valid? validated)
+      (with-transacted-storage [s storage-spec]
+        (-> validated
+            (assoc :storage s)
+            append-commodity
+            append-transfer-accounts
+            process-transfer-lots
+            create-transfer-transaction
+            (select-keys [:lots :transaction])))
+      validated)))

 (defn- append-commodity-account
   [{:keys [storage commodity] :as context}]


Update state

Update state

--- src/cljs/gtfve/state.cljs
+++ src/cljs/gtfve/state.cljs
@@ -6,6 +6,7 @@
    :environment :development
    :ui {:editor {:mode :view}
         :panel {:tab :stops
+                :stops-query ""
                 :active? true
                 :in? true}}
    :data {:stops []


CMR-6059: Reindex permitted groups.

CMR-6059: Reindex permitted groups.

--- system-int-test/test/cmr/system_int_test/search/acls/collection.clj
+++ system-int-test/test/cmr/system_int_test/search/acls/collection.clj
@@ -425,6 +425,7 @@
         user1-token (e/login (s/context) "user1")
         user2-token (e/login (s/context) "user2")]

+    (ingest/reindex-collection-permitted-groups (tc/echo-system-token))
     (index/wait-until-indexed)

     ;; A logged out token is normally not useful


(SERVER-2477) Add test for jruby queue limit in v4

--- test/integration/puppetlabs/services/master/master_service_test.clj
+++ test/integration/puppetlabs/services/master/master_service_test.clj
@@ -4,6 +4,7 @@
     [clojure.set :as setutils]
     [puppetlabs.services.master.master-service :refer :all]
     [puppetlabs.services.jruby.jruby-puppet-service :as jruby]
+    [puppetlabs.services.protocols.jruby-metrics :as jruby-metrics]
     [puppetlabs.puppetserver.bootstrap-testutils :as bootstrap-testutils]
     [puppetlabs.trapperkeeper.app :as tk-app]
     [puppetlabs.trapperkeeper.testutils.logging :as logutils]
@@ -62,6 +63,22 @@
   (let [master-service-test-runtime-ssl-dir
         (str master-service-test-runtime-dir "/ssl")]
     (http-client/put (str "https://localhost:8140" url)
+                     {:ssl-cert (str master-service-test-runtime-ssl-dir
+                                     "/certs/localhost.pem")
+                      :ssl-key (str master-service-test-runtime-ssl-dir
+                                    "/private_keys/localhost.pem")
+                      :ssl-ca-cert (str master-service-test-runtime-ssl-dir
+                                        "/certs/ca.pem")
+                      :body body
+                      :headers {"Accept" "application/json"
+                                "Content-type" "application/json"}
+                      :as :text})))
+
+(defn http-post
+  [url body]
+  (let [master-service-test-runtime-ssl-dir
+        (str master-service-test-runtime-dir "/ssl")]
+    (http-client/post (str "https://localhost:8140" url)
                      {:ssl-cert (str master-service-test-runtime-ssl-dir
                                      "/certs/localhost.pem")
                       :ssl-key (str master-service-test-runtime-ssl-dir
@@ -713,3 +730,30 @@
               (is (= "bar" (get-in stored-facts ["values" "foo"]))))))
         (finally
           (jruby-testutils/return-instance jruby-service jruby-instance :facts-upload-endpoint-test))))))
+
+(deftest ^:integration v4-queue-limit
+  (bootstrap-testutils/with-puppetserver-running
+   app
+   {:jruby-puppet {:gem-path gem-path
+                   :max-active-instances 1
+                   :max-retry-delay 1800
+                   :max-queued-requests 1
+                   :master-code-dir test-resources-code-dir
+                   :master-conf-dir master-service-test-runtime-dir
+                   :master-var-dir (fs/tmpdir)}}
+
+    (let [metrics-svc (tk-app/get-service app :JRubyMetricsService)
+          metrics (jruby-metrics/get-metrics metrics-svc)
+          _ (swap! (:requested-instances metrics) assoc :foo "bar" :baz "bar")]
+
+      (logutils/with-test-logging
+        (testing "v4 catalog endpoint is affected by the jruby queue limit"
+          (let [body "{\"certname\": \"foo\", \"persistence\": {\"facts\": false, \"catalog\": false}}"
+                response (http-post "/puppet/v4/catalog" body)
+                status-code (:status response)
+                retry-after (-> response
+                                (get-in [:headers "retry-after"])
+                                Integer/parseInt)]
+
+            (is (= 503 status-code))
+            (is (<= 0 retry-after 1800))))))))


removed refactored test

removed refactored test

--- test/org/domaindrivenarchitecture/pallet/crate/user/user_for_transport_test.clj
+++ test/org/domaindrivenarchitecture/pallet/crate/user/user_for_transport_test.clj
@@ -1,43 +0,0 @@
-; Licensed to the Apache Software Foundation (ASF) under one
-; or more contributor license agreements. See the NOTICE file
-; distributed with this work for additional information
-; regarding copyright ownership. The ASF licenses this file
-; to you under the Apache License, Version 2.0 (the
-; "License"); you may not use this file except in compliance
-; with the License. You may obtain a copy of the License at
-;
-; http://www.apache.org/licenses/LICENSE-2.0
-;
-; Unless required by applicable law or agreed to in writing, software
-; distributed under the License is distributed on an "AS IS" BASIS,
-; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-; See the License for the specific language governing permissions and
-; limitations under the License.
-
-(ns org.domaindrivenarchitecture.pallet.crate.user.user-for-transport-test
-  (:require
-    [clojure.test :refer :all]
-    [org.domaindrivenarchitecture.pallet.crate.user.user-for-transport :as sut]
-    ))
-
-(deftest public-key
-  (testing
-    "format public key string for ssh authorized keys"
-    (is (=  #pallet.core.user.User{:username "pallet",
-                                 :public-key-path
-                                 "/home/mje/.ssh/id_rsa.pub",
-                                 :private-key-path
-                                 "/home/mje/.ssh/id_rsa",
-                                 :public-key nil,
-                                 :private-key nil,
-                                 :passphrase nil,
-                                 :password nil,
-                                 :sudo-password nil,
-                                 :no-sudo nil,
-                                 :sudo-user nil,
-                                 :state-root nil,
-                                 :state-group nil}
-           (sut/pallet-user-for-cm)
-           ))
-    ))
-


Enable cljs current-fill and current-stroke tests

--- test/cljc/snippets/color/creating_and_reading.cljc
+++ test/cljc/snippets/color/creating_and_reading.cljc
@@ -125,33 +125,31 @@
   (q/fill 5 10 0 15)
   (q/rect 210 210 100 100))

-#?(:clj
-   (defsnippet current-fill {}
-     (q/background 255)
+(defsnippet current-fill {}
+  (q/background 255)

-     (q/fill 255 0 0)
-     (q/rect 0 0 100 100)
+  (q/fill 255 0 0)
+  (q/rect 0 0 100 100)

-     (let [cur-fill (q/current-fill)]
-       (q/fill 0 0 255)
-       (q/rect 70 70 100 100)
+  (let [cur-fill (q/current-fill)]
+    (q/fill 0 0 255)
+    (q/rect 70 70 100 100)

-       (q/fill cur-fill)
-       (q/rect 140 140 100 100))))
+    (q/fill cur-fill)
+    (q/rect 140 140 100 100)))

-#?(:clj
-   (defsnippet current-stroke {}
-     (q/background 255)
+(defsnippet current-stroke {}
+  (q/background 255)

-     (q/stroke 255 0 0)
-     (q/rect 0 0 100 100)
+  (q/stroke 255 0 0)
+  (q/rect 0 0 100 100)

-     (let [cur-stroke (q/current-stroke)]
-       (q/stroke 0 0 255)
-       (q/rect 70 70 100 100)
+  (let [cur-stroke (q/current-stroke)]
+    (q/stroke 0 0 255)
+    (q/rect 70 70 100 100)

-       (q/stroke cur-stroke)
-       (q/rect 140 140 100 100))))
+    (q/stroke cur-stroke)
+    (q/rect 140 140 100 100)))

 (defsnippet lerp-color {}
   (q/background 255)


Une 2ème proposition de solution pour l'exercice Strain de Exercism dans la track Clojure

--- exercism/clojure/strain/src/strain.clj
+++ exercism/clojure/strain/src/strain.clj
@@ -1,9 +1,19 @@
 (ns strain)

-(defn retain [pred v]
-  (reduce #(if (pred %2) (conj %1 %2) %1) [] v)
-  )
+;; A solution with reduce
+;; (defn retain [pred v]
+;;   (reduce #(if (pred %2) (conj %1 %2) %1) [] v))

-(defn discard [pred v]
-  (reduce #(if (pred %2) %1 (conj %1 %2)) [] v)
-)
+;; (defn discard [pred v]
+;;   (reduce #(if (pred %2) %1 (conj %1 %2)) [] v))
+
+;; A recursive solution
+(defn retain [pred v]
+  (if
+   (or (nil? v) (empty? v)) []
+   (if (pred (first v)) (cons  (first v) (retain pred (rest v))) (retain pred (rest v)))))
+
+(defn discard [pred v]
+  (if
+   (or (nil? v) (empty? v)) []
+   (if (pred (first v)) (discard pred (rest v)) (cons  (first v) (discard pred (rest v))))))


btset extended common clojure set protocols

--- src/datascript/btset.cljs
+++ src/datascript/btset.cljs
@@ -11,7 +11,7 @@
                               inc))
 (def ^:const ^number path-mask (dec (bit-shift-left 1 level-shift)))
 (def ^:const ^number empty-path 0)
-(def ^:dynamic *cmp* compare)
+(def ^:dynamic *cmp*)

 (defn ^number path-get [^number path
                         ^number level]
@@ -308,6 +308,8 @@
       (recur (- level level-shift) (aget (.-pointers node) (path-get path level)))
       (.-keys node))))

+(declare alter-btset)
+
 (defn btset-conj [set key]
   (binding [*cmp* (.-comparator set)]
     (let [roots (.conj (.-root set) key)]
@@ -318,11 +320,17 @@

         ;; keeping single root
         (== (alength roots) 1)
-          (BTSet. (aget roots 0) (.-shift set) *cmp*)
+          (alter-btset set
+            (aget roots 0)
+            (.-shift set)
+            (inc (.-cnt set)))

         ;; introducing new root
         :else
-          (BTSet. (Node. (.map roots lim-key) roots) (+ (.-shift set) level-shift) *cmp*)))))
+          (alter-btset set
+            (Node. (.map roots lim-key) roots)
+            (+ (.-shift set) level-shift)
+            (inc (.-cnt set)))))))

 (defn btset-disj [set key]
   (binding [*cmp* (.-comparator set)]
@@ -332,10 +340,18 @@
         (let [new-root (aget new-roots 0)]
           (if (and (instance? Node new-root)
                    (== (alength (.-pointers new-root)) 1))
+
             ;; root has one child, make him new root
-            (BTSet. (aget (.-pointers new-root) 0) (- (.-shift set) level-shift) *cmp*)
+            (alter-btset set
+              (aget (.-pointers new-root) 0)
+              (- (.-shift set) level-shift)
+              (dec (.-cnt set)))
+
             ;; keeping root level
-            (BTSet. new-root (.-shift set) *cmp*)))))))
+            (alter-btset set
+              new-root
+              (.-shift set)
+              (dec (.-cnt set)))))))))

 ;; iteration

@@ -402,11 +418,33 @@

 ;; public interface

-(deftype BTSet [root shift comparator]
+(deftype BTSet [root shift cnt comparator meta ^:mutable __hash]
   Object
-;;   (toString [this]
-;;     (pr-str* this))
-
+  (toString [this]
+    (pr-str* this))
+
+  ICloneable
+  (-clone [_] (BTSet. root shift cnt comparator meta __hash))
+
+  IWithMeta
+  (-with-meta [_ new-meta] (BTSet. root shift cnt comparator new-meta __hash))
+
+  IMeta
+  (-meta [_] meta)
+
+  IEmptyableCollection
+  (-empty [_] (BTSet. (LeafNode. (array)) 0 0 comparator meta 0))
+
+  IEquiv
+  (-equiv [this other]
+    (and
+     (set? other)
+     (== cnt (count other))
+     (every? #(contains? this %) other)))
+
+  IHash
+  (-hash [coll] (caching-hash coll hash-iset __hash))
+
   ICollection
   (-conj [set key] (btset-conj set key))

@@ -417,20 +455,32 @@
   ILookup
   (-lookup [set k]
     (-lookup set k nil))
-  (-lookup [set k not-found]
-    (binding [*cmp* (.-comparator set)]
-      (or (.lookup (.-root set) k) not-found)))
+  (-lookup [_ k not-found]
+    (binding [*cmp* comparator]
+      (or (.lookup root k) not-found)))

   ISeqable
   (-seq [this]
     (btset-iter this))

+  ICounted
+  (-count [_] cnt)
+
+  IFn
+  (-invoke [coll k]
+    (-lookup coll k))
+  (-invoke [coll k not-found]
+    (-lookup coll k not-found))
+
   IPrintWithWriter
   (-pr-writer [this writer opts]
     (pr-sequential-writer writer pr-writer "#{" " " "}" opts (seq this))))

+(defn alter-btset [set root shift cnt]
+  (BTSet. root shift cnt (.-comparator set) (.-meta set) nil))
+
 (defn btset-by
-  ([cmp] (BTSet. (LeafNode. (array)) 0 cmp))
+  ([cmp] (BTSet. (LeafNode. (array)) 0 0 cmp nil 0))
   ([cmp & keys]
     (reduce -conj (btset-by cmp) keys)))

@@ -440,7 +490,6 @@
     (reduce -conj (btset) keys)))

 ;; helpers
-

 (defn parse-path [path shift]
   (loop [level shift
@@ -468,10 +517,10 @@
       (-write writer "\n")
       (dump (aget (.-pointers node) i) writer (str "  " offset)))))

-(extend-type BTSet
-  IPrintWithWriter
-  (-pr-writer [o writer _]
-    (dump (.-root o) writer "")))
+;; (extend-type BTSet
+;;   IPrintWithWriter
+;;   (-pr-writer [o writer _]
+;;     (dump (.-root o) writer "")))

 ;; (def s0 (into (btset) (shuffle (range 10000))))
 ;; (reduce disj s0 (shuffle (range 9995)))
@@ -482,11 +531,20 @@
           xs-sorted (distinct (sort xs))
           set0      (into (btset) xs)
           rm        (repeatedly (rand-int 10000) #(rand-nth xs))
+          xs-rm     (reduce disj (into (sorted-set) xs) rm)
           set1      (reduce disj set0 rm)]
       (when-not (= (vec set0) xs-sorted)
         (throw (js/Error. (str "conj failed on: " xs))))
-      (when-not (= (vec set1) (->> (reduce disj (into #{} xs) rm) sort))
+      (when-not (= set0 (set xs-sorted))
+        (throw (js/Error. (str "equiv 1 failed on: " xs))))
+      (when-not (= (count set0) (count xs-sorted))
+        (throw (js/Error. (str "count 1 failed on: " xs))))
+      (when-not (= (vec set1) (vec xs-rm))
         (throw (js/Error. (str "disj failed on: " xs " and " rm))))
+      (when-not (= (count set1) (count xs-rm))
+        (throw (js/Error. (str "count 2 failed on: " xs " and " rm))))
+      (when-not (= set1 xs-rm)
+        (throw (js/Error. (str "equiv 2 failed on: " xs))))
       (println "Checking...")))
   (println "Checked")
   :ok)
@@ -495,11 +553,11 @@

 ;; perf

-(def test-matrix [:target    { "sorted-set" (sorted-set)
+(def test-matrix [:target    { ;; "sorted-set" (sorted-set)
                                "btset"      (btset)}
 ;;                   :distinct? [true false]
-                  :size    [100 500 1000 2000 5000 10000 20000 50000]
-;;                   :size      [100 500 20000]
+;;                   :size    [100 500 1000 2000 5000 10000 20000 50000]
+                  :size      [100 500 20000]
                   :method    { "conj"    (fn [opts] (into (:target opts) (:range opts)))
                                "disj"    (fn [opts] (reduce disj (:set opts) (shuffle (:range opts))))
                                "lookup"  (fn [opts] (contains? (:set opts) (rand-int (:size opts))))


Add text-field validation error handling


Fixed problem where by content-type filtering would cause error pages to be returned with default content-types.

For example, this would mean that HTML error pages would be returned in text/plain if a text/plain service threw an error.

--- src/main/clojure/plugboard/webfunction/plugboards.clj
+++ src/main/clojure/plugboard/webfunction/plugboards.clj
@@ -98,7 +98,8 @@
   "Drive the plugboard and use the result to select the view"
   (let [[status state] (plugboard/get-status-with-state plugboard
                          (initialize-state req))
-        webfns (get state ::uri-matching-web-functions)
+        webfns (or (get state ::content-type-filtered-uri-matching-web-functions)
+                   (get state ::uri-matching-web-functions))
         matching-webfns (filter (by-status status) webfns)]
     (if (:immediate-exit state)
       {:status status :headers (get-in state [:response :headers]) :body ""}
@@ -115,7 +116,7 @@
                 {:status status :headers headers :body body}))
             (catch Exception e
               (let [status 500
-                    matching-webfns (filter (by-status status) webfns)]
+                    matching-webfns (filter (by-status status) (get state ::uri-matching-web-functions))]
                 (if-let [^ContentFunction cf (first matching-webfns)]
                   ;; TODO: Test this, release it, use the error handler to log the support ticket, and add the support ticket id
                   ;; into the state
@@ -247,5 +248,5 @@
          true

          (let [filtered-functions (negotiate-content unfiltered-functions accepts get-content-type-fragment)
-               new-state (assoc state ::uri-matching-web-functions filtered-functions)]
+               new-state (assoc state ::content-type-filtered-uri-matching-web-functions filtered-functions)]
            [(not (empty? filtered-functions)) new-state]))))})


CMR-1383 Fixes typo.

CMR-1383 Fixes typo.

--- metadata-db-app/src/cmr/metadata_db/data/providers.clj
+++ metadata-db-app/src/cmr/metadata_db/data/providers.clj
@@ -16,7 +16,7 @@
   (update-provider
     [db provider]
     "Updates an existing provider in the database based on the
-    provider map's provider-id value..")
+    provider map's provider-id value.")

   (delete-provider
     [db provider-id]


fixed #106

fixed #106

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -48,13 +48,17 @@
         uploads          (:uploads new-state)
         uploads-order    (:uploads-order new-state)
         active-uploads   (active-uploads   uploads-order uploads)
-        inactive-uploads (inactive-uploads uploads-order uploads)]
+        inactive-uploads (inactive-uploads uploads-order uploads)
+        unpaused-inactive-uploads (vec (remove #(:paused? (uploads %)) inactive-uploads))]
     (cond
       (and (< old-upload-slots new-upload-slots)
            (< (count active-uploads) new-upload-slots))
-        (if-not (empty? inactive-uploads)
-          {:uploads (merge uploads {(first inactive-uploads)
-                                    (start-upload (uploads (first inactive-uploads)))})})
+      (do
+    (println "ACTIVE-UPLOADS:" active-uploads)
+    (println "inactive-uploads:" inactive-uploads)
+        (if-not (empty? unpaused-inactive-uploads)
+          {:uploads (merge uploads {(first unpaused-inactive-uploads)
+                                    (start-upload (uploads (first unpaused-inactive-uploads)))})}))
       (and (> old-upload-slots new-upload-slots)
            (> (count active-uploads) new-upload-slots))
         (if-not (empty? active-uploads)


CMR-1863 Adds expected conversion for SMAP platform characteristics

--- umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
@@ -146,7 +146,8 @@
       ;; ISO SMAP does not support the PrecisionOfSeconds field.
       (update-in-each [:TemporalExtents] assoc :PrecisionOfSeconds nil)
       ;; Because SMAP cannot account for type, all of them are converted to Spacecraft.
-      (update-in-each [:Platforms] assoc :Type "Spacecraft")))
+      ;; Platform Characteristics are also not supported.
+      (update-in-each [:Platforms] assoc :Type "Spacecraft" :Characteristics nil)))

 ;;; Unimplemented Fields


Improve API doc.

Improve API doc.

--- src/afterglow/channels.clj
+++ src/afterglow/channels.clj
@@ -170,8 +170,9 @@
   "Defines a channel whose values are divided up into different ranges
   which perform different functions. After the channel type and DMX
   offset, pass a list of starting values and function specifications.
-  The simplest form of specification is a keyword identifying the
-  function type; this will be expanded into a variable-range function
+  The simplest form of specification is a keyword or string
+  identifying the function type; this will be expanded into a
+  variable-range (for keywords) or fixed-range (for strings) function
   of that type. For more complex functions, pass in a map containing
   the :type keyword and any other settings you need to
   make (e.g. :label), and the rest will be filled in for you. The


Make it easy to play with color construction forms.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -9,6 +9,7 @@
             [afterglow.fixtures.chauvet :as chauvet]
             [afterglow.rhythm :refer :all]
             [afterglow.show :as show]
+            [com.evocomputing.colors :refer [color-name create-color]]
             [taoensso.timbre :as timbre]))

 ;; Make sure the experimenter does not get blasted with a ton of debug messages
@@ -24,10 +25,14 @@

 (defn global-color-cue
   "Make a fixed color cue which affects all lights in the sample rig."
-  [color-name]
-  (color-cue (str "Color: " (name color-name))
-                                     (com.evocomputing.colors/create-color color-name)
-                                     (show/all-fixtures sample-show)))
+  [color]
+  (try
+    (let [c (if (= (type color) :com.evocomputing.colors/color)
+              color
+              (create-color color))]
+      (color-cue (str "Color: " (color-name c)) c (show/all-fixtures sample-show)))
+    (catch Exception e
+      (throw (Exception. (str "Can't figure out how to create color from " color))))))

 (def blue-cue (global-color-cue :slateblue))


Fix indentation.

Fix indentation.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -445,17 +445,17 @@
                :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
                :color :cyan))

-(ct/set-cue!
- (:cue-grid *show*) 6 7
- (cues/cue :fade-test-2 (fn [var-map]
-                          (fx/fade "Fade Test 2"
-                                   (move/direction-effect "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
-                                                          (show/fixtures-named "torrent"))
-                                   (move/direction-effect "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
-                                                          (show/fixtures-named "blade"))
-                                   (params/bind-keyword-param (:phase var-map 0) Number 0)))
-           :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
-           :color :red))
+    (ct/set-cue!
+     (:cue-grid *show*) 6 7
+     (cues/cue :fade-test-2 (fn [var-map]
+                              (fx/fade "Fade Test 2"
+                                       (move/direction-effect "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
+                                                              (show/fixtures-named "torrent"))
+                                       (move/direction-effect "p/t" (params/build-pan-tilt-param :pan 0 :tilt 0)
+                                                              (show/fixtures-named "blade"))
+                                       (params/bind-keyword-param (:phase var-map 0) Number 0)))
+               :variables [{:key "phase" :min 0.0 :max 1.0 :start 0.0 :name "Fade"}]
+               :color :red))

     (ct/set-cue! (:cue-grid *show*) 7 7
                  (cues/function-cue :strobe-all :strobe (show/all-fixtures) :effect-name "Raw Strobe"))


initial implementation of order

initial implementation of order

--- pigpen-cascading/src/main/clojure/pigpen/cascading.clj
+++ pigpen-cascading/src/main/clojure/pigpen/cascading.clj
@@ -1,7 +1,7 @@
 (ns pigpen.cascading
   (:import (cascading.tap.hadoop Hfs)
            (cascading.scheme.hadoop TextLine)
-           (cascading.pipe Pipe Each CoGroup Every Merge)
+           (cascading.pipe Pipe Each CoGroup Every Merge GroupBy)
            (cascading.flow.hadoop HadoopFlowConnector)
            (pigpen.cascading PigPenFunction GroupBuffer JoinBuffer PigPenAggregateBy OperationUtil)
            (cascading.tuple Fields)
@@ -264,6 +264,13 @@
   (let [union-pipe (Merge. (into-array (map (:pipes flowdef) ancestors)))]
     (add-val flowdef [:pipes] id union-pipe)))

+(defmethod command->flowdef :order
+  [{:keys [id ancestors sort-keys opts]} flowdef]
+  {:pre [id (= 1 (count ancestors))]}
+  (let [key (first sort-keys)
+        sort-pipe (GroupBy. ((:pipes flowdef) (first ancestors)) Fields/NONE (cfields [key]))]
+    (add-val flowdef [:pipes] id sort-pipe)))
+
 (defmethod command->flowdef :script
   [_ flowdef]
   ; No-op, since the flowdef already contains everything needed to handle multiple outputs.
@@ -318,6 +325,7 @@
 (defn commands->flow
   "Transforms a series of commands into a Cascading flow"
   [commands ^FlowConnector connector]
+  (clojure.pprint/pprint (preprocess-commands commands))
   (let [flowdef (reduce (fn [def cmd] (command->flowdef cmd def)) {} (preprocess-commands commands))
         {:keys [sources pipe-to-sink sinks pipes]} flowdef
         sources-map (into {} (map (fn [s] [(str s) (sources s)]) (keys sources)))