Tundra S3: close input stream!

Tundra S3: close input stream!

--- src/taoensso/carmine/tundra/s3.clj
+++ src/taoensso/carmine/tundra/s3.clj
@@ -3,7 +3,7 @@
   {:author "Peter Taoussanis"}
   (:require [clojure.string          :as str]
             [aws.sdk.s3              :as s3]
-            [taoensso.encore         :as encore]
+            [taoensso.encore         :as enc :refer (have? have)]
             [taoensso.timbre         :as timbre]
             [taoensso.carmine.tundra :as tundra])
   (:import  [java.io ByteArrayInputStream DataInputStream]
@@ -17,7 +17,7 @@
 (defrecord S3DataStore [creds bucket]
   IDataStore
   (put-key [this k v]
-    (assert (encore/bytes? v))
+    (have? enc/bytes? v)
     (let [reply (try (s3/put-object creds bucket k (ByteArrayInputStream. v)
                        {:content-length (count v)
                         ;; Nb! Prevents overwriting with corrupted data:
@@ -38,10 +38,14 @@
     (let [fetch1
           (fn [k]
             (tundra/catcht
-             (let [obj (s3/get-object creds bucket k)
-                   ba  (byte-array (-> obj :metadata :content-length))]
-               (.readFully (DataInputStream. (:content obj)) ba)
-               ba)))]
+              (let [obj (s3/get-object creds bucket k)]
+                (with-open
+                    [^com.amazonaws.services.s3.model.S3ObjectInputStream cnt
+                     (:content obj)]
+                  (let [ba (byte-array (enc/have enc/pos-int?
+                                         (-> obj :metadata :content-length)))]
+                    (.readFully (DataInputStream. cnt) ba)
+                    ba)))))]
       (->> (mapv #(future (fetch1 %)) ks)
            (mapv deref)))))

@@ -58,6 +62,6 @@

 (comment
   (def dstore  (s3-datastore creds "ensso-store/folder"))
-  (def hardkey (tundra/>urlsafe-str "foo:bar /♡\\:baz "))
+  (def hardkey (tundra/>urlsafe-str "00temp-test-foo:bar /♡\\:baz "))
   (tundra/put-key dstore hardkey (.getBytes "hello world"))
   (String. (first (tundra/fetch-keys dstore [hardkey]))))


TODO comments - link back to GitHub issue

--- test/unit/patch.cljc
+++ test/unit/patch.cljc
@@ -138,8 +138,7 @@
         (is (= 21 (new-sum 1 2 3 4 5 6)))
         (is (= 120 (new-sum 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))))))

-; TODO: fails in CLJS with:
-; "TypeError: undefined is not a constructor (evaluating 'unit.fixtures.functions.variadic.cljs$core$IFn$_invoke$arity$1(arguments[0])')"
+; TODO: fails in CLJS - see https://github.com/metametadata/clj-fakes/issues/3
 #?(:clj
    (u/-deftest
      "variadic function can be patched with non-variadic function which calls original function"
@@ -150,7 +149,7 @@

        (is (= "[a]" (funcs/variadic 100))))))

-; TODO: fails in CLJS with "RangeError: Maximum call stack size exceeded."
+; TODO: fails in CLJS - see https://github.com/metametadata/clj-fakes/issues/3
 #?(:clj
    (u/-deftest
      "variadic function can be patched with variadic function which calls original function"


moved statement creation to function

moved statement creation to function

--- src/athena_cmd/core.clj
+++ src/athena_cmd/core.clj
@@ -8,26 +8,33 @@

 (use '[clojure.pprint :only [print-table]])

-(def athenaURI
-  "jdbc:awsathena://athena.us-east-1.amazonaws.com:443")
+(defn get_properties
+  []
+  (let [info (Properties.)
+        s3_path_env "ATHENA_S3_PATH"
+        s3_path (System/getenv s3_path_env)
+        ]
+    (doto info

-(def info (Properties.))
+      (.put "s3_staging_dir"
+        (if s3_path s3_path
+          (throw (Exception. (str s3_path_env " is not set.")))))

-(def s3_path_env "ATHENA_S3_PATH")
-(def s3_path (System/getenv s3_path_env))
+      (.put "aws_credentials_provider_class"
+            "com.amazonaws.auth.DefaultAWSCredentialsProviderChain")

-(.put info "s3_staging_dir"
-      (if s3_path s3_path
-        (throw (Exception. (str s3_path_env " is not set.")))))
+      (.put "log_path"
+            "/tmp/athenajdbc.log"))

-(.put info "aws_credentials_provider_class"
-           "com.amazonaws.auth.DefaultAWSCredentialsProviderChain")
+          info))

-(.put info "log_path"
-           "/tmp/athenajdbc.log")
-
-(def conn (DriverManager/getConnection athenaURI info))
-(def stmt (.createStatement conn))
+(defn get_stmt
+  []
+  (let [athenaURI
+        "jdbc:awsathena://athena.us-east-1.amazonaws.com:443"
+        info (get_properties)
+        conn (DriverManager/getConnection athenaURI info)
+        stmt (.createStatement conn)] stmt))

 (defn read_row
   [rs]
@@ -42,11 +49,9 @@

 (defn exec
   [query]
-  (let [rs (.executeQuery stmt query)
-        m (.getMetaData rs)]
+  (let [rs (.executeQuery (get_stmt) query)]

-    (loop [
-           res []
+    (loop [res []
            more (.next rs)]

       (if-not more


combine two stages in the pipeline into one

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -56,13 +56,9 @@

      ;; For each bolt, create a map of complement positions
      ;; within the bolt to possible complements for that position
-     (map (fn [bolt] (assoc
-                       (comp-paths-to-complements bolt model depth max-depth)
-                       [] (list bolt))))
-
-     (map (fn [bolt-and-comps]
-            {:bolt (get bolt-and-comps [])
-             :comps (dissoc bolt-and-comps [])}))
+     (map (fn [bolt]
+            {:bolt (list bolt)
+             :comps (comp-paths-to-complements bolt model depth max-depth)}))

      ;; For each such map:complement-position -> complements, find all
      ;; possible combinations of complements, taking one complement


more logging

more logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -180,9 +180,7 @@
   ;; otherwise has a child with the same two options (leaf or a head child),
   ;; up to the maximum depth.
   (log/debug (str "lightning-bolts: depth="
-                  depth (if use-candidate-parents
-                          (str "; using ucp: "
-                               (count use-candidate-parents)))))
+                  depth "; spec=" (dag_unify.core/strip-refs spec)))
   (if (and (< depth max-depth)
            (not (= false (get-in spec [:phrasal] true))))
     (let [candidate-parents
@@ -205,8 +203,9 @@
                                                      spec)))
                                     true
                                     (log/debug (str "rule:" (:rule rule)
-                                                    " => "
-                                                    "OK")))
+                                                    " OK for spec:"
+                                                    (dag_unify.core/strip-refs
+                                                     spec))))
                               result)))
                      (filter #(not (= :fail %)))
                      (shufflefn))]
@@ -318,7 +317,16 @@
                    (or (:lexicon (:generate model)) (:lexicon model)))))))
    (filter #(or (= false (get-in % [:exception] false))
                 (not (= :verb (get-in % [:synsem :cat])))))
-   (map #(unify % spec))
+   (map
+    (fn [lexeme]
+      (do
+        (log/debug (str "get-lexemes: testing lexeme: "
+                        (dag_unify.core/strip-refs lexeme)))
+        (let [result (unify lexeme spec)]
+          (if (= result :fail)
+            (log/debug (str "fail-path:"
+                            (dag_unify.core/fail-path lexeme spec))))
+          result))))
    (filter #(not (= :fail %)))))

 (defn show-spec [spec]


schemas for all http request body parsing

--- src/shale/resources.clj
+++ src/shale/resources.clj
@@ -120,7 +120,11 @@
   :allowed-methods [:get :put :delete]
   :available-media-types ["application/json"]
   :known-content-type? is-json-or-unspecified?
-  :malformed? #(parse-request-data :context %)
+  :malformed? #(parse-request-data
+                 :context %
+                 :schema {(s/optional-key "reserved") s/Bool
+                          (s/optional-key "tags") [s/Str]
+                          (s/optional-key "current_url") s/Str})
   :handle-ok (fn [context]
                (jsonify (get context ::session)))
   :handle-exception handle-exception
@@ -146,7 +150,6 @@
   :allowed-methods  [:get]
   :available-media-types  ["application/json"]
   :known-content-type? is-json-or-unspecified?
-  :malformed? #(parse-request-data :context %)
   :handle-ok (fn [context]
                (jsonify (shale.nodes/view-models)))
   :handle-exception handle-exception)
@@ -162,7 +165,10 @@
   :allowed-methods [:get :put :delete]
   :available-media-types ["application/json"]
   :known-content-type? is-json-or-unspecified?
-  :malformed? #(parse-request-data :context %)
+  :malformed? #(parse-request-data
+                 :context %
+                 :schema {(s/optional-key "url") s/Str
+                          (s/optional-key "tags") [s/Str]})
   :handle-ok (fn [context]
                (jsonify (get context ::node)))
   :handle-exception handle-exception


removed unneeded line from om-next template

--- resources/om-next.cljs
+++ resources/om-next.cljs
@@ -34,7 +34,6 @@
 (defmethod read :default
   [{:keys [state]} k _]
   (let [st @state]
-    (find st k)
     (if-let [[_ v] (find st k)]
       {:value v}
       {:value :not-found})))


Badge ads, added :remote_badge_id to schema

--- src/cljc/salava/extra/application/schemas.cljc
+++ src/cljc/salava/extra/application/schemas.cljc
@@ -10,6 +10,7 @@
                           :remote_url            s/Str
                           :remote_id             s/Str
                           :remote_issuer_id      s/Str
+          (s/optional-key :remote_badge_id)      s/Str
                           :info                  s/Str
                           :application_url       s/Str
                           :application_url_label (s/maybe s/Str)
@@ -35,7 +36,8 @@

 (s/defschema BadgeAdvertUnpublish {:remote_url       s/Str
                                    :remote_id        s/Str
-                                   :remote_issuer_id s/Str})
+                                   :remote_issuer_id s/Str
+                   (s/optional-key :remote_badge_id) s/Str})


change user collection vector to set

change user collection vector to set

