close channels to avoid thread leaks

close channels to avoid thread leaks

--- clj-tcp/src/clj_tcp/client.clj
+++ clj-tcp/src/clj_tcp/client.clj
@@ -2,7 +2,7 @@
    (:require [clojure.tools.logging :refer [info error]]
              [clj-tcp.codec :refer [byte-decoder default-encoder buffer->bytes]]
              [clojure.core.async.impl.protocols :as asyncp]
-             [clojure.core.async :refer [chan >!! go >! <! <!! thread timeout alts!! dropping-buffer sliding-buffer]])
+             [clojure.core.async :refer [chan >!! go >! <! <!! thread timeout alts!! dropping-buffer sliding-buffer close!]])
    (:import

             [clj_tcp.util PipelineUtil]
@@ -49,7 +49,7 @@
 ;by default all clients will share this event loop group
 (defonce ^NioEventLoopGroup EVENT-LOOP-GROUP (NioEventLoopGroup. (get-default-threads) (DefaultThreadFactory. "global-netty-nio-events" true)))

-(defn close-client [{:keys [^NioEventLoopGroup group ^NioEventLoopGroup read-group ^ChannelFuture channel-f]}]
+(defn close-client [{:keys [^NioEventLoopGroup group ^NioEventLoopGroup read-group ^ChannelFuture channel-f internal-error-ch write-ch]}]
       (let [^Channel channel (.channel channel-f)]

            ;only shutdown the event loop groups if they are uniquely created for the connection
@@ -61,7 +61,8 @@

            (.await ^ChannelFuture (.disconnect channel))
            (.await ^ChannelFuture (.close channel))
-           ))
+           (close! write-ch)
+           (close! internal-error-ch)))

 (defn close-all [{:keys [group closed] :as conf}]
@@ -215,7 +216,8 @@
   (catch Exception e (do
                        (error e e)
                        (>!! internal-error-ch [e 1])
-                       nil)))))
+                       nil
+                       )))))

 (defn read-print-ch [n ch]
   (go
@@ -287,7 +289,7 @@
 		              (do
                            (write-poison local-client)
 			               (.set ^AtomicBoolean (:closed local-client) true)
-			               (>!! error-ch [v o]) ;send the error channel)
+			               (>!! error-ch [v o])) ;send the error channel)
                 (catch Exception e (error e e))))
              (do
 		          (if (instance? Poison v)
@@ -366,7 +368,7 @@
 	                      )))))

-		    client))
+		    client))


unique successor ... qed

unique successor ... qed

--- src/latte/int.clj
+++ src/latte/int.clj
@@ -43,28 +43,6 @@
         :by ((rel/bijective-is-surjective int int succ) (succ-bijective)))
   (qed ((a) y)))

-(defthm single-succ-
-  "An integer `y` is the successor *at most* another integer."
-  [[y int]]
-  (forall [x1 x2 int]
-    (==> (equal int ((succ) x1) y)
-         (equal int ((succ) x2) y)
-         (equal int ((succ) x1) ((succ) x2)))))
-;; there is a problem with:
-;; (q/single int (lambda [x int] (equal int ((succ) x) y))))
-
-(proof single-succ- :script
-  (assume [x1 int
-           x2 int
-           u1 (equal int ((succ) x1) y)
-           u2 (equal int ((succ) x2) y)]
-    (have a (equal int y ((succ) x2)) :by ((eq/eq-sym int ((succ) x2) y) u2))
-    (have b (equal int ((succ) x1) ((succ) x2))
-          :by ((eq/eq-trans int ((succ) x1) y ((succ) x2))
-               u1 (a)))
-    (qed b)))
-
-
 (defthm single-succ
   "An integer `y` is the successor *at most* another integer."
   [[y int]]
@@ -79,67 +57,22 @@
     (have b (equal int ((succ) x1) ((succ) x2))
           :by ((eq/eq-trans int ((succ) x1) y ((succ) x2))
                H1 (a)))
-    (have c (==> ((lambda [x int] (equal int ((succ) x) y)) x2)
-                 (equal int ((succ) x1) ((succ) x2))) :discharge [H2 (b)])
-    (have d (==> ((lambda [x int] (equal int ((succ) x) y)) x1)
-                 ((lambda [x int] (equal int ((succ) x) y)) x2)
-                 (equal int ((succ) x1) ((succ) x2))) :discharge [H1 (c)])
-    (have e _ :discharge [x2 (d)])
-    (have f _ ;(q/single int (lambda [x int] (equal int ((succ) x) y)))
-          :discharge [x1 (e)]))
-  (qed f))
-
-
-(latte.kernel.norm/beta-delta-eq? {}
- (latte/term
-  [y int]
-  (forall [x1 x2 int]
-    (==> (equal int ((succ) x1) y)
-         (equal int ((succ) x2) y)
-         (equal int ((succ) x1) ((succ) x2)))))
- (latte/term
-  [y int]
-  (q/single int (lambda [x int] (equal int ((succ) x) y)))))
-
-(latte.kernel.norm/beta-delta-eq?
- {}
- (latte/term
-  [y int]
-  (forall [x1 x2 int]
-    (==> (equal int ((succ) x1) y)
-         (equal int ((succ) x2) y)
-         (equal int ((succ) x1) ((succ) x2)))))
- (latte/term
-  [y int]
-  (forall [x1 x2 int]
-    (==> ((lambda [x int] (equal int ((succ) x) y)) x1)
-         ((lambda [x int] (equal int ((succ) x) y)) x2)
-         (equal int ((succ) x1) ((succ) x2))))))
-
-;; this is probably a bug ...
-(latte.kernel.norm/beta-delta-eq?
- {}
- (latte/term
-  [y int]
-  (forall [x1 x2 int]
-    (==> ((lambda [x int] (equal int ((succ) x) y)) x1)
-         ((lambda [x int] (equal int ((succ) x) y)) x2)
-         (equal int ((succ) x1) ((succ) x2)))))
- (latte/term
-  [y int]
-  (q/single int (lambda [x int] (equal int ((succ) x) y)))))
-
-
-;; (definition single
-;;   "The constraint that \"there exists at most\"..."
-;;   [[T :type] [P (==> T :type)]]
-;;   (forall [x y T]
-;;     (==> (P x)
-;;          (P y)
-;;          (equal T x y))))
-
+    (have c (rel/injective int int succ)
+                                        ;(forall [x y int]
+                                        ;  (==> (equal int ((succ) x) ((succ y)))
+                                        ;       (equal int x y)))
+          :by ((rel/bijective-is-injective int int succ) (succ-bijective)))
+    (have d (equal int x1 x2) :by ((c) x1 x2 (b)))
+    (qed d)))

 (defthm unique-succ
   "There is a unique successor to an integer `y`."
-  [y int]
-  (q/unique int (lambda [x int] (equal int ((succ) x) y))))
+  [[y int]]
+  (q/unique int (lambda [x int] (equal int ((succ) x) y))))
+
+(proof unique-succ :script
+  (qed ((p/and-intro (q/ex int (lambda [x int] (equal int ((succ) x) y)))
+                     (q/single int (lambda [x int] (equal int ((succ) x) y))))
+        (exist-succ y)
+        (single-succ y))))
+


Provide file-based cache persistence [IMMUTANT-116]

--- modules/cache/src/main/clojure/immutant/cache/core.clj
+++ modules/cache/src/main/clojure/immutant/cache/core.clj
@@ -17,6 +17,7 @@

 (ns ^{:no-doc true} immutant.cache.core
     (:require [immutant.registry :as registry]
+              [clojure.java.io :as io]
               [clojure.tools.logging :as log])
     (:import [org.infinispan.configuration.cache ConfigurationBuilder VersioningScheme CacheMode]
              [org.infinispan.transaction TransactionMode LockingMode]
@@ -26,6 +27,7 @@

 (def clustered-manager (registry/get "jboss.infinispan.web"))
 (def local-manager (delay (DefaultCacheManager.)))
+(def file-store-path (str (io/file (System/getProperty "jboss.server.data.dir") "immutant-cache-persist")))

 (defn cache-mode
   [{:keys [mode sync]}]
@@ -54,7 +56,7 @@
   builder)

 (defn build-config
-  [{:keys [locking template] :as opts}]
+  [{:keys [locking template persist] :as opts}]
   (let [builder (ConfigurationBuilder.)]
     (if template (.read builder template))
     (.classLoader builder (.getContextClassLoader (Thread/currentThread)))
@@ -63,6 +65,9 @@
         (transactionMode TransactionMode/TRANSACTIONAL))
     (.. builder clustering
         (cacheMode (cache-mode opts)))
+    (if persist
+      (let [store (.. builder loaders addFileCacheStore)]
+        (.. store (location (if (string? persist) persist file-store-path)))))
     (cond
       (= locking :pessimistic) (set-pessimistic-locking! builder)
       (= locking :optimistic) (set-optimistic-locking! builder)


fix classpath-js reload

fix classpath-js reload

didn't work properly for closure goog.provide/goog.module files

--- src/main/shadow/cljs/devtools/server/reload_classpath.clj
+++ src/main/shadow/cljs/devtools/server/reload_classpath.clj
@@ -42,15 +42,23 @@
              (filter #(contains? @bm/reloadable-macros-ref %))
              (into #{}))

+        add-ns
+        (fn [result event ns]
+          (-> result
+              (update :namespaces conj ns)
+              (update event conj ns)))
+
         ns-updates
         (reduce
           (fn [result {:keys [event name]}]
-            (let [ns (if (util/is-cljs-file? name)
-                       (util/filename->ns name)
-                       (symbol (ModuleNames/fileToModuleName name)))]
-              (-> result
-                  (update :namespaces conj ns)
-                  (update event conj ns))))
+            (-> result
+                (add-ns event (util/filename->ns name))
+                ;; JS file might be old style goog.provide/goog.module with regular js
+                ;; or ESM with generic name, so add both. engine will look at the file
+                ;; later and find the correct one
+                (cond->
+                  (util/is-js-file? name)
+                  (add-ns event (symbol (ModuleNames/fileToModuleName name))))))
           {:namespaces #{}
            :mod #{}
            :del #{}


Revert to "->" delimiter in the help output

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/core.clj
+++ src/obcc/core.clj
@@ -81,7 +81,7 @@
                options-summary
                ""
                "Actions:"
-               (map (fn [[_ {:keys [name desc]}]] (str "  " name ": " desc)) subcommands)
+               (map (fn [[_ {:keys [name desc]}]] (str "  " name " -> " desc)) subcommands)
                ""
                ]))


Macros: Notes.

Macros: Notes.

--- test/com/nomistech/clojure_the_language/macros/examples.clj
+++ test/com/nomistech/clojure_the_language/macros/examples.clj
@@ -74,7 +74,7 @@
         (do (println "x is large") :large)
         (do (println "x is small") :small)))

-;;;; Why would you use this?
+;;;; Why would you use `if-not`?

 ;;;; Given...

@@ -100,9 +100,6 @@
      and
      pieces))

-;;;; Is this a good use of macros?
-;;;; - See `our-if-not-2` later.
-
 ;;;; ___________________________________________________________________________
 ;;;; Syntax-quote, unquote and unquote-splicing.
 ;;;; - Templates
@@ -124,9 +121,15 @@
 ;;;; ___________________________________________________________________________
 ;;;; Defining macros using syntax-quote.

