rewrite resolvers for introspection queries

--- src/graphql_clj/resolver.clj
+++ src/graphql_clj/resolver.clj
@@ -1,6 +1,5 @@
 (ns graphql-clj.resolver
-  (:require [clojure.core.match :as match]
-            [graphql-clj.introspection :as introspection]))
+  (:require [graphql-clj.introspection :as introspection]))

 (defn default-resolver-fn [type-name field-name]
   (fn [context parent args]
@@ -27,47 +26,44 @@
                                  "QueryRoot"))
         mutation-root-name (str (get-in schema [:roots :mutation]))]
     (fn [type-name field-name]
-      (match/match
-       [type-name field-name]
-       [query-root-name "__schema"] (fn [context parent args]
-                                      {:types        (introspection/schema-types schema)
-                                       :queryType    (root-type schema query-root-name)
-                                       :mutationType (root-type schema mutation-root-name)
-                                       :directives   []})
-       [query-root-name "__type"] (fn [context parent args]
-                                    (let [type-name (get args "name")
-                                          type (get-type-in-schema schema type-name)]
-                                      (assert type (format "type is nil for type-name: %s." type-name))
-                                      (introspection/type-resolver (assoc type :type-name type-name))))
-       ["__Schema" "directives"] (fn [context parent args]
-                                   [])
-       ["__Type" "ofType"] (fn [context parent args]
-                             (when-let [inner-type (:inner-type parent)]
-                               (cond
-                                 (:required inner-type) (introspection/type-resolver inner-type)
-                                 (get-in inner-type [:type-name]) (introspection/type-resolver (get-type-in-schema schema (get-in inner-type [:type-name])))
-                                 inner-type (introspection/type-resolver inner-type)
-                                 :default (throw (ex-info (format "Unable to process ofType for: %s." parent) {})))))
-       ["__Type" "fields"] (fn [context parent args]
-                             (map introspection/field-resolver (:fields parent)))
-       ["__Type" "enumValues"] (fn [context parent args]
-                                 (map introspection/enum-resolver (:enumValues parent)))
-       ["__Type" "inputFields"] (fn [context parent args]
-                                  (map introspection/input-field-resolver (:inputFields parent)))
-       ["__Field" "type"] (fn [context parent args]
-                            ;; (cond
-                            ;;   (:required parent) (introspection/type-resolver parent)
-                            ;;   (:inner-type parent) (introspection/type-resolver parent)
-                            ;;   (:type-name parent) (introspection/type-resolver parent)
-                            ;;   :default (throw (ex-info (format "Unhandled type: %s" parent) {})))
-                            (introspection/type-resolver parent))
-       ["__Field" "args"] (fn [context parent args]
-                            (map introspection/args-resolver (:args parent)))
-       ["__InputValue" "type"] (fn [context parent args]
-                                 (introspection/type-resolver parent))
-       :else (do
-               ;; (printf "not found resolver for: type-name:%s, field-name:%s.%n" type-name field-name ".")
-               nil)))))
+      (get-in {query-root-name {"__schema" (fn [context parent args]
+                                             {:types        (introspection/schema-types schema)
+                                              :queryType    (root-type schema query-root-name)
+                                              :mutationType (root-type schema mutation-root-name)
+                                              :directives   []})
+                                "__type" (fn [context parent args]
+                                           (let [type-name (get args "name")
+                                                 type (get-type-in-schema schema type-name)]
+                                             (assert type (format "type is nil for type-name: %s." type-name))
+                                             (introspection/type-resolver (assoc type :type-name type-name))))}
+               "__Schema" {"directives" (fn [context parent args]
+                                          [])}
+               "__Type" {"ofType" (fn [context parent args]
+                                    (when-let [inner-type (:inner-type parent)]
+                                      (cond
+                                        (:required inner-type) (introspection/type-resolver inner-type)
+                                        (get-in inner-type [:type-name]) (introspection/type-resolver (get-type-in-schema schema (get-in inner-type [:type-name])))
+                                        inner-type (introspection/type-resolver inner-type)
+                                        :default (throw (ex-info (format "Unable to process ofType for: %s." parent) {})))))
+                         "fields" (fn [context parent args]
+                                    (map introspection/field-resolver (:fields parent)))
+                         "enumValues" (fn [context parent args]
+                                        (map introspection/enum-resolver (:enumValues parent)))
+                         "inputFields" (fn [context parent args]
+                                         (map introspection/input-field-resolver (:inputFields parent)))}
+               "__Field" {"type" (fn [context parent args]
+                                   ;; (cond
+                                   ;;   (:required parent) (introspection/type-resolver parent)
+                                   ;;   (t:inner-ype parent) (introspection/type-resolver parent)
+                                   ;;   (:type-name parent) (introspection/type-resolver parent)
+                                   ;;   :default (throw (ex-info (format "Unhandled type: %s" parent) {})))
+                                   (introspection/type-resolver parent))
+                          "args" (fn [context parent args]
+                                   (map introspection/args-resolver (:args parent)))}
+               "__InputValue" {"type" (fn [context parent args]
+                                        (introspection/type-resolver parent))}}
+              [type-name field-name])
+      )))

 (defn create-resolver-fn
   [state resolver-fn]


Include strand in projection of position.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -1101,7 +1101,7 @@

 (def ^:private field-position-by-row-query
   (cached-statement
-    "SELECT `row`, `chrom`, `chromStart`, `chromEnd` FROM `field_position`
+    "SELECT `row`, `chrom`, `chromStart`, `chromEnd`, `strand` FROM `field_position`
     INNER JOIN TABLE(x VARCHAR = (?)) X ON X.x = `row`
     WHERE `field_id` = ?"
     true))


Logs now print last Git commit hash and link to GitHub.

--- src/clojush.clj
+++ src/clojush.clj
@@ -2117,6 +2117,20 @@
                       (math/expt (float (- target (+ intercept (* slope output)))) 2))
                  targets
                  outputs))))))
