CMR-5927 Test fixes.

CMR-5927 Test fixes.

--- umm-spec-lib/test/cmr/umm_spec/test/validation/umm_spec_collection_validation_tests.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/validation/umm_spec_collection_validation_tests.clj
@@ -167,22 +167,22 @@
           ["Metadata Associations must be unique. This contains duplicates named [(EntryId [S1] & Version [V1])]."])))))

 (deftest collection-tiling-identification-systems-validation
-  (let [t1 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T1"}
-                                                   :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0}
-                                                                                :MaximumValue 6.0)
-                                                   :Coordinate2 (coll/map->TilingCoordinateType {:MinimumValue 10.0}
-                                                                                :MaximumValue 10.0))
-        t2 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T2"}
-                                                   :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0})
-                                                   :Coordinate2 (coll/map->TilingCoordinateType {:MaximumValue 26.0}))
-        t3 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T3"}
-                                                   :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 10.0}
-                                                                                :MaximumValue 6.0))
-        t4 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T4"}
-                                                   :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0}
-                                                                                :MaximumValue 6.0)
-                                                   :Coordinate2 (coll/map->TilingCoordinateType {:MinimumValue 50.0}
-                                                                                :MaximumValue 26.0))]
+  (let [t1 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T1"
+                                                      :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0
+                                                                                :MaximumValue 6.0})
+                                                      :Coordinate2 (coll/map->TilingCoordinateType {:MinimumValue 10.0
+                                                                                :MaximumValue 10.0})})
+        t2 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T2"
+                                                      :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0})
+                                                      :Coordinate2 (coll/map->TilingCoordinateType {:MaximumValue 26.0})})
+        t3 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T3"
+                                                      :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 10.0
+                                                                                :MaximumValue 6.0})})
+        t4 (coll/map->TilingIdentificationSystemType {:TilingIdentificationSystemName "T4"
+                                                      :Coordinate1 (coll/map->TilingCoordinateType {:MinimumValue 0.0
+                                                                                :MaximumValue 6.0})
+                                                      :Coordinate2 (coll/map->TilingCoordinateType {:MinimumValue 50.0
+                                                                                :MaximumValue 26.0})})]
     (testing "valid tiling identification systems"
       (h/assert-valid (coll/map->UMM-C {:TilingIdentificationSystems [t1 t2]})))


added notes for know and learn

added notes for know and learn

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1177,7 +1177,7 @@
               :sem {:human true
                     :pred :I}
               :subcat '()}}]
-
+
    "if"   (let [obj (atom :top)]
             {:synsem {:cat :comp
                       :comp-type :if
@@ -1186,7 +1186,7 @@
                       ;; {:pred :unspec} is to prevent unexpected
                       ;; use of this lexeme with specifications that
                       ;; as for a given {:pred}.
-
+
                       :subcat {:1 {:cat :verb
                                    :sem obj
                                    :subcat '()}
@@ -1286,18 +1286,36 @@
    "kill" {:synsem {:cat :verb
                     :sem {:pred :kill}}}

-   "learn" {:synsem {:cat :verb
-                     :sem {:pred :learn}}}
-
-  "know" [{:english {:past "knew"
-                    :past-participle "known"}
+
+  "know" [
+
+           {:english {:past "knew"
+                      :past-participle "known"
+                      :note "s-"}
             :synsem {:cat :verb
                      :sem {:pred :know-s}}}
+
+
            {:english {:past "knew"
-                     :past-participle "known"}
-                     :synsem {:cat :verb
-                     :sem {:pred :know-c}}}]
-
+                      :note "c-"
+                      :past-participle "known"}
+            :synsem {:cat :verb
+                     :sem {:pred :know-c}}}
+
+          ]
+
+
+   "learn" [
+
+           {:english {:note "a-"}
+            :synsem  {:cat :verb
+                      :sem {:pred :learn-a}}}
+
+          {:english {:note "i-"}
+           :synsem  {:cat :verb
+                     :sem {:pred :learn-i}}}
+
+          ]

    "leave" [{:english {:past "left"}
              :synsem {:cat :verb
@@ -2812,7 +2830,7 @@
       (default
        {:english {:exception false}
         :synsem {:cat :verb}})
-
+
       (default
        {:english {:exception true}
         :synsem {:cat :verb
@@ -2826,7 +2844,7 @@
                  :infl :past
                  :sem {:aspect :perfect
                        :tense :past}}})
-
+
       ;; </verb default rules>

       ;; <prep default rules>


~small:rules-for-spec: use a cache/fifo-cache-factory rather than simply a map

--- src/babel/espanol/grammar.cljc
+++ src/babel/espanol/grammar.cljc
@@ -474,7 +474,7 @@
                         (do
                           (merge tree
                                  (morph-walk-tree tree))))
-     :rules-for-spec (atom {})
+     :rules-for-spec (atom (cache/fifo-cache-factory {} :threshold 1024))
      :tenses tenses}))

 (defn medium []


added beber

added beber

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -102,6 +102,9 @@
    "aprender" {:synsem {:cat :verb
                         :sem {:pred :learn}}}

+   "aprobar" {:synsem {:cat :verb
+                        :sem {:pred :approve}}}
+
    "aprovechar" [
                  {:synsem {:cat :verb
                            :sem {:pred :take-advantage-of}}}
@@ -122,6 +125,9 @@

    "bajar" {:synsem {:cat :verb
                      :sem {:pred :lower}}}
+
+   "beber" {:synsem {:cat :verb
+                     :sem {:pred :drink}}}

    "cambiar" {:synsem {:cat :verb
                        :sem {:pred :change}}}


s/:wait/:wait-for/

s/:wait/:wait-for/

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -57,7 +57,7 @@
                         :sem {:pred :insure}}}]

    "attendre" {:synsem {:cat :verb
-                         :sem {:pred :wait}}}
+                         :sem {:pred :wait-for}}}

    "augmenter" {:synsem {:cat :verb
                          :sem {:pred :increase}}}


Updated error code

Updated error code

--- src/clinvar_submitter/form.clj
+++ src/clinvar_submitter/form.clj
@@ -71,18 +71,21 @@
  (defn variant-identifier
   "Return variant identifier, typically the ClinGen AlleleReg id."
   [v]
-  (csv-colval (get v "CanonicalAllele")))
+  (if (nil? (get v "CanonicalAllele")) "*E-202"
+  (csv-colval (get v "CanonicalAllele"))))

   (defn variant-alt-designations
   "Return variant hgvs representations"
   [v]
-  (csv-colval (get v "alleleName name")))
+  (if (nil? (get v "alleleName name")) "*E-203"
+  (csv-colval (get v "alleleName name"))))

  (defn variant-refseq
   "Return the variant reference sequence."
   [t v]
   (let [refseq (ld-> t v "referenceCoordinate" "referenceSequence")]
-    (csv-colval (get refseq "display"))))
+    (if (nil? (get refseq "display")) "*E-204"
+    (csv-colval (get refseq "display")))))

  (defn variant-start
   "Return the variant reference sequence start pos (0-to-1-based transform)."
@@ -91,7 +94,8 @@
   (let [ref (ld-> t v "referenceCoordinate" "refAllele")
         alt (get v "allele")
         start (ld-> t v "referenceCoordinate" "start")]
-    (csv-colval (if (str/blank? ref) (get start "index") (+ 1 (get start "index"))))))
+    (if (nil? (get start "index")) "*E-205"
+    (csv-colval (if (str/blank? ref) (get start "index") (+ 1 (get start "index")))))))

  (defn variant-stop
   "Return the variant reference sequence stop pos (0-to-1-based transform)."
@@ -100,18 +104,21 @@
   (let [ref (ld-> t v "referenceCoordinate" "refAllele")
         alt (get v "allele")
         stop (ld-> t v "referenceCoordinate" "end")]
-    (csv-colval (if (and (str/blank? ref) (not (str/blank? alt))) (+ 1 (get stop "index")) (get stop "index")))))
+    (if (nil? (get stop "index")) "*E-206"
+    (csv-colval (if (and (str/blank? ref) (not (str/blank? alt))) (+ 1 (get stop "index")) (get stop "index"))))))

  (defn variant-ref
   "Return the variant ref allele sequence."
   [t v]
   (let [refcoord (ld-> t v "referenceCoordinate")]
-    (csv-colval (get refcoord "refAllele"))))
+    (if (nil? (get refcoord "refAllele")) "*E-207"
+    (csv-colval (get refcoord "refAllele")))))

  (defn variant-alt
    "Return the variant alt allele sequence."
    [v]
-   (csv-colval (get v "allele")))
+   (if (nil? (get v "allele")) "*E-208"
+   (csv-colval (get v "allele"))))

  (defn get-variant
   "Returns a map of all variant related fields needed for the clinvar


Moar sirene

Moar sirene

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -77,6 +77,7 @@
    (train-coffee :notes)
    (train-coffee :fuelpump)
    (train-coffee :alarm_clock)
+   (train-coffee :sirene)
    (train-coffee :punch)
    (train-coffee :el_kanno)
    (train-coffee :arrow_right :el_kanno)


Pick train using macro, #closes #7

Pick train using macro, #closes #7

Not weighted.. but should work..

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -15,17 +15,22 @@
                               ":sparkles:" 2
                               ":exclamation:" 1})