--- src/cljs/offcourse/collection_api/service.cljs
+++ src/cljs/offcourse/collection_api/service.cljs
@@ -16,10 +16,8 @@
 (defn fetch-user-collection [user-name]
   (->> fake-data/courses
        (reduce (fn [acc [id course]]
-                 (if (= user-name (:curator course))
-                   (conj acc id)
-                   acc)
-                 )[])))
+                 (if (= user-name (:curator course)) (conj acc id) acc)
+                 ) #{})))

 (defn fetch-collection [payload]
   (match [payload]


keep sketch and applet docstrings in synck

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -138,50 +138,54 @@
 (defn applet
   "Create and start a new visualisation applet.

-  :title          - a string which will be displayed at the top of
-                    the applet window.
-
-  :size           - a vector of width and height. Defaults to
-                    [500 300].
-
-  :renderer       - The renderer to use. (one of :p2d, :java2d,
-                    :opengl, :pdf or :dxf). Defaults to :java2d.
-
-  :setup          - a fn to be called once when setting the applet up.
-
-  :draw           - a fn to be repeatedly called at most n times per
-                    second where n is the target frame-rate set for
-                    the visualisation.
-
-  :target         - one of :frame, :perm-frame. Default :frame.
-
-  :focus-gained   - Called when the applet gains focus.
-
-  :focus-lost     - Called when the applet loses focus.
-
-  :mouse-entered  - Called when the mouse enters the applet window.
-
-  :mouse-exited   - Called when the mouse leaves the applet window
-
-  :mouse-pressed  - Called every time a mouse button is pressed.
-
-  :mouse-released - Called every time a mouse button is released.
-
-  :mouse-clicked  - called once after a mouse button has been pressed
-                    and then released.
-
-  :mouse-moved    - Called every time the mouse moves and a button is
-                    not pressed.
-
-  :mouse-dragged  - Called every time the mouse moves and a button is
-                    pressed.
-
-  :key-pressed    - Called every time any key is pressed.
-
-  :key-released   - Called every time any key is released.
-
-  :key-typed      - Called once every time non-modifier keys are
-                    pressed."
+   :size           - a vector of width and height for the sketch.
+                     Defaults to [500 300].
+
+   :renderer       - Specify the renderer type. One of :p2d, :java2d,
+                     :opengl, :pdf or :dxf). Defaults to :java2d.
+
+   :title          - a string which will be displayed at the top of
+                     the sketch window.
+
+   :keep-on-top    - Specify whether the window should be on top of
+                     all other OS windows.
+
+   :decor          - Specify if the window should have OS frame
+                     decorations.
+
+   :setup          - a fn to be called once when setting the sketch up.
+
+   :draw           - a fn to be repeatedly called at most n times per
+                     second where n is the target frame-rate set for
+                     the visualisation.
+
+   :focus-gained   - Called when the sketch gains focus.
+
+   :focus-lost     - Called when the sketch loses focus.
+
+   :mouse-entered  - Called when the mouse enters the sketch window.
+
+   :mouse-exited   - Called when the mouse leaves the sketch window
+
+   :mouse-pressed  - Called every time a mouse button is pressed.
+
+   :mouse-released - Called every time a mouse button is released.
+
+   :mouse-clicked  - called once after a mouse button has been pressed
+                     and then released.
+
+   :mouse-moved    - Called every time the mouse moves and a button is
+                     not pressed.
+
+   :mouse-dragged  - Called every time the mouse moves and a button is
+                     pressed.
+
+   :key-pressed    - Called every time any key is pressed.
+
+   :key-released   - Called every time any key is released.
+
+   :key-typed      - Called once every time non-modifier keys are
+                     pressed."
   [& opts]
   (let [options           (merge {:size [500 300] :target :frame}
                                  (apply hash-map opts))


fixed plumatic issue with optional keys

fixed plumatic issue with optional keys

--- src/dda/pallet/domain/dda_servertest_crate.clj
+++ src/dda/pallet/domain/dda_servertest_crate.clj
@@ -34,25 +34,27 @@
    {:dda-servertest-group
     {:dda-servertest crate/ServerTestConfig}}})

-(s/defn ^:always-validate crate-stack-configuration :- ServertestCrateStackConfig
-  [domain-config :- ServerTestDomainConfig
-   & {:keys [group-key] :or {group-key :dda-servertest-group}}]
-  (let [{:keys [os-user]} domain-config]
-    {:group-specific-config
-      {group-key
-        {:dda-servertest
-         (merge
-          (if (contains? domain-config :package)
-            {:package-fact nil
-             :package-test (:package domain-config)}
-            {})
-          (if (contains? domain-config :netstat)
-            {:netstat-fact nil
-             :netstat-test (:netstat domain-config)}
-            {})
-          (if (contains? domain-config :file)
-            {:file-fact (map #(:path %) (vals (:file domain-config)))
-             :file-test (:file domain-config)}))}}}))
+(defn crate-stack-configuration
+  [domain-config & {:keys [group-key] :or {group-key :dda-servertest-group}}]
+  (s/validate s/Keyword group-key)
+  (s/validate ServerTestDomainConfig domain-config)
+  (s/validate ServertestCrateStackConfig
+    (let [{:keys [os-user]} domain-config]
+      {:group-specific-config
+        {group-key
+          {:dda-servertest
+           (merge
+            (if (contains? domain-config :package)
+              {:package-fact nil
+               :package-test (:package domain-config)}
+              {})
+            (if (contains? domain-config :netstat)
+              {:netstat-fact nil
+               :netstat-test (:netstat domain-config)}
+              {})
+            (if (contains? domain-config :file)
+              {:file-fact (map #(:path %) (vals (:file domain-config)))
+               :file-test (:file domain-config)}))}}})))

 (s/defn ^:always-validate dda-servertest-group
   [stack-config :- ServertestCrateStackConfig]


Updated ns-tracker to 0.2.2

Updated ns-tracker to 0.2.2

--- ring-devel/project.clj
+++ ring-devel/project.clj
@@ -6,7 +6,7 @@
   :dependencies [[ring/ring-core "1.2.1"]
                  [hiccup "1.0.3"]
                  [clj-stacktrace "0.2.5"]
-                 [ns-tracker "0.2.1"]]
+                 [ns-tracker "0.2.2"]]
   :profiles
   {:1.4 {:dependencies [[org.clojure/clojure "1.4.0"]]}
    :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}})


Well, that was pointless busiwork

Well, that was pointless busiwork

--- tasks/leiningen/compile_assets.clj
+++ tasks/leiningen/compile_assets.clj
@@ -8,7 +8,6 @@
      (require '[clojure.tools.logging :refer (info)])
      (require '[staircase.tasks.assets :as assets])
      (info "Precompiling assets...")
-     (assets/clean)
      (assets/precompile)))

 (defn precompile-assets [f & [project :as args]]


cleaning imports

cleaning imports

--- test/celestial/integration/workflows/freenas.clj
+++ test/celestial/integration/workflows/freenas.clj
@@ -6,11 +6,9 @@
     [celestial.persistency.systems :as s]
     [celestial.fixtures.data :refer (redis-type local-conf redis-freenas)]
     [celestial.fixtures.populate :refer (populate-system)]
-    [celestial.integration.workflows.common :refer (spec get-spec)]
-    [celestial.workflows :as wf]
-    )
-  (:use midje.sweet)
- )
+    [celestial.integration.workflows.common :refer (spec)]
+    [celestial.workflows :as wf])
+  (:use midje.sweet))

 (with-admin
   (with-conf local-conf


(#9068) Add a real world query SQL test

(#9068) Add a real world query SQL test

This adds a real query, based on the StoreConfigs default pattern, to the test
suite.  This validates that we can really compile a complex, real-world query
and see the correct results returned.

Signed-off-by: Daniel Pittman <3d0f3b9ddcacec30c4008c5e030e6c13a478cb4f@puppetlabs.com>

--- test/com/puppetlabs/cmdb/test/query/resource.clj
+++ test/com/puppetlabs/cmdb/test/query/resource.clj
@@ -232,6 +232,9 @@
     (doseq [n [1 3 5]]
       (sql/insert-record :certname_resources
                          {:certname "subset.local" :resource (str n)}))
+    (sql/insert-records
+     :resource_tags
+     {:resource "4" :name "vivid"})
     ;; structure the results, eh.
     (let [result1 {:hash      "1"
                    :type       "File"
@@ -280,22 +283,45 @@
       ;; ...and, finally, ready for testing.
       (testing "queries against SQL data"
         (doseq [[input expect]
-                {;; no match
-                 ["=" "type" "Banana"]            []
-                 ["=" "tag"  "exotic"]            []
-                 ["=" ["parameter" "foo"] "bar"]  []
-                 ["=" ["node" "certname"] "bar"]  []
-                 ;; ...and with an actual match.
-                 ["=" "type" "File"]              [result1 result4]
-                 ["=" "exported" true]            [result1 result2 result3]
-                 ["=" ["parameter" "ensure"] "file"] [result1]
-                 ;; multi-value parameter matching!
-                 ["=" ["parameter" "multi"] "two"] [result6]
-                 ;; and that they don't match *everything*
-                 ["=" ["parameter" "multi"] "five"] []
-                 ;; testing not operations
-                 ["not" ["=" "type" "File"]] [result2 result3 result5 result6]
-                 ["not" ["=" "type" "File"] ["=" "type" "Notify"]] [result6]
-                 }]
+                (partition
+                 2 [ ;; no match
+                    ["=" "type" "Banana"]            []
+                    ["=" "tag"  "exotic"]            []
+                    ["=" ["parameter" "foo"] "bar"]  []
+                    ["=" ["node" "certname"] "bar"]  []
+                    ;; ...and with an actual match.
+                    ["=" "type" "File"]              [result1 result4]
+                    ["=" "exported" true]            [result1 result2 result3]
+                    ["=" ["parameter" "ensure"] "file"] [result1]
+                    ["=" ["node" "certname"] "subset.local"] [result1 result3 result5]
+                    ["=" "tag" "vivid"] [result4]
+                    ;; multi-value parameter matching!
+                    ["=" ["parameter" "multi"] "two"] [result6]
+                    ;; and that they don't match *everything*
+                    ["=" ["parameter" "multi"] "five"] []
+                    ;; testing not operations
+                    ["not" ["=" "type" "File"]] [result2 result3 result5 result6]
+                    ["not" ["=" "type" "File"] ["=" "type" "Notify"]] [result6]
+                    ;; and, or
+                    ["and" ["=" "type" "File"] ["=" "title" "/etc/passwd"]] [result1]
+                    ["and" ["=" "type" "File"] ["=" "type" "Notify"]] []
+                    ["or" ["=" "type" "File"] ["=" "title" "/etc/passwd"]]
+                    [result1 result4]
+                    ["or" ["=" "type" "File"] ["=" "type" "Notify"]]
+                    [result1 result2 result3 result4 result5]
+                    ;; nesting queries
+                    ["and" ["or" ["=" "type" "File"] ["=" "type" "Notify"]]
+                     ["=" ["node" "certname"] "subset.local"]
+                     ["and" ["=" "exported" true]]]
+                    [result1 result3]
+                    ;; real world query (approximately; real world exported is
+                    ;; true, but for convenience around other tests we use
+                    ;; false here. :)
+                    ["and" ["=" "exported" false]
+                     ["not" ["=" ["node" "certname"] "subset.local"]]
+                     ["=" "type" "File"]
+                     ["=" "tag" "vivid"]]
+                    [result4]
+                    ])]
           (is (= (s/query-resources input) expect)
               (str "  " input " =>\n  " expect)))))))


Using :url for the project's URL.

Using :url for the project's URL.

--- KataTrigrams/project.clj
+++ KataTrigrams/project.clj
@@ -1,7 +1,6 @@
 (defproject kata-trigrams "1.0.0-SNAPSHOT"
-  :description "Random text generator using trigrams.
-                See github.com/bfontaine/Katas."
+  :description "Random text generator using trigrams."
+  :url "https://github.com/bfontaine/Katas"
   :dependencies [[org.clojure/clojure "1.3.0"]]
-
   :main kata-trigrams.cli
   :repl-init kata-trigrams.core)


Drop remote send/receive logging

Drop remote send/receive logging

--- src/web/reconciler.cljs
+++ src/web/reconciler.cljs
@@ -74,7 +74,6 @@
     (merge-tree a b)))

 (defn merge-remote [results merge-fn]
-  (println "<<" results)
   (merge-fn results))

 (def remotes
@@ -92,7 +91,6 @@
          #js {"Content-Type" "application/transit+json"}))

 (defn send-to-remotes [remotes sends merge-fn]
-  (println ">>" sends)
   (doseq [[remote query] sends]
     (transit-post (get-in remotes [remote :url])
                   query


minor

minor

--- src/ysmiraak/tensor.clj
+++ src/ysmiraak/tensor.clj
@@ -47,36 +47,39 @@
          (recur idxs ds (+ axis (if (integer? idx) 0 1)) tsr)
          tsr)))))