+
+(defn git-last-commit-hash
+  "Returns the last Git commit hash"
+  []
+  (let [dir (local-file/project-dir)]
+    (string/trim
+      (slurp
+        (str dir
+             "/.git/"
+             (subs
+               (string/trim
+                 (slurp
+                   (str dir "/.git/HEAD")))
+               5))))))

 (defn pushgp
   "The top-level routine of pushgp."
@@ -2186,6 +2200,24 @@
       (flush)
       (catch Exception e
              (printf "version number unavailable\n")
+             (flush)))
+    (try
+      (let [git-hash (git-last-commit-hash)]
+        (if (empty? git-hash)
+          (throw Exception)
+          (do
+            ;; NOTES: - Last commit hash will only be correct if this code has
+            ;;          been committed already.
+            ;;        - GitHub link will only work if commit has been pushed
+            ;;          to GitHub.
+            (printf (str "Hash of last Git commit = " git-hash "\n"))
+            (printf (str "GitHub link = https://github.com/lspector/Clojush/commit/"
+                         git-hash
+                         "\n"))
+            (flush))))
+      (catch Exception e
+             (printf "Hash of last Git commit = unavailable\n")
+             (printf "GitHub link = unavailable\n")
              (flush)))
     (print-params
       (error-function error-threshold population-size max-points atom-generators max-generations


Revert "CMR-1950: Added :ignore-conflicts false to update-index"

This reverts commit 3197a33b18876d9f41b22d8a920a70bf5abda9b2.

--- index-set-app/src/cmr/index_set/data/elasticsearch.clj
+++ index-set-app/src/cmr/index_set/data/elasticsearch.clj
@@ -62,8 +62,7 @@
       (if (esi/exists? conn index-name)
         ;; The index exists. Update the mappings.
         (doseq [[type-name type-mapping] mapping]
-          (let [response (esi/update-mapping
-                           conn index-name (name type-name) :mapping mapping :ignore_conflicts false)]
+          (let [response (esi/update-mapping conn index-name (name type-name) :mapping mapping)]
             (when-not (= {:acknowledged true} response)
               (errors/internal-error! (str "Unexpected response when updating elastic mappings: "
                                            (pr-str response))))))


remove lower than two count from diameter

--- src/clj/ceres_analytics/news_measures.clj
+++ src/clj/ceres_analytics/news_measures.clj
@@ -52,7 +52,7 @@
          (pmap
           (fn [[l ls]]
             (let [node-times (map (comp c/to-long :ts) ls)]
-              (if (empty? node-times)
+              (if (< (count node-times) 2)
                 nil
                 (/ (->> (t/interval
                          (c/from-long (apply min node-times))
@@ -67,7 +67,7 @@
          (pmap
           (fn [[l ls]]
             (let [node-times (map (comp c/to-long :ts) ls)]
-              (if (empty? node-times)
+              (if (< (count node-times) 2)
                 nil
                 (/ (->> (t/interval
                          (c/from-long (apply min node-times))
@@ -85,12 +85,12 @@
                 (pmap
                  (fn [[l ls]]
                    (let [node-times (map (comp c/to-long :ts) ls)]
-                     (if (empty? node-times)
+                     (if (< (count node-times) 2)
                        nil
                        (/ (->> (t/interval
-                              (c/from-long (apply min node-times))
-                              (c/from-long (apply max node-times)))
-                             t/in-seconds)
+                                (c/from-long (apply min node-times))
+                                (c/from-long (apply max node-times)))
+                               t/in-seconds)
                           3600)))))
                 (remove nil?)
                 statistics)))


remove debug

remove debug

--- src/com/billpiel/sayid/string_output2.clj
+++ src/com/billpiel/sayid/string_output2.clj
@@ -560,8 +560,6 @@

 (defn decorate-token
   [t]
-  (if (= (:start t) 62)
-    (def t' t))
   (let [z (:zipper t)
         out (adjusted-pos (find-out-node z))
         in (adjusted-pos (find-in-node z))


Add simple function for check byte array equality.

--- src/bytebuf/bytes.clj
+++ src/bytebuf/bytes.clj
@@ -20,6 +20,11 @@
   [^bytes input ^long offset ^long limit]
   (Arrays/copyOfRange input offset limit))

+(defn equals?
+  "Check if two byte arrays are equals."
+  [^bytes a ^bytes b]
+  (Arrays/equals a b))
+
 (defn zeropad!
   "Add zero byte padding to the given byte array
   to the remaining bytes after specified data length."


Adds support for phrases collection.

Adds support for phrases collection.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -3,13 +3,18 @@
   (:require [monger.core :as mg]
             [monger.collection :as mc]
             [noir.validation :as vali]
+            [cadence.pattern-recognition :as patrec]
             [noir.options :as options]
             [cemerick.friend :as friend])
   (:use clojure.walk
-        [cemerick.friend.credentials :only [hash-bcrypt]]))
+        monger.operators
+        [cemerick.friend.credentials :only [hash-bcrypt]])
+  (:import [org.bson.types ObjectId]))

 (defn- ensure-indexes []
   (mc/ensure-index "cadences" {:random_point "2d"})
+  (mc/ensure-index "phrases" {:random_point "2d"})
+  (mc/ensure-index "phrases" {:users 1})
   (mc/ensure-index "users" {:username 1} {:unique 1 :dropDups 1}))

 (defn connect [connection-info]
@@ -49,10 +54,25 @@
                                     :random_point [(rand) 0]}))
                         cads)))

+(defn add-phrases
+  "Batch inserts phrases to be used for training and auth."
+  [phrases]
+  (mc/insert-batch "phrases"
+                   (map (fn [x]
+                          {:phrase x
+                           :users []
+                           :random_point [(rand) 0]}) phrases)))
+
 (def identity #(get friend/*identity* :current))
 (def get-auth #((:authentications friend/*identity*) (:current friend/*identity*)))

-(defn get-phrase []
+(defn get-phrase [user-id for-auth?]
   (if (options/dev-mode?)
-    "derp"
-    "completing this phrase is fun"))
+    {:_id (ObjectId. "1234")
+     :phrase "derp"
+     :users [(:_id (get-auth))]}
+    (mc/find-one-as-map "phrases"
+                        (if for-auth?
+                          {:users user-id :random_point {"$near" (rand)}}
+                          {:users {$ne user-id} :random_point {"$near" (rand)}})
+                        {:phrase 1})))


Add the year renderer again

Add the year renderer again

because it's needed to display the year

--- src/catalog/latex.clj
+++ src/catalog/latex.clj
@@ -100,6 +100,10 @@
             api-key
             (string/replace record-id "/" "."))))

+(defn year [date]
+  (time.format/unparse
+   (time.format/formatters :year) (time.coerce/from-date date)))
+
 (defn periodify
   "Add a period to the end of `s` if it is not nil and doesn't end in
   punctuation. If `s` is nil return an empty string."


Api working

Api working

--- src/clj/virt/core.clj
+++ src/clj/virt/core.clj
@@ -41,8 +41,7 @@

 (defn cosm-data-handler [request]
   (let [params (:route-params request)
-        id (:id params)]
-    (println id)
+        id (read-string (:id params))]
     {:status 200
      :headers {"Content-Type" "application/edn"}
      :body (pr-str (get-in @cosm-data [id]))}))
@@ -66,7 +65,7 @@
   (GET ["/api/watch/:cosm-id/:channel-id", :cosm-id #"[0-9A-Za-z]+", :channel-id #"[0-9A-Za-z]+"] {}
        (wrap-aleph-handler chat))
   (GET "/api/cosms" [] cosms-handler)
-  (GET "/api/cosm/:id" [id] cosm-data-handler)
+  (GET "/api/cosm/:id" [] cosm-data-handler)
   (GET "/*" {:keys [uri]} (resp/resource-response "index.html" {:root "public"}))
   (route/not-found "Page not found"))


More anal silliness

More anal silliness

--- src/cljparse/core.clj
+++ src/cljparse/core.clj
@@ -25,12 +25,12 @@
                (not= errors nil)
                (exit -1 (str "Error: " errors))

-              :else (let [ path (:path options)
+               :else (let [ path (:path options)
                            file (io/file path configname) ]
                       (do
                         (cond (not (.isFile file))
                             (exit -1 (str ("Configuration not found at " path)))
                             :else
                             (do
-                              (println "Starting cljparse with path:" path "and errors:" errors)
+                              (println "Starting cljparse on:" (.getAbsolutePath file) "and errors:" errors)
                               (config/parser file))))))))


Begin to fix templating code

Begin to fix templating code

--- src/cljs/app/app.cljs
+++ src/cljs/app/app.cljs
@@ -30,11 +30,6 @@
 (defn update-results-state [in]
   (go-loop []
     (.log js/console (swap! state assoc :results (<! in)))))
-
-; (defn timeout [ms]
-;   (let [c (chan)]
-;     (js/setTimeout (fn [] (close! c)) ms)
-;     c))

 (defn throttle [c ms]
   (let [c' (chan)]
@@ -69,8 +64,7 @@
 (defn search-field []
   (dom/getElement "search-field"))

-; Capture keypresses on search field and perform searches as user types,
-; throttled to an interval
+; Capture keypresses on search field and perform searches as user types
 (defn query-input-loop []
   (let [typing (listen (search-field) "keypress")]
     (go-loop []
@@ -78,31 +72,31 @@
       (>! query-chan (.-value (search-field))))))

 ; Templating
-(defsnippet result-data "templates/results.html" [:.list-row] [result-element]
-  {[:.list-row] (kioo/content [:li (first result-element)]
-                              [:li (second result-element)])})
+(def lookup-label
+  {:category-drugs "Therapeutic Category: Drug(s)"
+   :organ-system "Organ System"
+   :rationale "Rationale"
+   :recommendation "Recommendation"
+   :quality-of-evidence "Quality Of Evidence"
+   :strength-of-recommendation "Strength of Recommendation"
+   :evidence "Evidence"})
+
+(defsnippet result-data "templates/results.html" [:.list-row] [[key val]]
+  {[:.list-row] (kioo/content [:li (get key lookup-label)]
+                              [:li val])})

 (defsnippet result-card "templates/results.html" [:.card] [result-map]
   {[:.list-column] (kioo/content [:li
                                    [:ul {:class "list-row"}
                                      (map result-data
-                                       (get result-map :_source))]])})
+                                       result-map)]])})

 (deftemplate result-cards "templates/results.html" []
-  {[:.card] (map result-card (get @state :results))})
+  {[:.card] (kioo/content (map result-card (get-in @state [:results :_source])}))})

 (deftemplate page "index.html" []
-  {[:.results] (result-cards)})
+  {[:.results] (kioo/content (result-cards))})

 (defn init []
   (reagent/render-component [page] (.-body js/document))
   (query-input-loop))
-
-; (let [query-url "http://168.235.155.245/beers/2015/_search"
-;       terms "cardiovascular"]
-;   (execute-query query-url terms))
-
-; (let [{drugs :drugs rationale :rationale recommendation :recommendation
-;        quality-of-evidence :quality-of-evidence
-;        strength-of-recommendation :strength-of-recommendation
-;        evidence :evidence}]


made proxy cursor seqable

made proxy cursor seqable

--- src/copper/query.cljs
+++ src/copper/query.cljs
@@ -26,11 +26,18 @@
   core/ITransact
   (-transact! [this path func]
     (let [f (fn temp [source [path-part  & rpaths]]
-             (let [res (get source path-part)]
-               (if (satisfies? core/ITransact res)
-                 (core/transact! res (vec rpaths) func)
-                 (temp res rpaths))))]
-      (f source path))))
+              (if path-part
+                (let [res (get source path-part)]
+                  (if (satisfies? core/ITransact res)
+                    (core/transact! res (vec rpaths) func)
+                    (temp res rpaths)))
+                source))]
+      (f source path)))
+
+  ISeqable
+  (-seq [this]
+    (for [idx (count source)]
+      (sub-cursor this idx))))

 (def built-ins


a little more progress on config editor

a little more progress on config editor

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

--- acqEngine/src/org/micromanager/config_editor.clj
+++ acqEngine/src/org/micromanager/config_editor.clj
@@ -96,6 +96,11 @@
     (when (< -1 row (count groups))
       (nth groups row))))