-(defn train [a b]
+(defn- train [a b]
   (let [front (rand-nth-weighted locomotives)
         back  (rand-nth-weighted train-endings)]
     (str front a b a b a b a back)))

-(def ^:private flat-rand (comp rand-nth flatten))
+(defmacro pick-train
+  [trains]
+  (rand-nth trains))

 (defn rand-train []
-  (flat-rand
-   [(repeat 2 (train ":coffee:" ":coffee:"))
-    (repeat 3 (train ":coffee:" ":heart:"))
+  (pick-train
+   [(train ":coffee:" ":coffee:")
+    (train ":coffee:" ":coffee:")
+    (train ":coffee:" ":heart:")
+    (train ":coffee:" ":heart:")
+    (train ":coffee:" ":heart:")
     (train ":coffeealarm:" ":coffeealarm:")
     (train ":nespresso:" ":ali:")
     (train ":ali:" ":gruff:")


Removing debugging and restoring old code.

--- src/clj/traveler/templates.clj
+++ src/clj/traveler/templates.clj
@@ -41,8 +41,7 @@
     :user-name      user-name
     :main-menu      main-menu
     :user-menu      user-menu
-    ;;; :page-content   page-content
-    :page-content   (prn-str (:helmsman request))
+    :page-content   page-content
     :extra-styles   extra-styles
     :extra-scripts  extra-scripts
     :ng-app         ng-app


fix genetic example to work with new turtle code

--- src/cljs/geometer/genetic.cljs
+++ src/cljs/geometer/genetic.cljs
@@ -4,54 +4,33 @@
             [geometer.turtle  :as t]
             [clojure.data     :refer [diff]]))

-;; (defn random-gene
-;;   "A function to return a random operation to produce variation in each generation. Repeating an operation in the vector of ops increases its likelihood."
-;;   []
-;;   (rand-nth [\F \F \F \C \+ \- \& \^ \\ \/ \| \[ \]]))
+(defn random-gene
+  "A function to return a random operation to produce variation in each generation. Repeating an operation in the vector of ops increases its likelihood."
+  []
+  (rand-nth [t/line t/line t/line t/line t/rx t/rx- t/ry t/ry- t/rz t/rz-]))
+;;  t/center

-;; (defn mesh-distance
-;;   "An extremely primitive function to calculate the difference between mesh vertices `old` and `new`. Used as a fitness function for a genetic algorithm that follows."
-;;   [old new]
-;;   (apply + (map #(apply min (map (partial g/dist %) old)) new)))
+(defn mesh-distance
+  "An extremely primitive function to calculate the difference between mesh vertices `old` and `new`. Used as a fitness function for a genetic algorithm that follows."
+  [old new]
+  (apply + (map #(apply min (map (partial g/dist %) old)) new)))

 (defn novelty-search
   "Use a novelty search genetic algorithm to produce the most 'interesting' mesh possible given these constraints."
   []
-  ;; (let [generation-size 8
-  ;;       genes-per-generation 18]
-  ;;   (loop [generations 10
-  ;;          state ls/initial-state]
-  ;;     (if (zero? generations)
-  ;;       (last state)
-  ;;       (recur (dec generations)
-  ;;              (->> (repeatedly generation-size #(repeatedly genes-per-generation random-gene))
-  ;;                   (map (partial ls/execute-ops
-  ;;                                 (constantly (m/radians 90))
-  ;;                                 (partial ls/grow-cuboid 4)
-  ;;                                 state))
-  ;;                   (map (fn [kid] (vector (mesh-distance (g/vertices (last kid))
-  ;;                                                        (g/vertices (last state)))
-  ;;                                         kid)))
-  ;;                   (apply min-key first)
-  ;;                   second)))))
-  )
-
-;;
-;; TODO
-;;
-;; (defn evolve-toroid
-;;   "Use a genetic algorithm to search for toroid-like shapes."
-;;   []
-;;   (let [generation-size 10
-;;         genes-per-generation 6]
-;;     (loop [generations 20
-;;            state [[(vec3 0 0 0)] [(vec3 0 0 0)] (gm/gmesh)]]
-;;       (.log js/console (pr-str (mesh-distance toroid (g/vertices (last state)))))
-;;       (if (or (zero? generations))
-;;         (last state)
-;;         (recur (dec generations)
-;;                (->> (repeatedly generation-size #(repeatedly genes-per-generation random-gene))
-;;                     (map (fn [ops] (execute-ops state ops #(m/radians 15) #(identity 4))))
-;;                     (map #(vector (mesh-distance toroid (g/vertices (last %))) %))
-;;                     (apply min-key first)
-;;                     second))))))
+  (let [generation-size 8
+        genes-per-generation 18]
+    (loop [generations 10
+           state t/fresh-turtle]
+      (if (zero? generations)
+        (:mesh state)
+        (recur (dec generations)
+               (->> (repeatedly generation-size
+                                #(repeatedly genes-per-generation random-gene))
+                    (map (partial t/turtle-mesh state))
+                    (map (fn [kid]
+                           (vector (mesh-distance (g/vertices kid)
+                                                  (g/vertices (:mesh state)))
+                                   (assoc state :mesh kid))))
+                    (apply min-key first)
+                    second))))))


resources.cljx edited online with Bitbucket

--- src/cljx/oxylab/resources.cljx
+++ src/cljx/oxylab/resources.cljx
@@ -6,4 +6,4 @@
    :soil {:size 0.0
           :max-size 100}
    :oxygen {:size 0.0
-            :max-size 100}})
+            :max-size 1000}})


Make sure more than two chained classes are translated.

The interop .replace will only replace the first instance of
needle. Using clojure.string/replace will swap out all instances of
needle and thus allow more than two chained classes.

--- src/clojure/freactive/dom.cljs
+++ src/clojure/freactive/dom.cljs
@@ -520,7 +520,7 @@
                  (.createElementNS js/document resolved-ns tag))
                (.createElement js/document tag))]
     (when id (set! (.-id node) id))
-    (when class (set! (.-className node) (.replace class "." " ")))
+    (when class (set! (.-className node) (clojure.string/replace class "." " ")))
     node))

 ;(defn- create-dom-node-simple [tag]


CMR-183: Added route for accessing key value in cache.

--- src/cmr/indexer/api/routes.clj
+++ src/cmr/indexer/api/routes.clj
@@ -54,26 +54,42 @@

     ;; Querying cache
     (context "/caches" []
-      (GET "/" {:keys [params]}
-        {:status 200})
+      (GET "/" {:keys [params request-context headers]}
+        (debug "Getting caches...")
+        (let [context (acl/add-authentication-to-context request-context params headers)
+              caches (keys (get-in context [:system :caches]))]
+          (acl/verify-ingest-management-permission context :read)
+          {:status 200
+           :body caches}))
       (GET "/:cache-name" {{:keys [cache-name] :as params} :params
                            request-context :request-context
                            headers :headers}
         (let [context (acl/add-authentication-to-context request-context params headers)
-              ;_ (acl/verify-ingest-management-permission context :read)
-              result (keys (get-in context [:system :caches (keyword cache-name)]))]
-          (println (str "LOOKING FOR CACHE [" (keyword cache-name) "]"))
-          (println "CACHES.....")
-          (println (get-in context [:system :caches]))
-          (when result {:status 200
-                        :body result})))
+              cache (get-in context [:system :caches (keyword cache-name)])]
+          (acl/verify-ingest-management-permission context :read)
+          (when cache
+            (let [result (-> cache
+                             :atom
+                             deref
+                             keys
+                             pr-str)]
+              {:status 200
+               :body result}))))

       (GET "/:cache-name/:cache-key" {{:keys [cache-name cache-key] :as params} :params
                                       request-context :request-context
                                       headers :headers}
-        (let [context (acl/add-authentication-to-context request-context params headers)]
+        (let [cache-key (keyword cache-key)
+              context (acl/add-authentication-to-context request-context params headers)
+              cache (get-in context [:system :caches (keyword cache-name)])
+              result (-> cache
+                         :atom
+                         deref
+                         (get cache-key))]
           (acl/verify-ingest-management-permission context :read)
-          (identity))))
+          (when result
+            {:status 200
+             :body (pr-str result)}))))

     (POST "/clear-cache" {:keys [request-context params headers]}
       (let [context (acl/add-authentication-to-context request-context params headers)]


handle reflexive verbs when conjugating imperfect

--- src/babel/espanol/morphology/verbs.clj
+++ src/babel/espanol/morphology/verbs.clj
@@ -220,7 +220,7 @@
 (defn imperfect [word & [ {usted :usted
                            vosotros :vosotros
                            ustedes :ustedes}]]
-  (let [infinitive (get-in word '(:espanol))
+  (let [infinitive (reflexive-to-infinitive (get-in word '(:espanol)))
         ar-type (try (re-find #"ar$" infinitive)
                      (catch Exception e
                        (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))


Remove page header.

Remove page header.

--- src/clj/hatnik/web/server/renderer.clj
+++ src/clj/hatnik/web/server/renderer.clj
@@ -77,9 +77,6 @@

 (defn work-main-page [req]
   (hc/html
-   [:div.page-header
-    [:h2 "Project list"]]
-
    [:div.row
     [:div.col-md-2
      [:a.btn.btn-success


trim space and underscore

trim space and underscore

--- src/cljs/bills_to_beans/documents.cljs
+++ src/cljs/bills_to_beans/documents.cljs
@@ -39,8 +39,8 @@
   (-> filename
       (string/replace date-regex "")
       (string/replace amount-regex "")
-      (string/replace #"^[ _-]" "")
-      (string/replace #"[ _-]$" "")))
+      (string/replace #"^[ _-]*" "")
+      (string/replace #"[ _-]*$" "")))

 (defn parse-filename! [data filename]
   (if-let [date (get-date-from-the-beginning filename)]


WIP add full transaction form

WIP add full transaction form

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -253,9 +253,21 @@
    [:div.pull-right
     (util/button "New"
                  (fn []
-                   (reset! transaction {:account-id (:id @account)
-                                                :entity-id (:id @state/current-entity)
-                                                :transaction-date (f/unparse (f/formatter "M/d/yyyy") (t/today))})
+                   (reset! transaction
+
+                           ; The simplified form
+                           #_{:account-id (:id @account)
+                                        :entity-id (:id @state/current-entity)
+                                        :transaction-date (f/unparse (f/formatter "M/d/yyyy")
+                                                                     (t/today))}
+
+                           ; The full form
+                           {:entity-id (:id @state/current-entity)
+                            :transaction-date (f/unparse (f/formatter "M/d/yyyy")
+                                                                     (t/today))
+                            :items [{:account-id (:id @account)
+                                     :debit-quantity nil
+                                     :credit-quantity nil}]})
                    (with-retry
                      (.focus (.getElementById js/document "transaction-date"))))
                  {:icon :plus
@@ -367,14 +379,47 @@
       (transactions/create #(handle-saved-transaction % context)
                            notify/danger)))

+(defn- item-input-row
+  [index item]
+  ^{:key (str "item-form-" index)}
+  [:tr
+   [:td "account control goes here"]
+   [:td [:input.form-control {:field :numeric
+                              :id [:items index :credit-quantity]}]]
+   [:td [:input.form-control {:field :numeric
+                              :id [:items index :debit-quantity]}]]])
+
+(defn- items-input
+  [transaction]
+  [:table.table
+   [:thead
+    [:tr
+     [:td "Account"]
+     [:td "Credit Amount"]
+     [:td "Debit Amount"]]]
+   [:tbody
+    (doall
+      (map-indexed item-input-row
+                   (:items @transaction)))]])
+
+(defn- all-items-present?
+  [transaction]
+  (every? #(some % [:credit-quantity :debit-quantity])
+          (:items transaction)))
+
 (defn- transaction-form
   [{:keys [transaction] :as context}]
   (when @transaction
     (let [form [:form
                 (text-input :transaction-date :required)
                 (text-input :description :required)
-                (number-input :quantity :required)
-                (typeahead-input
+
+                ; full
+                (items-input transaction)
+
+                ; simplified
+                #_(number-input :quantity :required)
+                #_(typeahead-input
                   :other-account-id
                   {:data-source accounts-source
                    :input-placeholder "Select the other account"
@@ -387,7 +432,20 @@
                            "Edit Transaction"
                            "New Transaction")]]
        [:div.panel-body
-        [bind-fields form transaction]
+        [bind-fields form transaction (fn [path value doc]
+
+                                        (.log js/console "doc " (prn-str doc))
+
+                                        (when (all-items-present? doc)
+                                          (swap! transaction
+                                                 update-in
+                                                 [:items]
+                                                 conj
+                                                 {:account-id nil
+                                                  :credit-quantity nil
+                                                  :debit-quantity nil})
+
+                                          (.log js/console "after add " (prn-str @transaction))))]
         (util/button "Save"
                      #(save-transaction context)
                      {:class "btn btn-primary"


cleanup

cleanup

--- src/cljs/infinitelives/utils/vec2.cljs
+++ src/cljs/infinitelives/utils/vec2.cljs
@@ -296,9 +296,13 @@

   ISeqable
   (-seq [this]
-    (for [i (range (.-length this))] (aget this i)))
+    (for [i (range (.-length this))]
+      (aget this i)))

   ASeq
   ISeq
-  (-first [this] (aget this 0))
-  (-rest [this] (for [i (range 1 (.-length this))] (aget this i))))
+  (-first [this]
+    (aget this 0))
+  (-rest [this]
+    (for [i (range 1 (.-length this))]
+      (aget this i))))


fix compatibility of request uri

fix compatibility of request uri

--- src/clojure/buddy/auth/accessrules.clj
+++ src/clojure/buddy/auth/accessrules.clj
@@ -198,7 +198,8 @@
                  (:pattern accessrule)
                  (fn [request]
                    (let [pattern (:pattern accessrule)
-                         uri (:uri request)]
+                         uri (or (:path-info request)
+                                 (:uri request))]
                      (boolean (seq (re-matches pattern uri)))))

                  (:uri accessrule)


clojure: morphism function returns pair including affine operator

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -114,7 +114,7 @@
         (let [[a b] (first q)]
           (cond
             (empty? q)
-            src2img
+            [M src2img]

             (nil? b)
             nil


Explicit long cast

Explicit long cast

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

--- src/conexp/contrib/algorithms/util.clj
+++ src/conexp/contrib/algorithms/util.clj
@@ -34,7 +34,7 @@
                    (conj! ints (nth vec current-int))))
           (recur (rest str)
                  (let [next-int (int (Character/digit ^Character next-char 10))]
-                   (+ (* 10 (max 0 current-int)) next-int))
+                   (long (+ (* 10 (max 0 current-int)) next-int)))
                  ints))))))

 ;;;


Speed up map preprocessing in nav-2d

Speed up map preprocessing in nav-2d

--- src/edu/berkeley/ai/domains/nav_2d.clj
+++ src/edu/berkeley/ai/domains/nav_2d.clj
@@ -9,27 +9,34 @@
 (defn preprocess-map
   "Returns a new, hopefully fast/compact c-space free-fn"
   [width height free-fn radius]
-  (let [offsets (for [dx (range (- radius) (inc radius)), dy (range (- radius) (inc radius))
+  (let [width (int width)
+	height (int height)
+	radius (int radius)
+	offsets (for [dx (range (- radius) (inc radius)), dy (range (- radius) (inc radius))
 		      :when (<= (+ (* dx dx) (* dy dy)) (* radius radius))]
 		  [dx dy])
-	fill-map (make-array Boolean/TYPE (* height width))
-	idx-fn   (fn [x y] (+ x (* y width)))]
+	fill-map (make-array Boolean/TYPE (* height width))]
     (doseq [y (range height), x (range width)]
-      (when (some (fn [[dx dy]]
-		    (let [nx (+ x dx)
-			  ny (+ y dy)]
-		      (or (< nx 0) (>= nx width) (< ny 0) (>= ny height) (not (free-fn [nx ny])))))
+      (let [x (int x) y (int y)]
+	(when (some (fn [[dx dy]]
+		      (let [dx (int dx)
+			    dy (int dy)
+			    nx (+ x dx)
+			    ny (+ y dy)]
+			(or (< nx 0) (>= nx width) (< ny 0) (>= ny height) (not (free-fn [nx ny])))))
 		offsets)
-	(aset-boolean fill-map (idx-fn x y) true))
+	  (aset-boolean fill-map (+ x (* y width)) true)))
 ;      (println x y (aget fill-map (idx-fn x y)))
       )
     (fn [[x y]]
-      (and (aget fill-map (idx-fn x y))
-	   (some (fn [[dx dy]]
-		   (let [nx (+ x dx), ny (+ y dy)]
-		     (if (and (>= nx 0) (< nx width) (>= ny 0) (< ny height) (not (aget fill-map (idx-fn nx ny))))
-		       true nil)))
-		 [[-1 0] [1 0] [0 -1] [0 1]])))))
+      (let [x (int x) y (int y)]
+	(and (aget fill-map (+ x (* y width)))
+	     (some (fn [[dx dy]]
+		     (let [dx (int dx) dy (int dy)
+			   nx (+ x dx), ny (+ y dy)]
+		       (if (and (>= nx 0) (< nx width) (>= ny 0) (< ny height) (not (aget fill-map (+ nx (* ny width)))))
+			 true nil)))
+		 [[-1 0] [1 0] [0 -1] [0 1]]))))))

 (let [f (util/path-local "nav_2d.pddl")]


Remove unused utility functions in 'describe' ns

--- src/main/clojure/lazytest/describe.clj
+++ src/main/clojure/lazytest/describe.clj
@@ -14,63 +14,16 @@
     [(first args) (next args)]
     [nil args]))

-(defn- firsts [coll]
-  (take-nth 2 coll))
-
-(defn- seconds [coll]
-  (take-nth 2 (drop 1 coll)))
-
-(defn- thunk-forms [forms]
-  (map (fn [f] `(fn [] ~f)) forms))
+(defn- merged-metadata [body form docstring extra-attr-map]
+  (merge (when (empty? body) {:pending true})
+	 {:nested-doc docstring, :file *file*, :ns *ns*}
+	 (meta form)
+	 extra-attr-map))

 (defn- strcat
   "Concatenate strings, with spaces in between, skipping nil."
   [& args]
   (apply str (interpose \space (remove nil? args))))
-
-(defn- merged-metadata [body form docstring extra-attr-map]
-  (merge (when (empty? body) {:pending true})
-	 {:doc docstring, :file *file*, :ns *ns*}
-	 (meta form)
-	 extra-attr-map))
-
-;;; Local Variable Scope
-
-(let [counter (atom 0)]
-  (defn- local-counter []
-    (swap! counter inc)))
-
-(defmacro bind-local
-  "Establishes a local binding of sym to the state returned by local-scope
-  c in all groups and examples found within body."
-  [form c & body]
-  `(let [~(with-meta (gensym) {::local true
-			       ::order (local-counter)
-			       ::arg form}) ~c]
-     ~@body))
-
-(defmacro wrap-local-scope
-  "Recursively creates local bindings for each pair in bindings vector."
-  [bindings body]
-  {:pre [(or (vector? bindings) (nil? bindings))
-         (even? (count bindings))]}
-  (if (seq bindings)
-    `(bind-local ~(first bindings) ~(second bindings)
-       (wrap-local-scope ~(vec (nnext bindings)) ~body))
-    body))
-
-(defn- find-locals
-  "Returns a vector of locals bound by bind-local in the
-  environment."
-  [env]
-  (vec (sort-by #(::order (meta %))
-                (filter #(::local (meta %)) (keys env)))))
-
-(defn- find-local-binding-forms
-  "Returns a vector of the function argument forms of locals bound by
-  bind-local in the environment."
-  [env]
-  (vec (map #(::arg (meta %)) (find-locals env))))

 ;;; Top-level definitions


creating macro for easier default positional args

--- server/src/gratefulplace/utils.clj
+++ server/src/gratefulplace/utils.clj
@@ -47,4 +47,33 @@

 (defn now
   []
-  (java.util.Date.))+  (java.util.Date.))
+
+
+
+(defn argperms
+  "Used to create all argument permutations for defnd"
+  [arglist]
+  (let [[base defaulted] (split-with (comp not vector?) arglist)
+        argcount (count arglist)]
+    (loop [defaulted defaulted
+           base {:argnames (into [] base)
+                 :application (into [] (concat base (map second defaulted)))}
+           arglists [base]]
+      (if (empty? defaulted)
+        arglists
+        (let [position (- argcount (count defaulted))
+              argname (ffirst defaulted)
+              new-base {:argnames (conj (:argnames base) argname)
+                        :application (assoc (:application base) position argname)}]
+          (recur (rest defaulted) new-base (conj arglists new-base)))))))
+
+(defmacro defnd
+  ;; defn with default arguments
+  [name args & body]
+  (let [arglists (reverse (argperms args))]
+    `(defn ~name
+       (~(:argnames (first arglists))
+        ~@body)
+       ~@(map #(list (:argnames %) (:application %))
+              (rest arglists)))))


hface-client to 3.12.1

hface-client to 3.12.1

--- client/project.clj
+++ client/project.clj
@@ -1,4 +1,4 @@
-(defproject org.hface/hface-client "0.1.5"
+(defproject org.hface/hface-client "0.1.6"
   :description "look your Hazelcast cluster in the face!"
   :url "https://github.com/tolitius/hface"
   :license {:name "Eclipse Public License"
@@ -6,14 +6,14 @@

   :java-source-paths ["src/java"]

-  :dependencies [[com.hazelcast/hazelcast "3.9"]]
+  :dependencies [[com.hazelcast/hazelcast "3.12.1"]]

   ;; ceremony for maven central

   :scm {:name "git"
         :url "https://github.com/tolitius/hface.git"}

-  :pom-addition [:developers [:developer
+  :pom-addition [:developers [:developer
                                [:id "tolitius"]
                                [:name "Anatoly"]
                                [:url "https://github.com/tolitius"]]]
@@ -22,7 +22,7 @@
                                     :creds :gpg}
                         "snapshots" {:url "https://oss.sonatype.org/content/repositories/snapshots/"
                                      :creds :gpg}}
-
+
   :classifiers {:javadoc {:java-source-paths ^:replace ["src/java"]
                           :source-paths ^:replace []
                           :resource-paths ^:replace []}


Failed BookKeeper writes now reboot the peer #390

Also closes #500 by improving performance of write-take-batch

--- src/onyx/state/log/bookkeeper.clj
+++ src/onyx/state/log/bookkeeper.clj
@@ -2,7 +2,8 @@
   (:require [onyx.log.curator :as curator]
             [taoensso.timbre :refer [info error warn trace fatal] :as timbre]
             [com.stuartsierra.component :as component]
-            [clojure.core.async :refer  [chan timeout thread go >! <! <!! >!! alts!! close!]]
+            [clojure.core.async :refer [chan timeout thread go >! <! <!! >!! alts!! close! poll!]]
+            [clojure.core.async.impl.protocols :refer [closed?]]
             [onyx.compression.nippy :as nippy]
             [onyx.extensions :as extensions]
             [onyx.monitoring.measurements :refer [emit-latency-value emit-latency]]
@@ -63,11 +64,11 @@

 (def HandleWriteCallback
   (reify AsyncCallback$AddCallback
-    (addComplete [this rc lh entry-id ack-fn]
+    (addComplete [this rc lh entry-id [success-fn fail-fn]]
       (if (= rc (BKException$Code/OK))
-        (ack-fn)
-        ;; TODO: should restart peer, see https://github.com/onyx-platform/onyx/issues/390
-        (warn "Unable to complete async write to bookkeeper. BookKeeper exception code:" rc)))))
+        (success-fn)
+        (do (warn "Unable to complete async write to bookkeeper. BookKeeper exception code:" rc)
+            (fail-fn))))))

 (defn compaction-transition
   "Transitions to a new compacted ledger, plus a newly created ledger created
@@ -107,56 +108,51 @@
           (.asyncAddEntry compacted-ledger
                           compacted-serialized
                           HandleWriteCallback
-                          (fn []
-                            (close-handle previous-handle)
-                            (emit-latency-value :window-log-compaction monitoring (- (System/currentTimeMillis) start-time))
-                            (>!! outbox-ch
-                                 {:fn :compact-bookkeeper-log-ids
-                                  :args {:job-id job-id
-                                         :task-id task-id
-                                         :slot-id slot-id
-                                         :peer-id id
-                                         :prev-ledger-ids (vec (butlast current-ids))
-                                         :new-ledger-ids [compacted-ledger-id]}}))))))))
-
-(defn ch->type [ch batch-ch timeout-ch kill-ch task-kill-ch]
-  (cond (= ch timeout-ch)
-        :timeout
-        (or (= ch kill-ch) (= ch task-kill-ch))
-        :shutdown
-        :else
-        :read))
-
-(defn take-write-batch [peer-opts batch-ch kill-ch task-kill-ch]
-  (let [batch-size (arg-or-default :onyx.bookkeeper/write-batch-size peer-opts)
-        timeout-ms (arg-or-default :onyx.bookkeeper/write-batch-timeout peer-opts)
-        timeout-ch (timeout timeout-ms)]
-    (loop [entries [] ack-fns [] i 0]
-      (if (< i batch-size)
-        (let [[[entry ack-fn] ch] (alts!! [kill-ch task-kill-ch batch-ch timeout-ch] :priority true)]
-          (if entry
-            (recur (conj entries entry)
-                   (conj ack-fns ack-fn)
-                   (inc i))
-            (let [msg-type (ch->type ch batch-ch timeout-ch kill-ch task-kill-ch)]
-              [msg-type entries ack-fns])))
-        [:read entries ack-fns]))))
-
-(defn process-batches [{:keys [ledger-handle next-ledger-handle batch-ch] :as log}
+                          (list (fn []
+                                  (close-handle previous-handle)
+                                  (emit-latency-value :window-log-compaction monitoring (- (System/currentTimeMillis) start-time))
+                                  (>!! outbox-ch
+                                       {:fn :compact-bookkeeper-log-ids
+                                        :args {:job-id job-id
+                                               :task-id task-id
+                                               :slot-id slot-id
+                                               :peer-id id
+                                               :prev-ledger-ids (vec (butlast current-ids))
+                                               :new-ledger-ids [compacted-ledger-id]}}))
+                                (fn []
+                                  (close! (:onyx.core/restart-ch event))))))))))
+
+(defn take-write-batch [batch-size batch-ch]
+  (loop [entries [] ack-fns [] i 0]
+    (if (< i batch-size)
+      (let [[entry ack-fn] (poll! batch-ch)]
+        (if entry
+          (recur (conj entries entry)
+                 (conj ack-fns ack-fn)
+                 (inc i))
+          [entries ack-fns]))
+      [entries ack-fns])))
+
+(defn process-batches [{:keys [ledger-handle next-ledger-handle batch-ch] :as log}
                        {:keys [onyx.core/kill-ch onyx.core/task-kill-ch onyx.core/peer-opts] :as event}]
-  (thread
-    (loop [[result batch ack-fns] (take-write-batch peer-opts batch-ch kill-ch task-kill-ch)]
-      ;; Safe point to transition to the next ledger handle
-      (when @next-ledger-handle
-        (compaction-transition log event))
-      (when-not (empty? batch)
-        (.asyncAddEntry ^LedgerHandle @ledger-handle
-                        ^bytes (nippy/window-log-compress batch)
-                        HandleWriteCallback
-                        (fn [] (run! (fn [f] (f)) ack-fns))))
-      (if-not (= :shutdown result)
-        (recur (take-write-batch peer-opts batch-ch kill-ch task-kill-ch))))
-    (info "BookKeeper: shutting down batch processing")))
+  (thread
+    (let [batch-size (arg-or-default :onyx.bookkeeper/write-batch-size peer-opts)
+          batch-backoff (arg-or-default :onyx.bookkeeper/write-batch-backoff peer-opts)]
+      (loop [[batch ack-fns] (take-write-batch batch-size batch-ch)]
+        ;; Safe point to transition to the next ledger handle
+        (when @next-ledger-handle
+          (compaction-transition log event))
+        (if (empty? batch)
+          (Thread/sleep batch-backoff)
+          (.asyncAddEntry ^LedgerHandle @ledger-handle
+                          ^bytes (nippy/window-log-compress batch)
+                          HandleWriteCallback
+                          (list (fn [] (run! (fn [f] (f)) ack-fns))
+                                (fn [] (close! (:onyx.core/restart-ch event))))))
+        (if (and (not (closed? kill-ch))
+                 (not (closed? task-kill-ch)))
+          (recur (take-write-batch batch-size batch-ch)))))
+          (info "BookKeeper: shutting down batch processing")))

 (defn assign-bookkeeper-log-id-spin [{:keys [onyx.core/peer-opts
                                              onyx.core/job-id onyx.core/task-id
@@ -170,10 +166,16 @@
                  :task-id task-id
                  :slot-id slot-id
                  :ledger-id new-ledger-id}})
-    (while (and (first (alts!! [kill-ch task-kill-ch] :default true))
-                (not= new-ledger-id (last (event->ledger-ids event))))
-      (info "New ledger id has not been published yet. Backing off.")
-      (Thread/sleep (arg-or-default :onyx.bookkeeper/ledger-id-written-back-off peer-opts)))))
+    (loop []
+      (let [exit? (nil? (first (alts!! [kill-ch task-kill-ch] :default true)))
+            not-added? (not= new-ledger-id (last (event->ledger-ids event)))]
+        (cond exit?
+              (info "Exiting assign-bookkeeper-log-id-spin early as peer has been reassigned.")
+              not-added?
+              (do
+                (info "New ledger id has not been published yet. Backing off.")
+                (Thread/sleep (arg-or-default :onyx.bookkeeper/ledger-id-written-back-off peer-opts))
+                (recur)))))))

 (defmethod state-extensions/initialize-log :bookkeeper [log-type {:keys [onyx.core/peer-opts] :as event}]
   (let [bk-client (bookkeeper peer-opts)
@@ -268,7 +270,8 @@
 (defmethod state-extensions/close-log onyx.state.log.bookkeeper.BookKeeperLog
   [{:keys [client ledger-handle next-ledger-handle]} event]
   (try
-    (close-handle @ledger-handle)
+    (when @ledger-handle
+      (close-handle @ledger-handle))
     (when @next-ledger-handle
       (close-handle @next-ledger-handle))
     (catch Throwable t


CMR-4495 - Added missing integration test for variable cascade delete.

--- metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/force_delete_test.clj
+++ metadata-db-app/int_test/cmr/metadata_db/int_test/concepts/force_delete_test.clj
@@ -19,6 +19,10 @@
 (defmethod cs-spec/gen-concept :service
   [_ provider-id uniq-num attributes]
   (util/service-concept provider-id uniq-num attributes))
+
+(defmethod cs-spec/gen-concept :variable
+  [_ provider-id uniq-num attributes]
+  (util/variable-concept provider-id uniq-num attributes))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Tests
@@ -124,3 +128,52 @@
                              "does not exist.")
                         svc-concept-id non-extant-revision)]
                (:errors response)))))))
+
+(deftest force-delete-variable-with-associations
+  (let [coll (util/create-and-save-collection "REG_PROV" 1)
+        coll-concept-id (:concept-id coll)
+        var-concept (util/create-and-save-variable "REG_PROV" 1 3)
+        var-concept-id (:concept-id var-concept)
+        var-assn (util/create-and-save-variable-association
+                  coll var-concept 1)
+        var-assn-concept-id (:concept-id var-assn)]
+    (testing "initial conditions"
+      ;; creation results as expected
+      (is (= 3 (:revision-id var-concept)))
+      ;; variable revisions in db
+      (is (= 3
+             (count (:concepts (util/find-concepts :variable)))))
+      (is (= 200 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 3))))
+      (is (= 200 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 2))))
+      ;; make sure variable association in place
+      (is (= coll-concept-id
+             (get-in var-assn [:extra-fields :associated-concept-id])))
+      (is (= var-concept-id
+             (get-in var-assn [:extra-fields :variable-concept-id])))
+      ;; make sure collection associations in place
+      (is (not (:deleted (:concept (util/get-concept-by-id var-assn-concept-id))))))
+    (testing "just the last revision is deleted"
+      (util/force-delete-concept var-concept-id 2)
+      (is (= 200 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 3))))
+      (is (= 404 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 2))))
+      ;; verify the association hasn't been deleted
+      (is (not (:deleted (:concept (util/get-concept-by-id var-assn-concept-id))))))
+    (testing "just the most recent revision is deleted"
+      (util/force-delete-concept var-concept-id 3)
+      (is (= 404 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 3))))
+      (is (= 404 (:status (util/get-concept-by-id-and-revision
+                           var-concept-id 2))))
+      (is (:deleted (:concept (util/get-concept-by-id var-assn-concept-id)))))
+    (testing "cannot delete non-existing revision"
+      (let [non-extant-revision 4
+            response (util/force-delete-concept var-concept-id non-extant-revision)]
+        (is (= 404 (:status response)))
+        (is (= [(format (str "Concept with concept-id [%s] and revision-id [%s] "
+                             "does not exist.")
+                        var-concept-id non-extant-revision)]
+               (:errors response)))))))


Extract set-offset logic into own fn. Prevent image dragging

--- src/simple_om_draggable/core.cljs
+++ src/simple_om_draggable/core.cljs
@@ -19,13 +19,16 @@

 ;;; Handlers

-(defn- handle-start [e owner]
-  ;; save the offset in local state
+(defn- set-offset [e owner]
   (let [client-offset {:left (.-clientX e)
                        :top (.-clientY e)}
         elem-pos (om/get-state owner :position)
         offset (merge-with - client-offset elem-pos)]
-    (om/set-state! owner :offset offset))
+    (om/set-state! owner :offset offset)))
+
+(defn- handle-start [e owner]
+  ;; save the offset (cursor pos inside element pos) in local state
+  (set-offset e owner)
   ;; start listening to global mouse events
   (tap global-mouse-chan (om/get-state owner :mouse-chan)))

@@ -89,7 +92,8 @@
             :top (get-in state [:position :top])
             :left (get-in state [:position :left])
             :user-select "none" :-webkit-user-select "none" :-moz-user-select "none" }
-           :on-mouse-down #(put! (:mouse-chan state) (.-nativeEvent %))}
+           :on-mouse-down #(put! (:mouse-chan state) (.-nativeEvent %))
+           :on-drag-start #(.preventDefault %)}

           ;; invisible overlay div to block e.g. clicks on links
           (dom/div {:style {:position "absolute"


🔊 Log projection refreshes unconditionally

Why:
- During the development there was a bug which caused an infinite loop
  in the refresh, which was hard to observe without logging.

--- src/territory_bro/projections.clj
+++ src/territory_bro/projections.clj
@@ -72,6 +72,7 @@
     (seq transient-events)))

 (defn refresh! []
+  (log/info "Refreshing projections")
   (let [[old new] (swap-vals! *cache (fn [cached]
                                        ;; Though this reads the database and is thus a slow
                                        ;; operation, retries on updating the atom should not


Update process_lisp.clj

Update process_lisp.clj

--- src/iyye/bios/process_lisp.clj
+++ src/iyye/bios/process_lisp.clj
@@ -31,8 +31,8 @@

 (defn process-lispy-control [tree input IO]
   (let [cmd (first tree)
-        params (for [cur (rest tree)] (if (seq? cur) (process-lispy-control cur (str cur) IO) cur))]
-    ;    (println "processing" cmd)
+        params (for [cur (rest tree)]
+                 (if (seq? cur) (process-lispy-control cur (str cur) IO) cur))]
     (if cmd
       (dorun (scwords/action cmd params IO))
       (future (Thread/sleep 500) (ioframes/process-output IO (str "failed to parse: " input))))))


Use reset! instead of swap! for model/set-state

--- src/text_justification/model.cljs
+++ src/text_justification/model.cljs
@@ -21,7 +21,7 @@

 (defonce state (atom []))

-(defn- set-state    [new-state] (swap! state (fn [] new-state))) ;; TODO just use reset!
+(defn- set-state    [new-state] (reset! state new-state))
 (defn- clear-state  [] (set-state []))
 (defn- update-state [new-lines] (set-state (concat @state new-lines)))


Log IRC connection details on connect

Log IRC connection details on connect

--- src/yetibot/core/adapters/irc.clj
+++ src/yetibot/core/adapters/irc.clj
@@ -3,7 +3,7 @@
     [schema.core :as s]
     [clojure.set :refer [difference union intersection]]
     [yetibot.core.adapters.adapter :as a]
-    [taoensso.timbre :as log :refer [info]]
+    [taoensso.timbre :as log :refer [info debug]]
     [rate-gate.core :refer [rate-limit]]
     [irclj
      [core :as irc]
@@ -177,14 +177,17 @@
           [k (partial v adapter)])))

 (defn connect [{:keys [config conn] :as a}]
-  (reset!
-    conn
-    (irc/connect
-      (or (:host config) "irc.freenode.net")
-      (read-string (or (:port config) "6667"))
-      (or (:username config) (str "yetibot_" (rand-int 1000)))
-      :ssl? (boolean (:ssl config))
-      :callbacks (callbacks a))))
+  (let [username (or (:username config) (str "yetibot_" (rand-int 1000)))
+        host (or (:host config) "irc.freenode.net")
+        port (read-string (or (:port config) "6667"))
+        ssl? (boolean (:ssl config))]
+    (info "Connecting to IRC"
+          {:host host :port port :ssl? ssl? :username username})
+    (reset!
+      conn
+      (irc/connect host port username
+                   :ssl? ssl?
+                   :callbacks (callbacks a)))))

 (defn join-or-part-with-current-channels
   "Determine the diff between current-channels and configured channels to
@@ -195,9 +198,9 @@
         to-part (difference @current-channels configured-rooms)
         to-join (difference configured-rooms @current-channels)]
     (info "configured-rooms" configured-rooms)
-    (info "channels" @current-channels)
-    (info "to-part" to-part)
-    (info "to-join" to-join)
+    (debug "channels" @current-channels)
+    (debug "to-part" to-part)
+    (debug "to-join" to-join)
     (reset! current-channels configured-rooms)
     (doall (map #(irc/join @conn %) to-join))
     (doall (map #(irc/part @conn %) to-part))


Fix find-user-like in users

Fix find-user-like in users

--- src/yetibot/core/models/users.clj
+++ src/yetibot/core/models/users.clj
@@ -92,10 +92,10 @@
   (@users {:adapter (:adapter source) :id id}))

 (defn find-user-like [chat-source name]
-  (let [patt (re-pattern (str "(?i)" name))]
-    (some #(when (re-find patt (:name %)) %)
-          (vals (get-users chat-source)))))
-
+  (let [us (filter (fn [[k user]] (= (:adapter k) (:adapter chat-source)))
+                   @users)
+        patt (re-pattern (str "(?i)" name))]
+    (some (fn [[k v]] (when (re-find patt (:name v)) v)) us)))

 ; (def campfire-date-pattern "yyyy/MM/dd HH:mm:ss Z")
 ; (def date-formatter (doto (new SimpleDateFormat campfire-date-pattern) (.setTimeZone (java.util.TimeZone/getTimeZone "GreenwichEtc"))))


Baka. Fist color

Baka. Fist color

--- src/leap_step/example/wubs.clj
+++ src/leap_step/example/wubs.clj
@@ -43,73 +43,77 @@
                   475 (live/ctl dubs :wobble 16)
                   "No Zone"))
             (do (swap! my-rgb (fn [x] [0 0 1]))
-                (live/ctl dubs :wob-vol 0)))
+                (live/ctl dubs :wob-vol 0)
+                (live/ctl dubs :wob4-vol 0)
+                (live/ctl dubs :chord-vol 0)))