+(def _ nil)
+
 (defn reshape
-  [tsr dims]
-  (let [dim$ (shape tsr)
-        siz$ (reduce * dim$)
-        fill (keep-indexed (fn [i d] (if (neg? d) i)) dims)
-        fill (if (and (< 1 (count fill)) (not (zero? siz$)))
-               (throw (ex-info "multiple unknown dimensions" {:dims dims}))
-               (first fill))
-        size (reduce * (cond-> dims fill (assoc fill 1)))
-        dim' (cond-> dims fill (assoc fill (if (zero? size) 0 (quot siz$ size))))
-        size (reduce * dim')
-        dims (if-not (= siz$ size)
-               (throw (ex-info "incompatible shapes" {:old dim$ :new dims}))
-               dim')]
-    (if-not (= dim$ dims)
-      (if (zero? size)
-        (if-not (= dim$ (take (count dim$) dims))
-          (reduce (fn [v d] (vec (repeat d v))) [] (reverse (take-while pos? dims)))
-          tsr)
-        (as-> tsr tsr
-          ((->> (partial apply concat)
-                (repeat (dec (count dim$)))
-                (apply comp vec)) tsr)
-          (if (< 1 (count dims))
-            ((->> (next dims)
-                  (map (partial partial partition))
-                  (interleave (repeat (partial map vec)))
-                  (apply comp vec)) tsr)
-            tsr)))
-      tsr)))
+  ([tsr] (reshape tsr [-1]))
+  ([tsr dims]
+   (let [dim$ (shape tsr)
+         siz$ (reduce * dim$)
+         fill (keep-indexed (fn [i d] (if (neg? d) i)) dims)
+         fill (if (and (< 1 (count fill)) (not (zero? siz$)))
+                (throw (ex-info "multiple unknown dimensions" {:dims dims}))
+                (first fill))
+         size (reduce * (cond-> dims fill (assoc fill 1)))
+         dim' (cond-> dims fill (assoc fill (if (zero? size) 0 (quot siz$ size))))
+         size (reduce * dim')
+         dims (if-not (= siz$ size)
+                (throw (ex-info "incompatible shapes" {:old dim$ :new dims}))
+                dim')]
+     (if-not (= dim$ dims)
+       (if (zero? size)
+         (if-not (= dim$ (take (count dim$) dims))
+           (reduce (fn [v d] (vec (repeat d v))) [] (reverse (take-while pos? dims)))
+           tsr)
+         (as-> tsr tsr
+           ((->> (partial apply concat)
+                 (repeat (dec (count dim$)))
+                 (apply comp vec)) tsr)
+           (if (< 1 (count dims))
+             ((->> (next dims)
+                   (map (partial partial partition))
+                   (interleave (repeat (partial map vec)))
+                   (apply comp vec)) tsr)
+             tsr)))
+       tsr))))

 (defn transpose
   ([tsr] (apply mapv vector tsr))


Reject positions that are more than 30 km from the previously reported
position.

I was seeing reports with positions that were off by several degrees
latitude/longitude.

--- src/com/lemondronor/orbital_detector/log2kml.clj
+++ src/com/lemondronor/orbital_detector/log2kml.clj
@@ -3,7 +3,8 @@
   (:require [com.lemondronor.orbital-detector :as orbdet]
             [com.lemonodor.gflags :as gflags]
             [clojure.data.xml :as xml]
-            [clojure.string :as string])
+            [clojure.string :as string]
+            [geo.spatial :as spatial])
   (:import ())
   (:gen-class))

@@ -60,8 +61,45 @@
   (* f 0.3048))

+(defn coordinate [r]
+  (str (:lon (:position r))
+       ","
+       (:lat (:position r))
+       ","
+       (feet-to-meters (:altitude r))))
+
+
+(defn point [r]
+  (spatial/spatial4j-point
+   (:lat (:position r))
+   (:lon (:position r))))
+
+
+(defn distance [r1 r2]
+  (spatial/distance (point r1) (point r2)))
+
+
+(defn warn [& args]
+  (binding [*out* *err*]
+    (apply println args)))
+
+
+(defn filter-reasonable-speed [records]
+  (reverse
+   (reduce
+    (fn [reasonable r]
+      (let [d (distance r (first reasonable))]
+        (if (< d 30000.0)
+          (cons r reasonable)
+          (do
+            (warn "distance from" (first reasonable) "is" d "dropping" r)
+            reasonable))))
+    (list (first records))
+    (rest records))))
+
+
 (defn reports2path [rs]
-  (let [groups (group-by :icao (filter has-position? rs))
+  (let [groups (group-by :icao rs)
         colors (take (count groups) path-colors)]
     (xml/sexp-as-element
      [:kml {:xmlns "http://www.opengis.net/kml/2.2"}
@@ -87,12 +125,7 @@
             [:coordinates
              (string/join
               "\n"
-              (map #(str (:lon (:position %))
-                         ","
-                         (:lat (:position %))
-                         ","
-                         (feet-to-meters (:altitude %)))
-                   rs))]]])
+              (distinct (map coordinate (filter-reasonable-speed rs))))]]])
         groups)]])))

@@ -113,6 +146,7 @@
     (->> args
          (mapcat orbdet/read-log)
          (filter-icaos (gflags/flags :icaos))
+         (filter has-position?)
          reports2path
          xml/emit-str
          println)))


Remove death code

Remove death code

--- backend/src/akvo/lumen/lib/aggregation/pivot.clj
+++ backend/src/akvo/lumen/lib/aggregation/pivot.clj
@@ -8,8 +8,6 @@
             [clojure.string :as str]
             [clojure.tools.logging :as log]
             [hugsql.core :as hugsql]))
-
-(hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")

 (defn- coalesce
   "For pivot tables, `NULL` categories will always be empty because `crosstab` uses `=` and


partial fix and debugging for train

partial fix and debugging for train

--- dada-core/src/main/clojure/org/dada/core/dql.clj
+++ dada-core/src/main/clojure/org/dada/core/dql.clj
@@ -256,6 +256,7 @@
      (initialValue [] 0)
      (initialType [type] Integer)
      (currentValue [extra-values & values] ;TODO - should not need (into-array)
+		   (println "COUNT" extra-values values)
 		   (.create creator (into-array Object (concat extra-values values))))
      (reduce [insertions alterations deletions] (- (count insertions) (count deletions)))
      (apply [currentValue delta] (+ currentValue delta))
@@ -462,18 +463,22 @@

 (defn dunion [& [model-name]]
   (fn [[metadata-fn direct-fn]]
-      (let [[src-metadata metaprefix extra-keys] (metadata-fn)]
+      (let [[src-metadata metaprefix extra-keys] (metadata-fn)
+	    tgt-metaprefix (str metaprefix ".union()")]
+	(println "DUNION METADATA" extra-keys)
 	[ ;; metadata
 	 (fn []
-	     [src-metadata (str metaprefix ".union()") extra-keys])
+	     (MetaResult. src-metadata tgt-metaprefix extra-keys [:union]))
 	 ;; direct
 	 (fn []
 	     (let [[#^Model src-metamodel prefix #^Collection extra-pairs] (direct-fn)
 		   tgt-model (model (or model-name (str prefix ".union()")) src-metadata)
-		   tgt-metamodel (meta-view ".union()" src-metamodel (fn [tgt-metamodel [src-model _ extra-pairs]] (connect src-model tgt-model)))]
+		   tgt-metamodel (meta-view ".union()" src-metamodel (fn [tgt-metamodel [src-model _ extra-pairs]] (connect src-model tgt-model)))
+		   tgt-prefix (str prefix ".union()")]
+	       (println "DUNION DATA" extra-pairs)
 	       (insert *metamodel* tgt-model)
-	       (insert tgt-metamodel [tgt-model extra-pairs])
-	       (Result. tgt-metamodel (str prefix ".union()") extra-pairs :union)))])))
+	       (insert tgt-metamodel (Result. tgt-model tgt-prefix  extra-pairs [:union]))
+	       (Result. tgt-metamodel tgt-metaprefix extra-pairs [:union])))])))

 ;; extra keys are inserted into attribute list
 ;; extra values are carried in model's row in metamodel
@@ -585,7 +590,6 @@
 		     (map
 		      (fn [#^Update insertion]
 			  (let [[src-model prefix split-extra-pairs operation] (.getNewValue insertion)
-				dummy (println "NEW-VALUE"  split-extra-pairs)
 				chain-fn (fn [#^Model split-model split-extra-value]
 					     (println "SPLIT - producing new model" split-model split-extra-value)
 					     (let [split-model-tuple (Result. split-model prefix (concat split-extra-pairs [[split-key split-extra-value]]) [:split :TODO])]


Fix bug caused by Hiccup's automatically removing namespace from symbols

--- src/leiningen/highlight/rendering_rules/html.clj
+++ src/leiningen/highlight/rendering_rules/html.clj
@@ -27,20 +27,20 @@
         "local"
         #_=> (if (= (:usage info) :def)
                (wrap-span [type "def"] (symbol-attr (:id x))
-                          [:a {:name (:id x)} v])
+                          [:a {:name (:id x)} (str v)])
                (wrap-span [type] (symbol-attr (:binding info))
                           [:a {:href (str "#" (:binding info))} v]))
         "var"
         #_=> (if (= (:usage info) :def)
                (wrap-span [type "def"] (symbol-attr (:name info))
-                          [:a {:name (:name info)} v])
+                          [:a {:name (:name info)} (str v)])
                (wrap-span type (symbol-attr v)
                           (var-link (:var info) v)))
         "macro"
         #_=> (let [macro-name (str/replace (str (:macro info)) #"^#'" "")]
                (wrap-span type (symbol-attr macro-name)
                           (var-link (:macro info) v)))
-        #_else (wrap-span type v)))))
+        #_else (wrap-span type (str v))))))

 (defn string-rule [x v]
   (->> (str/split v #"\n")


Fix issue where non-html assets weren't resolving when running the local server

--- src/leiningen/new/cryogen/src/cryogen/server.clj
+++ src/leiningen/new/cryogen/src/cryogen/server.clj
@@ -21,15 +21,18 @@
   (fn [request]
     (let [{:keys [clean-urls blog-prefix public-dest]} (resolve-config)
           req-uri (.substring (url-decode (:uri request)) 1)
-          res-path (condp = clean-urls
-                     :trailing-slash (path req-uri "index.html")
-                     :no-trailing-slash (if (or (= req-uri "")
-                                                (= req-uri "/")
-                                                (= req-uri
-                                                   (.substring blog-prefix 1)))
-                                          (path req-uri "index.html")
-                                          (path (str req-uri ".html")))
-                     :dirty (path (str req-uri ".html")))]
+          res-path (if (or (.endsWith req-uri "/")
+                           (.endsWith req-uri ".html"))
+                     (condp = clean-urls
+                       :trailing-slash (path req-uri "index.html")
+                       :no-trailing-slash (if (or (= req-uri "")
+                                                  (= req-uri "/")
+                                                  (= req-uri
+                                                     (.substring blog-prefix 1)))
+                                            (path req-uri "index.html")
+                                            (path (str req-uri ".html")))
+                       :dirty (path (str req-uri ".html")))
+                     req-uri)]
       (or (file-response res-path {:root public-dest})
           (handler request)))))


Remove unused code

Remove unused code

related to bb7f2b0a603105a7e43a30e6396961ef26f64257

--- backend/src/akvo/lumen/lib/update.clj
+++ backend/src/akvo/lumen/lib/update.clj
@@ -58,7 +58,6 @@
                                           "direction" nil
                                           "hidden" false}
                                    key                   (assoc "key" (boolean key))
-                                   caddisflyResourceUuid (assoc "caddisflyResourceUuid" caddisflyResourceUuid)
                                    multiple-type (assoc "multipleType" multiple-type)
                                    multiple-id (assoc "multipleId" multiple-id)))
                                importer-columns)]


add two tests for parsing with possessive suffix "s"

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -131,4 +131,8 @@
                                                   :subj {:pred :lei}
                                                   :obj {:pred :luisa}}}})))))

+(deftest the-dog-s-house
+  (is (not (empty? (parse "the dog's house")))))

+(deftest the-dogs-house
+  (is (not (empty? (parse "the dogs' house")))))


filename pattern has been updated on namespace reloader component

