Fix endless spinner on Fetch messages

Fix endless spinner on Fetch messages

--- src/status_im/mailserver/core.cljs
+++ src/status_im/mailserver/core.cljs
@@ -227,6 +227,13 @@
               (when-not (or sym-key-id generating-sym-key?)
                 (generate-mailserver-symkey mailserver)))))

+(defn executing-gap-request?
+  [{:mailserver/keys [current-request fetching-gaps-in-progress]}]
+  (= (get fetching-gaps-in-progress (:chat-id current-request))
+     (select-keys
+      current-request
+      [:from :to :force-to? :topics :chat-id])))
+
 (fx/defn connect-to-mailserver
   "Add mailserver as a peer using `::add-peer` cofx and generate sym-key when
    it doesn't exists
@@ -235,12 +242,14 @@
    A connection-check is made after `connection timeout` is reached and
    mailserver-state is changed to error if it is not connected by then"
   [{:keys [db] :as cofx}]
-  (let [{:keys [address] :as mailserver} (fetch-current cofx)
+  (let [{:keys [address]} (fetch-current cofx)
         {:keys [peers-summary]} db
-        added? (registered-peer? peers-summary
-                                 address)]
+        added?       (registered-peer? peers-summary address)
+        gap-request? (executing-gap-request? db)]
     (fx/merge cofx
-              {:db (dissoc db :mailserver/current-request)}
+              {:db (cond-> (dissoc db :mailserver/current-request)
+                     gap-request?
+                     (assoc :mailserver/fetching-gaps-in-progress {}))}
               (if added?
                 (mark-trusted-peer)
                 (add-peer)))))
@@ -627,31 +636,25 @@
                :mailserver/request-messages {:web3 (:web3 db)
                                              :mailserver    mailserver
                                              :request request-with-cursor}}))
-          (let [{:keys [chat-id] :as current-request} (db :mailserver/current-request)
-                gaps                    (db :mailserver/fetching-gaps-in-progress)
-                fetching-gap-completed? (= (get gaps chat-id)
-                                           (select-keys
-                                            current-request
-                                            [:from :to :force-to? :topics :chat-id]))]
-            (fx/merge cofx
-                      {:db            (-> db
-                                          (dissoc :mailserver/current-request)
-                                          (update :mailserver/requests-from
-                                                  #(apply dissoc % topics))
-                                          (update :mailserver/requests-to
-                                                  #(apply dissoc % topics))
-                                          (update :mailserver/topics merge mailserver-topics)
-                                          (update :mailserver/fetching-gaps-in-progress
-                                                  (fn [gaps]
-                                                    (if fetching-gap-completed?
-                                                      (dissoc gaps chat-id)
-                                                      gaps))))
-                       :data-store/tx (mapv (fn [[topic mailserver-topic]]
-                                              (data-store.mailservers/save-mailserver-topic-tx
-                                               {:topic            topic
-                                                :mailserver-topic mailserver-topic}))
-                                            mailserver-topics)}
-                      (process-next-messages-request))))))))
+          (fx/merge cofx
+                    {:db            (-> db
+                                        (dissoc :mailserver/current-request)
+                                        (update :mailserver/requests-from
+                                                #(apply dissoc % topics))
+                                        (update :mailserver/requests-to
+                                                #(apply dissoc % topics))
+                                        (update :mailserver/topics merge mailserver-topics)
+                                        (update :mailserver/fetching-gaps-in-progress
+                                                (fn [gaps]
+                                                  (if (executing-gap-request? db)
+                                                    (dissoc gaps (:chat-id request))
+                                                    gaps))))
+                     :data-store/tx (mapv (fn [[topic mailserver-topic]]
+                                            (data-store.mailservers/save-mailserver-topic-tx
+                                             {:topic            topic
+                                              :mailserver-topic mailserver-topic}))
+                                          mailserver-topics)}
+                    (process-next-messages-request)))))))

 (fx/defn retry-next-messages-request
   [{:keys [db] :as cofx}]
@@ -786,7 +789,8 @@

 (fx/defn resend-request
   [{:keys [db] :as cofx} {:keys [request-id]}]
-  (let [current-request (:mailserver/current-request db)]
+  (let [current-request (:mailserver/current-request db)
+        gap-request? (executing-gap-request? db)]
     ;; no inflight request, do nothing
     (when (and current-request
                ;; the request was never successful
@@ -803,16 +807,27 @@
         (fx/merge cofx
                   {:db (update db :mailserver/current-request dissoc :attempts)}
                   (change-mailserver))
-        (if-let [mailserver (get-mailserver-when-ready cofx)]
-          (let [{:keys [topics from to cursor limit] :as request} current-request
-                web3 (:web3 db)]
-            (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to "cursor" cursor "limit" (decrease-limit))
-            {:db (update-in db [:mailserver/current-request :attempts] inc)
-             :mailserver/decrease-limit []
-             :mailserver/request-messages {:web3 web3
-                                           :mailserver mailserver
-                                           :request (assoc request :limit (decrease-limit))}})
-          {:mailserver/decrease-limit []})))))
+        (let [mailserver (get-mailserver-when-ready cofx)
+              offline? (= :offline (:network-status db))]
+          (cond
+            (and gap-request? offline?)
+            {:db (-> db
+                     (dissoc :mailserver/current-request)
+                     (update :mailserver/fetching-gaps-in-progress
+                             dissoc (:chat-id current-request)))}
+
+            mailserver
+            (let [{:keys [topics from to cursor limit] :as request} current-request
+                  web3 (:web3 db)]
+              (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to "cursor" cursor "limit" (decrease-limit))
+              {:db                          (update-in db [:mailserver/current-request :attempts] inc)
+               :mailserver/decrease-limit   []
+               :mailserver/request-messages {:web3       web3
+                                             :mailserver mailserver
+                                             :request    (assoc request :limit (decrease-limit))}})
+
+            :else
+            {:mailserver/decrease-limit []}))))))

 (fx/defn initialize-mailserver
   [cofx custom-mailservers]


:wrench: Minor refactor on text shapes.

:wrench: Minor refactor on text shapes.

--- frontend/src/uxbox/main/ui/shapes/text.cljs
+++ frontend/src/uxbox/main/ui/shapes/text.cljs
@@ -5,22 +5,22 @@
 ;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

 (ns uxbox.main.ui.shapes.text
-  (:require [cuerdas.core :as str]
-            [lentes.core :as l]
-            [goog.events :as events]
-            [potok.core :as ptk]
-            [uxbox.main.store :as st]
-            [uxbox.main.geom :as geom]
-            [uxbox.main.refs :as refs]
-            [uxbox.main.data.shapes :as uds]
-            [uxbox.main.ui.shapes.common :as common]
-            [uxbox.main.ui.shapes.attrs :as attrs]
-            [uxbox.util.color :as color]
-            [uxbox.util.data :refer [classnames normalize-props]]
-            [uxbox.util.dom :as dom]
-            [uxbox.util.geom.matrix :as gmt]
-            [rumext.core :as mx :include-macros true])
-  (:import goog.events.EventType))
+  (:require
+   [cuerdas.core :as str]
+   [goog.events :as events]
+   [lentes.core :as l]
+   [rumext.core :as mx]
+   [rumext.alpha :as mf]
+   [uxbox.main.data.shapes :as uds]
+   [uxbox.main.geom :as geom]
+   [uxbox.main.refs :as refs]
+   [uxbox.main.store :as st]
+   [uxbox.main.ui.shapes.attrs :as attrs]
+   [uxbox.main.ui.shapes.common :as common]
+   [uxbox.util.color :as color]
+   [uxbox.util.data :refer [classnames normalize-props]]
+   [uxbox.util.dom :as dom]
+   [uxbox.util.geom.matrix :as gmt]))

 ;; --- Events

@@ -39,29 +39,29 @@
 (declare text-shape-wrapper)
 (declare text-shape-edit)

-(mx/defcs text-component
-  {:mixins [mx/static mx/reactive]}
-  [own {:keys [id x1 y1 content group] :as shape}]
-  (let [modifiers (mx/react (refs/selected-modifiers id))
-        selected (mx/react refs/selected-shapes)
-        edition? (= (mx/react refs/selected-edition) id)
-        selected? (and (contains? selected id)
-                       (= (count selected) 1))
-        shape (assoc shape :modifiers modifiers)]
-    (letfn [(on-mouse-down [event]
-              (handle-mouse-down event shape selected))
-            (on-double-click [event]
-              ;; TODO: handle grouping event propagation
-              ;; TODO: handle actions locking properly
-              (dom/stop-propagation event)
-              (st/emit! (uds/start-edition-mode id)))]
-      [:g.shape {:class (when selected? "selected")
-                 :ref "main"
-                 :on-double-click on-double-click
-                 :on-mouse-down on-mouse-down}
-       (if edition?
-         (text-shape-edit shape)
-         (text-shape-wrapper shape))])))
+(mf/def text-component
+  :mixins [mf/memo mx/reactive]
+  :render
+  (fn [own {:keys [id x1 y1 content group] :as shape}]
+    (let [modifiers (mx/react (refs/selected-modifiers id))
+          selected (mx/react refs/selected-shapes)
+          edition? (= (mx/react refs/selected-edition) id)
+          selected? (and (contains? selected id)
+                         (= (count selected) 1))
+          shape (assoc shape :modifiers modifiers)]
+      (letfn [(on-mouse-down [event]
+                (handle-mouse-down event shape selected))
+              (on-double-click [event]
+                ;; TODO: handle grouping event propagation
+                ;; TODO: handle actions locking properly
+                (dom/stop-propagation event)
+                (st/emit! (uds/start-edition-mode id)))]
+        [:g.shape {:class (when selected? "selected")
+                   :on-double-click on-double-click
+                   :on-mouse-down on-mouse-down}
+         (if edition?
+           (text-shape-edit shape)
+           (text-shape-wrapper shape))]))))

 ;; --- Text Styles Helpers

@@ -104,97 +104,130 @@

 ;; --- Text Shape Edit