-          (if-not (hand/fist? low-hand)
-            (condp > x
-              -300 "No Zone"
-              -150 (live/ctl dubs :note 34 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
-              0 (live/ctl dubs :note 37 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
-              150 (live/ctl dubs :note 39 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
-              300 (live/ctl dubs :note 42 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
-              "No Zone")
-            (condp > x
-              -300 "No Zone"
-              -125 (live/ctl dubs :note 58 :chord-vol 1 :wob4-vol 0)
-              0 (live/ctl dubs :note 61 :chord-vol 1 :wob4-vol 0)
-              150 (live/ctl dubs :note 63 :chord-vol 1 :wob4-vol 0)
-              300 (live/ctl dubs :note 68 :chord-vol 1 :wob4-vol 0)
-              "No Zone")))
-        :else
-        (let [lefthand (leap/leftmost-hand frame)
-              pos1 (hand/palm-position lefthand)
-              x1 (.getX pos1)
-              y1 (.getY pos1)
-              z1 (.getZ pos1)
-              righthand (leap/rightmost-hand frame)
-              pos2 (hand/palm-position righthand)
-              x2 (.getX pos2)
-              y2 (.getY pos2)
-              z2 (.getZ pos2)]
-          (swap! my-rgb (fn [x] [0 1 0]))
-          (when (and (< z1 150) (< z2 150))
-            (println (- x1 x2))
-            (condp > y1
-              ; "No Zone"
-              100 (live/ctl dubs :wobble 1)
-              175 (live/ctl dubs :wobble 2)
-              250 (live/ctl dubs :wobble 4)
-              325 (live/ctl dubs :wobble 8)
-              400 (live/ctl dubs :wobble 12)
-              475 (live/ctl dubs :wobble 16)
-              "No Zone")
+            (if-not (hand/fist? low-hand)
+              (do (swap! my-rgb (fn [x] [1 0 0]))
+                (condp > x
+                  -300 "No Zone"
+                  -150 (live/ctl dubs :note 34 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
+                  0 (live/ctl dubs :note 37 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
+                  150 (live/ctl dubs :note 39 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
+                  300 (live/ctl dubs :note 42 :chord-vol 0 :wob4-vol 0 :wob-vol 1)
+                  "No Zone"))
+              (do (swap! my-rgb (fn [x] [0 1 1]))
+                (condp > x
+                  -300 "No Zone"
+                  -125 (live/ctl dubs :note 58 :chord-vol 1 :wob4-vol 0)
+                  0 (live/ctl dubs :note 61 :chord-vol 1 :wob4-vol 0)
+                  150 (live/ctl dubs :note 63 :chord-vol 1 :wob4-vol 0)
+                  300 (live/ctl dubs :note 68 :chord-vol 1 :wob4-vol 0)
+                  "No Zone"))))
+          :else
+          (let [lefthand (leap/leftmost-hand frame)
+                pos1 (hand/palm-position lefthand)
+                x1 (.getX pos1)
+                y1 (.getY pos1)
+                z1 (.getZ pos1)
+                righthand (leap/rightmost-hand frame)
+                pos2 (hand/palm-position righthand)
+                x2 (.getX pos2)
+                y2 (.getY pos2)
+                z2 (.getZ pos2)]
+            (swap! my-rgb (fn [x] [0 1 0]))
+            (when (and (< z1 150) (< z2 150))
+              (println (- x1 x2))
+              (condp > y1
+                ; "No Zone"
+                100 (live/ctl dubs :wobble 1)
+                175 (live/ctl dubs :wobble 2)
+                250 (live/ctl dubs :wobble 4)
+                325 (live/ctl dubs :wobble 8)
+                400 (live/ctl dubs :wobble 12)
+                475 (live/ctl dubs :wobble 16)
+                "No Zone")

-            (condp > (- x1 x2)
-              -700 "No Zone"
-              -400 (live/ctl dubs :note 34 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
-              -300 (live/ctl dubs :note 37 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
-              -150 (live/ctl dubs :note 39 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
-              -80 (live/ctl dubs :note 42 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
-              "No Zone"))))))
+              (condp > (- x1 x2)
+                -700 "No Zone"
+                -400 (live/ctl dubs :note 34 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
+                -300 (live/ctl dubs :note 37 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
+                -150 (live/ctl dubs :note 39 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
+                -80 (live/ctl dubs :note 42 :chord-vol 0 :wob4-vol 1 :wob-vol 1.5)
+                "No Zone"))))))

-;(cond
-;(not (leap/hands? frame)) (do (live/ctl dubs :note 50 :wobble 1))
-;(leap/single-hand? frame) (do (live/ctl dubs :note 32 :wobble 4))
-;:else (do (live/ctl dubs :note 62 :wobble 8))))
+  ;(cond
+  ;(not (leap/hands? frame)) (do (live/ctl dubs :note 50 :wobble 1))
+  ;(leap/single-hand? frame) (do (live/ctl dubs :note 32 :wobble 4))
+  ;:else (do (live/ctl dubs :note 62 :wobble 8))))

-(defn -main [& args]
-  (let [dubs (popular/dubstep 34 120 4)
-        listener (leap/listener :frame #(process-frame (:frame %) dubs)
-                                :default #(println "Toggling" (:state %) "for listener:" (:listener %)))
-        [controller _] (leap/controller listener)]
-    ;    (read-line)
-    ;    (swap! my-rgb (fn [x] [0 0 1]))
-    ;    (read-line)
-    ;    (swap! my-rgb (fn [x] [1 0 0]))
-    ;    (read-line)
-    ;    (swap! my-rgb (fn [x] [0 1 1]))
-    (println "Press Enter to quit")
-    (read-line)
-    (leap/remove-listener! controller listener)))
+  (defn -main [& args]
+    (let [dubs (popular/dubstep 34 120 4)
+          listener (leap/listener :frame #(process-frame (:frame %) dubs)
+                                  :default #(println "Toggling" (:state %) "for listener:" (:listener %)))
+          [controller _] (leap/controller listener)]
+      ;    (read-line)
+      ;    (swap! my-rgb (fn [x] [0 0 1]))
+      ;    (read-line)
+      ;    (swap! my-rgb (fn [x] [1 0 0]))
+      ;    (read-line)
+      ;    (swap! my-rgb (fn [x] [0 1 1]))
+      (println "Press Enter to quit")
+      (read-line)
+      (leap/remove-listener! controller listener)))


Stop one character earlier

Stop one character earlier

--- src/advent_2016/day_5/part_2.cljs
+++ src/advent_2016/day_5/part_2.cljs
@@ -33,6 +33,6 @@
       (if (seen ndx)
         (recur seen (rest candidates) result)
         (let [result (assoc result ndx (code-str candidate))]
-          (if (== 8 (count seen))
+          (if (== 7 (count seen))
             (apply str result)
             (recur (conj seen ndx) (rest candidates) result)))))))


Proper metadata handling in jenkins-api module

--- src/emender_jenkins/jenkins_api.clj
+++ src/emender_jenkins/jenkins_api.clj
@@ -110,11 +110,21 @@
             (.printStackTrace e)
             (error-response-structure job-name command e))))

+(defn replace-placeholder
+    [string placeholder-name value]
+    (if value
+        (clojure.string/replace string (str "<placeholder id=\"" placeholder-name "\" />") value)
+        string))
+
 (defn update-template
-    [template git-repo branch]
+    [template git-repo branch metadata]
     (-> template
-        (clojure.string/replace "<placeholder id=\"git-repo\" />" git-repo)
-        (clojure.string/replace "<placeholder id=\"git-branch\" />" (str "*/" branch))))
+        (replace-placeholder "git-repo"                   git-repo)
+        (replace-placeholder "git-branch"                 (str "*/" branch))
+        (replace-placeholder "metadata-language"          (get metadata :language))
+        (replace-placeholder "metadata-environment"       (get metadata :environment))
+        (replace-placeholder "metadata-content-directory" (get metadata :content_directory))
+        (replace-placeholder "metadata-content-type"      (get metadata :content_type))))

 (defn start-job
     [jenkins-url jenkins-auth include-jenkins-reply? job-name]
@@ -133,11 +143,12 @@
     (job-related-command jenkins-url jenkins-auth include-jenkins-reply? job-name "doDelete"))

 (defn log-operation
-    [job-name git-repo branch operation]
+    [job-name git-repo branch operation metadata]
     (println "***" operation "***")
     (println "job-name" job-name)
     (println "git-repo" git-repo)
-    (println "branch"   branch))
+    (println "branch"   branch)
+    (println "metadata" metadata))

 (defn send-configuration-xml-to-jenkins
     [url config]
@@ -151,14 +162,15 @@

 (defn get-template
     [metadata]
-    (slurp (if metadata "data/template.xml" "data/template_with_metadata.xml")))
+    (slurp (if metadata "data/template_with_metadata.xml" "data/template.xml")))

 (defn create-job
     [jenkins-url jenkins-auth include-jenkins-reply? job-name git-repo branch metadata]
-    (log-operation job-name git-repo branch "create")
+    (log-operation job-name git-repo branch "create" metadata)
     (let [template (get-template metadata)
           config   (update-template template git-repo branch metadata)
           url      (str (update-jenkins-url jenkins-url jenkins-auth) "createItem?name=" (.replaceAll job-name " " "%20"))]
+          (spit "x.xml" config)
           (println "URL to use: " url)
           (try
               (->> (send-configuration-xml-to-jenkins url config)
@@ -169,7 +181,7 @@

 (defn update-job
     [jenkins-url jenkins-auth include-jenkins-reply? job-name git-repo branch metadata]
-    (log-operation job-name git-repo branch "update")
+    (log-operation job-name git-repo branch "update" metadata)
     (let [template (get-template metadata)
           config   (update-template template git-repo branch metadata)
           url      (str (job-name->url (update-jenkins-url jenkins-url jenkins-auth) job-name) "/config.xml")]


Get rid of update-context!

Get rid of update-context!

--- src/fhofherr/simple/engine/jobs.clj
+++ src/fhofherr/simple/engine/jobs.clj
@@ -50,7 +50,8 @@
 (defn alter-job-execution!
   "Apply the function `f` to the execution with id `exec-id` in the job
   descriptor's vector of executions. Replace the old value by the job
-  execution returned by `f`."
+  execution returned by `f`. `f` is executed *outside* of a transaction
+  and may have side-effects."
   [job-desc exec-id f & args]
   (let [apply-f (fn [exec]
                   {:post [(job-ex/job-execution? %)]}
@@ -66,12 +67,46 @@
         (alter $ assoc exec-id new-exec))))
   job-desc)

-(defn- update-context!
-  [job-desc exec-id f & args]
-  (alter-job-execution! job-desc
-                         exec-id
-                         (fn [exec]
-                           (update-in exec [:context] #(apply f % args)))))
+(defn execute-job!
+  "Synchronously execute the job execution with id `exec-id`. See
+  [[schedule-job!]] for asynchronous job execution. "
+  [job-desc exec-id]
+  (let [job-fn #(io! ((:job-fn job-desc) %))]
+    (log/info "Starting execution" exec-id "of job" (:job-var job-desc))
+    (-> job-desc
+      (alter-job-execution! exec-id job-ex/mark-executing)
+      (alter-job-execution! exec-id job-ex/update-context job-fn)
+      (alter-job-execution! exec-id job-ex/mark-finished))
+    (log/info "Finished execution" exec-id "of job" (:job-var job-desc))))
+
+(defn schedule-job-execution!
+  "Schedules the job execution identified by `exec-id` by sending it
+  to the job descriptor's `:executor` using `send-off`.
+
+  Returns the otherwise unchaged `job-desc` passed into the function."
+  [job-desc exec-id]
+  (letfn [(do-execute [last-exec-id]
+            {:pre [(< last-exec-id exec-id)]}
+            (execute-job! job-desc exec-id)
+            exec-id)]
+    (log/info "Queueing execution" exec-id "of job" (:job-var job-desc))
+    (alter-job-execution! job-desc exec-id job-ex/mark-queued)
+    ;; Jobs catch any Throwable thrown by the job steps and do not
+    ;; rethrow it. The executor should thus never fail under normal
+    ;; conditions.
+    (send-off (:executor job-desc) do-execute)
+    job-desc))
+
+;; TODO pass job execution instead of initial context
+(defn schedule-job!
+  "Create a new job execution using [[add-job-execution!]] and immediately
+  schedule it using [[schedule-job-execution!]]. Return the job execution's
+  id."
+  [job-desc initial-ctx]
+  (let [exec-id (add-job-execution! job-desc
+                                    (job-ex/make-job-execution initial-ctx))]
+    (schedule-job-execution! job-desc exec-id)
+    exec-id))

 (defn get-job-execution
   "Obtain the job execution with id `exec-id` from the job descriptor
@@ -84,54 +119,6 @@
   if no job has been executed yet."
   [job-desc]
   (get-job-execution job-desc @(:executor job-desc)))
-
-(defn execute-job!
-  "Synchronously execute the job execution with id `exec-id`. See
-  [[schedule-job!]] for asynchronous job execution. "
-  [job-desc exec-id]
-  (letfn [(apply-job-fn [job-fn exec] (job-fn (:context exec)))]
-    (log/info "Starting execution" exec-id "of job" (:job-var job-desc))
-    (alter-job-execution! job-desc exec-id job-ex/mark-executing)
-    (let [exec (get-job-execution job-desc exec-id)
-          ;; Do not apply the job fn within a transaction (e.g. by using
-          ;; update-context!). This would re-execute the tests if commiting
-          ;; the transaction fails.
-          new-ctx (apply-job-fn (:job-fn job-desc) exec)]
-      (log/info "Finished execution" exec-id "of job" (:job-var job-desc))
-      (dosync
-        ;; Replace the old context with new-ctx.
-        (update-context! job-desc exec-id (constantly new-ctx))
-        (alter-job-execution! job-desc exec-id job-ex/mark-finished)))))
-
-(defn schedule-job-execution!
-  "Schedules the job execution identified by `exec-id` by sending it
-  to the job descriptor's `:executor` using `send-off`.
-
-  Returns the otherwise unchaged `job-desc` passed into the function."
-  [job-desc exec-id]
-  (letfn [(do-execute [last-exec-id]
-            {:pre [(< last-exec-id exec-id)]}
-            (execute-job! job-desc exec-id)
-            exec-id)]
-    (log/info "Queueing execution" exec-id "of job" (:job-var job-desc))
-    (dosync
-      (alter-job-execution! job-desc exec-id job-ex/mark-queued)
-      ;; Jobs catch any Throwable thrown by the job steps and do not
-      ;; rethrow it. The executor should thus never fail under normal
-      ;; conditions.
-      (send-off (:executor job-desc) do-execute))
-    job-desc))
-
-;; TODO pass job execution instead of initial context
-(defn schedule-job!
-  "Create a new job execution using [[add-job-execution!]] and immediately
-  schedule it using [[schedule-job-execution!]]. Return the job execution's
-  id."
-  [job-desc initial-ctx]
-  (let [exec-id (add-job-execution! job-desc
-                                    (job-ex/make-job-execution initial-ctx))]
-    (schedule-job-execution! job-desc exec-id)
-    exec-id))

 (defn- apply-to-last-execution
   "Apply the function `f` to the last job execution of `job-desc`. Return


Add recent following link to org response.

--- src/oc/storage/representations/org.clj
+++ src/oc/storage/representations/org.clj
@@ -55,6 +55,9 @@

 (defn- following-link [org]
   (hateoas/link-map "following" hateoas/GET (str (url org) "/entries?following=true") {:accept mt/entry-collection-media-type}))
+
+(defn- recent-following-link [org]
+  (hateoas/link-map "recent-following" hateoas/GET (str (url org) "/entries?sort=activity&following=true") {:accept mt/entry-collection-media-type}))

 (defn- contributions-partial-link [org]
   (assoc (hateoas/link-map "partial-contributions" hateoas/GET (str (url org) "/contributions/$0") {:accept mt/entry-collection-media-type})
@@ -182,6 +185,7 @@
                                          (recent-activity-link org)
                                          (recent-contributions-partial-link org)
                                          (following-link org)
+                                         (recent-following-link org)
                                          (contributions-partial-link org)]) ; (calendar-link org) - not currently used
                           links)
         full-links (if (and (not id-token) (= access-level :author) )


use blocking subscribe and restart run-with-connection on errors

--- src/fscrawler_tika_convert/core.clj
+++ src/fscrawler_tika_convert/core.clj
@@ -65,8 +65,13 @@
     ;; (lq/declare ch queue-name :exclusive false :auto-delete true)
     ;; (lq/bind    ch queue-name "nextbot")
     (lb/qos ch (+ number-of-cores 4))
-    (lcons/subscribe ch queue-name handle-message :auto-ack false)
-    (println "done with subscribing")))
+    ;; (lcons/subscribe ch queue-name handle-message
+    ;;                  :auto-ack false))
+    ;;                  :handle-shutdown-signal-fn
+    ;;                  (fn [consumer_tag reason]
+    ;;                    (println "shutdown" consumer_tag reason))
+
+    (lcons/blocking-subscribe ch queue-name handle-message :auto-ack false)))

 (defn -main [& args]
@@ -81,4 +86,10 @@
                  ["--root" "Root directory of web server" :default "public"])]
     (println "port:" (:port options))
     (println "root:" (:root options)))
-  (run-with-connection))
+  (while true
+    (try
+      (run-with-connection)
+      (catch Exception err
+        (println "got exception" err)
+        (Thread/sleep 5000)
+        (println "restarting connection to rabbitmq")))))


refine morphological rule for adding "es" rather than "s" to pluralize nouns

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -584,7 +584,7 @@
 (defn plural-en [english]
   (if (re-find #"[t][y]$" english) ;; city => cities
     (replace english #"[y]$" "ies")
-    (if (re-find #"[hsx]$" english) ;; brush => brushes
+    (if (re-find #"[cs][hsx]$" english) ;; brush => brushes; beach => beaches
       (str english "es")
       ;; default case.
       (str english "s"))))


change quests to not depend on new-thread-id

--- src/braid/client/quests/list.cljs
+++ src/braid/client/quests/list.cljs
@@ -25,9 +25,14 @@
     :quest/video "/images/quests/conversation-new.gif"
     :quest/goal 3
     :quest/listener (fn [state [event data]]
+                      ; TODO: by the time this sees state, new-thread-id is out of date
+                      ; check if it's new by looking at the thread
                       (and
                         (= event :new-message)
-                        (= (data :thread-id) (:new-thread-id state))))}
+                        (->>
+                          (get-in state [:threads (data :thread-id) :messages])
+                          count
+                          (= 1))))}

    {:quest/order 2
     :quest/id :quest/conversation-reply
@@ -39,7 +44,10 @@
     :quest/listener (fn [state [event data]]
                       (and
                         (= event :new-message)
-                        (not= (data :thread-id) (:new-thread-id state))))}
+                        (->>
+                          (get-in state [:threads (data :thread-id) :messages])
+                          count
+                          (not= 1))))}

    {:quest/order 3
     :quest/id :quest/conversation-close


Fix RSS fetcher

Fix RSS fetcher

Was broken due to the change in how creating messages works (i.e. now
threads must be explicitly created before adding a message)

--- src/braid/rss/server/fetching.clj
+++ src/braid/rss/server/fetching.clj
@@ -2,8 +2,7 @@
   "Fetching items from an RSS feed"
   (:require
    [braid.core.server.db :as db]
-   [braid.chat.db.message :as message]
-   [braid.core.server.sync-helpers :as sync-helpers]
+   [braid.base.server.cqrs :as cqrs]
    [braid.rss.server.db :as rss-db]
    [clj-time.format :as f]
    [clojure.string :as string]
@@ -66,22 +65,23 @@

 (defn post-item
   [feed item]
-  (let [msg {:id (java.util.UUID/randomUUID)
-             ;; TODO: maybe also include description of item?
-             ;; it probably is html though, which may be something not
-             ;; worth the hassle
-             :content (string/join "\n" [(item :title) (item :link)])
-             :thread-id (java.util.UUID/randomUUID)
-             :user-id (feed :user-id)
-             :group-id (feed :group-id)
-             :created-at (java.util.Date.)
-             :mentioned-user-ids []
-             :mentioned-tag-ids (feed :tag-ids)}]
-    (db/run-txns! (message/create-message-txn msg))
-    ;; NB: explicitly *not* running sync-helpers/notify-users here
-    ;; since this is a sort of auto-generated post, it seems to
-    ;; not make the most sense
-    (sync-helpers/broadcast-thread (msg :thread-id) [])))
+  (let [thread-id (java.util.UUID/randomUUID)]
+    (cqrs/dispatch
+      [:braid.chat/create-thread!
+       {:user-id (feed :user-id)
+        :thread-id thread-id
+        :group-id (feed :group-id)}])
+    (cqrs/dispatch
+      [:braid.chat/create-message!
+       {:message-id (java.util.UUID/randomUUID)
+        ;; TODO: maybe also include description of item?
+        ;; it probably is html though, which may be something not
+        ;; worth the hassle
+        :content (string/join "\n" [(item :title) (item :link)])
+        :thread-id thread-id
+        :user-id (feed :user-id)
+        :mentioned-user-ids []
+        :mentioned-tag-ids (feed :tag-ids)}])))

 (defn update-feed!
   [feed]


removed exception from long-trends

removed exception from long-trends

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -99,16 +99,18 @@
   [y x & {:keys [intercept] :or {intercept true}}]
   (let [_x (if intercept (i/bind-columns (replicate (i/nrow x) 1) x) x)
         xt (i/trans _x)
-        xtx (i/mmult xt _x)
-        coefs (i/mmult (i/solve xtx) xt y)
-        fitted (i/mmult _x coefs)
-        resid (i/to-list (i/minus y fitted))
-        sse (i/sum-of-squares resid)
-        mse (/ sse (- (i/nrow y) (i/ncol _x)))
-        coef-var (i/mult mse (i/solve xtx))
-        std-errors (i/sqrt (i/diag coef-var))
-        t-tests (i/div coefs std-errors)]
-    [coefs t-tests]))
+        xtx (i/mmult xt _x)]
+    (if-not (singular? xtx)
+      (let [coefs (i/mmult (i/solve xtx) xt y)
+            fitted (i/mmult _x coefs)
+            resid (i/to-list (i/minus y fitted))
+            sse (i/sum-of-squares resid)
+            mse (/ sse (- (i/nrow y) (i/ncol _x)))
+            coef-var (i/mult mse (i/solve xtx))
+            std-errors (i/sqrt (i/diag coef-var))
+            t-tests (i/div coefs std-errors)]
+        [coefs t-tests])
+      [nil nil])))

 (defn long-stats
   "returns a tuple with the trend coefficient and associated
@@ -124,14 +126,8 @@
   (let [time-step (utils/idx ts)
         X (if (empty? cofactors)
             (i/matrix time-step)
-            (apply i/bind-columns time-step cofactors))
-        result (try (map second (trend-characteristics ts X))
-                    (catch Throwable e
-                      (error (str "TIMESERIES ISSUES: " ts ", " cofactors) e)))]
-    (if (or (nil? result)
-            (string? result))
-      [nil nil]
-      (vec result))))
+            (apply i/bind-columns time-step cofactors))]
+    (map second (trend-characteristics ts X))))

 ;; Short-term trend characteristic; supporting functions