--- utils/src/clj/hellhound/components/namespace.clj
+++ utils/src/clj/hellhound/components/namespace.clj
@@ -14,12 +14,10 @@
   (and (or (= kind :modify)
            (= kind :create))
        (and file
-            (not (re-matches #"\..*" (.getName file))))))
+            (not (re-matches #".*\.#[^/]+(clj|cljc)$" (.getName file))))))

 (deftransform loader
   [component value]
   (let [{:keys [kind file]} (:event value)]
-    (cond
-      (should-reload? kind file) (reload-ns)
-      ;; TODO: Replace the not reloading with a log entry.
-      :else (println "NOt reloading"))))
+    (when (should-reload? kind file)
+      (reload-ns))))


Fix and combine session tests

Fix and combine session tests

--- test/uruk/core_test.clj
+++ test/uruk/core_test.clj
@@ -10,41 +10,35 @@
          :user "rest-admin" :password "x"
          :content-base "TutorialDB"})

-(deftest session-parms-1
-  (testing "Create session with just URI"
-    (is (= "Hello world"
-           (let [session (create-session db)]
-             (-> session
-                 (.submitRequest (.newAdhocQuery session
-                                                 "\"Hello world\""))
-                 .asString))))))
-
-(deftest session-parms-2
-  (testing "Create session with URI and content-base"
-    (is (= "Hello world"
-           (let [session (create-session db)]
-             (-> session
-                 (.submitRequest (.newAdhocQuery session
-                                                 "\"Hello world\""))
-                 .asString))))))
-
-(deftest session-parms-3
-  (testing "Create session with URI, username, password"
-    (is (= "Hello world"
-           (let [session (create-session db)]
-             (-> session
-                 (.submitRequest (.newAdhocQuery session
-                                                 "\"Hello world\""))
-                 .asString))))))
-
-(deftest session-parms-4
-  (testing "Create session with all non-options parameters"
-    (is (= "Hello world"
-           (let [session (create-session db)]
-             (-> session
-                 (.submitRequest (.newAdhocQuery session
-                                                 "\"Hello world\""))
-                 .asString))))))
+(deftest create-session-parms
+  (testing "Creating sessions with a variety of parameters"
+    (testing "...with just URI"
+      (is (thrown? IllegalStateException
+                   (let [session (create-session {:uri "xdbc://localhost:8383/"})]
+                     (.submitRequest session (.newAdhocQuery session "\"Hello world\""))))))
+
+    (testing "...with URI and content-base"
+      (is (thrown? IllegalStateException
+                   (let [session (create-session {:uri "xdbc://localhost:8383/"
+                                                  :content-base "TutorialDB"})]
+                     (.submitRequest session (.newAdhocQuery session "\"Hello world\""))))))
+
+    (testing "...with URI, user, password"
+      (is (= "Hello world"
+             (let [session (create-session {:uri "xdbc://localhost:8383/"
+                                            :user "rest-admin" :password "x"})]
+               (-> session
+                   (.submitRequest (.newAdhocQuery session
+                                                   "\"Hello world\""))
+                   .asString)))))
+
+    (testing "...with URI, user, password, content-base"
+      (is (= "Hello world"
+             (let [session (create-session db)]
+               (-> session
+                   (.submitRequest (.newAdhocQuery session
+                                                   "\"Hello world\""))
+                   .asString)))))))

 ;;;; Request options


minor fixes

minor fixes

--- src/metabase/driver/query_processor/annotate.clj
+++ src/metabase/driver/query_processor/annotate.clj
@@ -244,19 +244,20 @@
 {:base_type :IntegerField, :special_type :category, :id nil, :table_id nil, :description nil, :extra_info {}, :target nil, :name "sum"}

 (defn- aggregate-fieldo [{{ag-type :aggregation-type, ag-field :field} :aggregation} field]
-  (all (membero ag-type [:count :avg :sum :stddev])
-       (if-not ag-field
-         (do (assert (= ag-type :count))
-             (== field {:base-type    :IntegerField
-                        :field-name   :count
-                        :special-type :number}))
-         (fresh [field-name]
-           (== field (assoc (select-keys ag-field [:base-type :special-type])
-                            :field-name field-name))
-           (membero field-name [:count :avg :sum :stddev])
-           (conde
-            ((== ag-type field-name))
-            ((== ag-type :distinct) (== field-name :count)))))))
+  (or (when (contains? #{:count :avg :sum :stddev} ag-type)
+        (if-not ag-field
+          (do (assert (= ag-type :count))
+              (== field {:base-type    :IntegerField
+                         :field-name   :count
+                         :special-type :number}))
+          (fresh [field-name]
+            (== field (assoc (select-keys ag-field [:base-type :special-type])
+                             :field-name field-name))
+            (membero field-name [:count :avg :sum :stddev])
+            (conde
+             ((== ag-type field-name))
+             ((== ag-type :distinct) (== field-name :count))))))
+      fail))

 (defn- valid-nameo [{:keys [result-keys]} field]
   (fresh [field-name]
@@ -314,6 +315,8 @@
    ((fields-sorted-by-nameo query f1 f2))))

 (defn- resolve+order-cols [query]
+  {:post [(or (sequential? %)
+              (println "FAILED!\n" (u/pprint-to-str query)))]}
   (let [num-cols (count (:result-keys query))
         cols     (vec (lvars num-cols))]
     (first (run 1 [q]
@@ -346,9 +349,10 @@
                        (map format-col)
                        add-fields-extra-info)
           columns (mapv :name cols)]
-      {:rows    results
-       :cols    cols
-       :columns columns})))
+      {:cols    cols
+       :columns columns
+       :rows    (for [row results]
+                  (mapv row columns))})))

 (require 'metabase.driver)

@@ -361,5 +365,6 @@
     (metabase.driver/process-query {:database 67
                                     :type     :query
                                     :query    {:source_table (id :venues)
-                                               :aggregation  ["sum" (id :venues :price)]
+                                               :aggregation  ["rows"]
+                                               :fields       [(id :venues :price)]
                                                :limit        10}})))


Removed profiles.clj in favour of cider.clj in profiles.d

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -1,12 +0,0 @@
-{:user {:plugins [[cider/cider-nrepl "0.17.0-SNAPSHOT"]
-                  [refactor-nrepl "2.4.0-SNAPSHOT"]]}
- :repl {:dependencies
-        [[acyclic/squiggly-clojure "0.1.9-SNAPSHOT"
-          :exclusions [org.clojure/tools.reader]]
-         [compliment "0.3.5"]]}
- :env {:squiggly
-       "{:checkers [:eastwood]
-         :eastwood-exclude-linters [:unlimited-use :no-ns-form-found]}"}}
-
-
-


Fix claim-spare-peers for percentage job scheduler

Ensures that peers are claimed by the job that is furtherst from the
desired allocation, rather than balancing as in balanced job scheduler.

--- src/onyx/scheduling/percentage_job_scheduler.clj
+++ src/onyx/scheduling/percentage_job_scheduler.clj
@@ -42,9 +42,35 @@
                  #(.indexOf ^clojure.lang.PersistentVector (vec (:jobs replica)) %))
            (:jobs replica)))

+(defn desired-allocation [replica job]
+  (* (count (:peers replica))
+     0.01
+     (get-in replica [:percentages job])))
+
+(defn select-job-requiring-peer
+  "Selects the next job deserving a peer.
+   Tries to cover job requiring the least peers to cover first,
+   then tries to give the peer to whichever job is furthers from its desired
+   percentage allocation."
+  [replica jobs]
+  (->> jobs
+       (sort-by (fn [[job-id peer-count :as job]]
+                  (let [covered (max 0 (- (cjs/job-lower-bound replica job-id) peer-count))
+                        diff-from-desired (- (common/job-peer-count replica job-id)
+                                             (desired-allocation replica job-id))
+                        job-index (.indexOf ^clojure.lang.PersistentVector (vec (:jobs replica)) job-id)]
+                    (vector covered diff-from-desired job-index))))
+       (remove (fn [[job-id peer-count]]
+                 (>= peer-count (cjs/job-upper-bound replica job-id))))
+       (ffirst)))
+
 (defmethod cjs/claim-spare-peers :onyx.job-scheduler/percentage
   [replica jobs n]
-  ;; We can get away with using the exact same algorithm as the
-  ;; Balanced job scheduler.
-  (cjs/claim-spare-peers
-   (assoc replica :job-scheduler :onyx.job-scheduler/balanced) jobs n))
+  (loop [jobs* jobs n* n]
+    (if (zero? n*)
+      jobs*
+      (let [job (select-job-requiring-peer replica jobs*)]
+        (if job
+          (recur (update jobs* job inc)
+                 (dec n*))
+          jobs*)))))


Refactor local playback

Refactor local playback

--- src/clojure/uk/org/potentialdifference/darknet/main.clj
+++ src/clojure/uk/org/potentialdifference/darknet/main.clj
@@ -7,6 +7,7 @@
             [neko.threading :refer [on-ui]]
             [neko.log :as log]
             [neko.intent :as intent]
+            [neko.notify :refer [toast]]
             [neko.ui :refer [make-ui]]
             [neko.ui.mapping :refer [defelement]]
             [uk.org.potentialdifference.darknet.config :refer [config]]
@@ -17,7 +18,8 @@
             [uk.org.potentialdifference.darknet.storage :as storage]
             [cheshire.core :refer [parse-string]]
             [clojure.java.io :as io]
-            [clojure.pprint :refer [pprint]])
+            [clojure.pprint :refer [pprint]]
+            [clojure.string :as str])
   (:import [android.app Activity]
            [android.widget Button]
            [android.graphics Color]
@@ -62,11 +64,10 @@
                    :camera parse-long})))

 (defn replace-view! [^Activity this ^View new]
-  (on-ui
-      (when-let [^View container (find-view this ::container)]
-        (let [^View old (.getChildAt  container 0)]
-          (.removeView container old)
-          (.addView container new 0)))))
+  (when-let [^View container (find-view this ::container)]
+    (let [^View old (.getChildAt  container 0)]
+      (.removeView container old)
+      (.addView container new 0))))

 (defn create-mjpeg-view ^MjpegView [^Context context source-url width height]
   (let [^MjpegView mjpeg-view (new MjpegView context)]
@@ -204,15 +205,10 @@
       (server/get-bytes uri f))
     view))

-(defn image-from-file [activity file]
+(defn image-from-path [activity path]
   (doto (ImageView. activity)
     (fit-linear-layout!)
-    (.setImageBitmap (BitmapFactory/decodeFile (.toString (.getAbsolutePath file))))))
-
-(defn image-from-bytes [activity bytes]
-  (doto (ImageView. activity)
-    (fit-linear-layout!)
-    (set-image-bitmap! bytes)))
+    (.setImageBitmap (BitmapFactory/decodeFile path))))

 (defn view-image [activity intruction]
   (on-ui
@@ -228,60 +224,48 @@
                  (make-ui activity
                           [:text-view {:text "Waiting..."}])))

-(defn video-from-uri [activity uri]
-  (doto (VideoView. activity)
-    (.setVideoURI (Uri/parse uri))
+(defn setVideoSource [video source]
+  (log/i "darknet setting video source" source)
+  (if (.startsWith source "http")
+    (.setVideoUri video (Uri/parse source))
+    (.setVideoPath video source)))
+
+(defn setup-video-view [view activity path]
+  (doto view
+    (fit-linear-layout!)
+    (setVideoSource path)
     (.setOnCompletionListener (reify
                                 MediaPlayer$OnCompletionListener
                                 (onCompletion [this mp]
                                   (default-view activity))))
-    (fit-linear-layout!)
-    (.start)))
-
-(defn view-video [activity instruction]
-  (on-ui
-      (replace-view! activity
-                     (make-ui activity
-                              [:linear-layout {:background-color Color/BLACK
-                                               :gravity Gravity/CENTER}
-                               (video-from-uri activity
-                                               "http://192.168.0.6:8080/public/small.mp4")]))))
+    (.start))
+  view)

 (defn video-from-path [activity path]
-  (doto (VideoView. activity)
-    (fit-linear-layout!)
-    (.setVideoPath path)
-    (.setOnCompletionListener (reify
-                                MediaPlayer$OnCompletionListener
-                                (onCompletion [this mp]
-                                  (default-view activity))))
-    (.start)))
-
-(defn save-to-local! [activity instruction]
+  (setup-video-view (VideoView. activity) activity path))
+
+(defn save-local! [activity instruction]
   (when-let [name (:name instruction)]
     (when-let [url (:url instruction)]
       (server/get-bytes url
                         (fn [bytes]
-                          (log/i "darknet stream" bytes)
                           (storage/write-bytes! bytes name))))))