-(defmacro our-if-not-2
-  ([test then else]
-   `(if ~test ~else ~then)))
+;; Remember we had:
+
+(defmacro our-if-not-1 [test then else]
+  (list 'if test else then))
+
+;; A nicer way:
+
+(defmacro our-if-not-2 [test then else]
+  `(if ~test ~else ~then))

 (fact
   (let [x 99]


Adding copyright notice to min-hyp-trans.clj

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/experimental/min-hyp-trans.clj
+++ src/conexp/contrib/experimental/min-hyp-trans.clj
@@ -1,3 +1,11 @@
+;; Copyright (c) Daniel Borchmann. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file LICENSE at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
 (ns conexp.contrib.experimental.min-hyp-trans
   (:use conexp.main
         [clojure.contrib.combinatorics :only (selections)]))


Install transitive dependencies with an exact version (#555)

--- src/main/shadow/cljs/devtools/server/npm_deps.clj
+++ src/main/shadow/cljs/devtools/server/npm_deps.clj
@@ -136,9 +136,9 @@
         (or (get-in config [:node-modules :install-cmd])
             (case (guess-node-package-manager config)
               :yarn
-              ["yarn" "add"]
+              ["yarn" "add" "--exact"]
               :npm
-              ["npm" "install" "--save"]))
+              ["npm" "install" "--save" "--save-exact"]))

         full-cmd
         (fill-packages-placeholder install-cmd args)


fixed compare.

fixed compare.

--- poker-hands/clojure/src/poker_hands/hands.clj
+++ poker-hands/clojure/src/poker_hands/hands.clj
@@ -26,7 +26,7 @@
 (defn- order-by-size-then-rank [groups]
   (sort #(or (and (= (:size %1) (:size %2))
                   (compare (:rank %1) (:rank %2)))
-             (* (compare (:size %1) (:size %2)) -1))
+             (compare (:size %2) (:size %1)))
         groups))

 (defn- order-by-hand [hand]


Split (run) in (run-web-server) and (run-auto-reload)

--- src/leiningen/new/chestnut/src/clj/chestnut/server.clj
+++ src/leiningen/new/chestnut/src/clj/chestnut/server.clj
@@ -22,17 +22,19 @@
     (reload/wrap-reload (wrap-defaults #'routes {{ring-defaults}}))
     (wrap-defaults routes {{ring-defaults}})))

+(defn run-web-server [& [port]]
+  (let [port (Integer. (or port (env :port) 10555))]
+    (print "Starting web server on port" port ".\n")
+    ({{server-command}} http-handler {:port port :join? false})))
+
+(defn run-auto-reload [& [port]]
+  (auto-reload *ns*)
+  (start-figwheel){{less-sass-start}})
+
 (defn run [& [port]]
-  (defonce ^:private server
-    (do
-      (when is-dev?
-        (auto-reload *ns*)
-        (start-figwheel){{less-start}}{{sass-start}})
-      (let [port (Integer. (or port (env :port) 10555))]
-        (print "Starting web server on port" port ".\n")
-        ({{server-command}} http-handler {:port port
-                          :join? false}))))
-  server)
+  (when is-dev?
+    (run-auto-reload))
+  (run-web-server port))

 (defn -main [& [port]]
   (run port))


fix failing assert on windows

fix failing assert on windows

--- src/main/shadow/cljs/devtools/server/fs_watch_hawk.clj
+++ src/main/shadow/cljs/devtools/server/fs_watch_hawk.clj
@@ -51,11 +51,19 @@
                                       (not (.isHidden file)))
                              (try
                                (let [abs-name (.getAbsolutePath file)]
-                                 (assert (str/starts-with? abs-name root-prefix))

                                  ;; special case hack when watching the public dir
                                  ;; we don't want to watch the files we write
-                                 (when-not (str/includes? abs-name "cljs-runtime")
+                                 (when (and (not (str/includes? abs-name "cljs-runtime"))
+                                            ;; for some reason on windows abs-name starts with
+                                            ;; C:\\Users...
+                                            ;; but root-prefix starts with
+                                            ;; c:\\Users...
+                                            ;; yet both used .getAbsolutePath, not sure why these differ
+                                            ;; this is just a sanity check so just compare the lower-case versions
+                                            (str/starts-with?
+                                              (str/lower-case abs-name)
+                                              (str/lower-case root-prefix)))
                                    (let [name
                                          (subs abs-name root-prefix-len)


Be more specific about what we are showing

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -66,7 +66,7 @@
                                   :data {:x "date"
                                          :type "spline"
                                          :columns [(concat ["date"] (map first build-times))
-                                                   (concat ["Build Times"] (map last build-times))]}
+                                                   (concat ["Median Build Time"] (map last build-times))]}
                                   :legend {:hide true}
                                   :grid {:y {:show true}}
                                   :zoom {:enabled true}


fixed document selection in view

fixed document selection in view

--- src/vix/views.clj
+++ src/vix/views.clj
@@ -49,7 +49,7 @@
   [documents]
   [:#main-page] (html/content
                   (map #(article-model % (parse-date (:published %)))
-                       documents)))
+                       (:documents documents))))

 (html/deftemplate blog-article-template "templates/blog.html"
   [document]


making modals less wide/ugly (#485)

making modals less wide/ugly (#485)

--- src/cljs/org/broadinstitute/firecloud_ui/main.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/main.cljs
@@ -317,11 +317,11 @@
     {:header (if maintenance-mode? "Maintenance Mode" "Server Unavailable")
      :show-cancel? false
      :content (if maintenance-mode?
-                [:div {} "FireCloud is currently undergoing planned maintenance.
+                [:div {:style {:width 500}} "FireCloud is currently undergoing planned maintenance.
                    We should be back online shortly. For more information, please see "
                  [:a {:href "http://status.firecloud.org/" :target "_blank"}
                   "http://status.firecloud.org/"] "."]
-                [:div {} "FireCloud service is temporarily unavailable.  If this problem persists, check "
+                [:div {:style {:width 500}} "FireCloud service is temporarily unavailable.  If this problem persists, check "
                  [:a {:href "http://status.firecloud.org/" :target "_blank"}
                   "http://status.firecloud.org/"]
                  " for more information."])}))


comments and code cleanup

comments and code cleanup

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

--- plugins/DLLAutoReloader/src/DLLAutoReloader/core.clj
+++ plugins/DLLAutoReloader/src/DLLAutoReloader/core.clj
@@ -16,8 +16,7 @@
 (ns DLLAutoReloader.core
   (:use [clojure.java.io :only (file copy)]
         [clojure.data :only (diff)]
-        [org.micromanager.mm :only (edt load-mm mmc core gui)]
-        [clojure.pprint :only (pprint)])
+        [org.micromanager.mm :only (edt load-mm mmc core gui)])
   (:import (javax.swing JButton JFrame JLabel JWindow)
            (java.awt Color)
            (java.awt.event ActionListener)
@@ -72,7 +71,6 @@
   "Takes list of state labels for a state device
    and applies these labels."
   [dev labels]
-  ;(println dev labels)
   (dotimes [i (count labels)]
       (core defineStateLabel dev i (get labels i))))

@@ -83,6 +81,8 @@
     (core getProperty dev "Port")))

 (defn read-device-startup-settings
+  "Read all settings that will be necessary for restarting
+   a device."
   [dev]
   {:library-location (device-library-location dev)
    :pre-init-settings (pre-init-property-settings dev)
@@ -211,6 +211,8 @@
       (.enableLiveMode gui true))))

 (defn new-dll-name
+  "Get the name of the new dll file that will be created in the
+   MM application directory."
   [dll]
   (let [name (.getName dll)]
     (if (JavaUtils/isWindows)
@@ -260,6 +262,7 @@
 (def dll-directory-type (FileDialogs$FileType. "DLL Directory" "New DLL location" "" false nil))

 (defn choose-dll-dir
+  "Presents user with a dialog for choosing the directory from which DLLs will be reloaded."
   []
   (FileDialogs/openDir nil "Please choose a directory where new DLLs will appear"
                        dll-directory-type))
@@ -295,20 +298,27 @@
       (.add path-button))
     frame))