Added a toast warning about Adam's implementation if there are not enough directives

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -6,6 +6,9 @@
          one-of-each   (fn [cards] (->> cards (group-by :title) (map second) (map first)))
          get-directives (fn [source] (filter #(some #{(:title %)} titles) source))]
    {:effect (req (let [directives (-> (:deck runner) (concat (:hand runner)) (get-directives) one-of-each)]
+                   (when (not= 3 (count directives))
+                     (toast state :runner
+                            "Your deck doesn't contain enough directives for Adam's ability. The deck needs to contain one copy of each directive. They are not counted against the decksize limit." "warning"))
                    (doseq [c directives]
                      (runner-install state side c {:no-cost true
                                                    :custom-message (str "starts with " (:title c) " in play")}))


gameboard layout fixes

gameboard layout fixes

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -218,7 +218,7 @@
          (om/build label rfg {:opts {:name "Removed"}})
          (map-indexed (fn [i card]
                         (sab/html
-                         [:div.card-wrapper {:style {:left (* (/ 100 (dec size)) i)}}
+                         [:div.card-wrapper {:style {:left (* (/ 128 (dec size)) i)}}
                           [:div (om/build card-view card)]]))
                       rfg)])))))

@@ -230,7 +230,7 @@
        (om/build label scored {:opts {:name "Scored Area"}})
        (map-indexed (fn [i card]
                       (sab/html
-                       [:div.card-wrapper {:style {:left (* (/ 100 (dec size)) i)}}
+                       [:div.card-wrapper {:style {:left (* (/ 128 (dec size)) i)}}
                         [:div (om/build card-view card)]]))
                     scored)]))))