-(defn view-local-image [activity instruction]
+(defn layout [activity view]
+  (make-ui activity
+           [:linear-layout {:background-color Color/BLACK
+                            :gravity Gravity/CENTER}
+            view]))
+
+(defn view-local [activity instruction]
   (when-let [name (:name instruction)]
-    (on-ui
-        (replace-view! activity
-                       (make-ui activity
-                                [:linear-layout {:background-color Color/BLACK
-                                                 :gravity Gravity/CENTER}
-                                 (image-from-file activity (storage/make-file name))])))))
-
-(defn view-local-video [activity instruction]
-  (when-let [name (:name instruction)]
-    (on-ui
-        (replace-view! activity
-                       (make-ui activity
-                                [:linear-layout {:background-color Color/BLACK
-                                                 :gravity Gravity/CENTER}
-                                 (video-from-path activity (storage/local-path name))])))))
+    (when-let [path (storage/local-path name)]
+      (case (:type instruction)
+        "image" (layout activity (image-from-path activity path))
+        "video" (layout activity (video-from-path activity path))))))
+
+(defn swap-view! [activity view]
+  (replace-view! activity view))

 (defactivity uk.org.potentialdifference.darknet.MainActivity
   :key :main
@@ -296,10 +280,9 @@
                                                    (camera-view this instruction))
                            "streamVideo" (stream-view this instruction)
                            "displayImage" (view-image this instruction)
-                           "viewVideo" (view-video this instruction)
-                           "saveToLocal" (save-to-local! this instruction)
-                           "viewLocalImage" (view-local-image this instruction)
-                           "viewLocalVideo" (view-local-video this instruction)
+                           ;; "viewVideo" (view-video this instruction)
+                           "save" (save-local! this instruction)
+                           "viewLocal" (on-ui (swap-view! this (view-local this instruction)))
                            "stop" (default-view this)
                            :default)))
           sizes {:rear (camera/preview-sizes 0)
@@ -308,10 +291,16 @@
       (helper/keep-screen-on! this)
       (helper/landscape! this)
       (websocket/connect! (:ws-url config)
-                          {:on-open (fn [_])
-                           :on-close (fn [code reason remote])
+                          {:on-open (fn [_]
+                                      (log/i "darknet" "websocket open" ))
+                           :on-close (fn [code reason remote]
+                                       #_(toast code reason remote)
+                                       (log/i "darknet" code reason remote))
+
                            :on-message on-message
-                           :on-error (fn [e] )})
+                           :on-error (fn [e]
+                                       #_(toast (.getMessage e))
+                                       (log/i "darknet" (.getMessage e)))})
       (on-ui
           (set-content-view! (*a)
             [:linear-layout {:id ::container


Small update: functional thinking(on immutability, HOFs) + 4clojure exercises

--- src/clojure_learning/with-clojure-playing-chap-7-FP.clj
+++ src/clojure_learning/with-clojure-playing-chap-7-FP.clj
@@ -171,7 +171,17 @@
 ( (fn [coll]
     (coll (- (count coll) 2))) [1 2 3])

-((fn [[penultimate & tail :as init-coll]]
+;; another one :) that does not depend on hardcoded decimals
+( (fn [[penultimate tail-item & tail :as init-coll]]
     (if (empty? tail)
       penultimate
-      (recur (rest init-coll) ))) [1 2 3])
+      (recur (rest init-coll) )))
+ [1 2 3]); 2
+
+;; small notes:
+;; deconstructuring the state of the recurring collection, as it should appear for last elements
+;; upfront they are head and next one, but when the recursive invocation reaches the condition
+;; obviously they will be bound to the penult + last items
+;; rest here does NOT return a nil never, and always returns an empty collection,
+;; however the nil? condition works as well since the binding is DONE in this case
+;; where the function-args are deconstructed! and NOT in the call to [recur]!


Remove some debug code for insert item

Remove some debug code for insert item

Remove some debug code for insert item

--- src/webapp/framework/client/components/main.cljs
+++ src/webapp/framework/client/components/main.cljs
@@ -37,10 +37,11 @@
 ;                                               (js/alert (pr-str (.-keyCode e  )))
                                                    (if (= (.-keyCode e  ) 13)
                                                              (go
-                                                                 (js/alert newtext)
+                                                                 ;(js/alert (read-ui  app [:newitem2]))
                                                                  ;(log "ISERT :** "  newtext)

-                                                                 (log (pr-str (sql "insert into  todo_items   (item) values (?)"   [(read-ui  app [:newitem2])]  )))
+                                                                 (log (pr-str (sql "insert into  todo_items   (item) values (?)"
+                                                                 [(read-ui  app [:newitem2])]  )))
                                                                  (write-ui  app  [:newitem2]  "")
                                                         ))))


Add a GET parameter for data query window.

--- metlog-vault/src-server/metlog_vault/core.clj
+++ metlog-vault/src-server/metlog_vault/core.clj
@@ -74,7 +74,7 @@
                                      series-id series-id])]
       (edn-response val))))

-(defn get-data-for-series-name [ series-name ]
+(defn get-data-for-series-name [ series-name window-size-secs ]
   (edn-response
    (merge {}
           {:data
@@ -82,9 +82,10 @@
                                  " FROM sample, series"
                                  " WHERE sample.series_id = series.series_id"
                                  "   AND series.series_name=?"
-                                 "   AND t > TIMESTAMPADD(SQL_TSI_DAY, -1, CURRENT_TIMESTAMP)"
+                                 "   AND t > TIMESTAMPADD(SQL_TSI_SECOND, ?, CURRENT_TIMESTAMP)"
                                  " ORDER BY t")
-                            series-name])})))
+                            series-name
+                            (- window-size-secs)])})))

 (defn get-series-names [ ]
   (edn-response
@@ -99,8 +100,10 @@
   (GET "/series-names" []
     (get-series-names))

-  (GET "/data/:series-name" [ series-name ]
-    (get-data-for-series-name series-name))
+  (GET "/data/:series-name" {{series-name :series-name
+                              window-secs :window-secs}
+                             :params}
+    (get-data-for-series-name series-name (or (parsable-integer? window-secs) 86400)))

   (GET "/latest/:series-name" [ series-name ]
     (get-latest-data-for-series-name series-name))


Updated unit tests for ECHOLastUpdate AQL parsing change.

--- test/cmr/search/test/services/aql/conversion.clj
+++ test/cmr/search/test/services/aql/conversion.clj
@@ -112,7 +112,7 @@

 (defn- aql-date-range-elem->condition
   [aql-snippet]
-  (let [aql (format "<ECHOLastUpdate>%s</ECHOLastUpdate>" aql-snippet)
+  (let [aql (format "<ECHOLastUpdate><dateRange>%s</dateRange></ECHOLastUpdate>" aql-snippet)
         xml-struct (x/parse-str aql)]
     (a/element->condition :collection xml-struct)))


fixed tests

fixed tests


update benchmark file refs

update benchmark file refs

--- bench/transit/bench.cljs
+++ bench/transit/bench.cljs
@@ -19,8 +19,8 @@
 (enable-console-print!)

 (def fs (js/require "fs"))
-(def rjson (. fs (readFileSync "../transit/seattle-data0.json" "utf8")))
-(def json (. fs (readFileSync "../transit/seattle-data0.tjsm" "utf8")))
+(def rjson (. fs (readFileSync "../transit/seattle-data0.jsonv" "utf8")))
+(def json (. fs (readFileSync "../transit/seattle-data0.json" "utf8")))
 (def r (t/reader :json))
 (def w (t/writer :json))
 (def w-nc (t/writer :json {:cache false}))


update

update

--- example/srcs/ui/core.cljs
+++ example/srcs/ui/core.cljs
@@ -321,8 +321,7 @@
             :on-click #(set-value i)}
            [:span.radio]
            [:span.value (pr-str i)]]))
-       [:div.option.clear {:on-click #(set-value nil)} "Clear x"]
-       ])))
+       [:div.option.clear {:on-click #(set-value nil)} "Clear x"]])))

 (defn select-page []
   (rf/dispatch [:re-form/manifest {:name :myform
@@ -354,6 +353,31 @@

        ])))

+(defn inputs-page []
+  (rf/dispatch [:re-form/manifest {:name :myform
+                                   :fields {:name {:type :string}
+                                            :email {:type :string}
+                                            :password {:type :password}}}])
+  (let [v (rf/subscribe [:re-form/value [:forms :myform]])]
+    (fn []
+      [:div
+       (style [:body
+               re-select-style
+               re-radio-group-style])
+       [:h1 "Select widget"]
+       [:hr]
+       [:pre [:code (pr-str @v)]]
+       [:lable "Name: "]
+       [re-input {:path [:forms :myform :fields :name]}]
+
+       [:lable "Email: "]
+       [re-input {:path [:forms :myform :fields :email]}]
+
+       [:lable "Password: "]
+       [re-input {:path [:forms :myform :fields :password]}]
+
+       ])))
+
 (defn multiselect-page []
   [:h1 "Index"])

@@ -363,7 +387,7 @@
            :cmp index}
    :inputs {:title "Inputs"
             :w 2
-            :cmp select-page}
+            :cmp inputs-page}
    :select {:title "Select"
             :w 3
             :cmp select-page}


core: list*

core: list*

--- data/core.clj
+++ data/core.clj
@@ -435,3 +435,22 @@
                 (symbol? name) (keyword* name)
                 (string? name) (keyword* name)))
   ([ns name] (keyword* ns name)))
+
+(defn spread
+  {:private true}
+  [arglist]
+  (cond
+   (nil? arglist) nil
+   (nil? (next arglist)) (seq (first arglist))
+   :else (cons (first arglist) (spread (next arglist)))))
+
+(defn list*
+  "Creates a new list containing the items prepended to the rest, the
+  last of which will be treated as a sequence."
+  {:added "1.0"}
+  ([args] (seq args))
+  ([a args] (cons a args))
+  ([a b args] (cons a (cons b args)))
+  ([a b c args] (cons a (cons b (cons c args))))
+  ([a b c d & more]
+     (cons a (cons b (cons c (cons d (spread more)))))))


full screen enter and exit

full screen enter and exit

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

--- plugins/SlideExplorer2/src/slide_explorer/display.clj
+++ plugins/SlideExplorer2/src/slide_explorer/display.clj
@@ -1,10 +1,11 @@
 (ns slide_explorer.display
-  (:import (javax.swing JFrame JLabel)
-           (java.awt Canvas Graphics Graphics2D RenderingHints)
-           (java.awt.event MouseAdapter WindowAdapter)
+  (:import (javax.swing AbstractAction JComponent JFrame JLabel KeyStroke)
+           (java.awt Canvas Color Graphics Graphics2D RenderingHints Window)
+           (java.awt.event ComponentAdapter KeyAdapter KeyEvent MouseAdapter WindowAdapter)
            (java.awt.image BufferedImage WritableRaster)
            (java.awt.geom AffineTransform)
            (java.io ByteArrayInputStream)
+           (java.util UUID)
            (javax.imageio ImageIO)
            (mmcorej TaggedImage)
            (org.micromanager.utils GUIUpdater ImageUtils MDUtils))
@@ -27,6 +28,57 @@
       .show))
   reference)