-(defn show-plugin [app]
+(defn show-plugin
+  "Show the plugin at a given location."
+  [app]
   (load-mm app)
   (when-not @control-frame
     (reset! control-frame (startup)))
   (.show @control-frame))

-(defn handle-exit []
+(defn handle-exit
+  "Runs when application exits."
+  []
   (stop))

 ;; testing

-(defn test-lib [] (first (keys (devices-in-each-module))))
-
-(defn test-unload []
+(defn test-lib
+  "Get the first module with loaded devices."
+  []
+  (first (keys (devices-in-each-module))))
+
+(defn test-unload
+  "Attemt to unload a the test library."
+  []
   (core unloadLibrary (test-lib)))
-
-;(def test-file (file default-directory "mmgr_dal_DemoCamera.dll"))


CMR-4307: Fixed the code to refresh the collection cache if no collections are found when generating the humanizer-report.

--- search-app/src/cmr/search/services/humanizers/humanizer_report_service.clj
+++ search-app/src/cmr/search/services/humanizers/humanizer_report_service.clj
@@ -12,6 +12,7 @@
    [cmr.common.config :refer [defconfig]]
    [cmr.common.jobs :refer [defjob]]
    [cmr.common.log :as log :refer [debug info warn error]]
+   [cmr.common.services.errors :as errors]
    [cmr.common.util :as util]
    [cmr.search.data.metadata-retrieval.metadata-cache :as metadata-cache]
    [cmr.search.data.metadata-retrieval.revision-format-map :as rfm]
@@ -56,13 +57,25 @@
   [context rfms]
   (map #(rfm->umm-collection context %) rfms))

+(defn- refresh-and-get-collections-from-cache
+   "Force the collection cache to be populated and then get all the collections from it."
+   [context]
+   (let [_ (metadata-cache/refresh-collections-metadata-cache-job)
+         rfms (metadata-cache/all-cached-revision-format-maps context)]
+     (if (nil? (seq rfms))
+       (errors/internal-error! "Collection cache is not populated after refresh.")
+       rfms)))
+
 (defn- get-all-collections
   "Retrieves all collections from the Metadata cache, partitions them into batches of size
   humanizer-report-collection-batch-size, so the batches can be processed lazily to avoid out of memory errors."
   [context]
   ;; Currently not throwing an exception if the cache is empty. May want to
   ;; change in the future to throw an exception.
-  (let [rfms (metadata-cache/all-cached-revision-format-maps context)]
+  (let [rfms (metadata-cache/all-cached-revision-format-maps context)
+        rfms (if (nil? (seq rfms))
+               (refresh-and-get-collections-from-cache context)
+               rfms)]
     (map
      #(rfms->umm-collections context %)
      (partition-all (humanizer-report-collection-batch-size) rfms))))


fix REPL locking up after read failure

fix REPL locking up after read failure

fixes #1003

--- src/main/shadow/cljs/devtools/server/repl_impl.clj
+++ src/main/shadow/cljs/devtools/server/repl_impl.clj
@@ -124,6 +124,8 @@

                      error?
                      (do (repl-read-ex repl-state ex)
+                         (repl-prompt repl-state)
+                         (>!! read-lock 1)
                          (recur repl-state))

                      (= ":repl/quit" source)


CMR-1868 Removes println debugging.

CMR-1868 Removes println debugging.

--- umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2/spatial.clj
+++ umm-spec-lib/src/cmr/umm_spec/xml_to_umm_mappings/iso19115_2/spatial.clj
@@ -69,8 +69,6 @@
         shapes-by-type (group-by #(.getName (class %)) shapes)
         get-shapes     (fn [k]
                          (map umm-spec-shape (get shapes-by-type k)))]
-    (println (keys shapes-by-type))
-    (println "coord sys" (value-of doc coordinate-system-xpath))
     ;; TODO Figure out if coordinate system mapping is correct.
     {:CoordinateSystem   (value-of doc coordinate-system-xpath)
      :Points             (get-shapes "cmr.spatial.point.Point")


just use go

just use go

--- test/cljx/jamesmacaulay/async_tools/core_test.cljx
+++ test/cljx/jamesmacaulay/async_tools/core_test.cljx
@@ -45,7 +45,7 @@

 (deftest test-async-future<
   (go
-    (let [fut (tools/async-future< (to-chan [1]))]
+    (let [fut (tools/async-future< (go 1))]
       (is (= [1 1 1]
              [(<! fut) (<! fut) (<! fut)])))))


the client was hardcoded at a max of 20 connections … fixed to use thread count now

--- ws-client/src/main/clojure/ws/client/ws_client.clj
+++ ws-client/src/main/clojure/ws/client/ws_client.clj
@@ -31,7 +31,7 @@
         (.write log-writer (str "\n\t\"requests-per-thread\" : " requests-per-thread ","))
         (.write log-writer (str "\n\t\"requests\" : [\n"))
         ; start the load test and output logs into the JSON
-	      (http/with-connection-pool {:timeout 500 :threads 20 :insecure? false :default-per-route 20}
+	      (http/with-connection-pool {:timeout 500 :threads num-threads :insecure? false :default-per-route num-threads}
 	        (let [futures (doall (for [i (range num-threads)]
 	                             (future
 	                               ;(println "send-requests starting in thread: " (Thread/currentThread))


Remove debug code from edge.kick

Remove debug code from edge.kick

--- edge.kick/src/edge/kick/builder.clj
+++ edge.kick/src/edge/kick/builder.clj
@@ -25,7 +25,6 @@

 (defmethod ig/resume-key :edge.kick/builder
   [key opts old-opts old-impl]
-  (prn opts old-opts)
   (if (= opts old-opts)
     old-impl
     (do (ig/halt-key! key old-impl)


CMR-4327: Remove database migration for adding provider-id to variables table since code does not populate provider-id yet

--- metadata-db-app/src/migrations/059_add_provider_id_to_variables_table.clj
+++ metadata-db-app/src/migrations/059_add_provider_id_to_variables_table.clj
@@ -1,25 +0,0 @@
-(ns migrations.059-add-provider-id-to-variables-table
-  "Adds `provider_id` column to variables table."
-  (:require
-   [clojure.java.jdbc :as j]
-   [cmr.metadata-db.services.provider-validation :as provider-validation]
-   [config.mdb-migrate-helper :as h]))
-
-(defn up
-  "Migrates the database up from version 58 to 59."
-  []
-  (println "migrations.059-add-provider-id-to-variables-table up...")
-  ;; At this point in time, UMM-Vars support is still being developed, so we
-  ;; don't care about what's in the database right now, and the new field
-  ;; can't be null, so:
-  (h/sql "TRUNCATE TABLE METADATA_DB.cmr_variables")
-  (h/sql "TRUNCATE TABLE METADATA_DB.cmr_variable_associations")
-  (h/sql (format (str "ALTER TABLE METADATA_DB.cmr_variables "
-                      "ADD provider_id VARCHAR(%s) NOT NULL")
-                 provider-validation/PROVIDER_ID_MAX_LENGTH)))
-
-(defn down
-  "Migrates the database down from version 59 to 58."
-  []
-  (println "migrations.059-add-provider-id-to-variables-table down...")
-  (h/sql "ALTER TABLE METADATA_DB.cmr_variables DROP COLUMN provider_id"))


Add joystic

Add joystic

--- src/re_natal_esp32control_app/views/ble_control.cljs
+++ src/re_natal_esp32control_app/views/ble_control.cljs
@@ -42,15 +42,58 @@
       [control-button "back"          {:lb 255 :rb 255}]
       [control-button "back right"    {:lb 255}]]]))

-(defn joystick []
-  [v.common/view
-   [v.common/text "joystick here"]])
+(defn calc-rate-x-y [p-x p-y view-x view-y view-w view-h]
+  (let [harf-w (/ view-w 2)
+        harf-h (/ view-h 2)
+        rate-x (/ (- p-x view-x harf-w) harf-w)
+        rate-y (/ (- p-y view-y harf-h) harf-h)]
+    {:x rate-x :y rate-y}))
+
+(defn joystick [on-move on-release]
+  (let [view-x (r/atom nil)
+        view-y (r/atom nil)
+        view-w 300
+        view-h 300
+        joystick-ref (r/atom nil)
+        update-view-x-y #(.measure @joystick-ref (fn [fx fy w h px py]
+                                                   (reset! view-x px)
+                                                   (reset! view-y py)))
+        action-after-calc (fn [evt]
+                            (-> (calc-rate-x-y (.-pageX (.-nativeEvent evt))
+                                               (.-pageY (.-nativeEvent evt))
+                                               @view-x @view-y view-w view-h)
+                                (on-move)))]
+    (r/create-class
+     {:reagent-render
+      (fn []
+        [v.common/view
+         {:ref "joystickArea"
+          :style {:align-content "center" :align-self "center"
+                  :width view-w
+                  :height view-h
+                  :background-color "#beb"}
+          :on-layout (fn [this]
+                       (update-view-x-y))
+          :on-start-should-set-responder (fn [] true)
+          :on-move-should-set-responder (fn [] true)
+          :on-responder-grant #(action-after-calc %)
+          :on-responder-move #(action-after-calc %)
+          :on-responder-release (fn [] (on-release))}])
+
+      :component-did-mount
+      (fn [this]
+        (reset! joystick-ref (-> (.-refs this)
+                                 (.-joystickArea))))})))

 (def control-modes
   [{:id :joystick
     :name "Joystick"}
    {:id :tile-buttons
     :name "Tile Buttons"}])
+
+(defn all-range-action [{:keys [x y]}]
+  (prn :x x)
+  (prn :y y))

 (defn control-area []
   (let [control-mode (r/atom (:id (first control-modes)))]
@@ -73,7 +116,7 @@
             [v.common/text name]]))]
        (case @control-mode
          :tile-buttons [tile-buttons]
-         [joystick])])))
+         [joystick #(all-range-action %) #(all-range-action {:x 0 :y 0})])])))

 (defn ble-control-page []
   (let [current-device (subscribe [:get-current-device])


add autobuild-repl

add autobuild-repl

--- sidecar/src/figwheel_sidecar/auto_builder.clj
+++ sidecar/src/figwheel_sidecar/auto_builder.clj
@@ -2,11 +2,13 @@
   (:require
    [clojure.pprint :as p]
    [figwheel-sidecar.core :as fig]
+   [figwheel-sidecar.repl :as fig-repl]
    [cljs.analyzer]
    [cljs.env]
    [clj-stacktrace.repl]
    [clojurescript-build.core :as cbuild]
-   [clojurescript-build.auto :as auto]))
+   [clojurescript-build.auto :as auto]
+   [clojure.java.io :as io]))

 (defn check-changes [figwheel-server build]
   (let [{:keys [additional-changed-ns build-options id old-mtimes new-mtimes]} build]
@@ -38,7 +40,50 @@
     :builder (builder figwheel-server)
     :each-iteration-hook (fn [_] (fig/check-for-css-changes figwheel-server))}))

+(defn autobuild-repl [{:keys [builds figwheel-server] :as opts}]
+  (let [builds' (mapv auto/prep-build
+                      builds)
+        log-writer (io/writer "figwheel_server_log.txt" :append true)]
+    (binding [*out* log-writer
+              *err* log-writer]
+      ((builder figwheel-server) (first builds'))
+      (autobuild* {:builds builds'
+                   :figwheel-server figwheel-server }))
+    (fig-repl/repl (first builds') figwheel-server)))
+
 (defn autobuild [src-dirs build-options figwheel-options]
   (autobuild* {:builds [{:source-paths src-dirs
                          :build-options build-options}]
                :figwheel-server (fig/start-server figwheel-options)}))
+
+(comment
+
+  (def builds [{ :id "example"
+                 :source-paths ["src" "../support/src"]
+                 :build-options { :output-to "resources/public/js/compiled/example.js"
+                                  :output-dir "resources/public/js/compiled/out"
+                                  :source-map true
+                                  :cache-analysis true
+                                  ;; :reload-non-macro-clj-files false
+                                  :optimizations :none}}])
+
+  (def env-builds (map (fn [b] (assoc b :compiler-env
+                                      (cljs.env/default-compiler-env
+                                        (:compiler b))))
+                        builds))
+
+  (def figwheel-server (fig/start-server))
+
+  (fig/stop-server figwheel-server)
+
+  (def bb (autobuild* {:builds env-builds
+                             :figwheel-server figwheel-server}))
+
+  (auto/stop-autobuild! bb)
+
+  (fig-repl/eval-js figwheel-server "1 + 1")
+
+  (def build-options (:build-options (first builds)))
+
+  (cljs.repl/repl (repl-env figwheel-server) )
+)


Add devcard for different container behaviors

--- src-cljs/frontend/components/pieces/popover.cljs
+++ src-cljs/frontend/components/pieces/popover.cljs
@@ -364,4 +364,26 @@
                     :trigger-mode :hover
                     :on-show #(println "popover shown")
                     :on-hide #(println "popover hidden")}
-                   trigger)])))))
+                   trigger)])))
+
+    (defcard popover-trigger-containers
+      (fn [state]
+        (html
+         [:div
+          [:div {:style {:margin-bottom 20}}
+           (popover {:title "Popover with block trigger"
+                     :body "Use :container :div when using block elements as triggers"
+                     :container :div
+                     :trigger-mode :hover}
+                    [:div {:style {:background-color "black"
+                                   :color "white"
+                                   :height 20}}
+                     "content"])]
+          [:div {:style {:margin-bottom 20}}
+           (popover {:title "Popover with inline trigger"
+                     :body "Use :container :span when using inline elements as triggers"
+                     :container :span
+                     :trigger-mode :hover}
+                    [:span {:style {:background-color "black"
+                                    :color "white"}}
+                     "content"])]])))))


generate a hashmap for each article

generate a hashmap for each article

not quite the correct values yet.

--- src/clj_ptt_crawler/convert_articles_html.clj
+++ src/clj_ptt_crawler/convert_articles_html.clj
@@ -1,10 +1,31 @@
 (ns clj-ptt-crawler.convert-articles-html
+  (:require [clojure.data.json :as json]
+            [net.cgrand.enlive-html :as enlive])
   (:gen-class))

 (defn html-only [f] (and (.isFile f) (re-find #"\.html$" (.getName f))))

+(defn convert-this [f]
+  (let [output-file-name (.replace (.getPath f) ".html" ".json")]
+    (prn "==> " output-file-name)
+    (-> f
+        slurp
+        enlive/html-snippet
+        ((fn [dom]  {:dom (enlive/select dom [[:div (enlive/attr-contains :id "main-content")]])}))
+        ((fn [article]
+           ;; (enlive/select (:dom article) [[:div (enlive/attr-contains :class "article-metaline")]])
+           {:meta [ (enlive/select (:dom article) [:div.article-metaline] ) ],
+            :push [ (enlive/select (:dom article) [:div.push ] ) ],
+            :body (enlive/select (:dom article) [:div#main-content])}
+           ))
+        prn
+        ;;   (for [x (enlive/select dom [[:div (enlive/attr-contains :class "article-metaline")]])]
+        ;;     [(enlive/select x [[:span (enlive/attr-contains :class "article-meta-tag")]])
+        ;;      (enlive/select x [[:span (enlive/attr-contains :class "article-meta-value")]])]))
+        )))
+
 (defn -main [ptt_dir]
   (let [files (filter html-only (file-seq (clojure.java.io/file ptt_dir)))]
     (doseq [f files]
-      (println (.getName f)))))
+      (convert-this f))))


refactoring in times per book list

refactoring in times per book list

--- src/cljs/iwaswhere_web/ui/entry/briefing.cljs
+++ src/cljs/iwaswhere_web/ui/entry/briefing.cljs
@@ -226,10 +226,7 @@
                         [:input {:on-input (time-alloc-input-fn entry k)
                                  :value    (when allocation (/ allocation 60))
                                  :type     :number}]
-                        (when allocation
-                          [:span.allocated (u/duration-string allocation)]))
-                      (when (pos? remaining)
-                        [:span.remaining (u/duration-string remaining)])
-                      (when (pos? actual)
-                        [:span.actual (u/duration-string actual)])])]))]
+                        [:span.allocated (u/duration-string allocation)])
+                      [:span.remaining (u/duration-string remaining)]
+                      [:span.actual (u/duration-string actual)]])]))]
              (when day-stats [time-by-stories-list day-stats local])]]])))))