@@ -372,7 +372,7 @@
                      (cond-button "Run" (< (:click me) 1)
                                   #(-> (om/get-node owner "servers") js/$ .toggle))
                      (let [servers (concat (remote-list) ["HQ" "R&D" "Archives"])]
-                       [:div.blue-shade.panel.servers {:ref "servers"}
+                       [:div.blue-shade.panel.servers-menu {:ref "servers"}
                         (map (fn [label]
                                [:div {:on-click #(do (send-command "run" {:server label})
                                                      (-> (om/get-node owner "servers") js/$ .fadeOut))}


Removed unnecessary dependency to clojure.core.reducers

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

--- src/conexp/contrib/algorithms.clj
+++ src/conexp/contrib/algorithms.clj
@@ -9,7 +9,6 @@
 (ns conexp.contrib.algorithms
   "Provides some optimized versions of the standard algorithms of conexp.main"
   (:require [conexp.main :as cm]
-            [clojure.core.reducers :as r]
             conexp.contrib.algorithms.linclosure))

 ;;;


Set window update checking interval to every 2 seconds

--- src/day8/re_frame_10x/events.cljs
+++ src/day8/re_frame_10x/events.cljs
@@ -273,7 +273,7 @@
                                     (reset! window-position-interval
                                             (js/setInterval
                                               handle-window-position
-                                              10000)))
+                                              2000)))
           :component-will-unmount unmount
           :reagent-render         (fn [] [container/devtools-inner {:panel-type :popup}])})]
       app)))