-(defn- text-shape-edit-did-mount
-  [own]
-  (let [[shape] (::mx/props own)
-        dom (mx/ref-node own "container")]
-    (set! (.-textContent dom) (:content shape ""))
-    (.focus dom)
-    own))
-
-(mx/defc text-shape-edit
-  {:did-mount text-shape-edit-did-mount
-   :mixins [mx/static]}
-  [{:keys [id x1 y1 content] :as shape}]
-  (let [{:keys [width height]} (geom/size shape)
-        style (make-style shape)
-        props {:x x1 :y y1 :width width :height height}]
-    (letfn [(on-input [ev]
-              (let [content (dom/event->inner-text ev)]
-                (st/emit! (uds/update-text id content))))]
-      [:foreignObject props
+(mf/def text-shape-edit
+  :mixins [mf/memo]
+
+  :init
+  (fn [own props]
+    (assoc own ::container (mf/create-ref)))
+
+  :did-mount
+  (fn [own]
+    (let [shape (::mf/props own)
+          dom (mx/ref-node (::container own))]
+      (set! (.-textContent dom) (:content shape ""))
+      (.focus dom)
+      own))
+
+  :render
+  (fn [own {:keys [id x1 y1 content] :as shape}]
+    (let [{:keys [width height]} (geom/size shape)
+          style (make-style shape)
+          on-input (fn [ev]
+                     (let [content (dom/event->inner-text ev)]
+                       (st/emit! (uds/update-text id content))))]
+      [:foreignObject {:x x1 :y y1 :width width :height height}
        [:div {:style (normalize-props style)
-              :ref "container"
+              :ref (::container own)
               :on-input on-input
               :contentEditable true}]])))

 ;; --- Text Shape Wrapper

-;; NOTE: this is a hack for the browser rendering.
-;;
-;; Without forcing rerender, when the shape is displaced
-;; and only x and y attrs are updated in dom, the whole content
-;; of the foreignObject becomes sometimes partially or
-;; completelly invisible. The complete dom rerender fixes that
-;; problem.
-
-(defn text-shape-wrapper-did-mount
-  [own]
-  (let [[shape] (::mx/props own)
-        dom (mx/ref-node own "fobject")
-        html (dom/render-to-html (text-shape-html shape))]
-    (set! (.-innerHTML dom) html))
+(mf/def text-shape-wrapper
+  :mixins [mf/memo]
+  :key-fn pr-str
+
+  :init
+  (fn [own props]
+    (assoc own ::fobject (mf/create-ref)))
+
+  ;; NOTE: this is a hack for the browser rendering.
+  ;;
+  ;; Without forcing rerender, when the shape is displaced
+  ;; and only x and y attrs are updated in dom, the whole content
+  ;; of the foreignObject becomes sometimes partially or
+  ;; completelly invisible. The complete dom rerender fixes that
+  ;; problem.
+
+  :did-mount
+  (fn [own]
+    (let [shape (::mf/props own)
+          dom (mf/ref-node (::fobject own))
+          html (dom/render-to-html (text-shape-html shape))]
+      (set! (.-innerHTML dom) html))
     own)

-(mx/defc text-shape-wrapper
-  {:did-mount text-shape-wrapper-did-mount
-   :key-fn #(pr-str %1)}
-  [{:keys [id modifiers] :as shape}]
-  (let [{:keys [displacement resize]} modifiers
-        xfmt (cond-> (gmt/matrix)
-               displacement (gmt/multiply displacement)
-               resize (gmt/multiply resize))
-
-        {:keys [x1 y1 width height] :as shape} (-> (geom/transform shape xfmt)
-                                                   (geom/size))
-        moving? (boolean displacement)]
-    [:foreignObject {:x x1
-                     :y y1
-                     :class (classnames :move-cursor moving?)
-                     :id (str id)
-               :ref "fobject"
-                     :width width
-                     :height height}]))
+  :render
+  (fn [own {:keys [id modifiers] :as shape}]
+    (let [{:keys [displacement resize]} modifiers
+          xfmt (cond-> (gmt/matrix)
+                 displacement (gmt/multiply displacement)
+                 resize (gmt/multiply resize))
+
+          {:keys [x1 y1 width height] :as shape} (-> (geom/transform shape xfmt)
+                                                     (geom/size))
+          moving? (boolean displacement)]
+      [:foreignObject {:x x1
+                       :y y1
+                       :class (classnames :move-cursor moving?)
+                       :id (str id)
+                       :ref (::fobject own)
+                       :width width
+                       :height height}])))

 ;; --- Text Shape Html

-(mx/defc text-shape-html
-  [{:keys [content] :as shape}]
-  (let [style (make-style shape)]
-    [:div {:style style} content]))
+(mf/def text-shape-html
+  :mixins [mf/memo]
+  :render
+  (fn [own {:keys [content] :as shape}]
+    (let [style (make-style shape)]
+      [:div {:style style} content])))

 ;; --- Text Shape Html

-(mx/defc text-shape
-  {:mixins [mx/static]
-   :did-mount text-shape-wrapper-did-mount
-   :key-fn #(pr-str %1)}
-  [{:keys [id content modifiers] :as shape}]
-  (let [{:keys [displacement resize]} modifiers
-        xfmt (cond-> (gmt/matrix)
-               displacement (gmt/multiply displacement)
-               resize (gmt/multiply resize))
-
-        {:keys [x1 y1 width height] :as shape} (-> (geom/transform shape xfmt)
-                                                   (geom/size))
-        moving? (boolean displacement)
-        style (make-style shape)]
-    [:foreignObject {:x x1
-                     :y y1
-                     :class (classnames :move-cursor moving?)
-                     :id (str id)
-                     :ref "fobject"
-                     :width width
-                     :height height}
-     [:div {:style style}
-      [:p content]]]))
+(mf/def text-shape
+  :mixins [mf/memo]
+  :key-fn pr-str
+
+  :init
+  (fn [own props]
+    (assoc own ::fobject (mf/create-ref)))
+
+  ;; NOTE: this is a hack for the browser rendering.
+  ;;
+  ;; Without forcing rerender, when the shape is displaced
+  ;; and only x and y attrs are updated in dom, the whole content
+  ;; of the foreignObject becomes sometimes partially or
+  ;; completelly invisible. The complete dom rerender fixes that
+  ;; problem.
+
+  :did-mount
+  (fn [own]
+    (let [shape (::mf/props own)
+          dom (mf/ref-node (::fobject own))
+          html (dom/render-to-html (text-shape-html shape))]
+      (set! (.-innerHTML dom) html))
+    own)
+
+  :render
+  (fn [own {:keys [id content modifiers] :as shape}]
+    (let [{:keys [displacement resize]} modifiers
+          xfmt (cond-> (gmt/matrix)
+                 displacement (gmt/multiply displacement)
+                 resize (gmt/multiply resize))
+
+          {:keys [x1 y1 width height] :as shape} (-> (geom/transform shape xfmt)
+                                                     (geom/size))
+          moving? (boolean displacement)
+          style (make-style shape)]
+      [:foreignObject {:x x1
+                       :y y1
+                       :class (classnames :move-cursor moving?)
+                       :id (str id)
+                       :ref (::fobject own)
+                       :width width
+                       :height height}
+       [:div {:style style}
+        [:p content]]])))


corrupt all properties of store

corrupt all properties of store

--- src/konserve/compliance_test.cljc
+++ src/konserve/compliance_test.cljc
@@ -1,12 +1,13 @@
 (ns konserve.compliance-test
   (:refer-clojure :exclude [get get-in update update-in assoc assoc-in dissoc exists? keys])
   (:require [clojure.core.async :refer [<!! go chan]]
-            [clojure.string :as str]
             [konserve.core :refer :all]
             #?(:clj [clojure.test :refer :all]
                :cljs [cljs.test :refer :all :include-macros true])))

-(defrecord UnknownType []) ;custom type used to corrupt store
+
+
+(deftype UnknownType [])

 (defn exception? [thing]
   (let [ex (type thing)]
@@ -61,16 +62,9 @@
            (= (type (java.util.Date.)) (type timestamp)))
          list-keys)))

-    (let [corrupt (-> store ; let's corrupt our store
-                    (clojure.core/assoc-in [:config] (UnknownType.)) ;common naming convention
-                    (clojure.core/assoc-in [:con] (UnknownType.))
-                    (clojure.core/assoc-in [:conn] (UnknownType.))
-                    (clojure.core/assoc-in [:store] (UnknownType.))
-                    (clojure.core/assoc-in [:serializers] (UnknownType.)) ;parts of the konserve protocol
-                    (clojure.core/assoc-in [:compressor] (UnknownType.))
-                    (clojure.core/assoc-in [:encryptor] (UnknownType.))
-                    (clojure.core/assoc-in [:read-handlers] (atom (UnknownType.)))
-                    (clojure.core/assoc-in [:write-handlers] (atom (UnknownType.))))]
+    (let [params (clojure.core/keys store)
+          corruptor (fn [s k] (clojure.core/assoc-in s [k] (UnknownType.)))
+          corrupt (reduce corruptor store params)]
       (is (exception? (<!! (get corrupt :bad))))
       (is (exception? (<!! (get-meta corrupt :bad))))
       (is (exception? (<!! (assoc corrupt :bad 10))))


fix typo

fix typo

--- web/src/immutant/web/undertow.clj
+++ web/src/immutant/web/undertow.clj
@@ -85,7 +85,7 @@
     (dissoc options :http2?)))

 (defn ssl-context
-  "Assoc an SSLContext given a keystore and a trustore, which may be
+  "Assoc an SSLContext given a keystore and a truststore, which may be
   either actual KeyStore instances, or paths to them. If truststore is
   ommitted, the keystore is assumed to fulfill both roles"
   [{:keys [keystore key-password truststore trust-password] :as options}]


Include the auth query in the defentity definition

--- src/main/workflo/macros/entity.clj
+++ src/main/workflo/macros/entity.clj
@@ -2,6 +2,7 @@
   (:require [clojure.spec :as s]
             [clojure.string :as string]
             [workflo.macros.command.util :as util]
+            [workflo.macros.query :as q]
             [workflo.macros.specs.entity]))

 ;;;; Configuration
@@ -107,20 +108,28 @@
                                                   [name forms]))))
          description     (:description (:forms args))
          auth            (:auth (:forms args))
+         auth-query      (some-> (:auth-query auth) q/parse)
          validation      (:validation (:forms args))
          schema          (:schema (:forms args))
          forms           (-> (:forms args)
                              (select-keys [:auth :validation :schema])
                              (vals))
          name-sym        (util/unqualify name)
-         forms-map       (zipmap (map (comp keyword :form-name) forms)
+         all-forms       (cond-> forms
+                           auth-query (conj {:form-name 'auth-query}))
+         forms-map       (zipmap (map (comp keyword :form-name)
+                                      all-forms)
                                  (map #(prefixed-form-name % name-sym)
-                                      forms))
+                                      all-forms))
          auth-form       (when auth
                            `((~'defn ~(util/prefix-form-name 'auth
                                                              name-sym)
                               []
                               ~@(:form-body auth))))
+         auth-query-form (when auth-query
+                           `((~'def ~(util/prefix-form-name 'auth-query
+                                                            name-sym)
+                              '~auth-query)))
          validation-form (when validation
                            `((~'def ~(util/prefix-form-name 'validation
                                                             name-sym)
@@ -134,6 +143,7 @@
                            ~forms-map)]
      `(do
         ~@auth-form
+        ~@auth-query-form
         ~@validation-form
         ~@schema-form
         ~definition))))


Fix bugs introduced in previous commits.

--- src/uxbox/ui/dashboard/images.cljs
+++ src/uxbox/ui/dashboard/images.cljs
@@ -130,8 +130,7 @@
         builtin? (= (:collection-type dashboard) :builtin)
         collections (if builtin?
                       (vals library/+image-collections-by-id+)
-                      (rum/react collections-by-id-l))
-
+                      (vals (rum/react collections-by-id-l)))
         show-builtin #(rs/emit! (di/set-collection-type :builtin))
         show-own #(rs/emit! (di/set-collection-type :own))
         new-coll #(rs/emit! (di/create-collection))


Make postgres the default db

Make postgres the default db

Make postgres the default db

--- srcbase/webapp_config/settings.clj
+++ srcbase/webapp_config/settings.clj
@@ -18,18 +18,18 @@
 (defonce ^:dynamic *web-server* "127.0.0.1:3449")

-;(defonce ^:dynamic *database-type* "postgres")
-;(defonce ^:dynamic *database-server* "127.0.0.1")
-;(defonce ^:dynamic *database-user* "postgres")
-;(defonce ^:dynamic *database-password* "manager")
-;(defonce ^:dynamic *database-name* "coils")
+(defonce ^:dynamic *database-type* "postgres")
+(defonce ^:dynamic *database-server* "127.0.0.1")
+(defonce ^:dynamic *database-user* "postgres")
+(defonce ^:dynamic *database-password* "manager")
+(defonce ^:dynamic *database-name* "coils")

-(defonce ^:dynamic *database-type* "oracle")
-(defonce ^:dynamic *database-server* "localhost")
-(defonce ^:dynamic *database-user* "system")
-(defonce ^:dynamic *database-password* "Manager2")
-(defonce ^:dynamic *database-name* "ORCL")
+;(defonce ^:dynamic *database-type* "oracle")
+;(defonce ^:dynamic *database-server* "localhost")
+;(defonce ^:dynamic *database-user* "system")
+;(defonce ^:dynamic *database-password* "Manager2")
+;(defonce ^:dynamic *database-name* "ORCL")


adam harper interview test-code - seems legit

--- test/er_cassandra/model/types_test.clj
+++ test/er_cassandra/model/types_test.clj
@@ -1,6 +1,8 @@
 (ns er-cassandra.model.types-test
   (:require
-   [clojure.test :as test :refer [deftest is are use-fixtures]]
+   [clojure.test :as test :refer [deftest is are use-fixtures testing]]
+   [clojure.string :as string]
+   [manifold.deferred :as deferred]
    [schema.test :as st]
    [er-cassandra.model.types :as t]
    [er-cassandra.model.types :refer :all]))
@@ -62,3 +64,28 @@
                                  :view? true}]})]
     (is (= (->> m :lookup-tables (take 1))
            (t/mutable-lookup-tables m)))))