Rename token to Bearer

Rename token to Bearer

--- src/cylon/oauth/impl/authorization_server.clj
+++ src/cylon/oauth/impl/authorization_server.clj
@@ -278,7 +278,8 @@
   RequestAuthorizer
   (request-authorized? [component request scope]
     (when-let [auth-header (get (:headers request) "authorization")]
-      (let [access-token (second (re-matches #"\Qtoken\E\s+(.*)" auth-header))]
+      ;; Only match 'Bearer' tokens for now
+      (let [access-token (second (re-matches #"\QBearer\E\s+(.*)" auth-header))]
         (authorized? component access-token scope)))))

 (defn new-authorization-server [& {:as opts}]


Remove port parsing from server.clj

Remove port parsing from server.clj

--- src/leiningen/new/re_frame/src/clj/server.clj
+++ src/leiningen/new/re_frame/src/clj/server.clj
@@ -5,5 +5,5 @@
   (:gen-class))

  (defn -main [& _args]
-   (let [port (Integer/parseInt (or (env :port) "3000"))]
+   (let [port (or (env :port) "3000")]
      (run-jetty handler {:port port :join? false})))


Add removal, and change animations on attractions.

--- src/cljs/travel_site/components/attractions.cljs
+++ src/cljs/travel_site/components/attractions.cljs
@@ -71,12 +71,15 @@
                 [:div {:class "header"} (:name attraction)]
                 [:div {:class "description"} (:description attraction)]]
                (if (attraction-selected? attraction waypoint-attraction-ids)
-                 [:div {:class "ui bottom attached green button"}
+                 [:div {:class "ui bottom attached green button"
+                        :on-click #(do
+                                     (.transition (js/$. (om/get-node owner)) "bounce")
+                                     (remove-waypoint attraction))}
                   [:i {:class "check outline icon"}]
                   "Added!" ]
                  [:div {:class "ui fluid blue button"
                         :on-click #(do
-                                     (.transition (js/$. (om/get-node owner)) "jiggle")
+                                     (.transition (js/$. (om/get-node owner)) "bounce")
                                      (add-waypoint attraction))}
                   [:i {:class "plus outline icon"}]
                   "Add to journey"])])))))


De-lazification.

De-lazification.

--- src/clojush/instructions/random_instructions.clj
+++ src/clojush/instructions/random_instructions.clj
@@ -55,7 +55,9 @@
                    (+' min-random-string-length
                        (lrand-int (- max-random-string-length
                                      min-random-string-length)))
-                   (fn [] (lrand-nth (concat ["\n" "\t"] (map (comp str char) (range 32 127)))))))
+                   (fn [] (lrand-nth (vec (concat ["\n" "\t"]
+                                                  (map (comp str char)
+                                                       (range 32 127))))))))
       :string
       state)))

@@ -63,6 +65,8 @@
   char_rand
   ^{:stack-types [:char :random]}
   (fn [state]
-    (push-item (lrand-nth (concat [\newline \tab] (map char (range 32 127))))
+    (push-item (lrand-nth (vec (concat [\newline \tab]
+                                       (map char (range 32 127)))))
                :char
                state)))
+


CMR-2927 CMR-2928 Cleanup the demo files and an unused parameter

--- umm-lib/src/cmr/umm/validation/collection.clj
+++ umm-lib/src/cmr/umm/validation/collection.clj
@@ -29,7 +29,7 @@
   "Enforces presence of a spatial representation because translation from some schemas allow spatial
    data with no reference. (ISO19115 for example)"
   [field-path spatial-coverage]
-  (let [{:keys [spatial-representation granule-spatial-representation geometries]} spatial-coverage]
+  (let [{:keys [spatial-representation geometries]} spatial-coverage]
     (when (seq geometries)
       (when (nil? spatial-representation)
         {field-path ["Spatial coordinate reference type must be supplied."]}))))


A better name

A better name