+(defn- default-screen-device []
+  (->
+    (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
+    .getDefaultScreenDevice))
+
+(defn bind-key
+  "Maps an input-key on a swing component to an action,
+  such that action-fn is executed when key is pressed."
+  [component input-key action-fn global?]
+  (let [im (.getInputMap component (if global?
+                                     JComponent/WHEN_IN_FOCUSED_WINDOW
+                                     JComponent/WHEN_FOCUSED))
+        am (.getActionMap component)
+        input-event (KeyStroke/getKeyStroke input-key)
+        action
+          (proxy [AbstractAction] []
+            (actionPerformed [e]
+                (action-fn)))
+        uuid (.. UUID randomUUID toString)]
+    (.put im input-event uuid)
+    (.put am uuid action)))
+
+(defn bind-window-key
+  [window input-key action-fn]
+  (bind-key (.getContentPane window) input-key action-fn true))
+
+(defn full-screen! ; adapted from seesaw
+  "Make the given window/frame full-screen. Pass nil to return all windows
+to normal size."
+  ([^java.awt.GraphicsDevice device window]
+    (if window
+      (do
+        (.dispose window)
+        (.setUndecorated window true)
+        (.setFullScreenWindow device window)
+        (.show window)
+        )
+      (let [window (.getFullScreenWindow device)]
+        (.setFullScreenWindow device nil)
+        (when window
+          (.dispose window)
+          (.setUndecorated window false)
+          (.show window))))
+    window)
+  ([window]
+    (full-screen! (default-screen-device) window)))
+
+(defn setup-fullscreen [window]
+  (bind-window-key window "F" #(full-screen! window))
+  (bind-window-key window "ESCAPE" #(full-screen! nil)))
+
 (defrecord screen-properties [x y z width height zoom])

 (def screen-state (atom nil))
@@ -59,23 +111,33 @@
     (let [graphics2d (cast Graphics2D g)]
       (.setRenderingHint graphics2d
                          RenderingHints/KEY_ANTIALIASING
-                         (if on RenderingHints/VALUE_ANTIALIAS_ON
+                         (if on
+                           RenderingHints/VALUE_ANTIALIAS_ON
                            RenderingHints/VALUE_ANTIALIAS_OFF)))))

 (defn draw-tile [^Graphics2D g image-data]
   (.drawImage g (buffered-image [512 512] (:pixels image-data))
               (AffineTransform.) nil))

-(defn paint-tiles [canvas]
-  (doseq [x (range 10 100 10)]
-    (.drawOval (.getGraphics canvas)
-               x x
-               (- (.getWidth canvas) (* 2 x))
-               (- (.getHeight canvas) (* 2 x)))))
-
-(defn paint-screen [canvas]
-  (enable-anti-aliasing (.getGraphics canvas))
-  (paint-tiles canvas))
+(defn paint-tiles [canvas screen-state]
+  (let [g (.getGraphics canvas)]
+    (doto g
+      enable-anti-aliasing
+      (.setColor Color/YELLOW)
+      (.fillOval (- (+ (/ (:width @screen-state) 2)
+                       (:x @screen-state))
+                    30)
+                 (- (+ (/ (:height @screen-state) 2)
+                       (:y @screen-state))
+                    30)
+                 60 60)
+      (.setColor Color/GRAY)
+      (.drawString (str @screen-state)
+                   (int 0)
+                   (int (- (:height @screen-state) 10))))))
+
+(defn paint-screen [canvas screen-state]
+  (paint-tiles canvas screen-state))

 (defn handle-drags [component position-atom]
   (let [drag-origin (atom nil)
@@ -105,22 +167,46 @@
                               + (.getWheelRotation e)))))
   z-atom)

-(defn main-canvas []
-  (let [updater (GUIUpdater.)]
-    (doto (proxy [Canvas] []
-            (paint [^Graphics g] (paint-screen this))))))
+(defn handle-resize [component size-atom]
+  (let [update-size #(let [bounds (.getBounds component)]
+                       (swap! size-atom merge
+                              {:width (.getWidth bounds)
+                               :height (.getHeight bounds)}))]
+    (update-size)
+    (.addComponentListener component
+      (proxy [ComponentAdapter] []
+        (componentResized [e]
+                          (update-size)))))
+  size-atom)
+
+(defn reflect-changes [canvas screen-state]
+  (add-watch screen-state "display"
+    (fn [_ _ _ new-state]
+      (.repaint canvas))))
+
+(defn main-canvas [screen-state]
+  (doto
+    (proxy [Canvas] []
+      (paint [^Graphics g] (paint-screen this screen-state)))
+    (.setBackground Color/BLACK)))

 (defn main-frame []
   (doto (JFrame. "Slide Explorer II")
     .show
     (.setBounds 10 10 500 500)))

+
 (defn show []
-  (let [canvas (main-canvas)
-        screen-state (atom (sorted-map :x 0 :y 0 :z 0))]
-    (.add (.getContentPane (main-frame)) canvas)
+  (let [screen-state (atom (sorted-map :x 0 :y 0 :z 0))
+        canvas (main-canvas screen-state)
+        frame (main-frame)]
+    (.add (.getContentPane frame) canvas)
+    (setup-fullscreen frame)
     (handle-drags canvas screen-state)
-    (handle-wheel canvas screen-state)))
+    (handle-wheel canvas screen-state)
+    (handle-resize canvas screen-state)
+    (reflect-changes canvas screen-state)
+    canvas))

 ;;;;;;;;


Link Decorators

Link Decorators

--- webapp/src/webapp/html_helpers.clj
+++ webapp/src/webapp/html_helpers.clj
@@ -15,6 +15,8 @@
 	[:body {:background "linear-gradient(to right, #99CCFF, #8AB8E6, #99CCFF)" :margin-top "10px" :margin-left "10px"}]
 	[:.main {:border-radius "6px" :background-color "white" :margin-left "50px" :width "500px"}]
 	[:h2 {:border-radius "6px" :padding "10px" :margin-left "50px" :width "485px" :background-color "white" }]
-	[:.internal {:background "linear-gradient(to right, #99CCFF, #8AB8E6, #99CCFF)"}]))
+	[:.internal {:background "linear-gradient(to right, #99CCFF, #8AB8E6, #99CCFF)"}]
+	[:a:link {:color "#4C6680"}]
+	[:a:visited {:color "#4C6680"}]))

 (def site_header (html [:head [:meta {:charset "utf-8"}]][:style site_style]))


Update some deps in generated project.clj

--- resources/leiningen/new/kraken_works/project.clj
+++ resources/leiningen/new/kraken_works/project.clj
@@ -12,13 +12,13 @@
                  [com.datomic/datomic-pro "0.9.5703"
                   :exclusions [org.slf4j/slf4j-nop
                                org.slf4j/slf4j-log4j12]]
-                 [com.amazonaws/aws-java-sdk-dynamodb "1.11.402"
+                 [com.amazonaws/aws-java-sdk-dynamodb "1.11.460"
                   :exclusions [commons-codec commons-logging]]
 {{/datomic?}}
                  [ch.qos.logback/logback-classic "1.2.3"]
-                 [democracyworks/kehaar "0.11.4"]]
+                 [democracyworks/kehaar "1.0.0"]]
   :plugins [[com.pupeno/jar-copier "0.4.0"]]
-  :java-agents [[com.newrelic.agent.java/newrelic-agent "4.5.0"]]
+  :java-agents [[com.newrelic.agent.java/newrelic-agent "4.8.0"]]
   :jar-copier {:java-agents true
                :destination "resources/jars"}
   :prep-tasks ["javac" "compile" "jar-copier"]


Let's bump up the timeout since I dunno what Quartz can do [IMMUTANT-348]

--- integration-tests/apps/jobs/test/jobs/at.clj
+++ integration-tests/apps/jobs/test/jobs/at.clj
@@ -55,7 +55,7 @@
   (let [q (random-queue)]
     (with-job #(msg/publish q "ping") [:every 500 :repeat 1]
       (is (= "ping" (msg/receive q :timeout 10000)))
-      (is (= ["ping" nil] (take 2 (msg/message-seq q :timeout 550)))))))
+      (is (= ["ping" nil] (take 2 (msg/message-seq q :timeout 650)))))))

 (deftest at-with-every-should-fire-immediately-and-continuously-starting-at-at
   (let [q (random-queue)]


faster decode-bits removes print-cores

faster decode-bits removes print-cores

--- desafio4/clojure/src/huffman/core.clj
+++ desafio4/clojure/src/huffman/core.clj
@@ -47,10 +47,6 @@
     (leaf? tree) [1 (sym-as-bits tree)]
     (node? tree) [0 (tree-as-bits (left-node tree))  (tree-as-bits (right-node tree))]))

-(defn- print-codes [codes]
-  (doseq [key (sort (keys codes))]
-    (println key "->" (get codes key))))
-
 (defn compress [input output]
   (let [bytes (read-bytes input)
         freq (sort-by val < (seq (frequencies bytes)))
@@ -98,11 +94,11 @@
     (node-decode tree bits)))

 (defn decode-bits [tree coded-bits]
-  (loop [bits coded-bits bytes []]
+  (loop [bits coded-bits bytes (transient [])]
     (if (empty? bits)
-      bytes
+      (persistent! bytes)
       (let [[rest-bits sym] (tree-decode tree bits)]
-        (recur rest-bits (conj bytes sym))))))
+        (recur rest-bits (conj! bytes sym))))))

 (defn decompress [input output]
   (let [bytes (read-bytes input)


marks test-expired-instance as explicit (#899)

--- waiter/integration/waiter/autoscaling_test.clj
+++ waiter/integration/waiter/autoscaling_test.clj
@@ -142,7 +142,10 @@
             waiter-url cookies request-fn requests-per-thread delay-secs service-id
             num-threads expected-instances))))))