+
+
+(deftest test-run-callbacks
+  (let [s nil
+        m (t/create-entity
+           {:primary-table {:name :foos :key [:id]}})
+        update-callbacks (fn [m cbs]
+                           (assoc-in m [:callbacks :before-save] cbs))
+        r {:id 1 :name "bar"}]
+      (let [m (update-callbacks m [identity])]
+    (testing "identity"
+        (is (= r @(run-callbacks s m :before-save r)))))
+    (testing "callback sequence"
+      (let [m (update-callbacks m [#(assoc % :name "baz")
+                                   #(update % :name string/upper-case)])
+            exp {:id 1 :name "BAZ"}]
+        (is (= exp @(run-callbacks s m :before-save r)))))
+    (testing "callback deferred"
+      (let [m (update-callbacks m [(reify ICallback
+                                     (run-callback [_ session entity record]
+                                       (deferred/success-deferred
+                                         (update record :name string/upper-case))))])
+            exp {:id 1 :name "BAR"}]
+        (is (= exp @(run-callbacks s m :before-save r)))))
+    (testing "callback error")))


Only test the right namespaces - previously we were testing lots of non-Klangmeister ones.

--- test/klangmeister/test/runner.cljs
+++ test/klangmeister/test/runner.cljs
@@ -1,7 +1,7 @@
 (ns klangmeister.test.runner
-  (:require [doo.runner :refer-macros [doo-all-tests]]
+  (:require [doo.runner :refer-macros [doo-tests]]
             [klangmeister.test.processing]))

 (enable-console-print!)

-(doo-all-tests)
+(doo-tests 'klangmeister.test.processing)


adding a unit test.

adding a unit test.

--- test/metabase/api/meta/db_test.clj
+++ test/metabase/api/meta/db_test.clj
@@ -4,6 +4,7 @@
             [metabase.driver :as driver]
             [metabase.driver.mongo.test-data :as mongo-test-data]
             (metabase.models [database :refer [Database]]
+                             [field :refer [Field]]
                              [table :refer [Table]])
             [metabase.test.data :refer :all]
             (metabase.test.data [datasets :as datasets]
@@ -153,6 +154,70 @@
       (set ((user->client :rasta) :get 200 "meta/db")))))

+;; ## GET /api/meta/table/:id/query_metadata
+;; TODO - add in example with Field :values
+(expect
+  (match-$ (db)
+           {:created_at      $
+            :engine          "h2"
+            :id              $
+            :updated_at      $
+            :name            "Test Database"
+            :organization_id nil
+            :description     nil
+            :tables [(match-$ (Table (id :categories))
+                              {:description  nil
+                               :entity_type  nil
+                               :visibility_type nil
+                               :name         "CATEGORIES"
+                               :display_name "Categories"
+                               :fields       [(match-$ (Field (id :categories :id))
+                                                       {:description     nil
+                                                        :table_id        (id :categories)
+                                                        :special_type    "id"
+                                                        :name            "ID"
+                                                        :display_name    "Id"
+                                                        :updated_at      $
+                                                        :active          true
+                                                        :id              $
+                                                        :field_type      "info"
+                                                        :position        0
+                                                        :target          nil
+                                                        :preview_display true
+                                                        :created_at      $
+                                                        :base_type       "BigIntegerField"
+                                                        :parent_id       nil
+                                                        :parent          nil
+                                                        :values          []})
+                                              (match-$ (Field (id :categories :name))
+                                                       {:description     nil
+                                                        :table_id        (id :categories)
+                                                        :special_type    "name"
+                                                        :name            "NAME"
+                                                        :display_name    "Name"
+                                                        :updated_at      $
+                                                        :active          true
+                                                        :id              $
+                                                        :field_type      "info"
+                                                        :position        0
+                                                        :target          nil
+                                                        :preview_display true
+                                                        :created_at      $
+                                                        :base_type       "TextField"
+                                                        :parent_id       nil
+                                                        :parent          nil
+                                                        :values          []})]
+                               :rows         75
+                               :updated_at   $
+                               :entity_name  nil
+                               :active       true
+                               :id           (id :categories)
+                               :db_id        (db-id)
+                               :created_at   $})]})
+  (let [resp ((user->client :rasta) :get 200 (format "meta/db/%d/metadata" (db-id)))]
+    (assoc resp :tables (filter #(= "CATEGORIES" (:name %)) (:tables resp)))))
+
+
 ;; # DB TABLES ENDPOINTS

 ;; ## GET /api/meta/db/:id/tables


return new versioned entry.

return new versioned entry.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -106,12 +106,14 @@
                                                "-v" revision-id))
                      (assoc :revision-date ts)
                      (assoc :revision-author (first (:author original-entry))))]
-    (when-not (:deleted original-entry)
-      (update-entry conn
-                    (assoc updated-entry :revision-id revision-id-new)
-                    updated-entry
-                    ts))
-    (db-common/create-resource conn versions-table-name revision ts)))
+    (let [updated-entry (if-not (:deleted original-entry)
+                          (update-entry conn
+                            (assoc updated-entry :revision-id revision-id-new)
+                            updated-entry
+                            ts)
+                          updated-entry)]
+      (db-common/create-resource conn versions-table-name revision ts)
+      updated-entry)))

 (defn delete-versions [conn entry]
   (doseq [version (range (inc (:revision-id entry)))]
@@ -249,8 +251,7 @@
           updated-entry (assoc entry :author updated-authors)]
       (let [updated-entry (update-entry conn updated-entry original-entry ts)]
         ;; copy current version to versions table, increment revision uuid
-        (create-version conn updated-entry original-entry)
-        updated-entry))))
+        (create-version conn updated-entry original-entry)))))

 (defn upsert-entry!
   "
@@ -307,12 +308,12 @@
           updated-authors (conj authors (assoc publisher :updated-at ts))
           entry-update (assoc merged-entry :author updated-authors)]
       (schema/validate common/Entry entry-update)
-      (let [updated-entry (db-common/update-resource conn table-name primary-key original-entry entry-update ts)]
-        ;; copy current version to versions table, increment revision uuid
-        (create-version conn updated-entry entry-update)
+      (let [updated-entry (db-common/update-resource conn table-name primary-key original-entry entry-update ts)
+            ;; copy current version to versions table, increment revision uuid
+            versioned-entry (create-version conn updated-entry entry-update)]
         ;; Delete the draft entry's interactions
         (db-common/delete-resource conn common/interaction-table-name :resource-uuid uuid)
-        updated-entry)))))
+        versioned-entry)))))

 (schema/defn ^:always-validate delete-entry!
   "Given the UUID of the entry, delete the entry and all its interactions. Return `true` on success."


Preserve the current published-at if there is one when the entry is being created as published.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -167,7 +167,12 @@
   Throws a runtime exception if the provided entry doesn't conform to the
   common/Entry schema. Throws an exception if the board specified in the entry can't be found.
   "
-  ([conn entry :- common/Entry] (create-entry! conn entry (db-common/current-timestamp)))
+  ([conn entry :- common/Entry]
+   (let [ts (if (and (seq (:published-at entry))
+                      (= (keyword (:status entry)) :published))
+               (:published-at entry)
+               (db-common/current-timestamp))]
+     (create-entry! conn entry ts)))

   ([conn entry :- common/Entry ts :- lib-schema/ISO8601]
   {:pre [(db-common/conn? conn)]}


remove console log

remove console log

--- src/app/cljs/one/sample/model.cljs
+++ src/app/cljs/one/sample/model.cljs
@@ -32,7 +32,6 @@
   (let [state   (atom {:who     who
                        :id      (or id (uuid))
                        :content content})
-        logit (.log js/console "doc-session" (pr-str @state))
         history (atom '())
         cursor  (atom 0)
         watch   (add-watch state :document-state-key


(PDB-4812) convert-to-schema: always throw an exception

Previously this could crash when we attempted to throw the map
returned by error-val rather than an exception.

That can be demonstrated, for example, by adding an optional key to
one of the *-config-in maps in config, but not the
corresponding *-config-out map, and then attempting to use the value.

The exact case that uncovered it was the addition of this (which
wasn't quite right anyway) to per-database-config-in:

  :min-required-version (s/maybe [s/Int])

--- src/puppetlabs/puppetdb/schema.clj
+++ src/puppetlabs/puppetdb/schema.clj
@@ -1,6 +1,7 @@
 (ns puppetlabs.puppetdb.schema
   (:require [puppetlabs.puppetdb.time :as time]
             [schema.core :as s]
+            [puppetlabs.i18n.core :refer [trs]]
             [puppetlabs.kitchensink.core :as kitchensink]
             [schema.coerce :as sc]
             [clojure.string :as str]
@@ -135,9 +136,14 @@
   "Convert `data` to the format specified by `schema`"
   [schema data]
   (let [result ((sc/coercer schema conversion-fns) data)]
-    (if (su/error? result)
-      (throw (su/error-val result))
-      result)))
+    (when (su/error? result)
+      ;; Intended to roughly match plumatic's validator behavior
+      (let [error (su/error-val result)]
+        (throw (ex-info (trs "schema coercion error: {0}" (pr-str error))
+                        {:schema schema
+                         :value data
+                         :error error}))))
+    result))

 (defn unknown-keys
   "Returns all the keys in `data` not specified by `schema`"


[#8256] do not call getApplicationInfo every time card connected

Signed-off-by: Dmitry Novotochinov <b5b1b877a7d2fe39ba1f1c39d1fd1abc6e284505@gmail.com>

--- src/status_im/hardwallet/core.cljs
+++ src/status_im/hardwallet/core.cljs
@@ -301,6 +301,10 @@
   [{:keys [db]}]
   {:db (assoc-in db [:hardwallet :on-card-read] nil)})

+(fx/defn clear-on-card-connected
+  [{:keys [db]}]
+  {:db (assoc-in db [:hardwallet :on-card-connected] nil)})
+
 (fx/defn dispatch-event
   [_ event]
   {:dispatch [event]})
@@ -382,7 +386,7 @@
              :hardwallet/register-card-events nil
              :db                              (-> db
                                                   (assoc-in [:hardwallet :setup-step] :begin)
-                                                  (assoc-in [:hardwallet :on-card-connected] nil)
+                                                  (assoc-in [:hardwallet :on-card-connected] :hardwallet/get-application-info)
                                                   (assoc-in [:hardwallet :on-card-read] :hardwallet/check-card-state)
                                                   (assoc-in [:hardwallet :pin :on-verified] nil))}
             (navigation/navigate-to-cofx :hardwallet-connect nil)))
@@ -870,13 +874,14 @@
                                               :original     []
                                               :confirmation []}))

-(fx/defn wait-for-card-tap
+(fx/defn proceed-to-login
   [{:keys [db] :as cofx}]
   (let [card-connected? (get-in db [:hardwallet :card-connected?])]
     (if card-connected?
       (login-with-keycard cofx false)
       (fx/merge cofx
                 {:db (-> db
+                         (assoc-in [:hardwallet :on-card-connected] :hardwallet/get-application-info)
                          (assoc-in [:hardwallet :on-card-read] :hardwallet/login-with-keycard))}
                 (navigation/navigate-to-cofx :hardwallet-connect nil)))))

@@ -970,7 +975,7 @@

       (and (= enter-step :login)
            (= 6 numbers-entered))
-      (wait-for-card-tap)
+      (proceed-to-login)

       (and (= enter-step :original)
            (= pin-code-length numbers-entered))
@@ -1057,13 +1062,13 @@
               {:db (-> db
                        (assoc-in [:hardwallet :card-connected?] true)
                        (assoc-in [:hardwallet :card-read-in-progress?] (boolean on-card-read)))}
-              (when-not (contains? #{:hardwallet/sign
-                                     :hardwallet/verify-pin
-                                     :hardwallet/change-pin} on-card-connected)
+              (when on-card-connected
+                (dispatch-event on-card-connected))
+              (when on-card-connected
+                (clear-on-card-connected))
+              (when (and on-card-read
+                         (nil? on-card-connected))
                 (get-application-info pairing on-card-read))
-              (when (and on-card-connected
-                         (not login?))
-                (dispatch-event on-card-connected))
               (when setup-running?
                 (navigation/navigate-to-cofx :hardwallet-setup nil)))))

