no longer using map time to store timestamps

This increases by a huge factor the write latency (a write requires a
read). We've numbers varying from 100ms to 800ms. Yet worse, there was
no real gain using collections here.

--- src/blackbox/src/leela/blackbox/storage/cassandra.clj
+++ src/blackbox/src/leela/blackbox/storage/cassandra.clj
@@ -28,12 +28,11 @@
 (defn decode-time [time-in-sec]
   (let [time (from-long (* 1000 time-in-sec))
         bucket (quot (to-long (date-time (year time) (month time) (day time))) 1000)
-        hitime (quot (- time-in-sec bucket) 3600)
-        lotime (rem (- time-in-sec bucket) 3600)]
-    [bucket hitime lotime]))
-
-(defn encode-time [bucket hitime lotime]
-  (+ bucket (* 3600 hitime) lotime))
+        slot (- time-in-sec bucket)]
+    [bucket slot]))
+
+(defn encode-time [bucket slot]
+  (+ bucket slot))

 (defn check-schema [cluster keyspace]
   (when-not (describe-keyspace cluster keyspace)
@@ -71,7 +70,7 @@
     (create-table
      cluster :t_attr
      (if-not-exists)
-     (column-definitions {:key :uuid :name :varchar :bucket :bigint :hitime :int :data (map-type :int :blob) :primary-key [[:key :name :bucket] :hitime]})
+     (column-definitions {:key :uuid :name :varchar :bucket :bigint :slot :int :data :blob :primary-key [[:key :name :bucket] :slot]})
      (with {:compaction {:class "LeveledCompactionStrategy" :sstable_size_in_mb "128"}})))
   (when-not (describe-table cluster keyspace :k_attr)
     (warn "creating table k_attr")
@@ -162,27 +161,25 @@

 (defn fmt-put-tattr [[data opts0]]
   (let [opts (flatten (seq (dissoc opts0 :index)))
-        [bucket hitime lotime] (decode-time (:time data))
+        [bucket slot] (decode-time (:time data))
         idx (if (:index opts0)
               [(fmt-put-index-opts :t_index
                                    {:key (:key data)
                                     :name (:name data)} opts)]
               [])]
     (if (empty? opts)
-      (cons (update-query :t_attr
-                          {:data [+ {lotime (:value data)}]}
-                          (where
+      (cons (insert-query :t_attr
+                          {:data (:value data)
                            :key (:key data)
                            :name (:name data)
                            :bucket bucket
-                           :hitime hitime)) idx)
-      (cons (update-query :t_attr
-                          {:data [+ {lotime (:value data)}]}
-                          (where
+                           :slot slot}) idx)
+      (cons (insert-query :t_attr
+                          {:data (:value data)
                            :key (:key data)
                            :name (:name data)
                            :bucket bucket
-                           :hitime hitime)
+                           :slot slot}
                            (apply using opts)) idx))))

 (defn fmt-del-kattr [data]
@@ -192,14 +189,13 @@

 (defn fmt-del-tattr [data]
   (if (contains? data :time)
-    (let [[bucket hitime lotime] (decode-time (:time data))]
+    (let [[bucket slot] (decode-time (:time data))]
       [(delete-query
         :t_attr
-        (columns {:data lotime})
         (where :key (:key data)
                :name (:name data)
                :bucket bucket
-               :hitime hitime))])
+               :slot slot))])
     (fmt-del-index :t_index {:key (:key data)
                              :name (:name data)})))

@@ -291,17 +287,14 @@
     (client/execute cluster (client/render-query query))))

 (defn get-tattr [cluster k name time]
-  (let [[bucket hitime] (take 2 (decode-time time))]
-    (mapcat
+  (let [[bucket slot] (decode-time time)]
+    (map
      (fn [row]
-       (map
-        (fn [[lotime value]]
-          [(encode-time bucket (:hitime row) lotime) (f/binary-to-bytes value)])
-        (:data row)))
+       [(encode-time bucket (:slot row)) (f/binary-to-bytes (:data row))])
      (select cluster
              :t_attr
-             (columns :hitime :data)
-             (where :key k :name name :bucket bucket :hitime [:>= hitime])))))
+             (columns :slot :data)
+             (where :key k :name name :bucket bucket :slot [:>= slot])))))

 (defn del-tattr [cluster attrs]
   (let [query (->> attrs


Fix batches

Fix batches

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -313,7 +313,7 @@
   ([table-name keyspace]
    (QueryBuilder/truncate (name keyspace) (name table-name))))

-(defmacro queries
+(defn queries
   [& statements]
   [:queries statements])

@@ -336,8 +336,7 @@
          (sort-by #(get order (first %)))
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
-                 batch-type)
-         ))
+                 batch-type)))

   (defn batch
     [& statements]


Bring batch a step further

Bring batch a step further

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -411,14 +411,26 @@
   ([table-name keyspace]
      (.toString (QueryBuilder/truncate (name keyspace) (name table-name)))))

-(defmacro batch
-  [statements]
-  `(binding [*batch* true]
-     (let [builder# (QueryBuilder/batch (into-array ~statements))]
-       (.toString builder#)
-       )
-    )
-  )
+(defmacro queries
+  [& statements]
+  [:queries `(binding [*batch* true]
+               ~(vec statements))])
+
+(let [order
+      {:queries 1}
+      renderers
+      {:queries (fn queries-renderer [query-builder queries]
+                  (QueryBuilder/batch (into-array queries))
+)}]
+  (defn batch
+    [& statements]
+    (->> statements
+         (sort-by #(get order (first %)))
+         (reduce (fn [builder [statement-name statement-args]]
+                   ((get renderers statement-name) builder statement-args))
+                 nil)
+         (maybe-stringify))))
+
 ;; Batch batch(RegularStatement... statements)
 ;; Batch unloggedBatch(RegularStatement... statements)
 ;; Truncate truncate(String table)


Updates for December 2019

Updates for December 2019

--- scrape-n-mail/src/scrape_n_mail/core.cljs
+++ scrape-n-mail/src/scrape_n_mail/core.cljs
@@ -191,7 +191,7 @@
       [:br]
       [:p "Dear " (::submitter-name (first name-records)) ","]

-      [:p "Our general call for names for Wellbeing for November 2019 has gone out to the newDharma mailing list."]
+      [:p "Our general call for names for Wellbeing for December 2019 has gone out to the newDharma mailing list."]

       [:p "Currently, the community is holding the following names on the altar "
           "in support of their wellbeing at your request. Click "
@@ -215,7 +215,8 @@
                [:a {:href payment-link} "the link."]]]

       [:p "If we do not hear from you, we will remove the above names from the altar "
-          "unless you've checked the \"Renew until further notice?\" box on the form. "
+          "unless you had checked the \"Renew until further notice?\" box on the form. "
+          "But please renew them if you can so that we can transition away from this \"indefinite\" approach. "
           "J'ai mitra!"]

       ; Note that the \ is an escape character!


CMR-1980: Address review comments

CMR-1980: Address review comments