-(deftest ^:parallel ^:integration-slow test-expired-instance
+;; (every? #(= 200 (:status %)) with at least one response having 502 Request to service backend failed
+;; (> (count @response-instance-ids-atom) 1) fails with (not (> 1 1))
+;; (contains? killed-instances instance-id) fails
+(deftest ^:explicit ^:parallel ^:integration-slow test-expired-instance
   (testing-using-waiter-url
     (let [extra-headers {:x-waiter-instance-expiry-mins 1 ;; can't set it any lower :(
                          :x-waiter-name (rand-name)}


Une proposition de solution pour l'exercice Flatten Array de Exercism dans la track Clojure

--- exercism/clojure/flatten-array/src/flatten_array.clj
+++ exercism/clojure/flatten-array/src/flatten_array.clj
@@ -1,17 +1,23 @@
-(ns flatten-array)
+(ns flatten-array
+  (:require [clojure.inspector :as inspector]))

+; A simple solution that use clojure.core/flatten
+; (defn flatten [arr]
+;   (filter (complement nil?) (clojure.core/flatten arr))
+;  )
+
+; A solution that do not use clojure.core/flatten
 (declare flatten)

-(defn manage-element [element result-array]
-  (cond
-    (nil? element) result-array
-    (atom? element) (cons element result-array)
-    (seq? element) (concat (flatten element) result-array)
-    )
-  )
+(defn flatten-element [element flatten-array]
+  (cond
+    (nil? element) flatten-array
+    (inspector/atom? element) (conj flatten-array element )
+    (empty? element) flatten-array
+    (vector? element) (into [] (concat flatten-array (flatten-array/flatten element)))))

 (defn flatten [arr]
-  (loop [process-array arr result-array []]
-    (if (nil? process-array)
-      (vec result-array)
-      (recur (rest process-array) (manage-element (first process-array) result-array)))))
+  (loop [nested-array arr flatten-array []]
+    (if (empty? nested-array)
+      flatten-array
+      (recur (rest nested-array) (flatten-element (first nested-array) flatten-array)))))


Remove close button from user settings

Remove close button from user settings

It doesn't work correctly as implemented: if you're on `/account`, it
takes you to `/`, which isn't supposed to be an inner URL at all, and if
you're on `/account/heroku` (for instance), it takes you to `/account`,
which doesn't make much sense.

There isn't really a great place for this to take you to. Also,
`aside.less` says:

```
// [...] the close menu should be removed on completion of v2 anyways.
```

so apparently we were already expecting to lose these a while ago.

--- src-cljs/frontend/components/pages/user_settings.cljs
+++ src-cljs/frontend/components/pages/user_settings.cljs
@@ -33,9 +33,7 @@
    ;; styled component. See CIRCLE-2545.
    [:div.aside-user
     [:header
-     [:h4 "Account Settings"]
-     [:a.close-menu {:href "./"} ; This may need to change if we drop hashtags from url structure
-      (common/ico :fail-light)]]
+     [:h4 "Account Settings"]]
     [:div.aside-user-options
      (aside/expand-menu-items (nav-items) subpage)]]))


Add tooltips

Add tooltips

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -106,7 +106,10 @@
         [:div.row-fluid
          (for [follower followers]
            [:span.follower-container
-            {:style {:display "inline-block"}}
+            {:style {:display "inline-block"}
+             :title (:login follower)
+             :data-toggle "tooltip"
+             :data-placement "right"}
             [:img.gravatar
              {:src (gh-utils/make-avatar-url follower :size 60)}]
             " "


Avoid publishing response before consumer is ready [HORNETQ-86]

The sleep avoids the race condition of the publish occurring before the
client establishes itself as a queue consumer. Otherwise, due to
HORNETQ-86, the message will not be redistributed after the consumer is
finally ready.

--- integration-tests/apps/cluster/src/immutant/init.clj
+++ integration-tests/apps/cluster/src/immutant/init.clj
@@ -21,7 +21,11 @@
 (job/schedule "updater" update-cache :every :second)

 (let [resp  (atom nil)
-      start (fn [] (reset! resp (msg/respond "/queue/cache" (fn [_] (into {} cache)))))
+      start (fn [] (reset! resp
+                    (msg/respond "/queue/cache"
+                      (fn [_]
+                        (Thread/sleep 500) ; HORNETQ-86
+                        (into {} cache)))))
       stop  (fn [] (msg/unlisten @resp))]
   (dmn/daemonize "cache-status" start stop))


fix regression in DefaultScheduler where it wouldn't reassign squeezed topologies correctly

--- src/clj/backtype/storm/scheduler/DefaultScheduler.clj
+++ src/clj/backtype/storm/scheduler/DefaultScheduler.clj
@@ -48,7 +48,7 @@
                   alive-assigned (EvenScheduler/get-alive-assigned-node+port->executors cluster topology-id)
                   can-reassign-slots (slots-can-reassign cluster (keys alive-assigned))
                   total-slots-to-use (min (.getNumWorkers topology)
-                                          (+ (count can-reassign-slots) (count alive-assigned)))
+                                          (+ (count can-reassign-slots) (count available-slots)))
                   bad-slots (if (> total-slots-to-use (count alive-assigned))
                                 (bad-slots alive-assigned (count all-executors) total-slots-to-use)
                                 [])]]


Add if-not-exists statement

Add if-not-exists statement

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -467,7 +467,8 @@
       column-type)))

 (let [order
-      {:column-definitions 1}
+      {:column-definitions 1
+       :if-not-exists      2}
       renderers
       {:column-definitions (fn [query-builder column-defs]
                              (let [[primary-key & clustering-keys] (get column-defs :primary-key)
@@ -498,7 +499,10 @@
                                                         (name column-name)
                                                         (make-column-type column-name column-defs)))
                                 query-builder
-                                clustering-keys)))}]
+                                clustering-keys)))
+
+       :if-not-exists      (fn if-not-exists-query [query-builder _]
+                             (.ifNotExists query-builder))}]
   (defn create-table
     [table-name & statements]
     (->> statements


clojure-programming:: more on namespaces and project architecturing in clojure

--- src/clojure_learning/clj_programming_all_about_ns.clj
+++ src/clojure_learning/clj_programming_all_about_ns.clj
@@ -7,7 +7,11 @@
 ;; the [def] constructs will create vars within the current ns, which is ALWAYS bound to *ns* special value
 ;; the clojure.core is bound to the user's default ns, so switching to other ns using [in-ns] will not have loaded the
 ;; clojure.core library
-(in-ns 'clojure-learning.clj-programming-all-about-ns)
+(ns clojure-learning.clj-programming-all-about-ns
+  (use (clojure [repl] test core)))
+
+(in-ns 'clojure-learning.clj-programming-all-about-ns
+  (use '(clojure [repl] [test])))
 (some #{:foo} [:foo]) ;; ->unable to resolve symbol "some"
 (clojure.core/some #{:foo} [:foo :bar]) ;; :foo -> works

@@ -94,12 +98,24 @@
 ;; once we defined the dependencies in project.clj file -> opening a REPL -> they will be automatically loaded
 ;; in the REPL classpath.

-(defn find-max-consecs [head & tail]
-  (reduce
-    (fn [v x]
-      (if (= x (inc ((comp last last) v)))
-        (conj v x)
-        (conj v [x])))
-    [head] tail))
+(use clojure.repl)

-;; 1 2 4 6 7 8 10 12 -> 6 7 8
+;; find the first non-consecutive missing element from a sequence
+;; abcdxyzabc -> d
+(defn find-first-misssing [xstring]
+  (letfn [(map-to-ints [char-seq] (map int char-seq))
+          (group-by-freqs [int-seq] (-> frequencies map-to-ints))]
+    (let [[head & tail] (map-to-ints xstring)]
+      (reduce
+        (fn [{:keys [curr] :as m} each]
+          (if (:true) :true))
+        {:curr [head] :missing []} tail))
+    (map-to-ints xstring)))
+
+(frequencies (find-first-misssing "abcdxyzabc"))
+;; returns a map indexed by the unique-keys and vals identified by the number of times they occur
+
+(find-first-misssing "abcdxyzabc")
+;; ()
+(reduce (fn [acc each]) [] (find-first-misssing "abcdxyzabc")
+


change default sort for transaction items

--- src/clj/clj_money/models/storage/sql_storage.clj
+++ src/clj/clj_money/models/storage/sql_storage.clj
@@ -896,7 +896,7 @@
                          (append-sort (if (:count options)
                                            options
                                            (merge
-                                             {:sort [:i.transaction_date :i.index]}
+                                             {:sort [[:i.index :desc]]}
                                              options)))
                          (append-limit options)))]
         (if (:count options)


add all resources to war

add all resources to war

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -164,7 +164,7 @@
          (add-source-files "WEB-INF/classes")
          (add-zipfileset {:dir (file "src")         :prefix web     :includes "*web.xml"})
          (add-zipfileset {:dir (file "classes")     :prefix classes :includes "**/*.class"})
-         (add-zipfileset {:dir (file "resources")   :prefix classes :includes "*"})
+         (add-zipfileset {:dir (file "resources")   :prefix classes :includes "**/*"})
          (add-zipfileset {:dir (file "build" "jar") :prefix classes})
          (add-fileset    {:dir (file "build" "war")})
          (add-fileset    {:dir (file "src" "html")})


Manage credentials per lane.

Manage credentials per lane.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -1,5 +1,6 @@
 (ns cbfg.world.t2
-  (:require-macros [cbfg.act :refer [act achan achan-buf aput atake]])
+  (:require-macros [cbfg.act :refer [act act-loop achan achan-buf
+                                     aclose aput atake]])
   (:require [cbfg.fence]
             [cbfg.world.t1 :refer [prog-base-now prog-curr-now prog-evt
                                    wait-done addr-override-xy]]
@@ -25,10 +26,30 @@
   (let [lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
-                    (let [lane-in-ch (achan-buf actx lane-buf-size)]
+                    (let [lane-in-ch (achan-buf actx lane-buf-size)
+                          cred-ch (achan actx)
+                          cred-cb (fn [is-req msg lane-state]
+                                    (if is-req
+                                      (if msg
+                                        [(assoc msg :cred-ch cred-ch) lane-state]
+                                        (do (act close-cred actx
+                                                 (aclose close-cred cred-ch))
+                                            [msg lane-state]))
+                                      [msg lane-state]))]
                       (cbfg.fence/make-fenced-pump actx lane-name
                                                    lane-in-ch lane-out-ch
-                                                   lane-max-inflight false)
+                                                   lane-max-inflight false
+                                                   :ext-cb cred-cb)
+                      (act-loop lane-cred actx [cred nil]
+                                (let [m (atake lane-cred cred-ch)]
+                                  (case (:op m)
+                                    :get-cred (do (aput lane-cred (:res-ch m)
+                                                        (assoc m :status :ok :result cred))
+                                                  (recur cred))
+                                    :set-cred (do (aput lane-cred (:res-ch m)
+                                                        (assoc m :status :ok))
+                                                  (recur (:cred m)))
+                                    :mismatch)))
                       lane-in-ch))
         conn-loop (fn [actx server-send-ch server-recv-ch close-server-recv-ch]
                     (cbfg.world.net/server-conn-loop actx server-send-ch server-recv-ch


Rename to rq-handler.

Rename to rq-handler.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -54,11 +54,11 @@
    "count" cbfg.world.base/example-count
    "close-lane" cbfg.world.base/close-lane})

-(defn rq-handle [actx m] ((get rq-handlers (:op m)) actx m))
+(defn rq-handler [actx m] ((get rq-handlers (:op m)) actx m))

 ; --------------------------------------------

-(defn cmd-handler [c] (assoc c :rq rq-handle))
+(defn cmd-handler [c] (assoc c :rq rq-handler))

 (def cmd-handlers (into {} (map (fn [k] [k cmd-handler]) (keys rq-handlers))))


fix watch

fix watch

--- src/ci3/controller.clj
+++ src/ci3/controller.clj
@@ -8,7 +8,8 @@
 (defonce stop (atom nil))

 (defn process-build [builds]
-  (when-let [items (:items builds)]
+  (println builds)
+  #_(when-let [items (:items builds)]
     (doseq [i items]
       (when-not (:pod i)
         (let [id (get-in i [:metadata :name])]
@@ -43,10 +44,10 @@
                               :scheduledAt (str (java.util.Date.))
                               :status "sche"})))))))))

-(defn watch-resource [rt process]
+(defn watch-resource [cfg rt process]
   (if @stop
     (println "Stop watching " (name rt))
-    (future (process (walk/keywordize-keys (k8s/list k8s/cfg rt)))
+    (future (process (walk/keywordize-keys (k8s/list cfg rt)))
             (Thread/sleep 5000)
             (watch-resource rt process))))

@@ -57,21 +58,22 @@
         (println "Add webhook " (:url r))
         (spit "/tmp/repl" (str "add web hook" "\n\n\n"))))))

-(defn restart []
-  (do
-    (reset! stop true)
-    (reset! stop false)
-    (watch-resource :repositories process-repository)))
-
 (defn watch []
-  (watch-resource :build process-build))
+  (watch-resource cfg :builds process-build))

 (comment

-  (watch-resource :build process-build)
+  (watch-resource cfg :builds process-build)
+
   (watch-resource :repositories process-repository)

-  (k8s/list k8s/cfg :repositories)
+  ("items")
+  (doseq [b (get (k8s/list cfg :builds) "items")]
+    (println
+     (k8s/delete cfg :builds
+                 (get-in b ["metadata" "name"]))))
+
+
   (reset! stop true)
   (reset! stop false)


Fix the irritating "%s threw COMMAND" bug.

--- src/circle/workers.clj
+++ src/circle/workers.clj
@@ -26,7 +26,7 @@
          result#)
        (catch Exception e#
          (airbrake :data {:body (quote ~@body) :future true} :exception e#)
-         (error e# "%s threw" (quote ~@body))
+         (errorf e# "%s threw" (quote ~@body))
          (throw e#)))))

 (defn start-worker [f & args]


add trace to Flare

add trace to Flare

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -3423,12 +3423,15 @@
     :strength-bonus (req (or (:advance-counter card) 0))}

    "Flare"
-   {:abilities [{:prompt "Choose a piece of hardware to trash"
-                 :msg (msg "trash " (:title target)) :label "Trash a piece of hardware"
-                 :choices {:req #(and (:installed %) (:type % "Hardware"))}
-                 :effect (effect (trash target))}
-                {:msg "do 2 meat damage and end the run"
-                 :effect (effect (damage :meat 2 {:unpreventable true :card card}) (end-run))}]}
+   {:abilities [{:label "Trace 6 - Trash 1 hardware, do 2 meat damage, and end the run"
+                 :trace {:base 6 :msg "trash 1 hardware, do 2 meat damage, and end the run"
+                         :effect (effect (resolve-ability {:prompt "Choose a piece of hardware to trash"
+                                                           :label "Trash a piece of hardware"
+                                                           :msg (msg "trash " (:title target))
+                                                           :choices {:req #(= (:type %) "Hardware")}
+                                                           :effect (effect (trash target {:cause :subroutine}))} card nil)
+                                         (damage :meat 2 {:unpreventable true :card card})
+                                         (end-run))}}]}

    "Galahad"
    {:abilities [{:label "End the run" :msg "end the run" :effect (effect (end-run))}


Add lein-inky instructions to inky home page

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -231,13 +231,18 @@
         [:a {:href "https://twitter.com/heyzk"} "@heyzk"]
         " if you'd like your library to be available to inky sketches, or open a pull request at "
         [:a {:href "https://github.com/zk/inky"} "zk/inky"]
-        "."]]
+        "."]
+       [:p "Getting started instructions below."]]
       [:section.sketch-examples
        [:h3 "Recent Sketches"]
        [:ul
         (map $sketch-preview previews)]]
       [:section.instructions
-       [:h3 "How-To"]
+       [:h3 "Compiling Your Sketches"]
+       [:p
+        "Sketches are "
+        [:a {:href "https://gist.github.com"} "gist"]
+        "-backed."]
        [:div.instructions-list
         [:ol
          [:li
@@ -245,8 +250,34 @@
           [:code "inky.cc/:gh-login/:gist-id"]
           ". This will compile the provided source and redirect you to the resulting sketch."]
          [:li "???"]
-         [:li "Profit"]]]
-       [:p "It makes it a bit easier to read your source if you keep your lines <= 80 characters."]]
+         [:li "Profit"]]]]
+      [:section.local-dev
+       [:h3 "Sketching Locally"]
+       [:p
+        "We've got a lein plugin to help you bring your tools to bear on inky sketches."
+        " First, add "
+        [:code "[lein-inky \"0.1.4\"]"]
+        " to your "
+        [:code "~/.lein/profiles.clj"]
+        ". Then:"]
+       [:ol
+        [:li
+         "Fork "
+         [:a {:href "https://gist.github.com/zk/8108564"} "this gist"]]
+        [:li
+         "Clone that gist locally: "
+         [:code "git clone git@gist.github.com/<gist-id>.git"]
+         "."]
+        [:li [:code "cd <gist-id>"]]
+        [:li "Run " [:code "lein inky"]]]
+       [:p
+        "You'll see something like the following output. Visit "
+        [:a {:href "http://localhost:4659"} "http://localhost:4659"]
+        " and start editing your sketch w/ source maps."]
+       [:p
+        "When you're done editing, commit, push, and visit "
+        [:code "http://inky.cc/<github-login>/<gist-id>"]
+        " to make your sketches available online."]]
       ($jobs-section data)]}))

 (defn squeeze


more navigation

more navigation

--- src/cljs/uix/core.cljs
+++ src/cljs/uix/core.cljs
@@ -67,6 +67,14 @@
     (.log js/console "c " col " nc " n-col " nr " next-row-number " rs " r-size)
     (swap! ui-state assoc :current [page next-row-number n-col])))