@@ -1124,7 +1129,9 @@
   [{:keys [db] :as cofx} {:keys [code error]}]
   (log/debug "[hardwallet] install applet and init card error: " error)
   (fx/merge cofx
-            {:db (assoc-in db [:hardwallet :setup-error] error)}
+            {:db (-> db
+                     (assoc-in [:hardwallet :on-card-connected] :hardwallet/load-preparing-screen)
+                     (assoc-in [:hardwallet :setup-error] error))}
             (process-error code error)))

 (def on-init-card-error on-install-applet-and-init-card-error)
@@ -1166,7 +1173,9 @@
     (fx/merge cofx
               {:db (-> db
                        (assoc-in [:hardwallet :setup-error] (i18n/label :t/invalid-pairing-password))
-                       (assoc-in [:hardwallet :on-card-connected] nil))}
+                       (assoc-in [:hardwallet :on-card-connected] (if (= setup-step :pairing)
+                                                                    :hardwallet/load-pairing-screen
+                                                                    :hardwallet/pair)))}
               (when (not= setup-step :enter-pair-code)
                 (process-error code error)))))

@@ -1181,7 +1190,9 @@
   [{:keys [db] :as cofx} {:keys [error code]}]
   (log/debug "[hardwallet] generate mnemonic error: " error)
   (fx/merge cofx
-            {:db (assoc-in db [:hardwallet :setup-error] error)}
+            {:db (-> db
+                     (assoc-in [:hardwallet :on-card-connected] :hardwallet/load-generating-mnemonic-screen)
+                     (assoc-in [:hardwallet :setup-error] error))}
             (process-error code error)))

 (fx/defn recovery-phrase-start-confirmation [{:keys [db]}]
@@ -1327,7 +1338,9 @@
   [{:keys [db] :as cofx} {:keys [error code]}]
   (log/debug "[hardwallet] generate and load key error: " error)
   (fx/merge cofx
-            {:db (assoc-in db [:hardwallet :setup-error] error)}
+            {:db (-> db
+                     (assoc-in [:hardwallet :on-card-connected] :hardwallet/load-loading-keys-screen)
+                     (assoc-in [:hardwallet :setup-error] error))}
             (process-error code error)))

 (fx/defn on-get-keys-success


RS + DM | 26 | Update callback handler and extract token request as a separate function

--- src/stonecutter_client/handler.clj
+++ src/stonecutter_client/handler.clj
@@ -14,6 +14,36 @@
             [stonecutter-client.view.voting :as voting]
             [stonecutter-client.view.view-poll :as view-poll]))

+;; ======================================================
+(defn authorisation-redirect-response  [stonecutter-config]
+  (let  [callback-uri  (:callback-uri stonecutter-config)
+         oauth-authorisation-path  (str  (:auth-provider-url stonecutter-config)
+                                        "/authorisation?client_id="  (:client-id stonecutter-config)
+                                        "&response_type=code&redirect_uri=" callback-uri)]
+    (->  (r/redirect oauth-authorisation-path)
+        (assoc-in  [:headers "accept"] "text/html"))))
+
+(defn request-access-token!  [stonecutter-config auth-code]
+  (let  [callback-uri  (:callback-uri stonecutter-config)
+         oauth-token-path  (str  (:auth-provider-url stonecutter-config) "/api/token")
+         token-response (http/post oauth-token-path  {:form-params  {:grant_type    "authorization_code"
+                                                                      :redirect_uri  callback-uri
+                                                                      :code          auth-code
+                                                                      :client_id     (:client-id stonecutter-config)
+                                                                      :client_secret  (:client-secret stonecutter-config)}})]
+    (-> token-response :body  (json/parse-string keyword))))
+
+(defn configure  [auth-provider-url
+                  client-id
+                  client-secret
+                  callback-uri]
+  (if  (and auth-provider-url client-id client-secret callback-uri)
+    {:auth-provider-url auth-provider-url
+     :client-id client-id
+     :client-secret client-secret
+     :callback-uri callback-uri}
+    :invalid-configuration))
+;; ======================================================
 (defn get-env
   ([k]
    (get-env k nil))
@@ -50,15 +80,13 @@
     (r/redirect (absolute-path :voting))
     (html-response (login/login-page request))))

+(def stonecutter-config (configure (auth-url)
+                                   (get-env :client-id)
+                                   (get-env :client-secret)
+                                   (str (base-url) "/callback")))
+
 (defn login [request]
-  (let [client-id (get-env :client-id)
-        callback-uri (str (base-url) "/callback")
-        oauth-authorisation-path (str (auth-url) "/authorisation?client_id=" client-id "&response_type=code&redirect_uri=" callback-uri)
-        response
-        (-> (r/redirect oauth-authorisation-path)
-            (assoc :params {:client_id client-id :response_type "code" :redirect_uri callback-uri})
-            (assoc-in [:headers "accept"] "text/html"))]
-    response))
+  (authorisation-redirect-response stonecutter-config))

 (defn logout [request]
   (-> (r/redirect (absolute-path :home))
@@ -66,21 +94,10 @@

 (defn oauth-callback [request]
   (if-let [auth-code (get-in request [:params :code])]
-  (let [client-id (get-env :client-id)
-        client-secret (get-env :client-secret)
-        callback-uri (str (base-url) "/callback")
-        oauth-token-path (str (auth-url) "/api/token")
-        token-response (http/post oauth-token-path {:form-params {:grant_type    "authorization_code"
-                                                                  :redirect_uri  callback-uri
-                                                                  :code          auth-code
-                                                                  :client_id     client-id
-                                                                  :client_secret client-secret}})
-        token-body (-> token-response
-                       :body
-                       (json/parse-string keyword))]
-    (-> (r/redirect (absolute-path :voting))
-        (assoc :session {:access-token (:access_token token-body)
-                         :user (:user-email token-body)})))
+    (let [token-body (request-access-token! stonecutter-config auth-code)]
+      (-> (r/redirect (absolute-path :voting))
+          (assoc :session {:access-token (:access_token token-body)
+                           :user (:user-email token-body)})))
     (r/redirect (absolute-path :home))))

 (defn voting [request]


♻ Extract admin-permissions-granted

♻ Extract admin-permissions-granted

Why:
- Remove duplication

--- src/territory_bro/congregation.clj
+++ src/territory_bro/congregation.clj
@@ -109,6 +109,14 @@

 (defmulti ^:private command-handler (fn [command _congregation _injections]
                                       (:command/type command)))
+
+(defn- admin-permissions-granted [cong-id user-id]
+  (for [permission [:view-congregation :configure-congregation :gis-access]]
+    {:event/type :congregation.event/permission-granted
+     :event/version 1
+     :congregation/id cong-id
+     :user/id user-id
+     :permission/id permission}))

 (defmethod command-handler :congregation.command/create-congregation
   [command _congregation {:keys [generate-tenant-schema-name]}]
@@ -117,26 +125,13 @@
         name (:congregation/name command)]
     (when (str/blank? name)
       (throw (ValidationException. [[:missing-name]])))
-    [{:event/type :congregation.event/congregation-created
-      :event/version 1
-      :congregation/id cong-id
-      :congregation/name name
-      :congregation/schema-name (generate-tenant-schema-name cong-id)}
-     {:congregation/id cong-id
-      :event/type :congregation.event/permission-granted
-      :event/version 1
-      :permission/id :view-congregation
-      :user/id user-id}
-     {:congregation/id cong-id
-      :event/type :congregation.event/permission-granted
-      :event/version 1
-      :permission/id :configure-congregation
-      :user/id user-id}
-     {:congregation/id cong-id
-      :event/type :congregation.event/permission-granted
-      :event/version 1
-      :permission/id :gis-access
-      :user/id user-id}]))
+    (cons {:event/type :congregation.event/congregation-created
+           :event/version 1
+           :congregation/id cong-id
+           :congregation/name name
+           :congregation/schema-name (generate-tenant-schema-name cong-id)}
+          ;; TODO: grant initial permissions using a process manager (after moving the events to a user stream)
+          (admin-permissions-granted cong-id user-id))))

 (defmethod command-handler :congregation.command/add-user
   [command congregation {:keys [user-exists? check-permit]}]
@@ -148,22 +143,8 @@
     (when-not (user-exists? user-id)
       (throw (ValidationException. [[:no-such-user user-id]])))
     (when-not already-user?
-      [{:event/type :congregation.event/permission-granted
-        :event/version 1
-        :congregation/id cong-id
-        :user/id user-id
-        :permission/id :view-congregation}
-       ;; TODO: remove these after the admin can himself edit user permissions
-       {:event/type :congregation.event/permission-granted
-        :event/version 1
-        :congregation/id cong-id
-        :user/id user-id
-        :permission/id :configure-congregation}
-       {:event/type :congregation.event/permission-granted
-        :event/version 1
-        :congregation/id cong-id
-        :user/id user-id
-        :permission/id :gis-access}])))
+      ;; TODO: only grant :view-congregation to new users (after admin has a UI for editing permissions)
+      (admin-permissions-granted cong-id user-id))))

 (defmethod command-handler :congregation.command/set-user-permissions
   [command congregation {:keys [user-exists? check-permit]}]


♻ Reorder congregation functions

♻ Reorder congregation functions

Why:
- Group all commands together, whether event sourced or CRUD.

--- src/territory_bro/congregation.clj
+++ src/territory_bro/congregation.clj
@@ -16,7 +16,7 @@
   (:import (java.util UUID)
            (territory_bro ValidationException)))

-;;; Read model
+;;;; Read model

 (defmulti ^:private update-congregation (fn [_congregation event]
                                           (:event/type event)))
@@ -76,6 +76,9 @@
       (update-in [::congregations (:congregation/id event)] update-congregation event)
       (update-permissions event)))

+
+;;;; Queries
+
 (defn get-unrestricted-congregations [state]
   (vals (::congregations state)))

@@ -97,36 +100,15 @@
   (-> (get-unrestricted-congregation state cong-id)
       (apply-user-permissions user-id)))