JS unicode char hex formatting

JS unicode char hex formatting

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -113,7 +113,8 @@
       9 "\\t"
       (if (< 31 cp 127)
         c ; Print simple ASCII characters
-        (format "\\u%04X" cp))))) ; Any other character is Unicode
+        #?(:clj (format "\\u%04X" cp)
+           :cljs (str "\\u" (.toString cp 16))))))) ; Any other character is Unicode

 (defn- escape-string [^CharSequence s]
   (let [sb #?(:clj (StringBuilder. (count s))


(PDB-2847) i18n enable the threadpool log messages

This commit wraps the string literals from
puppetlabs.puppetdb.threadpool in the appropriate i18n system local
translation macros.

--- src/puppetlabs/puppetdb/threadpool.clj
+++ src/puppetlabs/puppetdb/threadpool.clj
@@ -5,14 +5,16 @@
             RejectedExecutionException ExecutorService]
            [org.apache.commons.lang3.concurrent BasicThreadFactory BasicThreadFactory$Builder])
   (:require [clojure.core.async :as async]
-            [clojure.tools.logging :as log]))
+            [clojure.tools.logging :as log]
+            [puppetlabs.i18n.core :as i18n]))

 (def logging-exception-handler
   "Exception handler that ensures any uncaught exception that occurs
   on this thread is logged"
   (reify Thread$UncaughtExceptionHandler
     (uncaughtException [_ thread throwable]
-      (log/error throwable "Error processing command"))))
+      (log/error throwable
+                 (i18n/trs "Error processing command")))))

 (defn thread-factory
   "Creates a command thread factory, wrapping the
@@ -30,8 +32,9 @@

 (defn shutdown
   "Shuts down the gated threadpool, ensuring in-flight work is
-  complete before tearing it down. Currently waits up to 5 minutes for
-  that work to complete"
+  complete before tearing it down. Waits up to `shutdown-timeout` (in
+  milliseconds) for that work to complete before forcibly shutting
+  down the threadpool that work to complete"
   [{:keys [^Semaphore semaphore ^ExecutorService threadpool shutdown-timeout]}]

   ;; Prevent new work from being accepted
@@ -43,12 +46,14 @@
   ;; This will block, waiting for the threadpool to shutdown
   (when-not (.awaitTermination threadpool shutdown-timeout java.util.concurrent.TimeUnit/MILLISECONDS)

-    (log/warn "Attempted to shutdown threadpool, not stopped after 5 minutes, forcibly shutting it down")
+    (log/warn
+     (i18n/trs "Threadpool not stopped after {0} milliseconds, forcibly shutting it down" shutdown-timeout))

     ;; This will force the shutdown of the threadpool and will
     ;; not allow current threads to finish
     (.shutdownNow threadpool)
-    (log/warn "Threadpool forcibly shutdown")))
+    (log/warn
+     (i18n/trs "Threadpool forcibly shutdown"))))

 (defrecord GatedThreadpool [^Semaphore semaphore ^ExecutorService threadpool shutdown-timeout]
   java.io.Closeable
@@ -90,7 +95,7 @@
                              (finally
                                (.release semaphore)))))
     (catch RejectedExecutionException e
-      (log/error e "Message not submitted to command processing threadpool")
+      (log/error e (i18n/trs "Message not submitted to command processing threadpool"))
       (.release semaphore))))

 (defn exec-from-channel


high-level upsert

high-level upsert

--- src/er_cassandra/model/upsert.clj
+++ src/er_cassandra/model/upsert.clj
@@ -1,5 +1,6 @@
 (ns er-cassandra.model.upsert
   (:require
+   [clojure.set :as set]
    [clojure.core.match :refer [match]]
    [manifold.deferred :as d]
    [cats.core :as m]
@@ -11,179 +12,142 @@
    [er-cassandra.key :as k]
    [er-cassandra.record :as r]
    [er-cassandra.record-either :as re]
-   [er-cassandra.model.types :as t])
+   [er-cassandra.model.types :as t]
+   [er-cassandra.model.util :refer [combine-responses create-lookup-record]]
+   [er-cassandra.model.unique-key :as uk])
   (:import [er_cassandra.model.types Model]))

