(SERVER-977) Remove with-redef from handle-delete-cert.-req.-test

Previously, we were using `with-redefs` to stub a lower level library
call to force the error path in
`handle-delete-certificate-request!-test`. This moves to making the over
arching fixtures directory unwrite-able to force the error.

It also updates each `testing` block to use a unique subject name to
clarify logs and subsequent errors for each testing block. A
`gen-csr-input-stream` helper function has been refactored out to help
support the unique csr input stream that must be generated when using a
unique subject name.

--- test/unit/puppetlabs/services/ca/certificate_authority_core_test.clj
+++ test/unit/puppetlabs/services/ca/certificate_authority_core_test.clj
@@ -47,6 +47,14 @@
         (handler request)))
     puppet-version))

+(defn gen-csr-input-stream!
+  [subject]
+  (let [key-pair (utils/generate-key-pair 512)
+        csr (utils/generate-certificate-request key-pair (utils/cn subject))
+        pem (java.io.ByteArrayOutputStream.)
+        _ (utils/obj->pem! csr pem)]
+    (io/input-stream (.getBytes (.toString pem)))))
+
 (defn wrap-with-ssl-client-cert
   "Wrap a compojure app so all requests will include the
    localhost certificate to allow access to the certificate
@@ -122,27 +130,29 @@
 (deftest handle-delete-certificate-request!-test
   (let [settings (assoc (testutils/ca-sandbox! cadir)
                         :allow-duplicate-certs true
-                        :autosign false)
-        subject "foo-agent"
-        csr-stream (io/input-stream (test-pem-file "foo-agent-csr.pem"))
-        expected-path (ca/path-to-cert-request (:csrdir settings) subject)]
+                        :autosign false)]
     (testing "successful csr deletion"
       (logutils/with-test-logging
-        (try
-          (handle-put-certificate-request! subject csr-stream settings)
-          (is (true? (fs/exists? expected-path)))
-          (let [response (handle-delete-certificate-request! subject settings)
-                msg-matcher (re-pattern (str "Deleted .* for " subject ".*"))]
-            (is (false? (fs/exists? expected-path)))
-            (is (= 204 (:status response)))
-            (is (re-matches msg-matcher (:body response)))
-            (is (= "text/plain" (get-in response [:headers "Content-Type"])))
-            (is (logged? msg-matcher :debug)))
-          (finally
-            (fs/delete expected-path))))
+        (let [subject "happy-agent"
+              csr-stream (gen-csr-input-stream! subject)
+              expected-path (ca/path-to-cert-request (:csrdir settings) subject)]
+          (try
+            (handle-put-certificate-request! subject csr-stream settings)
+            (is (true? (fs/exists? expected-path)))
+            (let [response (handle-delete-certificate-request! subject settings)
+                  msg-matcher (re-pattern (str "Deleted .* for " subject ".*"))]
+              (is (false? (fs/exists? expected-path)))
+              (is (= 204 (:status response)))
+              (is (re-matches msg-matcher (:body response)))
+              (is (= "text/plain" (get-in response [:headers "Content-Type"])))
+              (is (logged? msg-matcher :debug)))
+            (finally
+              (fs/delete expected-path))))))
       (testing "Attempted deletion of a non-existant CSR"
         (logutils/with-test-logging
-          (let [response (handle-delete-certificate-request! subject settings)
+          (let [subject "not-found-agent"
+                response (handle-delete-certificate-request! subject settings)
+                expected-path (ca/path-to-cert-request (:csrdir settings) subject)
                 msg-matcher (re-pattern
                               (str "No cert.*request for " subject " at.*" expected-path))]
             (is (false? (fs/exists? expected-path)))
@@ -152,14 +162,21 @@
             (is (logged? msg-matcher :warn)))))
       (testing "Error during deletion of a CSR"
         (logutils/with-test-logging
-          (let [response
-                (with-redefs [me.raynes.fs/exists? (constantly true)]
-                  (handle-delete-certificate-request! subject settings))
-                msg-matcher (re-pattern (str "Path " expected-path " exists but.*"))]
-            (is (= 500 (:status response)))
-            (is (re-matches msg-matcher (:body response)))
-            (is (= "text/plain" (get-in response [:headers "Content-Type"])))
-            (is (logged? msg-matcher :error))))))))
+          (let [subject "err-agent"
+                csr-stream (gen-csr-input-stream! subject)
+                expected-path (ca/path-to-cert-request (:csrdir settings) subject)]
+            (try
+              (handle-put-certificate-request! subject csr-stream settings)
+              (is (true? (fs/exists? expected-path)))
+              (fs/chmod "-w" (fs/parent expected-path))
+              (let [response (handle-delete-certificate-request! subject settings)
+                     msg-matcher (re-pattern (str "Path " expected-path " exists but.*"))]
+                 (is (= 500 (:status response)))
+                 (is (re-matches msg-matcher (:body response)))
+                 (is (= "text/plain" (get-in response [:headers "Content-Type"])))
+                 (is (logged? msg-matcher :error)))
+              (finally
+                (fs/chmod "+w" (fs/parent expected-path)))))))))

 (deftest handle-put-certificate-request!-test
   (let [settings   (assoc (testutils/ca-sandbox! cadir)


CMR-4657: Cleaned up unrelated tests.

CMR-4657: Cleaned up unrelated tests.

--- collection-renderer-lib/test/cmr/collection_renderer/test/services/collection_renderer.clj
+++ collection-renderer-lib/test/cmr/collection_renderer/test/services/collection_renderer.clj
@@ -1,19 +1,21 @@
 (ns cmr.collection-renderer.test.services.collection-renderer
-  (require [clojure.test :refer :all]
-           [cmr.common.test.test-check-ext :as ext :refer [defspec]]
-           [clojure.test.check.generators :as gen]
-           [com.gfredericks.test.chuck.clojure-test :refer [for-all]]
-           [clojure.string :as str]
-           [cmr.common.lifecycle :as l]
-           [cmr.collection-renderer.services.collection-renderer :as cr]
-           [cmr.umm-spec.test.expected-conversion :as expected-conversion]
-           [cmr.umm-spec.test.umm-generators :as umm-gen]))
+  (require
+   [clojure.string :as string]
+   [clojure.test :refer :all]
+   [clojure.test.check.generators :as gen]
+   [cmr.collection-renderer.services.collection-renderer :as cr]
+   [cmr.common.lifecycle :as l]
+   [cmr.common.test.test-check-ext :as ext :refer [defspec]]
+   [cmr.umm-spec.test.expected-conversion :as expected-conversion]
+   [cmr.umm-spec.test.umm-generators :as umm-gen]
+   [com.gfredericks.test.chuck.clojure-test :refer [for-all]]))

 (defn create-renderer-context
   "Returns a context to use with testing collection"
   []
   {:system (l/start {cr/system-key (cr/create-collection-renderer)
-                     :public-conf {:relative-root-url "/search" :edsc-url "https://search.earthdata.nasa.gov"}}
+                     :public-conf {:relative-root-url "/search"
+                                   :edsc-url "https://search.earthdata.nasa.gov"}}
                     nil)})

 (def renderer-context
@@ -21,28 +23,29 @@
   (memoize create-renderer-context))

 (deftest render-default-collection
-  (let [coll expected-conversion/example-collection-record
-        ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
-    (is html "Expected some HTML to be returned")
-    (is (.contains html (:EntryTitle coll)))))
+  (testing "Get returned HTML"
+    (let [coll expected-conversion/example-collection-record
+          ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
+      (is (string/includes? html (:EntryTitle coll))))))

 ;; This checks that we can render any UMM collection without getting an exception.
 ;; A small number of tries is done to avoid making tests take a long time.
 (defspec render-any-umm-collection 10
-  (for-all [umm-record (gen/no-shrink umm-gen/umm-c-generator)]
-    (let [^String html (cr/render-collection (renderer-context) umm-record "C1234-PROV1")]
-      (and html (.contains html (:EntryTitle umm-record))))))
+  (testing "Render without exception"
+    (for-all [umm-record (gen/no-shrink umm-gen/umm-c-generator)]
+      (let [^String html (cr/render-collection (renderer-context) umm-record "C1234-PROV1")]
+        (and html (string/includes? html (:EntryTitle umm-record)))))))

-;; Verify that the title of the html is the entry title
 (deftest render-title-as-entry-title
-  (let [coll expected-conversion/example-collection-record
-        ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
-    (is html "Expected a title containing the entry title")
-    (is (.contains html (str "<title>" (:EntryTitle coll) "</title>")))))
+  (testing "Verify that the title of the html is the entry title"
+    (let [coll expected-conversion/example-collection-record
+          ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
+      (is (string/includes? html (str "<title>" (:EntryTitle coll) "</title>"))))))

-;; Verify that the correct EDSC url is rendered
 (deftest render-edsc-link
-  (let [coll expected-conversion/example-collection-record
-        ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
-    (is html "Expected the correct edsc url to be rendered")
-    (is (.contains html (str "https://search.earthdata.nasa.gov/search/granules?p=C1234-PROV1")))))
+  (testing "Verify that the correct EDSC url is rendered"
+    (let [coll expected-conversion/example-collection-record
+          ^String html (cr/render-collection (renderer-context) coll "C1234-PROV1")]
+      (is (string/includes?
+           html
+           "https://search.earthdata.nasa.gov/search/granules?p=C1234-PROV1")))))


added vcf and hansen precondition

added vcf and hansen precondition

--- src/clj/forma/hadoop/jobs/preprocess.clj
+++ src/clj/forma/hadoop/jobs/preprocess.clj
@@ -80,8 +80,10 @@
                   output-path))

 (defmain PreprocessAscii
-  "TODO: Tidy up. This needs to be combined with PreprocessStatic."
+  "TODO: This is only good for hansen datasets looking to be combined
+  Tidy up. This needs to be combined with PreprocessStatic."
   [dataset ascii-path pail-path & countries]
+  {:pre [(#{"hansen" "vcf"} dataset)]}
   (with-fs-tmp [_ tmp-dir]
     (let [line-tap (hfs-textline ascii-path)
           pix-tap  (->> countries


Add line numbers to pygments output.

Add line numbers to pygments output.

--- src/clj/qualityclj/imports/highlight.clj
+++ src/clj/qualityclj/imports/highlight.clj
@@ -11,7 +11,8 @@
   "Produce an HTML file from a given source file. Takes a full path to
   the original source file as well as an output file path."
   [filename outname]
-  (let [result (sh "pygmentize" "-f" "html" "-o" outname filename)]
+  (let [result (sh "pygmentize" "-f" "html" "-O" "linenos=1"
+                   "-o" outname filename)]
     (when-not (= 0 (:exit result))
       (throw (Exception. (str "Error with highlighting: " (:err result)))))))


fix require stmts regarding core.async in message-router

--- src/cljc/ow/starbuck/message_router.cljc
+++ src/cljc/ow/starbuck/message_router.cljc
@@ -1,8 +1,9 @@
 (ns ow.starbuck.message-router
+  ?#(:cljs (:require-macros [cljs.core.async.macros :refer [go-loop]]))
   (:require [taoensso.timbre :refer [trace debug info warn error fatal]]
             #?(:clj  [clojure.core.async.impl.protocols :as ap]
                :cljs [cljs.core.async.impl.protocols :as ap])
-            #?(:clj  [clojure.core.async :as a]
+            #?(:clj  [clojure.core.async :refer [go-loop] :as a]
                :cljs [cljs.core.async :as a])
             [ow.clojure :as owc]
             [ow.starbuck.protocols :as p]
@@ -242,7 +243,7 @@
       (defn start-async-component [comp-kw input-pub output-ch]
         (let [sub-ch (a/sub input-pub comp-kw (a/chan))
               timeout (+ 20000 (rand-int 2000))]
-          (a/go-loop [[msg _] (a/alts! [sub-ch (a/timeout timeout)])]
+          (go-loop [[msg _] (a/alts! [sub-ch (a/timeout timeout)])]
             (println "got component msg in" comp-kw "-" msg "on thread" (-> Thread .currentThread .getId))
             (when msg
               (Thread/sleep 1000)
@@ -251,7 +252,7 @@

       (defn start-async-router [router router-kw input-ch output-ch]
         (let [timeout (+ 20000 (rand-int 2000))]
-          (a/go-loop [[msg _] (a/alts! [input-ch (a/timeout timeout)])]
+          (go-loop [[msg _] (a/alts! [input-ch (a/timeout timeout)])]
             (println "got router msg in" router-kw "-" msg "on thread" (-> Thread .currentThread .getId))
             (when msg
               (Thread/sleep 1000)


localization of messages

localization of messages

--- src/cljs/just_married/home/handlers.cljs
+++ src/cljs/just_married/home/handlers.cljs
@@ -2,7 +2,19 @@
   (:require [re-frame.core :as re-frame :refer [reg-sub dispatch reg-event-db reg-event-fx]]
             [ajax.core :as ajax]
             [just-married.home.config :as config]
+            [just-married.home.language :refer [translate]]
             [day8.re-frame.http-fx]))
+
+(def ^:private handlers-dict
+  {:en {:worked "Thanks for letting us know"
+        :missing "Missing required field `Name`"
+        :not-working "Could not submit your response"}
+
+   :it {:worked "Grazie per averci fatto sapere"
+        :missing "Il campo `Nome` è richiesto"
+        :not-working "Errore nel sottomettere il tuo form"}})
+
+(def ^:private tr (partial translate handlers-dict))

 (def default-db
   ;; what other possibly useful information could be here?
@@ -52,9 +64,9 @@
 (defn handle
   [response]
   (case (:status response)
-    201 (js/alert "Thanks for letting us know")
-    400 (js/alert "Missing required field `Name`")
-    (js/alert "Could not submit your response")))
+    201 (js/alert (tr :worked))
+    400 (js/alert (tr :missing))
+    (js/alert (tr :not-working))))

 ;;XXX: getting strangely cjls-ajax to report failure
 ;;even if in fact it worked and it was a 201 response


default log level option

default log level option

--- src/clojure/zensols/actioncli/log4j2.clj
+++ src/clojure/zensols/actioncli/log4j2.clj
@@ -12,6 +12,10 @@
   (alter-var-root #'log/*logger-factory*
                   (constantly (fac/log4j2-factory)))
   (catch Exception e))
+
+(def log-level-set-option-default
+  "Default log level for [[log-level-set-option]]."
+  (Level/toLevel "info"))

 (defn change-log-level
   "Change the Log4j2 log level.
@@ -36,12 +40,15 @@
     (log/debugf "configured with XML resource: %s" xml-resource)))

 (defn log-level-set-option
+  "Create an option that sets the Log4j2 level.  Note that all you need to do
+  is add this to the option definition and the log level is set in the validate
+  phase."
   ([]
    (log-level-set-option "-l" "--level"))
   ([short long]
    [short long "Log level to set in the Log4J2 system."
     :required "<log level>"
-    :default (Level/toLevel "info")
+    :default log-level-set-option-default
     :parse-fn #(Level/toLevel % nil)
     :validate [(fn [level]
                  (when level


Fixed :consistency, added :inconsistency and :infidelity; lein release :minor

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -49,6 +49,8 @@
              (inc (:age p1)))
     :fidelity (fn [p1 p2 g]
                 (sequence-similarity g (:genome p1)))
+    :infidelity (fn [p1 p2 g]
+                  (- 1 (sequence-similarity g (:genome p1))))
     :consistency (fn [p1 p2 g]
                    ;; don't compute when calling op via genome instruction
                    (if (or (neg? (:age p1))
@@ -56,11 +58,22 @@
                      -1
                      (- 1
                         (#(- (max %1 %2) (min %1 %2))
-                          (sequence-similarity p1 g)
+                          (sequence-similarity (:genome p1) g)
                           (sequence-similarity
-                            p1
+                            (:genome p1)
                             (produce-child-genome-by-autoconstruction
-                              g (:genome p1) (:genome p2) false argmap))))))))
+                              g (:genome p1) (:genome p2) false argmap))))))
+    :inconsistency (fn [p1 p2 g]
+                     ;; don't compute when calling op via genome instruction
+                     (if (or (neg? (:age p1))
+                             (neg? (:age p2)))
+                       -1
+                       (#(- (max %1 %2) (min %1 %2))
+                         (sequence-similarity (:genome p1) g)
+                         (sequence-similarity
+                           (:genome p1)
+                           (produce-child-genome-by-autoconstruction
+                             g (:genome p1) (:genome p2) false argmap)))))))

 ;; test effects of :proportionate with expressions like this:
 ;(float ((age-combining-function {:age-combining-function :proportionate})
@@ -983,3 +996,4 @@
         :is-random-replacement
         (if use-child false true)))))

+


Add tests for conforming and parsing joins with sub-aliases

--- src/test/workflo/macros/specs/query_test.cljc
+++ src/test/workflo/macros/specs/query_test.cljc
@@ -506,3 +506,27 @@
                       :join-target [{:name user/name :type :property}]}]}]
     '[{users [user [name]
               {[current-user _] [user [name]]}]}]))