-(defn use-schema [conn state cong-id] ; TODO: create a better helper?
-  (let [cong (get-unrestricted-congregation state cong-id)
-        schema (:congregation/schema-name cong)]
-    (db/use-tenant-schema conn schema)))
-
-(defn create-congregation! [conn name]
-  (let [id (UUID/randomUUID)
-        master-schema (:database-schema config/env)
-        tenant-schema (str master-schema
-                           "_"
-                           (str/replace (str id) "-" ""))]
-    (assert (not (contains? (set (db/get-schemas conn))
-                            tenant-schema))
-            {:schema-name tenant-schema})
-    (event-store/save! conn id 0 [(assoc (events/defaults)
-                                         :event/type :congregation.event/congregation-created
-                                         :congregation/id id
-                                         :congregation/name name
-                                         :congregation/schema-name tenant-schema)])
-    (-> (db/tenant-schema tenant-schema master-schema)
-        (.migrate))
-    (log/info "Congregation created:" id)
-    id))
-

 ;;;; Write model

 (defn- write-model [congregation event]
   (-> congregation
       (update-congregation event)))
+
+
+;;;; Command handlers

 (defmulti ^:private command-handler (fn [command _congregation _injections]
                                       (:command/type command)))
@@ -208,6 +190,33 @@
     (event-store/save! conn stream-id (count old-events) new-events)))

+;;;; Other commands
+
+(defn use-schema [conn state cong-id] ; TODO: create a better helper?
+  (let [cong (get-unrestricted-congregation state cong-id)
+        schema (:congregation/schema-name cong)]
+    (db/use-tenant-schema conn schema)))
+
+(defn create-congregation! [conn name]
+  (let [id (UUID/randomUUID)
+        master-schema (:database-schema config/env)
+        tenant-schema (str master-schema
+                           "_"
+                           (str/replace (str id) "-" ""))]
+    (assert (not (contains? (set (db/get-schemas conn))
+                            tenant-schema))
+            {:schema-name tenant-schema})
+    (event-store/save! conn id 0 [(assoc (events/defaults)
+                                         :event/type :congregation.event/congregation-created
+                                         :congregation/id id
+                                         :congregation/name name
+                                         :congregation/schema-name tenant-schema)])
+    (-> (db/tenant-schema tenant-schema master-schema)
+        (.migrate))
+    (log/info "Congregation created:" id)
+    id))
+
+
 ;;;; User access

 (defn get-users [state cong-id]


some optimizations

some optimizations

--- src/bluebell/utils/setdispatch.clj
+++ src/bluebell/utils/setdispatch.clj
@@ -136,12 +136,8 @@
      system
      (clojure.set/difference all-sets all-elements))))

-(defn resolve-fn-call [system dispatch-state args]
-  (let [arity (count args)
-        feature-extractor (:feature-extractor dispatch-state)
-        args-memberships (map (partial evaluate-feature-set-memberships
-                                       feature-extractor)
-                              args)
+(defn compute-alternatives [system dispatch-state args-memberships]
+  (let [arity (count args-memberships)
         system (add-set-canonical-elements
                 (transduce cat
                            tr-ss-add
@@ -157,6 +153,21 @@
         frontier (pareto/elements (reduce pareto/insert
                                           (pareto/frontier alt-dominates?)
                                           matching-alternatives))]
+    (utils/map-of arity alternatives matching-alternatives frontier)))
+
+(def memoized-compute-alternatives (memoize compute-alternatives))
+
+(defn resolve-fn-call [system dispatch-state args]
+  (let [args-memberships (map (partial evaluate-feature-set-memberships
+                                       (:feature-extractor dispatch-state))
+                              args)
+        {:keys [arity
+                frontier
+                alternatives
+                matching-alternatives]} (memoized-compute-alternatives
+                                         system
+                                         dispatch-state
+                                         args-memberships)]
     (cond
       (empty? frontier) (throw (ex-info "No matching set-fn for this arity."
                                         (match-error-map


fix rendering of capacities while topology is starting up

--- src/clj/backtype/storm/ui/core.clj
+++ src/clj/backtype/storm/ui/core.clj
@@ -379,10 +379,11 @@
   (link-to (url-format "/topology/%s/component/%s" storm-id id) id))

 (defn render-capacity [capacity]
-  [:span (if (and capacity (> capacity 0.9))
-               {:class "red"}
-               {})
-         (float-str capacity)])
+  (let [capacity (nil-to-zero capacity)]
+    [:span (if (> capacity 0.9)
+                 {:class "red"}
+                 {})
+           (float-str capacity)]))

 (defn compute-executor-capacity [^ExecutorSummary e]
   (let [stats (.get_stats e)
@@ -404,6 +405,7 @@
 (defn compute-bolt-capacity [executors]
   (->> executors
        (map compute-executor-capacity)
+       (map nil-to-zero)
        (apply max)))

 (defn spout-comp-table [top-id summ-map errors window include-sys?]


comments

comments

--- src/cljs/triboard/logic/board.cljs
+++ src/cljs/triboard/logic/board.cljs
@@ -18,6 +18,7 @@
   (vec (for [x (range width) y (range height)] [x y])))

 (def empty-board
+  "An empty board of `width` columns times `height` owners"
   (let [empty-column (vec (repeat height :none))]
     (vec (repeat width empty-column))))


Return nil when evaling entire files

Return nil when evaling entire files

--- src/clojure/nightcode/builders.clj
+++ src/clojure/nightcode/builders.clj
@@ -34,7 +34,7 @@
                  [selected]
                  (for [source (-> (lein/read-project-clj path)
                                   (lein/stale-clojure-sources timestamp))]
-                   (slurp source)))]
+                   (str (slurp source) " nil")))]
     (->> (str "(do " (clojure.string/replace code "\n" " ") ")")
          (.enterLine console)))
   (s/request-focus! (-> console .getViewport .getView)))


CMR-5104: Fixed placement of docstring.

CMR-5104: Fixed placement of docstring.

--- src/cmr/opendap/testing/system.clj
+++ src/cmr/opendap/testing/system.clj
@@ -14,11 +14,11 @@
   :throw-errors true})

 (defn init
-  []
   "This is used to set the options and any other global data.

   This is defined in a function for re-use. For instance, when a REPL is
   reloaded, the options will be lost and need to be re-applied."
+  []
   (logger/set-level! '[] :fatal)
   (system-api/setup-manager setup-options))


correct import test query

correct import test query

--- test/clj_money/import_test.clj
+++ test/clj_money/import_test.clj
@@ -280,7 +280,14 @@
                                     :created-at
                                     :updated-at)
                          lots)
-        prices  (prices/search storage-spec {:entity-id (:id entity)})
+        aapl (first (commodities/search storage-spec
+                                        {:entity-id (:id entity)
+                                         :symbol "AAPL"}
+                                        {:limit 1}))
+        prices  (prices/search storage-spec {:commodity-id (:id aapl)
+                                             :trade-date [:between
+                                                          (t/local-date 2015 1 1)
+                                                          (t/local-date 2015 12 31)]})
         actual-prices (->> prices
                            (map #(dissoc % :id
                                            :commodity-id


check that data has been inserted

check that data has been inserted

--- test/clojento/magento/t_db.clj
+++ test/clojento/magento/t_db.clj
@@ -62,4 +62,7 @@
         (raw-jdbc-fetch (:db @system) "show tables;") => (contains {:table_name "core_store", :table_schema "public"}))
   (fact "make sure db is read-only"
         (raw-jdbc-execute (:db @system) write-query) => (throws org.h2.jdbc.JdbcBatchUpdateException #"read only"))
+  (fact "db contains 2 websites (admin + 1) and 2 stores"
+        (count (raw-jdbc-fetch (:db @system) "select * from core_website;")) => 2
+        (count (raw-jdbc-fetch (:db @system) "select * from core_store;")) => 2)
   (log/info "completed tests with read-only DB"))


Create key value reduce tests

Create key value reduce tests

--- test/clojure/lean_map/test.clj
+++ test/clojure/lean_map/test.clj
@@ -24,4 +24,8 @@

 (t/deftest seq-operations
   (t/is (= false (-> lmu/empty (assoc :foo :bar) seq empty?)))
-  (t/is (= [:foo :bar] (-> lmu/empty (assoc :foo :bar) seq first))))+  (t/is (= [:foo :bar] (-> lmu/empty (assoc :foo :bar) seq first))))
+
+(t/deftest kv-reduce-operations
+  (t/is (= 45 (let [kvm (->> (zipmap (range 10) (range 10)) (into lmu/empty))]
+                (.kvreduce kvm (fn [sum _ v] (+ sum v)) 0)))))


Replace println with doall.

Replace println with doall.

--- test/minijava/test_compile.clj
+++ test/minijava/test_compile.clj
@@ -9,7 +9,7 @@
                  (accept [_ name] (not (nil? (re-find #"java$" name)))))
         files (-> "resources/sample" java.io.File. (.listFiles filter))]
     (doseq [f files]
-    (println (compile-program f)))))
+      (doall (compile-program f)))))

 (deftest test-factorial
@@ -34,7 +34,7 @@

 }" ]

- (println (compile-program prog))
+ (doall (compile-program prog))

 ))

@@ -141,7 +141,7 @@

 }"]

- (println (compile-program prog))
+ (doall (compile-program prog))

 ))


fix tests

fix tests