+(defn get-selected-preset []
+  (let [row (.getSelectedRow (@widgets :preset-names-table))
+        presets (keys @group-data)]
+    (when (< -1 row (count @group-data))
+      (nth presets row))))

 (defn update-group-data []
     (reset! group-data
@@ -234,7 +239,8 @@
         preset (config-struct (core getConfigGroupState group))]
     (doseq [[[d p] v] preset]
       (core defineConfig group preset-name d p v))
-    (redraw-data)))
+    (redraw-data)
+    ))

 (defn add-property [group dev prop]
   (when-not ((set (properties @group-data)) [dev prop])
@@ -301,7 +307,9 @@
       (.setModel preset-names-table (preset-names-table-model))
       (.setModel presets-table (presets-table-model))
       (link-table-row-selection presets-table preset-names-table)
-      (double-click-for-new-row groups-table #(println "new row!"))
+      (double-click-for-new-row groups-table new-group)
+      (double-click-for-new-row
+        preset-names-table #(new-preset (get-selected-group)))
       (.setAutoResizeMode presets-table JTable/AUTO_RESIZE_OFF)
       (doto cp
         (.setLayout (SpringLayout.))


New tests: test-render-front-page-existence, test-render-error-page-existence, and test-get-hostname-existence

--- test/emender_jenkins/server_test.clj
+++ test/emender_jenkins/server_test.clj
@@ -65,6 +65,25 @@
         (is (callable? 'emender-jenkins.server/get-hostname))))

+
+(deftest test-get-hostname-existence
+    "Check that the emender-jenkins.server/get-hostname definition exists."
+    (testing "if the emender-jenkins.server/get-hostname definition exists."
+        (is (callable? 'emender-jenkins.server/get-hostname))))
+
+
+(deftest test-get-api-command-existence
+    "Check that the emender-jenkins.server/get-api-command definition exists."
+    (testing "if the emender-jenkins.server/get-api-command definition exists."
+        (is (callable? 'emender-jenkins.server/get-api-command))))
+
+
+(deftest test-api-call-handler-existence
+    "Check that the emender-jenkins.server/api-call-handler definition exists."
+    (testing "if the emender-jenkins.server/api-call-handler definition exists."
+        (is (callable? 'emender-jenkins.server/api-call-handler))))
+
+
 ;(get-api-command nil "/api")

 ;(get-api-command "/" "/api")


Tests: verbose?, result-cache?, pretty-print-end?, and delete-workdirs?

--- test/emender_service/config_test.clj
+++ test/emender_service/config_test.clj
@@ -60,3 +60,23 @@
     (testing "if the emender-service.config/path-to-tests definition exists."
         (is (callable? 'emender-service.config/path-to-tests))))

+(deftest test-verbose?-existence
+    "Check that the emender-service.config/verbose? definition exists."
+    (testing "if the emender-service.config/verbose? definition exists."
+        (is (callable? 'emender-service.config/verbose?))))
+
+(deftest test-use-result-cache?-existence
+    "Check that the emender-service.config/use-result-cache? definition exists."
+    (testing "if the emender-service.config/use-result-cache? definition exists."
+        (is (callable? 'emender-service.config/use-result-cache?))))
+
+(deftest test-pretty-print-edn?-existence
+    "Check that the emender-service.config/pretty-print-edn? definition exists."
+    (testing "if the emender-service.config/pretty-print-edn? definition exists."
+        (is (callable? 'emender-service.config/pretty-print-edn?))))
+
+(deftest test-delete-workdirs?-existence
+    "Check that the emender-service.config/delete-workdirs? definition exists."
+    (testing "if the emender-service.config/delete-workdirs? definition exists."
+        (is (callable? 'emender-service.config/delete-workdirs?))))
+


Tests for HTML renderer module

Tests for HTML renderer module

--- test/hurvinek/html_renderer_test.clj
+++ test/hurvinek/html_renderer_test.clj
@@ -81,3 +81,44 @@
         (is (callable? 'hurvinek.html-renderer/render-database-statistic-page))))

+(deftest test-render-export-database-page-existence
+    "Check that the hurvinek.html-renderer/render-export-database-page definition exists."
+    (testing "if the hurvinek.html-renderer/render-export-database-page definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-export-database-page))))
+
+
+(deftest test-render-product-list-existence
+    "Check that the hurvinek.html-renderer/render-product-list definition exists."
+    (testing "if the hurvinek.html-renderer/render-product-list definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-product-list))))
+
+
+(deftest test-render-edit-product-existence
+    "Check that the hurvinek.html-renderer/render-edit-product definition exists."
+    (testing "if the hurvinek.html-renderer/render-edit-product definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-edit-product))))
+
+
+(deftest test-render-chapter-list-existence
+    "Check that the hurvinek.html-renderer/render-chapter-list definition exists."
+    (testing "if the hurvinek.html-renderer/render-chapter-list definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-chapter-list))))
+
+
+(deftest test-render-edit-chapter-existence
+    "Check that the hurvinek.html-renderer/render-edit-chapter definition exists."
+    (testing "if the hurvinek.html-renderer/render-edit-chapter definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-edit-chapter))))
+
+
+(deftest test-render-group-list-existence
+    "Check that the hurvinek.html-renderer/render-group-list definition exists."
+    (testing "if the hurvinek.html-renderer/render-group-list definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-group-list))))
+
+
+(deftest test-render-component-list-existence
+    "Check that the hurvinek.html-renderer/render-component-list definition exists."
+    (testing "if the hurvinek.html-renderer/render-component-list definition exists."
+        (is (callable? 'hurvinek.html-renderer/render-component-list))))
+


failing tests

failing tests

--- test/tabby/cluster_test.clj
+++ test/tabby/cluster_test.clj
@@ -142,24 +142,26 @@
       (is (= '(:follower :follower :follower) (fields-by-id s :type)))
       (is (= 2 (get-in s [:servers 0 :current-term]))))))

-;; (deftest test-log-catch-up
-;;   (testing "log catchup"
-;;     (init)
-;;     (until-empty)
-;;     (add-packet-loss 1 0)
-;;     (system-write {:a "a"})
-;;     (step 0)
-;;     (step 0)
-;;     (is (= '(1 0 1) (map #(count (:log %)) (servers))))
-;;     (step 10)
-;;     (step 0)
-;;     (is (= '(1 0 1) (map :commit-index (servers))))
-;;     (clear-packet-loss)
-;;     (step 10)
-;;     (step 0)
-;;     (step 0)
-;;     (step 10)
-;;     (step 0)
-;;     (step 0)
-;;     (is (= '(1 1 1) (map :commit-index (servers))))
-;;     (is (= '({:a "a"} {:a "a"} {:a "a"}) (map :db (servers))))))
+(deftest test-log-catch-up
+  (testing "log is missing 1"
+    (let [s (->> (test-cluster 3)
+                 (until-empty)
+                 (add-packet-loss 1 0)
+                 (write {:a "a"})
+                 (step-times 0 2)
+                 (step 10)
+                 (step 0))]
+      (is (= '(1 0 1) (map count (fields-by-id s :log))))
+      (is (= '(1 0 1) (fields-by-id s :commit-index)))
+
+      (let [s1 (->> s
+                    (clear-packet-loss)
+                    (step 10)
+                    (step 0)
+                    (step 0)
+                    (step 10)
+                    (step 0)
+                    (step 0))]
+
+        (is (= '(1 1 1) (fields-by-id s1 :commit-index)))
+        (is (= '({:a "a"} {:a "a"} {:a "a"}) (fields-by-id s :db)))))))


whitespace.

whitespace.

--- modules/clojure/src/main/clojure/wunderboss/util.clj
+++ modules/clojure/src/main/clojure/wunderboss/util.clj
@@ -37,9 +37,9 @@
   (require '[dynapath.dynamic-classpath :as dp])
   (eval '(let [base-url-classloader
                (assoc dp/base-readable-addable-classpath
-               :classpath-urls #(seq (.getURLs %))
-               :add-classpath-url (fn [cl url]
-                                    (.addURL cl url)))]
+                 :classpath-urls #(seq (.getURLs %))
+                 :add-classpath-url (fn [cl url]
+                                      (.addURL cl url)))]

            ;; if dynapath is available, make our classloader join the party
            (extend org.projectodd.wunderboss.DynamicClassLoader


Minor formatting, punctuation, and typographic corrections

--- src/main/clojure/clara/rules/compiler.clj
+++ src/main/clojure/clara/rules/compiler.clj
@@ -28,10 +28,11 @@
 (def BetaNode (sc/either ProductionNode QueryNode HashJoinNode ExpressionJoinNode
                          NegationNode TestNode AccumulateNode))

-;; A rulebase -- essentially an immutable Rete network with a collection of alpha and beta nodes and supporting structure.
+;; A rulebase -- essentially an immutable Rete network with a collection of
+;; alpha and beta nodes and supporting structure.
 (sc/defrecord Rulebase [;; Map of matched type to the alpha nodes that handle them.
                         alpha-roots :- {sc/Any [AlphaNode]}
-                        ;; Root beta nodes (join, accumulate, etc.)
+                        ;; Root beta nodes (join, accumulate, etc.).
                         beta-roots :- [BetaNode]
                         ;; Productions in the rulebase.
                         productions :- #{schema/Production}
@@ -39,7 +40,7 @@
                         production-nodes :- [ProductionNode]
                         ;; Map of queries to the nodes hosting them.
                         query-nodes :- {sc/Any QueryNode}
-                        ;; May of id to one of the beta nodes (join, accumulate, etc)
+                        ;; Map of id to one of the beta nodes (join, accumulate, etc).
                         id-to-node :- {sc/Num BetaNode}])

 (def ^:private reflector
@@ -1579,7 +1580,7 @@
                           ;; Load rules from the source, or just use the input as a seq.
                           (mapcat #(if (satisfies? IRuleSource %)
                                      (load-rules %)
-                                     %))
+                                     %))
                           (map (fn [n production]
                                  (vary-meta production assoc ::rule-load-order (or n 0)))
                                (range))


we use random access on types so make it a vector

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -41,28 +41,28 @@
 ;;  delphinidae                         ; Orca, Dolphins

-(def types '(
-	     "blue whale"
-	     "sei whale"
-	     "bottlenose dolphin"
-	     "killer whale"
-	     "false killer whale"
-	     "amazon river dolphin"
-	     "narwhal"
-	     "sperm whale"
-	     "pilot whale"
-	     "beluga whale"
-	     "humpback whale"
-	     "fin whale"
-	     "right whale"
-	     "bowhead whale"
-	     "brydes whale"
-	     "minke whale"
-	     "gray whale"
-	     "spinner dolphin"
-	     "melon headed whale"
-	     "beaked whale"
-	     ))
+(def types [
+	    "blue whale"
+	    "sei whale"
+	    "bottlenose dolphin"
+	    "killer whale"
+	    "false killer whale"
+	    "amazon river dolphin"
+	    "narwhal"
+	    "sperm whale"
+	    "pilot whale"
+	    "beluga whale"
+	    "humpback whale"
+	    "fin whale"
+	    "right whale"
+	    "bowhead whale"
+	    "brydes whale"
+	    "minke whale"
+	    "gray whale"
+	    "spinner dolphin"
+	    "melon headed whale"
+	    "beaked whale"
+	    ])

 (defn rnd [seq] (nth seq (rand-int (count seq))))


test - add cljs.test/do-report :fail from ::bad-http-result

--- test/re_frame_http_fx/core_test.cljs
+++ test/re_frame_http_fx/core_test.cljs
@@ -13,22 +13,22 @@
 ;; ---- TESTS ------------------------------------------------------------------

-(deftest ajax-get
-  ;; Setup handler which returns a :http effect specifying an ajax-request.
+(deftest xhrio-get
+  ;; Setup effects handler with :http-xhrio specifying an ajax-request.
   ;; Note we specify optional :response-format to make sure our json result
   ;; has keywords for keys, and :timeout see the ajax-request API
   ;; for more details https://github.com/JulianBirch/cljs-ajax#ajax-request
-  ;; We specify an :on-failure for completenes but we don't expect the request
+  ;; We specify an :on-failure for completeness but we don't expect the request
   ;; to fail unless there is something wrong with your internet or github.
   (re-frame/def-event-fx
     ::http-test
     (fn [_context _event-v]
-      {:http {:method          :get
-              :uri             "https://api.github.com/orgs/day8"
-              :timeout         5000
-              :response-format (ajax/json-response-format {:keywords? true})
-              :on-success      [::good-http-result "test-token1"]
-              :on-failure      [::bad-http-result "test-token1"]}}))
+      {:http-xhrio {:method          :get
+                    :uri             "https://api.github.com/orgs/day8"
+                    :timeout         5000
+                    :response-format (ajax/json-response-format {:keywords? true})
+                    :on-success      [::good-http-result "test-token1"]
+                    :on-failure      [::bad-http-result "test-token1"]}}))
     (async done

       ;; setup success handler
@@ -46,10 +46,15 @@
       ;; setup failure handler
       (re-frame/def-event
         ::bad-http-result
-        (fn [db [_ _token error]]
-          (re-frame/console :error "Unexpected HTTP error, something wrong with your internet? " error)
+        (fn [db [_ token error]]
+          (is (= "test-token1" token) "expected: token passed through")
+          (cljs.test/do-report
+            {:type     :fail
+             :message  "Unexpected HTTP error, something wrong with your internet?"
+             :expected ::good-http-result
+             :actual   error})
           (done)
           db))

-      ;; kick things off
+      ;; kick off main handler
       (re-frame/dispatch [::http-test])))


Fix pre check for follow-data.

Fix pre check for follow-data.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -244,7 +244,8 @@
           (or (sequential? allowed-boards)
               (nil? allowed-boards))
           (lib-schema/unique-id? user-id)
-          (map? follow-data)
+          (or (nil? follow-data)
+              (map? follow-data))
           (#{:desc :asc} order)
           (not (nil? start))
           (#{:after :before} direction)


Allowing osx only orgs to be mama/papa :pig:

--- src-cljs/frontend/models/plan.cljs
+++ src-cljs/frontend/models/plan.cljs
@@ -97,6 +97,7 @@

 (defn transferrable-or-piggiebackable-plan? [plan]
   (or (paid? plan)
+      (osx? plan)
       ;; Trial plans shouldn't really be transferrable
       ;; but they are piggiebackable and the UI mixes the two :(
       (trial? plan)))


Inbox: Ask for document title if not set.

--- src-cljs/pepa/workflows/inbox.cljs
+++ src-cljs/pepa/workflows/inbox.cljs
@@ -151,7 +151,9 @@
                                   (async/put! (om/get-state owner :events)
                                               {:event :document/save
                                                :document (om/value document)})
-                                  (.preventDefault e))
+                                  (doto e
+                                    (.preventDefault)
+                                    (.stopPropagation)))
                       :disabled disabled?}
         "Save"]))))

@@ -208,8 +210,6 @@
               (or title "Unnamed")]
              (om/build save-button document
                        {:init-state {:events events}
-                        :state {:disabled? (or (s/blank? title)
-                                               (empty? (:pages document)))}
                         :key :id}))
             (list
              [:form.title {:on-submit (fn [e]
@@ -455,14 +455,16 @@
   "Saves DOCUMENT on the server and removes it from the inbox state."
   [state document]
   (go
-    (assert (:title document))
-    (assert (seq (:pages document)))
-    (println "Saving document" document)
-    (when (<! (api/save-new-document! document "inbox"))
-      (om/transact! state :documents #(dissoc % (:id document)))
-      (let [pages (:pages document)]
-        (when (<! (api/delete-from-inbox! pages))
-          (om/transact! state [:documents :inbox :pages] #(filterv (complement (set pages)) %)))))))
+    (let [document (update-in document [:title]
+                              #(or % (js/window.prompt "Please enter a name for the document:")))]
+      (assert (seq (:pages document)))
+      (if (s/blank? (:title document))
+        (js/alert "Can't save a document without a title.")
+        (when (<! (api/save-new-document! document "inbox"))
+          (om/transact! state :documents #(dissoc % (:id document)))
+          (let [pages (:pages document)]
+            (when (<! (api/delete-from-inbox! pages))
+              (om/transact! state [:documents :inbox :pages] #(filterv (complement (set pages)) %)))))))))

 (defn ^:private delete-pages!
   "Deletes selected pages from the inbox on the server."


Uncommented bookmark replacement in template file.

--- src/alfresco_technical_validation/validation.clj
+++ src/alfresco_technical_validation/validation.clj
@@ -228,4 +228,4 @@
     (dn/write-dependencies! neo4j-url dependencies)
     (let [bookmarks (validate-criteria neo4j-url source-index)]
       (println "bookmarks =" bookmarks)   ; ####TEST!!!!
-      (bw/populate-bookmarks! report-template report-filename bookmarks))))
+      (bw/populate-bookmarks! (clojure.java.io/input-stream report-template) report-filename bookmarks))))


call the secretary/dispatch during figwheel reload since otherwise layout changes aren't visible instantly

--- src-cljs/bitfondue/core.cljs
+++ src-cljs/bitfondue/core.cljs
@@ -270,5 +270,5 @@
   ;; optionally touch your app-state to force rerendering depending on
   ;; your application
   ;; (swap! app-state update-in [:__figwheel_counter] inc)
-  (fetch-chunks)
-)
+  ;; (fetch-chunks)
+  (secretary/dispatch! (get-token)))


moving all the login content into the login-form; adding a password field and submit button

--- src-cljs/bitfondue/core.cljs
+++ src-cljs/bitfondue/core.cljs
@@ -77,15 +77,19 @@

 (def login-form
   [:div.col-md-6
+   [:h1 "Login"]
+   [:br]
    [:form
     [:fieldset.form-group
      [:label {:for "usernameInput"} "Username"]
-     [:input.form-control {:type "email" :id "usernameInput" :placeholder "Your username please."}]]]])
+     [:input.form-control {:type "email" :id "usernameInput" :placeholder "Your username please."}]]
+    [:fieldset.form-group
+     [:label {:for "passwordInput"} "Password"]
+     [:input.form-control {:type "password" :id "passwordInput" :placeholder "Password"}]]
+    [:button.btn.btn-primary {:type "submit"} "Login"]]])

 (defn login []
-  [layout [:div.row
-           [:h1 "Login"]
-           login-form]])
+  [layout [:div.row login-form]])

 (defn register []
   [layout [:h1 "Register"]])


Reduce MAX-OSC-SAMPLES to work within the constraints of the native server ByteBuffer capacity. Fixes #222

--- src/overtone/sc/defaults.clj
+++ src/overtone/sc/defaults.clj
@@ -50,7 +50,7 @@

 (def MAX-OSC-SAMPLES
   "Max number of samples supported in a UDP OSC message"
-  8192)
+  6548)

 (def INTERNAL-POOL
   "make an at-at pool for all internal scheduling"


add docs for x-fade2 ugen

add docs for x-fade2 ugen

--- src/overtone/sc/ugen/pan.clj
+++ src/overtone/sc/ugen/pan.clj
@@ -148,11 +148,12 @@

        ;; TODO why is inB default 0.0 in sc code if checkNInputs(2)?
        {:name "XFade2",
-        :args [{:name "inA"}
-               {:name "inB"}
-               {:name "pan", :default 0.0}
-               {:name "level", :default 1.0}]
-        :check (when-ar (first-n-inputs-ar 2))}
+        :args [{:name "inA" :doc "input signal A"}
+               {:name "inB" :doc "input signal B"}
+               {:name "pan", :default 0.0 :doc "Pan between the two input signals with -1 being inA only and 1 being inB only with values between being a mix of the two."}
+               {:name "level", :default 1.0 :doc "Output level - 0 being silent and 1 being original volume"}]
+        :check (when-ar (first-n-inputs-ar 2))
+        :doc "Equal power two channel cross fade"}

        ;; LinXFade2 : XFade {
        ;;  // linear two channel cross fade


Fix node-control call now that it requires a single map as an arg (due to a lack of vararg support in Clojure's protocols)

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -76,7 +76,7 @@
     on-key)
     (on-event [:midi :note-off] (fn [{note :note velocity :velocity}]
                                   (let [n (get @notes* note)]
-                                    (node-control n :gate 0))
+                                    (node-control n {:gate 0}))
                                   (swap! notes* dissoc note))
               off-key)
     {:notes* notes*


Got shader error logging working.

Got shader error logging working.

--- src/petulant_life/shader.clj
+++ src/petulant_life/shader.clj
@@ -17,16 +17,15 @@
 (defn load-shader [path type]
   (let [shader (load-shader-raw path type)
         status (GL20/glGetShaderi shader GL20/GL_COMPILE_STATUS)]
-    (if status
+    (if (= status 1)
       shader
-      (do (print (GL20/glGetShaderInfoLog shader 2048))
-          (.exit System) 1))))
+      (print (str "SHADER COMPILER ERROR: " (GL20/glGetShaderInfoLog shader 2048))))))

 ;; Loading a shader if it exists.
 (defn load-if-exists [path type]
   (if (.exists (as-file path))
     (load-shader path type)
-    (print (str "Loading shader: " path " does not exist.\n"))))
+    nil))

 ;; Loading a bunch of shaders and returning them in one map.
 (defn load-shaders [src-path]
@@ -62,7 +61,6 @@
 (defn load-shader-program [src-path]
   (let [shader-program (load-shader-program-raw src-path)
         status (GL20/glGetProgrami shader-program GL20/GL_LINK_STATUS)]
-    (if status
+    (if (= status 1)
       shader-program
-      (do (print (GL20/glGetProgramInfoLog shader-program 2048))
-          (.exit System 1)))))
+      (print (str "SHADER LINKER ERROR: " (GL20/glGetProgramInfoLog shader-program 2048))))))


refactor file-exists?

refactor file-exists?

--- src/galleon.clj
+++ src/galleon.clj
@@ -13,11 +13,8 @@
 (def default-config-path "/etc/galleon.edn")
 (def system nil)

-(defn file-exists?
-  [path]
-  (prn path)
-  (if
-    (.isFile (File. path)) true false))
+(defn file-exists? [path]
+  (if (.isFile (File. path)) true false))

 (defn load-system-config []
   (let [path "aspire-conf.edn"]


can't have any fractional amounts

can't have any fractional amounts

--- src/bitsplit_cli/system/client/transactions.cljs
+++ src/bitsplit_cli/system/client/transactions.cljs
@@ -33,7 +33,7 @@
   (when (output? send-to)
     (doseq [with-fee [(apply-diff (- tx-fee) send-to)]
             [address amount] with-fee]
-      (.addOutput tx address amount))
+      (.addOutput tx address (.floor js/Math amount)))
     tx))

 (def with-outputs! (partial merge-with add-output!))


Fix output

Fix output

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -4,6 +4,7 @@
             [discuss.communication.main :as com]
             [discuss.components.sidebar :as sidebar]
             [discuss.components.bubbles]
+            [discuss.config :as config]
             [discuss.debug :as debug]
             [discuss.references.integration]
             [discuss.utils.common :as lib]
@@ -16,8 +17,8 @@
 ;; Initialization
 (defn ^:export main []
   (com/init-with-references!)
-  (lib/log (str "Loaded " (discuss.config/project))))
-;(main)
+  (lib/log (str "Loaded " config/project " " config/version)))
+(main)

 ;; Register
 (om/root views/main-view lib/app-state


Add alternative, fancy-nav warehouse hierarchy.

--- src/exp/warehouse.clj
+++ src/exp/warehouse.clj
@@ -76,7 +76,7 @@

-(deftype WarehouseEnv [init goal] :as this
+(deftype WarehouseEnv [init goal topright] :as this
  env/Env
   (initial-state [] init)
   (actions-fn []
@@ -121,16 +121,18 @@
                        (when block [['on block] (or (get stack y) nil)])
                        [[['blockat x y] (or block nil)]
                         [['someblockat x y] (if block true false)]]))))
-       (into {} (for [stack goal-stacks, [a b] (partition 2 1 stack)] [['on b] a]))))))
-
-
-
-
-;;;;;;;; hierarchy ;;;;;;;;;;;;
-
-;; TODO: fix nav dependence growth?
-
-(deftype NavHLA [name context dest] :as this
+       (into {} (for [stack goal-stacks, [a b] (partition 2 1 stack)] [['on b] a]))
+       topright))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Hierarchies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Simple Nav ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftype SimpleNavHLA [name context dest] :as this
   env/Action                (action-name [] name)
                             (primitive? [] false)
   env/ContextualAction      (precondition-context [s] context )
@@ -143,18 +145,71 @@
                                  [a this])))
                             (cycle-level- [s] 1))

+
+;Issue with context: we also learn for other initial states, possibly outside initial range.
+(defn make-simple-nav-hla [dx dy nav-context]
+  (SimpleNavHLA ['nav dx dy] nav-context [dx dy]))
+   ;(into '#{[at]} (for [x (incl-range dx gx) y (range (min dy gy) (inc h))] ['someblockat x y])) [dx dy]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  URD   Nav ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftype UpHLA [opt-dy] :as this
+  env/Action                (action-name [] ['up-to opt-dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s] '#{[at]})
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                              (let [[cx cy] (env/get-var s '[at])]
+                                (filter identity
+                                  [(when (or (not opt-dy) (= cy opt-dy)) [])
+                                   (when (or (not opt-dy) (< cy opt-dy))
+                                     (when-let [a (make-up s)] [a this]))])))
+                            (cycle-level- [s] nil))
+
+(deftype DownHLA [dx dy] :as this
+  env/Action                (action-name [] ['down-to dx dy])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s] #{'[at] ['someblockat dx dy]})
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                              (let [[cx cy] (env/get-var s '[at])]
+                                (assert (= cx dx))
+                                (filter identity
+                                  [(cond (= cy dy) []
+                                         (> cy dy) (when-let [a (make-down s)] [a this]))])))
+                            (cycle-level- [s] nil))
+
 (defn incl-range
   ([x1 x2] (if (<= x1 x2) (range x1 (inc x2)) (range x2 (inc x1))))
   ([x1 x2 x3] (range (min x1 x2 x3) (inc (max x1 x2 x3)))))

-;Issue with context: we also learn for other initial states, possibly outside initial range.
-(defn make-nav-hla [dx dy nav-context]
-  (NavHLA ['nav dx dy] nav-context [dx dy]))
-                                        ;(into '#{[at]} (for [x (incl-range dx gx) y (range (min dy gy) (inc h))] ['someblockat x y])) [dx dy]))
+(deftype TraverseHLA [dx] :as this
+  env/Action                (action-name [] ['traverse-to dx])
+                            (primitive? [] false)
+  env/ContextualAction      (precondition-context [s]
+                              (let [[cx cy] (env/get-var s '[at])]
+                                (into '#{[at]} (for [x (incl-range cx dx)] ['someblockat x cy]))))
+  hierarchy/HighLevelAction (immediate-refinements- [s]
+                              (let [[cx cy] (env/get-var s '[at])]
+                                (filter identity
+                                  [(cond (= cx dx) []
+                                         (> cx dx) (when-let [a (make-left s)] [a this])
+                                         (< cx dx) (when-let [a (make-right s)] [a this]))])))
+                            (cycle-level- [s] nil))
+
+(defn make-fancy-nav-plan [dx dy h]
+  (if (= dy h)
+      [(UpHLA dy) (TraverseHLA dx)]
+    [(UpHLA nil) (TraverseHLA dx) (DownHLA dx dy)]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Hierarchy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+

 ; state vars are: (const), at, facingright, holding, blockat, someblockat, on

-(deftype MoveBlockHLA [env name context nav-context b bx by a c cx cy] :as this
+(deftype MoveBlockHLA [env name context nav-factory b bx by a c cx cy] :as this
     env/Action                (action-name [] name)
                               (primitive? [] false)
     env/ContextualAction      (precondition-context [s] context)
@@ -175,34 +230,37 @@
                            (contains? #{nil b} (env/get-var s ['blockat gx2 gy2])))]
             (concat
              (when (not (util/truth= fr? fr1))
-               [(make-nav-hla gx1 h nav-context) (make-specific-turn [gx1 h] fr?)])
-             [(make-nav-hla gx1 gy1 nav-context) (make-specific-get b a fr1 gx1 gy1)]
+               (conj (nav-factory gx1 h) (make-specific-turn [gx1 h] fr?)))
+             (nav-factory gx1 gy1)
+             [(make-specific-get b a fr1 gx1 gy1)]
              (when (not (util/truth= fr1 fr2))
-               [(make-nav-hla gx2 h nav-context) (make-specific-turn [gx2 h] fr1)])
-             [(make-nav-hla gx2 gy2 nav-context) (make-specific-put b c fr2 gx2 gy2)]))))
+               (conj (nav-factory gx2 h) (make-specific-turn [gx2 h] fr1)))
+             (nav-factory gx2 gy2)
+             [(make-specific-put b c fr2 gx2 gy2)]))))
       (cycle-level- [s] nil))

-(defn make-move-block-hla [env nav-context b bx by a c cx cy]
+(defn make-move-block-hla [env nav-context nav-factory b bx by a c cx cy]
   (MoveBlockHLA env ['move-block b c]
                 (into nav-context
                       ['[facingright] ['on a] ['on c] '[holding]
                        ['blockat bx by] ['blockat cx (inc cy)]])
-                nav-context b bx by a c cx cy))
+                nav-factory b bx by a c cx cy))

 (declare possible-move-refinements)

-(deftype MoveBlocksHLA [env goal-fn context nav-context block-off-limits] :as this
+(deftype MoveBlocksHLA [env goal-fn context nav-context nav-factory block-off-limits] :as this
     env/Action                (action-name [] ['move-blocks block-off-limits ])
                               (primitive? [] false)
     env/ContextualAction      (precondition-context [s] context)
     hierarchy/HighLevelAction (immediate-refinements- [s]
-                                 (possible-move-refinements env goal-fn context nav-context block-off-limits s))
+                                 (possible-move-refinements env goal-fn context nav-context
+                                                            nav-factory block-off-limits s))
                               (cycle-level- [s] 2))

 ; Note: differs from previous (strips) version in use of goal test.
 ;; TODO: should allow self-moves?
-(defn possible-move-refinements [env goal-fn context nav-context block-off-limits state]
+(defn possible-move-refinements [env goal-fn context nav-context nav-factory block-off-limits state]
   (let [[w h] (get (env/get-var state :const) '[topright])
         tops  (for [x (range 1 (inc w))]
                 [x (last (take-while #(and (<= % h) (env/get-var state ['someblockat x %])) (range 1 (inc h))))])]
@@ -214,28 +272,42 @@
            [cx cy] tops
            :let [c (env/get-var state ['blockat cx cy])]
            :when (and (< cy h) (not (= b c)))]
-       [(make-move-block-hla env nav-context
+       [(make-move-block-hla env nav-context nav-factory
                              b bx by (env/get-var state ['blockat bx (dec by)]) c cx cy)
-        (MoveBlocksHLA env goal-fn context nav-context b)]))))
-
-(deftype WarehouseTLA [env context] :as this
+        (MoveBlocksHLA env goal-fn context nav-context nav-factory b)]))))
+
+(defn make-nav-context [env]
+  (let [ [w h] (:topright env)]
+    (set (cons '[at] (for [x (range 1 (inc w)) y (range 2 (inc h))] ['someblockat x y])))))
+
+(deftype WarehouseTLA [env context nav-context nav-factory] :as this
     env/Action                (action-name [] '[top])
                               (primitive? [] false)
     env/ContextualAction      (precondition-context [s] context)
     hierarchy/HighLevelAction (immediate-refinements- [s]
-                                 (let [goal-fn (env/goal-fn env)
-                                       [w h] (get (env/get-var s :const) '[topright])]
-                                   (possible-move-refinements env goal-fn context
-                                     (set (cons '[at] (for [x (range 1 (inc w)) y (range 2 (inc h))] ['someblockat x y]))) nil s)))
+                                 (let [goal-fn (env/goal-fn env)]
+                                   (possible-move-refinements
+                                    env goal-fn context nav-context nav-factory nil s)))
                               (cycle-level- [s] nil))
-

 (defn make-warehouse-tla [env]
-  (WarehouseTLA env (util/keyset (dissoc (env/initial-state env) :const))))
+  (let [nav-context (make-nav-context env)]
+    (WarehouseTLA env (util/keyset (dissoc (env/initial-state env) :const))
+                  nav-context (fn [dx dy] [(make-simple-nav-hla dx dy nav-context)]))))

 (defn simple-warehouse-hierarchy [#^WarehouseEnv env]
   (hierarchy/SimpleHierarchicalEnv env [(make-warehouse-tla env)]))
+
+
+(defn make-warehouse-tla-fancynav [env]
+  (let [nav-context (make-nav-context env)
+        [w h]       (:topright env)]
+    (WarehouseTLA env (util/keyset (dissoc (env/initial-state env) :const))
+                  nav-context (fn [dx dy] (make-fancy-nav-plan dx dy h)))))
+
+(defn simple-warehouse-hierarchy-fancynav [#^WarehouseEnv env]
+  (hierarchy/SimpleHierarchicalEnv env [(make-warehouse-tla-fancynav env)]))

 ;; TODO: heuristic
 ;; TODO: missing precond handling && preconds ?


Call url-connect instead of just connect.

Accept URLs on --attach rather than just host/port.

--- src/clj/reply/eval_modes/nrepl.clj
+++ src/clj/reply/eval_modes/nrepl.clj
@@ -66,19 +66,20 @@
                        (binding [*print-meta* true]
                          (pr-str read-result))))))))))

-(defn get-connection [options]
-  (let [attach (:attach options)
-        [attach-port attach-host] (and attach
-                                       (reverse (.split attach ":")))
-        port (if attach-port
-               (Integer/parseInt attach-port)
-               (-> (nrepl.server/start-server :port (Integer/parseInt (or (:port options) "0")))
-                   deref
-                   :ss
-                   .getLocalPort))
-        host (or attach-host
-                 (:host options "localhost"))]
-    (nrepl/connect :host host :port port)))
+;; TODO: this could be less convoluted if we could break backwards-compat
+(defn- url-for [attach host port]
+  (if (and attach (re-find #"^\w+://" attach))
+    attach
+    (let [[port host] (if attach
+                        (reverse (.split attach ":"))
+                        [port host])]
+      (format "nrepl://%s:%s" (or host "localhost") port))))
+
+(defn get-connection [{:keys [attach host port]}]
+  (let [port (if-not attach
+               (-> (nrepl.server/start-server :port (Integer. (or port 0)))
+                   deref :ss .getLocalPort))]
+    (nrepl/url-connect (url-for attach host port))))

 (defn adhoc-eval [client session form]
   (let [results (atom "nil")]


Need to wrap listener in a function

Need to wrap listener in a function

--- src/clj/retroboard/environment.clj
+++ src/clj/retroboard/environment.clj
@@ -64,19 +64,24 @@
   (edn/read-string (wcar* (car/hget env-map eid))))

-(let [listener (car/with-new-pubsub-listener (:spec server1-conn) {})]
-  (defn subscribe-to-redis [eid ch]
-    (car/with-open-listener listener
-      (car/subscribe (channel-id eid)))
-    (swap! (:state listener) assoc (channel-id eid)
-           (fn [[type _ message]]
-             (if (= type "message")
-               (put! ch message)))))
+(let [listener (atom nil)]
+  (defn get-listener []
+    (swap! listener
+           (fn [l] (or l (car/with-new-pubsub-listener (:spec server1-conn) {}))))
+    @listener))

-  (defn unsubscribe-from-redis [eid]
-    (car/with-open-listener listener
-      (car/unsubscribe (channel-id eid)))
-    (swap! (:state listener) dissoc (channel-id eid))))
+(defn subscribe-to-redis [eid ch]
+  (car/with-open-listener (get-listener)
+    (car/subscribe (channel-id eid)))
+  (swap! (:state (get-listener)) assoc (channel-id eid)
+         (fn [[type _ message]]
+           (if (= type "message")
+             (put! ch message)))))
+
+(defn unsubscribe-from-redis [eid]
+  (car/with-open-listener (get-listener)
+    (car/unsubscribe (channel-id eid)))
+  (swap! (:state (get-listener)) dissoc (channel-id eid)))

 (defn add-subscriber [eid subscribers]
   (let [[_ subscribe-chan]


add ports authorization

add ports authorization

#58

--- src/clj/swarmpit/authorization.clj
+++ src/clj/swarmpit/authorization.clj
@@ -67,6 +67,9 @@
             {:pattern        #"^/distribution/registries/[a-zA-Z0-9]*/tags$"
              :request-method :get
              :handler        {:and [authenticated-access distribution-access]}}
+            {:pattern        #"^/distribution/registries/[a-zA-Z0-9]*/ports$"
+             :request-method :get
+             :handler        {:and [authenticated-access distribution-access]}}
             {:pattern        #"^/distribution/registries/[a-zA-Z0-9]*$"
              :request-method #{:get :delete :post}
              :handler        {:and [authenticated-access owner-access]}}
@@ -74,6 +77,9 @@
              :request-method :get
              :handler        {:and [authenticated-access distribution-access]}}
             {:pattern        #"^/distribution/dockerhub/[a-zA-Z0-9]*/tags$"
+             :request-method :get
+             :handler        {:and [authenticated-access distribution-access]}}
+            {:pattern        #"^/distribution/dockerhub/[a-zA-Z0-9]*/ports$"
              :request-method :get
              :handler        {:and [authenticated-access distribution-access]}}
             {:pattern        #"^/distribution/dockerhub/[a-zA-Z0-9]*$"


Use an update channel to trigger canvas redraws.

--- src/cljs/clj_typeshooter/main.cljs
+++ src/cljs/clj_typeshooter/main.cljs
@@ -11,6 +11,8 @@
    [cljs.core.async.macros :as m :refer [go]]))

 (def rocket (atom {:state {:speed 0 :x-coord 250 :y-coord -850}}))
+(def max-speed 5)
+(def min-speed -5)
 (def game-state (atom {:active false}))
 (def start-loop-event (new js/CustomEvent "startloop"))

@@ -33,28 +35,33 @@
   (go
    (loop []
      (let [val (<! ch)]
+       (.log js/console (str "val: " val))
        (.start (:game @game-state) update)
        (swap! game-state #(assoc % :active true))
        (.dispatchEvent (sel1 :body) start-loop-event))
      (recur))))
+
+(defn update-canvas [ch]
+  (go
+   (while (<! ch)
+     (update))))

 (defn speedometer [ch]
   (go
    (while true
      (let [val (<! ch)
            sprite (:sprite @rocket)
-           speed (+ (.getSpeed sprite) val)
+           old-speed (.getSpeed sprite)
+           ;; Increase ship speed if it's less than `max-speed'
+           speed (if (or (and (< val 0)
+                              (<= old-speed min-speed))
+                         (and (> val 0)
+                              (>= old-speed max-speed)))
+                   old-speed
+                   (+ old-speed val))
            updater #(merge % {:speed speed})]
        (.setSpeed sprite speed)
        (swap! rocket updater)))))
-
-(defn update-loop [ch]
-  (go
-   (loop []
-     (let [val (<! ch)]
-       (if (= "start" val)
-         (update)
-         (recur))))))

 ;; chan producers
 (defn handle-speed [ch update-ch event]


Handle multiple systems

Handle multiple systems

--- src/greenyet/core.clj
+++ src/greenyet/core.clj
@@ -2,21 +2,40 @@
   (:require [hiccup.core :refer [html]]))

 (def dummy-host-list [{:host "abcd1234" :environment "DEV" :system "MySystem"}
-                      {:host "xyz123" :environment "PROD" :system "MySystem"}])
+                      {:host "xyz123" :environment "PROD" :system "MySystem"}
+                      {:host "fgh456" :environment "DEV" :system "AnotherSystem"}])

-(defn- environment-entry [host-list environment]
+(defn- host-for-environment [host-list environment]
   (first (filter #(= environment (:environment %)) host-list)))
+
+(defn- system-row [environments host-list]
+  (map (fn [environment]
+         (host-for-environment host-list environment))
+       environments))
+
+(defn- environment-table [environments host-list]
+  (->> host-list
+       (group-by :system)
+       (map (fn [[_ system-host-list]]
+              (system-row environments system-host-list)))))
+
+
+(defn- environment-table-as-html [environments rows]
+  (html [:table
+         [:thead
+          [:tr
+           (cons [:td]
+                 (map (fn [env] [:td env]) environments))]]
+         [:tbody
+          (map (fn [row]
+                 [:tr
+                  (cons [:td (:system (first row))]
+                        (map (fn [host] [:td (:host host)]) row))])
+               rows)]]))
+

 (defn handler [x]
   (let [environments (distinct (map :environment dummy-host-list))
-        row (map (partial environment-entry dummy-host-list) environments)]
-    {:body (html [:table
-                  [:thead
-                   [:tr
-                    (cons [:td]
-                          (map (fn [env] [:td env]) environments))]]
-                  [:tbody
-                   [:tr
-                    (cons [:td (:system (first dummy-host-list))]
-                          (map (fn [host] [:td (:host host)]) row))]]])}))
+        rows (environment-table environments dummy-host-list)]
+    {:body (environment-table-as-html environments rows)}))


Refactor

Refactor

--- src/greenyet/poll.clj
+++ src/greenyet/poll.clj
@@ -14,22 +14,16 @@
        last-changed
        (tc/now))]))

-(defn- fetch-status-with-timeout [host timeout-in-ms callback]
-  (log/info (format "Fetching status from %s" (:status-url host)))
-  (status/fetch-status host
-                       timeout-in-ms
-                       (fn [status]
-                         (log/info (format "Received status %s from %s"
-                                           (:color status)
-                                           (:status-url host)))
-                         (callback status))))
-
 (defn- poll-status [host polling-interval-in-ms]
   (go-loop []
-    (fetch-status-with-timeout host
-                               polling-interval-in-ms
-                               (fn [status]
-                                 (swap! statuses update-status host status)))
+    (log/info (format "Fetching status from %s" (:status-url host)))
+    (status/fetch-status host
+                         polling-interval-in-ms
+                         (fn [status]
+                           (log/info (format "Received status %s from %s"
+                                             (:color status)
+                                             (:status-url host)))
+                           (swap! statuses update-status host status)))
     (<! (timeout polling-interval-in-ms))
     (recur)))


Support for -h and --help CLI options

Support for -h and --help CLI options

--- src/hurvinek/core.clj
+++ src/hurvinek/core.clj
@@ -31,7 +31,8 @@
 (def cli-options
     "Definitions of all command line options that are  currenty supported."
     ;; an option with a required argument
-    [["-p" "--port   PORT"    "port number"   :id :port]])
+    [["-p" "--port   PORT"    "port number"    :id :port]
+     ["-h" "--help"           "show this help" :id :help]])

 ; we need to load the configuration in advance so the 'app' could use it
 (def configuration (config/load-configuration "hurvinek.ini"))
@@ -65,14 +66,22 @@
         default-port
         (get-and-check-port specified-port)))

+(defn show-help
+    "Display brief help on the standard output."
+    [all-options]
+    (println "Usage:")
+    (println (:summary all-options)))
+
 (defn -main
-    "Entry point to the hurvinek server."
+    "Entry point to the Hurvinek server."
     [& args]
     (let [all-options      (cli/parse-opts args cli-options)
           options          (all-options :options)
           port             (options :port)]
           (config/print-configuration configuration)
-          (start-server    (get-port port))))
+          (if (:help options)
+              (show-help all-options)
+              (start-server (get-port port)))))

 ; finito


128MB command logs, instead of 1GB

128MB command logs, instead of 1GB

--- src/jepsen/voltdb.clj
+++ src/jepsen/voltdb.clj
@@ -56,7 +56,7 @@
        [:paths {}
         [:voltdbroot {:path base-dir}]]
        [:heartbeat {:timeout 5}] ; seconds
-       [:commandlog {:enabled true, :synchronous true}
+       [:commandlog {:enabled true, :synchronous true, :logsize 128}
         [:frequency {:time 2}]]]))) ; milliseconds

 (defn configure!


Fix pom/make-repository to work after changing deps/make-repository.

--- src/leiningen/pom.clj
+++ src/leiningen/pom.clj
@@ -97,10 +97,13 @@
       (.setClassifier classifier)
       (.setExclusions es))))

-(defn make-repository [[id url]]
-  (doto (Repository.)
-    (.setId id)
-    (.setUrl url)))
+(defn make-repository [[id settings]]
+  (let [repo (Repository.)]
+    (.setId repo id)
+    (if (string? settings)
+      (.setUrl repo settings)
+      (.setUrl repo (:url settings)))
+    repo))

 (defn make-license [{:keys [name url distribution comments]}]
   (doto (License.)


CMR-2226: Added tests to identify problems when ingesting collections in formats that are missing fields used by referencing granules.

--- system-int-test/test/cmr/system_int_test/ingest/granule_parent_dependency_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/granule_parent_dependency_test.clj
@@ -52,35 +52,70 @@
                       :end-coordinate-1 130
                       :start-coordinate-2 300
                       :end-coordinate-2 328})
-        coll1 (dc/collection {:entry-title "short_name_version"
-                              :short-name "short_name"
-                              :version-id "version"
-                              :product-specific-attributes [psa1]
-                              :platforms [p1]
-                              :organizations [(dc/org :distribution-center "Larc")]
-                              :science-keywords [(dc/science-keyword {:category "upcase"
-                                                                      :topic "Cool"
-                                                                      :term "Mild"})]
-                              :projects projects
-                              :spatial-coverage (dc/spatial {:gsr :geodetic})
-                              :two-d-coordinate-systems [two-d-cs]
-                              :related-urls [(dc/related-url {:type "type" :url "htt://www.foo.com"})]
-                              :beginning-date-time "1965-12-12T07:00:00.000-05:00"
-                              :ending-date-time "1967-12-12T07:00:00.000-05:00"})
+        coll-data {:entry-title "short_name1_version"
+                   :short-name "short_name1"
+                   :version-id "version"
+                   :product-specific-attributes [psa1]
+                   :platforms [p1]
+                   :organizations [(dc/org :distribution-center "Larc")]
+                   :science-keywords [(dc/science-keyword {:category "upcase"
+                                                           :topic "Cool"
+                                                           :term "Mild"})]
+                   :projects projects
+                   :spatial-coverage (dc/spatial {:gsr :geodetic})
+                   :two-d-coordinate-systems [two-d-cs]
+                   :related-urls [(dc/related-url {:type "type" :url "htt://www.foo.com"})]
+                   :beginning-date-time "1965-12-12T07:00:00.000-05:00"
+                   :ending-date-time "1967-12-12T07:00:00.000-05:00"}
+        gran-data {:platform-refs [pr1]
+                   :spatial-coverage gran-spatial-rep
+                   :two-d-coordinate-system g-two-d-cs
+                   :product-specific-attributes [gpsa]
+                   :beginning-date-time "1966-12-12T07:00:00.000-05:00"
+                   :ending-date-time "1967-10-12T07:00:00.000-05:00"}
+        coll1 (dc/collection coll-data)
         _ (d/ingest "PROV1" coll1 {:format :echo10})
-        gran1 (dg/granule coll1 {:platform-refs [pr1]
-                                 :spatial-coverage gran-spatial-rep
-                                 :two-d-coordinate-system g-two-d-cs
-                                 :product-specific-attributes [gpsa]
-                                 :beginning-date-time "1966-12-12T07:00:00.000-05:00"
-                                 :ending-date-time "1967-10-12T07:00:00.000-05:00"})
-        _ (d/ingest "PROV1" gran1)]
-    (let [resp (d/ingest "PROV1" coll1 {:format :dif :allow-failure? true})]
-      (is (= nil (:errors resp))))
-    (let [resp (d/ingest "PROV1" coll1 {:format :dif10 :allow-failure? true})]
-      (is (= nil (:errors resp))))
-    (let [resp (d/ingest "PROV1" coll1 {:format :iso19115 :allow-failure? true})]
-      (is (= nil (:errors resp))))
-    (let [resp (d/ingest "PROV1" coll1 {:format :iso-smap :allow-failure? true})]
-      (is (= nil (:errors resp))))))
+        coll2 (dc/collection (assoc coll-data :entry-title "short_name2_version"
+                                    :short-name "short_name2"
+                                    :entry-id "short_name2_version"))
+        _ (d/ingest "PROV1" coll2 {:format :dif})
+        coll3 (dc/collection (assoc coll-data :entry-title "short_name3_version"
+                                    :short-name "short_name3"
+                                    :entry-id "short_name3_version"))
+        _ (d/ingest "PROV1" coll3 {:format :dif10})
+        coll4 (dc/collection (assoc coll-data :entry-title "short_name4_version"
+                                    :short-name "short_name4"
+                                    :entry-id "short_name4_version"))
+        _ (d/ingest "PROV1" coll4 {:format :iso19115})
+        coll5 (dc/collection (assoc coll-data :entry-title "short_name5_version"
+                                    :short-name "short_name5"
+                                    :entry-id "short_name5_version"))
+        _ (d/ingest "PROV1" coll5 {:format :iso-smap})
+        gran1 (dg/granule coll1 gran-data)
+        gran2 (dg/granule coll2 gran-data)
+        gran3 (dg/granule coll3 gran-data)
+        gran4 (dg/granule coll4 gran-data)
+        gran5 (dg/granule coll5 gran-data)]
+    (are [exp-errors gran]
+         (= exp-errors
+            (flatten (map (fn [error] (:errors error))
+                          (:errors (d/ingest "PROV1" gran {:format :echo10 :allow-failure? true})))))

+         []
+         gran1
+
+         ["The following list of 2D Coordinate System names did not exist in the referenced parent collection: [BRAVO]."]
+         gran2
+
+         ["The following list of 2D Coordinate System names did not exist in the referenced parent collection: [BRAVO]."]
+         gran3
+
+         ["The following list of 2D Coordinate System names did not exist in the referenced parent collection: [BRAVO]."
+          "The following list of Product Specific Attributes did not exist in the referenced parent collection: [a-float]."
+          "[Geometries] cannot be set when the parent collection's GranuleSpatialRepresentation is NO_SPATIAL"]
+         gran4
+
+         ["The following list of 2D Coordinate System names did not exist in the referenced parent collection: [BRAVO]."
+          "The following list of Product Specific Attributes did not exist in the referenced parent collection: [a-float]."
+          "[Geometries] cannot be set when the parent collection's GranuleSpatialRepresentation is NO_SPATIAL"]
+         gran5)))


Re-enable queryable state manager.

Re-enable queryable state manager.

--- src/onyx/peer/queryable_state_manager.clj
+++ src/onyx/peer/queryable_state_manager.clj
@@ -4,6 +4,7 @@
             [com.stuartsierra.component :as component]
             [onyx.peer.window-state :as ws]
             [onyx.state.protocol.db :as db]
+            [onyx.peer.grouping :as g]
             [taoensso.timbre :refer [fatal info]])
   (:import [java.util.concurrent.locks LockSupport]))

@@ -20,7 +21,6 @@

 (defmulti process-store
   (fn [[cmd] _ _]
-    ;(println "CMD" cmd)
     cmd))

 ; (defn drop-prior-db [st event]
@@ -44,15 +44,16 @@
     (assoc-in st
               (state-key replica-version event)
               {:state-indices (ws/state-indices event)
+               :grouped? (g/grouped-task? (:onyx.core/task-map event))
                :db (db/open-db-reader peer-config exported serializers)})))

 (defmethod process-store :created-db
   [[_ replica-version event exported] state peer-config]
-  #_(swap! state add-new-db event replica-version peer-config exported))
+  (swap! state add-new-db event replica-version peer-config exported))

 (defmethod process-store :drop-db
   [[_ replica-version event] state peer-config]
-  #_(let [serializers (onyx.state.serializers.utils/event->state-serializers event)
+  (let [serializers (onyx.state.serializers.utils/event->state-serializers event)
         k (state-key replica-version event)
         store (get @state k)]
     (dissoc-db state event replica-version)
@@ -63,7 +64,6 @@
     (when-not @shutdown
       (if-let [cmd (poll! ch)]
         (do
-         ;(println "CMD" cmd)
          (process-store cmd state peer-config))
         (LockSupport/parkNanos (* 10 1000000)))
       (recur))))


Re-adding the bytes conversion function

Re-adding the bytes conversion function

For blob output, but you don't want to do this conversion for every blob
(hence why not adding it in the dispatch above). Some of those will be
other datatypes kept in Cassandra as Blob types, so the user should be
allowed to change them later.

--- src/clojure/clojurewerkz/cassaforte/conversion.clj
+++ src/clojure/clojurewerkz/cassaforte/conversion.clj
@@ -49,3 +49,10 @@
                                       :address    (.getHostAddress (.getAddress host))
                                       :rack       (.getRack host)})
     :else                          java-val))
+
+(defn #^bytes to-bytes
+  [^ByteBuffer byte-buffer]
+  (let [bytes (byte-array (.remaining byte-buffer))]
+    (.get byte-buffer bytes 0 (count bytes))
+    bytes))
+


added save and restoration of lines generated by turtle; reworked save and restoration of bitmap so that old bitmap will be reused only if it's dimensions match exactly with screen dimensions, otherwise new bitmap will be drawn from scratch;

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -15,8 +15,7 @@
                                 onDestroy superOnDestroy
                                 onBackPressed superOnBackPressed
                                 onActivityResult superOnActivityResult
-                                onSaveInstanceState superOnSaveInstanceState
-                                onRestoreInstanceState superOnRestoreInstanceState}
+                                onSaveInstanceState superOnSaveInstanceState}
               :state ^{:tag ActivityState} state
               :init init
               :constructors {[] []})
@@ -375,6 +374,87 @@

+(def save-state-config
+  (letfn [(save-matrix [activity-key
+                        key
+                        ^org.turtle.geometry.TurtleGraphics activity
+                        ^Bundle bundle]
+            (let [values (float-array 9 0)]
+              (.getValues ^Matrix (get-in @activity activity-key) values)
+              (.putFloatArray bundle key values)))
+          (restore-matrix [activity-key
+                           key
+                           ^org.turtle.geometry.TurtleGraphics activity
+                           ^Bundle bundle]
+            (let [m (Matrix.)]
+              (.setValues m (.getFloatArray bundle key))
+              (swap! (.state activity) assoc-in
+                     activity-key
+                     m)))]
+    [["intermediate-bitmap"
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (let [bitmap (get-in @activity
+                             [:draw-state :intermediate-bitmap])]
+          (.putParcelable bundle key bitmap)))
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (let [bitmap (.getParcelable bundle key)]
+          (swap! (.state activity) assoc-in
+                 [:draw-state :intermediate-bitmap]
+                 bitmap)))]
+     ["turtle-lines"
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (let [lines (get-in @activity [:turtle-state :lines])]
+          (.putFloatArray bundle
+                          (str key "-coords")
+                          (into-array Float/TYPE
+                                      (flatten
+                                       (map (fn [[p1 p2 _]] [p1 p2]) lines))))
+          (.putIntArray bundle
+                        (str key "-colors")
+                        (into-array Integer/TYPE
+                                    (map (fn [[_ _ color]] color) lines)))))
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (let [flat-pts (.getFloatArray bundle (str key "-coords"))
+              pts (vec (map vec (partition 2 (map vec (partition 2 flat-pts)))))
+              colors (vec (.getIntArray bundle (str key "-colors")))
+              res-lines (map (fn [pts color] (conj pts color)) pts colors)]
+          (swap! (.state activity) assoc-in
+                 [:turtle-state :lines]
+                 res-lines)))]
+     ["program-source"
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (.putString bundle
+                    key
+                    (str (.getText (program-source-editor @activity)))))
+      (fn [key
+           ^org.turtle.geometry.TurtleGraphics activity
+           ^Bundle bundle]
+        (.setText (program-source-editor @activity)
+                  (.getString bundle key)))]
+     ["turtle-view-transform"
+      #(save-matrix [:draw-area-view-transform] %1 %2 %3)
+      #(restore-matrix [:draw-area-view-transform] %1 %2 %3)]
+     ["intermediate-transform"
+      #(save-matrix [:intermediate-transform] %1 %2 %3)
+      #(restore-matrix [:intermediate-transform] %1 %2 %3)]]))
+
+(defn -onSaveInstanceState [^org.turtle.geometry.TurtleGraphics this
+                            ^Bundle bundle]
+  (.superOnSaveInstanceState this bundle)
+  (doseq [[key save _] save-state-config]
+    (save key this bundle)))
+
+
 (defn -onCreate [^org.turtle.geometry.TurtleGraphics this
                  ^Bundle bundle]
   (reset! *activity* this)
@@ -537,14 +617,10 @@
   (.setText (program-source-editor @this)
             ;; "(doseq [r [1 1.5 2 2.5 3]]\n  (dotimes [_ 360]\n    (forward r)\n    (left 1)))"
             "(forward 100)\n(left 90)\n(forward 100)\n")
-  ;; (.setOnTouchListener (program-source-editor @this)
-  ;;
-  ;;                      (make-double-tap-handler
-  ;;                       (fn [] (log "Double tapped source editor twice"))))
-  ;; (.setOnTouchListener (error-output @this)
-  ;;                      (make-double-tap-handler
-  ;;                       (fn [] (log "Double tapped error output twice"))))
-  )
+
+  (when bundle
+    (doseq [[key _ restore] save-state-config]
+      (restore key this bundle))))

 (defn ^boolean -onCreateOptionsMenu [^org.turtle.geometry.TurtleGraphics this
                                      ^Menu menu]
@@ -668,77 +744,6 @@
      ;; ignore it
      nil)))

-(def save-state-config
-  (letfn [(save-matrix [activity-key
-                        key
-                        ^org.turtle.geometry.TurtleGraphics activity
-                        ^Bundle bundle]
-            (let [values (float-array 9 0)]
-              (.getValues ^Matrix (get-in @activity activity-key) values)
-              (.putFloatArray bundle key values)))
-          (restore-matrix [activity-key
-                           key
-                           ^org.turtle.geometry.TurtleGraphics activity
-                           ^Bundle bundle]
-            (let [m (Matrix.)]
-              (.setValues m (.getFloatArray bundle key))
-              (swap! (.state activity) assoc-in
-                     activity-key
-                     m)))]
-    [["intermediate-bitmap"
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (.putParcelable bundle key (get-in @activity
-                                           [:draw-state :intermediate-bitmap])))
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (swap! (.state activity) assoc-in
-               [:draw-state :intermediate-bitmap]
-               (.getParcelable bundle key)))]
-     ["program-source"
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (.putString bundle key (str (.getText (program-source-editor @activity)))))
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (.setText (program-source-editor @activity)
-                  (.getString bundle key)))]
-     ["turtle-view-transform"
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (save-matrix [:draw-area-view-transform] key activity bundle))
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (restore-matrix [:draw-area-view-transform] key activity bundle))]
-     ["intermediate-transform"
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (save-matrix [:intermediate-transform] key activity bundle))
-      (fn [key
-           ^org.turtle.geometry.TurtleGraphics activity
-           ^Bundle bundle]
-        (restore-matrix [:intermediate-transform] key activity bundle))]]))
-
-
-(defn -onSaveInstanceState [^org.turtle.geometry.TurtleGraphics this
-                            ^Bundle bundle]
-  (.superOnSaveInstanceState this bundle)
-  (doseq [[key save _] save-state-config]
-    (save key this bundle)))
-
-(defn -onRestoreInstanceState [^org.turtle.geometry.TurtleGraphics this
-                               ^Bundle bundle]
-  (.superOnRestoreInstanceState this bundle)
-  (doseq [[key _ restore] save-state-config]
-    (restore key this bundle)))
-

 (defn clear-intermed-bitmap [^org.turtle.geometry.TurtleGraphics this]
   (when-let [intermed-canvas (get-in @this [:draw-state :draw-canvas])]
@@ -750,12 +755,13 @@
                        width
                        height]
   (log "surfaceChanged")
-  (let [new-bitmap
-        (if-let [interm-bitmap (get-in @this [:draw-state :intermediate-bitmap])]
-          (Bitmap/createScaledBitmap interm-bitmap
-                                     width
-                                     height
-                                     true)
+  (let [interm-bitmap ^Bitmap (get-in @this [:draw-state :intermediate-bitmap])
+        use-old-bitmap? (and (not (nil? interm-bitmap))
+                             (= width (.getWidth interm-bitmap))
+                             (= height (.getHeight interm-bitmap)))
+        new-bitmap
+        (if use-old-bitmap?
+          interm-bitmap
           (Bitmap/createBitmap width height
                                Bitmap$Config/ARGB_8888))
         canvas (Canvas. new-bitmap)]
@@ -766,7 +772,8 @@
            :surface-available? true
            :intermediate-bitmap new-bitmap
            :draw-canvas canvas)
-    (.drawColor canvas Color/WHITE)
+    (when-not use-old-bitmap?
+      (redraw-indermed-bitmap this))
     (draw-scene this)))

 (defn -surfaceCreated [^org.turtle.geometry.TurtleGraphics this


make prep+article more visible and simply a data structure rather than code

--- src/babel/italiano/morphology.cljc
+++ src/babel/italiano/morphology.cljc
@@ -1197,60 +1197,62 @@
      true
      expr)))

+(def preposition-plus-article
+  [[#"\ba il "  "al "]
+   [#"\ba lo "  "allo "]
+   [#"\ba la "  "alla "]
+   [#"\ba l'"   "all'"]
+   [#"\ba i "   "ai "]
+   [#"\ba gli " "agli "]
+   [#"\ba le "  "alle "]
+
+   [#"\bda il "  "dal "]
+   [#"\bda lo "  "dallo "]
+   [#"\bda la "  "dalla "]
+   [#"\bda l'"   "dall'"]
+   [#"\bda i "   "dai "]
+   [#"\bda gli " "dagli "]
+   [#"\bda le "  "dalle "]
+
+   [#"\bde il "  "del "]
+   [#"\bde lo "  "dello "]
+   [#"\bde la "  "della "]
+   [#"\bde l'"   "dell'"]
+   [#"\bde i "   "dei "]
+   [#"\bde gli " "degli "]
+   [#"\bde le "  "delle "]
+
+   [#"\bdi il "  "del "]
+   [#"\bdi lo "  "dello "]
+   [#"\bdi la "  "della "]
+   [#"\bdi l'"   "dell'"]
+   [#"\bdi i "   "dei "]
+   [#"\bdi gli " "degli "]
+   [#"\bdi le "  "delle "]
+
+   [#"\bin il "  "nel "]
+   [#"\bin lo "  "nello "]
+   [#"\bin la "  "nella "]
+   [#"\bin l'"   "nell'"]
+   [#"\bin i "   "nei "]
+   [#"\bin gli " "negli "]
+   [#"\bin le "  "nelle "]
+
+   [#"\bsu il "  "sul "]
+   [#"\bsu lo "  "sullo "]
+   [#"\bsu la "  "sulla "]
+   [#"\bsu l'"   "sull'"]
+   [#"\bsu i "   "sui "]
+   [#"\bsu gli " "sugli "]
+   [#"\bsu le "  "sulle "]
+      ])
+
 (defn conjugate-italian-prep [prep np]
   (let [concat (str (get prep :italiano)
                     " "
                     (get np :italiano))]
     (replace-from-list
-     (list
-      (list #"\ba il " "al ")
-      (list #"\ba lo " "allo ")
-      (list #"\ba la " "alla ")
-      (list #"\ba l'" "all'")
-      (list #"\ba i " "ai ")
-      (list #"\ba gli " "agli ")
-      (list #"\ba le " "alle ")
-
-      (list #"\bda il " "dal ")
-      (list #"\bda lo " "dallo ")
-      (list #"\bda la " "dalla ")
-      (list #"\bda l'" "dall'")
-      (list #"\bda i " "dai ")
-      (list #"\bda gli " "dagli ")
-      (list #"\bda le " "dalle ")
-
-      (list #"\bde il " "del ")
-      (list #"\bde lo " "dello ")
-      (list #"\bde la " "della ")
-      (list #"\bde l'" "dell'")
-      (list #"\bde i " "dei ")
-      (list #"\bde gli " "degli ")
-      (list #"\bde le " "delle ")
-
-      (list #"\bdi il " "del ")
-      (list #"\bdi lo " "dello ")
-      (list #"\bdi la " "della ")
-      (list #"\bdi l'" "dell'")
-      (list #"\bdi i " "dei ")
-      (list #"\bdi gli " "degli ")
-      (list #"\bdi le " "delle ")
-
-      (list #"\bin il " "nel ")
-      (list #"\bin lo " "nello ")
-      (list #"\bin la " "nella ")
-      (list #"\bin l'" "nell'")
-      (list #"\bin i " "nei ")
-      (list #"\bin gli " "negli ")
-      (list #"\bin le " "nelle ")
-
-      (list #"\bsu il " "sul ")
-      (list #"\bsu lo " "sullo ")
-      (list #"\bsu la " "sulla ")
-      (list #"\bsu l'" "sull'")
-      (list #"\bsu i " "sui ")
-      (list #"\bsu gli " "sugli ")
-      (list #"\bsu le " "sulle ")
-      )
+     preposition-plus-article
      concat)))

 (defn analyze-regular [surface-form lexicon]


Deleting a job now stops it running.  If all jobs are killed then the whole batch terminates.

--- src/marcgrep/core.clj
+++ src/marcgrep/core.clj
@@ -174,13 +174,15 @@
         (let [record (.take queue)]
           (if (= record :eof)
             (.put queue :eof)
-            (do (doseq [job jobs]
-                  (swap! job update-in [:records-checked] inc)
-                  (when ((:query @job) record)
-                    (swap! job update-in [:hits] inc)
-                    (locking (outputs job)
-                      (.write (outputs job) record))))
-                (recur)))))
+            (when-let [jobs (seq (filter (fn [job] (not= (:status @job) :deleted))
+                                         jobs))]
+              (doseq [job jobs]
+                (swap! job update-in [:records-checked] inc)
+                (when ((:query @job) record)
+                  (swap! job update-in [:hits] inc)
+                  (locking (outputs job)
+                    (.write (outputs job) record))))
+              (recur)))))
       (catch Throwable ex
         (.printStackTrace ex)))))

@@ -214,9 +216,14 @@
       (with-open [marc-records ((ns-resolve (:marc-backend @config )
                                             'all-marc-records)
                                 config)]
-        (doseq [record (take-while identity (repeatedly #(.next marc-records)))]
+        (doseq [record (take-while (fn [record]
+                                     (and (not-every? future-done? workers)
+                                          record))
+                                   (repeatedly #(.next marc-records)))]
           (.put queue record))
-        (.put queue :eof))
+
+        (when (not-every? future-done? workers)
+          (.put queue :eof)))

       (doseq [worker workers] @worker))

@@ -281,6 +288,8 @@
     (when (:file @job)
       (.delete (:file @job)))

+    (swap! job assoc :status :deleted)
+
     (swap! job-queue #(remove #{job} %)))
   id)


fix for vertex conversion in funimage.mesh

--- src/funimage/mesh.clj
+++ src/funimage/mesh.clj
@@ -10,9 +10,9 @@
   "Convert a Vertex to Vector3D."
   [vtx]
   (org.apache.commons.math3.geometry.euclidean.threed.Vector3D.
-    (.x vtx)
-    (.y vtx)
-    (.z vtx)))
+    (.getX vtx)
+    (.getY vtx)
+    (.getZ vtx)))

 (defn marching-cubes
   "Convenience function for marching cubes."


Implement bank detection by reading the first line of the file (the columns of the csv), taking a hash from it and comparing that to the known bank hashes

--- src/clj/my_money/routes/upload.clj
+++ src/clj/my_money/routes/upload.clj
@@ -4,7 +4,8 @@
             [my-money.op-csv :refer :all]
             [clj-time.jdbc]
             [compojure.core :refer [defroutes POST]]
-            [ring.util.http-response :as response]))
+            [ring.util.http-response :as response]
+            [clojure.java.io :as io]))

 (defn ->event [user-id raw-data]
   {:transaction-id (:Arkistointitunnus raw-data)
@@ -31,6 +32,28 @@
 (defn ->events [x]
   (map (partial ->event 1) x))

+(def op-first-line-hash 96410471)
+
+(def s-pankki-first-line-hash -1695375124)
+
+(defn detect-bank
+  "Takes column line as a string from a csv file and checks if it matches some known bank file"
+  [column-line]
+  (cond
+    (= s-pankki-first-line-hash (hash column-line)) :spankki
+    (= op-first-line-hash (hash column-line)) :op
+    :else :not-found))
+
+(defn detect-bank-from-file
+  "Reads the first line of the file in the given path
+  and based on it tries to detech what bank the file is from."
+  [filepath]
+  (with-open [reader (io/reader filepath)]
+    (-> reader
+        line-seq
+        first
+        detect-bank)))
+
 (defroutes upload-routes
   (POST "/upload" [file :as req]
     (let [user-id (:id (db/get-user-by-username {:username (:identity req)}))


Fix cross-process completion

Fix cross-process completion

This was undone by the jline overhaul.

--- src/clj/reply/eval_modes/nrepl.clj
+++ src/clj/reply/eval_modes/nrepl.clj
@@ -20,6 +20,8 @@
 (def current-session (atom nil))
 (def current-ns (atom (str *ns*)))

+(def completion-eval-fn (atom (constantly ())))
+
 (defn handle-client-interruption! [client]
   (signals/set-signal-handler!
     "INT"
@@ -40,7 +42,7 @@

 (defn make-completer [ns]
   (fn [reader]
-    (let [eval-fn reply.initialization/eval-in-user-ns
+    (let [eval-fn @completion-eval-fn
           redraw-line-fn (fn []
                            (.redrawLine reader)
                            (.flush reader))]
@@ -216,6 +218,8 @@
     (swap! response-queues assoc
            session (LinkedBlockingQueue.)
            completion-session (LinkedBlockingQueue.))
+    (reset! completion-eval-fn
+            (partial completion-eval client completion-session))
     (let [options (assoc options :prompt
                     (fn [ns] (str ns "=> ")))
           options (if (:color options)


Deploy error when service have healthcheck #469

--- src/cljc/swarmpit/routes_spec.cljc
+++ src/cljc/swarmpit/routes_spec.cljc
@@ -181,7 +181,7 @@
    :user            string?
    :dir             string?
    :tty             boolean?
-   :healthcheck     {:test     string?
+   :healthcheck     {:test     [string?]
                      :interval number?
                      :timeout  number?
                      :retries  number?}
@@ -280,7 +280,7 @@
    (ds/opt :user)            string?
    (ds/opt :dir)             string?
    (ds/opt :tty)             boolean?
-   (ds/opt :healthcheck)     {:test     string?
+   (ds/opt :healthcheck)     {:test     [string?]
                               :interval number?
                               :timeout  number?
                               :retries  number?}


Remove useless whitespace.

Remove useless whitespace.

--- src/clojure/catacumba/impl/sse.clj
+++ src/clojure/catacumba/impl/sse.clj
@@ -17,7 +17,6 @@
            org.reactivestreams.Subscriber
            org.reactivestreams.Subscription
            catacumba.impl.context.DefaultContext))
-

 (defprotocol IEvent
   (^:private event [_] "Create a event"))


Restore static metadata to Core.getStage gen-class method.

--- src/clojure/uk/org/il2ssd/core.clj
+++ src/clojure/uk/org/il2ssd/core.clj
@@ -14,7 +14,7 @@
   (:gen-class :name uk.org.il2ssd.Core
               :extends javafx.application.Application
               :main true
-              :methods[[getStage [] javafx.stage.Stage]]))
+              :methods [#^{:static true} [getStage [] javafx.stage.Stage]]))

 (defn -getStage
   "### -getStage