--- search-app/src/cmr/search/api/keyword.clj
+++ search-app/src/cmr/search/api/keyword.clj
@@ -43,14 +43,12 @@
 (defn- translate-keyword-scheme-to-gcmd
   "Translates a keyword scheme into a known keyword scheme for GCMD."
   [keyword-scheme]
-  (or (keyword-scheme cmr-to-gcmd-keyword-scheme-aliases)
-      keyword-scheme))
+  (get cmr-to-gcmd-keyword-scheme-aliases keyword-scheme keyword-scheme))

 (defn- translate-keyword-scheme-to-cmr
   "Translates a keyword scheme into a known keyword scheme for CMR."
   [keyword-scheme]
-  (or (keyword-scheme (set/map-invert cmr-to-gcmd-keyword-scheme-aliases))
-      keyword-scheme))
+  (get (set/map-invert cmr-to-gcmd-keyword-scheme-aliases) keyword-scheme keyword-scheme))

 (defn- validate-keyword-scheme
   "Throws a service error if the provided keyword-scheme is invalid."


formatting

formatting

--- libs/storm/test/storm/core_test.clj
+++ libs/storm/test/storm/core_test.clj
@@ -144,16 +144,18 @@
  (st/with-local-cluster [cluster]
    (let [config {:link-bolt {:include []}
                  :modules ['storm.core-test/mock-db-module]}
-         topology (s/topology {"l0" (s/spout-spec (fact-spout "mocked..." config))
-                               "f1" (s/spout-spec (fact-spout "mocked..." config))}
-                              {"l1" (s/bolt-spec {"l0" ["key"]
-                                                  "f1" ["key"]} (link-bolt 'storm.core-test/timeline 1 config))})
-         result (st/complete-topology cluster topology
-                                      :mock-sources
-                                      {"l0" [[:rule "storm.core-test/timeline!0" "bob" ["alice" "bob"]
-                                              1000 1 #{"storm.core-test"} #{}]]
-                                       "f1" [[:fact "test/tweeted" "foo" ["hello, world"]
-                                              1001 1 #{} #{}]]})]
+         topology (s/topology
+                   {"l0" (s/spout-spec (fact-spout "mocked..." config))
+                    "f1" (s/spout-spec (fact-spout "mocked..." config))}
+                   {"l1" (s/bolt-spec {"l0" ["key"]
+                                       "f1" ["key"]} (link-bolt 'storm.core-test/timeline 1 config))})
+         result (st/complete-topology
+                 cluster topology
+                 :mock-sources
+                 {"l0" [[:rule "storm.core-test/timeline!0" "bob" ["alice" "bob"]
+                         1000 1 #{"storm.core-test"} #{}]]
+                  "f1" [[:fact "test/tweeted" "foo" ["hello, world"]
+                         1001 1 #{} #{}]]})]
      (->> (st/read-tuples result "l1")
           (map (fn [[kind name user [tweet] ts change writers readers]]
                  [user tweet ts]))


Qualified != to l/!=

Qualified != to l/!=

--- EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
@@ -233,7 +233,7 @@
   (l/fresh [?pointcut ?advice1 ?advice2]
     (aspect-declaredsuperaspect+ ?aspect1 ?superaspect)
     (aspect-declaredsuperaspect+ ?aspect2 ?superaspect)
-    (!= ?aspect1 ?aspect2)
+    (l/!= ?aspect1 ?aspect2)
     (aspect-pointcutdefinition ?superaspect ?pointcut)
     (aspect-advice ?aspect1 ?advice1)
     (aspect-advice ?aspect2 ?advice2)


TODO done.

TODO done.

--- src/isla/lexer.clj
+++ src/isla/lexer.clj
@@ -25,5 +25,3 @@
     (if (not= :nl (last tokens))
       (conj tokens :nl)
       tokens)))
-
-;; get rid of multiple newlines


make the env-default function private since environment variables & configuration details shouldn't be read outside this namespace #6


Throw better error when an index's meta is empty


Commented out compressibility meta case for now

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -36,7 +36,7 @@
                         (cond
                           (fn? cat) (cat ind)
                           (= cat :size) (count (:genome ind))
-                          (= cat :compressibility) 555 ;;TMH fix later
+;                          (= cat :compressibility) 555 ;;TMH fix later
                           (= cat :total-error) (:total-error ind)
                           (= cat :unsolved-cases) (count (filter #(> % error-threshold) (:errors ind)))
                           :else (throw (Exception. (str "Unrecognized meta category: " cat)))))]


Formatting

Formatting

--- src/braid/core/client/ui/views/new_message_action_button.cljs
+++ src/braid/core/client/ui/views/new_message_action_button.cljs
@@ -9,12 +9,12 @@
   (hooks/register! (atom []) [HeaderItem]))

 (defn new-message-action-button-view
-  [{:keys [thread-id group-id] :as config}]
+  [{:keys [thread-id group-id]}]
   [:div.plus
    (let [popup-view (fn [] [hover-menu-view
-                           {:thread-id thread-id
-                            :group-id group-id}
-                           @menu-items :top])]
+                            {:thread-id thread-id
+                             :group-id group-id}
+                            @menu-items :top])]
      {:on-mouse-enter
       (popovers/on-mouse-enter popup-view)
       :on-touch-start


Remove cruft from initial app

Remove cruft from initial app

--- src/dato/lib/server.clj
+++ src/dato/lib/server.clj
@@ -149,11 +149,10 @@
                            @(:server dato-config)
                            (:server dato-config))
         user-db-ids      (mapv :db/id (dsu/qes-by (ddb server) :user/email))
-        full-session     {:live            {:ch   ch
-                                            :dato dato-config}
-                          :id              id
-                          :session/key     id
-                          :session/user-id (rand-nth user-db-ids)}
+        full-session     {:live        {:ch   ch
+                                        :dato dato-config}
+                          :id          id
+                          :session/key id}
         others-data      (cdc/encode (ss-msg :server/session-created {:session (dissoc full-session :live)}) :transit)
         full-session-enc (cdc/encode (dissoc full-session :live) :transit)]
     ;; Put new channel in global storage


Spelling fixes

Spelling fixes

--- src-cljs/frontend/components/pricing_b.cljs
+++ src-cljs/frontend/components/pricing_b.cljs
@@ -143,7 +143,7 @@
                    If you don't have enough free containers available, then your builds queue up until other builds finish."]
               [:p "Everyone gets their first container free and your team can run as many builds as you want with that container.
                    More containers allows faster builds through parallellism in addition shorter queue times"]
-              [:p "Parallelism is an extrememly powerful feature and allows to dramitcally speed up your test suite.
+              [:p "Parallelism is an extremely powerful feature and allows you to dramatically speed up your test suite.
                    CircleCI automatically splits your tests across multiple containers, finishing your build in a fraction of the time."]]
              [:article
               [:h3 "How many containers do I need?"]


don't let cancel-drawing create a nil :drawing map

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -89,7 +89,7 @@

 (defn cancel-drawing [state]
   (-> state
-    (assoc :drawing nil)
+    (assoc :drawing {:layers []})
     (assoc-in [:mouse-down] false)))

 (defmethod control-event :cancel-drawing


Fix mui example buttons

Fix mui example buttons

--- examples/material-ui/src/example/core.cljs
+++ examples/material-ui/src/example/core.cljs
@@ -55,11 +55,13 @@
     [:strong @text-state]]

    [:button
-    {:on-click #(swap! text-state str " foo")}
+    {:type "button"
+     :on-click #(swap! text-state str " foo")}
     "update value property"]

    [:button
-    {:on-click #(reset! text-state "")}
+    {:type "button"
+     :on-click #(reset! text-state "")}
     "reset"]

    [text-field


add tests for autocompletion using syis1 transgene


Work-in-progress with lots of debugging.

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -21,7 +21,7 @@
             [environ.core :refer [env]]
             [camel-snake-kebab.core :as translate]
             [instaparse.core :as insta]
-            [pamela.utils :refer [stdout? output-file]]
+            [pamela.utils :refer [stdout? output-file display-name-string]]
             [pamela.parser :as parser]
             [pamela.tpn :as tpn]))

@@ -42,10 +42,13 @@

 ;; vars -------------------------------------------------------

-(def ^{:dynamic true} *debug-ir* (atom {}))
+(def ^:dynamic *debug-ir* (atom {}))
+
+;; HTN Methods
+;; HTN Methods have a 1:1 correspondence with the :methods defined by the Pamela source code

 ;; {pclass-name {method-name method}}
-(def ^{:dynamic true} *htn-methods* (atom {}))
+(def ^:dynamic *htn-methods* (atom {}))

 (defn reinitialize-htn-method-table []
   (reset! *htn-methods* {}))
@@ -62,26 +65,25 @@
       (throw (AssertionError. (str "method not found: " name " in pclass " pclass))))
     method))

+;; HTN Objects
+;; HTN Objects are all of the UID-identified objects in our HTN world

 ;; {uid htn-object}
-(def ^{:dynamic true} *htn-objects* (atom {}))
-
-(defn reinitialize-htn-object-table []
-  (reset! *htn-objects* {}))
-
-(defn get-htn-object [uid-or-object]
-  (let [uid (if (keyword? uid-or-object)
-              uid-or-object
-              (:uid uid-or-object))]
-    (get @*htn-objects* uid)))
-
-(defn update-htn-object! [object]
-  (let [uid (:uid object)]
-    (swap! *htn-objects* assoc uid object)
-    object))
+(def ^:dynamic *htn-objects* (atom {}))
+
+(defn reinitialize-htn-object-table [] (reset! *htn-objects* {}))
+
+(defn get-htn-object [uid-or-object] (let [uid (if (keyword? uid-or-object) uid-or-object (:uid
+  uid-or-object))] (get @*htn-objects* uid)))
+
+(defn update-htn-object! [object] (let [uid (:uid object)] (swap! *htn-objects* assoc uid object)
+  object))
+
+;; HTN Plan Map contains the expanded HTN structure, based on expansion of a root task and a library
+;; of HTN methods

 ;; {uid htn-object} where htn-object has keys trimmed
-(def ^{:dynamic true} *htn-plan-map* (atom {}))
+(def ^:dynamic *htn-plan-map* (atom {}))

 (defn reinitialize-htn-plan-map []
   (reset! *htn-plan-map* {}))
@@ -97,7 +99,7 @@
     (swap! *htn-plan-map* assoc uid object)
     object))

-(def ^{:dynamic true} *htn-plan-ancestry*
+(def ^:dynamic *htn-plan-ancestry*
   "Used to keep track of the parents of the current node.  A list, with oldest at the end"
   '())

@@ -147,11 +149,12 @@

 ;; name-with-args multi-methods --------------------------------------

-;; FUTURE: add pclass to name-with-args
+;; FUTURE: (optionally) add pclass to name-with-args
 (def name-with-args-max-line-length
   "The (preferred) maximimum line length for Task/Method Names including arguments"
   25)

+;; TODO: This will be OBE, once Planviz can dynamically hide/show the args, based on user setting.
 (def name-with-args-include-args?
   "Whether to include argument lists when displaying names of Tasks and Methods"
   true)
@@ -256,13 +259,20 @@
                            task-type irks henpt ancestry-path]
   (let [hem (get-htn-object (first ancestry-path))
         ;; DEBUG
-        ;; _ (println "  RPC0" plant-class "METHOD" method
-        ;;    "RPCHEM" (dissoc hem :subtasks :ancestry-path
-        ;;               :expansion-method :subtask-constraints))
-        ;; _ (if-not (htn-isa? task-type :htn-nonprimitive-task)
-        ;;     (println "  RPC HENPT" (dissoc henpt :subtasks :ancestry-path
-        ;;                              :expansion-method :subtask-constraints
-        ;;                              :task-expansions)))
+        _ (println "  RPC0" plant-class "METHOD" method
+           "\nRPCHEM" (dissoc hem :subtasks :ancestry-path
+                              :expansion-method :subtask-constraints)
+           "\nhem-pclass" hem-pclass
+           "pargs" pargs
+           "plant-class" plant-class
+           "task-type" task-type
+           "(:pclass henpt)" (:pclass henpt)
+           ;;"ancestry-path" ancestry-path
+           )
+        _ (if-not (htn-isa? task-type :htn-nonprimitive-task)
+            (println "  RPC HENPT" (dissoc henpt :subtasks :ancestry-path
+                                     :expansion-method :subtask-constraints
+                                     :task-expansions)))
         plant-class (if hem ;; avoid pathological case
                       (cond
                         (= plant-class ::unknown) ;; matching method in pargs?
@@ -274,10 +284,10 @@
                               pc (first (filter #(= (:param %) param) pargs))
                               plant (:pclass pc)
                               plant-method (get-in ir [plant :methods method])]
-                          ;; (println "UNKNOWN PARAM" param ;; DEBUG
-                          ;;   "PLANT" plant
-                          ;;   "PLANT-METHOD" plant-method
-                          ;;   "PC" pc)
+                          (println "UNKNOWN PARAM" param ;; DEBUG
+                            "PLANT" plant
+                            "PLANT-METHOD" plant-method
+                            "PC" pc)
                           (if (and plant-method pc)
                             pc ;; plant parameter
                             param)) ;; must be a method parameter
@@ -299,26 +309,26 @@
                         (:pclass henpt)
                         :else
                         plant-class))
-        ;; _ (println "  RPC1" plant-class) ;; DEBUG
         {:keys [argument-mappings]} hem
+         _ (println "  RPC1" plant-class "argument-mappings" argument-mappings) ;; DEBUG
         resolve-pc (fn [arg]
                      (if (and (variable? arg) (not (empty? argument-mappings)))
                        (get argument-mappings arg)
                        arg))
         p (resolve-pc plant-class)
-        ;; _ (println "  RPC2" p) ;; DEBUG
+        _ (println "  RPC2" p) ;; DEBUG
         p (if (variable? p)
             (resolve-plant-class ir hem-pclass pargs p method task-type
               irks nil (nthrest ancestry-path 2))
             p)
-        ;; _ (println "  RPC3" p) ;; DEBUG
+        _ (println "  RPC3" p) ;; DEBUG
         ;; if method is not primitive in p then return nil to
         ;; indicate this is NOT actually a primitive method
         p (if (and (map? p)
                 (= (:type p) :pclass-ctor)
                 (get-in ir [(:pclass p) :methods method :primitive]))
             p)]
-    ;; (println "RPC" plant-class "=>" p) ;; DEBUG
+    (println "RPC" plant-class "=>" p) ;; DEBUG
     p))

 (defmethod name-with-argvals :htn-task
@@ -364,6 +374,7 @@
   [object]
   (name-with-args object))

+;; Resources are a domain-specific legacy attribute.  TODO: We may want to generalize this.
 ;; children-have-resources? multi-methods --------------------------------------

 (defmulti children-have-resources?
@@ -418,27 +429,25 @@

 (defn pprint-htn-methods []
   (let [htn-methods @*htn-methods*
-        pcs (sort (keys htn-methods))]
+        pclasses (sort (keys htn-methods))]
     (println "PPRINT-HTN-METHODS")
-    (loop [pc (first pcs) more (rest pcs)]
-      (when pc
-        (println "PCLASS" pc "METHODS" (sort (keys (get htn-methods pc))))
-        (recur (first more) (rest more))))))
+    (doseq [pclass pclasses]
+      (println "PCLASS" pclass "METHODS" (sort (keys (get htn-methods pclass)))))))

 ;; returns a sequence of [k v] pairs containing
 ;; methods which match name in pclass
 ;; or, if empty, matches in all other pclasses
 (defn find-candidate-methods [ir pclass name]
   (let [htn-methods @*htn-methods*
-        pcs (keys htn-methods)
-        all (set (keys ir))
-        other-pcs (set/difference all (set pcs))]
+        pclasses (keys htn-methods)
+        all-pclasses (set (keys ir))
+        other-pclasses (set/difference all-pclasses (set pclasses))]
     ;; DEBUG
-    ;; (println "FCM PCLASS" pclass "NAME" name "PCS" pcs "OTHER-PCS" other-pcs)
+    ;; (println "FCM PCLASS" pclass "NAME" name "PCLASSES" pclasses "OTHER-PCLASSES" other-pclasses)
     (loop [in-pclass [] ;; methods inside pclass
            out-pclass [] ;; methods outside of pclass
-           pc (first pcs)
-           more (rest pcs)]
+           pc (first pclasses)
+           more (rest pclasses)]
       (if-not pc
         (sort-by first ;; return the methods sorted by method name
           (if-not (empty? in-pclass)
@@ -516,7 +525,8 @@
       (throw
         (AssertionError.
           (str "cannot create arg-mappings with static-task-args: "
-            static-task-args " and dynamic-task-args: " dynamic-task-args))))
+               static-task-args " and dynamic-task-args: " dynamic-task-args))))
+    ;; (println (:name task) static-task-args dynamic-task-args (map type dynamic-task-args))
     (zipmap static-task-args dynamic-task-args)))

 (declare htn-primitive-task)
@@ -524,16 +534,16 @@
 (declare copy-temporal-constraints)
 (declare htn-expanded-method)

-;; NOTE assumes old-task is :htn-primitive-task or :htn-nonprimitive-task
+;; NOTE assumes original-task is :htn-primitive-task or :htn-nonprimitive-task
 (defn make-expanded-task
   "Make an expanded task"
-  [old-task & [argument-mapping]]
-  ;; (println "MET" old-task argument-mapping) ;; DEBUG
-  (let [task-type (:type old-task)
-        old-task (dissoc old-task :uid :label)
+  [original-task & [argument-mapping]]
+  ;; (println "MET" original-task argument-mapping) ;; DEBUG
+  (let [task-type (:type original-task)
+        skeleton-task (dissoc original-task :uid :label)
         task (if (= task-type :htn-primitive-task)
-               (htn-primitive-task old-task)
-               (htn-expanded-nonprimitive-task old-task))
+               (htn-primitive-task skeleton-task)
+               (htn-expanded-nonprimitive-task skeleton-task))
         {:keys [temporal-constraints arguments]} task
         new-arguments (if argument-mapping
                         (mapv #(get argument-mapping %) arguments)
@@ -541,7 +551,7 @@
     ;; (println "  MET TASK" task) ;; DEBUG
     (update-htn-object!
       (assoc-if task
-        :arguments arguments
+        :arguments new-arguments
         :temporal-constraints (and temporal-constraints
                                 (copy-temporal-constraints temporal-constraints))))))

@@ -740,9 +750,10 @@
   [{:keys [prefix uid ancestry-path pclass pargs name arguments cost task-type probability temporal-constraints
            mission-effectiveness priority resources network-flows
            flow-characteristics mission-task-weight
-           label incidence-set edges]
+           label display-name incidence-set edges]
     :or {prefix "task-"
          task-type :communications
+         display-name label
          temporal-constraints []}}]
   (let [network-flows (if (network-flow-types name)
                         (make-network-flows name flow-characteristics arguments)
@@ -765,6 +776,7 @@
         :flow-characteristics flow-characteristics
         :mission-task-weight mission-task-weight
         :label label
+        :display-name display-name
         :incidence-set incidence-set ;; NOTE should be a clojure set
         :edges edges))))

@@ -773,7 +785,7 @@
   [{:keys [prefix uid ancestry-path pclass pargs name arguments cost task-type probability temporal-constraints
            mission-effectiveness priority resources network-flows
            flow-characteristics mission-task-weight
-           label incidence-set edges irks]
+           label display-name incidence-set edges irks]
     :as options}]
   (update-htn-object!
     (assoc-if (htn-task (assoc options :prefix (or prefix "hpt-")))
@@ -785,7 +797,7 @@
   [{:keys [prefix uid ancestry-path pclass pargs name arguments cost task-type probability temporal-constraints
            mission-effectiveness priority resources network-flows
            flow-characteristics mission-task-weight
-           label incidence-set edges irks]
+           label display-name incidence-set edges irks]
     :as options}]
   (update-htn-object!
     (assoc-if (htn-task (assoc options :prefix (or prefix "hnpt-")))
@@ -797,14 +809,16 @@
   [{:keys [prefix uid ancestry-path pclass pargs name arguments cost task-type probability temporal-constraints
            mission-effectiveness priority resources network-flows
            flow-characteristics mission-task-weight task-expansions
-           label incidence-set edges irks]
+           label display-name incidence-set edges irks]
     :or {task-expansions []}
     :as options}]
   (let [task (assoc-if (htn-nonprimitive-task (assoc options :prefix (or prefix "henpt-")))
                :type :htn-expanded-nonprimitive-task
                :task-expansions task-expansions)
         label (if (empty? label) (name-with-args task) label)]
-    (update-htn-object! (assoc task :label label))))
+    (update-htn-object! (assoc task
+                               :display-name (if (empty? display-name) label display-name)
+                               :label label))))

 (defn htn-method
   "An HTN-method is used to decompose a nonprimitive-task into one or more subtasks"
@@ -813,6 +827,7 @@
            ancestry-path
            pclass
            name
+           display-name
            nonprimitive-task ;;This is the HTN-nonprimitive-task that this method matches on
            preconditions
            subtasks ;;This is a simple list of the tasks
@@ -830,6 +845,7 @@
                  :type :htn-method
                  :pclass pclass
                  :name name
+                 :display-name display-name
                  :nonprimitive-task nonprimitive-task
                  :preconditions preconditions
                  :subtasks (vec subtasks)
@@ -842,32 +858,37 @@
                  :network network
                  :irks irks)
         label (if (empty? label) (name-with-args method) label)
-        method (update-htn-object! (assoc method :label label))]
+        display-name (if (empty? display-name) label display-name)
+        method (update-htn-object! (assoc method
+                                          :display-name display-name
+                                          :label label))]
     (add-htn-method method)
     method))

 (defn htn-network
   "HTN network"
-  [{:keys [prefix uid ancestry-path label rootnodes parentid]
+  [{:keys [prefix uid ancestry-path label display-name rootnodes parentid]
     :or {prefix "net-"
          rootnodes []}}]
   (update-htn-object!
-    (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
-      :type :htn-network
-      :label label
-      :rootnodes rootnodes
-      :parentid parentid)))
+   (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
+             :type :htn-network
+             :display-name (if (empty? display-name) label display-name)
+             :label label
+             :rootnodes rootnodes
+             :parentid parentid)))

 (defn htn-edge
   "HTN edge"
-  [{:keys [prefix uid ancestry-path label end-node edge-type] ;; edge-type is usually only :choice (if not nil)
+  [{:keys [prefix uid ancestry-path label display-name end-node edge-type] ;; edge-type is usually only :choice (if not nil)
     :or {prefix "hedge-"}}]
   (update-htn-object!
-    (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
-      :type :edge
-      :label label
-      :end-node end-node
-      :edge-type edge-type)))
+   (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
+             :type :edge
+             :display-name display-name
+             :label label
+             :end-node end-node
+             :edge-type edge-type)))

 ;; There will be a 1:1 mapping between task-expansions and methods
 (defn htn-expanded-method
@@ -879,29 +900,34 @@
            argument-mappings
            subtasks
            subtask-constraints
-           label incidence-set network
+           label display-name
+           incidence-set network
            irks]
     :or {prefix "hem-"
+         display-name (:display-name expansion-method)
          subtasks []
          subtask-constraints []}}]
   (let [orig-method expansion-method
         orig-subtasks (:subtasks orig-method)
         new-subtasks subtasks ;; expanded henpt's
         subtask-constraints (map
-                              #(copy-constraint-into-expansion %
-                                 orig-method orig-subtasks new-subtasks)
-                              (:subtask-constraints orig-method))
+                             #(copy-constraint-into-expansion %
+                                                              orig-method orig-subtasks new-subtasks)
+                             (:subtask-constraints orig-method))
         hem   (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
-                :type :htn-expanded-method
-                :expansion-method expansion-method
-                :argument-mappings argument-mappings
-                :subtasks (vec subtasks)
-                :subtask-constraints (vec subtask-constraints)
-                :incidence-set incidence-set ;; NOTE should be a clojure set
-                :network network
-                :irks irks)
+                        :type :htn-expanded-method
+                        :expansion-method expansion-method
+                        :argument-mappings argument-mappings
+                        :subtasks (vec subtasks)
+                        :subtask-constraints (vec subtask-constraints)
+                        :incidence-set incidence-set ;; NOTE should be a clojure set
+                        :network network
+                        :irks irks)
         label (if (empty? label) (name-with-args hem) label)
-        hem   (update-htn-object! (assoc hem :label label))]
+        display-name (if (empty? display-name) label display-name)
+        hem   (update-htn-object! (assoc hem
+                                         :display-name display-name
+                                         :label label))]
     hem))

 ;; Expansion -------------------------------------------------
@@ -1152,23 +1178,40 @@
 (declare make-htn-methods)

 ;; walk ir, look for pclasses that have non-empty methods
+;; (defn transform-htn [ir]
+;;   (reset! *debug-ir* ir) ;;DEBUG
+;;   (let [ir-syms (seq ir)]
+;;     (loop [[k v] (first ir-syms) more (rest ir-syms)]
+;;       (if-not k
+;;         nil
+;;         (let [{:keys [type methods]} v]
+;;           ;; (println "TRANSFORM-HTN" k)
+;;           (when (and (= type :pclass) methods)
+;;             (let [method-syms (seq methods)]
+;;               (loop [[mname method] (first method-syms) moar (rest method-syms)]
+;;                 (if mname ;; else (println "no more methods")
+;;                   (let [{:keys [temporal-constraints args primitive body]} method]
+;;                     ;; (println "  METHOD" mname "PRIMITIVE" primitive)
+;;                     (if (and (not primitive) body)
+;;                       (make-htn-methods ir k mname args body))
+;;                     (recur (first moar) (rest moar)))))))
+;;           (recur (first more) (rest more)))))))
+
+;; walk ir, look for pclasses that have non-empty methods
 (defn transform-htn [ir]
-  (let [ir-syms (seq ir)]
-    (loop [[k v] (first ir-syms) more (rest ir-syms)]
-      (if-not k
-        nil
-        (let [{:keys [type methods]} v]
-          ;; (println "TRANSFORM-HTN" k)
-          (when (and (= type :pclass) methods)
-            (let [method-syms (seq methods)]
-              (loop [[mname method] (first method-syms) moar (rest method-syms)]
-                (if mname ;; else (println "no more methods")
-                  (let [{:keys [temporal-constraints args primitive body]} method]
-                    ;; (println "  METHOD" mname "PRIMITIVE" primitive)
-                    (if (and (not primitive) body)
-                      (make-htn-methods ir k mname args body))
-                    (recur (first moar) (rest moar)))))))
-          (recur (first more) (rest more)))))))
+  (reset! *debug-ir* ir) ;;DEBUG
+  (doseq [[pclass-name v] (seq ir)]
+    (assert pclass-name "Found a nil pclass in the IR")
+    (let [{:keys [type methods]} v]
+      ;; (println "TRANSFORM-HTN" pclass-name)
+      (when (= type :pclass) ;;Could it be anything else?
+        (doseq [[mname method] (seq methods)]
+          (if mname ;; else (println "no more methods")
+            (let [{:keys [temporal-constraints args primitive display-name body]} method]
+              ;; (println "  METHOD" mname "PRIMITIVE" primitive)
+              (if (and (not primitive) body)
+                (make-htn-methods ir pclass-name mname display-name args body))
+              )))))))

 ;; consider memoizing or caching result
 (defn find-plant-fn-bounds [ir plant-fn-pclass ctor-arg-i method]
@@ -1227,7 +1270,7 @@
 (defn plant-details [ir pargs subtask plant-class primitive?]
   (let [{:keys [type name arguments ancestry-path]} subtask
         name-str (str name)
-        display-name (translate/->camelCase name-str)
+        display-name (display-name-string name-str)
         details {:name name-str
                  :label (str "TEMP-" name-str) ;; TEMPORARY
                  :display-name display-name}]
@@ -1240,8 +1283,10 @@
             args (if (pos? unresolved)
                       (resolve-arguments arguments ancestry-path)
                       arguments)
+            _ (println "plant-class" plant-class)
+            _ (println "get-in" pclass name)
             formal-args (mapv str (get-in ir [pclass :methods name :args]))
-            ;; _ (println "PD ARGS" args "FORMAL-ARGS" formal-args) :: DEBUG
+            _ (println "PD ARGS" args "FORMAL-ARGS" formal-args) ;;:: DEBUG
             argsmap (zipmap formal-args args)]
         (assoc-if details
           :args args
@@ -1327,7 +1372,7 @@
                      (irks->bounds ir irks))
             m-task-expansions (count task-expansions)
             ;; DEBUG
-            ;; _ (println "ST#" i "of" n-subtasks "IRKS" irks)
+            _ (println "ST#" i "of" n-subtasks "IRKS" irks)
             ;; resolve pclass if (= type :htn-nonprimitive-task)
             ;; to determine if this was really an unresolved primitive task
             ;; DEBUG plant-class (if (htn-isa? type :htn-nonprimitive-task)
@@ -1349,6 +1394,7 @@
             ;;     "choice?" choice?
             ;;     "ST" (dissoc subtask :ancestry-path :task-expansions))
             ;; add in details for the plant for primitive tasks...
+            ;;_ (println "plant-details" pargs subtask plant-class primitive?) ;;DEBUG
             details (plant-details ir pargs subtask plant-class primitive?)
             ;; OLD: label (name-with-argvals subtask)
             subtask-map (merge
@@ -1498,6 +1544,7 @@
     ))

 (defn construct-htn-plan-map [ir expanded-root-task]
+  ;;(println expanded-root-task)
   (let [{:keys [uid label pargs]} expanded-root-task
         ;; _ (println "ERT PARGS" pargs) ;; DEBUG
         net (htn-network {:label label :rootnodes #{uid}})
@@ -1533,7 +1580,7 @@

 ;; will return subtasks, if any (and create htn-methods as a side effect)
 ;; irks are the ks to get-in the ir for the method in question (initially nil)
-(defn make-htn-methods [ir pclass mname margs body & [irks]]
+(defn make-htn-methods [ir pclass mname display-name margs body & [irks]]
   (let [irks (conj (or irks [pclass :methods mname]) :body)
         n (count body)]
     (loop [subtasks [] i 0]
@@ -1642,6 +1689,7 @@
                   (when make-htn-method?
                     (htn-method {:pclass pclass
                                  :name mname
+                                 :display-name display-name
                                  :nonprimitive-task nt
                                  :subtasks st
                                  :irks irks-i}))
@@ -1651,11 +1699,14 @@
                 (let [nonprimitive-task (htn-nonprimitive-task
                                           {:pclass pclass
                                            :name mname
+                                           :display-name display-name
                                            :arguments margs
                                            :temporal-constraints
                                            temporal-constraints
                                            :irks irks-i})
-                      subtasks (make-htn-methods ir pclass type nil body irks-i)
+                      subtasks (make-htn-methods ir pclass type
+                                                 (str type) ;;TODO: Not sure this will be necessary
+                                                 nil body irks-i)
                       subtask-constraints (if (= type :sequence)
                                             [(task-sequential-constraint
                                                {:tasks subtasks})]
@@ -1663,6 +1714,7 @@
                   ;; (println " MHM" type "SUBTASKS" subtasks)
                   ;; work here
                   (htn-method {:pclass pclass :name mname
+                               :display-name display-name
                                :nonprimitive-task nonprimitive-task
                                :subtasks subtasks
                                :subtask-constraints subtask-constraints
@@ -1677,6 +1729,7 @@
                 (let [nonprimitive-task (htn-nonprimitive-task
                                           {:pclass pclass
                                            :name mname
+                                           :display-name display-name
                                            :arguments margs
                                            :temporal-constraints
                                            temporal-constraints
@@ -1691,10 +1744,13 @@
                             cname (symbol (str mname "-choice-" j))
                             ;; _ (println "CHOICE CNAME" cname)
                             subtasks (make-htn-methods ir pclass
-                                       :choice nil body irks-j)
+                                                       :choice
+                                                       "Choice" ;;TODO: Not sure this is necessary
+                                                       nil body irks-j)
                             _ (if (not= type :choice)
                                 (log/error "HEY, I EXPECTED a :choice")) ;; FIXME
                             hem (htn-method {:pclass pclass :name cname
+                                             :display-name display-name
                                              :nonprimitive-task nonprimitive-task
                                              :subtasks subtasks
                                              :irks irks-j})]
@@ -1703,15 +1759,17 @@

                 (= type :delay)
                 (let [task (htn-primitive-task
-                             {:name 'delay
-                              :temporal-constraints temporal-constraints
-                              :irks irks-i})]
+                            {:name 'delay
+                             :display-name "Delay"
+                             :temporal-constraints temporal-constraints
+                             :irks irks-i})]
                   task)

                 :else
                 (let [msg (str "unhandled function type in HTN: " type)
                       task (htn-primitive-task
-                             {:name 'error
+                            {:name 'error
+                             :display-name "ERROR"
                               :arguments [msg]
                               :irks irks-i})]
                   (log/error msg)


Migrate to new cql api, comment unready parts to start testing

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -20,12 +20,6 @@
             [clojurewerkz.cassaforte.client :as cc])
   (:import com.datastax.driver.core.Session))

-(defn ^:private compile-query-
-  "Compiles query from given `builder` and `query-params`"
-  [builder query-params]
-  ;; TODO: mapcat identity here?
-  (apply builder (flatten query-params)))
-
 ;;
 ;; Schema operations
 ;;
@@ -35,7 +29,7 @@
    including all column families in it, and all data contained in those column families."
   [^Session session ks & query-params]
   (cc/execute session
-              (compile-query- new-query-api/drop-keyspace (cons ks query-params))))
+              (apply new-query-api/drop-keyspace ks query-params)))

 (defn create-keyspace
   "Creates a new top-level keyspace. A keyspace is a namespace that
@@ -48,9 +42,9 @@
                    (with {:replication
                           {:class \"SimpleStrategy\"
                            :replication_factor 1}}))"
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/create-keyspace-query query-params)))
+  [^Session session keyspace & query-params]
+  (cc/execute session
+              (apply new-query-api/create-keyspace (cons keyspace query-params))))

 (defn create-index
   "Creates a new (automatic) secondary index for a given (existing)
@@ -65,18 +59,18 @@
                     (if-not-exists))"
   [^Session session & query-params]
   (cc/execute session
-              (compile-query- q/create-index-query query-params )))
-
-(defn drop-index
-  "Drop an existing secondary index. The argument of the statement
-   is the index name.
-
-   Example, drops an index on `users` table, `city` column:
-
-       (drop-index th/session :users_city)"
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/drop-index-query query-params) ))
+              (apply new-query-api/create-index query-params)))
+
+;; (defn drop-index
+;;   "Drop an existing secondary index. The argument of the statement
+;;    is the index name.
+
+;;    Example, drops an index on `users` table, `city` column:
+
+;;        (drop-index th/session :users_city)"
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply new-query-api/drop-index query-params) ))

 (defn create-table
   "Creates a new table. A table is a set of rows (usually
@@ -94,7 +88,7 @@
                                      :primary-key [:name]}))"
   [^Session session & query-params]
   (cc/execute session
-              (compile-query- q/create-table-query query-params)))
+              (apply new-query-api/create-table query-params)))

 (def create-column-family create-table)

@@ -103,7 +97,7 @@
    all data in it."
   [^Session session ks]
   (cc/execute session
-              (q/drop-table-query ks)))
+              (new-query-api/drop-table ks)))

 (defn use-keyspace
   "Takes an existing keyspace name as argument and set it as the per-session current working keyspace.
@@ -111,21 +105,21 @@
    unless otherwise specified, until another USE statement is issued or the connection terminates."
   [^Session session ks]
   (cc/execute session
-              (q/use-keyspace-query ks)))
+              (new-query-api/use-keyspace ks)))

 (defn alter-table
   "Alters a table definition. Use it to add new
    columns, drop existing ones, change the type of existing columns, or update the table options."
   [^Session session & query-params]
   (cc/execute session
-              (compile-query- q/alter-table-query query-params)))
-
-(defn alter-keyspace
-  "Alters properties of an existing keyspace. The
-   supported properties are the same that for `create-keyspace`"
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/alter-keyspace-query query-params)))
+              (apply new-query-api/alter-table query-params)))
+
+;; (defn alter-keyspace
+;;   "Alters properties of an existing keyspace. The
+;;    supported properties are the same that for `create-keyspace`"
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/alter-keyspace-query query-params)))

 ;;
 ;; DB Operations
