Extract comment-begin-string into dynamic global var.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -19,6 +19,8 @@
     (java.io PushbackReader StringReader)
     (jline.console ConsoleReader)
     (jline.console.completer ArgumentCompleter Completer StringsCompleter)))
+
+(def ^:dynamic *comment-begin-string* ";")

 (defn cli-repl-print
   "The default repl print function of cli4clj only prints non-nil values."
@@ -113,7 +115,7 @@
       (let [line (.readLine in-rdr)]
         (if (and (not (nil? line))
                  (not (.isEmpty line))
-                 (not (-> line (.trim) (.startsWith ";"))))
+                 (not (-> line (.trim) (.startsWith *comment-begin-string*))))
           (binding [*in* (PushbackReader. (StringReader. (str line "\n")))]
             (rdr-fn request-prompt request-exit))
           request-prompt)))))


Show edit form.

Show edit form.

--- src/lab_notebook/core.cljs
+++ src/lab_notebook/core.cljs
@@ -48,14 +48,24 @@
       {:editing? false})
     om/IRenderState
     (render-state [this state]
-      (dom/div #js {:style #js {:marginTop "2em"}}
-        (dom/button #js {:className "btn btn-primary"
-                         :onClick (fn [e]
-                                    (om/set-state! component :editing? true))}
-          "Edit")
-        (dom/div nil (:summary cursor))
-        (dom/div nil (:date-time cursor))
-        (dom/div nil (:notes cursor))))))
+      (if (:editing? state)
+        (dom/div #js {:style #js {:marginTop "2em"}}
+          (om/build item-form cursor
+            {:opts {:on-save (fn [summary date-time notes]
+                               (om/transact! cursor (fn [entry]
+                                                      (assoc entry
+                                                        :summary summary
+                                                        :date-time date-time
+                                                        :notes notes)))
+                               (om/set-state! component :editing? false))}}))
+        (dom/div #js {:style #js {:marginTop "2em"}}
+          (dom/button #js {:className "btn btn-primary"
+                           :onClick (fn [e]
+                                      (om/set-state! component :editing? true))}
+            "Edit")
+          (dom/div nil (:summary cursor))
+          (dom/div nil (:date-time cursor))
+          (dom/div nil (:notes cursor)))))))

 (defn item-table [cursor component]
   (reify


Make sure parent directories exist.

Make sure parent directories exist.

--- src/leiningen/protobuf.clj
+++ src/leiningen/protobuf.clj
@@ -44,6 +44,7 @@
           (recur files)
           (let [location (str "proto/" proto)
                 proto-file (io/file target location)]
+            (.mkdirs (.getParentFile proto-file))
             (io/copy (io/reader (io/resource location)) proto-file)
             (recur (into files (proto-dependencies proto-file)))))))))


Implemented with-memoized-fns using alter-var-root

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -216,11 +216,20 @@
   (die-with-error IllegalStateException strings))

 (defmacro with-memoized-fns
-  "Runs code in body with all functions in functions memoized."
+  "Runs code in body with all given functions memoized."
   [functions & body]
-  `(binding ~(vec (interleave functions
-			      (map (fn [f] `(memoize ~f)) functions)))
-     ~@body))
+  (let [function-gensyms (into {} (for [f functions] [(gensym) f]))]
+    `(let ~(vec (mapcat (fn [[f-name f]] [f-name `(deref (var ~f))])
+                        function-gensyms))
+       (try
+         ~@(map (fn [f]
+                  `(alter-var-root (var ~f) memoize))
+                functions)
+         ~@body
+          (finally
+           ~@(map (fn [[name-f f]]
+                    `(alter-var-root (var ~f) (constantly ~name-f)))
+                  function-gensyms))))))

 (defmacro memo-fn
   "Defines memoized, anonymous function."


do not allow position at the leaf node of the xpath

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -423,6 +423,8 @@
                            (fn [a-group]
                              (let [objs           (map :obj (second a-group))

+                                   path-length    (-> a-group first count)
+
                                    poss           (map
                                                    (fn [an-obj]
                                                      (map last
@@ -447,16 +449,18 @@
                                    accum-scr      (reverse
                                                    (into [] (reductions * (reverse positions-freq))))

-                                   where          (utils/positions-at
-                                                   (map
-                                                    (fn [i]
-                                                      (and
-                                                       (not= (nth positions-freq i) 1)
-                                                       (< (nth accum-scr i) num-as)
-                                                       (not= (nth positions-freq i) positions-max)))
-                                                    (range
-                                                     (count accum-scr)))
-                                                   true)]
+                                   where          (filter
+                                                   #(not= (dec path-length) %)
+                                                   (utils/positions-at
+                                                    (map
+                                                     (fn [i]
+                                                       (and
+                                                        (not= (nth positions-freq i) 1)
+                                                        (< (nth accum-scr i) num-as)
+                                                        (not= (nth positions-freq i) positions-max)))
+                                                     (range
+                                                      (count accum-scr)))
+                                                    true))]
                                where))
                            grouped-nodes)


unescape html else crawler fails

unescape html else crawler fails

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -358,7 +358,8 @@
                                (let [link (-> x
                                               (.getAttributes)
                                               (.getNamedItem "href")
-                                              (.getValue))]
+                                              (.getValue)
+                                              (StringEscapeUtils/unescapeHtml))]
                                  {:node x
                                   :href (try
                                           (uri/fragment
@@ -467,7 +468,8 @@
                                   (-> a-tag
                                       (.getAttributes)
                                       (.getNamedItem "href")
-                                      (.getValue)))
+                                      (.getValue)
+                                      (StringEscapeUtils/unescapeHtml)))
                                  "javascript")
                                 (not
                                  (some
@@ -476,7 +478,8 @@
                                      (-> a-tag
                                          (.getAttributes)
                                          (.getNamedItem "href")
-                                         (.getValue)))}
+                                         (.getValue)
+                                         (StringEscapeUtils/unescapeHtml)))}
                                   (set blacklist)))))
                          anchor-nodes)

@@ -491,7 +494,8 @@
                              (let [link (-> x
                                             (.getAttributes)
                                             (.getNamedItem "href")
-                                            (.getValue))]
+                                            (.getValue)
+                                            (StringEscapeUtils/unescapeHtml))]
                                {:node x
                                 :href (try
                                         (uri/fragment
@@ -555,7 +559,8 @@
                                   (-> a-tag
                                       (.getAttributes)
                                       (.getNamedItem "href")
-                                      (.getValue)))
+                                      (.getValue)
+                                      (StringEscapeUtils/unescapeHtml)))
                                  "javascript")
                                 (not
                                  (some
@@ -564,7 +569,8 @@
                                      (-> a-tag
                                          (.getAttributes)
                                          (.getNamedItem "href")
-                                         (.getValue)))}
+                                         (.getValue)
+                                         (StringEscapeUtils/unescapeHtml)))}
                                   (set blacklist)))))
                          anchor-nodes)

@@ -579,7 +585,8 @@
                              (let [link (-> x
                                             (.getAttributes)
                                             (.getNamedItem "href")
-                                            (.getValue))]
+                                            (.getValue)
+                                            (StringEscapeUtils/unescapeHtml))]
                                {:node x
                                 :href (try
                                         (uri/fragment
@@ -679,7 +686,8 @@
                                 (-> a-tag
                                     (.getAttributes)
                                     (.getNamedItem "href")
-                                    (.getValue)))
+                                    (.getValue)
+                                    (StringEscapeUtils/unescapeHtml)))
                                "javascript")
                               (not
                                (some
@@ -688,7 +696,8 @@
                                    (-> a-tag
                                        (.getAttributes)
                                        (.getNamedItem "href")
-                                       (.getValue)))}
+                                       (.getValue)
+                                       (StringEscapeUtils/unescapeHtml)))}
                                 (set blacklist)))))
                          anchor-nodes)