-(defn applied?
-  [lwt-response]
-  (get lwt-response (keyword "[applied]")))
+(defn delete-record
+  [session model table key-value]
+  (m/with-monad dm/either-deferred-monad
+    (m/mlet [delete-result (re/delete session
+                                      (:name table)
+                                      (:key table)
+                                      key-value)]
+            (m/return
+             [:ok {:table (:name table)
+                   :key (:key table)
+                   :key-value key-value} :deleted]))))

-(defn applied-or-owned?
-  [^Model model insert-uber-key lwt-insert-response ]
-  (if (applied? lwt-insert-response)
-    true
-    (let [owner-uber-key (k/extract-key-value
-                          (get-in model [:primary-table :key])
-                          lwt-insert-response)]
-      (= insert-uber-key owner-uber-key))))
+(defn upsert-record
+  [session ^Model model table record]
+  (m/with-monad dm/either-deferred-monad
+    (m/mlet [insert-result (re/insert session
+                                      (:name table)
+                                      record)]
+            (m/return
+             [:ok record :upserted]))))

-(defn unique-key-table-upsert
-  "insert into a unique-key table with a lightweight transaction.
-   returns a Deferred[Either], with Right values describing how
-   they were successful, and Left values describing errors"
+(defn delete-stale-secondaries
+  [session ^Model model old-record new-record]
+  (combine-responses
+   (filter
+    identity
+    (for [t (:secondary-tables model)]
+      (let [key (:key t)
+            old-key-value (k/extract-key-value key old-record)
+            new-key-value (k/extract-key-value key new-record)]
+        (when (and old-key-value
+                   (not= old-key-value new-key-value))
+          (delete-record session
+                         model
+                         t
+                         old-key-value)))))))

-  [session ^Model model unique-key-table unique-key-record]
+(defn upsert-secondaries
+  "returns Deferred[Right[]]"
+  [session ^Model model record]
+  (combine-responses
+   (for [t (:secondary-tables model)]
+     (upsert-record session model t record))))

-  (m/with-monad dm/either-deferred-monad
-    (m/mlet [insert-response (re/insert session
-                                        (:name unique-key-table)
-                                        unique-key-record
-                                        {:if-not-exists true})
+(defn delete-stale-lookups
+  [session ^Model model old-record new-record]
+  (combine-responses
+   (mapcat
+    identity
+    (for [t (:lookup-tables model)]
+      (let [uber-key (t/uber-key model)
+            uber-key-value (t/extract-uber-key-value model new-record)
+            key (:key t)
+            coll (:collection t)]

-             inserted? (m/return (applied? insert-response))
+        (if coll
+          (let [old-kvs (set (k/extract-key-value-collection key old-record))
+                new-kvs (set (k/extract-key-value-collection key new-record))
+                stale-kvs (filter identity (set/difference new-kvs old-kvs))]
+            (for [kv stale-kvs]
+              (delete-record session model t kv)))

-             owned? (m/return
-                      (applied-or-owned?
-                       model
-                       (t/extract-uber-key-value model unique-key-record)
-                       insert-response))
+          (let [old-kv (k/extract-key-value key old-record)
+                new-kv (k/extract-key-value key new-record)]
+            (when (and old-kv
+                       (not= old-kv new-kv))
+              [(delete-record session model t old-kv)]))))))))

-             live-ref? (if-not owned?
-                         (re/select-one session
-                                        (get-in model [:primary-table :name])
-                                        (get-in model [:primary-table :key])
-                                        (t/extract-uber-key-value
+(defn upsert-lookups
+  [session ^Model model record]
+  (combine-responses
+   (mapcat
+    identity
+    (for [t (:lookup-tables model)]
+      (let [uber-key (t/uber-key model)
+            uber-key-value (t/extract-uber-key-value model record)
+            key (:key t)
+            coll (:collection t)]
+        (if coll
+          (let [kvs (filter identity
+                            (set (k/extract-key-value-collection key record)))]
+            (for [kv kvs]
+              (let [lookup-record (create-lookup-record
+                                   uber-key uber-key-value
+                                   key kv)]
+                (upsert-record session
+                               model
+                               t
+                               lookup-record))))
+
+          (let [key-value (k/extract-key-value key record)]
+            (when-let [lookup-record (create-lookup-record
+                                      uber-key uber-key-value
+                                      key key-value)]
+              [(upsert-record session model t lookup-record)]))))))))
+
+(defn upsert
+  "upsert a single instance, upserting primary, secondary, unique-key and
+   lookup records as required and deleting stale secondary, unique-key and
+   lookup records"
+
+  ([session ^Model model record]
+
+   (m/with-monad dm/either-deferred-monad
+     (m/mlet [with-unique-keys (uk/acquire-unique-keys session model record)
+
+              stale-secondary-responses (delete-stale-secondaries
+                                         session
                                          model
-                                         insert-response))
-                         (m/return nil))
+                                         with-unique-keys
+                                         record)

-             stale-update-response (if (and (not owned?)
-                                            (not live-ref?))
-                                     (re/update
+              stale-lookup-responses (delete-stale-lookups
                                       session
-                                      (:name unique-key-table)
-                                      (:key unique-key-table)
-                                      unique-key-record
-                                      {:only-if
-                                       (t/extract-uber-key-equality-clause
-                                        model
-                                        insert-response)})
-                                     (m/return nil))
+                                      model
+                                      with-unique-keys
+                                      record)

-             updated? (m/return (applied? stale-update-response))]
+              secondary-reponses (combine-responses
+                                  (upsert-secondaries
+                                   session
+                                   model
+                                   record))

-            (m/return
-             (cond
-               inserted? [:ok :inserted]    ;; new key
-               owned?    [:ok :owned]       ;; ours already
-               updated?  [:ok :updated]     ;; ours now
-               live-ref? [:fail :notunique] ;; not ours
-               :else     [:fail :notunique] ;; someone else won
-               )))))
-
-(defn acquire-unique-key
-  "acquire a single unique key.
-   returns a Deferred[Right[:ok <keydesc> info]] if the key was acquired
-   successfully, a Deferred[Right[:fail <keydesc> reason]]"
-  [session ^Model model unique-key-table uber-key-value key-value]
-  (let [uber-key (t/uber-key model)
-        key (:key unique-key-table)
-        unique-key-record (into {}
-                                (concat (map vector uber-key uber-key-value)
-                                        (map vector key key-value)))]
-    (m/with-monad dm/either-deferred-monad
-      (m/mlet [acquire-result (unique-key-table-upsert session
-                                                       model
-                                                       unique-key-table
-                                                       unique-key-record)]
-              (m/return
-               (match acquire-result
-                      [:ok info] [:ok
-                                  {:uber-key uber-key
-                                   :uber-key-value uber-key-value
-                                   :key key
-                                   :key-value key-value}
-                                  info]
-                      [_ reason] [:fail
-                                  {:uber-key uber-key
-                                   :uber-key-value uber-key-value
-                                   :key key
-                                   :key-value key-value}
-                                  reason]))))))
-
-(defn remove-unique-key
-  "remove a single unique key"
-  [session ^Model model unique-key-table uber-key-value key-value]
-  (let [uber-key (t/uber-key model)
-        key (:key unique-key-table)]
-    (m/with-monad dm/either-deferred-monad
-      (m/mlet [delete-result (re/delete session
-                                        (:name unique-key-table)
-                                        key
-                                        key-value
-                                        {:only-if
-                                         (k/key-equality-clause
-                                          uber-key
-                                          uber-key-value)})
-               deleted? (m/return (applied? delete-result))]
-              (m/return
-               (cond
-                 deleted? [:ok :deleted]
-                 :else    [:ok :stale]))))))
-
-(defn acquire-singular-unique-key
-  "attempt to acquire a singular unique key, returning a
-   Deferred[Right[[:ok key info]]] or a Deferred[Right[[:fail key reason]]]"
-  [session ^Model model unique-key-table owner-record]
-  (let [uber-key-value (t/extract-uber-key-value model owner-record)
-        key-value (k/extract-key-value (:key unique-key-table) owner-record)]
-    (acquire-unique-key session model unique-key-table uber-key-value key-value)))
-
-(defn acquire-unique-key-collection
-  "attempt to acquire a set of unique keys. returns a
-   Deferred[Right[[ [:ok key info] | [:fail key reason] ]]]"
-  [session ^Model model unique-key-table owner-record]
-  (let [uber-key-value (t/extract-uber-key-value model owner-record)
-        key-value-coll (k/extract-key-value-collection
-                        (:key unique-key-table)
-                        owner-record)
-        responses (mapv (partial acquire-unique-key
+              lookup-responses (combine-responses
+                                (upsert-lookups
                                  session
                                  model
-                                 unique-key-table
-                                 uber-key-value)
-                        key-value-coll)]
-    (d/chain
-     (apply d/zip responses)
-     (fn [responses]
-       (clojure.pprint/pprint responses)
-       (if (some either/left? responses)
-         (either/left responses)
-
-         (either/right (mapv deref responses)))))))
-
-(defn lookup-key-table-upsert
-  [session ^Model model lookup-key-table record]
-  (m/with-monad dm/either-deferred-monad
-    (m/mlet [upsert-response (re/insert session
-                                        (:name lookup-key-table)
-                                        record)]
-            (m/return :upserted))))
-
-
-
-
-
-
-(defn upsert
-  "upsert a single instance, creating primary, secondary, unique-key and
-   lookup records as required"
-
-  ([session ^Model model record]
-   (upsert session model record {}))
-
-  ([session ^Model model record opts]
-   ;; insert to primary table if not exists
-   ;; insert to secondary tables if not exists
-   ;; insert to each lookup-table if not exists
-   ))
+                                 record))]
+             (m/return
+              (re/select-one session
+                             (get-in model [:primary-table :name])
+                             (get-in model [:primary-table :key])
+                             (t/extract-uber-key-value model record)))))))


