Use infof instead of an explicit format.

--- src/com/farmlogs/conduit/subscription.clj
+++ src/com/farmlogs/conduit/subscription.clj
@@ -26,26 +26,26 @@
                               [result-chan (read-payload (:content-type metadata) payload)])
                (a/>!! result-chan :retry))
              (catch Throwable t
-               (log/error t (format (str "Exception while enqueuing"
-                                         " new message: '%s' content-type: %s")
-                                    (-> (Base64/getEncoder)
-                                        (.encodeToString payload))
-                                    (:content-type metadata)))
+               (log/errorf t (str "Exception while enqueuing"
+                                  " new message: '%s' content-type: %s")
+                           (-> (Base64/getEncoder)
+                               (.encodeToString payload))
+                           (:content-type metadata))
                (a/>!! result-chan :nack)))))))

 (defn consume-ok
   [{:keys [queue-name] :as config} consumer-tag]
-  (log/info (format "Consuming %s with tag %s" queue-name consumer-tag)))
+  (log/infof "Consuming %s with tag %s" queue-name consumer-tag))

 (defn cancel
   [cancelled-promise {:keys [queue-name] :as queue-config} consumer-tag]
   (deliver cancelled-promise true)
-  (log/warn (format "Cancelled consumer tag: %s on queue: %s" consumer-tag queue-name)))
+  (log/warnf "Cancelled consumer tag: %s on queue: %s" consumer-tag queue-name))

 (defn cancel-ok
   [cancelled-promise {:keys [queue-name] :as queue-config} consumer-tag]
   (deliver cancelled-promise true)
-  (log/info (format "Consumer tag: %s on queue: %s shutdown" consumer-tag queue-name)))
+  (log/infof "Consumer tag: %s on queue: %s shutdown" consumer-tag queue-name))

 (defn- make-channel
   [conn {:keys [exchange-name exchange-type] :as config}]
@@ -59,7 +59,7 @@
     [rmq-connection rmq-chan queue-config buffer-size]
   component/Lifecycle
   (start [this]
-    (log/info (format "Starting subscription on queue '%s'" (:queue-name queue-config)))
+    (log/infof "Starting subscription on queue '%s'" (:queue-name queue-config))
     (let [rmq-chan (or rmq-chan (make-channel (:conn rmq-connection) queue-config))
           new-messages (a/chan)
           pending-messages (a/chan buffer-size)
@@ -74,9 +74,9 @@

-      (log/info (format "Started subscription on queue '%s' with tag '%s'"
-                        (:queue-name queue-config)
-                        consumer-tag))
+      (log/infof "Started subscription on queue '%s' with tag '%s'"
+                 (:queue-name queue-config)
+                 consumer-tag)
       (assoc this
              :rmq-chan rmq-chan
              :rmq-consumer rmq-consumer
@@ -91,9 +91,9 @@
     ;; library has turned off the workers depending on this subscription.

     ;; Shut down the RMQ consumer, so we don't get any more messages delivered
-    (log/info (format "Shutting down subscription '%s' on queue '%s'"
-                      consumer-tag
-                      (:queue-name queue-config)))
+    (log/infof "Shutting down subscription '%s' on queue '%s'"
+               consumer-tag
+               (:queue-name queue-config))
     (rmq.basic/cancel rmq-chan consumer-tag)

     ;; Wait until the server acknowledges the cancellation of our subscription


Works! Reponds with an index. Pretty tinker-toy at the moment, but gets up and does a dance.

--- src/doctopus/web.clj
+++ src/doctopus/web.clj
@@ -1,5 +1,46 @@
 (ns doctopus.web
-  (:require [ring.middleware.defaults :refer :all]
+  (:require [bidi.ring :as bidi]
+            [clojure.java.io :as io]
+            [doctopus.configuration :refer [server-config]]
+            [org.httpkit.server :as server]
+            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
             [ring.middleware.reload :as reload]
             [ring.middleware.resource :refer [wrap-resource]]
-            [ring.middleware.stacktrace :as trace]))
+            [ring.middleware.stacktrace :as trace]
+            [ring.util.response :as ring-response]
+            [taoensso.timbre :as log]))
+
+(defn wrap-error-page [handler]
+  "Utility ring handler for when Stuff goes Sideways; returns a 500 and an error
+  page"
+  (fn [req]
+    (try (handler req)
+         (catch Exception e
+           {:status 500
+            :headers {"Content-Type" "text/html"}
+            :body (slurp (io/resource "500.html"))}))))
+
+(defn serve-index
+  [_]
+  (-> (slurp (io/resource "index.html"))
+      (ring-response/response)
+      (ring-response/content-type "text/html")))
+
+(def routes
+  (bidi/make-handler ["/" {"" {:get serve-index}}]))
+
+(def application
+  (-> (wrap-defaults routes site-defaults)
+      (reload/wrap-reload)
+      ((if (= (:env (server-config)) :production)
+         wrap-error-page
+         trace/wrap-stacktrace))))
+
+;; # Http Server
+;; This is what lifts the whole beast off the ground. Reads its configs out of
+;; resources/configuration.edn
+(defn -main
+  []
+  (let [{:keys [port]} (server-config)]
+    (log/info "Starting HTTP server on port" port)
+    (server/run-server application {:port port})))


logs button

logs button

--- src/cljs/swarmpit/component/service/info.cljs
+++ src/cljs/swarmpit/component/service/info.cljs
@@ -66,6 +66,12 @@
       [:div.form-panel-right
        (comp/mui
          (comp/raised-button
+           {:href    (routes/path-for-frontend :service-log {:id id})
+            :label   "Logs"
+            :primary true}))
+       [:span.form-panel-delimiter]
+       (comp/mui
+         (comp/raised-button
            {:href    (routes/path-for-frontend :service-edit {:id id})
             :label   "Edit"
             :primary true}))


CMR-513: Removed test comment code.

CMR-513: Removed test comment code.

--- src/cmr/metadata_db/data/oracle/sql_utils.clj
+++ src/cmr/metadata_db/data/oracle/sql_utils.clj
@@ -51,18 +51,4 @@
   [db stmt start-index batch-size]
   (let [stmt (find-batch-sql stmt start-index batch-size)]
     (println (pr-str stmt))
-    (j/query db stmt)))
-
-
-(comment
-  (let [istmt (select ['*] (from :fix_prov1_collections) (order-by :concept-id))]
-    (find-batch-sql istmt 100 10))
-
-  )
-
-
-; select * from
-;   (SELECT a.*, rownum r FROM
-;     (SELECT * from fix_prov1_collections order by concept_id) a
-;    WHERE ROWNUM < 210)
-; where r >= 111+    (j/query db stmt)))


Some refactoring for TITANIC

Some refactoring for TITANIC

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

--- src/conexp/contrib/algorithms/titanic.clj
+++ src/conexp/contrib/algorithms/titanic.clj
@@ -13,6 +13,8 @@
  "Implements the TITANIC algorithm. Note that this implementation is
  not tune for speed but for flexibility.")

+(set! *warn-on-reflection* true)
+
 ;;; Pragmatics

 (defmacro- set-val!
@@ -25,17 +27,27 @@

 (defvar- closure nil
   "Holds the closures of sets. To be rebound.")
-(defvar- minimum nil
-  "Computes the minimum of weights in a given sequence of weights. To
-  be rebound.")
 (defvar- set-weight nil
   "Holds the weights of sets. To be rebound.")

+(defn- minimum
+  "Computes the minimum of weights in a given sequence of
+  weights. order must be a linear order on elements plus max-val and
+  max-val must be the maximal element to be considered."
+  [order max-val elements]
+  (loop [current-min max-val,
+         elements    elements]
+    (if (empty? elements)
+      current-min
+      (recur (if (order (first elements) current-min)
+               (first elements)
+               current-min)
+             (rest elements)))))
+
 (defn- subset-weight
   "Returns the minimum of the weights of all proper subsets of X."
-  [max-weight X]
-  (minimum (conj (map #(get set-weight (disj X %)) X)
-                 max-weight)))
+  [X]
+  (minimum (map #(get set-weight (disj X %)) X)))

 (defn- titanic-closure
   "Computes the closure of X by the weights of its subsets. The
@@ -44,7 +56,9 @@
     - keys is the sequence of already computed key sets and is orderd
       by weights ascending,
     - X is a member of keys.
-  "
+
+  Also note that the variables «closure» and «set-weight» have to be
+  rebound."
   [X base-set keys candidates]
   (let [X-weight (set-weight X),
         keys     (take-while #(not= (set-weight %) X-weight) keys)]
@@ -64,7 +78,8 @@
         Y))))

 (defn- titanic-generate
-  "Computes the next candidate set."
+  "Computes the next candidate set. Note that the variables «closure»
+  and «set-weight» have to be rebound."
   [base-set key-set]
   (set-of next [A key-set,
                 m (difference base-set A),
@@ -75,14 +90,13 @@
 (defn titanic
   "Implements the titanic algorithm. weigh must return for a
   collection of sets a hash-map mapping every set to its weight, with
-  max-weight being the maximal weight possbile. weight-minimum is a
-  function of one argument being a sequence of weights and returning
-  the minimal of those."
-  [base-set weigh max-weight weight-minimum]
-  (binding [closure       {},
-            set-weight    (weigh [#{}]),
-            subset-weight (partial subset-weight max-weight),
-            minimum       weight-minimum]
+  max-weight being the maximal weight possible. weight-order denotes
+  the order on the weights. Note that this order has to be linear for
+  this implementation to work."
+  [base-set weigh max-weight weight-order]
+  (binding [closure    {},
+            set-weight (weigh [#{}]),
+            minimum    (partial minimum weight-order max-weight)]

     (loop [key-set    #{#{}},
            candidates (set-of #{m} [m base-set]),
@@ -96,10 +110,11 @@
         (if-not (empty? next-key-set)
           (recur next-key-set
                  (titanic-generate base-set next-key-set)
-                 (sort (fn [a b]
-                         (= (get set-weight a)
-                            (weight-minimum [(get set-weight a) (get set-weight b)])))
-                       (concat next-key-set keys)))
+                 (map first
+                      (sort (fn [[_ a] [_ b]]
+                              (weight-order a b))
+                            (map #(vector % (set-weight %))
+                                 (concat next-key-set keys)))))
           (distinct (map closure keys)))))))

 ;;;
@@ -125,7 +140,7 @@
   (titanic (attributes context)
            (supports context 0)
            1.0
-           #(apply min %)))
+           <=))

 (defn titanic-iceberg-intent-set
   "Computes the iceberg intent set for given context and minimal
@@ -134,7 +149,7 @@
   (let [intents (titanic (attributes context)
                          (supports context minsupp)
                          1.0
-                         #(apply min %))]
+                         <=)]
     (if (<= (* (count (objects context)) minsupp)
             (count (attribute-derivation context (attributes context))))
       intents


indent variations

indent variations

--- src/com/billpiel/mem_tracer/string_output.clj
+++ src/com/billpiel/mem_tracer/string_output.clj
@@ -50,19 +50,22 @@
   (str depth (clojure.string/join "" (repeat depth "|"))))

 (defn indent
-  [depth]
-  (->> depth
-       inc
-       (range 1)
-       (map #(str (fg-color-code %)
-                  "|"))
-       (clojure.string/join "")
-       (format " %s ")))
+  [depth & {:keys [start end]
+            :or   {start " " end " "}}]
+  (format "%s%s%s"
+          start
+          (->> depth
+               inc
+               (range 1)
+               (map #(str (fg-color-code %)
+                          "|"))
+               (clojure.string/join ""))
+          end))

 (defn indent-line-breaks
-  [s depth]
+  [s depth & rest]
   (clojure.string/join ""
-                       (mapcat (fn [line] [(indent depth)
+                       (mapcat (fn [line] [(apply indent depth rest)
                                            line
                                            reset-color-code
                                            "\n"])
@@ -72,7 +75,10 @@
   [entry]
   (let [depth (:depth entry)]
     (clojure.string/join "" [(fg-color-code depth)
-                             (indent depth)
+                             (indent depth :end "" )
+                             (color-code :fg 7 :bold true)
+                             ">"
+                             (fg-color-code depth)
                              (:name entry)
                              reset-color-code])))

@@ -82,15 +88,18 @@
     (indent-line-breaks (clojure.string/join "\n"
                                              (map pprint-str
                                                   args))
-                        (:depth entry))))
+                        (:depth entry)
+                        :end "  ")))

 (defn return-str
   [entry]
   (when-let [return (:return entry)]
     (str (indent (:depth entry))
-         "return => "
-         (pprint-str return)
-         "\n")))
+         "return => \n"
+         (indent-line-breaks (str (pprint-str return)
+                                  "\n")
+                             (:depth entry)
+                             :end "  "))))

 (defn throw-str
   [entry]


Make- prefixes. Rename "types".

Make- prefixes. Rename "types".

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -91,7 +91,7 @@
   (hash-map (.toString (.getName xdm-var))
             (.toString (.getValue xdm-var))))

-(def types
+(def xcc-type->conv-fn
   "Default mapping from MarkLogic XCC types (e.g. those that might be
   returned in a query's result set) to Clojure functions intended to
   convert to Clojure types. See
@@ -159,10 +159,10 @@
   MarkLogic query result sequence. Default type mappings can be
   overridden (in part or in whole) with the optional parameter
   `type-mapping`, which should contain a transformation function keyed
-  by an XCC type string. See `types` above."
+  by an XCC type string. See `xcc-type->conv-fn` above."
   [result-sequence & [type-mapping]]
   ;; TODO throw informative exception if type not found in types
-  (map (fn [item] (((merge types
+  (map (fn [item] (((merge xcc-type->conv-fn
                           (when (map? type-mapping)
                             type-mapping))
                    (.toString (.getValueType item))) item))
@@ -190,7 +190,7 @@
     :timeout-millis
     :timezone})

-(defn request-options
+(defn make-request-options
   "Creates a Request Options object (to pass to a Request or a
   Session) out of the given options map. See `valid-request-options`
   for supported keywords."
@@ -464,7 +464,7 @@

     clj-val))

-(defn- request-obj
+(defn- make-request-obj
   "Build a Request object using the given `request-factory` builder,
   request `options`, and bindings for XQuery external `variables`."
   [request-factory options variables]
@@ -485,20 +485,20 @@
                                         value
                                         (wrap-val value type))))))
                acc)
-             (doto request-factory (.setOptions (request-options options)))
+             (doto request-factory (.setOptions (make-request-options options)))
              variables))

 (defn submit-request
   "Construct, submit, and return raw results of request for the given
   `session` using `request-factory` and `query`. Modify it
   with (possibly empty) `options` and `variables` maps. Applies type
-  conversion to response according to defaults and `types`. Variables
+  conversion to response according to defaults and `xcc-type->conv-fn`. Variables
   may be passed as a map of Strings or with String names corresponding
   to maps describing the variable using mandatory key `:value` and
   optional keys `:namespace` and `:type`.`"
   [request-factory session query options variables types shape]
   (let [req (sling/try+ (.submitRequest session
-                                        (request-obj request-factory options variables))
+                                        (make-request-obj request-factory options variables))
                         ;; RequestException and its subclass
                         ;; XQueryException have overridden toString,
                         ;; so only those need to be re-thrown with
@@ -535,7 +535,7 @@
   connection defined by the given session. Takes an optional
   configuration map describing request `options` and `variables`,
   desired `shape` of the result, and overrides of default type
-  conversion in `types`.
+  conversion in `xcc-type->conv-fn`.

   Options passed must be in `valid-request-options` and conform to
   `request-options`.
@@ -549,8 +549,8 @@
   return only the first value.

   Type conversion overrides must be a map using keys present in
-  `uruk.core/types` and conform to use in `convert-types`, that is,
-  including values which are a function of one variable."
+  `uruk.core/xcc-type->conv-fn` and conform to use in `convert-types`,
+  that is, including values which are a function of one variable."
   ([session query]
    (execute-xquery session query {}))
   ([session query {:keys [options variables types shape]}]
@@ -561,7 +561,8 @@
   "Execute the named module as a request to the database connection
   defined by the given session. Takes an optional configuration map
   describing request `options` and `variables`, desired `shape` of the
-  result, and overrides of default type conversion in `types`.
+  result, and overrides of default type conversion in
+  `xcc-type->conv-fn`.

   Options passed must be in `valid-request-options` and conform to
   `request-options`.
@@ -575,8 +576,8 @@
   return only the first value.

   Type conversion overrides must be a map using keys present in
-  `uruk.core/types` and conform to use in `convert-types`, that is,
-  including values which are a function of one variable."
+  `uruk.core/xcc-type->conv-fn` and conform to use in `convert-types`,
+  that is, including values which are a function of one variable."
   ([session module]
    (execute-module session module {}))
   ([session module {:keys [options variables types shape]}]


Add new urls for images page.

Add new urls for images page.

--- src/uxbox/main/ui.cljs
+++ src/uxbox/main/ui.cljs
@@ -99,7 +99,14 @@
         :dashboard/projects (dashboard/projects-page)
         :dashboard/elements (dashboard/elements-page)
         :dashboard/icons (dashboard/icons-page)
-        :dashboard/images (dashboard/images-page)
+        :dashboard/images (let [{:keys [id type]} params
+                                type (when (str/alpha? type) (keyword type))
+                                id (cond
+                                     (str/digits? id) (parse-int id)
+                                     (uuid-str? id) (uuid id)
+                                     :else nil)]
+                            (dashboard/images-page type id))
+
         :dashboard/colors (let [{:keys [id type]} params
                                 type (when (str/alpha? type) (keyword type))
                                 id (cond
@@ -127,10 +134,15 @@
    ["/dashboard/projects" :dashboard/projects]
    ["/dashboard/elements" :dashboard/elements]
    ["/dashboard/icons" :dashboard/icons]
+
    ["/dashboard/images" :dashboard/images]
+   ["/dashboard/images/:type/:id" :dashboard/images]
+   ["/dashboard/images/:type" :dashboard/images]
+
    ["/dashboard/colors" :dashboard/colors]
    ["/dashboard/colors/:type/:id" :dashboard/colors]
    ["/dashboard/colors/:type" :dashboard/colors]
+
    ["/workspace/:project/:page" :workspace/page]])

 (extend-protocol bc/IPathRepr


Add cursor in app-state

Add cursor in app-state

--- src/discuss/utils/common.cljs
+++ src/discuss/utils/common.cljs
@@ -16,6 +16,7 @@
          (atom {:discussion {}
                 :issues     {}
                 :items      {}
+                :search     {:results []}
                 :layout     {:title         "discuss"
                              :template      :discussion
                              :next-template :discussion


Replace java 18 with java 19

Replace java 18 with java 19

--- src/docker_clojure/config.clj
+++ src/docker_clojure/config.clj
@@ -39,7 +39,7 @@

 (def git-repo "https://github.com/Quantisan/docker-clojure.git")

-(def jdk-versions #{8 11 17 18})
+(def jdk-versions #{8 11 17 19})

 (def base-images
   "Map of JDK version to base image name with :default as a fallback"


Fix local names

Fix local names

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -351,9 +351,9 @@
           (reduce (fn [acc f]
                     (api/write-meta (:datastore config) acc {})
                     (f acc))
-                  (t/->Group groupid)
-                  [#(t/->Artifact % artifactid)
-                   #(t/->Version % version)
+                  (t/->Group p-groupid)
+                  [#(t/->Artifact % p-artifactid)
+                   #(t/->Version % p-version)
                    #(t/->Platform % platform)
                    identity])


[CS WR] reorder precinct_split xml output

--- src/vip/data_processor/output/precinct_split.clj
+++ src/vip/data_processor/output/precinct_split.clj
@@ -10,10 +10,10 @@
         polling-location-nodes (joined-nodes ctx :precinct-split id :polling-location)

         children (concat [(xml-node name)
-                          (xml-node precinct_id)
-                          (xml-node ballot_style_image_url)]
+                          (xml-node precinct_id)]
                          electoral-district-nodes
-                         polling-location-nodes)]
+                         polling-location-nodes
+                         [(xml-node ballot_style_image_url)])]
     (simple-xml :precinct_split id children)))

 (defn xml-nodes [ctx]


RS & JC | 206 | Remove unused require that might be creating a db connection at compile time

--- test/objective8/integration/db/activities.clj
+++ test/objective8/integration/db/activities.clj
@@ -2,7 +2,6 @@
   (:require [midje.sweet :refer :all]
             [org.httpkit.client :as http]
             [objective8.utils :as utils]
-            [objective8.integration.integration-helpers :as ih]
             [objective8.integration.storage-helpers :as sh]
             [objective8.back-end.domain.activities :as activities]
             [objective8.back-end.domain.objectives :as objectives]


(PE-33177) Update exception handling in sync_ssl_test for clojure sync client

The clojure sync client now throws a ConnectionClosedException, rather than an SSLException, when a connection can't be established due to no valid protocols. This happens in the latest Java 11 versions, but older Java 11 versions (e.g. 11.0.2 used by Travis) still throws an SSLHandshakeException.  This commit changes java-unsupported-protocol-exception? to be able to handle both of these cases.

Note that there still seems to be cases where ConnectionClosedException is picked up by the HttpClientException block (using the Java sync client) and some cases where it isn't (Clojure sync client).

--- test/puppetlabs/http/client/sync_ssl_test.clj
+++ test/puppetlabs/http/client/sync_ssl_test.clj
@@ -140,7 +140,8 @@
              (and (instance? SSLException cause#)
                   (or (re-find #"handshake_failure" message#)
                       (re-find #"internal_error" message#)))
-             (instance? ConnectionClosedException cause#))))))
+             (instance? ConnectionClosedException cause#))))
+     (catch ConnectionClosedException cce# true)))

 (defn java-https-get-with-protocols
   [client-protocols client-cipher-suites]
@@ -183,5 +184,5 @@
         (is (java-unsupported-protocol-exception?
               (java-https-get-with-protocols ["TLSv1.2"] nil))))
       (testing "clojure sync client"
-        (is (thrown? SSLException (clj-https-get-with-protocols ["TLSv1.2"] nil)))))))
+        (is (java-unsupported-protocol-exception? (clj-https-get-with-protocols ["TLSv1.2"] nil)))))))


(PDB-3611) Update test fixture to accommodate for previous revert

--- test/puppetlabs/puppetdb/scf/storage_test.clj
+++ test/puppetlabs/puppetdb/scf/storage_test.clj
@@ -140,11 +140,7 @@
                  "fqdn" "myhost.mydomain.com"
                  "hostname" "myhost"
                  "kernel" "Linux"
-                 "operatingsystem" "Debian"
-                 "excitement?" true
-                 "version" 1
-                 "temperature" 273.16
-                 "binary" [0 1]}
+                 "operatingsystem" "Debian"}
           producer "bar.com"]
       (add-certname! certname)


cleaned up socket handling action case form

--- possibledb/src/possibledb/core.cljs
+++ possibledb/src/possibledb/core.cljs
@@ -335,7 +335,7 @@
                            reader/read-string)]

               (try
-                (let [[action db data] safe
+                (let [[action db & args] safe
                       db (str db)
                       write! (fn [data]
                                (let [data (.toString data "utf8")]
@@ -346,26 +346,33 @@
                     (case (str action)

                       ;; get the entire database
-                      "get" (possibledb-get-db! db
-                                                (fn [db]
-                                                  (let [conn @db]
-                                                    (write!
-
-                                                     ;; remove type for reading
-                                                     (zipmap (keys conn) (vals conn))))))
-
-                      "create!" (possibledb-create-db! db
-                                                       (fn [x]
-                                                         (write! x)))
-                      "query" (possibledb-q db
-                                            data
-                                            (fn [result]
-                                              (write! result)))
-
-                      "transact!" (possibledb-transact! db
-                                                        data
-                                                        (fn [result]
-                                                          (write! result)))))
+                      "get"
+                      (possibledb-get-db! db
+                                          (fn [db]
+                                            (let [conn @db]
+                                              (write!
+
+                                               ;; remove type for reading
+                                               (zipmap (keys conn) (vals conn))))))
+
+                      "create!"
+                      (possibledb-create-db! db
+                                             (fn [x]
+                                               (write! x)))
+                      "query"
+                      (let [data (first args)]
+                        (possibledb-q db
+                                      data
+                                      (fn [result]
+                                        (write! result))))
+
+                      "transact!"
+                      (let [data (first args)]
+                        (possibledb-transact! db
+                                              data
+                                              (fn [result]
+                                                (write! result))))))
+
                   (catch js/Object ex
                     (println ex "input =>" safe)
                     (.end socket))))