+(defn ^:extern esc []
+  (swap! ui-state (fn [x] (assoc x :current [(first (:current x))]))))
+
+(defn ^:extern desktop []
+  (swap! ui-state (fn [x] (assoc x :current ({[:editors] [:animators] [:animators] [:editors]} (:current x))))))
+
+(defn ^extern select [row column]
+  (swap! ui-state (fn [x] (assoc x :current (into (:current x) [row column])))))

 (defn show [page row column]
   (let [c (:current @ui-state)]


Return 204 on delete

Return 204 on delete

--- entity/templates/src/app/routes/_entities.clj
+++ entity/templates/src/app/routes/_entities.clj
@@ -14,4 +14,6 @@
     (PUT "/:id"
       [id <% _.each(attrs, function (attr) { %><%= attr.attrName %> <% }); %>]
       (resp/json (db/update-<%= name %> (Integer/valueOf id) <% _.each(attrs, function (attr) { %><%= attr.attrName %> <% }); %>)))
-    (DELETE "/:id" [id] (resp/json (db/delete-<%= name %> (Integer/valueOf id))))))
+    (DELETE "/:id" [id]
+      (db/delete-<%= name %> (Integer/valueOf id))
+      {:status 204})))


default 'highlight language/output removed

--- src/clygments/core.clj
+++ src/clygments/core.clj
@@ -24,8 +24,7 @@

 (defn highlight
   "highlight a piece of code."
-  ([code] (highlight code :python :html))
-  ([code lang output]
+  [code lang output]
     (try
       (exec-code-in "_r" (str "get_lexer_by_name(\"" (name lang) "\")") "None")
       (exec-code-in
@@ -35,8 +34,8 @@
           ;; XXX it won't work if 'code contains a sequence of three or more
           ;; double quotes, e.g.: """
           (.exec python (str "_res=highlight(\"\"\"" code "\"\"\",_r,_f)\n"))
-          ;; XXX it won't work with non-text formatters, such as gif
+          ;; FIXME it won't work with non-text formatters, such as gif
           (.get python "_res" String)))
       (catch Exception e
         (.printStackTrace e)
-        (println (.getMessage e))))))
+        (println (.getMessage e)))))


Fixes #236

Fixes #236

--- src/clj/quil/applet.clj
+++ src/clj/quil/applet.clj
@@ -73,6 +73,7 @@
     ; TODO: check if resizable and alwaysOnTop work correctly.
     (javax.swing.SwingUtilities/invokeLater
      (fn []
+       (.setTitle surface title)
        (.setResizable surface resizable?)
        (.setAlwaysOnTop surface keep-on-top?)))
     applet))


Don't convert single color to float to handle correctly int-encoded color in cljs. Fix #267.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -1586,7 +1586,7 @@
    (cond (vector? gray) (apply fill gray)
          (nil? gray) (no-fill)
          true (do
-                (.fill (current-graphics) (float gray))
+                (.fill (current-graphics) gray)
                 (save-current-fill [gray]))))

   ([gray alpha]
@@ -3932,7 +3932,7 @@
    (cond (vector? gray) (apply stroke gray)
          (nil? gray) (no-stroke)
          true (do
-                (.stroke (current-graphics) (float gray))
+                (.stroke (current-graphics)  gray)
                 (save-current-stroke [gray]))))
   ([gray alpha]
    (.stroke (current-graphics) (float gray) (float alpha))


Finish bulk of HashMap. Rename -without to -dissoc.

Still need to extend IHash to many more types. Refs #10

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -39,7 +39,7 @@

 (defprotocol IMap
   #_(-assoc-ex [coll k v])
-  (-without [coll k]))
+  (-dissoc [coll k]))

 (defprotocol ISet
   (-contains? [coll v])
@@ -419,13 +419,18 @@

 (defn vector [& args] (vec args))

-(defn- hash-map-seq [hash-map i]
-  (lazy-seq
-    (when (< i (.length (.keys hash-map)))
-      (cons
-        (vector (aget (.keys hash-map) i)
-                (-lookup hash-map (aget (.keys hash-map) i)))
-        (hash-map-seq hash-map (inc i))))))
+(extend-protocol IHash
+  goog.global.Number (-hash [o] o))
+
+(defn hash [o] (-hash o))
+
+(defn- scan-array [incr k array]
+  (let [len (.length array)]
+    (loop [i 0]
+      (when (< i len)
+        (if (= k (aget array i))
+          i
+          (recur (+ i incr)))))))

 ; Keys is an array of all keys of this map, in no particular order.
 ; Any string key is stored along with its value in strobj. If a string key is
@@ -451,19 +456,32 @@
   ISeqable
   (-seq [coll]
     (when (> (.length keys) 0)
-      (hash-map-seq coll 0)))
+      (let [hash-map-seq
+             (fn hash-map-seq [i]
+               (lazy-seq
+                 (when (< i (.length keys))
+                   (cons
+                     (vector (aget keys i) (-lookup coll (aget keys i)))
+                     (hash-map-seq (inc i))))))]
+        (hash-map-seq 0))))

   ICounted
   (-count [coll] (.length keys))

   ILookup
-  (-lookup [coll k] (-lookkup coll k nil))
+  (-lookup [coll k] (-lookup coll k nil))
   (-lookup [coll k not-found]
     (if (goog.isString k)
       (if (.hasOwnProperty strobj k)
         (aget strobj k)
         not-found)
-      "tbd-non-string-key"))
+      ; non-string key
+      (let [h (hash k)
+            bucket (aget hashobj h)
+            i (when bucket (scan-array 2 k bucket))]
+        (if i
+          (aget bucket (inc i))
+          not-found))))

   IAssociative
   (-assoc [coll k v]
@@ -476,27 +494,53 @@
           (let [new-keys (array-clone keys)] ; append
             (.push new-keys k)
             (HashMap. meta new-keys new-strobj hashobj))))
-      "tbd-non-string-key"))
+      ; non-string key
+      (let [h (hash k)
+            bucket (aget hashobj h)]
+        (if bucket
+          (let [new-bucket (array-clone bucket)
+                new-hashobj (goog.cloneObject hashobj)]
+            (aset new-hashobj h new-bucket)
+            (if-let [i (scan-array 2 k new-bucket)]
+              (do
+                (aset new-bucket (inc i) v) ; found key, replace
+                (HashMap. meta keys strobj new-hashobj))
+              (let [new-keys (array-clone keys)] ; did not find key, append
+                (.push new-keys k)
+                (.push new-bucket k v)
+                (HashMap. meta new-keys strobj new-hashobj))))
+          (let [new-keys (array-clone keys)
+                new-hashobj (goog.cloneObject hashobj)]
+            (.push new-keys k)
+            (aset new-hashobj h (array k v))
+            (HashMap. meta new-keys strobj new-hashobj))))))

   IMap
-  (-without [coll k]
+  (-dissoc [coll k]
     (if (goog.isString k)
       (if (not (.hasOwnProperty strobj k))
         coll ; key not found, return coll unchanged
         (let [new-keys (array-clone keys)
               new-strobj (goog.cloneObject strobj)
               new-count (dec (.length keys))]
-          (loop [i 0] ; look for k in keys
-            (if (not (= k (aget new-keys i)))
-              (recur (inc i))
-              (loop [i i] ; shift subsequent keys down one step
-                (when (< i new-count)
-                  (aset new-keys i (aget new-keys (inc i)))
-                  (recur (inc i))))))
-          (set! new-keys.length new-count) ; fix up keys length
-          (js-delete new-strobj k)         ; fix up strobj
+          (.splice new-keys (scan-array 1 k new-keys) 1)
+          (js-delete new-strobj k)
           (HashMap. meta new-keys new-strobj hashobj)))
-      "tbd-non-string-key")))
+      ; non-string key
+      (let [h (hash k)
+            bucket (aget hashobj h)
+            i (when bucket (scan-array 2 k bucket))]
+        (if (not i)
+          coll ; key not found, return coll unchanged
+          (let [new-keys (array-clone keys)
+                new-hashobj (goog.cloneObject hashobj)]
+            (if (> 3 (.length bucket))
+              (js-delete new-hashobj h)
+              (let [new-bucket (array-clone bucket)]
+                (.splice new-bucket i 2)
+                (aset new-hashobj h new-bucket)))
+            (.splice new-keys (scan-array 1 k new-keys) 1)
+            (HashMap. meta new-keys strobj new-hashobj)))))))

 (set! cljs.core.HashMap.EMPTY (HashMap. nil (array) (js-obj) (js-obj)))


Reorganize cats.core namespace.

Reorganize cats.core namespace.


Fix (width) and (height) functions.

Fix (width) and (height) functions.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -1896,8 +1896,7 @@
   "Height of the display window. The value of height is zero until
   size is called."
   []
-  #+clj (.getHeight (current-applet))
-  #+cljs (.-height (current-applet)))
+  (.-height (current-applet)))

 (defn
   ^{:requires-bindings true
@@ -4458,8 +4457,7 @@
   "Width of the display window. The value of width is zero until size is
   called."
   []
-  #+clj (.getWidth (current-applet))
-  #+cljs (.-width (current-applet)))
+  (.-width (current-applet)))

 #+clj
 (defmacro


per discussion on gitter, remove awaiting job completion

as feedback-exception does this for us already

--- src/leiningen/new/onyx_app/src/onyx_app/core.clj
+++ src/leiningen/new/onyx_app/src/onyx_app/core.clj
@@ -86,5 +86,4 @@
                        (println "Successfully submitted job: " job-id)
                        (println "Blocking on job completion...")
                        (onyx.test-helper/feedback-exception! peer-config job-id)
-                       (onyx.api/await-job-completion peer-config job-id)
                        (exit 0 "Job Completed"))))))