--- test/spec_tools/core_test.cljc
+++ test/spec_tools/core_test.cljc
@@ -117,9 +117,9 @@
                   (st/opt :description) string?})
         s-keys (s/keys
                  :req [::id ::age]
-                 :req-un [:spec-tools.core-test$$my-map/boss
-                          :spec-tools.core-test$$my-map/name]
-                 :opt-un [:spec-tools.core-test$$my-map/description])]
+                 :req-un [:spec-tools.core-test$my-map/boss
+                          :spec-tools.core-test$my-map/name]
+                 :opt-un [:spec-tools.core-test$my-map/description])]
     (is (= (s/form s-keys) (s/form st-map)))
     (testing "conforming"
       (let [value {::id 1, ::age 18 :boss true, :name "Mikko", :description "Shoes"}]


fix cljs.source-map/seg->map

fix cljs.source-map/seg->map

--- src/main/cljs/cljs/source_map.cljs
+++ src/main/cljs/cljs/source_map.cljs
@@ -56,11 +56,11 @@
   [seg source-map]
   (let [[gcol source line col name] seg]
    {:gcol   gcol
-    :source (aget (.split (gobj/get source-map "sources" source) "?") 0)
+    :source (aget (gobj/get source-map "sources") source)
     :line   line
     :col    col
     :name   (when-let [name (-> seg meta :name)]
-              (gobj/get source-map "names" name))}))
+              (aget (gobj/get source-map "names") name))}))

 (defn seg-combine
   "Combine a source map segment vector and a relative


Adds some tests and notes.

Adds some tests and notes.

--- test/active/clojure/match_test.clj
+++ test/active/clojure/match_test.clj
@@ -101,29 +101,54 @@

 (t/deftest clause->lhs

-  (t/testing "key exists"
+  (t/testing "key exists with binding"
+    ;; FIXME: what are we testing here?
     (t/is (= {:x 'x} (p/clause->lhs {} (p/key-exists-with-binding-clause :x "x"))))
     (t/is (= {:x 'rebind} (p/clause->lhs {} (p/key-exists-with-binding-clause :x "rebind")))))

-  (t/testing "path exists"
+  (t/testing "key exists without binding"
+    (t/is (= {:x '_} (p/clause->lhs {} (p/key-exists-without-binding-clause :x)))))
+
+  (t/testing "path exists with binding"
     (t/is (= {:x {"b" {"c" 'c}}}
              (p/clause->lhs {} (p/path-exists-with-binding-clause [:x "b" "c"] "c"))))
     (t/is (= {:x {"b" {"c" 'rebind}}}
              (p/clause->lhs {} (p/path-exists-with-binding-clause [:x "b" "c"] "rebind")))))

-  (t/testing "key matches"
+  (t/testing "path exists without binding"
+    (t/is (= {:x {"b" {"c" '_}}}
+             (p/clause->lhs {} (p/path-exists-without-binding-clause [:x "b" "c"])))))
+
+  (t/testing "key matches with binding"
     (t/is (= {:x "b"} (p/clause->lhs {} (p/key-matches-with-binding-clause :x (p/match-const "b") "x"))))
-    (t/testing "lhs doesn't care abound bindings"
+    ;; FIXME: why is this a new testing / is there something special about rebind?
+    (t/testing "lhs doesn't care about bindings"
       (t/is (= {:x "b"} (p/clause->lhs {} (p/key-matches-with-binding-clause :x (p/match-const "b") "rebind")))))
+    ;; FIXME: what is wrong with that test?
     #_(t/is (= `({:x ~(quote _)} :guard [(constantly (~even? (get-in {} [:x])))])
              (p/clause->lhs {} (p/key-matches-with-binding-clause :x (p/match-predicate even?))))))

-  (t/testing "path matches"
-    (t/is (= {:x {:y {:z "b"}}} (p/clause->lhs {} (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "z"))))
+  (t/testing "key matches without binding"
+    (t/is (= {:x "b"} (p/clause->lhs {} (p/key-matches-without-binding-clause :x (p/match-const "b"))))))
+
+  (t/testing "path matches with binding"
+    ;; FIXME: is there a difference between these two tests? except for syntactic sugar?
+    (t/is (= {:x {:y {:z "b"}}}
+             (p/clause->lhs {} (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "z"))))
+    (t/is (= {:x {:y {:z "b"}}}
+             (p/clause->lhs {} (-> (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "z")))))
     (t/is (= {:x {:y {:z "b"}}}
              (p/clause->lhs {} (-> (p/path-matches-with-binding-clause [:x :y :z] (p/match-const "b") "rebind")))))
+    ;; FIXME: what is wrong with that test?
     #_(t/is (= `({:x {:y {"Z" ~(quote _)}}} :guard [(constantly (~even? (get-in {} [:x :y "Z"])))])
-             (p/clause->lhs {} (p/path-matches-with-binding-clause [:x :y "Z"] (p/match-predicate even?)))))))
+             (p/clause->lhs {} (p/path-matches-with-binding-clause [:x :y "Z"] (p/match-predicate even?))))))
+
+  (t/testing "path matches without binding"
+    ;; FIXME: is there a difference between these two tests? except for syntactic sugar?
+    (t/is (= {:x {:y {:z "b"}}}
+             (p/clause->lhs {} (p/path-matches-without-binding-clause [:x :y :z] (p/match-const "b")))))
+    (t/is (= {:x {:y {:z "b"}}}
+             (p/clause->lhs {} (-> (p/path-matches-without-binding-clause [:x :y :z] (p/match-const "b"))))))))

 (t/deftest path-matches-with-binding-clause->rhs-match-test
   (t/is (= `[~(symbol "z") (get-in {:x {:y {:z "b"}}} [:x :y :z] "b")]
@@ -241,7 +266,8 @@
                            [a c C Z])
             two-data))))

-(t/deftest map-matcher-regex-key-not-found-t
+ ;; FIXME: map-matcher-or-test - #3 --- same test?
+(t/deftest map-matcher-regex-key-not-found-test
   (t/is (= false
            (example-matcher three-data))))

@@ -263,6 +289,7 @@
            (example-or-matcher one-data)))
   (t/is (= ["a" "c" 42 23]
            (example-or-matcher two-data)))
+  ;; FIXME: this is not an example-or-matcher
   (t/is (= false (example-matcher {:kind "none"}))))

@@ -320,6 +347,7 @@
   (t/testing "with compare-fn"
     (let [evt {"X" "x"}]
       (t/is (= "x"
+               ;; FIXME: please explain: #(= % )
                ((p/map-matcher [(X (:compare-fn #(= % (get evt "X"))))] x)
                 evt)))))
   (t/testing "as local constant"
@@ -333,6 +361,7 @@
       (t/is (= x
                ((p/map-matcher [(X x)] x)
                 evt)))))
+  ;; FIXME: Docu below the same, tests different
   (t/testing "as constant with global defpattern"
     (let [x   "x"
           evt {"X" x}]


Add property test for cursor position and row/column count

--- test/asciinema_player/vt_test.cljs
+++ test/asciinema_player/vt_test.cljs
@@ -1392,8 +1392,34 @@
   (let [vt (-> (make-vt 4 3) (assoc-in [:parser :param-chars] [0x3b 0x3b 0x31 0x32 0x3b 0x3b 0x32 0x33 0x3b 0x31 0x3b]))]
     (is (= (get-params vt) [0 0 12 0 23 1]))))

-(defspec feeding-rubbish
+(def gen-rubbish (gen/vector (gen/choose 0 0x9f) 1 100))
+
+(defspec test-parser-state-for-random-input
   100
-  (let [vt (make-vt 80 24)]
-    (prop/for-all [rubbish (gen/vector (gen/choose 0 0x7f) 1 100)]
-                  (not= nil (-> vt (feed rubbish) :parser :state)))))
+  (prop/for-all [rubbish gen-rubbish]
+                (let [vt (-> (make-vt 80 24) (feed rubbish))]
+                  (keyword? (-> vt :parser :state)))))
+
+(defspec test-cursor-position-for-random-input
+  100
+  (prop/for-all [x (gen/choose 0 19)
+                 y (gen/choose 0 9)
+                 rubbish gen-rubbish]
+                (let [vt (-> (make-vt 20 10)
+                             (move-cursor x y)
+                             (feed rubbish))
+                      {{:keys [x y]} :cursor} vt]
+                  (and (< -1 x 20)
+                       (< -1 y 10)))))
+
+(defspec test-row-and-column-count-for-random-input
+  100
+  (prop/for-all [x (gen/choose 0 19)
+                 y (gen/choose 0 9)
+                 rubbish gen-rubbish]
+                (let [vt (-> (make-vt 20 10)
+                             (move-cursor x y)
+                             (feed rubbish))
+                      {:keys [lines]} vt]
+                  (and (= 10 (count lines))
+                       (every? #(= 20 (count %)) lines)))))


Working on porting third test.

Working on porting third test.

--- test/blutwurst/jsonschema_test.clj
+++ test/blutwurst/jsonschema_test.clj
@@ -31,16 +31,24 @@
    )
   )

-#_(testing "Handles complex arrays."
+(testing "Handles complex arrays."
        (let [spec {:connection-string (io/resource "arrays2.json")}
              result (parse-json-schema-from-spec spec)]
-         (is (= {:tables [{:name "Arrays" :schema nil :dependencies [{:target-schema nil :target-name "UNKNOWN1" :dependency-name nil :links {"tags" :embedded}}]
-                           :columns [{:name "id" :type "INTEGER" :nullable true}
-                                     {:name "tag-sets" :type "OBJECT" :nullable true :container "array"}]
-                                     },
-                          {:name "UNKNOWN1" :schema nil :dependencies []
-                           :columns [{:name "foo" :type "STRING" :nullable true}
-                                     {:name "baz" :type "DECIMAL" :nullable true :container "array"}]}]} result))
+         (is (=  {:entities ({:dependencies []
+                       :name "Arrays"
+                       :properties [{:constraints {:nullable true}
+                                     :name "id"
+                                     :type :integer}
+                                    {:constraints {:nullable true}
+                                     :name "tag-sets"
+                                     :properties [{:dependencies []
+                                                   :name "items"
+                                                   :properties []
+                                                   :schema nil
+                                                   :type :sequence}]
+                                     :type :sequence}]
+                       :schema nil
+                       :type :complex})} result))
        )
       )


Fix indentation.

Fix indentation.


add :startup project key back. add :shutdown

--- src/cake/main.clj
+++ src/cake/main.clj
@@ -8,7 +8,8 @@
         [bake.core :only [debug?]]
         [bake.io :only [init-multi-out]]
         [bake.reload :only [reload reload-project-files]]
-        [cake.tasks.swank :only [start-swank]])
+        [cake.tasks.swank :only [start-swank]]
+        [cake.utils.useful :only [on-shutdown]])
   (:require [cake.tasks default global]
             [cake.project :as project]
             [cake.server :as server])
@@ -28,6 +29,8 @@

 (defn start-server [port]
   (reload-project-files)
+  (eval (:startup *project*))
+  (on-shutdown #(eval (:shutdown *project*)))
   (init-multi-out ".cake/cake.log")
   (in-project {:outs *outs* :verbose (debug?) :root *root*}
     (when-let [autostart (get *config* "swank.autostart")]


Fix for cljam level

Fix for cljam level

--- src/cljam/cli.clj
+++ src/cljam/cli.clj
@@ -354,7 +354,7 @@
       (not= (count arguments) 2) (exit 1 (level-usage summary))
       errors (exit 1 (error-msg errors)))
     (let [[in out] arguments]
-      (with-open [r (reader in)
+      (with-open [r (reader in :ignore-index false)
                   w (writer out)]
         (level/add-level r w))))
   nil)


change heading for Storm version

change heading for Storm version

--- src/clj/backtype/storm/ui/core.clj
+++ src/clj/backtype/storm/ui/core.clj
@@ -87,7 +87,7 @@
         total-tasks (->> (.get_topologies summ)
                          (map #(.get_num_tasks ^TopologySummary %))
                          (reduce +))]
-    (table ["Storm version" "Nimbus uptime" "Supervisors" "Used slots" "Free slots" "Total slots" "Running tasks"]
+    (table ["Version" "Nimbus uptime" "Supervisors" "Used slots" "Free slots" "Total slots" "Running tasks"]
            [[(read-storm-version)
              (pretty-uptime-sec (.get_nimbus_uptime_secs summ))
              (count sups)


Fix broken syntax in lambdacd.steps.support/merge-step-results

--- src/clj/lambdacd/steps/support.clj
+++ src/clj/lambdacd/steps/support.clj
@@ -148,9 +148,9 @@
   (or (:global (reduce execution-util/keep-globals {} step-results)) {}))

 (defn merge-step-results
-  [step-results]
   "Deprecated, use `lambdacd.stepresults.merge/merge-step-results` instead."
   {:deprecated "0.13.1"}
+  [step-results]
   (merge/merge-step-results step-results merge/merge-two-step-results))

 ; not part of the public interface, just public for the macro


This one is right.

This one is right.

--- src/cljc/lander/game_launcher.cljc
+++ src/cljc/lander/game_launcher.cljc
@@ -24,7 +24,7 @@
     :key-pressed (fn [s { :keys [key-code] }] (in/handle-keydown s key-code))
     :key-released (fn [s] (assoc-in s [:lander :thrust] 0))))

-;#?(:clj (launch-sketch { :width 800 :height 600 }))
+#?(:clj (launch-sketch { :width 800 :height 600 }))

 #?(:cljs (defn ^:export launch-app[host width height]
            (launch-sketch { :width width :height height :host host})))


Setup history object to dispatch re-frame events

--- src/cljs/comic_reader/history.cljs
+++ src/cljs/comic_reader/history.cljs
@@ -1,5 +1,6 @@
 (ns comic-reader.history
-  (:require [goog.events :as events]
+  (:require [re-frame.core :as rf]
+            [goog.events :as events]
             [goog.history.EventType :as EventType])
   (:import goog.History))

@@ -16,5 +17,5 @@
         (events/listen
             EventType/NAVIGATE
             (fn [event]
-              nil))
+              (rf/dispatch [:navigate (.-token event)])))
         (.setEnabled true)))))


refactoring

refactoring

--- src/cljs/om_next_leaflet/core.cljs
+++ src/cljs/om_next_leaflet/core.cljs
@@ -93,6 +93,39 @@
             (channel-handler this (assoc data :tag tag))))
         (recur)))))

+(defn api--get-lines
+  [chan]
+  (util/send-request! :get "/api2/lines" nil chan))
+
+(defn api--get-stations
+  [chan line-no]
+  (util/send-request! :get (str "/api2/lines/" line-no "/stations") nil chan))
+
+(defui TestButton
+  Object
+  (render [this]
+    (let [{:keys [event-chan input-node]} (om/props this)]
+      (html
+       [:button {:on-click (fn [e]
+                             (let [new-title (.-value input-node)]
+                               (put! event-chan {:result :success :event-id :app/on-click :data new-title})))}
+        "update"]))))
+
+(def button-fn (om/factory TestButton))
+
+(defui TestInput
+  Object
+  (render [this]
+    (let [{:keys [ref title event-chan]} (om/props this)]
+      (html
+       [:input {:ref ref
+                :value (if (nil? title) "" title)
+                :on-change (fn [e]
+                             (let [new-title (-> e .-target .-value)]
+                               (put! event-chan {:result :success :event-id :app/update-title :data new-title})))}]))))
+
+(def input-fn (om/factory TestInput))
+
 (defui Root
   static om/IQuery
   (query [this]
@@ -108,9 +141,11 @@
       ;; watch channels
       (main-channel-loop this channels)
       ;; initialize
-      (util/send-request! :get "/api2/lines" nil (:leaflet/lines channels))
-      (util/send-request! :get "/api2/lines/24/stations" nil (:leaflet/stations channels))
-      (om/update-state! this assoc :channels channels)))
+      (api--get-lines (:leaflet/lines channels))
+      (api--get-stations (:leaflet/stations channels) 24)
+      (om/update-state! this assoc
+                        :channels channels
+                        :input-node (dom/node this "title"))))
   (componentWillUnmount [this]
     (debug "will-unmount"))
   (render [this]
@@ -121,15 +156,8 @@
        [:div
         [:div {:id "custom-control"
                :class "leaflet-control-layers leaflet-control-layers-expanded leaflet-control"}
-         [:input {:ref "title"
-                  :value (if (nil? title) "" title)
-                  :on-change (fn [e]
-                               (let [new-title (-> e .-target .-value)]
-                                 (put! event-chan {:result :success :event-id :app/update-title :data new-title})))}]
-         [:button {:on-click (fn [e]
-                               (let [new-title (.-value (dom/node this "title"))]
-                                 (put! event-chan {:result :success :event-id :app/on-click :data new-title})))}
-          "update"]
+         (input-fn {:ref "title" :title title :event-chan event-chan})
+         (button-fn {:event-chan event-chan :input-node (-> this om/get-state :input-node)})
          [:div
           [:p (str "zoom: " (:zoom mapstate))]]]
         (leaflet-map-fn {:mapid "map"


Correct compojure api route not found

Correct compojure api route not found

--- src/clojure_rest/config/routes.clj
+++ src/clojure_rest/config/routes.clj
@@ -1,11 +1,9 @@
 (ns clojure-rest.config.routes
   (:require [compojure.api.sweet :refer :all]
-            [compojure.api.middleware :refer :all]
             [ring.util.http-response :refer :all]
             [clojure-rest.config.swagger :as swagger-conf]
             [clojure-rest.controllers.document-controller :as document-controller]
-            [clojure-rest.model.document :as document-model]
-            [compojure.route :as route]))
+            [clojure-rest.model.document :as document-model]))

 (def document-routes
   (context "/documents" []
@@ -47,4 +45,4 @@
 (defapi app-routes
    swagger-conf/swagger-routes
    document-routes
-  (route/not-found "Not Found"))
+  (undocumented(compojure.route/not-found (ok {:not "found"}))))


Moved NoOpJob in line with the syntax used elsewhere

--- src/eddy/core.clj
+++ src/eddy/core.clj
@@ -2,8 +2,7 @@
   (:require [eddy.schedule :refer [schedule-jobs sch]]
             [clojurewerkz.quartzite.jobs :refer [defjob]]))

-(defjob NoOpJob
-  [ctx]
+(defjob NoOpJob [ctx]
   (println "Something"))

 (defn -main [& args]


Fix memory leak.

Fix memory leak.

--- src/cortex/compute/cuda/driver.clj
+++ src/cortex/compute/cuda/driver.clj
@@ -529,30 +529,31 @@
    shared-mem-size
    & kernel-args]
   (check-stream-device stream)
-  (let [^cuda$CUfunc_st kern-fn kern-fn
-        grid-dim-x (long grid-dim-x)
-        grid-dim-y (long grid-dim-y)
-        grid-dim-z (long grid-dim-z)
-        block-dim-x (long block-dim-x)
-        block-dim-y (long block-dim-y)
-        block-dim-z (long block-dim-z)
-        shared-mem-size (long shared-mem-size)
-        ;;Really stupid loop but I can't figure any other way of doing it.
-        ^"[Lorg.bytedeco.javacpp.Pointer;" ptr-array
-        (into-array Pointer (map (fn [karg]
-                                   (let [karg (long (to-long karg))
-                                         ^longs data-ary (make-array Long/TYPE 1)]
-                                     (aset data-ary 0 karg)
-                                     (LongPointer. data-ary)))
-                                 kernel-args))
-        arg-pointer (PointerPointer. ptr-array)]
-    (cuda-call (cuda/cuLaunchKernel kern-fn
-                                    grid-dim-x grid-dim-y grid-dim-z
-                                    block-dim-x block-dim-y block-dim-z
-                                    shared-mem-size
-                                    ^cuda$CUstream_st (get-cuda-stream stream)
-                                    arg-pointer
-                                    nil))))
+  (resource/with-resource-context
+    (let [^cuda$CUfunc_st kern-fn kern-fn
+          grid-dim-x              (long grid-dim-x)
+          grid-dim-y              (long grid-dim-y)
+          grid-dim-z              (long grid-dim-z)
+          block-dim-x             (long block-dim-x)
+          block-dim-y             (long block-dim-y)
+          block-dim-z             (long block-dim-z)
+          shared-mem-size         (long shared-mem-size)
+          ;;Really stupid loop but I can't figure any other way of doing it.
+          ^"[Lorg.bytedeco.javacpp.Pointer;" ptr-array
+                                  (into-array Pointer (map (fn [karg]
+                                                             (let [karg            (long (to-long karg))
+                                                                   ^longs data-ary (make-array Long/TYPE 1)]
+                                                               (aset data-ary 0 karg)
+                                                               (resource/track (LongPointer. data-ary))))
+                                                           kernel-args))
+          ^PointerPointer arg-pointer             (resource/track (PointerPointer. ptr-array))]
+      (cuda-call (cuda/cuLaunchKernel kern-fn
+                                      grid-dim-x grid-dim-y grid-dim-z
+                                      block-dim-x block-dim-y block-dim-z
+                                      shared-mem-size
+                                      ^cuda$CUstream_st (get-cuda-stream stream)
+                                      arg-pointer
+                                      nil)))))

 (defn launch-linear-kernel


Gui: toolbar handler expanded to regular menu

--- src/gui/menus.clj
+++ src/gui/menus.clj
@@ -99,18 +99,22 @@
                   :items [(action
                             :name "Check SAT"
                             ;:key "ctrl T+S"
-                            :icon (icon-path "task_sat.gif"))
+                            :icon (icon-path "task_sat.gif")
+                            :handler #(handler-sat %))
                           (action
                             :name "Truth Table"
                             ;:key "ctrl T T"
-                            :icon (icon-path "task_tt.gif"))
+                            :icon (icon-path "task_tt.gif")
+                            :handler #(handler-tt %))
                           (action
                             :name "Transform to CNF"
                             ;:key "ctrl T C"
-                            :icon (icon-path "task_cnf.gif"))
+                            :icon (icon-path "task_cnf.gif")
+                            :handler #(handler-cnf %))
                           (action
                             :name "Tseitin Transformation"
-                            :icon (icon-path "task_tcnf.gif"))
+                            :icon (icon-path "task_tcnf.gif")
+                            :handler #(handler-tseitin %))
                           (action
                             :name "Generate DIMACS")
                           (action


mandated flag for supporting ASM versions

--- src/insn/util.clj
+++ src/insn/util.clj
@@ -69,7 +69,9 @@
    :synthetic Opcodes/ACC_SYNTHETIC
    :transient Opcodes/ACC_TRANSIENT
    :varargs Opcodes/ACC_VARARGS
-   :volatile Opcodes/ACC_VOLATILE})
+   :volatile Opcodes/ACC_VOLATILE
+   :mandated (try (.getInt (.getField Opcodes "ACC_MANDATED") nil)
+                  (catch NoSuchFieldException _))})

 (def ^:no-doc handle-keyword?
   {:getfield Opcodes/H_GETFIELD


Also set the tool tip when setting the select input's value.

--- src/fm/simrunner/gui/rendering.clj
+++ src/fm/simrunner/gui/rendering.clj
@@ -43,9 +43,9 @@
         select-button (:widget select-button)
         value         (str value)]
     (.setEnabled select-text (not locked?))
-    (.setEnabled select-button (not locked?))
-    (when-not (= value (.getText select-text))
-      (.setText select-text value))))
+    (.setEnabled select-button (not locked?))
+    (.setText select-text value)
+    (.setToolTipText select-text value)))

 (defmethod set-value [:select-input File] [input value locked?]
   (set-value input (.getAbsolutePath value) locked?))
@@ -54,11 +54,9 @@
   (set-value input "" locked?))

 (defmethod set-value [:text-input Object] [input value locked?]
-  (let [input (:widget input)
-        value (str value)]
+  (let [input (:widget input)]
     (.setEnabled input (not locked?))
-    (when-not (= value (.getText input))
-      (.setText input value))))
+    (.setText input (str value))))

 (defmethod set-value [:text-input nil] [input value locked?]
   (set-value input "" locked?))


Remove :media-type-available? from section resource since the client is removing the Accept header so the media type decision is skipped.

--- src/open_company/api/sections.clj
+++ src/open_company/api/sections.clj
@@ -83,7 +83,6 @@
                         :delete (fn [ctx] (common/allow-org-members conn company-slug ctx))})

   :can-put-to-missing? true
-  :media-type-available? (by-method {:delete true})

   ;; TODO: handle with prismatic schema check
   :processable? (by-method {


simplify morphology: use pattern-matching rather than a giant (cond..)

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -76,53 +76,55 @@
    element of regular-patterns where the element's :u unifies successfully with
    unify-with. If lexicon is supplied, look up infinitive in lexicon and use exceptional form of
    first return value, if any."
-  (log/debug (str "conjugate1: infinitive= " infinitive "; unify-with= " unify-with))
-  (let [unify-with (dissoc-paths unify-with [[:français]])
-        diagnostics
-        (log/debug (str "conjugate2: infinitive= " infinitive "; unify-with= " unify-with))
-        exceptional-lexemes
-        (lookup-in lexicon
-                   {:spec (unify unify-with
-                                 {:français {:infinitive infinitive
-                                             :exception true}})})
-        exceptional-surface-forms
-        (map #(get-in % [:français :français])
-             exceptional-lexemes)
-        regulars
-        (remove #(nil? %)
-                (map
-                 (fn [replace-pattern]
-                   (let [from (nth (:g replace-pattern) 0)
-                         to (nth (:g replace-pattern) 1)
-                         unify-against (if (:u replace-pattern)
-                                         (:u replace-pattern)
-                                         :top)]
-                     (if (and from to
-                              (re-matches from infinitive)
-                              (not (fail? (unify unify-against
-                                                 unify-with))))
-                       (do
-                         (log/debug (str "matched infinitive: " infinitive))
-                         (log/debug (str "from: " from))
-                         (log/debug (str "to: " to))
-                         (log/debug (str "input spec: " (strip-refs unify-with)))
-                         (log/debug (str "pattern spec:"  (strip-refs unify-against)))
-                         (string/replace infinitive from to)))))
-                 regular-patterns))
-
-        diagnostics (log/debug (str "emptyness of exceptions:" (empty? exceptional-surface-forms)))
-
-        diagnostics (log/debug (str "emptyness of regulars:" (empty? regulars)))
-        ;; Take the first of any exceptions found; if not, take the first regular conjugation.
-        ;; if neither, it's an error in this implementation of French morphology so throw so it can be
-        ;; detected and fixed.
-        results (take 1 (concat exceptional-surface-forms regulars))]
-  (or (and (empty? results)
-           (throw (Exception. (str "nothing found to match infinitive: " infinitive " ; "
-                                   " unify-with: " (strip-refs unify-with) "."))))
-      (do
-        (log/debug (str "conjugated: " infinitive " => " (first results)))
-        (first results)))))
+  (if (nil? infinitive)
+    ""
+    (do
+      (log/debug (str "conjugate1: infinitive=" infinitive "; unify-with=" unify-with))
+      (let [exceptional-lexemes
+            (lookup-in lexicon
+                       {:spec {:français {:infinitive infinitive
+                                          :exception true}}})
+            exceptional-surface-forms
+            (map #(get-in % [:français :français])
+                 exceptional-lexemes)
+            regulars
+            (remove nil?
+                    (map
+                     (fn [replace-pattern]
+                       (log/trace (str " replace-pattern: " (strip-refs replace-pattern)))
+                       (let [from (nth (:g replace-pattern) 0)
+                             to (nth (:g replace-pattern) 1)
+                             unify-against (if (:u replace-pattern)
+                                             (:u replace-pattern)
+                                             :top)
+                             unified (unify unify-against
+                                            unify-with)]
+                         (when (and from to infinitive (not (= :fail unified)))
+                           (re-matches from infinitive)
+                           (log/debug (str " cat: " (get-in unify-with [:synsem :cat])))
+                           (log/debug (str " infinitive: " infinitive))
+                           (log/debug (str " from: " from))
+                           (log/debug (str " to: " to))
+                           (log/debug (str " input spec: " (strip-refs unify-with)))
+                           (log/debug (str " unified: " (strip-refs unified)))
+                           (let [output (string/replace infinitive from to)]
+                             (log/debug (str  "output: " output))
+                             output))))
+                     regular-patterns))
+
+            diagnostics (log/debug (str "emptyness of exceptions:" (empty? exceptional-surface-forms)))
+
+            diagnostics (log/debug (str "emptyness of regulars:" (empty? regulars)))
+            ;; Take the first of any exceptions found; if not, take the first regular conjugation.
+            ;; if neither, it's an error in this implementation of French morphology so throw so it can be
+            ;; detected and fixed.
+            results (take 1 (concat exceptional-surface-forms regulars))]
+        (or (and (empty? results)
+                 (throw (Exception. (str "nothing found to match infinitive: " infinitive " ; "
+                                         " unify-with: " (strip-refs unify-with) "."))))
+            (do
+              (log/debug (str "conjugated: " infinitive " => " (first results)))
+              (first results)))))))

 ;; TODO: separate part-of-speech -related functionality (e.g. the word is a verb) from
 ;; compositional functionality (e.g. the word has an :a and :b, so combine by concatenation, etc)
@@ -215,106 +217,16 @@
             (get-string
              (get-in word '(:a))
              (get-in word '(:b)))
-
-            ;; TODO: this rule is pre-empting all of the following rules
-            ;; that look in :a and :b. Either remove those following rules
-            ;; if they are redundant and not needed, or move this general rule
-            ;; below the following rules.
-           (and (not (= :none (get-in word '(:a) :none)))
-                (not (= :none (get-in word '(:b) :none))))
-           (get-string (get-in word '(:a))
-                       (get-in word '(:b)))
-
-           (and
-            (string? (get-in word '(:a :français)))
-            (string? (get-in word '(:b :français)))
-            (or (= :none (get-in word '(:b :agr :number) :none))
-                (= :top (get-in word '(:b :agr :number) :none)))
-            )
-           (str (string/trim (get-in word '(:a :français)))
-                " "
-                (string/trim (get-in word '(:b :français))))
-
-           (and
-            (string? (get-in word '(:a)))
-            (string? (get-in word '(:b :français)))
-            (or (= :none (get-in word '(:b :agr :number) :none))
-                (= :top (get-in word '(:b :agr :number) :none)))
-            )
-           (str (string/trim (get-in word '(:a)))
-                " "
-                (string/trim (get-in word '(:b :français))))
-
-           (and
-            (string? (get-in word '(:a :français)))
-            (get-in word '(:a :français))
-            (or (= :none (get-in word '(:b :agr :number) :none))
-                (= :top (get-in word '(:b :agr :number) :none)))
-            (= (get-in word '(:a :infl)) :top))
-           (string/trim (str (get-in word '(:a :français))
-                             " " (get-string (get-in word '(:b)))))
-
-           (= true (get-in word [:exception]))
-           (get-in word [:français])
-
-           (and
-            (or (= (get-in word [:infl]) :conditional)
-                (= (get-in word [:infl]) :future)
-                (= (get-in word [:infl]) :present))
-            (string? (get-in word [:français])))
-           (let [number-and-person (verbs/number-and-person number person)
-                 infl (get-in word [:infl])]
-             (cond
-               (and number-and-person
-                    (get-in word [infl number-and-person]))
-               (get-in word [infl number-and-person])
-
-               true
-               (let [infinitive (cond (and (= :future (get-in word [:infl]))
-                                           (get-in word [:future-stem]))
-                                      (get-in word [:future-stem])
-                                      ;; TODO: add checks for other -stem features, like :imperfect-stem.
-                                      true
-                                      (get-in word [:français]))]
-                 (log/debug (str "conjugate: infinitive=" infinitive "; word=" (strip-refs word)))
-                 (conjugate infinitive {:français word}))))
-
-           (and
-            (= (get-in word '(:infl)) :imperfect)
-            (string? (get-in word '(:français))))
-           (verbs/imperfect word)
-
-           (= (get-in word '(:infl)) :past-p)
-           (cond (get-in word [:past-participle])
-                 (get-in word [:past-participle])
-                 true
-                 (conjugate (get-in word [:français]) {:français word}))
-
-           (and
-            (get-in word '(:a))
-            (get-in word '(:b)))
-           (get-string
-            (get-in word '(:a))
-            (get-in word '(:b)))
-
-           (= (get-in word '(:a)) :top)
-           (str
-            ".." " " (get-string (get-in word '(:b))))
-
-           (and
-            (= (get-in word '(:b)) :top)
-            (string? (get-string (get-in word '(:a)))))
-           (str
-            (get-string (get-in word '(:a)))
-            " " "..")
-
-           (string? (get-in word [:français]))
-           (get-in word [:français])
-
-           true
-           (throw (Exception. (str "get-string: don't know what to do with input argument " word ";français="
-                                   (get-in word [:français]) "; stringness: "
-                                   (string? (get-in word [:français])))))))))
+
+            (= true (get-in word [:exception]))
+            (let [foo (log/debug (str "exception word:" (strip-refs word)))
+                  bar (log/debug (str "exception word1:" (get-in word [:français])))]
+              (get-in word [:français]))
+
+            true
+            (let [infinitive (get-in word [:français])]
+              (log/debug (str "calling: conjugate: infinitive=" infinitive "; word=" (strip-refs word)))
+              (conjugate infinitive {:synsem word}))))))

 (defn fo [input &
           {:keys [from-language show-notes]


fix perf tests

fix perf tests

--- perf/asphalt/test/perf.clj
+++ perf/asphalt/test/perf.clj
@@ -14,6 +14,7 @@
     [citius.core       :as c]
     [asphalt.test-util :as u]
     [asphalt.core      :as a]
+    [asphalt.internal  :as i]
     [asphalt.type      :as t]))

@@ -32,7 +33,7 @@
 (use-fixtures :each test-fixture)

-(def db-spec {:datasource u/ds})
+(def db-spec {:datasource u/orig-ds})

 ;"CREATE TABLE emp
 ;id     INT PRIMARY KEY AUTO_INCREMENT,
@@ -64,7 +65,7 @@
                :dept "Accounts"}
           vdat (vec (map data [:name :salary :dept]))]
      (jdbc/with-db-connection [db-con db-spec]
-       (a/with-connection [conn u/ds]
+       (i/with-connection [conn u/orig-ds]
          (c/compare-perf "insert-delete"
            (do
              (jdbc/insert! db-con :emp data)
@@ -85,11 +86,11 @@
     (let [data {:name "Joe Coder"
                 :salary 100000
                 :dept "Accounts"}]
-      (a/with-connection [conn u/ds]
+      (i/with-connection [conn u/orig-ds]
         (a/update conn t-insert data))
       ;; bench c.j.j normal with asphalt
       (jdbc/with-db-connection [db-con db-spec]
-        (a/with-connection [conn u/ds]
+        (i/with-connection [conn u/orig-ds]
           (c/compare-perf "select-row"
             (jdbc/query db-con [s-select])
             (a/query a/fetch-rows conn s-select nil)
@@ -97,7 +98,7 @@
             (a/query a/fetch-rows conn m-select nil))))
       ;; bench c.j.j `:as-arrays? true` with asphalt
       (jdbc/with-db-connection [db-con db-spec]
-        (a/with-connection [conn u/ds]
+        (i/with-connection [conn u/orig-ds]
           (c/compare-perf "select-row-as-arrays"
             (jdbc/query db-con [s-select] :as-arrays? true)
             (a/query a/fetch-rows conn s-select nil)


fixing lang-regex

fixing lang-regex

--- src/vignette/api/legacy/routes.clj
+++ src/vignette/api/legacy/routes.clj
@@ -9,7 +9,7 @@
          route->options)

 (def archive-regex #"(?!\/archive).*|\/archive")
-(def lang-regex #"\/[a-z-]+|.*")
+(def lang-regex #"\/[a-z-]+|")

 (def thumbnail-route
   (route-compile "/:wikia:lang/:image-type/thumb:archive/:top-dir/:middle-dir/:original/:thumbname"


Use renderer commons

Use renderer commons

--- src/wireframes/renderer/bitmap.clj
+++ src/wireframes/renderer/bitmap.clj
@@ -1,4 +1,5 @@
 (ns wireframes.renderer.bitmap
+  (:use [wireframes.renderer :only [get-3d-points get-2d-points]])
   (:require [wireframes.transform :as t]
             [wireframes.shape-primitives :as sp]
             [wireframes.shape-loader :as sl]
@@ -18,11 +19,8 @@

 (defn- draw-wireframe [^Graphics2D g2d focal-length transform shape]
   (let [path (GeneralPath.)
-        points (mapv
-                 (comp
-                   (t/perspective focal-length)
-                   (partial t/transform-point transform))
-                 (:points shape))]
+        points-3d (get-3d-points transform shape)
+        points-2d (get-2d-points focal-length points-3d)]

 ;    (.setColor g2d Color/RED)
 ;    (doseq [[idx1 idx2] (:lines shape)]
@@ -72,7 +70,7 @@
         (t/rotate :x (sp/degrees->radians -70))
         (t/translate 0 -1 40))
       (sl/load-shape "resources/newell-teapot/teapot" 16)
-      [600 600])
+      [1000 900])
     "doc/gallery/teapot.png")

   (write-png