@@ -147,31 +141,31 @@
   (cc/async
    (apply insert session query-params)))

-(defn ^:private batch-query-from-
-  [table records]
-  (->> records
-       (map (comp (partial apply (partial q/insert-query table)) flatten vector))
-       (apply q/queries)))
-
-(defn insert-batch
-  "Performs a batch insert (inserts multiple records into a table at the same time).
-  To specify additional clauses for a record (such as where or using), wrap that record
-  and the clauses in a vector"
-  [^Session session table records]
-  (let [query-params (batch-query-from- table records)]
-    (cc/execute session (q/batch-query query-params))))
-
-(defn insert-batch-async
-  "Same as insert-batch but returns a future"
-  [^Session session table records]
-  (cc/async
-   (insert-batch session table records)))
-
-(defn atomic-batch
-  "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
-  [^Session session & clauses]
-  (cc/execute session
-              (compile-query- q/batch-query clauses)))
+;; (defn ^:private batch-query-from-
+;;   [table records]
+;;   (->> records
+;;        (map (comp (partial apply (partial new-query-api/insert table)) flatten vector))
+;;        (apply q/queries)))
+
+;; (defn insert-batch
+;;   "Performs a batch insert (inserts multiple records into a table at the same time).
+;;   To specify additional clauses for a record (such as where or using), wrap that record
+;;   and the clauses in a vector"
+;;   [^Session session table records]
+;;   (let [query-params (batch-query-from- table records)]
+;;     (cc/execute session (q/batch-query query-params))))
+
+;; (defn insert-batch-async
+;;   "Same as insert-batch but returns a future"
+;;   [^Session session table records]
+;;   (cc/async
+;;    (insert-batch session table records)))
+
+;; (defn atomic-batch
+;;   "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
+;;   [^Session session & clauses]
+;;   (cc/execute session
+;;               (apply q/batch-query clauses)))

 (defn update
   "Updates one or more columns for a given row in a table. The `where` clause
@@ -179,9 +173,7 @@
    Other columns values are specified through assignment within the `set` clause."
   [^Session session & query-params]
   (cc/execute session
-              (apply new-query-api/update query-params)
-              ;; (compile-query- q/update-query query-params)
-              ))
+              (apply new-query-api/update query-params)))

 (defn update-async
   "Same as update but returns a future"
@@ -197,7 +189,7 @@
    for this function should always be table name."
   [^Session session table & query-params]
   (cc/execute session
-              (compile-query- q/delete-query (cons table query-params))))
+              (apply new-query-api/delete (cons table query-params))))

 (defn delete-async
   "Same as delete but returns a future"
@@ -223,42 +215,42 @@
    not removing the table itself."
   [^Session session table]
   (cc/execute session
-              (q/truncate-query table)))
-
-(defn create-user
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/create-user-query query-params)))
-
-(defn alter-user
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/alter-user-query query-params)))
-
-(defn drop-user
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/drop-user-query query-params)))
-
-(defn grant
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/grant-query query-params)))
-
-(defn revoke
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/revoke-query query-params)))
-
-(defn list-users
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/list-users-query query-params)))
-
-(defn list-permissions
-  [^Session session & query-params]
-  (cc/execute session
-              (compile-query- q/list-perm-query query-params)))
+              (new-query-api/truncate table)))
+
+;; (defn create-user
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/create-user-query query-params)))
+
+;; (defn alter-user
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/alter-user-query query-params)))
+
+;; (defn drop-user
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/drop-user-query query-params)))
+
+;; (defn grant
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/grant-query query-params)))
+
+;; (defn revoke
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/revoke-query query-params)))
+
+;; (defn list-users
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/list-users-query query-params)))
+
+;; (defn list-permissions
+;;   [^Session session & query-params]
+;;   (cc/execute session
+;;               (apply q/list-perm-query query-params)))

 ;;
 ;; Higher level DB functions