--- support/dammit/src/main/clojure/immutant/try.clj
+++ support/dammit/src/main/clojure/immutant/try.clj
@@ -29,11 +29,12 @@
       false)))

 (defmacro try-defn [attempt name & rest]
-  (if (worked? attempt)
-    `(defn ~name ~@rest)
-    `(defn ~name [& args#]
-       (log/warn (str "The function, " ~name ", is limited when run outside of Immutant"))
-       nil)))
+  (let [fname (str name)]
+    (if (worked? attempt)
+      `(defn ~name ~@rest)
+      `(defn ~name [& args#]
+         (log/warn (str "The function, " ~fname ", is limited when run outside of Immutant"))
+         nil))))

 (defmacro try-def [attempt name & rest]
   (if (worked? attempt)


Remove reduntant code from a test.

Remove reduntant code from a test.

--- test/fn_metas.clj
+++ test/fn_metas.clj
@@ -29,8 +29,6 @@
     (is (<= (max-docstring-length doc) 80)
         (str "Function " name " has docstring longer than 80 chars."))))

-(meta #'quil.core/sketch)
-
 (deftest test-sketch-docstring-up-to-date
   (let [sketch-docstring (-> #'quil.core/sketch meta :doc)
         applet-docstring (-> #'quil.applet/applet meta :doc)]


filter library project from url [SATURN-881] (#1550)

--- src/cljs/main/broadfcui/page/library/library_page.cljs
+++ src/cljs/main/broadfcui/page/library/library_page.cljs
@@ -368,6 +368,19 @@
 (def ^:private PERSISTENCE-KEY "library-page")
 (def ^:private VERSION 4)

+(defn- filter-search-projects-or-persist [page]
+  (let [search-projects (set (js* "new URLSearchParams(document.location.search).getAll('project')"))
+        initial-page-state {:search-text ""
+                            :research-purpose {}
+                            :facet-filters (if (empty? search-projects) {} {:library:projectName search-projects})
+                            :expanded-aggregates #{}}]
+    (if (empty? search-projects)
+      (persistence/with-state-persistence {:key PERSISTENCE-KEY :version VERSION
+                                           :initial initial-page-state
+                                           :except [:library-attributes :aggregates]}
+                                          page)
+      (merge page {:get-initial-state #(identity initial-page-state)}))))
+
 (react/defc- Page
   (->>
    {:update-filter
@@ -435,12 +448,7 @@
     :-refresh-table
     (fn [{:keys [refs after-update]} & [reset-sort?]]
       (after-update #((@refs "dataset-table") :execute-search reset-sort?)))}
-   (persistence/with-state-persistence {:key PERSISTENCE-KEY :version VERSION
-                                        :initial {:search-text ""
-                                                  :research-purpose {}
-                                                  :facet-filters {}
-                                                  :expanded-aggregates #{}}
-                                        :except [:library-attributes :aggregates]})))
+   (filter-search-projects-or-persist)))

 (defn add-nav-paths []
   (nav/defpath


simplification

simplification

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
@@ -19,7 +19,7 @@
 (def qry-chan   (chan)) ; Queries that will be forwarded to the server.
 (def cmd-chan   (chan)) ; Web-client internal command messages (e.g. state modification).
 (def state-pub-chan (chan)) ; Publication of state changes.
-(def state-pub (pub state-pub-chan #(first %))) ; Pub for subscribing to
+(def state-pub (pub state-pub-chan first)) ; Pub for subscribing to

 ;;; Initialize application state (atom in state namespace) and wire channels.
 (state/init-state data-chan qry-chan stats-chan cmd-chan state-pub-chan)


CMR-3284 addresses pr comment

CMR-3284 addresses pr comment

--- access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/acl_search_test.clj
@@ -786,8 +786,8 @@
                                                                                :mask "contains"}}
                                                               :granule_applicable true
                                                               :granule_identifier {:temporal {:start_date "2010-01-01T00:00:00Z"
-                                                                                :stop_date "2011-01-01T00:00:00Z"
-                                                                                :mask "contains"}}
+                                                                                :stop_date "2011-01-01T00:00:00Z"
+                                                                                :mask "contains"}}
                                                               :provider_id "PROV1"}))
         acl5 (ingest-acl token (assoc (catalog-item-acl "Temporal intersect")
                                       :catalog_item_identity {:name "Temporal intersect"


Clean-up obsolete tests.

Clean-up obsolete tests.

--- test/dsbdp/test/data_processing_dsl_java_interop_tests.clj
+++ test/dsbdp/test/data_processing_dsl_java_interop_tests.clj
@@ -109,119 +109,8 @@
         result (.invoke data-processing-fn pcap-byte-array-test-data)]
     (is (= expected (str result)))))

-;(deftest byte-array-to-csv-str-qm-test
-;  (let [expected "\"2048\",4096"
-;        dsl-expression {:output-type :csv-str
-;                        :rules [['udpSrc '(int16 50) :string]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (= expected (str  result)))))
-;
-;(deftest byte-array-to-json-str-qm-test
-;  (let [expected "{\"udpSrc\":2048,\"udpDst\":\"4096\"}"
-;        dsl-expression {:output-type :json-str
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52) :string]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (= expected (str result)))))
-;
-;(deftest output-type-defaults-to-java-map-test
-;  (let [expected {"udpSrc" 2048, "udpDst" 4096}
-;        dsl-expression {:output-type :this-is-no-supported-output-type
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (instance? Map result))
-;    (is (= expected result))))
-;
-;
-;
-;;;;
-;;;; Tests for incremental data processing.
-;;;;
-;(deftest incremental-byte-array-to-java-map-test
-;  (let [expected {"udpSrc" 2048, "udpDst" 4096, "foo" :bar}
-;        dsl-expression {:output-type :java-map#inc
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        input  (HashMap. {"foo" :bar})
-;        result (data-processing-fn pcap-byte-array-test-data input)]
-;    (is (instance? Map result))
-;    (is (identical? input result))
-;    (is (= expected result))))
-;
-;(deftest incremental-byte-array-to-clj-map-test
-;  (let [expected {"udpSrc" 2048, "udpDst" 4096, "foo" :bar}
-;        dsl-expression {:output-type :clj-map#inc
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        input  {"foo" :bar}
-;        result (data-processing-fn pcap-byte-array-test-data input)]
-;    (is (map? result))
-;    (is (not (identical? input result)))
-;    (is (= expected result))))
-;
-;(deftest incremental-byte-array-to-csv-str-test
-;  (let [expected "foo,bar,2048,4096"
-;        dsl-expression {:output-type :csv-str#inc
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        input (doto (java.lang.StringBuilder.) (.append "foo,bar,"))
-;        result (data-processing-fn pcap-byte-array-test-data input)]
-;    (is (= expected (str result)))))
-;
-;(deftest incremental-byte-array-to-json-str-test
-;  (let [expected "{\"foo\":\"bar\",\"udpSrc\":2048,\"udpDst\":4096}"
-;        dsl-expression {:output-type :json-str#inc
-;                        :rules [['udpSrc '(int16 50)]
-;                                ['udpDst '(int16 52)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        input (doto (java.lang.StringBuilder.) (.append "{\"foo\":\"bar\"}"))
-;        result (data-processing-fn pcap-byte-array-test-data input)]
-;    (is (= expected (str result)))))
-;
-;
-;
-;;;;
-;;;; Tests for more complex data processing definitions/functions.
-;;;;
-;(deftest byte-array-to-java-map-with-additional-operation-test
-;  (let [expected {"udpSrc" 1024, "udpDst" 2048}
-;        dsl-expression {:output-type :java-map
-;                        :rules [['udpSrc '(/ (int16 50) 2)]
-;                                ['udpDst '(/ (int16 52) 2)]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (instance? Map result))
-;    (is (= expected result))))
-;
-;(deftest byte-array-to-java-map-with-additional-operation-and-float-type-test
-;  (let [expected {"udpSrc" (float 0.031250477), "udpDst" (float 0.06250095)}
-;        dsl-expression {:output-type :java-map
-;                        :rules [['udpSrc '(float (/ (int16 50) 65535))]
-;                                ['udpDst '(float (/ (int16 52) 65535))]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (instance? Map result))
-;    (is (= expected result))))
-;
-;(deftest byte-array-to-java-map-with-additional-operation-and-two-data-values-test
-;  (let [expected {"quotient" 2}
-;        dsl-expression {:output-type :java-map
-;                        :rules [['quotient '(/ (int16 52) (int16 50))]]}
-;        data-processing-fn (create-proc-fn dsl-expression)
-;        result (data-processing-fn pcap-byte-array-test-data)]
-;    (is (instance? Map result))
-;    (is (= expected result))))
-;
-;
-;
+
+
 ;;;;
 ;;;; Tests for other input data types.
 ;;;;
@@ -274,76 +163,3 @@
 ;        result (data-processing-fn input-data)]
 ;    (is (instance? Map result))
 ;    (is (= expected result))))
-;
-;
-;
-;;;;
-;;;; Tests for generating vectors of functions that can be used in the data processing pipeline.
-;;;;
-;(deftest combine-proc-fns-1st-test
-;  (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
-;        expected {"a" 0, "b" 1, "c" 2, "d" 3}
-;        dsl-expression {:output-type :clj-map
-;                        :rules [['a '(int8 0)]
-;                                ['b '(int8 1)]
-;                                ['c '(int8 2)]
-;                                ['d '(int8 3)]
-;                                ['e '(int8 4)]
-;                                ['f '(int8 5)]
-;                                ['g '(int8 6)]
-;                                ['h '(int8 7)]
-;                                ['i '(int8 8)]
-;                                ['j '(int8 9)]]}
-;        proc-fn (combine-proc-fns dsl-expression 0 4)]
-;    (is (= expected (proc-fn input-ba)))))
-;
-;(deftest combine-proc-fns-nth-test
-;  (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
-;        expected {"e" 4, "f" 5, "g" 6}
-;        dsl-expression {:output-type :clj-map
-;                        :rules [['a '(int8 0)]
-;                                ['b '(int8 1)]
-;                                ['c '(int8 2)]
-;                                ['d '(int8 3)]
-;                                ['e '(int8 4)]
-;                                ['f '(int8 5)]
-;                                ['g '(int8 6)]
-;                                ['h '(int8 7)]
-;                                ['i '(int8 8)]
-;                                ['j '(int8 9)]]}
-;        proc-fn (combine-proc-fns dsl-expression 4 7)]
-;    (is (= expected (proc-fn input-ba {})))))
-;
-;(deftest dsl-expression-to-combined-function-vector-test-1
-;  (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
-;        expected-0 {"a" 0, "b" 1, "c" 2, "d" 3}
-;        expected-1 {"e" 4, "f" 5, "g" 6}
-;        expected-2 {"h" 7, "i" 8}
-;        expected-3 {"j" 9}
-;        dsl-expression {:output-type :clj-map
-;                        :rules [['a '(int8 0)]
-;                                ['b '(int8 1)]
-;                                ['c '(int8 2)]
-;                                ['d '(int8 3)]
-;                                ['e '(int8 4)]
-;                                ['f '(int8 5)]
-;                                ['g '(int8 6)]
-;                                ['h '(int8 7)]
-;                                ['i '(int8 8)]
-;                                ['j '(int8 9)]]}
-;        proc-fns-vec (combine-proc-fns-vec
-;                       [4 3 2 1]
-;                       dsl-expression)]
-;    (is (vector? proc-fns-vec))
-;    (is (= expected-0 ((proc-fns-vec 0) input-ba {})))
-;    (is (= expected-1 ((proc-fns-vec 1) input-ba {})))
-;    (is (= expected-2 ((proc-fns-vec 2) input-ba {})))
-;    (is (= expected-3 ((proc-fns-vec 3) input-ba {})))
-;    (is (= (merge
-;             expected-0 expected-1 expected-2 expected-3)
-;           (->> {}
-;             ((proc-fns-vec 0) input-ba)
-;             ((proc-fns-vec 1) input-ba)
-;             ((proc-fns-vec 2) input-ba)
-;             ((proc-fns-vec 3) input-ba))))))
-;


Adapted test names to what they actually test

--- rna-transcription/rna_transcription_test.clj
+++ rna-transcription/rna_transcription_test.clj
@@ -1,19 +1,19 @@
 (ns rna-transcription.test (:require [clojure.test :refer :all]))
 (load-file "dna.clj")

-(deftest transcribes-cytidine-unchanged
+(deftest transcribes-guanosine-to-cytidine
   (is (= "G" (dna/to-rna "C"))))

-(deftest transcribes-guanosine-unchanged
+(deftest transcribes-cytidine-to-guanosine
   (is (= "C" (dna/to-rna "G"))))

-(deftest transcribes-adenosine-unchanged
+(deftest transcribes-uracil-to-adenosine
   (is (= "U" (dna/to-rna "A"))))

 (deftest it-transcribes-thymidine-to-uracil
   (is (= "A" (dna/to-rna "T"))))

-(deftest it-transcribes-all-occurrences-of-thymidine-to-uracil
+(deftest it-transcribes-all-nucleotides
   (is (= "UGCACCAGAAUU" (dna/to-rna "ACGTGGTCTTAA"))))

 (deftest it-validates-dna-strands


document functions in org.micromanager.sequence_generator

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

--- acqEngine/src/org/micromanager/sequence_generator.clj
+++ acqEngine/src/org/micromanager/sequence_generator.clj
@@ -27,23 +27,36 @@
   :time-first :keep-shutter-open-slices :keep-shuftter-open-channels
   :use-autofocus :autofocus-skip :relative-slices :exposure :interval-ms :custom-intervals-ms)

-(defn pairs [x]
+(defn pairs
+  "Generates a lazy list of pairs in sequence, ending with the last
+   value paired with nil."
+  [x]
   (partition 2 1 (lazy-cat x (list nil))))

-(defn pairs-back [x]
+(defn pairs-back
+  "Generates a lazy list of pairs in sequence, beginning the (nil first-val)."
+  [x]
   (partition 2 1 (lazy-cat (list nil) x)))

-(defn if-assoc [pred m k v]
+(defn if-assoc
+  "Associate k,v in a map if pred is true, otherwise
+   return the map unchanged."
+  [pred m k v]
   (if pred (assoc m k v) m))

-(defn make-property-sequences [channel-properties]
+(defn make-property-sequences
+  "Make a sequence of properties."
+  [channel-properties]
   (let [ks (apply sorted-set
                   (apply concat (map keys channel-properties)))]
     (into (sorted-map)
       (for [[d p] ks]
         [[d p] (map #(get % [d p]) channel-properties)]))))

-(defn channels-sequenceable [property-sequences channels]
+(defn channels-sequenceable
+  "Checks if a give property sequence can actually be triggered,
+   (and if a set of channels all have the same exposure setting)."
+  [property-sequences channels]
   (and
     (not (some false?
            (for [[[d p] s] property-sequences]
@@ -52,14 +65,20 @@
                       (<= (count s) (core getPropertySequenceMaxLength d p)))))))
     (apply = (map :exposure channels))))

-(defn select-triggerable-sequences [property-sequences]
+(defn select-triggerable-sequences
+  "Select only those sequences that can and must be triggered."
+  [property-sequences]
   (into (sorted-map)
     (filter #(let [[[d p] vs] %]
                (and (core isPropertySequenceable d p)
                     (not (apply = vs))))
             property-sequences)))

-(defn make-dimensions [settings]
+(defn make-dimensions
+  "Create a structure describing the order and extent of each dimension in
+   a multi-dimensional acquisition given the acquisition settings generated
+   from the Acquisition Dialog input."
+  [settings]
   (let [{:keys [slices channels frames positions
                 slices-first time-first]} settings
         a [[slices :slice :slice-index] [channels :channel :channel-index]]
@@ -68,7 +87,9 @@
         b (if time-first b (reverse b))]
     (concat a b)))

-(defn nest-loop [events dim-vals dim dim-index-kw]
+(defn nest-loop
+  "Create a loop for a given dimension, as generated by make-dimensions."
+  [events dim-vals dim dim-index-kw]
   (if (and dim-vals (pos? (count dim-vals)))
     (for [i (range (count dim-vals)) event events]
       (assoc event
@@ -76,20 +97,30 @@
         dim (if (= dim-index-kw :frame-index) i (get dim-vals i))))
     (map #(assoc % dim-index-kw 0) events)))

-(defn create-loops [dimensions]
+(defn create-loops
+  "Generate loops of events from a set of dimensions parameters as
+   generated by make-dimensinos."
+  [dimensions]
   (reduce #(apply (partial nest-loop %1) %2) [{}] dimensions))

-(defn make-main-loops [settings]
+(defn make-main-loops
+  "Make the sequence of multi-d acq. events using the acquisition settings."
+  [settings]
   (create-loops (make-dimensions settings)))

-(defn build-event [settings event]
+(defn build-event
+  "Attach appropriate :exposure and :relative-z (true/false) setting
+   to an event, given the acquisition settings map."
+  [settings event]
   (assoc event
     :exposure (if (:channel event)
                 (get-in event [:channel :exposure])
                 (:default-exposure settings))
     :relative-z (:relative-slices settings)))

-(defn process-skip-z-stack [events slices]
+(defn process-skip-z-stack
+  "Remove events corresponding to a channel/slice that should be skipped."
+  [events slices]
   (if (pos? (count slices))
     (let [middle-slice (get slices (unchecked-divide-int (count slices) 2))]
       (filter
@@ -100,11 +131,16 @@
         events))
     events))

-(defn different [e1 e2 selectors]
-  (not= (get-in e1 selectors)
-        (get-in e2 selectors)))
-
-(defn manage-shutter [events keep-shutter-open-channels keep-shutter-open-slices]
+(defn different [e1 e2 selector]
+  "Determines where values in two event maps
+   (located by selector) are different."
+  (not= (get-in e1 selector)
+        (get-in e2 selector)))
+
+(defn manage-shutter
+  "Attach a [:close-shutter true/false] to each event, corresponding
+   to Keep Shutter Open for slices and channels."
+  [events keep-shutter-open-channels keep-shutter-open-slices]
   (for [[e1 e2] (pairs events)]
     (let [diff #(different e1 e2 %)]
       (assoc e1 :close-shutter
@@ -128,7 +164,9 @@
                       (diff [:channel :properties ["Core" "Shutter"]]))
                true)))))

-(defn process-channel-skip-frames [events]
+(defn process-channel-skip-frames
+  "Remove events corresponding to a channel/frame that should be skipped."
+  [events]
   (filter
     #(or
        (nil? (% :channel))
@@ -136,12 +174,17 @@
        (zero? (mod (% :frame-index) (-> % :channel :skip-frames inc))))
     events))

-(defn process-new-position [events]
+(defn process-new-position
+  "Attach a [:new-position true] entry to events where appropriate."
+  [events]
   (for [[e1 e2] (pairs-back events)]
     (assoc e2 :new-position
       (different e1 e2 [:position-index]))))

-(defn process-use-autofocus [events use-autofocus autofocus-skip]
+(defn process-use-autofocus
+  "Modify events sequence so that event maps will include an [:autofocus true]
+   entry when appropriate."
+  [events use-autofocus autofocus-skip]
   (for [[e1 e2] (pairs-back events)]
     (assoc e2 :autofocus
       (and use-autofocus
@@ -150,16 +193,22 @@
                  (or (different e1 e2 [:position-index])
                      (different e1 e2 [:frame-index]))))))))

-(defn process-wait-time [events interval]
+(defn process-wait-time
+  "Modify events sequence so that events will contain a nonzero
+   value at key :wait-time-ms."
+  [events interval]
   (cons
-    (assoc (first events) :wait-time-ms (if (vector? interval) (first interval) 0))    ;if supplied first custom time point is delay before acquisition start
+    (assoc (first events) :wait-time-ms (if (vector? interval) (first interval) 0))
+    ;if supplied first custom time point is delay before acquisition start
     (for [[e1 e2] (pairs events) :when e2]
       (if-assoc (different e1 e2 [:frame-index])
                 e2 :wait-time-ms (if (vector? interval)
                                    (nth interval (:frame-index e2))
                                    interval)))))

-(defn event-triggerable [burst event]
+(defn event-triggerable
+  "Returns true if an event can be added to a burst."
+  [burst event]
   (let [n (count burst)
         e1 (peek burst)
         e2 event
@@ -175,14 +224,20 @@
               (<= (Math/abs (- (e1 :slice) (e2 :slice))) MAX-Z-TRIGGER-DIST)
               (<= (e1 :slice-index) (e2 :slice-index))))))))

-(defn burst-valid [e1 e2]
+(defn burst-valid
+  "Returns true if a pair of events can be included in the
+   same burst."
+  [e1 e2]
   (and
     (let [wait-time (:wait-time-ms e2)]
       (or (nil? wait-time) (>= (:exposure e2) wait-time)))
     (select-values-match? e1 e2 [:exposure :position])
     (not (:autofocus e2))))

-(defn make-triggers [events]
+(defn make-triggers
+  "Make a series of trigger sequences from a set of properties
+   and/or slices."
+  [events]
   (let [props (map #(-> % :channel :properties) events)]
     (merge
       {:properties (-> props make-property-sequences select-triggerable-sequences)}
@@ -190,7 +245,12 @@
         (when-not (apply = slices)
           {:slices (when (-> events first :slice) slices)})))))

-(defn accumulate-burst-event [events]
+(defn accumulate-burst-event
+  "Accumulate a series of events into a burst as long
+   as possible. Returns a vector containing the burst
+   event sequence followed by a sequence of events that
+   couldn't be included in the burst."
+  [events]
   (loop [remaining-events (next events)
          burst [(first events)]]
     (let [e1 (last burst)
@@ -202,7 +262,9 @@
                (conj burst e2))
         [burst remaining-events]))))

-(defn make-bursts [events]
+(defn make-bursts
+  "Lazily convert a sequence of events into bursts, when possible."
+  [events]
   (lazy-seq
     (let [[burst later] (accumulate-burst-event events)]
       (when burst
@@ -216,29 +278,41 @@
           (when later
             (make-bursts later)))))))

-(defn add-next-task-tags [events]
+(defn add-next-task-tags
+  "Attach a :next-frame-index entry to each event map."
+  [events]
   (for [p (pairs events)]
     (do ;(println p)
         (assoc (first p) :next-frame-index (get (second p) :frame-index)))))

-(defn selectively-update-tag [events event-template key update-fn]
+(defn selectively-update-tag
+  "Modifies events matched by the sub-map event-template
+   by applying update-fn to the value in event at key."
+  [events event-template key update-fn]
   (let [ks (keys event-template)]
     (for [event events]
       (if (select-values-match? event event-template ks)
         (update-in event [key] update-fn)
         event))))

-(defn selectively-append-runnable [events event-template runnable]
+(defn selectively-append-runnable
+  "Attach runnables to those events matching a give template."
+  [events event-template runnable]
   (selectively-update-tag events event-template :runnables
                           #(conj (vec %) runnable)))

-(defn attach-runnables [events runnable-list]
+(defn attach-runnables
+  "Attaches runnables in runnable-list to events."
+  [events runnable-list]
   (if (pos? (count runnable-list))
     (recur (apply selectively-append-runnable events (first runnable-list))
            (next runnable-list))
     events))

-(defn generate-default-acq-sequence [settings runnables]
+(defn generate-default-acq-sequence
+  "The default generator of multi-d acq. sequences. Generates a sequence of events,
+   and modifies this sequence according to acquisition settings provided by user."
+  [settings runnables]
   (let [{:keys [slices keep-shutter-open-channels keep-shutter-open-slices
                 use-autofocus autofocus-skip interval-ms custom-intervals-ms relative-slices
                 runnable-list]} settings]
@@ -255,7 +329,8 @@
         (add-next-task-tags)
         )))

-(defn make-channel-metadata [channel]
+(defn make-channel-metadata
+  [channel]
   (when-let [props (:properties channel)]
     (into {}
       (for [[[d p] v] props]


Fix multipart parsing for empty form submission (common with checkboxes)

--- ext/multipart/src/yada/multipart.clj
+++ ext/multipart/src/yada/multipart.clj
@@ -49,22 +49,36 @@
         (System/arraycopy source from b 0 len)
         b))))

+(def dash (byte \-))          ;; 45
+(def tab (byte \tab))         ;; 9
+(def space (byte \space))     ;; 32
+(def return (byte \return))   ;; 13
+(def newline (byte \newline)) ;; 10
+
 (defn- count-transport-padding [from to b]
-  (loop [n from]
-    (when (< n to)
-      (let [x (get b n)]
-        ;; RFC 822 Section 3.3: LWSP-char = SPACE (32) / HTAB (9)
-        (if-not (#{(byte \tab) (byte \space)} x)
-          (if (and (= (get b n) (byte \return))
-                   (= (get b (inc n)) (byte \newline)))
-            (+ (count [\return \newline]) n)
-            ;; try to trigger this via a test
-            (throw (ex-info "Malformed boundary" {:from from
-                                                  :to to
-                                                  :n n
-                                                  :c1 (char (get b n))
-                                                  :c2 (char (get b (inc n)))})))
-          (recur (inc n)))))))
+  ;; If we encounter an empty form submit, return the start of the empty boundary, which is `from`
+  ;; Empty form submit fingerprint (45 45 13 10 0)
+  (if (and
+       (= dash    (get b      from))
+       (= dash    (get b (+ 1 from)))
+       (= return  (get b (+ 2 from)))
+       (= newline (get b (+ 3 from))))
+    from
+    (loop [n from]
+      (when (< n to)
+        (let [x (get b n)]
+          ;; RFC 822 Section 3.3: LWSP-char = SPACE (32) / HTAB (9)
+          (if-not (#{tab space} x)
+            (if (and (= (get b n) return)
+                     (= (get b (inc n)) newline))
+              (+ (count [\return \newline]) n)
+              ;; try to trigger this via a test
+              (throw (ex-info "Malformed boundary" {:from from
+                                                    :to to
+                                                    :n n
+                                                    :c1 (char (get b n))
+                                                    :c2 (char (get b (inc n)))})))
+            (recur (inc n))))))))

 (defn- copy-bytes-after-dash-boundary [{:keys [window dash-boundary-size]} from to]
   (copy-bytes window (count-transport-padding (+ from dash-boundary-size) to window) to))
@@ -588,8 +602,7 @@
               (String. (get-bytes part) offset (- (alength (get-bytes part)) offset))))})

 (defn assoc-body-parameters [ctx parts-by-name schemas]
-  (let [coercion-matchers (get-in ctx [:resource :methods (:method ctx)
-                                       :coercion-matchers])
+  (let [coercion-matchers (get-in ctx [:resource :methods (:method ctx) :coercion-matchers])
         matcher (or (:form coercion-matchers) (:body coercion-matchers))
         coercer (sc/coercer
                  (or (:form schemas) (:body schemas))
@@ -600,10 +613,13 @@
                     ((or coercion-matchers default-part-coercion-matcher) schema)
                     ((rsc/coercer :json) schema))))
         params (coercer parts-by-name)]
-    (if-not (schema.utils/error? params)
-      (assoc-in ctx [:parameters (if (:form schemas) :form :body)] params)
-      (d/error-deferred (ex-info "Bad form fields"
-                                 {:status 400 :error (schema.utils/error-val params)})))))
+    (if (and (= 1 (count parts-by-name))
+               (nil? (ffirst parts-by-name)))
+        ctx
+        (if-not (schema.utils/error? params)
+          (assoc-in ctx [:parameters (if (:form schemas) :form :body)] params)
+          (d/error-deferred (ex-info "Bad form fields"
+                                     {:status 400 :error (schema.utils/error-val params)}))))))

 (defmethod process-request-body "multipart/form-data"
   [ctx body-stream media-type & args]


proxy differentiates between methods that must be sync and could be async - decision is made at compile time

--- dada-core/src/main/clojure/org/dada/core/proxy.clj
+++ dada-core/src/main/clojure/org/dada/core/proxy.clj
@@ -37,16 +37,20 @@
 ;; nil
 ;; org.dada.core.proxy=>

+(defn async? [^Method m]
+  (and (= (Void/TYPE) (.getReturnType m))
+       (empty? (.getExceptionTypes m))))
+
 (defn make-proxy-method [^Class interface ^Method method]
-   (let [method-name (.getName method)
+  (let [method-name (.getName method)
  	params (map (fn [i] (symbol (str "arg" i))) (range (count (.getParameterTypes method))))]
-     (list
-      (symbol method-name) (apply vector 'this params)
-      (list 'invoker (list 'fn (vector (with-meta 'target {:tag (.getName ^Class (eval interface))})) (apply list (symbol (str "." method-name)) 'target params)))
-      )))
+    (list
+     (symbol method-name) (apply vector 'this params)
+     (list (if (async? method) 'async-invoker 'sync-invoker) (list 'fn (vector (with-meta 'target {:tag (.getName ^Class (eval interface))})) (apply list (symbol (str "." method-name)) 'target params)))
+     )))

 (defmacro defproxy-type [name & interfaces]
-  (let [fields '[invoker]]
+  (let [fields '[sync-invoker async-invoker]]
     `(deftype ~name ~fields
        ~@(mapcat
 	  (fn [interface]


rcutorture: Test both RCU-sched and RCU-bh for Tiny RCU

Tiny RCU supports both RCU-sched and RCU-bh, but only RCU-sched is
currently tested by the rcutorture scripts.  This commit therefore
changes the TINY02 configuration to test RCU-bh, with TINY01 continuing
to test RCU-sched.

This shortcoming of the current rcutorture tests was located by mutation
testing by Iftekhar.  The idea behind mutation testing is to automatically
mutate the code under test.  If a given mutant is not caught by testing,
this is a hint that the testing might need to be improved, as was the
case here.  Note that this is only a hint because it is possible to mutate
the code into something else that still works.  For example, a mutation
that removes (say) a WARN_ON() will not normally result in a test failure.

This change resulted in the test failure caused by list mishandling,
which is fixed by the next commit.

Reported-by: "Ahmed, Iftekhar" <d6b14ad555ad69fc2fad2d68e30fd1d0ed7a3226@onid.oregonstate.edu>
Signed-off-by: Paul E. McKenney <1e0ce936bb9b355d257bf5790d2513c3f28be22b@linux.vnet.ibm.com>
Reviewed-by: Josh Triplett <c028c213ed5efcf30c3f4fc7361dbde0c893c5b7@joshtriplett.org>

--- tools/testing/selftests/rcutorture/configs/rcu/TINY02.boot
+++ tools/testing/selftests/rcutorture/configs/rcu/TINY02.boot
@@ -1,2 +1,3 @@
 rcupdate.rcu_self_test=1
 rcupdate.rcu_self_test_bh=1
+rcutorture.torture_type=rcu_bh


Adds comment about vertical spatial domain values in ISO XML

--- umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
@@ -468,6 +468,9 @@
   [vsd]
   (let [fix-val (fn [x]
                   (when x
+                    ;; Vertical spatial domain values are encoded in a comma-separated string in ISO
+                    ;; XML, so the values must be updated to match what we expect in the resulting
+                    ;; XML document.
                     (iso/sanitize-value x)))]
     (-> vsd
         (update-in [:Type] fix-val)


Increases roundtrip-generator-gen-parse's sample count to 1000

--- umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
@@ -61,7 +61,7 @@
          :iso-smap
          :iso19115)))

-(defspec roundtrip-generator-gen-parse 100
+(defspec roundtrip-generator-gen-parse 1000
   (for-all [umm-record umm-gen/umm-c-generator
             metadata-format (gen/elements [:echo10 :dif :dif10 :iso-smap :iso19115])]
     (is (= (expected-conversion/convert umm-record metadata-format)


Further diagnosing the problems with my alg.

It turns out that there are quite a lot of issues! Especially thorny is
what behavior is expected if the length of the sentence to be generated
larger than the longest possible sentence even if it does not end on an
end node (for example, a language of a, b, c, ... z where each letter only
leads to the next one and an end node, asked to generate 50-length
string).

--- wysitutwyg/src-clj/wysitutwyg/markov/builder.clj
+++ wysitutwyg/src-clj/wysitutwyg/markov/builder.clj
@@ -110,16 +110,17 @@

 ;; Tail-recursive
 (defn- dive
-  [state {:keys [counts] :as datamap} n depth cont]
+  [state {:keys [counts end] :as datamap} n depth cont]
   (if (>= (+ depth (count state)) n)
       (conj cont state)
-      (let [result (conj (vec (rest state)) (pick-word (counts state)))]
-        (recur result datamap n (inc depth) (conj cont state)))))
+      (let [next-word (pick-word (counts state))
+            next-depth (if (end next-word) depth (inc depth))
+            result (conj (vec (rest state)) next-word)]
+        (recur result datamap n next-depth (conj cont state)))))

 (defn- dfs-single
   [{:keys [start counts] :as datamap} n]
   {:pre [(pos? n)]}
-  (prn "Diving!")
   (dive (pick-word start) datamap n 0 []))

 (defn gen-sentence
@@ -154,23 +155,68 @@
 ;; I thought I fixed that, but I didn't.
 ;; This is why tests are good.

-(defn test-both [n]
+(defn sentence-length
+  [s]
+  (count (clojure.string/split s #"\s")))
+
+#_(defn test-both [n]
   (do
     (prn "LENGTH: " n)
     (binding [*rnd* (java.util.Random. 1)]
-      (prn "Psdo: " (gen-sentence dmap n)))
+      (let [sentence (gen-sentence dmap n)]
+        (prn "Psdo - LEN: " (sentence-length sentence) " STR: " sentence)))
     (binding [*rnd* (java.util.Random. 1)]
-      (prn "True: " (gen-sentence-true-dfs dmap n)))))
-
-; (test-both 2)
-(test-both 10) ; lol that tricked me into thinking it was length 9!
-;;; TODO: Issue: punctuation has its own depth in dives
-(test-both 20)
-(test-both 40) ;; Issue: 39 not 40!
-(test-both 30) ;; Issue: 39 not 40!
-
-#_(binding [*rnd* (java.util.Random. 1)]
-  (prn (gen-sentence dmap 500)))
-
-#_(binding [*rnd* (java.util.Random. 1)]
-  (prn (gen-sentence-true-dfs dmap 500)))+      (let [sentence (gen-sentence-true-dfs dmap n)]
+        (prn "Psdo - LEN: " (sentence-length sentence) " STR: " sentence)))))
+(defn test-both [n]
+  (let [old (binding [*rnd* (java.util.Random. 1)]
+              (gen-sentence dmap n))
+        new (binding [*rnd* (java.util.Random. 1)]
+              (gen-sentence-true-dfs dmap n))]
+    (do
+      (if-not (= n (sentence-length old))
+              (prn (str "OLD! N: " n " LEN: " (sentence-length old)
+                        " SEN: " old)))
+      (if-not (= n (sentence-length new))
+              (prn (str "NEW! N: " n " LEN: " (sentence-length new)
+                        " SEN: " new))))))
+
+#_(doall (map test-both (range 1 100)))
+;   Whoa okay, wow, some of this is super duper broken. Uh, is my end case
+; HORRIBLY WRONG?
+
+; -----=====##### CONCERNING NEW ALGORITHM GENNING SHORT #####=====-----
+; Hmm, they all appear to be 1 off?
+; No, they're not. See: #89, #87.
+(doall (map test-both (range 30 50)))
+(doall (map test-both (range 85 90)))
+
+; -----=====##### CONCERNING #89 AND #50 #####=====-----
+;   Okay, so, for #89 and #50 old, they both end on "resultant pleasure?" -
+; which is the last set of tokens in the corpus! So it has nowhere to go from
+; there, since it's using 2-tuples, and so it goes woefully under-sized. That's
+; because my dive doesn't do any backtracking. uuuuuuuuh why doesn't it do any
+; backtracking? Past-me, I AM VERY CROSS.
+
+; -----=====##### CONCERNING FALLBACK TEXT GENERATION BEHAVIOR #####=====-----
+;   OKAY I get why some generated texts are slightly shorter than n! That's
+; because punctuation counts as a word, so if the dive hits the end of a
+; sentence...bam! One extra level down.
+;   Question: should the fallback text be able to generate sentences, or should
+; it, well, not? It'd look super funny if it didn't but then the normal text
+; looks super funny at high lengths, so...? But, no, it should not have any
+; punctuation at all!
+;   Okay, hold on. Let's assume a grammar of a, b, c, d...z, where every node
+; leads to only the next node in the alphabet, and a "." which is our end node.
+;   What happens when you try to generate a fifty-word sentence? The dfs will
+; return nil, because there is no valid fifty-word sentence. If we try to do
+; a fifty-word dive, without punctuation, we have three options:
+;   * Return a combination of sentences which collectively have fifty words
+;   * Return the truncated twenty-six word sentence
+;   * Return nil, and you need ANOTHER fallback algorithm! Actually, that'd be
+; a little like trying to get blood out of a stone; there's really no way to
+; generate a fifty-word sentence from a linear sequence of twenty-six words.
+;   So, if this is the case, we MUST accept punctuation in our fallback
+; sentences if we want to get a text with fifty words, OR accept that the
+; text will be less than fifty words.
+;   I will do the former.


Ring middleware: Add test of `rmk/wrap-keyword-params`


CMR-4691: Updated indexer predicate funcions for new schema changes.

--- indexer-app/src/cmr/indexer/data/concepts/service.clj
+++ indexer-app/src/cmr/indexer/data/concepts/service.clj
@@ -64,21 +64,21 @@
   values being 'spatial'."
   [context service-concept]
   (let [service (concept-parser/parse-concept context service-concept)
-        {{subset-type :SubsetType} :ServiceOptions} service]
-    (and (seq subset-type)
-         (contains? (set subset-type) "Spatial"))))
+        {{subset-types :SubsetTypes} :ServiceOptions} service]
+    (and (seq subset-types)
+         (contains? (set subset-types) "Spatial"))))

 (defn- has-transforms?
-  "Returns true if the given service has a defined SubsetType or InterpolationType,
+  "Returns true if the given service has a defined SubsetTypes or InterpolationTypes,
   or multiple SupportedProjections values."
   [context service-concept]
   (let [service (concept-parser/parse-concept context service-concept)
         {service-options :ServiceOptions} service
-        {subset-type :SubsetType
-         interpolation-type :InterpolationType
+        {subset-types :SubsetTypes
+         interpolation-types :InterpolationTypes
          supported-projections :SupportedProjections} service-options]
-    (or (seq subset-type)
-        (seq interpolation-type)
+    (or (seq subset-types)
+        (seq interpolation-types)
         (> (count supported-projections) 1))))

 (defn service-associations->elastic-doc


more leiningen stuff

more leiningen stuff

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,5 +1,6 @@
 {:user
- {:plugins
+ {:repl-options {:init (set! *print-length* 100)}
+  :plugins
   [
    [cider/cider-nrepl "0.9.1"]
    [lein-midje "3.1.3"]
@@ -9,6 +10,7 @@
    [lein-ancient "0.5.4"]
    [jonase/eastwood "0.0.2"]
    [lein-auto "0.1.1"]
+   [refactor-nrepl "1.1.0"]
    ]
   :dependencies
   [[alembic "0.3.2"]


CMR-3409: Added additional config for AWS queue type.

--- dev-system/src/cmr/dev_system/system.clj
+++ dev-system/src/cmr/dev_system/system.clj
@@ -183,17 +183,29 @@
       mem-queue/create-memory-queue-broker
       wrapper/create-queue-broker-wrapper))

+(defn- external-queue-config
+  "Create a configuration for an external queue (Rabbit MQ or AWS)."
+  [ttls]
+  (-> (indexer-config/queue-config)
+      (rmq-conf/merge-configs (vp-config/queue-config))
+      (rmq-conf/merge-configs (access-control-config/queue-config))
+      (assoc :ttls ttls)))
+
+;; for legacy reasons :external refers to Rabbit MQ
 (defmethod create-queue-broker :external
   [type]
   ;; set the time-to-live on the retry queues to 1 second so our retry tests won't take too long
   (let [ttls [1 1 1 1 1]]
     (rmq-conf/set-rabbit-mq-ttls! ttls)
-    (-> (indexer-config/queue-config)
-        (rmq-conf/merge-configs (vp-config/queue-config))
-        (rmq-conf/merge-configs (access-control-config/queue-config))
-        (assoc :ttls ttls)
+    (-> (external-queue-config ttls)
         rmq/create-queue-broker
         wrapper/create-queue-broker-wrapper)))
+
+(defmethod create-queue-broker :aws
+  [type]
+  (-> (external-queue-config [1 1 1 1 1])
+      sqs/create-queue-broker
+      wrapper/create-queue-broker-wrapper))

 (defn create-metadata-db-app
   "Create an instance of the metadata-db application."
@@ -277,7 +289,8 @@
    :parser parse-dev-system-component-type})

 (defconfig dev-system-message-queue-type
-  "Specifies whether dev system should skip the use of a message queue or use an external message queue"
+  "Specifies whether dev system should skip the use of a message queue or use a Rabbit MQ or
+  AWS SNS/SQS message queue"
   {:default :in-memory
    :parser parse-dev-system-message-queue-type})


Recognize User Port on Windows.

Recognize User Port on Windows.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -2859,8 +2859,10 @@
   environment, we need to be sure to bind only to the User port. This
   filter is used with [[filter-devices]] to screen out any port that
   does not seem to be the User port. If port names are assigned
-  differently on your operating system, you may need to change this."
-  "User Port")
+  differently on your operating system, you may need to change
+  this (and please open a Pull Request); this filter seems to work for
+  Mac OS X and Windows."
+  #".*(User|MIDIIN2).*")

 (defn- recognize
   "Returns the controller's device ID if `message` is a response


Remove unused refers

Remove unused refers

--- src/cljs/cglossa/search_inputs/cwb/core.cljs
+++ src/cljs/cglossa/search_inputs/cwb/core.cljs
@@ -5,11 +5,7 @@
             [cglossa.search-inputs.cwb.shared :refer [headword-search-checkbox
                                                       on-key-down search!
                                                       remove-row-btn]]
-            [cglossa.search-inputs.cwb.extended :refer [extended
-                                                        interval multiword-term
-                                                        split-query
-                                                        construct-query-terms
-                                                        wrapped-term-changed]]))
+            [cglossa.search-inputs.cwb.extended :refer [extended]]))

 (def ^:private headword-query-prefix "<headword>")
 (def ^:private headword-query-suffix-more-words "[]{0,}")


refactor race<

refactor race<

--- src/cljx/jamesmacaulay/async_tools/core.cljx
+++ src/cljx/jamesmacaulay/async_tools/core.cljx
@@ -70,7 +70,6 @@
 (defn race<
   [xs]
   (let [non-readports (remove readport? xs)]
-    (if (empty? non-readports)
-      (async-future<
-        (go (first (async/alts! xs))))
-      (->> non-readports first constant))))
+    (if (seq non-readports)
+      (-> non-readports first constant)
+      (async-future< (go (-> xs async/alts! first))))))


:sparkles: Improve initial shape drawing impl.

--- frontend/src/uxbox/main/ui/workspace/drawarea.cljs
+++ frontend/src/uxbox/main/ui/workspace/drawarea.cljs
@@ -118,24 +118,13 @@
                                            :y2 (+ (:y point) 2)})]
               (assoc-in state [:workspace pid :drawing] (assoc shape ::initialized? true))))

-          ;; NOTE: this is a new approach for resizing, when all the
-          ;; subsystem are migrated to the new resize approach, this
-          ;; function should be moved into uxbox.main.geom ns.
           (resize-shape [shape point lock?]
-            (if (= (:type shape) :circle)
-              (let [rx (mth/abs (- (:x point) (:cx shape)))
-                    ry (mth/abs (- (:y point) (:cy shape)))]
-                (if lock?
-                  (assoc shape :rx rx :ry ry)
-                  (assoc shape :rx rx :ry rx)))
-              (let [width (- (:x point) (:x1 shape))
-                    height (- (:y point) (:y1 shape))
-                    proportion (:proportion shape 1)]
-                (assoc shape
-                       :x2 (+ (:x1 shape) width)
-                       :y2 (if lock?
-                             (+ (:y1 shape) (/ width proportion))
-                             (+ (:y1 shape) height))))))
+            (let [shape (-> (geom/shape->rect-shape shape)
+                            (geom/size))
+                  result (geom/resize-shape :bottom-right shape point lock?)
+                  scale (geom/calculate-scale-ratio shape result)
+                  mtx (geom/generate-resize-matrix :bottom-right shape scale)]
+              (assoc shape :modifier-mtx mtx)))

           (update-drawing [state point lock?]
             (let [pid (get-in state [:workspace :current])]


Style consistency: no unnecessary commas

--- src/desdemona/launcher/launch_prod_peers.clj
+++ src/desdemona/launcher/launch_prod_peers.clj
@@ -34,9 +34,9 @@
                      :onyx.log/config
                      {:appenders
                       {:stdout
-                       {:enabled? true,
-                        :async? false,
-                        :output-fn t/default-output-fn,
+                       {:enabled? true
+                        :async? false
+                        :output-fn t/default-output-fn
                         :fn stdout-logger}}})
         peer-group (onyx.api/start-peer-group peer-config)
         env (onyx.api/start-env env-config)


Fix evaluation order.

Fix evaluation order.

--- src/dsbdp/local_data_processing_pipeline.clj
+++ src/dsbdp/local_data_processing_pipeline.clj
@@ -30,14 +30,15 @@
                   (println file-name "not found. Using default.")
 ;                  "ArrayBlockingQueue_put"))]
 ;                  "ArrayBlockingQueue_put-counted-yield"))]
-                  "ArrayBlockingQueue_add-counted-yield"))]
+;                  "ArrayBlockingQueue_add-counted-yield"))]
 ;                  "ArrayBlockingQueue_add-counted-yield_remove-yield"))]
 ;                  "OneToOneConcurrentArrayQueue3_add-counted-yield_remove-yield"))]
 ;                  "ArrayBlockingQueue_offer-counted"))]
 ;                  "ArrayBlockingQueue_offer-counted-yield"))]
 ;                  "LinkedTransferQueue_transfer"))]
+;                  "LinkedTransferQueue_tryTransfer"))]
 ;                  "LinkedTransferQueue_transfer-counted-yield"))]
-;                  "LinkedTransferQueue_tryTransfer-counted-1ms"))]
+                  "LinkedTransferQueue_tryTransfer-counted-10ms"))]
     (println "Using queue-setup:" setup)
     setup))

@@ -103,7 +104,6 @@
                                                (do
                                                  (.inc ~dropped-counter)
                                                  (Thread/yield)))
-               "tryTransfer" `(.tryTransfer ~queue ~data)
                "tryTransfer-counted-no-timeout" `(if (.tryTransfer ~queue ~data)
                                                    (.inc ~enqueued-counter)
                                                    (.inc ~dropped-counter))
@@ -115,7 +115,8 @@
                                              (.inc ~dropped-counter))
                "tryTransfer-counted-100ms" `(if (.tryTransfer ~queue ~data 100 TimeUnit/MILLISECONDS)
                                               (.inc ~enqueued-counter)
-                                              (.inc ~dropped-counter)))]
+                                              (.inc ~dropped-counter))
+               "tryTransfer" `(.tryTransfer ~queue ~data))]
     (println expr)
     expr))


remove stray file

remove stray file


fixes of dim-draw-algo by dominik

fixes of dim-draw-algo by dominik

--- src/main/clojure/conexp/layouts/dim_draw.clj
+++ src/main/clojure/conexp/layouts/dim_draw.clj
@@ -50,10 +50,7 @@
    (first (drop-while #(= % nil) (map #(sat-reduction g %) (range)))))
   ([g k]
    (let [node-clauses (mapcat
-                        #(vec [[[% 1] [% 2] [% 3]]          ;either V_{i,1}, V_{i,2}, or V_{i,3} is true
-                               [(! [% 1]) (! [% 2])]        ;but not two of them
-                               [(! [% 2]) (! [% 3])]
-                               [(! [% 3]) (! [% 1])]])
+                        #(vec [[[% 1] [% 2] [% 3]]])        ;either V_{i,1}, V_{i,2}, or V_{i,3} is true
                         (nodes g))
          ;edge-clauses (mapcat
          ;               #(let [vi (:src %) vj (:dest %)]
@@ -61,9 +58,8 @@
          ;               (lg/edges g))
          edge-clauses (mapcat
                         #(let [vi (:src %) vj (:dest %)]
-                           [[[vi 1] [vj 1] [vi 2] [vj 2]]
-                            [[vi 2] [vj 2] [vi 3] [vj 3]]
-                            [[vi 3] [vj 3] [vi 1] [vj 1]]])
+                           [[(! [vi 1]) (! [vj 1])]
+                            [(! [vi 2]) (! [vj 2])]])
                         (lg/edges g))
          no-more-than-k-bad-edges-clauses (lt-seq
                                             (vec (map #(vec [% 3]) (nodes g)))


add missing unique ids when rendering headers

--- cljs/src/main/plastic/main/editor/render/headers.cljs
+++ cljs/src/main/plastic/main/editor/render/headers.cljs
@@ -13,7 +13,7 @@
            [:div.name [:div text]]
            [:div.arities {:class (str "arity-" (count arities))}
             (for [args arities]
-              [:div.args args])]])))))
+              ^{:key (goog/getUid args)} [:div.args args])]])))))

 (defn headers-group-component [editor-id form-id node-id]
   (let [layout (subscribe [:editor-layout-form-node editor-id form-id node-id])


Fixed a problem with the arc line segment intersection algorithm when a vertical arc starts on the south pole.

--- src/cmr/spatial/arc_line_segment_intersections.clj
+++ src/cmr/spatial/arc_line_segment_intersections.clj
@@ -36,6 +36,10 @@
                        (p/is-south-pole? point2)
                        ;; Create a vertical line segment ignoring the original point2 lon
                        [(s/line-segment point1 (p/point (:lon point1) -90))]
+
+                       (p/is-south-pole? point1)
+                       ;; Create a vertical line segment ignoring the original point1 lon
+                       [(s/line-segment point2 (p/point (:lon point2) -90))]

                        :else
                        [(s/line-segment point1 point2)])]


drop the one CLJ use of shadow.css

drop the one CLJ use of shadow.css

not quite worth making it a runtime dependency yet.

fixes #1037

--- src/main/shadow/cljs/devtools/server/web.clj
+++ src/main/shadow/cljs/devtools/server/web.clj
@@ -8,7 +8,6 @@
     [ring.middleware.file-info :as ring-file-info]
     [shadow.http.router :as http]
     [shadow.server.assets :as assets]
-    [shadow.css :refer (css)]
     [shadow.cljs.devtools.server.web.common :as common]
     [shadow.cljs.devtools.server.web.api :as web-api]
     [shadow.cljs.devtools.server.supervisor :as super]
@@ -47,7 +46,7 @@
       [:meta {:name "shadow-remote-token" :content (get-in req [:http :server-token])}]
       [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no"}]]
      [:body
-      [:div#root {:class (css :h-screen :w-screen)}]
+      [:div#root {:style "height: 100vh; width: 100vw;"}]
       ;; defer'ing these causes the scripts to potentially run before the stylesheets finish loading
       ;; leading to incorrect measurements of elements and messing up vlists
       ;; I don't know how to fix that apart from just removing the defer?


[#244] Add more tests to statistic endpoint * todo: translate exception

--- api/test/clojure/org/akvo/flow_api/end_to_end.clj
+++ api/test/clojure/org/akvo/flow_api/end_to_end.clj
@@ -16,6 +16,42 @@
                       :content-type :json}))))))

 (deftest answer-stats
+  (testing "Random email trying to get a statistic"
+    (is (thrown? Exception
+                 (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
+                                      {:as :json
+                                       :headers {"x-akvo-email" "random.email@gmail.com"}
+                                       :query-params {:survey_id "148412306"
+                                                      :form_id "145492013"
+                                                      :question_id "147432013"}
+                                       :content-type :json}))))
+  (testing "Survey Not Found"
+    (is (thrown? Exception
+                 (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
+                                      {:as :json
+                                       :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                                       :query-params {:survey_id "999"
+                                                      :form_id "145492013"
+                                                      :question_id "147432013"}
+                                       :content-type :json}))))
+  (testing "Question Not Found"
+    (is (thrown? Exception
+                 (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
+                                      {:as :json
+                                       :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                                       :query-params {:survey_id "148412306"
+                                                      :form_id "145492013"
+                                                      :question_id "999"}
+                                       :content-type :json}))))
+  (testing "Question is not an Option Question"
+    (is (thrown? Exception
+                 (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
+                                      {:as :json
+                                       :headers {"x-akvo-email" "akvo.flow.user.test@gmail.com"}
+                                       :query-params {:survey_id "148412306"
+                                                      :form_id "145492013"
+                                                      :question_id "148442013"}
+                                       :content-type :json}))))
   (testing "Answer summary of an option type of question"
     (let [response (clj-http.client/get "http://mainnetwork:3000/orgs/akvoflowsandbox/stats"
                      {:as :json


[#12530] Scrolling issues on the 'Max priority fee' bottom sheet


Removed integration test since that's moving to graphql3

--- test/com/wsscode/pathom/connect/graphql2_test.cljc
+++ test/com/wsscode/pathom/connect/graphql2_test.cljc
@@ -489,33 +489,3 @@
                            [:customer/customerId "123"] {:service.Customer/name "Missy"}})
          {:service/banks         [{:service.Bank/name "Dino"}]
           :service.Customer/name "Missy"})))
-
-(deftest test-query-build-integration
-  (let [index  (pcg/index-schema {::pcg/prefix    prefix
-                                  ::pcg/schema    schema
-                                  ::pcg/ident-map {"customer"          {"customerId" :service.Customer/id}
-                                                   "creditCardAccount" {"customerId" :service.Customer/id}
-                                                   "savingsAccount"    {"customerId" :service.Customer/id}
-                                                   "repository"        {"owner" :service.Customer/name
-                                                                        "name"  :service.Repository/name}}
-                                  ::pcg/resolver  `supposed-resolver})
-        parser (p/parser
-                 {::p/env     {::p/reader               [p/map-reader
-                                                         pc/reader3
-                                                         pc/open-ident-reader
-                                                         p/env-placeholder-reader]
-                               :com.wsscode.pathom.diplomat.http/driver
-                                                        (fn [req]
-                                                          (println
-                                                            (:query (:com.wsscode.pathom.diplomat.http/form-params req)))
-                                                          {})
-                               ::p/placeholder-prefixes #{">"}}
-                  ::p/plugins [(pc/connect-plugin {::pc/register []
-                                                   ::pc/indexes  (atom index)})
-                               p/error-handler-plugin
-                               p/trace-plugin]})]
-    (is (= (parser {}
-             [{[:service.Customer/id "123"]
-               [:service.Customer/cpf :service.Customer/name :service/banks :other/thing
-                {:service.Customer/creditCardAccount [:sercrecaacc]}]}])
-           {}))))