Fix tests

Fix tests

--- test/cljc/spec_tools/json_schema_test.cljc
+++ test/cljc/spec_tools/json_schema_test.cljc
@@ -1,14 +1,13 @@
 (ns spec-tools.json-schema-test
-  (:require  [clojure.test :refer [deftest testing is]]
-             [clojure.spec :as s]
-             [clojure.spec.test :as stest]
-             [com.gfredericks.test.chuck.clojure-test :refer [checking]]
-             #?(:clj [scjsv.core :as scjsv])
-             [spec-tools.core :as st]
-             [spec-tools.impl :as impl]
-             [spec-tools.json-schema :as jsc]))
+  (:require [clojure.test :refer [deftest testing is]]
+            [clojure.spec :as s]
+            [com.gfredericks.test.chuck.clojure-test :refer [checking]]
+    #?(:clj
+            [scjsv.core :as scjsv])
+            [spec-tools.core :as st]
+            [spec-tools.json-schema :as jsc]))

-(s/def ::int int?)
+(s/def ::integer integer?)
 (s/def ::string string?)
 (s/def ::set #{1 2 3})

@@ -16,7 +15,7 @@
   (testing "primitive predicates"
     ;; You're intented to call jsc/to-json with a registered spec, but to avoid
     ;; boilerplate, we do inline specization here.
-    (is (= (jsc/to-json (s/spec int?)) {:type "integer"}))
+    (is (= (jsc/to-json (s/spec int?)) {:type "integer" :format "int64"}))
     (is (= (jsc/to-json (s/spec integer?)) {:type "integer"}))
     (is (= (jsc/to-json (s/spec float?)) {:type "number"}))
     (is (= (jsc/to-json (s/spec double?)) {:type "number"}))
@@ -26,28 +25,28 @@
     (is (= (jsc/to-json #{1 2 3}) {:enum [1 3 2]})))
   (testing "clojure.spec predicates"
     (is (= (jsc/to-json (s/nilable ::string)) {:oneOf [{:type "string"} {:type "null"}]}))
-    (is (= (jsc/to-json (s/int-in 1 10)) {:allOf [{:type "integer"} {:minimum 1 :maximum 10}]})))
+    (is (= (jsc/to-json (s/int-in 1 10)) {:allOf [{:type "integer" :format "int64"} {:minimum 1 :maximum 10}]})))
   (testing "simple specs"
-    (is (= (jsc/to-json ::int) {:type "integer"}))
+    (is (= (jsc/to-json ::integer) {:type "integer"}))
     (is (= (jsc/to-json ::set) {:enum [1 3 2]})))
   (testing "composite objects"
-    (is (= (jsc/to-json (s/keys :req-un [::int] :opt-un [::string]))
+    (is (= (jsc/to-json (s/keys :req-un [::integer] :opt-un [::string]))
            {:type "object"
-            :properties {"int" {:type "integer"} "string" {:type "string"}}
-            :required ["int"]}))
-    (is (= (jsc/to-json (s/tuple int? string?))
+            :properties {"integer" {:type "integer"} "string" {:type "string"}}
+            :required ["integer"]}))
+    (is (= (jsc/to-json (s/tuple integer? string?))
            {:type "array" :items [{:type "integer"} {:type "string"}] :minItems 2}))
-    (is (= (jsc/to-json (s/* int?)) {:type "array" :items {:type "integer"}}))
-    (is (= (jsc/to-json (s/+ int?)) {:type "array" :items {:type "integer"} :minItems 1}))
+    (is (= (jsc/to-json (s/* integer?)) {:type "array" :items {:type "integer"}}))
+    (is (= (jsc/to-json (s/+ integer?)) {:type "array" :items {:type "integer"} :minItems 1}))
     ;; The following tests require the full qualifying of the predicates until
     ;; this is fixed: <http://dev.clojure.org/jira/browse/CLJ-2035>
-    (is (= (jsc/to-json (s/every clojure.core/int?)) {:type "array" :items {:type "integer"}}))
+    (is (= (jsc/to-json (s/every clojure.core/integer?)) {:type "array" :items {:type "integer"}}))
     (is (= (jsc/to-json (s/map-of clojure.core/string? clojure.core/integer?))
            {:type "object" :additionalProperties {:type "integer"}})))
   (testing "composite specs"
-    (is (= (jsc/to-json (s/or :int int? :string string?))
+    (is (= (jsc/to-json (s/or :int integer? :string string?))
            {:anyOf [{:type "integer"} {:type "string"}]}))
-    (is (= (jsc/to-json (s/and int? pos?))
+    (is (= (jsc/to-json (s/and integer? pos?))
            {:allOf [{:type "integer"} {:minimum 0 :exclusiveMinimum true}]}))))

 #?(:clj
@@ -56,18 +55,18 @@
        (testing (str "with spec " spec)
          (checking "JSON schema accepts the data generated by the spec gen" 100
            [x (s/gen spec)]
-           (is (nil? (validate x))))))))
+           (is (nil? (validate x)) (str x " (" spec ") does not conform to JSON Schema")))))))

-(s/def ::compound (s/keys :req-un [::int] :opt-un [::string]))
+(s/def ::compound (s/keys :req-un [::integer] :opt-un [::string]))

 #?(:clj
-   (deftest validating-test
-     (test-spec-conversion ::int)
-     (test-spec-conversion ::string)
-     (test-spec-conversion ::set)
-     (test-spec-conversion ::compound)
-     (test-spec-conversion (s/nilable ::string))
-     (test-spec-conversion (s/int-in 0 100))))
+    (deftest validating-test
+      (test-spec-conversion ::integer)
+      (test-spec-conversion ::string)
+      (test-spec-conversion ::set)
+      (test-spec-conversion ::compound)
+      (test-spec-conversion (s/nilable ::string))
+      (test-spec-conversion (s/int-in 0 100))))

 ;; Test the example from README

@@ -75,14 +74,14 @@

 (def person-spec
   (st/coll-spec
-   ::person
-   {::id clojure.core/integer?
-    :age ::age
-    :name clojure.core/string?
-    :likes {clojure.core/string? clojure.core/boolean?}
-    (st/req :languages) #{clojure.core/keyword?}
-    (st/opt :address) {:street clojure.core/string?
-                       :zip clojure.core/string?}}))
+    ::person
+    {::id clojure.core/integer?
+     :age ::age
+     :name clojure.core/string?
+     :likes {clojure.core/string? clojure.core/boolean?}
+     (st/req :languages) #{clojure.core/keyword?}
+     (st/opt :address) {:street clojure.core/string?
+                        :zip clojure.core/string?}}))

 (deftest readme-test
   (is (= {:type "object"


test more options when round-tripping

test more options when round-tripping

--- test/id3_test.clj
+++ test/id3_test.clj
@@ -59,8 +59,44 @@
 				(testing (str "Reading " file)
 					(is (= tag (with-mp3 [mp3 file] (:id3/tag mp3)))))))))

+(defn normalize-full-tag [tag]
+	(-> tag
+		(dissoc :id3/size)
+		(update :id3/frames (fn [frames]
+			(mapv #(dissoc % :id3.frame/size :id3.frame/encoding) frames)))))
+
 (deftest round-trip
-	(let [tag #:id3.frame.name{:artist ["Nobody"], :title ["Nothing"]}]
-		(doseq [opts [[:version 4] [:version 3] [:encoding latin1] [:encoding utf16] [:padding 0]]]
-			(testing (str "Round-tripping with " opts)
-				(is (= tag (read-tag (ByteArrayInputStream. (apply write-tag-to-bytes tag opts)))))))))
+	(let [
+			full-tag #:id3{
+				:magic-number "ID3"
+				:version 4
+				:revision 0
+				:flags #{}
+				:size 35
+				:frames [
+					#:id3.frame{
+						:encoding "ISO-8859-1"
+						:content ["Nothing"]
+						:size 8
+						:id "TIT2"
+						:flags #{}}
+					#:id3.frame{
+						:encoding "ISO-8859-1"
+						:content ["Nobody"]
+						:size 7
+						:id "TPE1"
+						:flags #{}}]}
+			normalize (fn [tag]
+				(cond-> tag
+					(= :full (id3/tag-format tag)) normalize-full-tag))]
+		(doseq [ver [nil 3 4], enc [nil latin1 utf16], pad [nil 0 123], fmt [:simple :normal :full]]
+			(let [
+					tag (id3/downconvert-tag full-tag fmt)
+					opts (m/remove-vals nil? {:version ver, :encoding enc, :padding pad})]
+				(testing (format "Round-tripping with format: %s, opts: %s" fmt opts)
+					(is (= (normalize tag)
+						(-> tag
+							(write-tag-to-bytes opts)
+							ByteArrayInputStream.
+							(read-tag :format fmt)
+							normalize))))))))


(maint) remove commented out tests

(maint) remove commented out tests

These tests have been commented out for a while as they were the earliest tests
that validated action logic from a distance.  They are now covered by the tests
for connection-states and can be removed.

--- test/puppetlabs/cthun/websockets_test.clj
+++ test/puppetlabs/cthun/websockets_test.clj
@@ -1,54 +1,6 @@
 (ns puppetlabs.cthun.websockets-test
   (:require [clojure.test :refer :all]
             [puppetlabs.cthun.websockets :refer :all]))
-
-; Private websocket event handler tests
-
-;; TODO(richardc): This isn't the correct place to do this testing.
-;; We're testing at a distance that the callbacks for the websocket
-;; handles called over into connection-states and then returned
-;; something that looked like an updated view of the world.
-;; Remove all these once we're sure that are covered by the tests of
-;; connection-states.
-
-;; (deftest on-connect!-test
-;;   (with-redefs [get-hostname (fn [ws] "localhost")
-;;                 ring.adapter.jetty9/idle-timeout! (fn [ws timeout] true)]
-;;     (testing "It adds the fresh connection to the connection-map"
-;;       (let [connection-map (#'puppetlabs.cthun.websockets/on-connect! "ws")
-;;             socket-map (get connection-map "ws")]
-;;         (is (= (socket-map :client) "localhost"))
-;;         (is (= (socket-map :type) "undefined"))
-;;         (is (= (socket-map :status) "connected"))
-;;         (is (= nil (socket-map :endpoint)))))))
-
-;; (deftest on-text!-test
-;;   (with-redefs [puppetlabs.cthun.validation/validate-message (fn [message] true)
-;;                 puppetlabs.cthun.connection-states/process-message (fn [hostname ws message] true)
-;;                 get-hostname (fn [ws] "localhost")]
-;;     (testing "It processes a client message if the message body is valid"
-;;       (is (= (#'puppetlabs.cthun.websockets/on-text! "ws" "message") true))))
-;;   (with-redefs [puppetlabs.cthun.validation/validate-message (fn [message] false)
-;;                 get-hostname (fn [ws] "localhost")]
-;;     (testing "It does not process a client message if the message body is invalid"
-;;       (is (= (#'puppetlabs.cthun.websockets/on-text! "ws" "message") nil)))))
-
-;; (deftest on-bytes!-test
-;;   (println "on-bytes!-test *** Pending ***"))
-
-;; (deftest on-error-test
-;;   (println "on-error-test *** Pending ***"))
-
-;; (deftest on-close!-test
-;;   (with-redefs [get-hostname (fn [ws] "localhost")
-;;                 ring.adapter.jetty9/idle-timeout! (fn [ws timeout] true)]
-;;     (testing "It removes the closed connection from the connection-map and endpoint-map"
-;;       (swap! puppetlabs.cthun.connection-states/connection-map {})
-;;       (#'puppetlabs.cthun.websockets/on-connect! "ws")
-;;       (#'puppetlabs.cthun.websockets/on-close! "ws" 1001 "Remove")
-;;       (is (= @puppetlabs.cthun.connection-states/connection-map {})))))
-
-; Public interface tests

 (deftest websocket-handlers-test
   (testing "All the handler functions are defined"


add create-table to bigquery

add create-table to bigquery

--- bigquery/src/gclouj/bigquery.clj
+++ bigquery/src/gclouj/bigquery.clj
@@ -1,5 +1,5 @@
 (ns gclouj.bigquery
-  (:import [com.google.gcloud.bigquery BigQueryOptions BigQuery$DatasetListOption DatasetInfo DatasetId BigQuery$TableListOption TableInfo TableId BigQuery$DatasetOption]))
+  (:import [com.google.gcloud.bigquery BigQueryOptions BigQuery$DatasetListOption DatasetInfo DatasetId BigQuery$TableListOption TableInfo TableId BigQuery$DatasetOption BigQuery$TableOption Schema Field Field$Type Field$Mode]))

 (defprotocol ToClojure
   (to-clojure [_]))
@@ -57,3 +57,33 @@
       (.defaultTableLifetime builder table-lifetime-millis))
     (.location builder (or (locations location) "US"))
     (to-clojure (.create service (.build builder) (into-array BigQuery$DatasetOption [])))))
+
+(defn- mkfield [{:keys [name type description mode fields]}]
+  (let [field-type (condp = type
+                     :bool      (Field$Type/bool)
+                     :float     (Field$Type/floatingPoint)
+                     :integer   (Field$Type/integer)
+                     :string    (Field$Type/string)
+                     :timestamp (Field$Type/timestamp)
+                     :record    (Field$Type/record (map mkfield fields)))
+        builder    (Field/builder name field-type)
+        field-mode ({:nullable  (Field$Mode/NULLABLE)
+                     :repeated  (Field$Mode/REPEATED)
+                     :required  (Field$Mode/REQUIRED)} (or mode :nullable))]
+    (.mode builder field-mode)
+    (.build builder)))
+
+(defn- mkschema
+  [fields]
+  (let [builder (Schema/builder)]
+    (.fields builder (into-array Field (->> fields (map mkfield))))
+    (.build builder)))
+
+(defn create-table
+  "Fields: sequence of fields representing the table schema.
+  e.g. [{:name \"foo\" :type :record :fields [{:name \"bar\" :type :integer}]}]"
+  [service {:keys [project-id dataset-id table-id]} fields]
+  (let [builder (TableInfo/builder (TableId/of project-id dataset-id table-id)
+                                   (mkschema fields))
+        table-info (.build builder)]
+    (to-clojure (.create service table-info (into-array BigQuery$TableOption [])))))


Clarify position of logging.

Clarify position of logging.

--- test/workshop/jobs/challenge_4_1_test.clj
+++ test/workshop/jobs/challenge_4_1_test.clj
@@ -10,7 +10,9 @@
 ;; In this challenge, we're going to log every segment that
 ;; we see after it's processed by the :times-three task with
 ;; the lifecycle hook :after-batch. Obtain the segments via
-;; the key :onyx.core/batch in the event map.
+;; the key :onyx.core/batch in the event map. This key retrieves
+;; the segments that enter the task - before processing.
+;; Iterate over each segment with `doseq` and log its value.
 ;;
 ;; Try it with:
 ;;


Disable slack test runs since they rely on real Slack config

--- test/yetibot/core/test/adapters/slack.clj
+++ test/yetibot/core/test/adapters/slack.clj
@@ -49,15 +49,15 @@
            (unencode-message "Foo <https://imgflip.com> bar <https://www.google.com>")))))

 (deftest adapters-tests
+  (comment
+    (def adapter (first (a/active-adapters)))

-  (def adapter (first (a/active-adapters)))
+    (history adapter "G1QD1DNG2")

-  (history adapter "G1QD1DNG2")
+    (binding [chat/*target* "D0HFDJHA4"]
+      (a/send-msg adapter "hi"))

-  (binding [chat/*target* "D0HFDJHA4"]
-    (a/send-msg adapter "hi"))
-
-  (react adapter "balloon" "D0HFDJHA4"))
+    (react adapter "balloon" "D0HFDJHA4")))

 (deftest rooms-for-last-config


Remove Finished! Logging

Remove Finished! Logging

--- src/lens/import.clj
+++ src/lens/import.clj
@@ -167,7 +167,6 @@
               (recur (constrain-jobs state) ((job-handler type) state port val)))

             (if (= 0 (:count (:jobs state)))
-              (if (empty? (:refs state))
-                (log/info "Finished!")
+              (if-not (empty? (:refs state))
                 (throw (ex-info (str "Unresolved refs: " (:refs state)) {:refs (:refs state)})))
               (recur [] state))))))))


oops, className

oops, className

--- examples/drag-and-drop/src/drag_and_drop/core.cljs
+++ examples/drag-and-drop/src/drag_and_drop/core.cljs
@@ -175,9 +175,9 @@
                               :-moz-user-select "none"
                               :-ms-user-select "none"
                               :user-select "none"}}
-             (apply dom/div #js {:class "placed-boxes"}
+             (apply dom/div #js {:className "placed-boxes"}
                     (map render-solid-box (:placed-boxes state)))
-             (apply dom/div #js {:class "moving-boxes"}
+             (apply dom/div #js {:className "moving-boxes"}
                     (map render-ghost-box moving-boxes))
              (render-ghost-box resizing-box)
              (dom/div #js {:style #js {:position "relative"}}


changed date of next 3rd session

changed date of next 3rd session

--- src/cljs/work_sessions/components/session_not_found_page.cljs
+++ src/cljs/work_sessions/components/session_not_found_page.cljs
@@ -14,4 +14,4 @@
     [:a {:href "http://sws.eeefff.org/session-three-room"
          :target "_blank"}
      "link"]
-    " on 2 June 13:30 Helsinki time"]])
+    " on 9 June 13:30 Helsinki time"]])


distr and cnf implemented; cnf is not correct

--- src/logic/cnf.clj
+++ src/logic/cnf.clj
@@ -81,7 +81,45 @@
 	       :else formula)
 	     )))

-(defn transform-cnf
-  "Takes a formula in clojure code and produces the cnf of it"
+(defn distr
+  "Takes two nnf formulas and applies the distribution for 'formula-1 or formula-2'"
+  [formula-1 formula-2]
+  (cond
+    ;f-1 has the form (and f-11 f-12)
+    ; -> apply (and (distr f-11 f-2) (distr f-12 f-2))
+    (and
+      (not (literal? formula-1))
+      (= "and" (-> formula-1 first name)))
+
+    `(and ~@(map #(distr % formula-2) (rest formula-1)))
+
+    ;f-2 has the form (and f-21 f-22)
+    ; -> apply (and (distr f-1 f-21) (distr f-1 f-22))
+    (and
+      (not (literal? formula-2))
+      (= "and" (-> formula-2 first name)))
+
+    `(and ~@(map #(distr formula-1 %) (rest formula-2)))
+
+    :else
+    `(or ~formula-1 ~formula-2)
+))
+
+(defn cnf
+  "Takes a nnf formula and produces the conjunctive normal form of it."
   [formula]
-  (-> formula impl-free nnf))+  (cond
+    ;formula is literal -> return formula
+    (literal? formula)
+    formula
+
+    ;formula has the form 'f1 and f2' -> (and (cnf f1) (cnf f2))
+    (= "and" (-> formula first name))
+
+    `(and ~@(map cnf (rest formula)))
+
+    ;formula has the form 'f1 or f2' -> (distr (cnf f1) (cnf f2))
+    (= "or" (-> formula first name))
+
+    (apply distr ~@(map cnf (rest formula)))
+))


Create seperate functions for creating static element renderers vs. fragment invoking dynamic renderers.

--- src/main/clojure/com/howardlewisship/cascade/view_manager.clj
+++ src/main/clojure/com/howardlewisship/cascade/view_manager.clj
@@ -14,10 +14,10 @@

 (ns com.howardlewisship.cascade.view-manager
   (:use
-   com.howardlewisship.cascade.internal.utils
-   com.howardlewisship.cascade.dom
-   com.howardlewisship.cascade.config
-   com.howardlewisship.cascade.internal.parser))
+    com.howardlewisship.cascade.internal.utils
+    com.howardlewisship.cascade.dom
+    com.howardlewisship.cascade.config
+    com.howardlewisship.cascade.internal.parser))

 ; OK, so now a fragment function takes two parameters: env and params.  A view function is simply a wrapper
 ; around a fragment function that takes just the env and supplys nil for the params.
@@ -93,53 +93,62 @@
   [parsed-node]
   (wrap-dom-node-as-fragment-fn (struct-map dom-node :type :comment :value (parsed-node :text))))

+(defn- create-fragment-renderer
+  [element-node]
+  (let [body (element-node :body)
+        token (element-node :token)
+        element-uri (token :ns-uri)
+        element-name (token :tag)
+        element-ns-uri-to-prefix (element-node :ns-uri-to-prefix)
+        body-as-funcs (map to-fragment-fn body)
+        body-combined (combine-render-funcs body-as-funcs)
+        attributes (construct-attributes (element-node :attributes))]
+
+    ; The fragment-renderer is responsible for providing parameters
+    ; to the included fragment. Parameters aren't implemented yet.
+
+    (fn fragment-renderer [env params]
+      ; TODO: Error if a fragment element defines any namespace besides cascade.
+      (let [frag-func (get-fragment (name element-name))
+            inner-params [] ; TODO: evaluate parameters
+            body-renderer (create-render-body-fn body-combined params)
+            ; TODO: rebuild token, stripping from :attributes any parameters
+            frag-env (merge env {:element-token token
+                                 :render-body body-renderer})]
+        (frag-func frag-env inner-params)))))
+
+(defn- create-static-element-renderer
+  [element-node]
+  (let [body (element-node :body)
+        token (element-node :token)
+        element-uri (token :ns-uri)
+        element-name (token :tag)
+        element-ns-uri-to-prefix (element-node :ns-uri-to-prefix)
+        body-as-funcs (map to-fragment-fn body)
+        body-combined (combine-render-funcs body-as-funcs)
+        attributes (construct-attributes (element-node :attributes))]
+    (fn static-element-renderer [env params]
+      [(struct-map dom-node
+        :type :element
+        :ns-uri element-uri
+        :ns-uri-to-prefix (remove-cascade-namespaces element-ns-uri-to-prefix)
+        :name element-name
+        ; currently assuming that attributes are "static" but
+        ; that will change ... though we should seperate "static" from "dynamic"
+        :attributes attributes
+        ; TODO: there might be a way to identify that a static element has only static
+        ; content, in which case the body can itself be computed statically
+        :content (body-combined env params))])))
+
 (defmethod to-fragment-fn :element
-  [parsed-node]
+  [element-node]
   ; TODO: handle elements in the cascade namespace specially
   ; TODO: check for cascade namespace attributes
-  (let [body (parsed-node :body)
-        token (parsed-node :token)
-        element-uri (token :ns-uri)
-        element-name (token :tag)
-        element-ns-uri-to-prefix (parsed-node :ns-uri-to-prefix)
-        body-as-funcs (map to-fragment-fn body)
-        body-combined (combine-render-funcs body-as-funcs)
-        attributes (construct-attributes (parsed-node :attributes))]
-
-    ; TODO: as similar as these two options (static element vs. fragment) are,
-    ; it would probably be better to split this into two functions.
+  (let [element-uri (-> element-node :token :ns-uri)]

     (if (= fragment-uri element-uri)
-
-
-      ; The fragment-renderer is responsible for providing parameters
-      ; to the included fragment. Parameters aren't implemented yet.
-
-      (fn fragment-renderer [env params]
-                            ; TODO: Error if a fragment element defines any namespace besides cascade.
-                            (let [frag-func (get-fragment (name element-name))
-                                  inner-params [] ; TODO: evaluate parameters
-                                  body-renderer (create-render-body-fn body-combined params)
-                                  ; TODO: rebuild token, stripping from :attributes any parameters
-                                  frag-env (merge env {:element-token token
-                                                       :render-body body-renderer})]
-                              (frag-func frag-env inner-params)))
-
-      ; otherwise, a static element node
-      ; TODO: handle dynamic attributes
-      (fn static-element-renderer [env params]
-                                  [(struct-map dom-node
-                                    :type :element
-                                    :ns-uri element-uri
-                                    :ns-uri-to-prefix (remove-cascade-namespaces element-ns-uri-to-prefix)
-                                    :name element-name
-                                    ; currently assuming that attributes are "static" but
-                                    ; that will change ... though we should seperate "static" from "dynamic"
-                                    :attributes attributes
-                                    ; TODO: there might be a way to identify that a static element has only static
-                                    ; content, in which case the body can itself be computed statically
-                                    :content (body-combined env params))]))))
-
+      (create-fragment-renderer element-node)
+      (create-static-element-renderer element-node))))

 (defn parse-and-create-fragment
   "Parses a cascade template file and creates a fragment function from it."
@@ -168,7 +177,7 @@

 (defn- create-from-template
   "Searches for a template file as a classpath resource in one of the namespaces, creating a function (using the factory)
-  if found. If not found, throws RuntimeException."
+if found. If not found, throws RuntimeException."
   [name namespaces factory-fn]
   (let [path (str name ".cml")
         match (first-non-nil (map #(find-namespace-resource % path) namespaces))]


make things in default-pipeline-state-persistence private that don't need to be public

--- src/clj/lambdacd/internal/default_pipeline_state_persistence.clj
+++ src/clj/lambdacd/internal/default_pipeline_state_persistence.clj
@@ -14,22 +14,22 @@
             [clojure.data.json :as json]))

-(defn formatted-step-id [step-id]
+(defn- formatted-step-id [step-id]
   (str/join "-" step-id ))

-(defn unformat-step-id [formatted-step-id]
+(defn- unformat-step-id [formatted-step-id]
   (map util/parse-int (str/split formatted-step-id (Pattern/compile "-"))))

 (defn- step-result->json-format [[k v]]
   {:step-id (formatted-step-id k) :step-result v})

-(defn pipeline-state->json-format [pipeline-state]
+(defn- pipeline-state->json-format [pipeline-state]
   (map step-result->json-format pipeline-state))

 (defn- step-json->step [{step-result :step-result step-id :step-id}]
   {(unformat-step-id step-id) step-result})

-(defn json-format->pipeline-state [json-map]
+(defn- json-format->pipeline-state [json-map]
   (into {} (map step-json->step json-map)))


Renamed variable.

Renamed variable.

--- src/cmr/search/results_handlers/json_spatial_results_handler.clj
+++ src/cmr/search/results_handlers/json_spatial_results_handler.clj
@@ -42,11 +42,11 @@
 (defn shapes->json
   "Returns the json representation of the given shapes"
   [shapes]
-  (let [group-by-shapes (group-by type shapes)
-        points (map shape->string (get group-by-shapes cmr.spatial.point.Point))
-        boxes (map shape->string (get group-by-shapes cmr.spatial.mbr.Mbr))
-        polygons (get group-by-shapes cmr.spatial.polygon.Polygon)
-        lines (map shape->string (get group-by-shapes cmr.spatial.line.Line))
+  (let [shapes-by-type (group-by type shapes)
+        points (map shape->string (get shapes-by-type cmr.spatial.point.Point))
+        boxes (map shape->string (get shapes-by-type cmr.spatial.mbr.Mbr))
+        polygons (get shapes-by-type cmr.spatial.polygon.Polygon)
+        lines (map shape->string (get shapes-by-type cmr.spatial.line.Line))
         spatial {:points points
                  :boxes boxes
                  :polygons polygons


Little bit of acceptance testing.

Little bit of acceptance testing.

--- test/cmemcached/acceptance/spyglass.clj
+++ test/cmemcached/acceptance/spyglass.clj
@@ -4,7 +4,7 @@
             [environ.core :refer [env]]
             [midje.sweet :refer :all]))

-(def client (memoize #(spy/text-connection (str "localhost:" port))))
+(defn client [] (spy/text-connection (str "localhost:" port)))

 (fact-group
  :acceptance
@@ -22,4 +22,18 @@
              value (uuid)
              ttl 300]
          (spy/set (client) key ttl value)
-         (spy/get (client) key) => value)))
+         (spy/get (client) key) => value))
+
+ (fact "several values can be set and all retrieved at the same time"
+       (let [key1 (uuid)
+             value1 (uuid)
+             key2 (uuid)
+             value2 (uuid)
+             key3 (uuid)
+             value3 (uuid)]
+            (spy/set (client) key1 300 value1)
+            (spy/set (client) key2 300 value2)
+            (spy/set (client) key3 300 value3)
+            (Thread/sleep 100)
+            (let [result (spy/get-multi (client) [key1 key2 key3])]
+              result => {key1 value1 key2 value2 key3 value3}))))


(maint) Stop running migrations in pool-tests

This commit changes the pool-tests to not pass in a migration-db so that
the migrations step of the initilization won't be run since it isn't
necessary in testing and we have tests for migrations.

--- test/puppetlabs/jdbc_util/pool_test.clj
+++ test/puppetlabs/jdbc_util/pool_test.clj
@@ -103,7 +103,7 @@
                     ([user pass]
                      (.getConnection this))))]
     (testing "the pool retries until it gets a connection"
-      (let [wrapped (pool/wrap-with-delayed-init mock-ds (fn [_] mock-ds) {:migration-dir {}} 1)]
+      (let [wrapped (pool/wrap-with-delayed-init mock-ds (fn [_] mock-ds) 1)]
         (is (thrown? SQLTransientConnectionException
                      (.getConnection wrapped)))
         (Thread/sleep 2000)
@@ -121,7 +121,7 @@
                    pool/options->hikari-config)]
     (testing "if the init-fn throws an exception it continues to hand out connections normally"
       (let [wrapped (pool/connection-pool-with-delayed-init
-                     config {:migration-db {}} (fn [_] (throw (RuntimeException. "test exception"))) 10000)]
+                     config (fn [_] (throw (RuntimeException. "test exception"))) 10000)]
         (is (= [{:a 1}] (jdbc/query {:datasource wrapped} ["select 1 as a"])))
         (is (= {:state :error
                 :messages ["Initialization resulted in an error: test exception"]}
@@ -131,7 +131,7 @@
       (let [eo (string-as-locale "eo")]
         (with-user-locale eo
          (let [wrapped (pool/connection-pool-with-delayed-init
-                        config {:migration-db {}} (fn [_] (throw (RuntimeException. "test exception"))) 10000)]
+                        config (fn [_] (throw (RuntimeException. "test exception"))) 10000)]
                 (is (= [{:a 1}] (jdbc/query {:datasource wrapped} ["select 1 as a"])))
                 (is (= {:state :error
                         :messages ["This_is_a_translated_string: test exception"]}
@@ -141,7 +141,7 @@
   (let [test-pool (-> core-test/test-db
                       pool/spec->hikari-options
                       pool/options->hikari-config
-                      (pool/connection-pool-with-delayed-init {:migration-db core-test/test-db} identity 5000))]
+                      (pool/connection-pool-with-delayed-init identity 5000))]
     (.getConnection test-pool)
     (is (= {:state :ready}
            (pool/status test-pool)))


add auth test

add auth test

--- test/doc/sync.clj
+++ test/doc/sync.clj
@@ -34,23 +34,18 @@
          handler (create-http-kit-handler! "ws://127.0.0.1:9090/")
          ;; remote server to sync to
          remote-store (<!! (new-mem-store))
+         local-users {"john" "haskell" "jane" "lisp"}
+         input-users {"john" "haskell" "jane" "lisp"}
+         auth-fn (fn [users] (go (into {} (filter #(users (key %)) input-users ))))
+         cred-fn (fn [token] (if (= (:password token) (get local-users (:username token))) true nil))
          _ (def remote-peer (server-peer handler remote-store (comp (partial logger log-atom :remote-core)
                                                                     (partial fetch remote-store)
-                                                                    (partial publish-on-request remote-store)
-                                                                    (partial auth ))))
+                                                                    (partial publish-on-request remote-store))))

          ;; start it as its own server (usually you integrate it in ring e.g.)
          _ (start remote-peer)
          ;; local peer (e.g. used by a stage)
          local-store (<!! (new-mem-store))
-        local-users {"john" "P4ssw0rd"
-                     "jane" "lisp"}
-        input-users {"john" "P4ssw0rd"
-                     "jane" "lisp"}
-         auth-fn (fn [users] (go (into {} (filter #(users (key %)) input-users ))))
-         cred-fn (fn [token] (if (= (:password token) (get local-users (:username token)))
-                              true
-                              nil))
          _ (def local-peer (client-peer "CLIENT" local-store (comp (partial logger log-atom :local-core)
                                                                    (partial fetch local-store)
                                                                    (partial publish-on-request local-store)
@@ -95,6 +90,46 @@
                                    :branches {"master" #{2}}
                                    :schema {:type :geschichte
                                             :version 1}}}}})
+     ;; auth required
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 5}
+     ;; send some credentials
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häßkl"}})
+     ;; ups
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 4}
+     ;; let's try again
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskl"}})
+     ;; wrong, how could that be?
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 3}
+     ;; oh my, next try
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskel"}})
+     ;; wrong again
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 2}
+     ;; it's getting close
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häsckl"}})
+     ;; doh, wrong again
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 1}
+     ;; last try
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskil"}})
+     ;; oh no, epic fail
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-failed, :users #{"john"}}
+     ;; let's try again
+     (>!! out {:topic :meta-pub,
+               :peer "STAGE",
+               :metas {"john" {42 {:id 42
+                                   :causal-order {1 []
+                                                  2 [1]}
+                                   :last-update (java.util.Date. 0)
+                                   :description "Bookmark collection."
+                                   :head "master"
+                                   :branches {"master" #{2}}
+                                   :schema {:type :geschichte
+                                            :version 1}}}}})
+     ;; auth required again
+     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 5}
+     ;; this time with correct password
+     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "haskell"}})
+     ;; authed
+     (<!! in) => {:topic :geschichte.p2p.auth/authed, :users #{"john"}}
      ;; the peer replies with a request for missing commit values
      (<!! in) => {:topic :fetch,
                   :ids #{1 2}}
@@ -126,7 +161,8 @@
                                       :head "master",
                                       :pull-requests {}
                                       :branches {"master" #{2}}
-                                      :schema {:type :geschichte, :version 1}}}}}
+                                      :schema {:type :geschichte, :version 1}}}}
+                  :users #{"john"}, :geschichte.p2p.auth/authed true}

      ;; ack
      (>!! out {:topic :meta-pubed
@@ -142,6 +178,8 @@
                                    :branches {"master" #{3}}
                                    :schema {:type :geschichte
                                             :version 1}}}}})
+     ;; already authed
+     (<!! in) => {:topic :geschichte.p2p.auth/authed, :users #{"john"}}
      ;; again a new commit value is needed
      (<!! in) => {:topic :fetch,
                   :ids #{3}}
@@ -171,6 +209,8 @@
                                       :pull-requests {},
                                       :schema {:type :geschichte, :version 1}}}},
                   :peer "CLIENT",
+                  :users #{"john"}
+                  :geschichte.p2p.auth/authed true
                   :topic :meta-pub}
      ;; ack
      (>!! out {:topic :meta-pubed


generated-exemplar.verbose.json (new file ext)

--- test/exemplar.clj
+++ test/exemplar.clj
@@ -70,13 +70,12 @@

 (def symbols ['a 'ab 'abc 'abcd 'abcde 'a1 'b2 'c3 'a_b])

-
 (defn write-description [file-name description vals]
   (println "##" description)
   (println "* Files:"
            (str file-name ".edn")
            (str file-name ".json")
-           (str file-name ".json-verbose")
+           (str file-name ".verbose.json")
            (str file-name ".mp"))
   (println "* Value (EDN)")
   (println)
@@ -85,7 +84,7 @@

 (defn write-transit [dir file-name & vals]
   (doseq [format [{:type :json, :suffix ".json"}
-                  {:type :json-verbose, :suffix ".json-verbose"}
+                  {:type :json-verbose, :suffix ".verbose.json"}
                   {:type :msgpack :suffix ".mp"}]]
     (with-open [os (io/output-stream (str dir "/" file-name (:suffix format)))]
       (let [jsw (t/writer os (:type format))]


(PDB-3461) Disable the sensitive parameters test

This test is currently failing due to an incorrect version of the
PostgreSQL client installed on the Jenkins test machines. Once that
issue has been fixed (tracked as PDB-3461) this commit can be reverted
and the test re-enabled.

--- test/puppetlabs/puppetdb/integration/sensitive_params.clj
+++ test/puppetlabs/puppetdb/integration/sensitive_params.clj
@@ -46,7 +46,12 @@
       (finally
         (Files/deleteIfExists pgpass)))))

-(deftest ^:integration sensitive-parameter-redaction
+;;
+;; Disabling this due to issues with the Jenkins test
+;; instances. PDB-3461 covers the infrastructure related change needed
+;; to fix this test. This should be uncommented once that is complete.
+;;
+#_(deftest ^:integration sensitive-parameter-redaction
   (with-open [pg (int/setup-postgres)
               pdb (int/run-puppetdb pg {})
               ps (int/run-puppet-server-as "my_puppetserver" [pdb] {})]


CMR-6136: Fixed granule timeline tests.

CMR-6136: Fixed granule timeline tests.

--- search-app/src/cmr/search/results_handlers/timeline_results_handler.clj
+++ search-app/src/cmr/search/results_handlers/timeline_results_handler.clj
@@ -27,10 +27,12 @@
     :aggregations {:start-date-intervals
                    {:date_histogram
                     {:field (q2e/query-field->elastic-field :start-date :granule)
+                     :min_doc_count 1
                      :interval interval-granularity}}
                    :end-date-intervals
                     {:date_histogram
                      {:field (q2e/query-field->elastic-field :end-date :granule)
+                      :min_doc_count 1
                       :interval interval-granularity}}}}})

 (defmethod query-execution/pre-process-query-result-feature :timeline
@@ -136,7 +138,7 @@
   (let [dist-fn (interval-granularity->dist-fn interval-granularity)]
     (= 1 (dist-fn (t/interval (:end i1) (:start i2))))))

-(defn merge-intervals
+(defn- merge-intervals
   "Merges two intervals together. The start date of the first is taken along with the end date of
   the second. The hits are added together."
   [i1 i2]
@@ -144,7 +146,7 @@
       (update-in [:num-grans] #(+ % (:num-grans i2)))
       (assoc :end (:end i2))))

-(defn merge-adjacent-intervals
+(defn- merge-adjacent-intervals
   "Takes an interval-granularity and a list of intervals. Merges the intervals together that are
   within one interval granularity from each other. ASsumes intervals are already sorted by start
   date."
@@ -168,7 +170,7 @@
                                    [(conj new-intervals prev) current])]
         (recur (rest intervals) new-intervals prev)))))

-(def interval-granularity->period-fn
+(def ^:private interval-granularity->period-fn
   "Maps interval granularity types to the clj-time period functions"
   {:year t/years
    :month t/months
@@ -178,7 +180,7 @@
    :second t/seconds})

-(defn advance-interval-end-date
+(defn- advance-interval-end-date
   "Advances the interval end date by one unit of interval granularity. The end dates coming back from
   elasticsearch are at the beginning of the interval. The granules end date falls somewhere between
   the start of the interval and the end of it. By advancing the end date to the end we indicate to
@@ -187,7 +189,7 @@
   (let [one-unit ((interval-granularity->period-fn interval-granularity) 1)]
     (update-in interval [:end] #(when % (t/plus % one-unit)))))

-(defn constrain-interval-to-user-range
+(defn- constrain-interval-to-user-range
   "Constrains the start and end date of the interval to within the range given by the user"
   [start-date end-date interval]
   ;; This flag indicates in the ordered-events->intervals function that the interval had extra
@@ -198,7 +200,7 @@
         (update-in [:start] #(if (t/before? % start-date) start-date %))
         (update-in [:end] #(if (or no-end (nil? %) (t/after? % end-date)) end-date %)))))

-(defn collection-bucket->intervals
+(defn- collection-bucket->intervals
   "Takes a single collection bucket from the aggregation response and returns the intervals
   for that collection."
   [interval-granularity start-date end-date collection-bucket]


test that trigger can override job parameters

--- test/twarc/core_test.clj
+++ test/twarc/core_test.clj
@@ -50,7 +50,20 @@
                 :trigger {:cron "*/10 * * * * ?"})
     (is (true? (twarc/check-job-exists *scheduler* "task-3")))
     (twarc/delete-job *scheduler* "task-3")
-    (is (false? (twarc/check-job-exists *scheduler* "task-3")))))
+    (is (false? (twarc/check-job-exists *scheduler* "task-3"))))
+
+  (testing "trigger can override job parameters"
+    (let [listener (twarc/add-listener *scheduler*
+                                       {:key ["test-suite" "task-4"]} :to-be-executed)]
+      (simple-job *scheduler* []
+                  :job {:identity "task-4"
+                        :group "test-suite"}
+                  :trigger {:job-data {"arguments" ["Petr" "Yanovich"]}
+                            :cron "*/10 * * * * ?"})
+      (let [res (async-res listener)
+            data-map (.getMergedJobDataMap res)]
+        (is (= ["Petr" "Yanovich"] (get data-map "arguments")))
+        (is (= nil (get data-map "state")))))))

 (deftest remove-listener-test
   (testing "Remove a listener"


missed a variable rename

missed a variable rename

--- sidecar/src/figwheel_sidecar/build_middleware/stamp_and_clean.clj
+++ sidecar/src/figwheel_sidecar/build_middleware/stamp_and_clean.clj
@@ -23,6 +23,7 @@
            ".figwheel-compile-stamp"))

 ;; this provides a simple map and stable order for hashing
+;; TODO this should return a seq of map entries
 (defn options-that-affect-build-cache [build-config]
   (-> build-config
       (select-keys [:static-fns :optimize-constants
@@ -49,8 +50,8 @@
     (spit sfile
           (current-stamp-signature build-config))))

-(defn stamp-value [build-state]
-  (let [sf (stamp-file build-state)]
+(defn stamp-value [build-config]
+  (let [sf (stamp-file build-config)]
     (when (.exists sf) (slurp sf))))

 (defn stamp-matches? [build-config]


revert use earliest and update max-offsets

--- kafka-clj/src/kafka_clj/fetch.clj
+++ kafka-clj/src/kafka_clj/fetch.clj
@@ -102,7 +102,7 @@
   (with-size buff write-fetch-request-header topics state))

-(defn write-offset-request-message [^ByteBuf buff {:keys [topics use-earliest max-offsets] :or {max-offsets 10 use-earliest false}}]
+(defn write-offset-request-message [^ByteBuf buff {:keys [topics max-offsets] :or {max-offsets 500}}]
   "
 	OffsetRequest => ReplicaId [TopicName [Partition Time MaxNumberOfOffsets]]
 	  ReplicaId => int32
@@ -122,7 +122,7 @@
       (do
         (-> buff
             (.writeInt (int partition))
-            (.writeLong (if use-earliest -2 -1))
+            (.writeLong -1)
             (.writeInt (int max-offsets))))))

   buff)


fix emit-form for case*

fix emit-form for case*

--- src/main/clojure/clojure/tools/analyzer/passes/js/emit_form.clj
+++ src/main/clojure/clojure/tools/analyzer/passes/js/emit_form.clj
@@ -70,12 +70,20 @@
   (list 'defrecord* name (map #(-emit-form* % opts) fields) pmask
         (-emit-form* body opts)))

+(defmethod -emit-form :case-then
+  [{:keys [then]} opts]
+  (-emit-form* then opts))
+
+(defmethod -emit-form :case-test
+  [{:keys [test]} opts]
+  (-emit-form* test opts))
+
 (defmethod -emit-form :case
   [{:keys [test nodes default]} opts]
   `(case* ~(-emit-form* test opts)
           ~@(reduce (fn [acc {:keys [tests then]}]
                       (-> acc
-                        (update-in 0 conj (mapv #(-emit-form* (:test %) opts) tests))
+                        (update-in 0 conj (mapv #(-emit-form* % opts) tests))
                         (update-in 1 conj (-emit-form* then opts))))
                     [[] []] nodes)
           ~(-emit-form* default opts)))


(maint) Fix alignment

(maint) Fix alignment

--- src/puppetlabs/trapperkeeper/services/status/status_service.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_service.clj
@@ -41,7 +41,8 @@
     (log/infof "Registering status callback function for %s service" service-name)
     (status-core/update-status-context (:status-fns (service-context this))
                                        service-name service-version status-version status-fn))
+
   (get-status [this service-name level status-version]
               (let [status-fn (status-core/get-status-fn (:status-fns (service-context this)) service-name status-version)
-          timeout (status-core/check-timeout level)]
+                    timeout (status-core/check-timeout level)]
                 (status-core/guarded-status-fn-call status-fn level timeout))))


Set default profile to full-ha [IMMUTANT-74]

--- support/build-support/src/main/clojure/immutant/build/tools.clj
+++ support/build-support/src/main/clojure/immutant/build/tools.clj
@@ -127,6 +127,14 @@
   (add-polyglot-subsystems
    (reduce (partial add-subsystem "immutant-") loc (keys immutant-modules))))

+(defn fix-profile [loc]
+  (let [name (get-in (zip/node loc) [:attrs :name])]
+    (if (= "default" name)
+      (zip/remove loc)
+      (add-subsystems (if (= "full-ha" name)
+                        (zip/edit loc assoc-in [:attrs :name] "default")
+                        loc)))))
+
 (defn server-element [name offset]
   {:tag :server
    :attrs {:name name, :group "default"},
@@ -205,7 +213,7 @@
     (recur (zip/next
             (cond
              (looking-at? :extensions loc) (do (append-system-properties loc) (add-extensions loc))
-             (looking-at? :profile loc) (add-subsystems loc)
+             (looking-at? :profile loc) (fix-profile loc)
              (looking-at? :periodic-rotating-file-handler loc) (add-logger-levels loc)
              (looking-at? :virtual-server loc) (set-welcome-root loc)
              (looking-at? :system-properties loc) (unquote-cookie-path loc)


Symbolic differentiation working for + and *

--- src/main/cljc/clojure_club/x121_universal_computation_engine/mgrimm.cljc
+++ src/main/cljc/clojure_club/x121_universal_computation_engine/mgrimm.cljc
@@ -1,27 +1,33 @@
-(ns clojure-club.x121-universal-computation-engine.mgrimm)
+(ns clojure-club.x121-universal-computation-engine.mgrimm
+  (:require [clojure.walk :as walk]))

-(defn f' [e dv]
+(defn f' [e dvar]
   (cond
     (list? e)
-    (let [[op & os] e]
-
-      )
+    (let [[op u v] e]
+      (case op
+        + (list '+ (f' u dvar) (f' v dvar))
+        * (list '+ (list '* u (f' v dvar)) (list '* v (f' u dvar)))))
     (number? e) 0
-    (and (symbol? e) (= e dv)) 1
+    (and (symbol? e) (= e dvar)) 1
     :else 0))

-(defn calc [formula]
-  (fn [smap]
-    (clojure.walk/prewalk
-      #(if (list? %)
-         (let [[op & os] (replace (merge smap {'/ / '* * '+ + '- - 'f' f'}) %)]
-           (apply op os))
-         %)
-      formula)))
+(defn calc [formula]
+  (fn [smap]
+    (->> formula
+         (walk/prewalk
+           (fn [x]
+             (cond-> x
+               (and (list? x) (#{'f'} (first x)))
+               (->> rest (apply f')))))
+         (walk/postwalk
+           (fn [x]
+             (if (list? x)
+               (let [[op & os] (replace (merge smap {'/ / '* * '+ + '- -}) x)]
+                 (apply op os))
+               x))))))

 ;; -----------------------------------------------------------------------------
-
-((calc '(f' x :dv)) '{a 2 :dv x})

 (assert (= 2 ((calc '(/ a b))
               '{b 8 a 16})))
@@ -39,3 +45,10 @@
 (assert (= 1 ((calc '(/ (+ x 2)
                         (* 3 (+ y 1))))
               '{x 4 y 1})))
+
+(assert (= 0 ((calc '(f' 2 x)) nil)))
+(assert (= 1 ((calc '(f' x x)) nil)))
+(assert (= 0 ((calc '(f' y x)) nil)))
+(assert (= 3 ((calc '(f' (* x y) x)) '{x 1 y 3})))
+(assert (= 10 ((calc '(f' (* x x) x)) '{x 5})))
+(assert (= 40 ((calc '(f' (+ (* x x) (* 3 y)) x)) '{x 20 y 99})))


Prot -> Safe

Prot -> Safe

--- src/clj/clojurewerkz/statistiker/utils.clj
+++ src/clj/clojurewerkz/statistiker/utils.clj
@@ -64,7 +64,7 @@
 ;;

 (defn factorial
-  "Protected factorial. Special case: returns 1 if x is zero"
+  "Safe factorial. Special case: returns 1 if x is zero"
   [x]
   {:pre [(>= x 0)]}
     (loop [n x f 1]
@@ -79,8 +79,8 @@
     0
     (Math/log x)))

-(defn prot-shannon-entropy
-  "Protected Shannon entropy measure (inc. protected-logarithms)."
+(defn safe-shannon-entropy
+  "Safe Shannon entropy measure (inc. protected-logarithms)."
   [v]
   (let [sum (reduce + v)]
     (->> v


function to return all the char sprites as a sequence

--- src/cljs/infinitelives/pixi/pixelfont.cljs
+++ src/cljs/infinitelives/pixi/pixelfont.cljs
@@ -43,6 +43,28 @@
 (defn clear-text! [batch]
   (.removeChildren batch))

+(defn make-char-sprite-set [font-key text]
+  (loop [[c & l] (seq text)
+         xp 0 yp 0
+         last-c nil ;; remember last character for kerning
+         sprite-set []]
+    (let [char ((:font font) c)
+          {:keys [texture pos size]} char
+          [x y] pos
+          [w h] size
+          pair (str last-c c)
+          koff ((:kerning font) pair)
+          ]
+      (if (nil? char)
+        ;; if character is not present in font map, put a space
+        (when (seq l)
+          (recur l (+ xp (:space font)) yp c sprite-set))
+
+        (let [sprite (s/make-sprite texture :x (+ xp koff) :y yp :xhandle 0 :yhandle 0 :tint tint :scale 1)]
+          (if (seq l)
+            (recur l (+ xp w 1.0 koff) yp c (conj sprite-set sprite))
+            (conj sprite-set sprite)))))))
+
 (defn make-text [font-key text & {:keys [tint scale anchor rotation
                                          x y visible
                                          xhandle yhandle]


Fix bug in start-with-args

Fix bug in start-with-args

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -261,7 +261,7 @@
 (defn start-with-args [xs & states]
   (reset! -args xs)
   (if (first states)
-    (start states)
+    (apply start states)
     (start)))

 (defn start-with [with]


guitar strumming

guitar strumming

--- src/music/comp1.clj
+++ src/music/comp1.clj
@@ -11,19 +11,37 @@
             [overtone.synth.stringed :as strings]))

 (defmethod play-note :thePart [{midi :pitch}] (snth/overpad midi :amp 0.2))
-(defmethod play-note :theStrumming [{midi :pitch}] (snth/overpad midi :amp 0.2))
 (defmethod play-note :theBeats1 [{midi :pitch}] (drum/kick midi))
 (defmethod play-note :theBeats2 [{midi :pitch}] (drum/hat3 midi :amp 0.02))

+(def g (strings/guitar))

+(def updownmap {
+                81 :up
+                83 :down
+                84 :up
+                86 :down
+                88 :up
+                89 :down
+                })
+(def amgmap {
+                81 :Am
+                83 :Am
+                84 :G
+                86 :G
+                88 :E
+                89 :E7
+                })

-(def beatCount 15)
+(defmethod play-note :theStrumming [{midi :pitch}] (strings/guitar-strum g (amgmap midi) (updownmap midi) 0.101) (println midi))
+
+(def beatCount 20)
 (def delayBeforeStart 1/4)

 (def beats1
   (->>
    (phrase (take (- beatCount 2) (cycle [12/8]))
-           (take (- beatCount 2)  (cycle [0])))
+           (take (- beatCount 2) (cycle [0])))
    (where :time  (from delayBeforeStart))
    (where :part (is :theBeats1))))

@@ -34,10 +52,20 @@
    (where :time  (from delayBeforeStart))
    (where :part (is :theBeats2))))

+(def chords
+  (->>
+   (phrase (take (* beatCount 2)   (cycle [3/8   6/8   3/8  4/8  8/8]))
+           [
+            0 nil 1 0 nil 0 nil 1 0 nil 0 nil 1 3 nil 2 nil 3 2 nil
+            0 nil 1 0 nil 0 nil 1 0 nil 0 nil 1 5 nil 4 nil 5 4 nil
+            ]
+           )
+   (where :time  (from delayBeforeStart))
+   (where :part (is :theStrumming))))
+

 (def melody
   (->>
-
    (phrase [  4/8  5/8   4/8  6/8  6/8  9/8  9/8  6/8   8/8  6/8 ]
            [  0    0     2    1    0    0    1    0     -1   -4  ])

@@ -50,12 +78,15 @@
    (where :part (is :thePart))))

+
+
 (defn doit []
   (->>
    melody
    (with beats1)
    (with beats2)
+   (with chords)
    (where :time (bpm 120))
    (where :duration (bpm 120))
-   (where :pitch (comp A flat minor))
+   (where :pitch (comp high A  minor))
    play))


Allow singular unit usage.

Allow singular unit usage.

--- src/onyx/schema.clj
+++ src/onyx/schema.clj
@@ -173,10 +173,11 @@
   (s/enum :accumulating :discarding))

 (def TriggerPeriod
-  (s/enum :milliseconds :seconds :minutes :hours :days))
+  (s/enum :milliseconds :seconds :minutes :hours :days
+          :millisecond :second :minute :hour :day))

 (def TriggerThreshold
-  (s/enum :elements))
+  (s/enum :elements :element))

 (def Trigger
   {:trigger/window-id s/Keyword


make the update-users script more robust

--- src/pc/admin/db.clj
+++ src/pc/admin/db.clj
@@ -3,7 +3,8 @@
             [clj-time.core :as time]
             [clj-time.coerce :refer [to-date]]
             [pc.auth]
-            [pc.datomic :as pcd]))
+            [pc.datomic :as pcd]
+            [slingshot.slingshot :refer (try+)]))

 (defn interesting-doc-ids [{:keys [start-time end-time layer-threshold limit]
                             :or {start-time (time/minus (time/now) (time/days 1))
@@ -33,5 +34,10 @@
   (let [db (pcd/default-db)]
     (doseq [[eid] (d/q '{:find [?t]
                          :where [[?t :google-account/sub]]}
-                       db)]
-      (pc.auth/update-user-from-sub (d/entity db eid)))))
+                       db)
+            :let [cust (d/entity db eid)]]
+      (try+
+        (println "adding" (:cust/email cust))
+        (pc.auth/update-user-from-sub cust)
+        (catch :status t
+          (println "error updating" (d/touch cust)))))))


Поработал с отображением тумб картинок

Поработал с отображением тумб картинок

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -2017,7 +2017,8 @@
                                        :top 10 :left 5
                                        :fontSize "2em"}
                            :aria-hidden "true"}))
-          (dom/a nil (dom/img #js {:src path :alt "фото"}))
+          (dom/a nil (dom/img #js {:src (str path "_as_150.png") :alt "фото"
+                                   :style #js {:width "100%"}}))
           (dom/div #js {:className "caption"}
                    (when (not (clojstr/blank? top_description))
                      (dom/h3 nil top_description))
@@ -2025,10 +2026,11 @@
                             (when (not (clojstr/blank? description))
                               (dom/p nil description))

-                            (dom/span #js {:className "label label-default"} "URL")
+                            (dom/span #js {:className "label label-default"
+                                           :style #js {:width "15%" :fontSize "0.7em"}} "URL")
                             " "
                             (dom/input #js {:type "text"
-                                            :style #js {:width "70%" :fontSize "0.7em"}
+                                            :style #js {:width "65%" :fontSize "0.7em"}
                                             :value path
                                             :onMouseDown (fn [e] (.select (.-target e)))
                                             }))
@@ -2216,7 +2218,7 @@

 (defn file-thumb [app _ {:keys [class+
                                 onClick-fn]
-                         :or {class+ "col-xs-12 col-sm-6 col-md-6 col-lg-6"}}]
+                         :or {class+ "col-xs-12 col-sm-12 col-md-12 col-lg-12"}}]
   (reify
     om/IRender
     (render [_]


fixing bad macro

fixing bad macro

--- src/specly/core.clj
+++ src/specly/core.clj
@@ -370,8 +370,7 @@
   [& args]
   ;; check the args with s/keys
   (let [form (macroexpand `(s/keys ~@args))]
-    (prn args)
-    `(strict-mapkeys-impl ~(apply specly.core/parse-keys-args args) ~form)))
+    `(strict-mapkeys-impl (specly.core/parse-keys-args ~@args) ~form)))

@@ -658,14 +657,3 @@

   )
-
-
-
-
-(specly.core/strict-keys :opt-un [:fig-opt/builds]
-                         :req [:fig-opt/builds])
-
-#_(with-meta :hey {:d 1})
-
-
-#_(s/def :builds  (s/cat :builds (s/+ ))  )


Replace schema/either with schema/conditional

This gives much better error messages when the validation fails.

--- src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
+++ src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
@@ -90,11 +90,17 @@
        count
        (>= 1)))

+(defn map-of-maps? [x]
+  (and (map? x)
+       (every? map? (vals x))))
+
 (def MultiWebserverRawConfig
   (schema/both MultiWebserverRawConfigUnvalidated (schema/pred one-default? 'one-default?)))

 (def WebserverServiceRawConfig
-  (schema/either WebserverRawConfig MultiWebserverRawConfig))
+  (schema/conditional
+     map-of-maps? MultiWebserverRawConfig
+     :else WebserverRawConfig))

 (def WebserverSslPemConfig
   {:ssl-key                              schema/Str


mess around with dynamic movement

mess around with dynamic movement

--- src/tween/core.cljs
+++ src/tween/core.cljs
@@ -91,40 +91,41 @@
              (.addEventListener Ticker. "tick" stage))
            (js/console.error "Not sure what kind of shape you made"))))
      :reagent-render
-     (fn [{:keys [id] :as props}]
-       [:canvas {:id id :height 500 :width 500}])}))
+     (fn [{:keys [id height width] :as props}]
+       [:canvas {:id id :height height :width width}])}))

 (defn home-page []
-  [:div
-   [:h2 "Welcome to Reagent"]
-   [:p "Tween sample from main page integrated with reagent-frontend
-    template not using externs though"]
-   [TweenMovement {:id "demoCanvas"
-                   :item {:id 1
-                          :type :circle
-                          :fill "black"
-                          :r 50
-                          :x 100
-                          :y 100}
-                   :fps-ticker 60
-                   :movement [{:item 1 :axis :x :pos 400 :t 1000 :ease 4}
-                              {:item 1 :axis :y :pos 75 :t 500 :ease 2 :alpha 0}
-                              {:item 1 :axis :y :pos 125 :t 100 :alpha 0}
-                              {:item 1 :axis :y :pos 100 :t 500 :ease 2 :alpha 1}
-                              {:item 1 :axis :x :pos 100 :t 800 :ease 2}]}]
-   [TweenMovement {:id "demoCanvas2"
-                   :item {:id 1
-                          :type :circle
-                          :fill "red"
-                          :r 50
-                          :x 100
-                          :y 100}
-                   :fps-ticker 60
-                   :movement [{:item 1 :axis :x :pos 100 :t 1000 :ease 4}
-                              {:item 1 :axis :y :pos 100 :t 500 :ease 2 :alpha 0}
-                              {:item 1 :axis :y :pos 125 :t 100 :alpha 0}
-                              {:item 1 :axis :y :pos 75 :t 500 :ease 2 :alpha 1}
-                              {:item 1 :axis :x :pos 400 :t 800 :ease 2}]}]])
+  (let [ltr-movement [{:item 1 :axis :x :pos 400 :t 800 :ease 4}
+                      {:item 1 :axis :y :pos 75 :t 500 :ease 2 :alpha 0}
+                      {:item 1 :axis :y :pos 125 :t 100 :alpha 0}
+                      {:item 1 :axis :y :pos 100 :t 500 :ease 2 :alpha 1}
+                      {:item 1 :axis :x :pos 100 :t 800 :ease 2}]]
+    [:div
+     [:h2 "Welcome to Reagent"]
+     [:p "Tween sample from main page integrated with reagent-frontend
+      template not using externs though"]
+     [TweenMovement {:id "demoCanvas"
+                     :height 250
+                     :width 600
+                     :item {:id 1
+                            :type :circle
+                            :fill "black"
+                            :r 50
+                            :x 100
+                            :y 100}
+                     :fps-ticker 60
+                     :movement ltr-movement}]
+     [TweenMovement {:id "demoCanvas2"
+                     :height 250
+                     :width 600
+                     :item {:id 1
+                            :type :circle
+                            :fill "red"
+                            :r 50
+                            :x 400
+                            :y 100}
+                     :fps-ticker 60
+                     :movement (reverse ltr-movement)}]]))

 ;; -------------------------
 ;; Initialize app


Support for skipping loading

Support for skipping loading

As in Planck. For #85

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -149,6 +149,20 @@

 (def ^:private closure-index-mem (memoize closure-index))

+(defn- skip-load?
+  [{:keys [name macros]}]
+  (or
+    (= name 'cljsjs.parinfer)
+    (= name 'cljs.core)
+    (and (= name 'cljs.env.macros) macros)
+    (and (= name 'cljs.analyzer.macros) macros)
+    (and (= name 'cljs.compiler.macros) macros)
+    (and (= name 'cljs.repl) macros)
+    (and (= name 'cljs.js) macros)
+    (and (= name 'cljs.pprint) macros)
+    (and (= name 'clojure.template) macros)
+    (and (= name 'tailrecursion.cljson) macros)))
+
 ;; Represents code for which the goog JS is already loaded
 (defn- skip-load-goog-js?
   [name]
@@ -168,16 +182,17 @@
       (cb nil))))

 (defn load [{:keys [name macros path] :as full} cb]
-  #_(prn full)
-  (if (re-matches #"^goog/.*" path)
-    (do-load-goog name cb)
-    (loop [extensions (if macros
-                        [".clj" ".cljc"]
-                        [".cljs" ".cljc" ".js"])]
-      (if extensions
-        (when-not (load-and-callback! path (first extensions) cb)
-          (recur (next extensions)))
-        (cb nil)))))
+  (cond
+    (skip-load? full) (cb {:lang   :js
+                           :source ""})
+    (re-matches #"^goog/.*" path) (do-load-goog name cb)
+    :else (loop [extensions (if macros
+                              [".clj" ".cljc"]
+                              [".cljs" ".cljc" ".js"])]
+            (if extensions
+              (when-not (load-and-callback! path (first extensions) cb)
+                (recur (next extensions)))
+              (cb nil)))))

 (defn- canonicalize-specs
   [specs]


Playing with Ian Rumford's reducer examples.

--- test/com/nomistech/clojure_the_language/reducers_rumford_test.clj
+++ test/com/nomistech/clojure_the_language/reducers_rumford_test.clj
@@ -1,20 +1,22 @@
-;;;; From http://ianrumford.github.io/blog/2013/08/25/some-trivial-examples-of-using-clojure-reducers/
-;;;; and the corresponding gist at https://gist.github.com/ianrumford/6333358
-
 (ns com.nomistech.clojure-the-language.reducers-rumford-test
   (:require [clojure.core.reducers :as r]
             [clojure.string :as string]
             [midje.sweet :refer :all]))

-;; The Families in the Village
+;;;; From http://ianrumford.github.io/blog/2013/08/25/some-trivial-examples-of-using-clojure-reducers/
+;;;; and the corresponding gist at https://gist.github.com/ianrumford/6333358
+
+;;;; With extras.
+
+
+;;;; ___________________________________________________________________________

 (def village
-  [
-   {:home :north :family "smith" :name "sue" :age 37 :sex :f :role :parent}
+  "The Families in the Village"
+  [{:home :north :family "smith" :name "sue" :age 37 :sex :f :role :parent}
    {:home :north :family "smith" :name "stan" :age 35 :sex :m :role :parent}
    {:home :north :family "smith" :name "simon" :age 7 :sex :m :role :child}
    {:home :north :family "smith" :name "sadie" :age 5 :sex :f :role :child}
-

    {:home :south :family "jones" :name "jill" :age 45 :sex :f :role :parent}
    {:home :south :family "jones" :name "jeff" :age 45 :sex :m :role :parent}
@@ -27,8 +29,7 @@
    {:home :west :family "brown" :name "bettie" :age 29 :sex :f :role :child}

    {:home :east :family "williams" :name "walter" :age 23 :sex :m :role :parent}
-   {:home :east :family "williams" :name "wanda" :age 3 :sex :f :role :child}
-   ])
+   {:home :east :family "williams" :name "wanda" :age 3 :sex :f :role :child}])

 ;;;; ___________________________________________________________________________
@@ -41,6 +42,45 @@
 ;; Example 1 - use redcue to add up all the mapped values
 (r/reduce + 0 (ex1-map-children-to-value-1 village))

+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+(defn person--child?
+  [person]
+  (= (:role person)
+     :child))
+
+(defn person--child?->1
+  [person]
+  (if (person--child? person) 1 0))
+
+(fact
+  (r/reduce + 0 ((r/map person--child?->1) village))
+  => 8)
+
+(fact
+  (r/reduce + 0 (r/map person--child?->1 village))
+  => 8)
+
+(fact
+  (r/reduce + 0 ((comp (r/map (constantly 1))
+                       (r/filter person--child?))
+                 village))
+  => 8)
+
+;; Separating into map and filter is a bit faster, it seems.
+
+#_
+(def my-collection (time (into [] (range 50000000))))
+#_
+(do
+  (time (r/reduce + 0 ((comp (r/map (constantly 1))
+                             (r/filter even?))
+                       my-collection)))
+  (time (r/reduce + 0 ((r/map (fn [x] (if (even? x) 1 0)))
+                       my-collection))))
+;; "Elapsed time: 4976.768 msecs"
+;; "Elapsed time: 5909.332 msecs"

 ;;;; ___________________________________________________________________________

@@ -56,6 +96,20 @@
 (r/reduce + 0 (ex2-pipeline village))
 ;; =>
 2
+
+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+(defn person--brown-family-member? [person]
+  (= (string/lower-case (:family person))
+     "brown"))
+
+(fact
+  (r/reduce + 0 ((comp (r/map (constantly 1))
+                       (r/filter person--child?)
+                       (r/filter person--brown-family-member?))
+                 village))
+  => 2)

 ;;;; ___________________________________________________________________________

@@ -84,6 +138,20 @@
 ;; =>
 3

+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+(defn person--name-begins-with-j? [person]
+  (= (string/lower-case (first (:name person)))
+     "j"))
+
+(fact
+  (r/reduce + 0 ((comp (r/map (constantly 1))
+                       (r/filter person--name-begins-with-j?)
+                       (r/filter person--child?))
+                 village))
+  => 3)
+
 ;;;; ___________________________________________________________________________

 ;; Example 4 - making a collection how many children's names start with J?
@@ -99,6 +167,18 @@
  {:age 16, :home :south, :name "jason", :sex :f, :family "jones", :role :child}
  {:age 14, :home :south, :name "june", :sex :f, :family "jones", :role :child}]

+
+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+(fact
+  (into [] ((comp (r/filter person--name-begins-with-j?)
+                  (r/filter person--child?))
+            village))
+  =>
+  [{:age 19, :home :south, :name "jackie", :sex :f, :family "jones", :role :child}
+   {:age 16, :home :south, :name "jason", :sex :f, :family "jones", :role :child}
+   {:age 14, :home :south, :name "june", :sex :f, :family "jones", :role :child}])

 ;;;; ___________________________________________________________________________

@@ -141,17 +221,56 @@
              (ex3-select-children village))))))

 ;; Example 5 - calculate the average age of children on or below the equator
-(def ex5-averge-age-of-children-on-or-below-the-equator (float (/ ex5-sum-of-ages-of-children-on-or-below-the-equator ex5-no-children-on-or-below-the-equator )))
-
+(def ex5-averge-age-of-children-on-or-below-the-equator
+  (float (/ ex5-sum-of-ages-of-children-on-or-below-the-equator
+            ex5-no-children-on-or-below-the-equator )))
+
+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+(fact
+  ex5-no-children-on-or-below-the-equator
+  => 6)
+
+(fact
+  ex5-sum-of-ages-of-children-on-or-below-the-equator
+  => 104)
+
+(fact
+  ex5-averge-age-of-children-on-or-below-the-equator
+  => (float 52/3))
+
+(defn person--add-lat-and-long
+  [person]
+  (condp = (:home person)
+    :north (assoc person :lat 90 :lng 0)
+    :south (assoc person :lat -90 :lng 0)
+    :west (assoc person :lat 0 :lng -180)
+    :east (assoc person :lat 0 :lng 180)))
+
+(fact
+  (let [children-below-equator ((comp (r/filter #(>= 0 (:lat %)))
+                                      (r/map person--add-lat-and-long)
+                                      (r/filter person--child?))
+                                village)]
+    (/ (r/reduce + 0 ((r/map #(:age %)) children-below-equator))
+       (r/reduce + 0 ((r/map (constantly 1)) children-below-equator))))
+  => 52/3)

 ;;;; ___________________________________________________________________________

 ;; That was fun but why bother

+
+
+;; N.B. This example doesn't show that `fold` does better than `reduce`.
+;;      The collections are too small.
+;;      (That's what this example is intended to show.)
+
 ;; Example 6 - comparing the performance of reduce and fold

 ;; Example 6 - time reduce adding up Example 5's ages
-(time (r/reduce +
+#_(time (r/reduce +
                 (ex5-select-age
                  (ex5-select-people-on-or-below-equator
                   (ex5-map-home-to-latitude-and-longitude
@@ -161,13 +280,16 @@

 ;; Example 6 - time fold adding up Example 5's ages
-(time (r/fold +
+#_(time (r/fold +
               (ex5-select-age
                (ex5-select-people-on-or-below-equator
                 (ex5-map-home-to-latitude-and-longitude
                  (ex3-select-children village))))))
 ;; =>
 "Elapsed time: 0.185448 msecs"
+
+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff

 ;;;; ___________________________________________________________________________
@@ -195,8 +317,8 @@

 (defn ex7-make-visitors [n] (take n (repeatedly ex7-make-visitor)))

-(def ex7-visitors (ex7-make-visitors 100))
-;;(def ex7-visitors (into [] (ex7-make-visitors 1000000)))
+;;(def ex7-visitors (ex7-make-visitors 100))
+(def ex7-visitors (into [] (ex7-make-visitors 1000000)))

 ;; Example 7 - count the visiting Brown children using reduce
 ;;(time (r/reduce + 0 (ex2-pipeline ex7-visitors)))
@@ -207,6 +329,7 @@
 ;;(time (r/fold + (ex2-pipeline ex7-visitors)))
 ;; =>
 "Elapsed time: 64.788173 msecs"
+

 ;; Example 7 - count the visiting Brown children using core map, filter and reduce
 ;; (time (reduce + 0
@@ -216,6 +339,7 @@
 "Elapsed time: 223.55717 msecs"

+
 ;; WHat else can you do with fold?

 ;; A simple folder where both the reducer and combiner is +
@@ -224,6 +348,16 @@
 ;; A fold supplied with the chunk size, a combiner and a reducer
 ;;(r/fold the-chunk-size (r/monoid the-combiner-function the-init-function) the-reducer-function)

+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+
+#_
+(do
+  (time (reduce + 0
+                (map #(if (= :child (:role %)) 1 0)
+                     (filter #(= "brown" (string/lower-case (:family %))) ex7-visitors))))
+  (time (r/reduce + 0 (ex2-pipeline ex7-visitors)))
+  (time (r/fold + (ex2-pipeline ex7-visitors))))

 ;;;; ___________________________________________________________________________

@@ -254,3 +388,7 @@
 (r/fold ex8-combiner ex8-reducer  ex8-visitors-collection)
 ;; =>
 {:total-people 28, :total-age 1314, :average-age 46.92857}
+
+;;;; ---------------------------------------------------------------------------
+;;;; nomis stuff
+