Primes list is now lazy.

Primes list is now lazy.

--- Clojure/primes.clj
+++ Clojure/primes.clj
@@ -6,14 +6,17 @@
 (defn isprime?
     ([x] (isprime? x 2))
     ([x n]
-        (if (<= x n)
+        (if (> (* n n) x)
             true
             (if (zero? (rem x n))
                 false
                 (recur x (inc n))))))

-(println
+(defn lazy-primes
+    []
     (filter
         isprime?
-        (take 42 (iterate inc 0))))
+        (iterate inc 0)))

+(println (take 42 (lazy-primes)))
+


Add more embed functions

Add more embed functions

--- src/main/resources/sandbox-init.clj
+++ src/main/resources/sandbox-init.clj
@@ -27,5 +27,10 @@
   (def embed-image (memfn withImage url))
   (def embed-thumb (memfn withThumbnail url))
   (def embed-url   (memfn withUrl url))
+  (def embed-ftext (memfn withFooterText text))
+  (def embed-ficon (memfn withFooterIcon url))
+  (def embed-aname (memfn withAuthorName name))
+  (def embed-aicon (memfn withAuthorIcon url))
+  (def embed-aurl  (memfn withAuthorUrl url))
   (def embed-build (memfn build))
-)+)


Fix duplicate definition.

Fix duplicate definition.

--- src-cljs/frontend/models/plan.cljs
+++ src-cljs/frontend/models/plan.cljs
@@ -44,8 +44,6 @@

 (defn freemium-containers [plan]
   (or (get-in plan [:free :template :free_containers]) 0))
-
-(defn trial-containers [plan] (or (get-in plan [:trial :template :free_containers]) 0))

 (defn paid-containers [plan]
   (if (paid? plan)


updat paid? to look at paid-containers to cur down on dupe logic

--- src-cljs/frontend/models/plan.cljs
+++ src-cljs/frontend/models/plan.cljs
@@ -22,10 +22,6 @@
 (defn freemium? [plan]
   (boolean (:free plan)))

-(defn paid? [plan]
-  (boolean (and (:paid plan)
-                (not (zero? (:containers plan))))))
-
 (defn osx? [plan]
   (boolean (:osx plan)))

@@ -57,11 +53,14 @@
   (or (get-in plan [:free :template :free_containers]) 0))

 (defn paid-containers [plan]
-  (if (paid? plan)
-    (max (:containers_override plan)
-         (:containers plan)
-         (get-in plan [:paid :template :free_containers]))
-    0))
+  (max (:containers_override plan)
+       (:containers plan)
+       (get-in plan [:paid :template :free_containers]))
+  0)
+
+(defn paid? [plan]
+  (boolean (and (:paid plan)
+                (> (paid-containers plan) 0))))

 (defn trial-containers
   "How many containers are provided by this plan's trial? Note that this finds out how many


Use build-all to render tag-list.

Use build-all to render tag-list.

--- src-cljs/pepa/components/tags.cljs
+++ src-cljs/pepa/components/tags.cljs
@@ -223,4 +223,4 @@
     (render [_]
       (html
        [:ul.tags
-        (map #(om/build tag % {:react-key %}) tags)]))))
+        (om/build-all tag tags {:key-fn identity})]))))