@@ -703,7 +712,8 @@
                              (let [link (-> x
                                           (.getAttributes)
                                           (.getNamedItem "href")
-                                          (.getValue))]
+                                          (.getValue)
+                                          (StringEscapeUtils/unescapeHtml))]
                                {:node x
                                 :href (try
                                         (uri/fragment


analyze-deps & load-macros config for cljs.js/compile & cljs.js/eval-str

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -297,6 +297,8 @@
        :*cljs-ns*      'cljs.user
        :*ns*           (create-ns 'cljs.user)
        :*data-readers* tags/*cljs-data-readers*
+       :*analyze-deps* (or (:analyze-deps opts) true)
+       :*load-macros*  (or (:load-macros opts) true)
        :*eval-fn*      (or (:js-eval opts) js/eval)}
       source opts cb)))

@@ -337,5 +339,7 @@
       :*cljs-ns*      'cljs.user
       :*ns*           (create-ns 'cljs.user)
       :*data-readers* tags/*cljs-data-readers*
+      :*analyze-deps* (or (:analyze-deps opts) true)
+      :*load-macros*  (or (:load-macros opts) true)
       :*eval-fn*      (or (:js-eval opts) js/eval)}
      source opts cb)))


CLJS-1374: cljs.js/require doesn't supply good defaults

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -162,16 +162,19 @@
   ([name cb]
     (require name nil cb))
   ([name opts cb]
-    (require
-      {:*compiler*     (env/default-compiler-env)
-       :*data-readers* tags/*cljs-data-readers*
-       :*load-fn*      (or (:load opts) *load-fn*)
-       :*eval-fn*      (or (:eval opts) *eval-fn*)}
-      name opts cb))
+    (require nil name opts cb))
   ([bound-vars name opts cb]
    (require bound-vars name nil opts cb))
   ([bound-vars name reload opts cb]
-   (let [name (cond-> name (:macro-ns opts) ana/macro-ns-name)]
+   (let [bound-vars (merge
+                      {:*compiler*     (env/default-compiler-env)
+                       :*data-readers* tags/*cljs-data-readers*
+                       :*load-macros*  (or (:load-macros opts) true)
+                       :*analyze-deps* (or (:analyze-deps opts) true)
+                       :*load-fn*      (or (:load opts) *load-fn*)
+                       :*eval-fn*      (or (:eval opts) *eval-fn*)}
+                      bound-vars)
+         name (cond-> name (:macro-ns opts) ana/macro-ns-name)]
      (when (= :reload reload)
        (swap! *loaded* disj name))
      (when (= :reload-all reload)
@@ -746,6 +749,8 @@
   (def fs (js/require "fs"))
   (def st (cljs/empty-state))

+  (set! *target* "nodejs")
+
   (defn node-eval [{:keys [name source]}]
     (.runInThisContext vm source (str (munge name) ".js")))


typos

typos

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -97,10 +97,10 @@
    (doto (empty-state) (swap! init))))

 (defn load-ns [pure-state ns cache]
-  (assoc-in pure-state [:ana/namespaces ns] cache))
+  (assoc-in pure-state [::ana/namespaces ns] cache))

 (defn load-ns! [state ns cache]
-  (assoc-in state [:ana/namespaces ns] cache))
+  (assoc-in state [::ana/namespaces ns] cache))

 (defn sm-data []
   (atom


hide a few more things in cljs.js

hide a few more things in cljs.js

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -22,7 +22,7 @@

 (js/goog.require "cljs.core$macros")

-(defn debug-prn
+(defn- debug-prn
   [& args]
   (binding [*print-fn* *print-err-fn*]
     (apply println args)))
@@ -38,13 +38,13 @@
                    0 (- (count file) 5))]
     (symbol (demunge lib-name))))

-(defn atom? [x]
+(defn- atom? [x]
   (instance? Atom x))

-(defn valid-name? [x]
+(defn- valid-name? [x]
   (or (nil? x) (symbol? x) (string? x)))

-(defn valid-opts? [x]
+(defn- valid-opts? [x]
   (or (nil? x) (map? x)))

 (defonce


Make "triggered" a boolean in the response :watermelon:

--- src/metabase/api/setup.clj
+++ src/metabase/api/setup.clj
@@ -150,7 +150,8 @@
       (let [is-next-step? (boolean (and (not found-next-step?)
                                         (:triggered step)
                                         (not (:completed step))))
-            step          (assoc step :is_next_step is-next-step?)]
+            step          (-> (assoc step :is_next_step is-next-step?)
+                              (update :triggered boolean))]
         (recur (conj acc step)
                (or found-next-step? is-next-step?)
                more)))))


[fix #8802] universal links after login

[fix #8802] universal links after login

fix #8802
No redirect from universal links after login

--- src/status_im/multiaccounts/login/core.cljs
+++ src/status_im/multiaccounts/login/core.cljs
@@ -140,6 +140,7 @@
                           :networks/networks networks
                           :multiaccount multiaccount)
                :notifications/request-notifications-permissions nil}
+              (universal-links/process-stored-event)
               (check-network-version network-id)
               (chat.loading/initialize-chats)
               (contact/initialize-contacts)
@@ -168,7 +169,6 @@
               (when save-password?
                 (save-user-password address password))
               (navigation/navigate-to-cofx :home nil)
-              (universal-links/process-stored-event)
               (when platform/desktop?
                 (chat-model/update-dock-badge-label)))))


Tx failed with Out of Gas error [#4855]

Tx failed with Out of Gas error [#4855]

--- src/status_im/ui/screens/wallet/events.cljs
+++ src/status_im/ui/screens/wallet/events.cljs
@@ -267,7 +267,9 @@
 (handlers/register-handler-db
  :wallet/update-estimated-gas-success
  (fn [db [_ gas]]
-   (assoc-in db [:wallet :send-transaction :gas] (money/bignumber gas))))
+   (if gas
+     (assoc-in db [:wallet :send-transaction :gas] (money/bignumber (int (* gas 1.2))))
+     db)))

 (handlers/register-handler-fx
  :wallet/show-error


Update timer.clj

Update timer.clj

--- storm-core/src/clj/backtype/storm/timer.clj
+++ storm-core/src/clj/backtype/storm/timer.clj
@@ -57,7 +57,7 @@
                                    ;; an upper bound, e.g. 1000 millis, to the
                                    ;; sleeping time, to limit the response time
                                    ;; for detecting any new event within 1 secs.
-                                   (Time/sleep (max 1000 (- time-millis (current-time-millis))))
+                                   (Time/sleep (min 1000 (- time-millis (current-time-millis))))
                                    ;; Otherwise poll to see if any new event
                                    ;; was scheduled. This is, in essence, the
                                    ;; response time for detecting any new event


testing set title on game creation

testing set title on game creation

--- test/cljs/go_client/handlers/game_test.cljs
+++ test/cljs/go_client/handlers/game_test.cljs
@@ -2,7 +2,8 @@
   (:require-macros [cemerick.cljs.test :refer [is deftest with-test run-tests testing test-var]])
   (:require [cemerick.cljs.test]
             [go-client.db :as db]
-            [go-client.handlers.game :as game]))
+            [go-client.handlers.game :as game]
+            [clojure.set :as set]))

 (def starting-db db/default-db)

@@ -12,3 +13,10 @@
                changed-db (game/create-game starting-db ["title"])]
            (is (= expected-number-of-games (count (:games changed-db))))))

+(deftest game-title
+         (let [starting-game-keys (set (keys (:games starting-db)))
+               changed-db (game/create-game starting-db ["New game title"])
+               changed-game-keys (set (keys (:games changed-db)))
+               created-game-key (first (set/difference changed-game-keys starting-game-keys))]
+           (is (= "New game title" (get-in changed-db [:games created-game-key :title])))))
+


Fix end of ZK exception.

Fix end of ZK exception.

--- src/onyx/log/zookeeper.clj
+++ src/onyx/log/zookeeper.clj
@@ -163,6 +163,9 @@
                      (>!! ch position)
                      (recur)))))
              (recur (inc position)))))
+       (catch org.apache.zookeeper.KeeperException$ConnectionLossException e
+         ;; ZooKeeper has been shutdown, close the subscriber cleanly.
+         (close! ch))
        (catch Exception e
          (fatal e))))
     (<!! rets)))


thru rm_meddra_smq_content

thru rm_meddra_smq_content

--- src/pg_demo/table_defs.clj
+++ src/pg_demo/table_defs.clj
@@ -5235,6 +5235,285 @@
               PRIMARY KEY (ENTERPRISE_ID,CENTER_ID,STUDY_KEY,SEQ_NUM)
           ); " }

+    { "rm_lm_study_countries"
+          "CREATE TABLE rm_lm_study_countries (
+              ENTERPRISE_ID numeric NOT NULL,
+              STUDY_KEY numeric NOT NULL,
+              SEQ_NUM numeric NOT NULL,
+              COUNTRY_ID numeric NOT NULL,
+              INACTIVE_DATE timestamp,
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,STUDY_KEY,SEQ_NUM)
+          ); " }
+
+    { "rm_lm_study_products"
+          "CREATE TABLE rm_lm_study_products (
+              ENTERPRISE_ID numeric NOT NULL,
+              PRODUCT_ID numeric NOT NULL,
+              SEQ_NUM numeric NOT NULL,
+              LICENSE_ID numeric,
+              MEDICINAL_PROD_ID varchar(10),
+              DELETED timestamp,
+              BLINDED numeric NOT NULL,
+              COHORT_ID numeric NOT NULL,
+              PROD_TYPE_ID numeric,
+              PRIMARY KEY (ENTERPRISE_ID,COHORT_ID,PRODUCT_ID,SEQ_NUM)
+          ); " }
+
+    { "rm_lm_study_references"
+          "CREATE TABLE rm_lm_study_references (
+              ENTERPRISE_ID numeric NOT NULL,
+              STUDY_KEY numeric NOT NULL,
+              SEQ_NUM numeric NOT NULL,
+              SORT_ID numeric,
+              REF_TYPE_ID numeric,
+              REFERENCE varchar(40),
+              COUNTRY_ID numeric,
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,STUDY_KEY,SEQ_NUM)
+          ); " }
+
+    { "rm_lm_study_susar"
+          "CREATE TABLE rm_lm_study_susar (
+              ENTERPRISE_ID numeric NOT NULL,
+              STUDY_KEY numeric NOT NULL,
+              SEQ_NUM numeric NOT NULL,
+              ALWAYS_REPORT numeric NOT NULL,
+              COUNTRY_ID numeric NOT NULL,
+              LICENSE_TYPE_ID numeric NOT NULL,
+              AGENCY_ID numeric,
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,STUDY_KEY,SEQ_NUM)
+          ); " }
+
+    { "rm_lm_study_types"
+          "CREATE TABLE rm_lm_study_types (
+              STUDY_TYPE_ID numeric NOT NULL,
+              STUDY_TYPE varchar(15),
+              PROTECTED numeric,
+              DISPLAY numeric,
+              STUDY_TYPE_J varchar(15),
+              DELETED timestamp,
+              PRIMARY KEY (STUDY_TYPE_ID)
+          ); " }
+
+    { "rm_lm_udf_ddl_values"
+          "CREATE TABLE rm_lm_udf_ddl_values (
+              ENTERPRISE_ID numeric NOT NULL,
+              ID numeric NOT NULL,
+              FIELD_ID numeric NOT NULL,
+              DESCRIPTION varchar(100),
+              DESCRIPTION_J varchar(100),
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,ID)
+          ); " }
+
+    { "rm_lm_unblinding_status"
+          "CREATE TABLE rm_lm_unblinding_status (
+              ENTERPRISE_ID numeric NOT NULL,
+              STATUS_ID numeric NOT NULL,
+              UNBLINDING_STATUS varchar(30),
+              DISPLAY numeric(1),
+              PROTECTED numeric(1),
+              UNBLINDING_STATUS_J varchar(30),
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,STATUS_ID)
+          ); " }
+
+    { "rm_lm_vaccinated_at"
+          "CREATE TABLE rm_lm_vaccinated_at (
+              ENTERPRISE_ID numeric NOT NULL,
+              VACC_AT_ID numeric NOT NULL,
+              LOCATION varchar(40),
+              LOCATION_J varchar(40),
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,VACC_AT_ID)
+          ); " }
+
+    { "rm_lm_vaccines"
+          "CREATE TABLE rm_lm_vaccines (
+              VACC_ID numeric NOT NULL,
+              VACCINE_CODE varchar(6),
+              VACCINE_DESC varchar(100),
+              DELETED timestamp,
+              PRIMARY KEY (VACC_ID)
+          ); " }
+
+    { "rm_lm_vaers_rpt_block"
+          "CREATE TABLE rm_lm_vaers_rpt_block (
+              ENTERPRISE_ID numeric NOT NULL,
+              BLOCK_ID numeric NOT NULL,
+              BLOCK_NAME varchar(20),
+              BLOCK_NAME_J varchar(20),
+              DELETED timestamp,
+              PRIMARY KEY (ENTERPRISE_ID,BLOCK_ID)
+          ); " }
+
+    { "rm_meddra_hlgt_hlt_comp"
+          "CREATE TABLE rm_meddra_hlgt_hlt_comp (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLGT_CODE numeric NOT NULL,
+              HLT_CODE numeric NOT NULL,
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,HLGT_CODE,HLT_CODE)
+          ); " }
+
+    { "rm_meddra_hlg_pref_term"
+          "CREATE TABLE rm_meddra_hlg_pref_term (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLGT_CODE numeric NOT NULL,
+              HLGT_NAME varchar(120),
+              HLGT_WHO_ART_CODE varchar(7),
+              HLGT_HARTS_CODE numeric,
+              HLGT_COSTART_FG varchar(21),
+              HLGT_ICD9_CODE varchar(8),
+              HLGT_ICD9CM_CODE varchar(8),
+              HLGT_ICD10_CODE varchar(8),
+              HLGT_J_ART_CODE varchar(6),
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,HLGT_CODE)
+          ); " }
+
+    { "rm_meddra_hlg_pref_term_j"
+          "CREATE TABLE rm_meddra_hlg_pref_term_j (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLGT_CODE numeric NOT NULL,
+              HLGT_KANJI varchar(400),
+              HLGT_KANA varchar(400),
+              HLGT_KANA1 varchar(400),
+              HLGT_KANA2 varchar(400),
+              PRIMARY KEY (GLOBAL_DICT_ID,HLGT_CODE)
+          ); " }
+
+    { "rm_meddra_hlt_pref_comp"
+          "CREATE TABLE rm_meddra_hlt_pref_comp (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLT_CODE numeric NOT NULL,
+              PT_CODE numeric NOT NULL,
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,HLT_CODE,PT_CODE)
+          ); " }
+
+    { "rm_meddra_hl_pref_term"
+          "CREATE TABLE rm_meddra_hl_pref_term (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLT_CODE numeric NOT NULL,
+              HLT_NAME varchar(120),
+              HLT_WHO_ART_CODE varchar(7),
+              HLT_HARTS_CODE numeric,
+              HLT_COSTART_FG varchar(21),
+              HLT_ICD9_CODE varchar(8),
+              HLT_ICD9CM_CODE varchar(8),
+              HLT_ICD10_CODE varchar(8),
+              HLT_J_ART_CODE varchar(6),
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,HLT_CODE)
+          ); " }
+
+    { "rm_meddra_hl_pref_term_j"
+          "CREATE TABLE rm_meddra_hl_pref_term_j (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              HLT_CODE numeric NOT NULL,
+              HLT_KANJI varchar(400),
+              HLT_KANA varchar(400),
+              HLT_KANA1 varchar(400),
+              HLT_KANA2 varchar(400),
+              PRIMARY KEY (GLOBAL_DICT_ID,HLT_CODE)
+          ); " }
+
+    { "rm_meddra_md_hierarchy"
+          "CREATE TABLE rm_meddra_md_hierarchy (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              PT_CODE numeric NOT NULL,
+              HLT_CODE numeric NOT NULL,
+              HLGT_CODE numeric NOT NULL,
+              SOC_CODE numeric NOT NULL,
+              PT_NAME varchar(120) NOT NULL,
+              HLT_NAME varchar(120) NOT NULL,
+              HLGT_NAME varchar(120) NOT NULL,
+              SOC_NAME varchar(120) NOT NULL,
+              SOC_ABBREV varchar(5) NOT NULL,
+              NULL_FIELD varchar(1),
+              PT_SOC_CODE numeric,
+              PRIMARY_SOC_FG varchar(1),
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,PT_CODE,HLT_CODE,HLGT_CODE,SOC_CODE)
+          ); " }
+
+    { "rm_meddra_pref_term"
+          "CREATE TABLE rm_meddra_pref_term (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              PT_CODE numeric NOT NULL,
+              PT_NAME_ENGLISH varchar(120) NOT NULL,
+              NULL_FIELD varchar(1),
+              PT_SOC_CODE numeric,
+              PT_WHO_ART_CODE varchar(7),
+              PT_HARTS_CODE numeric,
+              PT_COSTART_FG varchar(21),
+              PT_ICD9_CODE varchar(8),
+              PT_ICD9CM_CODE varchar(8),
+              PT_ICD10_CODE varchar(8),
+              PT_J_ART_CODE varchar(6),
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,PT_CODE)
+          ); " }
+
+    { "rm_meddra_pref_term_j"
+          "CREATE TABLE rm_meddra_pref_term_j (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              PT_CODE numeric NOT NULL,
+              PT_KANJI varchar(400),
+              PT_KANA varchar(400),
+              PT_KANA1 varchar(400),
+              PT_KANA2 varchar(400),
+              PRIMARY KEY (GLOBAL_DICT_ID,PT_CODE)
+          ); " }
+
+    { "rm_meddra_pref_term_llt"
+          "CREATE TABLE rm_meddra_pref_term_llt (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              LLT_CODE numeric NOT NULL,
+              LLT_NAME_ENGLISH varchar(100) NOT NULL,
+              PT_CODE numeric,
+              LLT_WHO_ART_CODE varchar(7),
+              LLT_HARTS_CODE numeric,
+              LLT_COSTART_FG varchar(21),
+              LLT_ICD9_CODE varchar(8),
+              LLT_ICD9CM_CODE varchar(8),
+              LLT_ICD10_CODE varchar(8),
+              LLT_CURRENCY varchar(1),
+              LLT_J_ART_CODE varchar(6),
+              DELETED timestamp,
+              PRIMARY KEY (GLOBAL_DICT_ID,LLT_CODE)
+          ); " }
+
+    { "rm_meddra_pref_term_llt_j"
+          "CREATE TABLE rm_meddra_pref_term_llt_j (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              LLT_CODE numeric NOT NULL,
+              LLT_KANJI varchar(400),
+              LLT_JCURR varchar(10),
+              LLT_KANA varchar(600),
+              LLT_KANA1 varchar(600),
+              LLT_KANA2 varchar(600),
+              PRIMARY KEY (GLOBAL_DICT_ID,LLT_CODE)
+          ); " }
+
+    { "rm_meddra_smq_content"
+          "CREATE TABLE rm_meddra_smq_content (
+              GLOBAL_DICT_ID numeric NOT NULL,
+              SMQ_CODE numeric NOT NULL,
+              TERM_CODE numeric NOT NULL,
+              TERM_LEVEL numeric NOT NULL,
+              TERM_SCOPE numeric NOT NULL,
+              TERM_CATEGORY varchar(1) NOT NULL,
+              TERM_WEIGHT numeric NOT NULL,
+              TERM_STATUS varchar(1) NOT NULL,
+              TERM_ADDITION_VERSION varchar(5) NOT NULL,
+              TERM_LAST_MODIFIED_VERSION varchar(5) NOT NULL,
+              PRIMARY KEY (GLOBAL_DICT_ID,SMQ_CODE,TERM_CODE)
+          ); " }
+
   ] ))

 (def dummy


Support maps and collections.

Support maps and collections.

--- src/dragon/blog.clj
+++ src/dragon/blog.clj
@@ -114,7 +114,10 @@

 (defn data-minus-body
   [data]
-  (map #(dissoc % :body) data))
+  (log/trace "Dumping body from: " (into [] data))
+  (cond
+    (map? data) (assoc data :body "...")
+    (coll? data) (map #(assoc % :body "...") data)))

 (defn post-url
   [uri-base post]
@@ -152,7 +155,7 @@

 (defn get-indexed-archive-routes
   [data & {:keys [uri-base gen-func]}]
-  (log/trace "Got data:" (data-minus-body data))
+  (log/trace "Got data:"data)
   (->> data
        (map (partial get-indexed-archive-route uri-base gen-func data))
        (into {})))


Maybe this is bad?

Maybe this is bad?

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -37,11 +37,10 @@

 (defn korhal-gameStarted [this]
   (println "Here we go!")
-  (doto (:api @this)
-    (.enableUserInput)
-    (.enablePerfectInformation)
-    (.setGameSpeed 0)
-    (.loadMapData true))
+  (.enableUserInput (:api @this))
+  (.enablePerfectInformation (:api @this))
+  (.setGameSpeed (:api @this) 0)
+  (.loadMapData (:api @this) true)
   (swap-keys (.state this)
     :claimed []
     :morphed-drone false
@@ -49,8 +48,6 @@
     :supply-cap 0))

 (defn korhal-gameUpdate [this]
-
-  (println "updating")

   ;; spawn a drone
   (for [unit (.getMyUnits (:api @this))]


same API as fr/ and it/

same API as fr/ and it/

--- src/es.clj
+++ src/es.clj
@@ -3,40 +3,55 @@
 ;; lein run -m es/todos
 ;; lein run -m es/todos <num>

-(ns es)
+(ns es (:refer-clojure :exclude [get-in]))

-(require '[babel.writer :refer [fill-by-spec fill-verb write-lexicon]])
+(require '[babel.writer :refer [fill-by-spec fill-verb process write-lexicon]])
 (require '[babel.english :as en])
-(require '[babel.espanol :as es :refer [verbs]])
+(require '[babel.espanol :as es :refer [lexicon]])
 (require '[babel.korma :refer :all])
-(require '[babel.repair :refer [process]])
 (require '[clojure.tools.logging :as log])
-(require '[dag-unify.core :refer [unify]])
+(require '[dag-unify.core :refer [get-in unify]])
 (require '[korma.core :refer :all])
 (require '[korma.db :refer :all])

 (defn todos [ & [count]]
   (let [count (if count (Integer. count) 10)]
     (write-lexicon "es" @es/lexicon)
-    (process
-     (reduce concat
-             (map (fn [verb]
-                    (map (fn [tense]
-                           {:fill
-                            {:spec (unify {:root {:espanol {:espanol verb}}}
-                                          tense)
-                             :source-model en/small
-                             :target-model es/small
-                             :count count}})
-                         (shuffle
-                          [
-                           {:synsem {:sem {:aspect :perfect
+    (let [
+          ;; subset of the lexicon: only verbs which are infinitives and that can be roots:
+          ;; (i.e. those that have a specific (non- :top) value for [:synsem :sem :pred])
+          root-verbs
+          (zipmap
+           (keys @lexicon)
+           (map (fn [lexeme-set]
+                  (filter (fn [lexeme]
+                            (and
+                             (= (get-in lexeme [:synsem :cat]) :verb)
+                             (= (get-in lexeme [:synsem :infl]) :top)
+                             (not (= :top (get-in lexeme [:synsem :sem :pred] :top)))))
+                          lexeme-set))
+                (vals @lexicon)))]
+      (.size (map (fn [verb]
+                    (let [root-form (get-in verb [:espanol :espanol])]
+                      (log/debug (str "generating from root-form:" root-form))
+                      (.size (map (fn [tense]
+                                    (let [spec (unify {:root {:espanol {:espanol root-form}}}
+                                                      tense)]
+                                      (log/debug (str "generating from: " spec))
+                                      (process [{:fill
+                                                 {:spec spec
+                                                  :source-model en/small
+                                                  :target-model es/small}
+                                                 :count count}])))
+                                  [{:synsem {:sem {:tense :conditional}}}
+                                   {:synsem {:sem {:tense :futuro}}}
+                                   {:synsem {:sem {:tense :present}}}
+                                   {:synsem {:sem {:aspect :perfect
                                            :tense :past}}}
-                           {:synsem {:sem {:tense :conditional}}}
-                           {:synsem {:sem {:tense :futuro}}}
-                           {:synsem {:sem {:tense :present}}}
-                           ])
-                         ))
-                  (sort verbs)
-                  )))))
+                                   ]
+                                  ))))
+                  (reduce concat
+                          (map (fn [key]
+                                 (get root-verbs key))
+                               (sort (keys root-verbs)))))))))


ant task macros working

ant task macros working

--- lancet/ant/ant.clj
+++ lancet/ant/ant.clj
@@ -52,29 +52,22 @@
     ([props]
        (let [task (instantiate-task ant-project task-name props)]
 	 (.execute task)))))
-
-(defmacro define-ant-task [task-name]
-  `(def ~(symbol task-name) (create-ant-task ~task-name)))

-;; (doseq td (.getTaskDefinitions ant-project)
-;;  (do
-;;    (println (.getKey td))
-;;    (define-ant-task (.getKey td))))
+(def task-names
+     (disj (set (map #(symbol (.getKey %)) (.getTaskDefinitions ant-project)))
+	   'import 'touch 'sync 'concat 'filter 'replace 'get 'apply))

-;; (defmacro define-data-type [type-name]
-;;   `(defn ~type-name
-;;      ([] (~type-name {}))
-;;      ([props#]
-;; 	(instantiate-data-type ant-project ~type-name props#))))
-
+(defmacro define-ant-task [t]
+  `(def ~t (create-ant-task ~(name t))))

-; TODO: replace with reflective approach (above)
-;; (define-ant-task echo)
-;; (define-ant-task tstamp)
-;; (define-ant-task mkdir)
-;; (define-ant-task javac)
-;; (define-ant-task delete)
-;; (define-ant-task jar)
+(defmacro define-ant-tasks []
+  `(do
+     ~@(map
+	(fn [nm]
+	  `(define-ant-task ~nm))
+	task-names)))

-;; (define-data-type fileset)
+(define-ant-tasks)

+; (define-data-type fileset)
+


Also a recursive function, much worse than with filter...

--- clojure-functional/src/test/clojure/no/knowit/clojure_functional/product_repository.clj
+++ clojure-functional/src/test/clojure/no/knowit/clojure_functional/product_repository.clj
@@ -3,31 +3,41 @@
   (:import [no.knowit.java_functional.product Product])
   (:import [org.joda.time LocalDate]))

+; Production code
 (defn product-is-available [local-date product-coll]
   (filter
     #(.isAvailable %1 local-date) product-coll))

+(defn product-is-available-recur [local-date product-coll]
+  (loop [cl product-coll result []]
+    (if-let [h (first cl)]
+      (recur (rest cl)
+        (conj result
+          (if (.isAvailable h local-date) h [])))
+      result)))

+; Define which function you want to test here
+(def product-func product-is-available)
+
+; Test code
 (deftest empty_list_when_no_products
-  (is (= (product-is-available (LocalDate.) []))))
+  (is (= (product-func (LocalDate.) []))))

 (deftest product_available_when_matching_date
   (let [today (new LocalDate)
         product (new Product "Cool product" today today)]
-    (is (not-empty (product-is-available today [product])))
-    (is (.contains (product-is-available today [product]) product))))
+    (is (not-empty (product-func today [product])))
+    (is (.contains (product-func today [product]) product))))

 (deftest empty_list_when_no_products_matching_date
   (let [today (new LocalDate)
         yesterday (.minusDays today 1)
         product (new Product "Cool product" yesterday yesterday)]
-    (is (empty (product-is-available today [product])))))
+    (is (empty (product-func today [product])))))

 (deftest find_discontinued_products
   (let [yesterday (.minusDays (new LocalDate) 1)
         product (new Product "Cool product" yesterday yesterday)]
-    (is (not-empty (product-is-available yesterday [product])))))
-
-
+    (is (not-empty (product-func yesterday [product])))))

 (run-tests)


cmr-6631 - adding sequence and uniq constraint (#1047)

* CMR-6631 - Adding a new column to the subscirption table for storing last notification date-time

* creating a new table to hold the notification details instead of using the subscription table

* rename of the notification column per suggestion

* CMR-6631 - adding primary key sequence and a uniq constraint

* CMR-6612 - renamed constraint and removed util functions

--- metadata-db-app/src/cmr/metadata_db/migrations/072_add_cmr_sub_notifications_table.clj
+++ metadata-db-app/src/cmr/metadata_db/migrations/072_add_cmr_sub_notifications_table.clj
@@ -9,17 +9,21 @@
  last_notified_at TIMESTAMP WITH TIME ZONE DEFAULT SYSTIMESTAMP NOT NULL")

  (def ^:private sub-notifications-constraint-sql
-   (str "CONSTRAINT sub_notifications_pk PRIMARY KEY (id)"))
+   (str "CONSTRAINT sub_notifications_pk PRIMARY KEY (id),"
+   "CONSTRAINT sub_cid UNIQUE (subscription_concept_id)"))

 (defn up
   "Migrates the database up to version 72."
   []
   (println "cmr.metadata-db.migrations.072-add-cmr-sub-notifications-table up...")
   (h/sql (format "CREATE TABLE METADATA_DB.cmr_sub_notifications (%s, %s)"
-   sub-notifications-column-sql sub-notifications-constraint-sql)))
+   sub-notifications-column-sql
+   sub-notifications-constraint-sql))
+  (h/sql "CREATE SEQUENCE cmr_sub_notifications_seq"))

 (defn down
   "Migrates the database down from version 72."
   []
   (println "cmr.metadata-db.migrations.072-add-cmr-sub-notifications-table down.")
+  (h/sql "DROP SEQUENCE METADATA_DB.cmr_sub_notifications_seq")
   (h/sql "DROP TABLE cmr_sub_notifications"))


Improve Doc of Func :version.fn/add-query

--- src/lens/schema.clj
+++ src/lens/schema.clj
@@ -129,7 +129,7 @@

     (func :workbook.fn/update
       "Updates the version in the workbook.
-
+
       Checks that the old version is still current - throws a exception with
       type ::precondition-failed if not. Throws ::workbook-not-found if the
       workbook doesn't exist. Throws ::version-not-found if the new version
@@ -154,12 +154,12 @@

 (def version
   "Schema of a version.
-
+
   A version is immutable. All updating functions return always a new version
   like operations on normal immutable data structures. The :version/parent
   references the past version of a version. One can use the parent to undo a
   change in a workbook. The parent of the initial version of a workbook is nil.
-
+
   A version has a linked list of queries. One can use the function
   :version.fn/add-query to add a new query in front of the list."
   {:attributes
@@ -203,8 +203,8 @@
         :version/parent parent}])

     (func :version.fn/add-query
-      "Adds a new query to a copy of the given version. Needs a tempid for the
-      new version."
+      "Creates transaction data for a new version which has one standard query
+      added to the given version. Needs a tempid for the new version."
       [db tid version]
       (let [queries (:version/queries (d/entity db version))
             new-queries #db/id[:db.part/user]
@@ -302,7 +302,7 @@

     (func :version.fn/remove-query-cell
       "Removes a query cell from a copy of the given version.
-
+
       Needs a tempid for the new version."
       [db tid version query-idx col-idx term-id]
       (let [seq (fn seq [l] (when l (cons (:l/head l) (seq (:l/tail l)))))


korma -> kc рефакторинг

korma -> kc рефакторинг

--- radiolamp-6P3/src/ixinfestor/core.clj
+++ radiolamp-6P3/src/ixinfestor/core.clj
@@ -1,13 +1,13 @@
 (ns ixinfestor.core

-  (:use korma.db)
-  (:use korma.core)
-
   (:use clojure.pprint)

   (:import [org.imgscalr Scalr])

-  (:require [clj-time.core :as tco]
+  (:require [korma.db :as kdb]
+            [korma.core :as kc]
+
+            [clj-time.core :as tco]
             [clj-time.format :as tf]
             [clj-time.coerce :as tc]
             [clj-time.local :as tl]
@@ -200,14 +200,14 @@
 (defn com-exec
   "Выполнить запрос"
   [query]
-  (exec query))
+  (kc/exec query))

 (defn com-exec-1
   "Выполнить запрос одной записи"
   [query]
   (-> query
-      (limit 1)
-      exec
+      (kc/limit 1)
+      kc/exec
       first))

@@ -215,54 +215,54 @@
 (defn com-save-for-field
   "Сохранить сущность"
   [entity field row]
-  (transaction
-   (let [r (update entity (set-fields row) (where (= field (row field))))]
+  (kdb/transaction
+   (let [r (kc/update entity (kc/set-fields row) (kc/where (= field (row field))))]
      (if (= r 0)
-       (insert entity (values row))
-       (first (select entity (where (= field (row field)))))))))
+       (kc/insert entity (kc/values row))
+       (first (kc/select entity (kc/where (= field (row field)))))))))

 (defn com-save-for-field-2
   "Сохранить сущность"
   [entity field-1 field-2 row]
-  (transaction
-   (let [r (update entity (set-fields row) (where (and
-                                                   (= field-1 (row field-1))
-                                                   (= field-2 (row field-2))
-                                                   )))]
+  (kdb/transaction
+   (let [r (kc/update entity (kc/set-fields row) (kc/where (and
+                                                            (= field-1 (row field-1))
+                                                            (= field-2 (row field-2))
+                                                            )))]
      (if (= r 0)
-       (insert entity (values row))
-       (first (select entity (where (and
-                                     (= field-1 (row field-1))
-                                     (= field-2 (row field-2))))))))))
+       (kc/insert entity (kc/values row))
+       (first (kc/select entity (kc/where (and
+                                           (= field-1 (row field-1))
+                                           (= field-2 (row field-2))))))))))

 (defn com-save-for-id
   "Сохранить сущность"
   [entity row]
-  (transaction
-   (let [r (update entity (set-fields row) (where (= :id (row :id))))]
+  (kdb/transaction
+   (let [r (kc/update entity (kc/set-fields row) (kc/where (= :id (row :id))))]
      (if (= r 0)
-       (insert entity (values row))
-       (first (select entity (where (= :id (row :id)))))))))
+       (kc/insert entity (kc/values row))
+       (first (kc/select entity (kc/where (= :id (row :id)))))))))

 (defn com-delete*
   "Удалить сущность"
   [entity]
-  (delete* entity))
+  (kc/delete* entity))

 (defn com-delete-for-id
   "Удалить сущность"
   [entity]
-  (delete* entity))
+  (kc/delete* entity))

 (defn com-delete-for-id
   "Удалить сущность по id"
   [entity id]
-  (delete entity (where (= :id id))))
+  (kc/delete entity (kc/where (= :id id))))

 (defn com-find
   "Найти сущность по :id"
   [entity id]
-  (let [rows (select entity (where (= :id id)))]
+  (let [rows (kc/select entity (kc/where (= :id id)))]
     (cond (empty? rows) nil
           (< 1 (count rows)) (do
                                (println "Внимание! По com-find нашел более одной записи по id "
@@ -274,13 +274,13 @@
   "Найти сущность по :id"
   [select*-1 id]
   (-> select*-1
-      (where (= :id id))
+      (kc/where (= :id id))
       com-exec-1))

 (defn com-count
   "Количество всех элементов"
   [entity]
-  (-> (select entity (aggregate (count :*) :c))
+  (-> (kc/select entity (kc/aggregate (count :*) :c))
       first
       :c))

@@ -288,12 +288,12 @@
   "Количество всех элементов"
   [select*-1]
   (-> select*-1
-      (aggregate (count :*) :c)
+      (kc/aggregate (count :*) :c)
       com-exec-1
       :c))

 (defn com-pred-page* [query* page size]
-  (-> query* (limit size) (offset (* page size))))
+  (-> query* (kc/limit size) (kc/offset (* page size))))

 (def spec-word-or #"\|")
@@ -312,19 +312,19 @@
                                      (reduce #(str %1 " & " %2))
                                      (#(str "(" % ")")))))
                          (clojure.string/join " | ")))]
-    (where query* (raw (str " " (name fts-field) " @@ to_tsquery('" fts-query "')")))))
+    (kc/where query* (kc/raw (str " " (name fts-field) " @@ to_tsquery('" fts-query "')")))))

 (defn com-defn-add-rel-many-to-many
   "создание функции соединения двух сущностей по типу many-to-many"
   [field-id-1 field-id-2 rel-entity field-fk-id-1 field-fk-id-2]
   (fn [{entity-1-id field-id-1} {entity-2-id field-id-2}]
-    (let [entity-2-row (select rel-entity
-                               (where (and
-                                       (=  field-fk-id-1 entity-1-id)
-                                       (=  field-fk-id-2 entity-2-id))))]
-      (if (empty? entity-2-row) (insert rel-entity
-                                        (values {field-fk-id-1 entity-1-id field-fk-id-2 entity-2-id}))
+    (let [entity-2-row (kc/select rel-entity
+                                  (kc/where (and
+                                             (=  field-fk-id-1 entity-1-id)
+                                             (=  field-fk-id-2 entity-2-id))))]
+      (if (empty? entity-2-row) (kc/insert rel-entity
+                                           (kc/values {field-fk-id-1 entity-1-id field-fk-id-2 entity-2-id}))
           (first entity-2-row)))))

@@ -333,54 +333,54 @@
   "создание функции проверки наличия соединения двух сущностей по типу many-to-many"
   [entity-2 field-id-2 field-keyname-2 rel-entity field-fk-id-1 field-fk-id-2]
   (fn [{entity-1-id field-id-2} entity-2-keyname]
-    (transaction
-     (let [entity-2s-ids (select entity-2
-                                 (fields field-id-2)
-                                 (where (= field-keyname-2 (name entity-2-keyname))))]
+    (kdb/transaction
+     (let [entity-2s-ids (kc/select entity-2
+                                    (kc/fields field-id-2)
+                                    (kc/where (= field-keyname-2 (name entity-2-keyname))))]
        (if (empty? entity-2s-ids)
          (throw (Exception. (str "Row with " field-keyname-2 " = " entity-2-keyname " is not described.")))
-         (not (empty? (select rel-entity
-                              (limit 1)
-                              (where (and
-                                      (= field-fk-id-1 entity-1-id)
-                                      (= field-fk-id-2 (-> entity-2s-ids first field-id-2))))))))))))
+         (not (empty? (kc/select rel-entity
+                                 (kc/limit 1)
+                                 (kc/where (and
+                                            (= field-fk-id-1 entity-1-id)
+                                            (= field-fk-id-2 (-> entity-2s-ids first field-id-2))))))))))))

 (defn com-defn-get-rels-set
   [entity-2 field-id-2 field-keyname-2 rel-entity field-fk-id-1 field-fk-id-2]
   (fn [{entity-1-id field-id-2}]
-    (transaction
-     (->> (select entity-2 (fields field-keyname-2)
-                  (where {field-id-2 [in (subselect rel-entity
-                                                    (fields field-fk-id-2)
-                                                    (where (= field-fk-id-1 entity-1-id)))]}))
+    (kdb/transaction
+     (->> (kc/select entity-2 (kc/fields field-keyname-2)
+                     (kc/where {field-id-2 [in (kc/subselect rel-entity
+                                                             (kc/fields field-fk-id-2)
+                                                             (kc/where (= field-fk-id-1 entity-1-id)))]}))
           (map field-keyname-2)
           set))))

 (defn com-defn-pred-rows-by-rel?
   [field-id-1 field-id-2 rel-entity field-fk-id-1 field-fk-id-2 & [not?]]
   (fn [select*-1 {entity-2-id field-id-2}]
-    (where select*-1
-           {field-id-1
-            (let [p [in (subselect rel-entity
-                                   (fields field-fk-id-1)
-                                   (where (= field-fk-id-2 entity-2-id)))]]
-              (if not? (not p) p))})))
+    (kc/where select*-1
+              {field-id-1
+               (let [p [in (kc/subselect rel-entity
+                                         (kc/fields field-fk-id-1)
+                                         (kc/where (= field-fk-id-2 entity-2-id)))]]
+                 (if not? (not p) p))})))

 (defn com-defn-pred-rows-by-rel--nil-other?
   [field-id-1 field-id-2 rel-entity field-fk-id-1 field-fk-id-2]
   (fn [select*-1 {entity-2-id field-id-2 :as row}]
     (if (nil? entity-2-id)
       ;; nil
-      (where select*-1 (not (exists
-                             (subselect rel-entity
-                                        (where (= field-fk-id-1
-                                                  (-> select*-1
-                                                      :ent
-                                                      :table
-                                                      str
-                                                      (str "." (name field-id-1))
-                                                      keyword)
-                                                  ))))))
+      (kc/where select*-1 (not (exists
+                                (kc/subselect rel-entity
+                                              (kc/where (= field-fk-id-1
+                                                           (-> select*-1
+                                                               :ent
+                                                               :table
+                                                               str
+                                                               (str "." (name field-id-1))
+                                                               keyword)
+                                                           ))))))
       ;; not nil
       ((com-defn-pred-rows-by-rel? field-id-1 field-id-2
                                    rel-entity field-fk-id-1 field-fk-id-2)
@@ -391,19 +391,19 @@
   (fn [select*-1 entity-2-rows]
     (reduce
      (fn [query entity-2-row]
-       (where query
-              (let [p (exists
-                       (subselect rel-entity
-                                  (fields field-fk-id-1)
-                                  (where (and
-                                          (= field-fk-id-2 (field-id-2 entity-2-row))
-                                          (= field-fk-id-1 (-> select*-1
-                                                               :ent
-                                                               :table
-                                                               (str "." (name field-id-1))
-                                                               keyword)))
-                                         )))]
-                (if not? (not p) p))))
+       (kc/where query
+                 (let [p (exists
+                          (kc/subselect rel-entity
+                                        (kc/fields field-fk-id-1)
+                                        (kc/where (and
+                                                   (= field-fk-id-2 (field-id-2 entity-2-row))
+                                                   (= field-fk-id-1 (-> select*-1
+                                                                        :ent
+                                                                        :table
+                                                                        (str "." (name field-id-1))
+                                                                        keyword)))
+                                                  )))]
+                   (if not? (not p) p))))
      select*-1 entity-2-rows)))

 ;; END SQL TOOLS
@@ -590,9 +590,9 @@
 ;;*
 ;;**************************************************************************************************

-(defentity webuser
-  (pk :id)
-  (transform (fn [row] (dissoc row :fts)))
+(kc/defentity webuser
+  (kc/pk :id)
+  (kc/transform (fn [row] (dissoc row :fts)))
   )

@@ -608,12 +608,12 @@
   ;; SAVE
   (com-save-for-field webuser :username webuser-row))

-(def webuser-select* (select* webuser))
+(def webuser-select* (kc/select* webuser))

 (defn webuser-find-by-username [username]
-  (-> (select* webuser)
-      (where (= :username username))
-      exec
+  (-> (kc/select* webuser)
+      (kc/where (= :username username))
+      kc/exec
       first))

 (defn webuser-pred-search? [select*-1 fts-query]
@@ -639,21 +639,21 @@
 ;;**************************************************************************************************

-(defentity webrolesgroup
-  (pk :id)
-  (prepare (partial prepare-as-string :keyname))
-  (transform (partial transform-as-keyword :keyname)))
+(kc/defentity webrolesgroup
+  (kc/pk :id)
+  (kc/prepare (partial prepare-as-string :keyname))
+  (kc/transform (partial transform-as-keyword :keyname)))

 (defn webrolesgroup-init [row]
   (com-save-for-field webrolesgroup :keyname (update-in row [:keyname] name)))

-(defentity webrole
-  (pk :id)
-  (belongs-to webrolesgroup)
-  (prepare (partial prepare-as-string :keyname))
-  (transform (partial transform-as-keyword :keyname)))
+(kc/defentity webrole
+  (kc/pk :id)
+  (kc/belongs-to webrolesgroup)
+  (kc/prepare (partial prepare-as-string :keyname))
+  (kc/transform (partial transform-as-keyword :keyname)))

 (defn webrole-init [row]
   (com-save-for-field webrole :keyname (update-in row [:keyname] name)))
@@ -662,8 +662,8 @@
   ([] (webrole-list false))
   ([with-webrolesgroup]
    (if with-webrolesgroup
-     (select webrole (with webrolesgroup))
-     (select webrole))))
+     (kc/select webrole (kc/with webrolesgroup))
+     (kc/select webrole))))

 ;; END entity webrole
@@ -677,24 +677,24 @@
 ;;*
 ;;**************************************************************************************************

-(defentity webuserwebrole
-  (pk :id))
+(kc/defentity webuserwebrole
+  (kc/pk :id))

 (defn webuserwebrole-add-rel [webuser-row webrole-row]
   ((com-defn-add-rel-many-to-many :id :id webuserwebrole :webuser_id :webrole_id) webuser-row webrole-row))

                                         ;TODO: Надо написать тесты
 (defn webuserwebrole-add-rels [{id :id :as webuser-row} webrole-rows]
-  (transaction
-   (delete webuserwebrole (where (= :webuser_id id)))
+  (kdb/transaction
+   (kc/delete webuserwebrole (kc/where (= :webuser_id id)))
    (doall (map (partial webuserwebrole-add-rel webuser-row) webrole-rows))))

                                         ;TODO: Надо написать тесты
 (defn webuserwebrole-add-rels-for-keynames [webuser-row webrole-rows-keynames]
   (->> webrole-rows-keynames
-       (map #(first (select webrole (where (= :keyname (name %))))))
+       (map #(first (kc/select webrole (kc/where (= :keyname (name %))))))
        (webuserwebrole-add-rels webuser-row)
-       transaction))
+       kdb/transaction))

 (defn webuserwebrole-webuser-has-a-role? [webuser-row webrole-keyname]
   ((com-defn-has-a-rel? webrole :id :keyname webuserwebrole :webuser_id :webrole_id) webuser-row webrole-keyname))
@@ -706,7 +706,7 @@
   (-> username
       webuser-find-by-username
       webuserwebrole-own-get-rels-set
-      transaction))
+      kdb/transaction))

 (defn webuserwebrole-get-rels-set-from-request [request]
   (-> request
@@ -806,15 +806,15 @@
 (declare files)

 (defn files-resize-all-images [{:keys [ws] :or {ws []}}]
-  (doseq [{path :path} (select files
-                               (fields :path)
-                               (where {:content_type [in ["image/gif"
-                                                          "image/jpeg"
-                                                          "image/pjpeg"
-                                                          "image/png"
-                                                          ;;"image/svg+xml"
-                                                          ;;"image/tiff"
-                                                          ]]}))
+  (doseq [{path :path} (kc/select files
+                                  (kc/fields :path)
+                                  (kc/where {:content_type [in ["image/gif"
+                                                                "image/jpeg"
+                                                                "image/pjpeg"
+                                                                "image/png"
+                                                                ;;"image/svg+xml"
+                                                                ;;"image/tiff"
+                                                                ]]}))
           :let [path (clojure.string/replace-first path #"/image/" "/")
                 file-src (new java.io.File (str @files-root-directory "/" path))]]
     (do
@@ -835,11 +835,11 @@
 (defn save-file [tempfile dir filename]
   (save-file-o tempfile dir filename {}))

-(defentity files
-  (pk :id)
-  (transform (fn [row] (dissoc row :fts))))
-
-(def files-select* (select* files))
+(kc/defentity files
+  (kc/pk :id)
+  (kc/transform (fn [row] (dissoc row :fts))))
+
+(def files-select* (kc/select* files))

 (defn files-save
   "Сохранение files"
@@ -852,7 +852,7 @@
 (defn file-upload-o [file-row tempfile {:keys [path-prefix]
                                         :or {path-prefix ""}
                                         :as options}]
-  (transaction
+  (kdb/transaction
    (let [{id :id :as new-row} (-> file-row
                                   (assoc :path "?TMP?")
                                   files-save)
@@ -869,16 +869,16 @@

 (defn file-pred-images* [query* & [not?]]
-  (where query*
-         {:content_type [(if not? not-in in) ["image/gif"
-                                              "image/jpeg"
-                                              "image/pjpeg"
-                                              "image/png"
-                                              "image/svg+xml"
-                                              "image/tiff"]]}))
+  (kc/where query*
+            {:content_type [(if not? not-in in) ["image/gif"
+                                                 "image/jpeg"
+                                                 "image/pjpeg"
+                                                 "image/png"
+                                                 "image/svg+xml"
+                                                 "image/tiff"]]}))

 (defn file-pred-galleria? [query*]
-  (where query* (= :galleria true)))
+  (kc/where query* (= :galleria true)))

@@ -887,13 +887,13 @@

 ;;связи для файлов

-(defentity files_rel
-  (belongs-to files))
+(kc/defentity files_rel
+  (kc/belongs-to files))

 (defn file-upload-rel-on-o [entity files-rel-field {id :id :as entity-row} options file-row tempfile]
-  (transaction
+  (kdb/transaction
    (let [file-row (file-upload-o file-row tempfile options)]
-     [file-row (insert files_rel (values {:files_id (:id file-row) files-rel-field id}))]
+     [file-row (kc/insert files_rel (kc/values {:files_id (:id file-row) files-rel-field id}))]
      )))

 (defn file-upload-rel-on [entity files-rel-field {id :id :as entity-row} file-row tempfile]
@@ -902,8 +902,8 @@

 (defn files_rel-delete [files-rel-field {file-id :id} {rel-id :id}]
-  (delete files_rel (where (and (= :files_id file-id)
-                                (= files-rel-field rel-id)))))
+  (kc/delete files_rel (kc/where (and (= :files_id file-id)
+                                      (= files-rel-field rel-id)))))

 (defn files_rel-select-files-by-* [row files-rel-field]
   ((com-defn-pred-rows-by-rel? :id :id files_rel :files_id files-rel-field)
@@ -939,18 +939,18 @@
 ;; select a.id, a.parent_id, a.tagname, cast (b.PATH ||'->'|| a.tagname as text) as PATH FROM tag a, temp1 b WHERE a.parent_id = b.id)
 ;; select * from temp1 order by PATH

-(defentity tag
-  (pk :id)
-  (prepare (fn [row] (-> row
-                         ((partial prepare-as-string :constname)))))
-  (transform (fn [row] (-> row
-                           ((partial transform-as-keyword :constname))
-                           (dissoc :fts)))))
+(kc/defentity tag
+  (kc/pk :id)
+  (kc/prepare (fn [row] (-> row
+                            ((partial prepare-as-string :constname)))))
+  (kc/transform (fn [row] (-> row
+                              ((partial transform-as-keyword :constname))
+                              (dissoc :fts)))))

 (defn tag-const? [{id :id}]
-  (-> (select* tag)
-      (where (and (= :id id) (= :const true)))
-      exec
+  (-> (kc/select* tag)
+      (kc/where (and (= :id id) (= :const true)))
+      kc/exec
       empty?
       not))

@@ -964,18 +964,18 @@
 (defn tag-save
   "Сохранение tag"
   [tag-row]
-  (transaction
+  (kdb/transaction
    (if (tag-const? tag-row) (throw (Exception. "Константная запись не может быть изменена!"))
        (com-save-for-id tag (update-in tag-row [:constname] #(when % (name %)))))))

 (defn tag-delete [{id :id :as tag-row}]
-  (transaction
+  (kdb/transaction
    (if (tag-const? tag-row) (throw (Exception. "Константная запись не может быть удалена!"))
        (com-delete-for-id tag id))))

 ;; TODO: написать тесты
 (defn tag-get-tree-path [row]
-  (transaction
+  (kdb/transaction
    (let [row (com-find tag (:id row))]
      (if (nil? row) []
          (loop [i 0, {p-id :parent_id}, row a [row]]
@@ -986,11 +986,11 @@

 ;; TODO: написать тесты
 (defn tag-get-tree-childs [{id :id}]
-  (select tag (where (= :parent_id id)) (order :tagname :ASC)))
+  (kc/select tag (kc/where (= :parent_id id)) (kc/order :tagname :ASC)))

 ;; TODO: написать тесты
 (defn tag-set-parent [row {id :id :as parent-row}]
-  (transaction
+  (kdb/transaction
    (doseq [{i-id :id} (tag-get-tree-path parent-row)
            :when (= id i-id)]
      (do
@@ -1000,32 +1000,32 @@

 ;; TODO: написать тесты
 (defn tag-get-tree-path-and-childs [row]
-  (transaction
+  (kdb/transaction
    [(tag-get-tree-path row) (tag-get-tree-childs row)]))

-(def tag-list* (select* tag))
+(def tag-list* (kc/select* tag))

 ;; TODO: написать тесты
 (defn tag-tree-as-flat-groups []
-  (sort-tree-as-flat-groups :id :parent_id (select tag)))
+  (sort-tree-as-flat-groups :id :parent_id (kc/select tag)))

 ;; TODO: написать тесты
 (defn tag-tree-as-flat-groups-with-patches [store-on-key]
-  (sort-tree-as-flat-groups-with-patches :id :parent_id store-on-key (select tag) :tagname))
+  (sort-tree-as-flat-groups-with-patches :id :parent_id store-on-key (kc/select tag) :tagname))

 ;; TODO: написать тесты
 (defn tag-tree-as-flat []
-  (sort-tree-as-flat :id :parent_id (select tag)))
+  (sort-tree-as-flat :id :parent_id (kc/select tag)))

 (defn tag-select-all-sub-tree-ids [{id :id}]
-  (transaction
+  (kdb/transaction
    (letfn [(getch [id]
              (let [cc (map :id
-                           (select tag
-                                   (fields :id)
-                                   (where (= :parent_id id))))]
+                           (kc/select tag
+                                      (kc/fields :id)
+                                      (kc/where (= :parent_id id))))]
                (reduce into cc (map getch cc))))]

      (getch id))))
@@ -1047,37 +1047,37 @@
 ;;*
 ;;**************************************************************************************************

-(defentity webdoc
-  (pk :id)
-
-  (many-to-many tag :webdoctag)
-
-  (prepare (fn [{:keys [id keyname web_description] :as row}]
-             (-> (if id row (assoc row :cdate (new java.util.Date)))
-                 ((partial prepare-date-to-sql-timestamp :cdate))
-                 (assoc :udate (new java.util.Date))
-                 ((partial prepare-date-to-sql-timestamp :udate))
-
-                 (as-> row
-                     (if keyname
-                       (assoc row :ttitle (make-translit-ru-en (str keyname)))
-                       row))
-
-                 (assoc :plan_text (html-clean-tags web_description))
-                 )))
-
-  (transform (fn [row]
-               (-> row
-                   ((partial transform-sql-date-to-date :cdate))
-                   ((partial transform-sql-date-to-date :udate))
-                   (dissoc :fts)
-                   (as-> row
-                       (if (:tag row)
-                         (-> row
-                             ;;(assoc :tag-tagnames-set (->> row :tag (map :tagname) set))
-                             (assoc :tag-ids-set (->> row :tag (map :id) set)))
-                         row))
-                   )))
+(kc/defentity webdoc
+  (kc/pk :id)
+
+  (kc/many-to-many tag :webdoctag)
+
+  (kc/prepare (fn [{:keys [id keyname web_description] :as row}]
+                (-> (if id row (assoc row :cdate (new java.util.Date)))
+                    ((partial prepare-date-to-sql-timestamp :cdate))
+                    (assoc :udate (new java.util.Date))
+                    ((partial prepare-date-to-sql-timestamp :udate))
+
+                    (as-> row
+                        (if keyname
+                          (assoc row :ttitle (make-translit-ru-en (str keyname)))
+                          row))
+
+                    (assoc :plan_text (html-clean-tags web_description))
+                    )))
+
+  (kc/transform (fn [row]
+                  (-> row
+                      ((partial transform-sql-date-to-date :cdate))
+                      ((partial transform-sql-date-to-date :udate))
+                      (dissoc :fts)
+                      (as-> row
+                          (if (:tag row)
+                            (-> row
+                                ;;(assoc :tag-tagnames-set (->> row :tag (map :tagname) set))
+                                (assoc :tag-ids-set (->> row :tag (map :id) set)))
+                            row))
+                      )))
   )

@@ -1097,7 +1097,7 @@

-(def webdoc-select* (select* webdoc))
+(def webdoc-select* (kc/select* webdoc))

 (defn webdoc-save
   "Сохранение webdoc"
@@ -1112,16 +1112,16 @@
   ([webdoc-row]
    (webdoc-delete webdoc-row webdoc))
   ([{id :id} webdoc-entity]
-   (transaction
+   (kdb/transaction
     (do
-      (delete webdoctag (where (= :webdoc_id id)))
-      (delete files_rel (where (= :webdoc_id id)))
+      (kc/delete webdoctag (kc/where (= :webdoc_id id)))
+      (kc/delete files_rel (kc/where (= :webdoc_id id)))
       (com-delete-for-id webdoc-entity id)))))

 (def webdoc-select*-for-urls
   (-> webdoc-select*
-      (fields :id :keyname :ttitle :web_title_image :web_top_description :cdate
-              :web_color_0 :web_color_1 :web_color_2 :web_color_3 :web_color_4 :web_color_5)))
+      (kc/fields :id :keyname :ttitle :web_title_image :web_top_description :cdate
+                 :web_color_0 :web_color_1 :web_color_2 :web_color_3 :web_color_4 :web_color_5)))

 (defn webdoc-get-url-path [{:keys [id ttitle]}]
   (str "/" id "/" ttitle ))
@@ -1147,14 +1147,14 @@
    select*-1 tags-rows))

 (defn webdoc-pred-childs-tags-of-parent-tag? [query {id :id}]
-  (where query
-         {:id [in
-               (subselect webdoctag
-                          (fields :webdoc_id)
-                          (where {:tag_id [in
-                                           (subselect tag
-                                                      (fields :id)
-                                                      (where (= :parent_id id)))]}))]}))
+  (kc/where query
+            {:id [in
+                  (kc/subselect webdoctag
+                                (kc/fields :webdoc_id)
+                                (kc/where {:tag_id [in
+                                                    (kc/subselect tag
+                                                                  (kc/fields :id)
+                                                                  (kc/where (= :parent_id id)))]}))]}))

 (defn webdoc-pred-by-tags?-and-childs-tags-of-parent-tag?
   [select*-1 tags-rows parent-tag-row]
@@ -1165,9 +1165,9 @@
 (defn webdoc-one-row-by-tags
   ([tags-rows webdoc-entity]
    (-> webdoc-entity
-       select*
+       kc/select*
        ((com-defn-pred-rows-by-rels? :id :id  webdoctag :webdoc_id :tag_id) tags-rows)
-       (order :id :desc)
+       (kc/order :id :desc)
        com-exec-1)))

 #_(defn webdoc-pred-by-tag--nil-other*-se?
@@ -1181,10 +1181,10 @@

 (defn webdoc-pred-search-for-the-child-tree-tags? [query tag-row]
   (let [tags-ids (tag-select-all-sub-tree-ids-and-with-this-id tag-row)]
-    (where query
-           (in :id (subselect webdoctag
-                              (fields :webdoc_id)
-                              (where (in :tag_id tags-ids)))))))
+    (kc/where query
+              (in :id (kc/subselect webdoctag
+                                    (kc/fields :webdoc_id)
+                                    (kc/where (in :tag_id tags-ids)))))))

@@ -1199,7 +1199,7 @@
                            (webdoc-pred-by-tags? (conj tags-rows tag-row))
                            com-exec-1)]))
        doall
-       transaction))
+       kdb/transaction))

 (defn tag-get-path-and-join-webdoc-for-urls [tags-rows tag-row]
@@ -1210,7 +1210,7 @@
                            (webdoc-pred-by-tags? (conj tags-rows tag-row))
                            com-exec-1)]))
        doall
-       transaction))
+       kdb/transaction))

@@ -1222,7 +1222,7 @@
                            (webdoc-pred-by-tags? (conj tags-rows tag-row))
                            com-exec-1)]))
        doall
-       transaction))
+       kdb/transaction))

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

@@ -1253,17 +1253,17 @@
 ;;*
 ;;**************************************************************************************************

-(defentity webdoctag
-  (belongs-to webdoc)
-  (belongs-to tag))
+(kc/defentity webdoctag
+  (kc/belongs-to webdoc)
+  (kc/belongs-to tag))

 ;; TODO: написать тесты
 (defn webdoctag-add-tag [webdoc-row tag-row]
   ((com-defn-add-rel-many-to-many :id :id webdoctag :webdoc_id :tag_id) webdoc-row tag-row))

 (defn webdoctag-update-tags [{webdoc-id :id :as webdoc-row} tags-rows]
-  (transaction
-   (delete webdoctag (where (= :webdoc_id webdoc-id)))
+  (kdb/transaction
+   (kc/delete webdoctag (kc/where (= :webdoc_id webdoc-id)))
    (->> tags-rows
         (map (fn [tag-row]
                (webdoctag-add-tag webdoc-row tag-row)))
@@ -1280,24 +1280,24 @@
 ;;*
 ;;**************************************************************************************************

-(defentity stext
-  (pk :id)
-  (prepare (fn [row] (-> row
-                         ((partial prepare-as-string :keyname)))))
-  (transform (fn [row] (-> row
-                           ((partial transform-as-keyword :keyname))
-                           (dissoc :fts)))))
+(kc/defentity stext
+  (kc/pk :id)
+  (kc/prepare (fn [row] (-> row
+                            ((partial prepare-as-string :keyname)))))
+  (kc/transform (fn [row] (-> row
+                              ((partial transform-as-keyword :keyname))
+                              (dissoc :fts)))))

 (defn stext-save [row]
   (com-save-for-id stext row))

-(def stext-select* (select* stext))
+(def stext-select* (kc/select* stext))

 (defn stext-pred-search? [select*-1 fts-query]
   (com-pred-full-text-search* select*-1 :fts fts-query))

 (defn stext-find [stext-keyname]
-  (first (select stext (where (= :keyname (name stext-keyname))))))
+  (first (kc/select stext (kc/where (= :keyname (name stext-keyname))))))

 (defn stext-save-const [tag-row]
   (println "stext-save-const >" tag-row)


s/dag-unify/dag_unify/

--- src/babel/workbook.clj
+++ src/babel/workbook.clj
@@ -42,7 +42,7 @@
    [clojure.string :as string]
    [clojure.tools.logging :as log]
    [compojure.core :as compojure :refer [GET PUT POST DELETE ANY]]
-   [dag-unify.core :refer [get-in remove-false strip-refs unify]]
+   [dag_unify.core :refer [get-in remove-false strip-refs unify]]
    [hiccup.core :refer [html]]
 ))


Improved headers and claims validations on jws for security.

--- src/buddy/sign/jws.clj
+++ src/buddy/sign/jws.clj
@@ -51,8 +51,9 @@
                  :es512 {:signer   #(ecdsa/sign %1 %2 :sha512)
                          :verifier #(ecdsa/verify %1 %2 %3 :sha512)}})

+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Implementation details
+;; Helpers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn normalize-date-claims
@@ -69,19 +70,25 @@
   [data]
   (into {} (remove (comp nil? second) data)))

-(defn encode-header
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation details
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- encode-header
   "Encode jws header"
-  [alg extra]
-  (let [algorithm (.toUpperCase (name alg))]
-    (-> (merge {:alg algorithm :typ "JWS"} extra)
+  [alg typ]
+  (let [algorithm (.toUpperCase (name alg))
+        type (.toUpperCase (name typ))]
+    (-> {:alg algorithm :typ type}
         (json/generate-string)
         (codecs/str->bytes)
         (codecs/bytes->safebase64))))

-(defn encode-claims
+(defn- encode-claims
   "Encode jws claims."
-  [input exp nbf iat]
-  (let [additionalclaims (-> (normalize-nil-claims {:exp exp :nbf nbf :iat iat})
+  [input opts]
+  (let [additionalclaims (-> (select-keys opts [:exp :nbf :iat :iss :aud])
+                             (normalize-nil-claims)
                              (normalize-date-claims))]
     (-> (normalize-date-claims input)
         (merge additionalclaims)
@@ -89,23 +96,40 @@
         (codecs/str->bytes)
         (codecs/bytes->safebase64))))

-(defn parse-header
+(defn- parse-header
   "Parse jws header."
-  [^String header]
-  (let [header (codecs/safebase64->str header)
-        {:keys [alg] :as header} (json/parse-string header true)]
-    (when (nil? alg)
-      (throw+ {:type :parse :cause :header :message "Missing `alg` key in header."}))
-    (merge {:alg (keyword (str/lower-case alg))}
-           (dissoc header :alg))))
+  [^String headerdata {:keys [alg] :or {alg :hs256}}]
+  (when (nil? alg)
+    (throw+ {:type :validation :cause :header :message "Missing `alg` parameter."}))
+  (let [header (-> (codecs/safebase64->str headerdata)
+                   (json/parse-string true))]
+    (when (not= alg (keyword (str/lower-case (:alg header))))
+      (throw+ {:type :validation :cause :header
+               :message "The `alg` param mismatch with header value."}))
+    (merge {:alg alg} (dissoc header :alg))))

-(defn parse-claims
+(defn- parse-claims
   "Parse jws claims"
-  [^String claimsdata]
-  (-> claimsdata
-      (codecs/safebase64->bytes)
-      (codecs/bytes->str)
-      (json/parse-string true)))
+  [^String claimsdata {:keys [max-age iss aud]}]
+  (let [claims (-> claimsdata
+                   (codecs/safebase64->bytes)
+                   (codecs/bytes->str)
+                   (json/parse-string true))
+        now (util/timestamp)]
+    (when (and iss (not= iss (:iss claims)))
+      (throw+ {:type :validation :cause :iss :message (str "Issuer does not match " iss)}))
+    (when (and aud (not= aud (:aud claims)))
+      (throw+ {:type :validation :cause :aud :message (str "Audience does not match " aud)}))
+    (when (and (:exp claims) (> now (:exp claims)))
+      (throw+ {:type :validation :cause :exp
+               :message (format "Token is older than :exp (%s)" (:exp claims))}))
+    (when (and (:nbf claims) (> now (:nbf claims)))
+      (throw+ {:type :validation :cause :nbf
+               :message (format "Token is older than :nbf (%s)" (:nbf claims))}))
+    (when (and (:iat claims) (number? max-age) (> (- now (:iat claims)) max-age))
+      (throw+ {:type :validation :cause :max-age
+               :message (format "Token is older than max-age (%s)" max-age)}))
+    claims))

 (defn- calculate-signature
   "Given the bunch of bytes, a private key and algorithm,
@@ -133,10 +157,12 @@
 (defn sign
   "Sign arbitrary length string/byte array using
   json web token/signature."
-  [claims pkey & [{:keys [alg exp nbf iat headers] :or {alg :hs256 headers {}}}]]
+  ;; The exp nbf and iat keys in the options are deprecated
+  ;; and will be removed in the next version.
+  [claims pkey & [{:keys [alg typ] :or {alg :hs256 typ :jws} :as opts}]]
   {:pre [(map? claims)]}
-  (let [header (encode-header alg headers)
-        claims (encode-claims claims exp nbf iat)
+  (let [header (encode-header alg typ)
+        claims (encode-claims claims opts)
         signature (calculate-signature {:key pkey
                                         :alg alg
                                         :header header
@@ -146,32 +172,15 @@
 (defn unsign
   "Given a signed message, verify it and return
   the decoded claims."
-  [input pkey & [{:keys [max-age] :as opts}]]
-  (let [[header claims signature] (str/split input #"\." 3)
-        {:keys [alg]} (parse-header header)
-        signature (codecs/safebase64->bytes signature)]
+  ([input pkey] (unsign input pkey {}))
+  ([input pkey opts]
+   (let [[header claims signature] (str/split input #"\." 3)
+         {:keys [alg]} (parse-header header opts)
+         signature (codecs/safebase64->bytes signature)]
     (when-not (verify-signature {:key pkey :signature signature
                                  :alg alg :header header :claims claims})
       (throw+ {:type :validation :cause :auth :message "Message seems corrupt or manipulated."}))
-    (let [claims (parse-claims claims)
-          now (util/timestamp)]
-      (cond
-        (and (:exp claims) (> now (:exp claims)))
-        (throw+ {:type :validation
-                 :cause :exp
-                 :message (format "Token is older than :exp (%s)" (:exp claims))})
-
-        (and (:nbf claims) (> now (:nbf claims)))
-        (throw+ {:type :validation
-                 :cause :nbf
-                 :message (format "Token is older than :nbf (%s)" (:nbf claims))})
-
-        (and (:iat claims) (number? max-age) (> (- now (:iat claims)) max-age))
-        (throw+ {:type :validation
-                 :cause :max-age
-                 :message (format "Token is older than max-age (%s)" max-age)})
-
-        :else claims))))
+    (parse-claims claims opts))))

 (defn encode
   "Sign arbitrary length string/byte array using


Reuse filter-r from world/base.

Reuse filter-r from world/base.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -14,7 +14,7 @@
             [cbfg.lane]
             [cbfg.world.net]
             [cbfg.world.lane]
-            [cbfg.world.base :refer [world-cmd-loop]]))
+            [cbfg.world.base :refer [world-cmd-loop filter-r]]))

 (defn actx-agw [actx] ((:get-agw (first actx))))

@@ -60,13 +60,6 @@
   (render-net-addrs (:net @prog-curr)))

 ; -------------------------------------------------------------------
-
-(defn filter-r [r] (if (map? r)
-                     (-> r
-                         (dissoc :opaque)
-                         (dissoc :op)
-                         (dissoc :fence))
-                     r))

 (defn render-reqs-html [reqs]
    (apply str


Reuse authenticate op.

Reuse authenticate op.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -38,8 +38,6 @@

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

-; TODO: Split between logical schema and physical runtime objects.
-
 (defn coll-handler [actx coll-state m]
   [coll-state nil])

@@ -49,6 +47,8 @@
     {:rev rev
      :name name
      :coll-ch coll-ch}))
+
+; --------------------------------------------

 (defn make-initial-server-state [actx]
   (let [c (make-coll actx 0 "default")]
@@ -139,13 +139,6 @@
         [server-state (assoc m :status :invalid :status-info :bad-key)])
       [server-state (assoc m :status :invalid :status-info :auth)])

-    :coll-get
-    [server-state (assoc m :status :ok
-                         :value (get-in server-state
-                                        [:realms (:cur-realm m)
-                                         :collsets (:cur-realm-collset m)
-                                         :colls (:cur-realm-collset-coll m)]))]
-
     [server-state (assoc m :status :invalid :status-info :invalid-op)]))

 ; --------------------------------------------
@@ -178,16 +171,24 @@
   {:cur-realm "_lobby"
    :cur-realm-collset "default"
    :cur-realm-collset-coll "default"
+   :cur-coll nil ; Either nil or result of make-coll.
    :cur-user-realm "_lobby"
    :cur-user "_anon"})

 (defn lane-state-loop [actx server-state-ch]
   (let [req-ch (achan actx)]
     (act lane-state-loop-init actx
-         (let [coll (areq lane-state-loop-init server-state-ch
-                          (assoc initial-lane-state :op :coll-get))]
+         (let [ils initial-lane-state
+               res (areq lane-state-loop-init server-state-ch
+                         {:op :authenticate
+                          :user-realm (:cur-user-realm ils)
+                          :user (:cur-user ils)
+                          :pswd ""
+                          :realm (:cur-realm ils)
+                          :realm-collset (:cur-realm-collset ils)
+                          :realm-collset-coll (:cur-realm-collset-coll ils)})]
            (state-loop actx :lane-state lane-handler
-                       (assoc initial-lane-state :cur-coll (:value coll))
+                       (assoc initial-lane-state :cur-coll (:coll res))
                        :req-ch req-ch)))
     req-ch))


refactor get-groups-for-user to use pull pattern

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -409,19 +409,15 @@
       db->group))

 (defn get-groups-for-user [user-id]
-  ; XXX: duplicating group-pull-pattern here, because interpolating variables
-  ; into datomic :find queries doesn't work well
-  (->> (d/q '[:find (pull ?g [:group/id
-                              :group/name
-                              {:extension/_group
-                               [:extension/id :extension/type]}])
+  (->> (d/q '[:find [?g ...]
               :in $ ?user-id
               :where
               [?u :user/id ?user-id]
               [?g :group/user ?u]]
             (d/db *conn*)
             user-id)
-       (map (comp #(dissoc % :users) db->group first))
+       (d/pull-many (d/db *conn*) group-pull-pattern)
+       (map (comp #(dissoc % :users) db->group))
        set))

 (defn get-users-in-group [group-id]


wait for txs to finish

wait for txs to finish

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -647,14 +647,14 @@

 (defn save-extension-token!
   [extension-id {:keys [access-token refresh-token]}]
-  (d/transact *conn* [[:db/add [:extension/id extension-id]
-                       :extension/token access-token]
-                      [:db/add [:extension/id extension-id]
-                       :extension/refresh-token refresh-token]]))
+  @(d/transact *conn* [[:db/add [:extension/id extension-id]
+                        :extension/token access-token]
+                       [:db/add [:extension/id extension-id]
+                        :extension/refresh-token refresh-token]]))

 (defn update-extension-config
   [extension-id config]
-  (d/transact *conn* [[:db/add [:extension/id extension-id]
+  @(d/transact *conn* [[:db/add [:extension/id extension-id]
                        :extension/config (pr-str config)]]))

 (defn group-extensions


upd telegram message

upd telegram message

--- src/ci3/agent/core.clj
+++ src/ci3/agent/core.clj
@@ -100,9 +100,9 @@
 (def base-url (or (environ/env :ci3-config-base-url) "http://cleo-ci.health-samurai.io/"))

 (defn notify [st build & text]
-  (telegram/notify (str st " build " (get-in build [:repository]) "/n"
+  (telegram/notify (str st " build " (get-in build [:repository]) "\n"
                         (get-in build [:commit :message]) " \n"
-                        "by " (or (get-in build [:author :raw]) (get-in build [:author :name])) " \n"
+                        "by " (or (get-in build [:commit :author :raw]) (get-in build [:commit :author :name])) " \n"
                         base-url "builds/" (get-in build [:metadata :name])
                         (when text (str " \n ```" (str/join text) "```") ))))

@@ -114,7 +114,6 @@

 (defn success [build]
   (println build)
-  (notify "Success" build)
   (when-not (:test build)
     (notify "Success" build))
   (update-status (assoc build :status "success")))


Added command line args

Added command line args

--- src/clj/asols/core.clj
+++ src/clj/asols/core.clj
@@ -5,8 +5,8 @@

 (defn -main
   [& args]
-  (let [ip "localhost"
-        port 8000]
+  (let [ip (or (first args) "localhost")
+        port (Integer/parseInt (or (second args) "8000"))]
     (server/run :ip ip :port port)
     (prn "Server started")
     (browse-url (str "http://" ip ":" port))))


meow?

meow?

--- src/clj/flambo/api.clj
+++ src/clj/flambo/api.clj
@@ -49,7 +49,8 @@

 (defn parallelize
   ([spark-context lst] (.parallelize spark-context lst))
-  ([spark-context lst num-slices] (.parallelize spark-context lst num-slices)))
+  #([spark-context lst num-slices] (.parallelize spark-context lst num-slices))
+  )

 ;;; Transformations


invokelater -> invokeandwait

invokelater -> invokeandwait

--- src/clojure2d/core.clj
+++ src/clojure2d/core.clj
@@ -622,7 +622,7 @@
   "Repaint canvas on window with set FPS.

   * Input: frame, is-display-running? atom, function to run before repaint, canvas and sleep time."
-  [^Canvas panel is-display-running? draw-fun buffer stime]
+  [panel is-display-running? draw-fun buffer stime]
   (loop [cnt (long 0)
          result nil]
     (let [new-result (when draw-fun (draw-fun @buffer cnt result))]
@@ -655,7 +655,7 @@
          buffer (atom canvas)
          frame (JFrame.)
          panel (create-panel buffer wname width height)]
-     (SwingUtilities/invokeLater #(build-frame frame panel is-display-running? buffer wname width height))
+     (SwingUtilities/invokeAndWait #(build-frame frame panel is-display-running? buffer wname width height))
      (future (refresh-screen-task panel is-display-running? draw-fun buffer (/ 1000.0 fps)))
      [frame is-display-running? buffer
       {:frame frame


indenting

indenting

--- src/cloogling/core.clj
+++ src/cloogling/core.clj
@@ -7,5 +7,5 @@
   "Get results from json data retrieved from engine"
   [x]
   (map (fn [x] (->entry (x "Url" ) (x "Title") (x "Description"))) (-> x
-                                                     json/read-str
-                                                     (get-in ["d" "results"]))))
+                                                                       json/read-str
+                                                                       (get-in ["d" "results"]))))


Fixed nil-punning in compojure.html/html-tree

--- src/compojure/html.clj
+++ src/compojure/html.clj
@@ -115,7 +115,7 @@
     (let [[tag attrs & body] (ensure-attrs tree)
           [tag attrs]        (parse-css-tag tag attrs)
           body               (expand-seqs body)]
-      (if (or body (explicit-ending-tag? tag))
+      (if (or (seq body) (explicit-ending-tag? tag))
         (create-tag tag attrs (apply html body))
         (create-closed-tag tag attrs)))
     (str tree)))


Remove unnecessary method name futzing machinery now we explicitly specify all handler methods.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -12,18 +12,6 @@
   toupper (memfn toUpperCase))

 (defonce untitled-applet-id* (atom 0))
-
-(defn- fix-mname
-  "Changes :method-name to :methodName."
-  [[mname fun]]
-  (let [mname (name mname)
-        mr (re-matcher #"\-[a-zA-z]" mname)
-        replace-fn (comp #(.replaceFirst mr %) toupper #(.substring % 1))
-        fixed-name (if-let [matched (re-find mr)]
-                     (replace-fn matched)
-                     mname)]
-    [(keyword fixed-name) fun]))
-

 (defn applet-stop
   "Stop an applet"
@@ -162,15 +150,8 @@
   (let [options           (merge {:size [500 300]} (apply hash-map opts))
         size              (validate-size! (:size options))
         renderer          (or (:renderer options) :p2d)
-        fns               (dissoc options :title :size :key-pressed
-                                  :key-released :key-typed :mouse-pressed
-                                  :mouse-released :mouse-moved :mouse-dragged
-                                  :focus-gained :focus-lost :mouse-entered
-                                  :mouse-exited :mouse-clicked :setup :keep-on-top :renderer)
-        mode              (if (< 2 (count (:size options)))
-                            (nth (:size options) 2)
-                            :p2d)
-        fns               (merge {:draw (fn [] nil)} fns)
+        draw-fn           (or (:draw options) (fn [] nil))
+        setup-fn          (or (:setup options) (fn [] nil))
         key-pressed-fn    (or (:key-pressed options) (fn [] nil))
         key-released-fn   (or (:key-released options) (fn [] nil))
         key-typed-fn      (or (:key-typed options) (fn [] nil))
@@ -188,7 +169,6 @@
                               (apply applet-set-size size-vec))
                             (when-let [f (:setup options)]
                               (f)))
-        methods           (into {} (map fix-mname fns))
         frame             (atom nil)
         state             (atom nil)
         keep-on-top?      (atom (:keep-on-top options))
@@ -290,18 +270,13 @@
                             (setup
                               ([] (binding [*applet* this
                                             *state* state]
-                                    (setup-fn)))))
-
-        bound-meths       (reduce (fn [methods [method-name f]]
-                                    (assoc methods (name method-name)
-                                           (fn [this & args]
-                                             (binding [*applet* this
-                                                       *state* state]
-                                               (apply f args)))))
-                                  {}
-                                  methods)]
-    (update-proxy prx bound-meths)
-    (applet-run prx mode @keep-on-top?)
+                                    (setup-fn))))
+
+                            (draw
+                              [] (binding [*applet* this
+                                           *state* state]
+                                   (draw-fn))))]
+    (applet-run prx renderer @keep-on-top?)
     prx))

 (defmacro defapplet


Make tree parsing (parents in particular) more robust

Allow names like r/foo/bar/baz to have r/foo as a parent if there
are no intermediate CUSTARD nodes.

--- src/custard/parser.clj
+++ src/custard/parser.clj
@@ -77,49 +77,46 @@
                 (fn [children]
                   (mapv #(process-down % f ctx) children))))))

-(defn set-parent [node ctx]
-  (let [parent ctx]
-    {:node (assoc node :parent
-                  (or (:parent node)
-                      (when parent {:name (:name parent)})))
-     :ctx (if (custard-node? node) node parent)}))
+(declare parse-nodes)

-(declare parse-node)
+(defn parse-children [name-segments parent-name data]
+  (letfn [(parse-child [[name-segment data]]
+            (parse-nodes (conj name-segments name-segment)
+                         parent-name data))]
+    (->> data
+         (filter #(map? (second %)))
+         (map parse-child)
+         (apply concat)
+         (into []))))

-(defn parse-children [name-segments data]
-  (into []
-        (comp (filter #(map? (second %)))
-              (map (fn [[k v]]
-                     (parse-node (conj name-segments k) v))))
-        data))
-
-(defn parse-node [name-segments data]
+(defn parse-nodes [name-segments parent-name data]
   {:pre [(map? data)]}
   (let [kind (parse-kind data)
-        parser (kind-parsers kind)
-        basic {:name (str/join "/" name-segments)
-               :children (parse-children name-segments data)}]
+        parser (kind-parsers kind)]
     (if (and kind parser)
-      (merge basic
-             {:kind kind}
-             (parse-common data)
-             (parser data))
-      basic)))
+      (let [name (str/join "/" name-segments)
+            basic {:name name
+                   :parent parent-name
+                   :children (parse-children name-segments name data)}]
+        [(merge basic
+                 {:kind kind}
+                 (parse-common data)
+                 (parser data))])
+      (parse-children name-segments parent-name data))))

 (defn parse-tree [data]
   (letfn [(parse-step [root [name-segment data]]
-            (let [node (parse-node [name-segment] data)]
-              (update root :children conj node)))]
-    (let [root {:name [] :children ()}
+            (let [nodes (parse-nodes [name-segment] nil data)]
+              (update root :children concat nodes)))]
+    (let [root {:name nil :children []}
           tree (reduce parse-step root data)]
-      (-> tree
-          (process-down set-parent nil)))))
+      tree)))

 (defn flatten-tree [node]
   (letfn [(collect-step [m node]
             (merge m (flatten-tree node)))]
     (reduce collect-step
-            (if (custard-node? node)
+            (if-not (nil? (:name node))
               {(:name node) node}
               {})
             (:children node))))
@@ -131,8 +128,8 @@
             {:name (:name node)})
           (parse-node [graph node]
             (let [ident (node->ident node)
-                  linked-node (update node :children
-                                           #(mapv node->link %))]
+                  child-links (mapv node->link (:children node))
+                  linked-node (assoc node :children child-links)]
               (-> graph
                   (update :nodes conj ident)
                   (assoc-in ident linked-node))))


Anagram test: case-insensitivity must go both ways

Previously it was enough to normalize just the subject.

This also adds the missing case-insensitivity test to some languages.

--- assignments/clojure/anagram/anagram_test.clj
+++ assignments/clojure/anagram/anagram_test.clj
@@ -20,4 +20,8 @@
   (is (= ["gallery" "regally" "largely"]
          (anagram/anagrams-for "allergy" ["gallery" "ballerina" "regally" "clergy" "largely" "leading"]))))

+(deftest case-insensitive-anagrams
+  (is (= ["Carthorse"]
+         (anagram/anagrams-for "Orchestra" ["cashregister" "Carthorse" "radishes"]))))
+
 (run-tests)


Scroll pages to top on navigation

Scroll pages to top on navigation

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -135,7 +135,11 @@
        (set-canonical! (:_canonical args))
        (analytics/register-last-touch-utm query-params)
        (when-let [join (:join query-params)] (analytics/track-join-code join))
-       (analytics/track-view-page (if inner? :inner :outer))))))
+       (analytics/track-view-page (if inner? :inner :outer))
+       (when-let [app-dominant (goog.dom.getElementByClass "app-dominant")]
+         (set! (.-scrollTop app-dominant) 0))
+       (when-let [main-body (goog.dom.getElementByClass "main-body")]
+         (set! (.-scrollTop main-body) 0))))))

 (defn api-handler
   [value state container]


Do not expose unneeded data

Do not expose unneeded data

--- src-cljs/frontend/send.cljs
+++ src-cljs/frontend/send.cljs
@@ -320,7 +320,6 @@
      (:job/name env))

    #{:job/build
-     :job/required-job-ids
      :job/required-jobs}
    (fn [{:keys [run/id job/name] :as env} ast]
      ;; Unlike most of the api functions, api/get-org-settings takes the channel


Removed unnecessary comment from client side code

--- src-cljs/tea_time/core.cljs
+++ src-cljs/tea_time/core.cljs
@@ -47,10 +47,7 @@
 (defn home-page []
   [:div.container
    [:div.jumbotron
-    [:h1 "Welcome to Tea Time"]
-    ;; [:p "Time to start building your site!"]
-    ;; [:p [:a.btn.btn-primary.btn-lg {:href "http://luminusweb.net"} "Learn more »"]]
-    ]
+    [:h1 "Welcome to Tea Time"]]
    [:div.row
     [:div.col-md-12
      [:h2 "Welcome to Tea Time"]]]


Force the walk to avoid confusion when loading multiple times

--- src/demo/messaging.clj
+++ src/demo/messaging.clj
@@ -13,7 +13,7 @@
 ;;; consume them
 (let [messages (msg/message-seq q)]
   (if (= 42 (msg/receive q))
-    (take 2 messages)))
+    (doall (take 2 messages))))

 ;;; filter them
 (def results (atom []))


Add simple example org.clojure/google-closure-library-third-party exclusion

--- examples/simple/project.clj
+++ examples/simple/project.clj
@@ -3,7 +3,8 @@
   :dependencies [[org.clojure/clojure       "1.10.1"]
                  [org.clojure/clojurescript "1.10.520"
                   :exclusions [com.google.javascript/closure-compiler-unshaded
-                               org.clojure/google-closure-library]]
+                               org.clojure/google-closure-library
+                               org.clojure/google-closure-library-third-party]]
                  [thheller/shadow-cljs      "2.8.69"]
                  [reagent                   "0.9.0-rc2"]
                  [re-frame                  "0.11.0-rc2"]]