+
+(deftest conforming-joins-with-sub-aliases
+  (are [out in] (= out (q/conform in))
+    '[[:property
+       [:join
+        [:properties
+         {[:link [user 1]]
+          [[:prefixed-properties {:base db
+                                  :children [[:aliased-property
+                                              {:property [:simple id]
+                                               :as :as :alias db-id}]]}]
+           [:aliased-property {:property [:simple name]
+                               :as :as :alias nm}]]}]]]]
+    '[{[user 1] [db [id :as db-id]
+                 name :as nm]}]))
+
+(deftest parsing-joins-with-sub-aliases
+  (are [out in] (= out (q/conform-and-parse in))
+    '[{:name user :type :join
+       :join-source {:name user :type :link :link-id 1}
+       :join-target [{:name db/id :type :property :alias db-id}
+                     {:name name :type :property :alias nm}]}]
+    '[{[user 1] [db [id :as db-id]
+                 name :as nm]}]))


added the twitter and facebook links to the footer

--- src-cljs/bitfondue/core.cljs
+++ src-cljs/bitfondue/core.cljs
@@ -98,7 +98,12 @@
     [:div.col-md-4
      [:ul
       [:li [:a {:href "http://blog.bitfondue.com"} "Blog"]]
-      [:li [:a {:href "https://github.com/bitfondue"} "GitHub"]]]]]])
+      [:li [:a {:href "https://github.com/bitfondue"} "GitHub"]]]]
+    [:div.col-md-4]
+    [:div.col-md-4
+     [:ul
+      [:li [:a {:href "https://twitter.com/bitfondue"} "Twitter"]]
+      [:li [:a {:href "https://twitter.com/bitfondue"} "Facebook"]]]]]])

 (defn layout


disable timeseries when limit is set

disable timeseries when limit is set

--- src/metabase/driver/druid/query_processor.clj
+++ src/metabase/driver/druid/query_processor.clj
@@ -488,15 +488,17 @@

 (defn- druid-query-type
   "What type of Druid query type should we perform?"
-  [{breakout-fields :breakout, {ag-type :aggregation-type} :aggregation}]
+  [{breakout-fields :breakout, {ag-type :aggregation-type} :aggregation, limit :limit}]
   (let [breakouts   (condp = (count breakout-fields)
                       0 :none
                       1 :one
                         :many)
         agg?        (boolean (and ag-type (not= ag-type :rows)))
         period-set  #{:minute :hour :day :week :month :quarter :year}
-        ts?         (and (instance? DateTimeField (first breakout-fields))        ;; Checks whether the query is a timeseries (excludes x-of-y type breakouts)
-                         (contains? period-set (:unit (first breakout-fields))))]
+        ts?         (and
+                      (instance? DateTimeField (first breakout-fields))        ;; Checks whether the query is a timeseries
+                      (contains? period-set (:unit (first breakout-fields)))   ;; (excludes x-of-y type breakouts)
+                      (nil? limit))]                                           ;; (excludes queries with LIMIT)

     (match [breakouts agg? ts?]
       [:none  false    _] ::select
@@ -509,8 +511,6 @@
 (defn- build-druid-query [query]
   {:pre [(map? query)]}
   (let [query-type (druid-query-type query)]
-    (log/error "THIS SHOULD BE A Query")
-    (log/error query)
     (loop [druid-query (query-type->default-query query-type), [f & more] [handle-source-table
                                                                            handle-aggregation
                                                                            handle-breakout
@@ -532,7 +532,7 @@
 (defmulti ^:private post-process query-type-dispatch-fn)

 (defmethod post-process ::select     [_ results] (->> results first :result :events (map :event)))
-(defmethod post-process ::total [_ results] (map :result results))
+(defmethod post-process ::total      [_ results] (map :result results))
 (defmethod post-process ::topN       [_ results] (-> results first :result))
 (defmethod post-process ::groupBy    [_ results] (map :event results))

@@ -571,8 +571,6 @@
                      :settings (:settings query))]
     (binding [*query* mbql-query]
       (let [[query-type druid-query] (build-druid-query mbql-query)]
-        (log/error "THIS Query from tonative")
-        (log/error druid-query)
         {:query      druid-query
          :query-type query-type}))))

@@ -589,11 +587,6 @@
                         (post-process query-type)
                         remove-bonus-keys)
         columns    (vec (keys (first results)))]
-    (log/error "THIS Query from execute-query")
-    (log/error query)
-    (log/error "THIS result from execute-query")
-    (log/error results)
-
     {:columns   columns
      :rows      (for [row results]
                   (mapv row columns))


update buildcheck for new build machine

update buildcheck for new build machine

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -20,8 +20,11 @@

 (doto (Calendar/getInstance) (.add Calendar/HOUR -1))

+;(defn result-file [bits mode]
+;  (File. micromanager (str "/result" bits (name mode) ".txt")))
+
 (defn result-file [bits mode]
-  (File. micromanager (str "/result" bits (name mode) ".txt")))
+  (File. micromanager (str "/results" bits ".txt")))

 (defn visual-studio-errors [result-text]
   (map first
@@ -93,21 +96,21 @@
           ({:inc "INCREMENTAL" :full "FULL"} mode)
           " BUILD ERROR REPORT\n"
         "For the full build output, see " (.getAbsolutePath f)
-        "\n\nVisual Studio reported errors:"
+        "\n\nVisual Studio reported errors:\n"
         (if-not (empty? vs-error-text)
           vs-error-text
           "None.")
         "\n\nOutdated device adapter DLLs:\n"
         (if-not (empty? outdated-dlls)
-          (str-lines "\n" (map #(.getName %) outdated-dlls))
+          (str-lines (map #(.getName %) outdated-dlls))
           "None.")
           "\n\nErrors reported by java compiler:\n"
         (if-not (empty? javac-errs)
-          (str-lines "\n" javac-errs)
+          (str-lines javac-errs)
           "None.")
         "\n\nOutdated jar files:\n"
         (if-not (empty? outdated-jars)
-          (str-lines "\n" (map #(.getName %) outdated-jars))
+          (str-lines (map #(.getName %) outdated-jars))
           "None.")
         "\n\nIs installer download available on website?\n"
         (if installer-ok


Coming along, getting close to parity at least.

--- src/angelic/search/action_set/gasplan2.clj
+++ src/angelic/search/action_set/gasplan2.clj
@@ -1,13 +1,15 @@
 (ns angelic.search.action-set.gasplan2
   (:require [angelic.util :as util]
             [angelic.util.graphs :as graphs]
+            [angelic.util.queues :as queues]
             [angelic.env :as env]
             [angelic.env.util :as env-util]
             [angelic.env.state :as state]
             [angelic.hierarchy :as hierarchy]
             [angelic.hierarchy.util :as hierarchy-util]
             [angelic.sas :as sas]
-            [angelic.sas.analysis :as sas-analysis])
+            [angelic.sas.analysis :as sas-analysis]
+            clojure.inspector)
   (:import [java.util HashMap]))

@@ -17,12 +19,10 @@

 ;; no greedy for side-effects,
 ;; no directed unless all side effects scheduled,
-;; TODO greedy for 'nice' effects (doesn't really matter?)

 ;; Need to identify possible actions, children given commitments.
 ;; I.e., for resources no actions should e allowed, that propagates.

-;; TODO: Will still have to handle dangling effects.

 ;; Current handling of greedy can be exponential when there are multiple
@@ -83,10 +83,11 @@
 ;;;;;;;;;;;;;;;;;;;;; Misc TODOs
 ;; TODO: add clusters -- leave out for now.
 ;; TODO: add top-down, leave out for now.
-;; TODO: we can generate cyclic plans -- figure out how to avoid this.
 ;; TODO: heuristic costs for commitments.  At minimum, heuristic is sum of min costs of action intentions.
 ;; TODO: identify superflous resources -- i.e., over-capacity trucks.
 ;; TODO: state abstraction / teleportation / generalized goal.
+;; TODO greedy for 'nice' side-effects (doesn't really matter?)
+;; TODO: Will still have to handle dangling effects.

 ;;;;;;;;;;;;;;;;;;;;; Partition ordering
@@ -108,32 +109,23 @@
 ;;    next actions that need u also need v.
 ;;    Can be implemented with implied edges in VPG.
 ;;     (this generalizes auxiliary notion?)
-;; TODO: if children need same value, don't need to choose ?
-
+;; LATER TODO: if children need same value, don't need to choose ?
+
+;; Implied edges: if var has reservation for u
+;;

 ;;;;;;;;;;;;;;;;;;;;; Auxiliary
-;; TODO: auxiliary -- use in selecting variables, not just children
-;;   note: if multiple auxiliaries for single canonical, don't necessarily want to
-;;         choose for canonical -- screws up greedy.
 ;; TODO: don't allow reserving truck for capacity (??)
-;;       note: seems we must allow, since if t1 on p1, p1 wants t2 first,
+;;       note: careful, since if t1 on p1, p1 wants t2 first,
 ;;             prevail rules don't allow making tc1 parent of p1.
 ;; TODO: should not even allow actions on capacity ?
-;; TODO: auxiliary -- don't even allow reservation of auxiliary?  Or actions on aux, if no self actions.
-;;      (sometimes need it, i.e., gas-up only at gas stations).
-
-;; How can we get around auxiliary reservation problem in nice way?
-;;  Can say, no reservy unless you own canonical.
-;;  This means you must be able to reserve canonical even if want value greedily.
-;;  If you don't own canonical, we don't generate the edge?  Or we remove it.
-;; This also prevents actions on capacity, since they need truck, which ....
-;; And auxiliary as child of canonical should be prevented by child pruning, based on this fact.
-
+;;       (sometimes need it, i.e., gas-up only at gas stations).

 ;;;;;;;;;;;;;;;;;;;;; Action pruning
-;; TODO: object symmetries?
+;; LATER TODO: object symmetries?
 ;;       if parents are symmetric, don't need to choose between them...
+;; Done: conflicting preconditions, effects.

@@ -144,9 +136,27 @@
 ;; Case is covered by reserving t1 for tc1?  Seems OK.

-
-
-
+;;;;;;;;;; Implementation notes
+
+
+
+;;;;;;;;;;;;;;;; Auxiliary
+
+;; How can we get around auxiliary reservation problem in nice way?
+;;  Can say, no reservy unless you own canonical.
+;;  This means you must be able to reserve canonical even if want value greedily.
+;;  If you don't own canonical, we don't generate the edge.
+
+;; Actions on auxiliary not needed since when we generate them,
+;;  it must be reserved for a var
+;; And auxiliary as child of canonical should be prevented by child pruning, based on this fact.
+
+;; TODO/  note: if multiple auxiliaries for single canonical, don't necessarily want to
+;;         choose for canonical -- screws up greedy.
+
+;; Note: if t1 reserved for tc1, and p1 wants t1, p1 is blocked on tc1, also wants tc1.
+;;       this is not quite a deadlock.  Top-down could resolve this.
+;;       Failure is in

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -395,13 +405,13 @@
     (and (not (#{#{} :wait} actions ))
          (every? #(contains? (:effect-map %) v) actions))))

-;; TODO TODO TODO: must allow reserving for FUTURE action on other var.? blech.
-;; Idea was that we'd just add the action here directly.

 ;; TODO: look at other precondition variables too?
 (defn possible-children [s p child-map prevail-map auxiliary-map]
   (let [potential-children (or (when-let [c (state/get-var s (child-var p))] [c]) (child-map p))]
-    (filter #(or (get-in prevail-map [p %]) (possible-scheduled-side-effector? s p %))
+    (filter #(and (or (get-in prevail-map [p %]) (possible-scheduled-side-effector? s p %))
+                  #_ (not (= p (auxiliary-map %))))  ;; TODO: put back
+
             (let [aux (when-let [av (auxiliary-map p)] (state/get-var s (child-var av)))]
               (if (and aux (not (= aux p)))
                 (do (util/assert-is (some #{aux} potential-children))
@@ -432,6 +442,20 @@
   (some #(guaranteed-scheduled-side-effector? s v %)
         (keys (dissoc (:effect-map a) v))))

+;; Is there a precondition reserved for a scheduled action
+;; that needs v, which is also needed for a?
+(defn conflicted-precond? [s v a]
+  (some #(when-let [c (state/get-var s (child-var %))]
+           (let [acts (state/get-var s (possible-actions-var c))]
+             (and (not (= c v)) (not (= acts :wait)) (seq acts)
+                  (every? (fn [ca] (contains? (:precond-map ca) v)) acts))))
+        (keys (dissoc (:precond-map a) v))))
+
+(defn conflicted-action? [s v a]
+  (or (conflicted-effects? s v a)
+      (conflicted-precond? s v a)))
+
+

 (defn structural-partitions [actions]
   (map set (vals (group-by (comp util/keyset :precond-map) actions))))
@@ -440,6 +464,7 @@
 ;; If there are cycles that do not effect the reserving action
 ;; TODO: dynamic determination of effect clustering, conflicts
 ;; NOTE: we require that possible-actions-var is correct for vars other than v,
+;;  and children are correct for vars other than (into or out of) v?
 ;;  but state may be otherwise inconsistent.
 ;;  (must take care, this happens in future state currently...)
 (defn make-possible-actions-fn [dtgs effect-cluster-map pre-partition?]
@@ -447,7 +472,7 @@
         acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
     (fn [s v cur-val dst-val]
       (let [dtg (get-in dtgs [v cur-val])
-            actions (remove #(conflicted-effects? s v %)
+            actions (remove #(conflicted-action? s v %)
                             (if (side-effect-free-var? s v effect-cluster-map)
                               (mapcat dtg (acyclic-succ-fn v cur-val dst-val))
                               (apply concat (vals dtg))))]
@@ -458,19 +483,24 @@

 (comment (util/singleton? (get effect-cluster-map v)))

-;; TODO: where do happy belong?
 ;; TODO: better choice of unhappy child?
+;; (NOTE -- if we're choosing on behalf of auxiliary, and all actions are happy with p's value,
+;;   we MUST treat all actions as concerned -- ignoring greedy.  Just do that by default for now)
+;;   TODO: investigate sometimes re-grouping happy with indifferent.
 (defn bottom-up-expand-actions [s p unhappy-children child-map prevail-map auxiliary-map possible-actions-fn]
   (let [children                (possible-children s p child-map prevail-map auxiliary-map)
         c                       (first (util/intersection (set children) (set unhappy-children)))
         _ (util/assert-is (identity c) "%s" [s p unhappy-children children (do (clojure.inspector/inspect-tree (sort-by key s)) nil)])
         actions (state/get-var s (possible-actions-var c))
         [concerned indifferent] (util/separate #(contains? (:precond-map %) p) actions)
-        [happy unhappy]         (util/separate #(can-greedily-use? s % p c) concerned)
-        lazy-set                (set (concat happy indifferent))]
+;        [happy unhappy]         (util/separate #(can-greedily-use? s % p c) concerned)
+;        lazy-set                (set (concat happy indifferent))
+        unhappy concerned
+        lazy-set (set indifferent) ;; TODO
+        ]
     (assert (= :wait (state/get-var s (possible-actions-var p))))
     (when-let [cur-c (state/get-var s (child-var p))] (assert (= cur-c c)))
-    (assert (seq unhappy))
+;    (assert (seq unhappy)) -- can't assert with aux
     (concat
      (when (seq lazy-set)
        [(make-set-actions-action c lazy-set)])
@@ -518,6 +548,9 @@
   (println)
 #_  (println s))

+(defn inspect-state [s]
+  (clojure.inspector/inspect-tree (sort-by key (state/as-map s))))
+

 ;; Hack to deal with hanging vars -- shouldn't be needed much when auxiliary handling added.
 (defn rejigger-prevail-cg [prevail-cg]
@@ -547,8 +580,8 @@
     check-components?: check for disconnected components, rule out sources outside of goal comp
     part?: initiall partition actions based on precondition variable set."
   ([sas-problem & {:keys [directed? greedy? deadlock? dead-vars? components? part? aux?] :as m
-                   :or   {directed? true greedy? true deadlock? true dead-vars? true components? false part? true aux? true}}]
-     (assert (every? #{:directed? :greedy? :deadlock? :dead-vars? :components?} (keys m)))
+                   :or   {directed? true greedy? true deadlock? true dead-vars? true components? false part? true aux?  true}}]
+     (assert (every? #{:directed? :greedy? :deadlock? :dead-vars? :components? :aux? :part?} (keys m)))
      (assert (= greedy? true))
      (let [edge-rule     (if greedy? :greedy :naive)
            causal-graph  (remove #(apply = %) (sas-analysis/standard-causal-graph sas-problem))
@@ -568,10 +601,15 @@
            possible-actions-fn (make-possible-actions-fn dtgs effect-cluster-map part?)

            auxiliary-map (if aux? (get-auxiliary-map sas-problem) {})
-           canonicalize  (fn [bu-map]
+           canonicalize  (fn [s bu-map]
                            (reduce (fn [bum k]
                                      (if-let [nk (auxiliary-map k)]
-                                       (assoc (dissoc bum k) nk (util/union (get bum k) (get bum nk #{})))
+                                       (let [nkc (state/get-var s (child-var nk))]
+                                         (if (not nkc)
+                                           (assoc (dissoc bum k) nk (util/union (get bum k) (get bum nk #{})))
+                                           (if (some #{nkc} (get bum k))
+                                             (assoc bum k #{nkc})
+                                             (dissoc bum k))))
                                        bum))
                                    (util/map-vals set bu-map) (keys bu-map)))]
 ;       (assert (graphs/dag? causal-graph))
@@ -599,12 +637,13 @@
                   (seq (get sources-by-type :greedy))
                   (greedy-fire-actions s (first sources) possible-actions-fn)

-                  (seq (get sources-by-type :bottom-up))
-                  (let [[p-var children] (apply max-key (comp tsi first) (identity #_ canonicalize sources))]
+                  (seq (canonicalize s (get sources-by-type :bottom-up)))
+                  (let [[p-var children] (apply max-key (comp tsi first) sources)]
                     (bottom-up-expand-actions s p-var children child-var-map prevail-cvm auxiliary-map possible-actions-fn))

-                  :else (do (util/assert-is (empty? sources-by-type) "%s" [(do (print-state s) (clojure.inspector/inspect-tree (state/as-map s))
-                                                                               s)])
+                  :else (do (util/assert-is (empty? (:other sources-by-type))
+                                            "%s" [(do (print-state s) (inspect-state s)
+                                                      s)])
                             (util/print-debug 1 "Pruning since nothing to do?!"))))

                (util/print-debug 1 "Pruning due to deadlock")))))
@@ -620,7 +659,63 @@
   [(asplan-solution-name sol) rew])

-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Fancier search ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Just hte cost of committed actions
+(defn committed-actions-heuristic [s]
+  (reduce +
+          (for [[var val] (state/as-map s)
+                :when (and (= (first var) :actions)
+                           (not (= :wait val))
+                           (not (empty? val)))]
+            (apply min (map :reward val)))))
+
+;; Committed actions + shortest paths to target values.
+(defn domain-paths-heuristic [s]
+  0)
+
+;; Committed actions + shortest paths + matching for preconds.
+(defn all-committments-heuristic [s]
+  0)
+
+(defn canonicalize-state [s]
+  (into {} (for [[var val] (state/as-map s)
+                 :when (not (#{:actions :child} (first var)))]
+             [var val])))
+
+;; Keeps a separate closed list for canonical state pruning.
+(defn asplan-search
+  ([env] (asplan-search env (constantly 0)))
+  ([env heuristic]
+     (let [q       (queues/make-graph-search-pq)
+           actions (env/actions-fn env)
+           goal    (env/goal-fn env)
+           init    (env/initial-state env)
+           closed  (HashMap.)]
+        (queues/pq-add! q init (heuristic init))
+        (loop []
+          (when-not (queues/pq-empty? q)
+            (let [[s c] (queues/pq-remove-min-with-cost! q)
+                  s-r     (or (:reward (meta s)) 0)
+                  canon-s (canonicalize-state s)
+                  canon-r (get closed canon-s Double/NEGATIVE_INFINITY)]
+              (util/print-debug 3 "dequeueing " (:act-seq (meta s)) c s "\n")
+              (or (and (goal s) [(asplan-solution-name (reverse (:act-seq (meta s))))
+                                 (:reward (meta s)) #_ (println s)])
+                  (if (< s-r canon-r)
+                    (recur)
+                    (do
+                      (when (> s-r canon-r) (.put closed canon-s s-r))
+                      (let [acts (actions s)]
+                        (util/print-debug 4 "Actions are:" (map env/action-name acts) "\n")
+                        (util/print-debug 4 (for [a acts :when (not (env/applicable? a s))] (str (:name a) (:precond-map a) "not applicable" )))
+                        (doseq [a acts :when (env/applicable? a s)]
+                          (let [[ss sc] (env/successor a s)
+                                f-val (+ (:reward (meta ss)) (heuristic ss))]
+                            (when (> f-val Double/NEGATIVE_INFINITY)
+                              #_(util/print-debug 1 "warning: pruning " ss)
+                              (queues/pq-add! q ss (- 0 f-val ))))))
+                      (recur))))))))))

 ;; (do (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'angelic.util 'angelic.sas.hm-heuristic 'angelic.search.interactive) (require '[angelic.search.action-set.gasplan2 :as gap2] '[angelic.search.action-set.asplan-r :as rap]))


fix overwrite issue

fix overwrite issue

--- src/cljc/iwaswhere_web/client_store_entry.cljc
+++ src/cljc/iwaswhere_web/client_store_entry.cljc
@@ -43,10 +43,11 @@
    Does nothing when entry is already saved in backend."
   [{:keys [current-state msg-payload put-fn]}]
   (let [ts (:timestamp msg-payload)
+        geo-info (select-keys msg-payload [:timestamp :latitude :longitude])
         local-entry (get-in current-state [:new-entries ts])
-        new-state (update-in current-state [:new-entries ts] #(merge msg-payload %))]
+        new-state (update-in current-state [:new-entries ts] #(merge geo-info %))]
     (when-not local-entry
-      (put-fn [:entry/update msg-payload]))
+      (put-fn [:entry/update geo-info]))
     (when local-entry
       (update-local-storage new-state)
       {:new-state new-state})))


Only show error message on disabled buttons when there's a message (#674)

--- src/cljs/main/broadfcui/common/components.cljs
+++ src/cljs/main/broadfcui/common/components.cljs
@@ -668,7 +668,5 @@
      :ok-button on-confirm}))

 (defn create-error-message [disabled?]
-  (cond
-    (nil? disabled?) #(push-error-text "This action is disabled.")
-    (string? disabled?) #(push-error-text disabled?)
-    :else #(push-error disabled?)))
+  (when (string? disabled?)
+    #(push-error-text disabled?)))


Fix resource queries involving tags

Fix resource queries involving tags

Compiling this query needs to know the kind of database being used, with
requires it be compiled with a connection available. We were using a
connection immediately after compilation already, so we can just move
the compile inside it.

--- src/com/puppetlabs/puppetdb/http/resources.clj
+++ src/com/puppetlabs/puppetdb/http/resources.clj
@@ -80,10 +80,12 @@
   If the query can't be parsed, a 400 is returned."
   [query db]
   (try
-    (let [q (r/query->sql (json/parse-string query true))]
-      (-> (with-transacted-connection db
-            (r/query-resources q))
-          (utils/json-response)))
+    (with-transacted-connection db
+      (-> query
+        (json/parse-string true)
+        (r/query->sql)
+        (r/query-resources)
+        (utils/json-response)))
     (catch com.fasterxml.jackson.core.JsonParseException e
       (utils/error-response e))
     (catch IllegalArgumentException e


Extract common code from and/or operations

Given that the only difference between these two methods was which
operator to join on (which is an argument to the function), they've been
combined into a :connective method.

--- src/com/puppetlabs/puppetdb/query/resource.clj
+++ src/com/puppetlabs/puppetdb/query/resource.clj
@@ -12,7 +12,10 @@
   "Recursively compile a query into a structured map reflecting the terms of
   the query."
   (fn [query]
-    (string/lower-case (first query))))
+    (let [operator (string/lower-case (first query))]
+      (cond
+        (#{"and" "or"} operator) :connective
+        :else operator))))

 (defn build-join-expr
   "Builds an inner join expression between catalog_resources and the given
@@ -112,7 +115,7 @@

 ;; Join a set of predicates together with an 'and' relationship,
 ;; performing an intersection (via natural join).
-(defmethod compile-term "and"
+(defmethod compile-term :connective
   [[op & terms]]
   {:pre  [(every? vector? terms)]
    :post [(string? (:where %))]}
@@ -123,25 +126,7 @@
         params (mapcat :params terms)
         query (->> (map :where terms)
                    (map #(format "(%s)" %))
-                   (string/join " AND "))]
-    {:joins joins
-     :where query
-     :params params}))
-
-;; Join a set of predicates together with an 'or' relationship,
-;; performing a union operation.
-(defmethod compile-term "or"
-  [[op & terms]]
-  {:pre  [(every? vector? terms)]
-   :post [(string? (:where %))]}
-  (when (empty? terms)
-    (throw (IllegalArgumentException. (str op " requires at least one term"))))
-  (let [terms (map compile-term terms)
-        joins (distinct (mapcat :joins terms))
-        params (mapcat :params terms)
-        query (->> (map :where terms)
-                   (map #(format "(%s)" %))
-                   (string/join " OR "))]
+                   (string/join (format " %s " (string/upper-case op))))]
     {:joins joins
      :where query
      :params params}))


Fix clojurescript tests

Fix clojurescript tests

--- src/test/clojure/clojure/test/check/test.cljc
+++ src/test/clojure/clojure/test/check/test.cljc
@@ -662,8 +662,10 @@
   [value]
   (= value (-> value prn-str edn/read-string)))

+(def infinities #{1E1000 -1E1000})
+
 (def infinity-syntax?
-  (edn-roundtrip? Double/POSITIVE_INFINITY))
+  (edn-roundtrip? (first infinities)))

 (defspec edn-roundtrips 200
   (prop/for-all [a gen/any-equatable]
@@ -672,7 +674,7 @@
         (and (not infinity-syntax?)
              (->> a
                   (tree-seq coll? seq)
-                  (some #{Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY}))))))
+                  (some infinities))))))

 ;; not-empty works
 ;; ---------------------------------------------------------------------------


update version

update version

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -1,4 +1,4 @@
-(defproject kafka-clj "3.0.5"
+(defproject kafka-clj "3.0.6"
   :description "fast kafka library implemented in clojure"
   :url "https://github.com/gerritjvv/kafka-fast"
   :license {:name "Eclipse Public License"


New primitive must return kw.

New primitive must return kw.

--- test/onyx/plugin/input_ledger_test.clj
+++ test/onyx/plugin/input_ledger_test.clj
@@ -28,7 +28,7 @@
                              (when (= 2 (swap! batch-num inc))
                                (Thread/sleep 3000)
                                (throw (ex-info "Restartable" {:restartable? true}))))
-   :lifecycle/handle-exception (constantly true)})
+   :lifecycle/handle-exception (constantly :restart)})

 (deftest input-plugin
   (let [_ (reset! out-chan (chan 1000))


Add sample-with-filter generator utility spec function

--- backend/specs/akvo/lumen/specs.clj
+++ backend/specs/akvo/lumen/specs.clj
@@ -28,3 +28,14 @@
     #(s/gen (reduce (fn [c _] (conj c (str (squuid)))) #{} (range 100)))))

 (s/def ::sort #{"ASC" "DESC"})
+
+(defn sample-with-filter
+  "generates a sample satisfying a filter condition."
+  ([spec filter-fun]
+   (sample-with-filter spec filter-fun 10))
+  ([spec filter-fun attempts]
+   (loop [attempt 0]
+     (let [res (filter filter-fun (sample spec attempts))]
+       (if (and (empty? res) (< attempt attempts))
+         (recur (inc attempt))
+         (first res))))))


Sort the peers to a stable order before doing a relative sort.

--- src/onyx/scheduling/common_job_scheduler.clj
+++ src/onyx/scheduling/common_job_scheduler.clj
@@ -189,7 +189,7 @@
 (defn choose-ackers [replica]
   (reduce
    (fn [result job]
-     (let [peers (apply concat (vals (get-in result [:allocations job])))
+     (let [peers (apply concat (sort (vals (get-in result [:allocations job]))))
            pct (or (get-in result [:acker-percentage job]) 10)
            n (int (Math/ceil (* 0.01 pct (count peers))))
            candidates (choose-acker-candidates result peers)]


Fixed bugs:   - prevent authorization header from being logged   - fix ignored return value

--- src/org/zalando/stups/friboo/system/http.clj
+++ src/org/zalando/stups/friboo/system/http.clj
@@ -196,7 +196,7 @@
       previous-logs)))

 (defn is-modifying? [{:keys [request-method]}]
-  (some #(= % request-method) [:post :put :patch :delete]))
+  (#{:post :put :patch :delete} request-method))

 (defn collect-audit-logs
   "Adds request map to audit-logs container."
@@ -214,14 +214,15 @@
                                 (dissoc :swagger)
                                 (dissoc :configuration)
                                 (dissoc :body)
-                                (dissoc-in [:tokeninfo "access_token"]))]
+                                (dissoc-in [:tokeninfo "access_token"])
+                                (dissoc-in [:headers "authorization"]))]
               (add-logs audit-logs [audit-log])
               response)))))
     (do
       (log/info "Not logging modifying requests.")
       next-handler)))

-(def default-audit-flush-millis (* 5 60 1000))
+(def default-audit-flush-millis (* 10 1000))

 (def audit-logs-file-formatter
   "yyyy/MM/dd/{app-id}/{app-version}/{instance-id}/modifying-requests-hh-mm-ss.log
@@ -302,20 +303,21 @@
                         (s1st/ring collect-audit-logs audit-logs audit-logs-bucket)
                         (s1st/executor :resolver resolver-fn))]

-        (merge component {:audit-logs-bucket audit-logs-bucket
-                          :audit-logs        audit-logs})
-
         (if (:no-listen? configuration)
           (merge component {:httpd                nil
                             :hystrix-httpd        nil
                             :handler              handler
-                            :audit-log-flush-pool nil})
+                            :audit-log-flush-pool nil
+                            :audit-logs-bucket    audit-logs-bucket
+                            :audit-logs           audit-logs})
           (merge component {:httpd                (jetty/run-jetty handler (merge configuration
                                                                                {:join? false}))
                             :hystrix-httpd        (run-hystrix-jetty (merge configuration {:join? false
                                                                                :port  7979}))
                             :handler              handler
-                            :audit-log-flush-pool (schedule-audit-log-flusher! audit-logs-bucket audit-logs configuration)}))))))
+                            :audit-log-flush-pool (schedule-audit-log-flusher! audit-logs-bucket audit-logs configuration)
+                            :audit-logs-bucket    audit-logs-bucket
+                            :audit-logs           audit-logs}))))))

 (defn stop-component
   "Stops the http component."


Added three tests into test-core module

Added three tests into test-core module

--- test/clouseau/test_core.clj
+++ test/clouseau/test_core.clj
@@ -38,7 +38,8 @@

 (ns clouseau.test-core
   (:require [clojure.test :refer :all]
-            [clouseau.core :refer :all]))
+            [clouseau.core :refer :all]
+            [ring.adapter.jetty :as jetty]))

 ;
 ; Common functions used by tests.
@@ -119,7 +120,9 @@
     (testing "the function clouseau.core/get-port."
         (is (thrown? AssertionError (get-port "0")))
         (is (thrown? AssertionError (get-port "-1")))
+        (is (thrown? AssertionError (get-port "-2")))
         (is (thrown? AssertionError (get-port "65536")))
+        (is (thrown? AssertionError (get-port "65537")))
         (is (thrown? AssertionError (get-port "1000000")))))

 (deftest test-get-and-check-port
@@ -136,5 +139,36 @@
         (is (thrown? AssertionError (get-and-check-port "-1")))
         (is (thrown? AssertionError (get-and-check-port "0")))
         (is (thrown? AssertionError (get-and-check-port "65536")))
+        (is (thrown? AssertionError (get-and-check-port "65537")))
         (is (thrown? AssertionError (get-and-check-port "1000000")))))

+(deftest test-start-server-positive-1
+    (testing "clouseau.core/start-server"
+        ; use mock instead of jetty/run-jetty
+        (with-redefs [jetty/run-jetty (fn [app port] port)]
+            (is (= {:port 1}     (start-server "1")))
+            (is (= {:port 2}     (start-server "2")))
+            (is (= {:port 1000}  (start-server "1000")))
+            (is (= {:port 65534} (start-server "65534")))
+            (is (= {:port 65535} (start-server "65535"))))))
+
+(deftest test-start-server-positive-2
+    (testing "clouseau.core/start-server"
+        ; use mock instead of jetty/run-jetty
+        (with-redefs [jetty/run-jetty (fn [app port] app)]
+            (is (= app (start-server "1")))
+            (is (= app (start-server "2")))
+            (is (= app (start-server "1000")))
+            (is (= app (start-server "65534")))
+            (is (= app (start-server "65535"))))))
+
+(deftest test-start-server-negative
+    (testing "clouseau.core/start-server"
+        ; use mock instead of jetty/run-jetty
+        (with-redefs [jetty/run-jetty (fn [app port] port)]
+            (is (= {:port -1}      (start-server "-1")))
+            (is (= {:port 0}       (start-server "0")))
+            (is (= {:port 65536}   (start-server "65536")))
+            (is (= {:port 65537}   (start-server "65537")))
+            (is (= {:port 1000000} (start-server "1000000"))))))
+


comments

comments

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -41,7 +41,9 @@
         debug (log/debug (str "using root:" root))
         debug (log/debug (str "using spec:" (strip-refs spec)))

-        use-map-fn pmap
+;;        use-map-fn map ;; <- development
+        use-map-fn pmap ;; <- production
+
         model (-> ((-> models :en)) deref)
         type-of-model (type model)
         log-the-type (log/info (str "type of model is: " type-of-model))
@@ -85,7 +87,7 @@
                         ;; of what the (process) command did.
                         (log/debug (str "process result:" result)))
                       (catch Exception e
-                        (let [catch-and-log-error false]
+                        (let [catch-and-log-error true] ;; false: throw error and stop further generation; true: log/error and continue generation
                           (log/error (str "Could not translate source expression: "
                                           "'" (get source-expression :surface) "'"
                                           " from language: '" source-language-short-name


fix typo in exception-catching logic

fix typo in exception-catching logic

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

                                                                          true


Add todomvc example org.clojure/google-closure-library-third-party exclusion

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -3,7 +3,8 @@
   :dependencies [[org.clojure/clojure        "1.10.1"]
                  [org.clojure/clojurescript  "1.10.520"
                   :exclusions [com.google.javascript/closure-compiler-unshaded
-                               org.clojure/google-closure-library]]
+                               org.clojure/google-closure-library
+                               org.clojure/google-closure-library-third-party]]
                  [thheller/shadow-cljs       "2.8.69"]
                  [reagent                    "0.9.0-rc2"]
                  [re-frame                   "0.11.0-rc2"]


small formatting

small formatting

--- src/braid/client/events.cljs
+++ src/braid/client/events.cljs
@@ -563,10 +563,8 @@
     ; TODO
     (edn-xhr {:uri "/check"
               :method :get
-              :on-complete (fn [_]
-                             (dispatch! :start-socket))
-              :on-error (fn [_]
-                          (dispatch! :set-login-state :login-form))})
+              :on-complete (fn [_] (dispatch! :start-socket))
+              :on-error (fn [_] (dispatch! :set-login-state :login-form))})
     state))

 (reg-event-db


util update

util update

--- app/utils/src/clojure/utils/core.clj
+++ app/utils/src/clojure/utils/core.clj
@@ -3,10 +3,21 @@
     (:gen-class
         :methods [^{:static true} [fitToWidth [int String int interfaces.WidthCalcFuncComposer] String]]))

-(defn -main
-    "I don't do a whole lot ... yet."
-    [& args]
-    (println "Hello, World!"))
+(defn last-line [text]
+    (-> text
+        (#(clojure.string/split % #"\n"))
+        last))
+
+(defn longer [text1 text2]
+    (> (clojure.string/siz)))
+
+(defn fit-to-width [width text text-size width-calc-func words]
+    (if (empty? words)
+        (.trim text)
+        (let [new-line-width  (str (last-line text) " " (first words))
+              new-width-exceeds (> (width-calc-func ) width)
+              new-text (str text " " (first words))]
+            (recur width new-text text-size width-calc-func (rest words)))))

 (defn -fitToWidth [width text text-size width-calc-func]
     1)


properly decode utf8 strings in constant pool

--- src/cafebabe/class_codec.clj
+++ src/cafebabe/class_codec.clj
@@ -4,7 +4,8 @@
                                 string
                                 repeated
                                 header
-                                prefix]]))
+                                prefix
+                                finite-frame]]))

 ;;
 ;; Look here for more examples:
@@ -146,10 +147,6 @@
            :name-index       :uint16
            :descriptor-index :uint16})

-(defcodec c-str
-          (repeated :ubyte :prefix :uint16))
-
-
 ;CONSTANT_Utf8_info {
 ;                    u1 tag;
 ;                    u2 length;
@@ -157,7 +154,7 @@
 ;                    }
 (defcodec utf8-info
           {:constant-type :c-utf8
-           :str           c-str})
+           :str           (finite-frame :uint16 (string :utf8))})

 ;CONSTANT_MethodHandle_info {
 ;                            u1 tag;


separate config for components vs. tunnels

--- src/cljc/ow/starbuck/message_router.cljc
+++ src/cljc/ow/starbuck/message_router.cljc
@@ -103,7 +103,7 @@
               cunit))))

 (defn- dispatch-tunnel [{:keys [components] :as router} tunnel msg]
-  (let [tunnel-comp (get components tunnel)
+  (let [tunnel-comp (get-in components [:tunnels tunnel])
         msg (update msg ::component pop)]
     (cond (fn? tunnel-comp)                   (tunnel-comp msg)
           (satisfies? ap/Channel tunnel-comp) (a/put! tunnel-comp msg)
@@ -113,8 +113,8 @@
                                                  :msg msg})))))

 (defn- dispatch-component [{:keys [components] :as router} component msg]
-  (let [comp (or (get components component)
-                 (get components :DEFAULT))]
+  (let [comp (or (get-in components [:components component])
+                 (get-in components [:components :DEFAULT]))]
     (cond (fn? comp)                    (comp msg)
           (satisfies? ap/Channel comp)  (a/put! comp msg)
           (satisfies? p/Component comp) (p/process comp msg)
@@ -182,16 +182,16 @@

                              :booker {:next [:invoice-generator (fn [msg] :notifier)]}}}}})

-  (def browser-components1 {:input-validator #(doto % (println "(input-validator)"))
-                            :input-sanitizer #(doto % (println "(input-sanitizer)"))
-                            :server #(doto % (println "(browser -> server)"))})
-
-  (def server-components1 {:auth-checker #(doto % (println "(auth-checker)"))
-                           :booker #(doto % (println "(booker)"))
-                           :invoice-generator #(doto % (println "(invoice-generator)"))
-                           ;;;:notifier #(doto % (println "(notifier)"))
-                           :browser #(doto % (println "(server -> browser)"))
-                           :DEFAULT #(doto % (println "(DEFAULT)"))})
+  (def browser-components1 {:components {:input-validator #(doto % (println "(input-validator)"))
+                                         :input-sanitizer #(doto % (println "(input-sanitizer)"))}
+                            :tunnels {:server #(doto % (println "(browser -> server)"))}})
+
+  (def server-components1 {:components {:auth-checker #(doto % (println "(auth-checker)"))
+                                        :booker #(doto % (println "(booker)"))
+                                        :invoice-generator #(doto % (println "(invoice-generator)"))
+                                        ;;;:notifier #(doto % (println "(notifier)"))
+                                        :DEFAULT #(doto % (println "(DEFAULT)"))}
+                           :tunnels {:browser #(doto % (println "(server -> browser)"))}})

   (def browser-router1 (make-router ruleset1 browser-components1 :unit :browser))
   (def server-router1 (make-router ruleset1 server-components1 :unit :server))


Improve converstion view performance

Improve converstion view performance

Replace do loop with list-view compoment.

--- src/trustroots/shared/pages/conversation.cljs
+++ src/trustroots/shared/pages/conversation.cljs
@@ -21,52 +21,53 @@
     "gravatar" (str "https://www.gravatar.com/avatar/" emailHash)
     nil )))

+(defn list-view-item [message]
+  (let [is-someone-else  (:is-from-someone-else message)
+        is-me (not (:is-from-someone-else message))
+        bubble-bg (if is-me "#CCF" "#DDD")]
+    (do
+      ^{:key (:_id message)}
+      [view
+       {
+        :style {
+                ;:background-color "red"
+                :flex -1
+                :flex-direction "row"
+                :align-items "flex-start"
+                ;;:justify-content "flex-start"
+                ;;:flex-basis 10
+                :margin-top 10
+                }
+        }
+       (when is-me [view {:style {:flex 4 :height 0 :background-color "red"}}])
+       [view
+        {:style
+         {:flex 6
+          :background-color bubble-bg
+          :border-radius 10
+          :padding 10
+          }
+         }
+        [ui/html-view {:value (get-in message [:content])}]]
+       (when is-someone-else [view {:style {:flex 4 :height 0 :background-color "blue"}}])
+       ]
+      )
+    ))
+
+
 (defn conversation-page [{style :style}]
   (let [messages (subscribe [:current-conversation])]
     (fn []
       (log "conversation" @messages)
       [view {:style {:flex-direction "column"
                      :margin 20
+                     :flex 1
+                     :justify-content "flex-end"
                      :align-items "stretch"}}
-       [ui/text "Conversation"]
-       (for [message @messages
-             :let [is-someone-else  (:is-from-someone-else message)
-                   is-me (not (:is-from-someone-else message))
-                   bubble-bg (if is-me "#CCF" "#DDD")]
-             ]
-         (do
-           ^{:key (:_id message)}
-           [view
-            {
-             :style {
-                     ; :background-color "red"
-                     :flex -1
-                     :flex-direction "row"
-                     :align-items "flex-start"
-                     ;;:justify-content "flex-start"
-                     ;;:flex-basis 10
-                     :margin-top 10
-                     }
-             }
-            (when is-me [view {:style {:flex 4 :height 0 :background-color "red"}}])
-            [view
-             {:style
-              {:flex 6
-               :background-color bubble-bg
-               :border-radius 10
-               :padding 10
-               }
-              }
-             [ui/html-view {:value (get-in message [:content])}]]
-            (when is-someone-else [view {:style {:flex 4 :height 0 :background-color "blue"}}])
-            ]
-           )
-         )
-       [ui/button { :text "Logout"
-
-                    :value "logout"
-                    :raised true
-                    :on-press #(dispatch [:logout])}]
-      ])))
+       [list-view-with-subscription messages list-view-item "Conversation"]
+       [view {:style { :height 50 :background-color "yellow" :align-self "flex-end" :flex-direction "row"}}
+        [ui/input {:style {:flex 1 :align-self "flex-start" }}]
+        ]
+      ])))


Minor translation string change.

Minor translation string change.

--- src/uxbox/ui/workspace/sidebar/drawtools.cljs
+++ src/uxbox/ui/workspace/sidebar/drawtools.cljs
@@ -74,7 +74,7 @@
      [:div#form-tools.tool-window.drawing-tools
       [:div.tool-window-bar
        [:div.tool-window-icon i/window]
-       [:span (tr "ds.tools")]
+       [:span (tr "ds.draw-tools")]
        [:div.tool-window-close {:on-click close} i/close]]
       [:div.tool-window-content
        (for [[key props] tools


auto-add cider refactor middleware when found on classpath

seems to be a common problem for people not configuring this
properly otherwise.

--- src/main/shadow/cljs/devtools/server/nrepl.clj
+++ src/main/shadow/cljs/devtools/server/nrepl.clj
@@ -89,7 +89,11 @@
       (cond->
         (and (io/resource "cider/nrepl.clj")
              (not (false? cider)))
-        (conj 'cider.nrepl/cider-middleware))
+        (conj 'cider.nrepl/cider-middleware)
+
+        (and (io/resource "refactor_nrepl/middleware.clj")
+             (not (false? cider)))
+        (conj 'refactor-nrepl.middleware/wrap-refactor))

       (into ['nrepl.middleware/wrap-describe
              'nrepl.middleware.interruptible-eval/interruptible-eval


Add todo.

Add todo.

--- src/fhofherr/simple/engine/jobs/job_fn.clj
+++ src/fhofherr/simple/engine/jobs/job_fn.clj
@@ -39,5 +39,6 @@
             (->> ctx
                  (apply-step before false)
                  (apply-step test false)
+                 ;; TODO execute in finally
                  (apply-step after true)))]
     (with-meta job {::job-fn? true})))


Putting a feature flag around osx plans.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -26,7 +26,8 @@
             [clojure.string :as string]
             [goog.string :as gstring]
             [goog.string.format]
-            [inflections.core :as infl :refer [pluralize]])
+            [inflections.core :as infl :refer [pluralize]]
+            [frontend.models.feature :as feature])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                    [frontend.utils :refer [html]]))

@@ -397,7 +398,8 @@
                        [:span "Your trial of " (pluralize (pm/trial-containers plan) "container")
                         " ended " (pluralize (Math/abs (pm/days-left-in-trial plan)) "day")
                         " ago. Pay now to enable builds of private repositories."])))]]]]]])
-           (om/build osx-plans plan)])))))
+           (when (feature/enabled? :osx-plans)
+             (om/build osx-plans plan))])))))

 (defn piggyback-organizations [app owner]
   (om/component


(maint) Fix an intermittent testing failure with time for factsets

Our test data population code was still using its own version of time, instead
of using the one passed as an argument. This made the matchers fail in a racey
way.

Signed-off-by: Ken Barber <470bc578162732ac7f9d387d34c4af4ca6e1b6f7@bob.sh>

--- test/com/puppetlabs/puppetdb/test/http/facts.clj
+++ test/com/puppetlabs/puppetdb/test/http/facts.clj
@@ -807,8 +807,7 @@
 (defn populate-for-structured-tests
   "Populate the database with tests suitable for structured fact testing"
   [test-time]
-  (let [current-time (now)
-        facts1 {"my_structured_fact" {"a" 1
+  (let [facts1 {"my_structured_fact" {"a" 1
                                       "b" 3.14
                                       "c" ["a" "b" "c"]
                                       "d" {"n" ""}
@@ -847,7 +846,7 @@
       (scf-store/add-certname! "foo4")
       (scf-store/add-facts! {:name "foo1"
                              :values facts1
-                             :timestamp current-time
+                             :timestamp test-time
                              :environment "DEV"
                              :producer-timestamp nil})
       (scf-store/add-facts! {:name  "foo2"
@@ -857,12 +856,12 @@
                              :producer-timestamp nil})
       (scf-store/add-facts! {:name "foo3"
                              :values facts3
-                             :timestamp current-time
+                             :timestamp test-time
                              :environment "PROD"
                              :producer-timestamp nil})
       (scf-store/add-facts! {:name "foo4"
                              :values facts4
-                             :timestamp current-time
+                             :timestamp test-time
                              :environment "PROD"
                              :producer-timestamp nil})
       (scf-store/deactivate-node! "foo4"))))


Report java compiler errors

Report java compiler errors

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -15,8 +15,9 @@
   (map first
        (re-seq #"\n[^\n]+\b([1-9]|[0-9][1-9]|[0-9][0-9][1-9])\b\serror\(s\)[^\n]+\n" result-text)))

-;(defn jar-errors [result-text]
-;  (re-seq #"\nBUILD FAILED[^\n]+\n" result-text))
+(defn javac-errors [result-text]
+  (map first
+    (re-seq #"\[javac\]\s\b([1-9]|[0-9][1-9]|[0-9][0-9][1-9])\b\serrors?" result-text)))

 (defn old-dlls [dir time-limit-hours]
   (let [now (System/currentTimeMillis)
@@ -30,37 +31,41 @@
       (.listFiles dir))))

 (defn report-build-errors [bits mode]
-  (let [result-txt (slurp (result-file bits mode))
+  (let [f (result-file bits mode)
+        result-txt (slurp f)
         vs-errors (visual-studio-errors result-txt)
         outdated-dlls (old-dlls (File. micromanager
                                        (condp = bits
                                          32 "bin_Win32"
-                                         64 "bin_x64")) 24)]
-    (when-not (and (empty? vs-errors) (empty? outdated-dlls))
+                                         64 "bin_x64")) 24)
+        javac-errs (javac-errors result-txt)]
+    (when-not (and (empty? vs-errors) (empty? outdated-dlls) (empty? javac-errs))
       (println (str "MICROMANAGER " bits "-bit "
                     ({:inc "INCREMENTAL" :full "FULL"} mode)
                     " BUILD ERROR REPORT"))
+      (println (str "For a full report, see " (.getAbsolutePath f)))
       (println "\nVisual Studio reported errors:")
-      (dorun (map println vs-errors))
+      (if-not (empty? vs-errors) (dorun (map println vs-errors)) (println "None."))
       (println "\nOutdated device adapter DLLs:")
-      (dorun (map #(println (.getAbsolutePath %)) outdated-dlls))
+      (if-not (empty? outdated-dlls) (dorun (map #(println (.getAbsolutePath %)) outdated-dlls)) (println "None."))
+      (println "\nErrors reported by java compiler:")
+      (if-not (empty? javac-errs) (dorun (map println javac-errs)) (println "None."))
       (println "\n\n"))))

-(defn send-full-report [mode send?]
+(defn make-full-report [mode send?]
   (let [report
         (with-out-str
           (report-build-errors 32 mode)
           (report-build-errors 64 mode))]
-    (when send
+    (when send?
       (when-not (empty? report)
         (with-session
           "mmbuilderrors@gmail.com" (slurp "C:\\pass.txt") "smtp.gmail.com" 465 "smtp" true
-          (send-email (text-email ["info@micro-manager.org"] "mm build errors" report)))
-        (println report)
-        ))))
+          (send-email (text-email ["info@micro-manager.org"] "mm build errors" report)))))
+    (println report)))

 (defn -main [mode]
-  (send-full-report (get {"inc" :inc "full" :full} mode) true))
+  (make-full-report (get {"inc" :inc "full" :full} mode) true))


Fix visibility on ssh-build-log

Fix visibility on ssh-build-log

--- src/circle/backend/build.clj
+++ src/circle/backend/build.clj
@@ -127,7 +127,7 @@

 (def ^:dynamic *log-ns* nil) ;; contains the name of the logger for the current build

-(defn- ssh-build-log
+(defn ssh-build-log
   "This is a different function from the normal build log because 1)
   ssh/handle-out won't pass format arguments. 2) if the string does happen to
   contain a %s, we don't want format throwing because we have a %s and
@@ -136,7 +136,7 @@
   (when *log-ns*
     (log *log-ns* :info nil s)))

-(defn- ssh-build-log-error [s]
+(defn ssh-build-log-error [s]
   (when *log-ns*
     (log *log-ns* :error nil s)))


figwheel.core: handle spec syntax errors better

--- figwheel-core/src/figwheel/tools/exceptions.clj
+++ figwheel-core/src/figwheel/tools/exceptions.clj
@@ -32,14 +32,20 @@
 (defn clj-compiler-ex? [tm]
   (-> tm :via first :type pr-str (= (pr-str 'clojure.lang.Compiler$CompilerException))))

+(defn clj-spec-error? [tm]
+  (-> tm :data :clojure.spec.alpha/problems))
+
 (defn exception-type? [tm]
   (cond
     (cljs-analysis-ex? tm) :cljs/analysis-error
     (eof-reader-ex? tm)    :tools.reader/eof-reader-exception
     (reader-ex? tm)        :tools.reader/reader-exception
     (cljs-failed-compiling? tm) :cljs/general-compile-failure
+    (clj-spec-error? tm)   :clj/spec-based-syntax-error
     (clj-compiler-ex? tm)  :clj/compiler-exception
     :else nil))
+
+(derive :clj/spec-based-syntax-error :clj/compiler-exception)

 (derive :tools.reader/eof-reader-exception :tools.reader/reader-exception)

@@ -51,6 +57,9 @@
   (or
    (some-> tm :cause (string/split #"\[line.*\]") second string/trim)
    (:cause tm)))
+
+(defmethod message :clj/spec-based-syntax-error [tm]
+  (first (string/split-lines (:cause tm))))

 (defmulti blame-pos exception-type?)


Prepare defcard to add new statements

Prepare defcard to add new statements

--- src/devcards/discuss/add_statements.cljs
+++ src/devcards/discuss/add_statements.cljs
@@ -3,20 +3,22 @@
             [discuss.parser :as parser]
             [discuss.views :as views]
             [devcards.discuss.utils :as dutils]
-            [om.next :as om]))
+            [om.next :as om]
+            [discuss.utils.common :as lib]))

-(defcard shortcuts dutils/shortcuts)
+(defcard shortcuts
+  dutils/shortcuts)

 (def sample-api-route "/town-has-to-cut-spending/justify/37/agree?history=/attitude/37")
-
-(def ^:private stmts-reconciler
-  (om/reconciler {:state (assoc @(om/app-state parser/reconciler) :api/last-call sample-api-route)
-                  :parser (om/parser {:read parser/read :mutate parser/mutate})}))

 (defcard-om-next main-content-view
   views/MainContentView
   parser/reconciler)

+(dc/defcard-doc
+  "Do request to the following Route:"
+  sample-api-route)
+
 (defcard-om-next add-new-statement
   views/AddElement
   parser/reconciler)


fill in missing docstrings

fill in missing docstrings

--- src/clj/com/rpl/specter.cljx
+++ src/clj/com/rpl/specter.cljx
@@ -23,8 +23,14 @@
             [clojure.set :as set])
   )

-(defn comp-paths [& paths]
-  (i/comp-paths* (vec paths)))
+(defn comp-paths
+  "Returns a compiled version of the given path for use with
+   compiled-{select/transform/setval/etc.} functions. This can compile navigators
+   (defined with `defnav`) without their parameters, and the resulting compiled
+   path will require parameters for all such navigators in the order in which
+   they were declared."
+  [& apath]
+  (i/comp-paths* (vec apath)))

 (def ^{:doc "Mandate that operations that do inline path factoring and compilation
              (select/transform/setval/replace-in/path/etc.) must succeed in
@@ -151,13 +157,25 @@
   (transform* [this structure next-fn]
     (next-fn structure)))

-(def ALL (comp-paths (i/->AllNavigator)))
+(def
+  ^{:doc "Navigate to every element of the collection. For maps navigates to
+          a vector of `[key value]`."}
+  ALL
+  (comp-paths (i/->AllNavigator)))

 (def VAL (i/->ValCollect))

-(def LAST (comp-paths (i/->PosNavigator i/get-last i/update-last)))
-
-(def FIRST (comp-paths (i/->PosNavigator i/get-first i/update-first)))
+(def
+  ^{:doc "Navigate to the last element of the collection. If the collection is
+          empty navigation is stopped at this point."}
+  LAST
+  (comp-paths (i/->PosNavigator i/get-last i/update-last)))
+
+(def
+  ^{:doc "Navigate to the first element of the collection. If the collection is
+          empty navigation is stopped at this point."}
+  FIRST
+  (comp-paths (i/->PosNavigator i/get-first i/update-first)))

 (defnav
   ^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
@@ -199,9 +217,15 @@
       (reverse (i/matching-ranges structure pred))
       )))

-(def BEGINNING (srange 0 0))
-
-(def END (srange-dynamic count count))
+(def
+  ^{:doc "Navigate to the empty subsequence before the first element of the collection."}
+  BEGINNING
+  (srange 0 0))
+
+(def
+ ^{:doc "Navigate to the empty subsequence after the last element of the collection."}
+  END
+  (srange-dynamic count count))

 (defnav
   ^{:doc "Navigates to the specified subset (by taking an intersection).
@@ -235,6 +259,8 @@
              newmap))))

 (defnav
+  ^{:doc "Using clojure.walk, navigate the data structure until reaching
+          a value for which `afn` returns truthy."}
   walker
   [afn]
   (select* [this structure next-fn]
@@ -243,6 +269,7 @@
     (i/walk-until afn next-fn structure)))

 (defnav
+  ^{:doc "Like `walker` but maintains metadata of any forms traversed."}
   codewalker
   [afn]
   (select* [this structure next-fn]
@@ -304,7 +331,12 @@
     (next-fn (afn structure))
     ))

-(defnav parser [parse-fn unparse-fn]
+(defnav
+  ^{:doc "Navigate to the result of running `parse-fn` on the value. For
+          transforms, the transformed value then has `unparse-fn` run on
+          it to get the final value at this point."}
+  parser
+  [parse-fn unparse-fn]
   (select* [this structure next-fn]
     (next-fn (parse-fn structure)))
   (transform* [this structure next-fn]
@@ -420,17 +452,39 @@
   (transform* [this structure next-fn]
     (next-fn (if (nil? structure) v structure))))

-(def NIL->SET (nil->val #{}))
-(def NIL->LIST (nil->val '()))
-(def NIL->VECTOR (nil->val []))
-
-(defpathedfn collect [& path]
+(def
+  ^{:doc "Navigates to #{} if the value is nil. Otherwise it stays
+          navigated at the current value."}
+  NIL->SET
+  (nil->val #{}))
+
+(def
+  ^{:doc "Navigates to '() if the value is nil. Otherwise it stays
+          navigated at the current value."}
+  NIL->LIST
+  (nil->val '()))
+
+(def
+  ^{:doc "Navigates to [] if the value is nil. Otherwise it stays
+          navigated at the current value."}
+  NIL->VECTOR
+  (nil->val []))
+
+(defpathedfn
+  ^{:doc "Adds the result of running select with the given path on the
+          current value to the collected vals."}
+  collect
+  [& path]
   (pathed-collector [late path]
     (collect-val [this structure]
       (compiled-select late structure)
       )))

-(defpathedfn collect-one [& path]
+(defpathedfn
+  ^{:doc "Adds the result of running select-one with the given path on the
+          current value to the collected vals."}
+  collect-one
+  [& path]
   (pathed-collector [late path]
     (collect-val [this structure]
       (compiled-select-one late structure)


Improve cardlist

Improve cardlist

--- src/cljs/decktouch/core.cljs
+++ src/cljs/decktouch/core.cljs
@@ -15,13 +15,38 @@
   [:li
    (str card)])

+(defn is-card-of-type? [card type]
+  (contains? (set (get card "types")) type))
+
+(defn filter-cards-by-type [cards type]
+  (filter (fn [card] (let [c (js->clj card)]
+                       (is-card-of-type? c type))) cards))
+
+(defn card-type-list [cards type]
+  (let [filtered-cards-by-type (filter-cards-by-type cards type)]
+    (if (not-empty filtered-cards-by-type)
+      [:div
+        [:p type]
+        [:ul
+          (for [card (filter-cards-by-type cards type)]
+               ^{:key card} (card-in-list (get card "name")))]])))
+
+
 (defn card-list [cards]
   (if (empty? cards)
-    [:span "Add some cards!"]
+    [:strong "Add some cards!"]
     ;; else
-    [:ul
-     (for [card cards]
-       ^{:key card} (card-in-list (get card "name")))]))
+    [:div.row
+      [:div.col-md-2
+        [card-type-list cards "Creature"]
+        [card-type-list cards "Land"]]
+      [:div.col-md-2
+        [card-type-list cards "Planeswalker"]
+        [card-type-list cards "Instant"]
+        [card-type-list cards "Sorcery"]
+        (let [noncreature-cards (filter #(not (is-card-of-type? % "Creature")) cards)]
+          [card-type-list noncreature-cards "Enchantment" {:not "Creature"}])
+        [card-type-list cards "Artifact"]]]))

 (defn record-mana-freq [mana-map mana]
   (if (contains? mana-map mana)


add rudimentary attacking

add rudimentary attacking

--- src/cljs/dodgeball/core.cljs
+++ src/cljs/dodgeball/core.cljs
@@ -43,6 +43,11 @@
   (cond
     (or (= y 4) (= y 7)) "middle-top"))

+(defn defense []
+  (if (= (:turn @game) :red-team)
+    :blue-team
+    :red-team))
+
 (defn switch-turns []
   (if (= (:turn @game) :red-team)
     (do
@@ -92,14 +97,23 @@
     (swap! game assoc-in [:units (:turn @game)] (conj team updated-unit))))

 (defn move-unit [x y]
-    (let [selected-unit (selected-unit)
-        updated-unit
-        (conj
-         selected-unit
-         {:coords {:x x :y y}})
-        team
-        (filter #(not= selected-unit %) (active-team))]
-      (swap! game assoc-in [:units (:turn @game)] (conj team updated-unit))))
+  (let [selected-unit (selected-unit)
+      updated-unit
+      (conj
+       selected-unit
+       {:coords {:x x :y y}})
+      team
+      (filter #(not= selected-unit %) (active-team))]
+    (swap! game assoc-in [:units (:turn @game)] (conj team updated-unit))))
+
+(defn attack [x y]
+  (let [selected-unit (selected-unit)
+        updated-unit  (conj selected-unit {:ball false})
+        defense-unit  (unit? x y (defense))
+        team          (filter #(not= selected-unit %) (active-team))]
+    (do
+      (swap! game assoc-in [:units (:turn @game)] (conj team updated-unit))
+      (println "Attack: " (rand-int 8) "Defense: " (rand-int 8)))))

 (defn ball-in-front-of-unit? [ball unit]
   (let [ball-x (:x (:coords ball))
@@ -138,7 +152,7 @@

 (defn unit-class [x y]
   (let [blue-unit (unit? x y :blue-team)
-        red-unit (unit? x y :red-team)
+        red-unit  (unit? x y :red-team)
         ball-unit (unit? x y :balls)]
   (str
     (cond
@@ -184,13 +198,13 @@
   (cond
    (and
     (= nil (selected-unit))
-    (unit? x y (:turn @game)))
+    (boolean (unit? x y (:turn @game))))
    {:type   :select-unit
     :id     (:id (unit? x y (:turn @game)))
     :coords {:x x :y y}}

    (or
-     (unit? x y (:turn @game))
+     (boolean (unit? x y (:turn @game)))
      (not (in-range? x y (:id (selected-unit)))))
    {:type   :deselect-unit
     :id     (:id (unit? x y (:turn @game)))
@@ -201,11 +215,18 @@
     :id     (:id (unit? x y :balls))
     :coords {:x x :y y}}

+   (boolean (unit? x y (defense)))
+   {:type :attack
+    :id (:id (unit? x y (:turn @game)))
+    :coords {:x x :y y}}
+

    (in-range? x y (:id (unit? x y (:turn @game))))
    {:type :move-unit
     :id (:id (unit? x y (:turn @game)))
     :coords {:x x :y y}}
+
+

    :else
      (println x y (:turn @game))))
@@ -232,18 +253,25 @@
    (.getElementById js/document "app"))
   (go
    (loop []
-     (let [event (<! ch)]
+     (let [event (<! ch)
+           x (:x (:coords event))
+           y (:y (:coords event))]
        (println event)
         (case (:type event)
           :select-unit   (select-unit (:id event))
           :deselect-unit (deselect-unit)
           :move-unit     (do
-                           (move-unit   (:x (:coords event)) (:y (:coords event)))
+                           (move-unit x y)
                            (swap! game update-in [:actions] inc)
                            (deselect-unit)
                            (if (= (:actions @game) 2) (switch-turns)))
           :pickup-ball   (do
-                           (pickup-ball (:x (:coords event)) (:y (:coords event)))
+                           (pickup-ball x y)
+                           (swap! game update-in [:actions] inc)
+                           (deselect-unit)
+                           (if (= (:actions @game) 2) (switch-turns)))
+          :attack        (do
+                           (attack x y)
                            (swap! game update-in [:actions] inc)
                            (deselect-unit)
                            (if (= (:actions @game) 2) (switch-turns))))


refactoring of ai

refactoring of ai

--- src/cljs/triboard/ai/ai.cljs
+++ src/cljs/triboard/ai/ai.cljs
@@ -29,6 +29,13 @@
         all-possible-scores (map #(score-move weights-by-cell player %) all-adverse-moves)]
     (scores/min-delta-for player all-possible-scores)))

+(defn- move-best-outcome
+  [weights-by-cell player others turn [coord converted :as move]]
+  (let [new-turn (turn/play-move turn coord)
+        move-diff (get (score-move weights-by-cell player move) player)
+        next-diff (get-worst-possible-score-for weights-by-cell new-turn player others)]
+    (+ move-diff next-diff)))
+

 ;; -----------------------------------------
 ;; Public API
@@ -44,13 +51,74 @@
         others (remove #{player} cst/players)]
     (first
       (utils/fast-max-key
-        (fn [[m converted :as move]]
-          (let [new-turn (turn/play-move turn m)
-                move-diff (get (score-move weights-by-cell player move) player)
-                next-diff (get-worst-possible-score-for weights-by-cell new-turn player others)]
-            (+ move-diff next-diff)))
+        #(move-best-outcome weights-by-cell player others turn %)
         (turn/get-moves-of turn player)
         ))
     ))

+#_(
+    (ns triboard.ai.ai
+      (:require
+        [triboard.ai.scores :as scores]
+        [triboard.logic.board :as board]
+        [triboard.logic.constants :as cst]
+        [triboard.logic.move :as move]
+        [triboard.logic.turn :as turn]
+        [triboard.utils :as utils]
+        ))

+
+    ;; -----------------------------------------
+    ;; Private
+    ;; -----------------------------------------
+
+    (defn- to-ai-input
+      [turn player]
+      {:player player
+       :other-players (remove #{player cst/players})
+       :cell-weights (scores/get-weights-by-cell (turn/get-board turn))
+       })
+
+    (defn- score-move
+      "Compute the strength of a move, based on the converted cells"
+      [{:keys [player cell-weights]} [point conversions]]
+      {:pre [(move/conversions? conversions)]}
+      (reduce
+        #(scores/update-score-diff cell-weights %1 %2)
+        scores/null-score-diff
+        (conj conversions
+          (move/empty-cell-conversion player point))
+        ))
+
+    (defn- get-worst-possible-score-for
+      [{:keys [player other-players] :as ai-input} turn]
+      (let [all-adverse-moves (mapcat #(turn/get-moves-of turn %) other-players)
+            all-possible-scores (map #(score-move ai-input %) all-adverse-moves)]
+        (scores/min-delta-for player all-possible-scores)
+        ))
+
+    (defn- move-best-outcome
+      [ai-input turn [coord converted :as move]]
+      (let [new-turn (turn/play-move turn coord)
+            move-diff (get (score-move ai-input move) (:player ai-input))
+            next-diff (get-worst-possible-score-for ai-input new-turn)]
+        (+ move-diff next-diff)))
+
+
+    ;; -----------------------------------------
+    ;; Public API
+    ;; -----------------------------------------
+
+    (defn best-move
+      "[SIMPLISTIC] Return the best move for a player based on:
+       * The immediate gain
+       * The worse immediate lost afterwards"
+      {:pre [(player? player)] :post [(board/coord? %)]}
+      [turn player]
+      (let [ai-input (to-ai-input turn player)]
+        (first
+          (utils/fast-max-key #(move-best-outcome ai-input turn %) (turn/get-moves-of turn player))
+          )))
+
+    )
+


Prevent job-JAR compilation errors from killing the REPL.

--- src/clojure/parkour/repl.clj
+++ src/clojure/parkour/repl.clj
@@ -21,15 +21,18 @@
   `(do
      (require 'leiningen.core.project
               'leiningen.core.classpath
+              'leiningen.core.main
               'leiningen.with-profile
               'leiningen.jar)
-     (let [project# (leiningen.core.project/read
-                     "project.clj" [:default :jobjar])
-           deps-project# (leiningen.core.project/unmerge-profiles
-                          project# [:default])]
-       {:dep-paths (->> (leiningen.core.classpath/get-classpath deps-project#)
-                        (filter #(.endsWith % ".jar")))
-        :jobjar-path (get (leiningen.jar/jar project#) [:extension "jar"])})))
+     (binding [leiningen.core.main/*exit-process?* false]
+       (let [project# (leiningen.core.project/read
+                       "project.clj" [:default :jobjar])
+             deps-project# (leiningen.core.project/unmerge-profiles
+                            project# [:default])]
+         {:dep-paths (->> (leiningen.core.classpath/get-classpath deps-project#)
+                          (filter #(.endsWith % ".jar")))
+          :jobjar-path (get (leiningen.jar/jar project#)
+                            [:extension "jar"])}))))

 (defn ^:private user-home
   "User HDFS home directory."


Remove a stray printstacktrace statement

--- src/clojure/picard/netty.clj
+++ src/clojure/picard/netty.clj
@@ -226,23 +226,20 @@
         ;; handler, but throwing a lock here doesn't
         ;; bother me much.
         (locking list
-          (try
-            (let [ch ^Channel (.getChannel evt)]
-              (cond
-               (instance? MessageEvent evt)
-               (do
-                 (.add list evt)
-                 (purge-evt-buffer list ctx evt ch))
-
-               (and (instance? ChannelStateEvent evt)
-                    (= ChannelState/INTEREST_OPS
-                       (.getState ^ChannelStateEvent evt)))
-               (do (purge-evt-buffer list ctx evt ch)
-                   (.sendUpstream ctx evt))
-               :else
-               (.sendUpstream ctx evt)))
-            (catch Exception err
-              (.printStackTrace err))))))))
+          (let [ch ^Channel (.getChannel evt)]
+            (cond
+             (instance? MessageEvent evt)
+             (do
+               (.add list evt)
+               (purge-evt-buffer list ctx evt ch))
+
+             (and (instance? ChannelStateEvent evt)
+                  (= ChannelState/INTEREST_OPS
+                     (.getState ^ChannelStateEvent evt)))
+             (do (purge-evt-buffer list ctx evt ch)
+                 (.sendUpstream ctx evt))
+             :else
+             (.sendUpstream ctx evt))))))))

 (defn- ^ChannelPipelineFactory mk-pipeline-factory
   [^ChannelGroup channel-group pipeline-fn opts]


Make workflow name/number link

Make workflow name/number link

--- src-cljs/frontend/components/pages/workflow.cljs
+++ src-cljs/frontend/components/pages/workflow.cljs
@@ -58,7 +58,8 @@
              [:div.run-info
               [:div.build-info-header
                [:div.contextual-identifier
-                [:span "workflow-name #1234"]]]
+                [:a {:href (routes/v1-run {:run-id id})}
+                 [:span "workflow-name #1234"]]]]
               [:div.recent-commit-msg
                [:span.recent-log "This is the thing that triggered the run"]]]
              [:div.metadata


(#14665) Removal of SSL provider fails when class not available

For compatibility with OpenJDK and OpenSSL 1.0+, we remove a buggy OpenJDK
security provider. We do this by enumerating the current set of security
providers and removing the problematic ones by checking if they are the
instance of a specific class.

However, if that class doesn't exist on the system at all, we get a
ClassNotFoundException. We had a try/catch around this code for just that
reason, only it turns out the try/catch isn't getting invoked when the error is
thrown.

This is because that code lives at the top-level of the namespace, and is
executed when the namespace is compiled. But the compiler can't find all the
classes mentioned in the code it's trying to compile, and the
ClassNotFoundException is actually thrown at compile-time...before the
try/catch code is compiled and live.

The fix is to change the declaration of the class (which may not actually
exist) from a compile-time declaration to a run-time declaration (using
Class/forName).

Signed-off-by: Deepak Giridharagopal <d11186354d1ef01ca06ae37d7e23e827da13e85f@puppetlabs.com>

--- src/com/puppetlabs/jetty.clj
+++ src/com/puppetlabs/jetty.clj
@@ -18,10 +18,12 @@
 ;; https://bugs.launchpad.net/ubuntu/+source/openjdk-6/+bug/948875
 (if (re-find #"OpenJDK" (System/getProperty "java.vm.name"))
   (try
-    (let [blacklist (filter #(instance? sun.security.pkcs11.SunPKCS11 %) (java.security.Security/getProviders))]
+    (let [klass     (Class/forName "sun.security.pkcs11.SunPKCS11")
+          blacklist (filter #(instance? klass %) (java.security.Security/getProviders))]
       (doseq [provider blacklist]
         (log/info (str "Removing buggy security provider " provider))
         (java.security.Security/removeProvider (.getName provider))))
+    (catch ClassNotFoundException e)
     (catch Throwable e
       (log/error e "Could not remove security providers; HTTPS may not work!"))))


Write to the cache before publishing

Write to the cache before publishing

On windows, the cache value isn't always visible if we write to the
caches after publishing.

--- transactions/test/immutant/transactions_test.clj
+++ transactions/test/immutant/transactions_test.clj
@@ -63,9 +63,9 @@
     int))

 (defn work [m]
+  (csh/swap-in! cache :a (constantly 1))
   (msg/publish queue "kiwi")
   (msg/publish remote-queue "starfruit")
-  (csh/swap-in! cache :a (constantly 1))
   (not-supported
     (csh/swap-in! cache :deliveries (fnil inc 0)))
   (sql/with-db-transaction [t spec]


(PDB-4655) threadpool-test: check log event message for thread name

Instead of checking the log event's thread name directly via
.getThreadName, look for the thread name in the message (generated via
logging-exception-handler).

We'd noticed that the name was sometimes "main" in travis, and suspect
the problem may be a timing issue with the code in logback
LoggingEvent's getThreadName, which appears to wait to grab/cache the
current thread's name the first time you ask for it.

Perhaps related: https://jira.qos.ch/browse/LOGBACK-1088

--- test/puppetlabs/puppetdb/threadpool_test.clj
+++ test/puppetlabs/puppetdb/threadpool_test.clj
@@ -173,12 +173,13 @@
                   (println @log-output)))

               (let [log-event (first @log-output)]
-                (is (= "ERROR"
-                       (-> log-event
-                           .getLevel
-                           str)))
-
-                (is (= "testpool-1" (.getThreadName log-event))))
+
+                (is (= "ERROR" (-> log-event .getLevel str)))
+
+                (when-not (is (re-find #"error from thread testpool-1"
+                                       (.getMessage log-event)))
+                  (binding [*out* *err*]
+                    (println "Unexpected log event" log-event))))

               (finally
                 (.shutdownNow threadpool))))))))


Remove flaky test: Fixing flakiness is to hard for the value this test provides and the flakiness is confusing people and adds extra work

--- test/clj/lambdacd/steps/control_flow_test.clj
+++ test/clj/lambdacd/steps/control_flow_test.clj
@@ -256,16 +256,6 @@
       (is (= [{:status :running}
               {:status :waiting}
               {:status :success}] (slurp-chan result-ch)))))
-  (testing "that it doesn't inherit the status of nested children"; TODO: flaky
-    (let [result-ch (async/chan 100)
-          ctx (some-ctx-with :result-channel result-ch
-                             :pipeline-state-component (noop-pipeline-state/new-no-op-pipeline-state)
-                             :config {:config {:step-updates-per-sec nil}})]
-      ((either (run some-successful-step some-failing-step) some-failing-step) {} ctx)
-      (is (= [{:status :running}
-              {:status :success}
-              {:status :running}
-              {:status :failure}] (slurp-chan result-ch)))))
   (testing "that it kills all children if it was already killed in the beginning"
     (let [is-killed (atom true)
           ctx       (some-ctx-with :is-killed is-killed


Add more icons.

Add more icons.


Didn't check in some tests

Didn't check in some tests

--- test/midje/internal_ideas/t_project_state.clj
+++ test/midje/internal_ideas/t_project_state.clj
@@ -69,6 +69,11 @@

  (def cleaner) ; standin for the calculated dependency cleaner
+ (def failure-record (atom {}))
+ (on-require-failure [ns throwable]
+   (swap! failure-record (constantly {:ns ns, :throwable throwable})))
+
+
  (fact "A namespace list can be loaded, obeying dependents"
    (require-namespaces! [] cleaner) => anything

@@ -82,14 +87,14 @@
      (require ..ns1.. :reload) => nil
      (require ..ns2.. :reload) => nil)

+

    (let [throwable (Error.)]
      (require-namespaces! [..ns1.. ..ns2.. ..ns3..] cleaner) => anything
      (provided
        (require ..ns1.. :reload) =throws=> throwable
-       (inform-user-of-require-failure ..ns1.. throwable) => anything
        (cleaner ..ns1.. [..ns2.. ..ns3..]) => [..ns3..]
-       (require ..ns3.. :reload) => nil))
-   )
+       (require ..ns3.. :reload) => nil)
+     @failure-record => {:ns ..ns1.. :throwable throwable}))

  )