@@ -274,89 +266,89 @@
   (assert (not cc/*prepared-statement*) "get-one query can't be executed as a prepared query")
   (first
    (cc/execute session
-               (compile-query- q/select-query query-params))))
-
-(defn perform-count
-  "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
-   in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
-   for more complex cases, you can wither do a full table scan or perform a count with this function,
-   please note that it does not have any performance guarantees and is potentially expensive.
-
-   Doesn't work as a prepared query."
-  [^Session session table & query-params]
-  (assert (not cc/*prepared-statement*) "Count query can't be executed as a prepared query")
-  (:count
-   (first
-    (select session table
-            (cons
-             (q/columns (q/count*))
-             query-params)))))
+               (apply new-query-api/select query-params))))
+
+;; (defn perform-count
+;;   "Helper function to perform count on a table with given query. Count queries are slow in Cassandra,
+;;    in order to get a rough idea of how many items you have in certain table, use `nodetool cfstats`,
+;;    for more complex cases, you can wither do a full table scan or perform a count with this function,
+;;    please note that it does not have any performance guarantees and is potentially expensive.
+
+;;    Doesn't work as a prepared query."
+;;   [^Session session table & query-params]
+;;   (assert (not cc/*prepared-statement*) "Count query can't be executed as a prepared query")
+;;   (:count
+;;    (first
+;;     (select session table
+;;             (cons
+;;              (q/columns (q/count*))
+;;              query-params)))))

 ;;
 ;; Higher-level helper functions for schema
 ;;

-(defn describe-keyspace
-  "Returns a keyspace description, taken from `system.schema_keyspaces`."
-  [^Session session ks]
-  (assert (not cc/*prepared-statement*) "Describe Keyspace query can't be executed as a prepared query")
-  (first
-   (select session :system.schema_keyspaces
-           (q/where {:keyspace_name (name ks)}))))
-
-(defn describe-table
-  "Returns a table description, taken from `system.schema_columnfamilies`."
-  [^Session session ks table]
-  (assert (not cc/*prepared-statement*) "Describe Table query can't be executed as a prepared query")
-  (first
-   (select session :system.schema_columnfamilies
-           (q/where {:keyspace_name (name ks)
-                     :columnfamily_name (name table)}))))
-
-(defn describe-columns
-  "Returns table columns description, taken from `system.schema_columns`."
-  [^Session session ks table]
-  (assert (not cc/*prepared-statement*) "Describe Columns query can't be executed as a prepared query")
-  (select session :system.schema_columns
-          (q/where {:keyspace_name (name ks)
-                    :columnfamily_name (name table)})))
+;; (defn describe-keyspace
+;;   "Returns a keyspace description, taken from `system.schema_keyspaces`."
+;;   [^Session session ks]
+;;   (assert (not cc/*prepared-statement*) "Describe Keyspace query can't be executed as a prepared query")
+;;   (first
+;;    (select session :system.schema_keyspaces
+;;            (q/where {:keyspace_name (name ks)}))))
+
+;; (defn describe-table
+;;   "Returns a table description, taken from `system.schema_columnfamilies`."
+;;   [^Session session ks table]
+;;   (assert (not cc/*prepared-statement*) "Describe Table query can't be executed as a prepared query")
+;;   (first
+;;    (select session :system.schema_columnfamilies
+;;            (q/where {:keyspace_name (name ks)
+;;                      :columnfamily_name (name table)}))))
+
+;; (defn describe-columns
+;;   "Returns table columns description, taken from `system.schema_columns`."
+;;   [^Session session ks table]
+;;   (assert (not cc/*prepared-statement*) "Describe Columns query can't be executed as a prepared query")
+;;   (select session :system.schema_columns
+;;           (q/where {:keyspace_name (name ks)
+;;                     :columnfamily_name (name table)})))

 ;;
 ;; Higher-level collection manipulation
 ;;

-(defn- load-chunk
-  "Returns next chunk for the lazy table iteration"
-  [^Session session table partition-key chunk-size last-pk]
-  (if (nil? (first last-pk))
-    (select session table
-            (q/limit chunk-size))
-    (select session table
-            (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
-            (q/limit chunk-size))))
-
-(defn iterate-table
-  "Lazily iterates through a table, returning chunks of chunk-size."
-  ([^Session session table partition-key chunk-size]
-     (iterate-table session table (if (sequential? partition-key)
-                                    partition-key
-                                    [partition-key])
-                    chunk-size []))
-  ([^Session session table partition-key chunk-size c]
-     (lazy-cat c
-               (let [last-pk    (map #(get (last c) %) partition-key)
-                     next-chunk (load-chunk session table partition-key chunk-size last-pk)]
-                 (if (empty? next-chunk)
-                   []
-                   (iterate-table session table partition-key chunk-size next-chunk))))))
-
-(defn copy-table
-  "Copies data from one table to another, transforming rows
-   using provided function (`transform-fn`)"
-  ([^Session session from-table to-table partition-key]
-     (copy-table session from-table to-table partition-key 16384))
-  ([^Session session from-table to-table partition-key chunk-size]
-     (copy-table session from-table to-table partition-key identity chunk-size))
-  ([^Session session from-table to-table partition-key transform-fn chunk-size]
-     (doseq [row (iterate-table session from-table partition-key chunk-size)]
-       (insert session to-table (transform-fn row)))))
+;; (defn- load-chunk
+;;   "Returns next chunk for the lazy table iteration"
+;;   [^Session session table partition-key chunk-size last-pk]
+;;   (if (nil? (first last-pk))
+;;     (select session table
+;;             (q/limit chunk-size))
+;;     (select session table
+;;             (q/where [[> (apply q/token partition-key) (apply q/token last-pk)]])
+;;             (q/limit chunk-size))))
+
+;; (defn iterate-table
+;;   "Lazily iterates through a table, returning chunks of chunk-size."
+;;   ([^Session session table partition-key chunk-size]
+;;      (iterate-table session table (if (sequential? partition-key)
+;;                                     partition-key
+;;                                     [partition-key])
+;;                     chunk-size []))
+;;   ([^Session session table partition-key chunk-size c]
+;;      (lazy-cat c
+;;                (let [last-pk    (map #(get (last c) %) partition-key)
+;;                      next-chunk (load-chunk session table partition-key chunk-size last-pk)]
+;;                  (if (empty? next-chunk)
+;;                    []
+;;                    (iterate-table session table partition-key chunk-size next-chunk))))))
+
+;; (defn copy-table
+;;   "Copies data from one table to another, transforming rows
+;;    using provided function (`transform-fn`)"
+;;   ([^Session session from-table to-table partition-key]
+;;      (copy-table session from-table to-table partition-key 16384))
+;;   ([^Session session from-table to-table partition-key chunk-size]
+;;      (copy-table session from-table to-table partition-key identity chunk-size))
+;;   ([^Session session from-table to-table partition-key transform-fn chunk-size]
+;;      (doseq [row (iterate-table session from-table partition-key chunk-size)]
+;;        (insert session to-table (transform-fn row)))))


4clojure:: impl the balanced? num function

--- src/clojure_learning/4clojure-exercises.clj
+++ src/clojure_learning/4clojure-exercises.clj
@@ -3251,3 +3251,62 @@
       (recur (applied-fn))
       applied-fn)))

+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The Balance of N
+;; Difficulty:	Medium
+;; Topics:	math
+;; Balanced Numbers are: whose component digits have the same sum on the left and right halves of the number.
+;; (= true (__ 11))
+;; (= false (__ 123))
+;; (= true (__ 89098))
+(defn balanced? [x]
+    (letfn [(to-int [x] (Integer/parseInt x))
+            (sum-reduce-chars [seq-chars]
+              (reduce + (map (comp to-int str) seq-chars)))
+            (even-count-chars? [seq-chars] (zero? (rem (count seq-chars) 2)))
+            (take-from [with seq-chars]
+              [(take (quot (count seq-chars) 2) seq-chars)
+               (drop (+ with (quot (count seq-chars) 2)) seq-chars)])
+            (split-in-halfs [seq-chars]
+              (if (even-count-chars? seq-chars)
+                (take-from 0 seq-chars)
+                (take-from 1 seq-chars)))
+            (sum-reduce-half [func seq-chars]
+              (sum-reduce-chars (func (split-in-halfs (str x)))))]
+      (= (sum-reduce-half first x)
+         (sum-reduce-half second x))))
+
+(balanced? 1234321) ;; true
+
+;; work:
+(letfn [(to-int [x-str] (Integer/parseInt x-str))]
+  (reduce + (map (comp to-int str) [\1 \2 \3]))) ;; 6
+
+(Integer. "123")  ;; 123
+(Integer/parseInt "123") ;; 123
+(take 2 "1234")
+(doc drop)
+(reduce )
+
+(quot 5 2)
+(zero? (rem (count "1233") 2)) ;; true
+
+;; refactoring...
+(defn balanced? [x]
+    (letfn [(take-from [with seq-chars]
+              (let [all (count seq-chars)]
+                [(take (quot all 2) seq-chars)
+                 (drop (+ with (quot all 2)) seq-chars)]))
+            (split-in-halfs [seq-chars]
+              (if (even? (count seq-chars))
+                (take-from 0 seq-chars)
+                (take-from 1 seq-chars)))
+            (sum-reduce-chars [seq-chars]
+              (reduce + (map int seq-chars)))
+            (sum-reduce-half [func seq-chars]
+              (sum-reduce-chars (func (split-in-halfs (str x)))))]
+      (= (sum-reduce-half first x)
+         (sum-reduce-half second x))))
+
+(balanced? 1234321) ;; true


Remove unneeded test destinations

Remove unneeded test destinations

--- support/build-support/src/main/clojure/fnbox/build/tools.clj
+++ support/build-support/src/main/clojure/fnbox/build/tools.clj
@@ -127,6 +127,11 @@
 (defn unquote-cookie-path [xml]
   (set-system-property xml "org.apache.tomcat.util.http.ServerCookie.FWD_SLASH_IS_SEPARATOR" "false"))

+(defn remove-jms-destinations [xml]
+  (if-let [loc (zfx/xml1-> (zip/xml-zip xml) zf/descendants :jms-destinations)]
+    (-> loc zip/remove zip/root)
+    xml))
+
 (defn transform-config [file]
   (let [in-file (io/file jboss-dir file)
         xml (xml/parse-trim in-file)
@@ -141,6 +146,8 @@
                     add-extensions
                     add-subsystems
                     set-welcome-root
-                    unquote-cookie-path)
+                    unquote-cookie-path
+                    remove-jms-destinations
+                    )
                 :indent 4))
              out-file)))


CMR-1746: A minor refactoring.

CMR-1746: A minor refactoring.

--- system-int-test/src/cmr/system_int_test/data2/collection.clj
+++ system-int-test/src/cmr/system_int_test/data2/collection.clj
@@ -230,9 +230,9 @@
    (let [collection (collection attribs)]
      (update-in collection [:data-provider-timestamps :revision-date-time]
                 (fn [revision-date-time]
-                  (when revision-date-time (->> revision-date-time
-                                                (f/unparse (f/formatters :date))
-                                                (f/parse (f/formatters :date)))))))))
+                  (some->> revision-date-time
+                           (f/unparse (f/formatters :date))
+                           (f/parse (f/formatters :date))))))))

 (defn collection-concept
   "Returns the collection for ingest with the given attributes"


prompt select list

prompt select list

--- src/pretty/cli.clj
+++ src/pretty/cli.clj
@@ -14,9 +14,9 @@
   (println (flf/figlet "TEST"))
   (let [
         first-name (prompt/input "First name")
+        last-name (prompt/input "Last name")
         gender (prompt/select-list "Gender" [{:label "Male" :value "M"} {:label "Female" :value "F"}])
-        last-name (prompt/input "Last name")
-        ;confirm? (prompt/confirm "Are you sure")
+        confirm? (prompt/confirm "Are you sure")
         ]


Remove macroexpand-all: it's not in fact the stepping-stone to setup/teardown.

--- src/midje/sweet.clj
+++ src/midje/sweet.clj
@@ -43,7 +43,7 @@
 	(do
 	  (define-metaconstants description)
 	  (let [background (expand description)]
-	    (macroexpand-all `(background/with-background-fakes ~background ~@forms))))
+	    `(background/with-background-fakes ~background ~@forms)))

 	:else
 	`(do ~@forms)))


formatting

formatting

--- frameworks/Clojure/luminus/hello/src/clj/hello/routes/home.clj
+++ frameworks/Clojure/luminus/hello/src/clj/hello/routes/home.clj
@@ -52,7 +52,7 @@
   (GET "/json"             [] (json-serialization)))

 (defroutes default-routes
-  (GET "/"                 [] "Hello, World!")
+  (GET "/"                 []        "Hello, World!")
   (GET "/db"               []        (single-query-test))
   (GET "/queries/"         []        (multiple-query-test 1))
   (GET "/queries/:queries" [queries] (multiple-query-test queries))


Use flexbox fo .org-flex-container, modeled on Projects page card titles

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -46,16 +46,17 @@
                                                    :cell-fn (fn [org]
                                                               (let [vcs-type (:vcs_type org)
                                                                     org-url (routes/v1-org-settings-path {:org (:login org)
-                                                                                :vcs_type vcs-type})]
-                                                                (html [:span
-                                                                       [:span.table-row-icon
-                                                                        (case vcs-type
-                                                                          "github" (icon/github)
-                                                                          "bitbucket" (icon/bitbucket)
-                                                                          nil)]
-                                                                       [:a
-                                                                        {:href org-url}
-                                                                        [:span (:login org)]]])))}]})]]]))])))))
+                                                                                :vcs_type vcs-type})
+                                                                    vcs-icon (case vcs-type
+                                                                               "github" (icon/github)
+                                                                               "bitbucket" (icon/bitbucket)
+                                                                               nil)]
+                                                                (html
+                                                                  [:div.org-flex-container
+                                                                   [:.vcs-icon vcs-icon]
+                                                                   [:a
+                                                                    {:href org-url}
+                                                                    [:span (:login org)]]])))}]})]]]))])))))

 (defn api-tokens [app owner]
   (reify


Push 2 can update touch strip faster.

Push 2 can update touch strip faster.

No need to wait until the next frame after a mode change.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -485,14 +485,11 @@
       (if next-strip
         (let [[value mode] next-strip
               message (ShortMessage.)]
-          (if (not= mode last-mode)
-            (do  ; When changing mode, we have to wait until the next frame to update the value.
-              (set-touch-strip-mode controller mode)
-              (reset! (:last-touch-strip controller) [nil mode]))
-            (do
-              (.setMessage message ShortMessage/PITCH_BEND 0 (rem value 128) (quot value 128))
-              (midi/midi-send-msg (get-in controller [:port-out :receiver]) message -1)
-              (reset! (:last-touch-strip controller) next-strip))))
+          (when (not= mode last-mode)
+            (set-touch-strip-mode controller mode))
+          (.setMessage message ShortMessage/PITCH_BEND 0 (rem value 128) (quot value 128))
+          (midi/midi-send-msg (get-in controller [:port-out :receiver]) message -1)
+          (reset! (:last-touch-strip controller) next-strip))
         (do
           (set-touch-strip-mode controller touch-strip-mode-default)
           (reset! (:last-touch-strip controller) nil))))))


Make rswap exception safe

Make rswap exception safe


cleanup

cleanup

--- demo/sitetools/core.cljs
+++ demo/sitetools/core.cljs
@@ -62,7 +62,7 @@
                   (assoc state :page-name v1))
     :goto-page (do
                  (assert (string? v1))
-                 (if r/is-client
+                 (if history
                    (do (.setToken history v1)
                        (r/next-tick #(set! js/document.body.scrollTop 0))
                        state)
@@ -89,7 +89,7 @@
 (defn init-history [page]
   (when-not history
     (let [html5 (and page
-                     (.isSupported Html5History)
+                     (Html5History.isSupported)
                      (#{"http:" "https:"} js/location.protocol))]
       (doto (set! history
                   (if html5


Reduce default pool size to 16

Reduce default pool size to 16

--- src/onyx/system.clj
+++ src/onyx/system.clj
@@ -58,7 +58,7 @@

 ;; Temporary workaround
 ;; Increase default core.async thread poll size to avoid blocking issues due to alts!!
-(System/setProperty "clojure.core.async.pool-size" (or (System/getProperty "clojure.core.async.pool-size") "32"))
+(System/setProperty "clojure.core.async.pool-size" (or (System/getProperty "clojure.core.async.pool-size") "16"))

 (def development-components [:monitoring :logging-config :log :bookkeeper])


Update http-handler

Update http-handler

--- src/clojure_template/server/http_handler.clj
+++ src/clojure_template/server/http_handler.clj
@@ -30,21 +30,22 @@
                        (application-controller/index)
                        (redirect "/404.html"))))

-          ;; initialize middleware
-          handler (if (= "development" (env :clj-env))
-                    (-> routes
-                        (wrap-defaults site-defaults)
-                        wrap-with-logger
-                        wrap-gzip
-                        wrap-exceptions
-                        wrap-reload)
+          default-handler (-> routes
+                              (wrap-defaults site-defaults)
+                              wrap-with-logger
+                              wrap-gzip)

-                    (-> routes
-                        (wrap-defaults site-defaults)
-                        wrap-with-logger
-                        wrap-gzip))]
+          development-handler (-> routes
+                                  (wrap-defaults site-defaults)
+                                  wrap-with-logger
+                                  wrap-gzip
+                                  wrap-exceptions
+                                  wrap-reload)]

-      (assoc this :handler handler)))
+      (assoc this :handler
+                  (if (= "development" (env :clj-env))
+                    development-handler
+                    default-handler))))

   (stop [this]
     (when handler


Adds attribution

Adds attribution

--- webapp/src/org/teamweek/webapp/middleware/datomic.clj
+++ webapp/src/org/teamweek/webapp/middleware/datomic.clj
@@ -1,6 +1,9 @@
 (ns org.teamweek.webapp.middleware.datomic
   (:require [datomic.api :as d]))

+
+;; Bobby Calderwood
+;; https://gist.github.com/bobby/3150938

 (defn wrap-datomic
   "A Ring middleware that provides a request-consistent database connection and


Remove deprecated quoting from the example project

--- example/project.clj
+++ example/project.clj
@@ -34,7 +34,7 @@
                                                 :optimizations :none}}
             :test               {:source-paths ["src" "test"]
                                  :compiler     {:output-to     "out/testable.js"
-                                                :main          'example.runner
+                                                :main          example.runner
                                                 :optimizations :simple}}
             :advanced           {:source-paths ["src" "test"]
                                  :compiler     {:output-to     "out/testable.js"


Added dissoc! function

Added dissoc! function

--- src/show/core.cljs
+++ src/show/core.cljs
@@ -1,5 +1,5 @@
 (ns show.core
-  (:refer-clojure :exclude [reset! update! assoc!])
+  (:refer-clojure :exclude [reset! update! assoc! dissoc!])
   (:require [clojure.string])
   (:import [goog.ui IdGenerator]))

@@ -62,6 +62,16 @@
    (let [ks (if (sequential? ks) ks [ks])]
      (reset! component
              (assoc-in (get-state component) ks val) cb))))
+
+(defn dissoc!
+  "Dissociates an entry from the component's nested associative structure. ks
+  can be a sequence of keys. Takes optional callback function to be called when
+  the value is merged into the render state."
+  ([component ks] (dissoc! component ks nil))
+  ([component ks cb]
+   (let [ks (if (sequential? ks) ks [ks])]
+     (reset! component
+             (update-in (get-state component) (butlast ks) dissoc (last ks))))))

 (defn update!
   "'Updates' a value in the component's local nested associative structure,


Simplify slider function

Simplify slider function

--- src/play_clj/ui.clj
+++ src/play_clj/ui.clj
@@ -85,13 +85,14 @@
   `(u/create-entity (u/calls! ^Label (label* ~text ~arg) ~@options)))

 (defn slider*
-  [min max step is-vert? arg]
-  (Slider. (float min) (float max) (float step) is-vert? arg))
+  [{:keys [min max step vertical?]
+    :or {min 0 max 10 step 1 vertical? false}}
+   arg]
+  (Slider. (float min) (float max) (float step) vertical? arg))

 (defmacro slider
-  [min max step is-vert? arg & options]
-  `(u/create-entity (u/calls! ^Slider (slider* ~min ~max ~step ~is-vert? ~arg)
-                              ~@options)))
+  [attrs arg & options]
+  `(u/create-entity (u/calls! ^Slider (slider* ~attrs ~arg) ~@options)))

 (defn text-button*
   [^String text arg]


Implemented the Memcache increment interface.

--- src/appengine_magic/services/memcache.clj
+++ src/appengine_magic/services/memcache.clj
@@ -95,3 +95,23 @@
   (let [service (get-memcache-service :service service :namespace namespace)
         policy (*policy-type-map* policy)]
     (.putAll service values expiration policy)))
+
+
+(defn increment
+  "If (sequential? key), increment each key by the delta."
+  [key delta & {:keys [service namespace initial]}]
+  (let [service (get-memcache-service :service service :namespace namespace)]
+    (if initial
+        (if (sequential? key)
+            (.incrementAll service key delta (long initial))
+            (.increment service key delta (long initial)))
+        (if (sequential? key)
+            (.incrementAll service key delta)
+            (.increment service key delta)))))
+
+
+(defn increment-map [values & {:keys [service namespace initial]}]
+  (let [service (get-memcache-service :service service :namespace namespace)]
+    (if initial
+        (.incrementAll service values (long initial))
+        (.incrementAll service values))))


Temporarily removed the caching URL Fetch implementation.

--- src/appengine_magic/services/urlfetch.clj
+++ src/appengine_magic/services/urlfetch.clj
@@ -111,54 +111,3 @@
   (let [f (.fetchAsync (get-urlfetch-service)
                        (apply make-request (urlify url) opts))]
     (derefify-future f #(parse-response (.get f)))))
-
-;; A 2-level cache for fetch results; first in memory, then memcache.
-(def *memcache-namespace* "appengine-magic.services.urlfetch")
-(def *memory-cache* (atom {}))
-(defn- cache-response [url response]
-  ;; save unnecessary memcache calls by checking for relevant headers
-  (if (or (:Last-Modified (:headers response))
-          (:ETag (:headers response)))
-    (do (swap! *memory-cache* assoc url response)
-        (memcache/put! url response :namespace *memcache-namespace*)
-        response)))
-(defn- uncache-response [url]
-  (if-let [response (@*memory-cache* url)]
-    response
-    (memcache/get url :namespace *memcache-namespace*)))
-
-(defn- make-cache-sensitive-request [old-response url & opts]
-  (let [request (apply make-request url opts)]
-    (if old-response
-      (if-let [etag (:ETag (:headers old-response))]
-        (.setHeader request (HTTPHeader. "If-None-Match" etag))
-        (if-let [last-modified (:Last-Modified (:headers old-response))]
-          (.setHeader request
-                      (HTTPHeader. "If-Modified-Since" last-modified)))))
-    request))
-
-(defn memcached-fetch
-  "Like fetch, but caches its results in memcache and uses ETag or
-   Last-Modified headers to avoid doing full-fetches when possible."
-  [url & opts]
-  (let [url          (urlify url)
-        old-response (uncache-response url)
-        request      (apply make-cache-sensitive-request old-response url opts)
-        response     (parse-response (.fetch (get-urlfetch-service) request))]
-    (if (= 304 (:response-code response))
-      old-response
-      (cache-response url response))))
-
-(defn memcached-fetch-async
-  "Like fetch-async, but caches its results like memcached-fetch."
-  [url & opts]
-  (let [url          (urlify url)
-        old-response (uncache-response url)
-        request      (apply make-cache-sensitive-request old-response url opts)
-        responsef    (.fetchAsync (get-urlfetch-service) request)]
-    (derefify-future responsef
-                     (fn []
-                       (let [response (parse-response (.get responsef))]
-                         (if (= 304 (:response-code response))
-                           old-response
-                           (cache-response url response)))))))


Fix backward-number bugs

Fix backward-number bugs

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -9,8 +9,8 @@
     #?@(:cljs
        [[java.time :refer [Date Clock ZoneId ZoneOffset Instant Duration Period DayOfWeek Month ZonedDateTime LocalTime LocalDateTime LocalDate Year YearMonth ZoneId OffsetDateTime OffsetTime ChronoUnit ChronoField TemporalAdjusters]]
          [cljs.java-time.extend-eq-and-compare]]))
-
-
+
+
   #?(:clj
      (:import
        [java.util Date]
@@ -726,7 +726,7 @@
   (backward-duration [t d] (.minus t d))
   Date
   (forward-duration [t d] (.plus (instant t) d))
-  (backward-duration [t d] (.plus (instant t) d))
+  (backward-duration [t d] (.minus (instant t) d))
   LocalDate
   (forward-number [t n] (.plusDays t n))
   (backward-number [t n] (.minusDays t n))
@@ -734,22 +734,22 @@
   (backward-duration [t d] (.minus t d))
   LocalTime
   (forward-duration [t d] (.plus t d))
-  (backward-duration [t d] (.plus t d))
+  (backward-duration [t d] (.minus t d))
   LocalDateTime
   (forward-duration [t d] (.plus t d))
-  (backward-duration [t d] (.plus t d))
+  (backward-duration [t d] (.minus t d))
   OffsetDateTime
   (forward-duration [t d] (.plus t d))
-  (backward-duration [t d] (.plus t d))
+  (backward-duration [t d] (.minus t d))
   ZonedDateTime
   (forward-duration [t d] (.plus t d))
-  (backward-duration [t d] (.plus t d))
+  (backward-duration [t d] (.minus t d))
   Year
   (forward-number [t n] (.plusYears t n))
-  (backward-number [t n] (.plusYears t n))
+  (backward-number [t n] (.minusYears t n))
   YearMonth
   (forward-number [t n] (.plusMonths t n))
-  (backward-number [t n] (.plusMonths t n))
+  (backward-number [t n] (.minusMonths t n))
   (forward-duration [t d] (.plus t d))
   (backward-duration [t d] (.minus t d))
   Clock


Fix typo in parse regex

Fix typo in parse regex

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -102,7 +102,7 @@
     #"(jul)(y)?" cljc.java-time.month/july
     #"(aug)(ust)?" cljc.java-time.month/august
     #"(sep)(tember)?" cljc.java-time.month/september
-    #"(oct)(tober)?" cljc.java-time.month/october
+    #"(oct)(ober)?" cljc.java-time.month/october
     #"(nov)(ember)?" cljc.java-time.month/november
     #"(dec)(ember)?" cljc.java-time.month/december
     nil))


Add update-action method for github pull request.

--- src/cljs/hatnik/web/client/z_actions.cljs
+++ src/cljs/hatnik/web/client/z_actions.cljs
@@ -191,6 +191,17 @@
          data (wrap-error-alert
                #(common-update-callback action-update-error-message data %)))))))

+(defmethod update-action :github-pull-request [data-pack]
+  (let [data (build-gh-pull-req-action data-pack)]
+    (if (s/check schm/GithubPullRequestAction data)
+      (msg/danger default-error-message)
+      (do
+        (.modal ($ :#iModalAddAction) "hide")
+        (ajax
+         (str "/api/actions/" (:action-id data-pack)) "PUT"
+         data (wrap-error-alert
+               #(common-update-callback action-update-error-message data %)))))))
+
 (defn delete-action [action-id]
   (.modal ($ :#iModalAddAction) "hide")
   (ajax


Refactored to centralize some code.

Refactored to centralize some code.

--- src/cmr/bootstrap/data/bulk_migration.clj
+++ src/cmr/bootstrap/data/bulk_migration.clj
@@ -9,7 +9,8 @@
             [sqlingvo.vendor :as v]
             [cmr.metadata-db.data.oracle.sql-utils :as su]
             [clojure.core.async :as ca :refer [thread alts!! <!!]]
-            [cmr.oracle.connection :as oc]))
+            [cmr.oracle.connection :as oc]
+            [cmr.metadata-db.data.oracle.concept-tables :as tables]))

 ;; To copy a provider
 ;; 1. Tell the metadata db to drop the provider
@@ -19,21 +20,24 @@
 ;; 4. Iterate over dataset ids for provider and insert granules into metadata db table
 ;; by selecting from catlaog-rest table.

-(def catalog-rest-tablespace "DEV_52_CATALOG_REST")
-
-(def metadata-db-tablespace "METADATA_DB")
-
-;;FIXME - metadata-db url should be the configuration value we load. This will be different
-;; when deployed in various environments.
-(def metadata-db-port (config/config-value-fn :metadata-db-port 3001))
+(def catalog-rest-tablespace (config/config-value-fn :catalog-rest-tablespace "DEV_52_CATALOG_REST"))
+
+(def metadata-db-tablespace (config/config-value-fn :metadata-db-tablespace "METADATA_DB"))
+
+(def metadata-db-url (config/config-value-fn :metadata-db-host "http://localhost:3001"))
+
+(defn catalog-rest-dataset-table
+  "Get the dataset table name for a given provider."
+  [provider-id]
+  (keyword (str (catalog-rest-tablespace) "." provider-id "-dataset-records")))

 (defn create-provider-url
   []
-  (format "http://localhost:%s/providers" (metadata-db-port)))
+  (format "%s/providers" (metadata-db-url)))

 (defn delete-provider-url
   [provider-id]
-  (format "http://localhost:%s/providers/%s" (metadata-db-port) provider-id))
+  (format "%s/providers/%s" (metadata-db-url) provider-id))

 (defn- create-provider
   "Create the provider with the given provider id"
@@ -51,9 +55,7 @@
 (defn- delete-collection-sql
   "Generate SQL to delete a collection from a provider's collection table."
   [provider-id collection-id]
-  ;; FIXME - this runs as the metadata db user so it's not necessary to specify the tablespace
-  ;; FIXME - Don't manually create the table names here. This should use shared code from metadata db or something.
-  (let [collection-table (keyword (str metadata-db-tablespace "." provider-id "-collections"))]
+  (let [collection-table (tables/get-table-name provider-id :collection)]
     (su/build (delete collection-table (where `(= :concept-id ~collection-id))))))

 (defn- delete-collection
@@ -67,7 +69,7 @@
 (defn- delete-collection-granules-sql
   "Generate SQL to delete granules for a given collection from a provider's granule table."
   [provider-id collection-id]
-  (let [granule-table (keyword (str metadata-db-tablespace "." provider-id "-granules"))]
+  (let [granule-table (tables/get-table-name provider-id :granule)]
     (su/build (delete granule-table (where `(= :parent-collection-id ~collection-id))))))

 (defn- delete-collection-granules
@@ -81,10 +83,8 @@
 (defn- get-dataset-record-id-for-collection-sql
   "Generate SQL to retrieve the id for a given collection/dataset from the catalog-rest table."
   [provider-id collection-id]
-  ;; FIXME - you have need to create table names with user prefixes in multiple places. This should
-  ;; be extracted into a helper function.
-  (let [dataset-table (keyword (str catalog-rest-tablespace "." provider-id "-dataset-records"))]
-    (su/build (select [:id] (from dataset-table) (where `(= :echo-collection-id ~collection-id))))))
+  (su/build (select [:id] (from (catalog-rest-dataset-table provider-id))
+                    (where `(= :echo-collection-id ~collection-id)))))

 (defn- get-dataset-record-id-for-collection
   "Retrieve the id for a given collection/dataset from the catalog-rest table."
@@ -97,8 +97,7 @@
 (defn- get-provider-collection-list-sql
   "Gengerate SQL to get the list of collections (datasets) for the given provider."
   [provider-id]
-  (let [dataset-table (keyword (str catalog-rest-tablespace "." provider-id "-dataset-records"))]
-    (su/build (select [:id :echo-collection-id] (from dataset-table)))))
+  (su/build (select [:id :echo-collection-id] (from (catalog-rest-dataset-table provider-id)))))

 (defn- get-provider-collection-list
   "Get the list of collections (datasets) for the given provider."
@@ -110,39 +109,33 @@
 (defn- copy-collection-data-sql
   "Generate SQL to copy the dataset/collection data from the catalog rest database to the
   metadata db for the given provider for all the provider's collections or a single collection."
-  ;; FIXME - if collection-id is supposed to be optional but not a list it should be done through
-  ;; the use of multiple arguments instead of the & method.
-  [provider-id & collection-id]
-  (let [dataset-table (keyword (str catalog-rest-tablespace
-                                    "."
-                                    provider-id
-                                    "-dataset-records"))
-        collection-table (keyword (str metadata-db-tablespace
-                                       "."
-                                       provider-id
-                                       "-collections"))
-        ;; FIXME - You instantiate this variable but never use it. I'm guessing you want to update
-        ;; the metadata db sequence using this. This should be a separate function specifically for this.
-        sequence (keyword (str metadata-db-tablespace
-                               ".concept_id_seq.NEXTVAL"))
-        collection-id (first collection-id)]
-    (su/build (insert collection-table [:concept-id
-                                        :native-id
-                                        :metadata
-                                        :format
-                                        :short-name
-                                        :version-id
-                                        :entry-title]
-                      (select [:echo-collection-id
-                               :dataset-id
-                               :compressed-xml
-                               :xml-mime-type
-                               :short-name
-                               :version-id
-                               :long-name]
-                              (from dataset-table)
-                              (when collection-id
-                                (where `(= :echo-collection-id ~collection-id))))))))
+  ([provider-id] (copy-collection-data-sql provider-id nil))
+  ([provider-id  collection-id] (let [dataset-table (keyword (str (catalog-rest-tablespace)
+                                                                  "."
+                                                                  provider-id
+                                                                  "-dataset-records"))
+                                      collection-table (keyword (str (metadata-db-tablespace)
+                                                                     "."
+                                                                     provider-id
+                                                                     "-collections"))
+                                      collection-id (first collection-id)]
+                                  (su/build (insert collection-table [:concept-id
+                                                                      :native-id
+                                                                      :metadata
+                                                                      :format
+                                                                      :short-name
+                                                                      :version-id
+                                                                      :entry-title]
+                                                    (select [:echo-collection-id
+                                                             :dataset-id
+                                                             :compressed-xml
+                                                             :xml-mime-type
+                                                             :short-name
+                                                             :version-id
+                                                             :long-name]
+                                                            (from dataset-table)
+                                                            (when collection-id
+                                                              (where `(= :echo-collection-id ~collection-id)))))))))

 (defn- copy-collection-data
@@ -157,9 +150,9 @@
 (defn- copy-granule-data-for-collection-sql
   "Generate the SQL to copy the granule data from the catalog reset datbase to the metadata db."
   [provider-id collection-id dataset-record-id]
-  (let [granule-echo-table (keyword (str catalog-rest-tablespace "." provider-id "-granule-records"))
-        granule-mdb-table (keyword (str metadata-db-tablespace "." provider-id "-granules"))
-        sequence (keyword (str metadata-db-tablespace ".concept_id_seq.NEXTVAL"))]
+  (let [granule-echo-table (keyword (str (catalog-rest-tablespace) "." provider-id "-granule-records"))
+        granule-mdb-table (keyword (str (metadata-db-tablespace) "." provider-id "-granules"))
+        sequence (keyword (str (metadata-db-tablespace) ".concept_id_seq.NEXTVAL"))]
     (su/build (insert granule-mdb-table [:concept-id
                                          :native-id
                                          :parent-collection-id


Remove unused code

Remove unused code

--- src/github_changelog/formatters/markdown.clj
+++ src/github_changelog/formatters/markdown.clj
@@ -47,9 +47,6 @@
     changes
     (str (format-scope scope) (format-entries changes))))

-(defn- assoc-formatted-change [change]
-  (assoc change :formatted (format-change change)))
-
 (defn- map-formatted [[scope changes]]
   [scope (map format-change changes)])


Slight refactor

Slight refactor

--- src/tttclj/web.clj
+++ src/tttclj/web.clj
@@ -27,9 +27,9 @@
         (when-not error
           (when (some #(= % message) (possible-moves @game))
             (swap! game #(successor % message))
-            (>! ws-channel (prep @game))))
-        (when-not (game-over? @game)
-          (recur))))))
+            (>! ws-channel (prep @game)))
+          (when-not (game-over? @game)
+            (recur)))))))

 (defroutes app
   (resources "/")


use the browser's JSON function

use the browser's JSON function

--- frontend/utils/ajax.cljs
+++ frontend/utils/ajax.cljs
@@ -20,7 +20,7 @@
   ([{:keys [prefix keywords? url method start-time]
      :or {start-time (time/now)}}]
      {:read (fn read-json [xhrio]
-              (let [json (.getResponseJson xhrio prefix)
+              (let [json (js/JSON.parse (.getResponseText xhrio))
                     headers (js->clj (.getResponseHeaders xhrio))
                     request-time (try
                                    (time/in-millis (time/interval start-time (time/now)))


make ssh rebuild work with BB builds

make ssh rebuild work with BB builds

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -476,9 +476,10 @@
   (let [api-ch (-> current-state :comms :api)
         org-name (vcs-url/org-name vcs-url)
         repo-name (vcs-url/repo-name vcs-url)
+        vcs-type (vcs-url/vcs-type vcs-url)
         uuid frontend.async/*uuid*]
     (go
-     (let [api-result (<! (ajax/managed-ajax :post (gstring/format "/api/v1/project/%s/%s/%s/ssh" org-name repo-name build-num)))]
+     (let [api-result (<! (ajax/managed-ajax :post (gstring/format "/api/v1.1/project/%s/%s/%s/%s/ssh" vcs-type org-name repo-name build-num)))]
        (put! api-ch [:retry-build (:status api-result) api-result])
        (release-button! uuid (:status api-result))
        (when (= :success (:status api-result))
@@ -492,9 +493,10 @@
   (let [api-ch (-> current-state :comms :api)
         org-name (vcs-url/org-name vcs-url)
         repo-name (vcs-url/repo-name vcs-url)
+        vcs-type (vcs-url/vcs-type vcs-url)
         uuid frontend.async/*uuid*]
     (go
-      (let [api-result (<! (ajax/managed-ajax :post (gstring/format "/api/v1/project/%s/%s/%s/ssh-users" org-name repo-name build-num)))]
+      (let [api-result (<! (ajax/managed-ajax :post (gstring/format "/api/v1.1/project/%s/%s/%s/%s/ssh-users" vcs-type org-name repo-name build-num)))]
         (release-button! uuid (:status api-result))))))

 (defmethod post-control-event! :followed-repo


Actually adding chesire/ring dependencies to project.clj

--- quote-generator-prototype/project.clj
+++ quote-generator-prototype/project.clj
@@ -4,7 +4,9 @@
   :min-lein-version "2.0.0"
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [compojure "1.4.0"]
-                 [ring/ring-defaults "0.1.5"]]
+                 [ring/ring-defaults "0.1.5"]
+                 [cheshire "5.5.0"]
+                 [ring/ring-json "0.4.0"]]
   :plugins [[lein-ring "0.9.7"]]
   :ring {:handler quote-generator-prototype.handler/app}
   :profiles


Hack to deal with protocol self-calls. Literal vectors etc. need parens to be able to be called.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -57,6 +57,8 @@
 (def ^:dynamic *go-import-prefix* "github.com/hraberg/cljs.go/")
 (def ^:dynamic *go-return-name* nil)
 (def ^:dynamic *go-return-tag* nil)
+(def ^:dynamic *go-protocol-fn* nil)
+(def ^:dynamic *go-protocol* nil)
 (def ^:dynamic *go-defs* nil)
 (def ^:dynamic *go-line-numbers* false) ;; https://golang.org/cmd/gc/#hdr-Compiler_Directives

@@ -409,9 +411,9 @@

         (<= (count keys) array-map-threshold)
         (if (distinct-keys? keys)
-          (emits "&CljsCorePersistentArrayMap{nil, " (count keys) ", []interface{}{"
+          (emits "(&CljsCorePersistentArrayMap{nil, " (count keys) ", []interface{}{"
             (comma-sep (interleave keys vals))
-            "}, nil}")
+            "}, nil})")
           (emits "CljsCorePersistentArrayMap_FromArray.X_invoke_Arity3([]interface{}{"
             (comma-sep (interleave keys vals))
             "}, true, false).(*CljsCorePersistentArrayMap)"))
@@ -437,8 +439,8 @@
       (emits "CljsCorePersistentVector_EMPTY")
       (let [cnt (count items)]
         (if (< cnt 32)
-          (emits "&CljsCorePersistentVector{nil, " cnt
-            ", 5, CljsCorePersistentVector_EMPTY_NODE, []interface{}{"  (comma-sep items) "}, nil}")
+          (emits "(&CljsCorePersistentVector{nil, " cnt
+            ", 5, CljsCorePersistentVector_EMPTY_NODE, []interface{}{"  (comma-sep items) "}, nil})")
           (emits "CljsCorePersistentVector_FromArray.X_invoke_Arity2([]interface{}{" (comma-sep items) "}, true).(*CljsCorePersistentVector)"))))))

 (defn distinct-constants? [items]
@@ -453,8 +455,8 @@
       (emits "CljsCorePersistentHashSet_EMPTY")

       (distinct-constants? items)
-      (emits "&CljsCorePersistentHashSet{nil, &CljsCorePersistentArrayMap{nil, " (count items) ", []interface{}{"
-        (comma-sep (interleave items (repeat "nil"))) "}, nil}, nil}")
+      (emits "(&CljsCorePersistentHashSet{nil, &CljsCorePersistentArrayMap{nil, " (count items) ", []interface{}{"
+        (comma-sep (interleave items (repeat "nil"))) "}, nil}, nil})")

       :else (emits "CljsCorePersistentHashSet_FromArray.X_invoke_Arity2([]interface{}{" (comma-sep items) "}, true).(*CljsCorePersistentHashSet)"))))

@@ -625,7 +627,9 @@
   (emit-fn-signature (rest params) ret-tag)
   (emits "{")
   (binding [*go-return-tag* (when (go-needs-coercion? (:tag expr) ret-tag)
-                              ret-tag)]
+                              ret-tag)
+            *go-protocol* protocol
+            *go-protocol-fn* (:name name)]
     (emit-fn-body type expr recurs))
   (emitln "}"))

@@ -774,10 +778,15 @@
 (defmethod emit* :invoke
   [{:keys [f args env] :as expr}]
   (let [info (:info f)
-       fn? (and ana/*cljs-static-fns*
-                (not (:dynamic info))
-                (:fn-var info))
-        protocol (:protocol info)
+        fn? (and ana/*cljs-static-fns*
+                 (not (:dynamic info))
+                 (:fn-var info))
+        protocol (or (:protocol info)
+                     (and (= *go-protocol-fn* (:name info)) ;; this is a hack to deal with self-calls, to be revisited.
+                          *go-protocol*))
+        object? (= 'cljs.core/Object protocol)
+        protocol (when (not object?)
+                   protocol)
         tag      (ana/infer-tag env (first (:args expr)))
         proto? (and protocol tag
                  (or (and ana/*cljs-static-fns* protocol (= tag 'not-native))
@@ -800,7 +809,7 @@
                 (or (= ns 'goog)
                     (when-let [ns-str (str ns)]
                       (= (get (string/split ns-str #"\.") 0 nil) "goog"))))
-        native? (or js? goog? go?)
+        native? (or js? goog? go? object?)
         keyword? (and (= (-> f :op) :constant)
                       (keyword? (-> f :form)))
         arity (count args)