Experiment with meta-errors

Experiment with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -208,7 +208,7 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
-              (if (not (:print-history argmap))
+              #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
                     ":print-history must be true for :case-stagnation"))
@@ -228,6 +228,24 @@
                                                (iterate (partial * (- 1 improvement-discount)) 1))
                                  sum (reduce + (mapv * improvements weights))]
                              (- sum)))))))
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-stagnation"))
+                (if (empty? (rest (:history ind)))
+                  (vec (repeat (count (:errors ind)) 1000000))
+                  (vec (for [case-history (apply map list (:history ind))]
+                         (let [improvements (mapv (fn [[newer-error older-error]]
+                                                    (if (< newer-error older-error)
+                                                      1.0
+                                                      (if (= newer-error older-error)
+                                                        -1.0
+                                                        0.0)))
+                                                  (partition 2 1 case-history))
+                               weights (take (count improvements)
+                                             (iterate (partial * (- 1 improvement-discount)) 1))
+                               sum (reduce + (mapv * improvements weights))]
+                           (- sum))))))
               #_(if (not (:print-history argmap))
                 (throw
                   (Exception.
@@ -944,7 +962,7 @@
                          (= e p1e) 3
                          :else 2)))
                 (vec (repeat (count (:errors ind)) 2)))
-              (if (:parent1-errors ind)
+              #_(if (:parent1-errors ind)
                 (vec (for [[e p1e] (mapv #(vector %1 %2)
                                          (:errors ind)
                                          (:parent1-errors ind))]
@@ -954,6 +972,58 @@
                          (= e p1e) 2
                          :else 2)))
                 (vec (repeat (count (:errors ind)) 2)))
+              #_(if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         (zero? e) 0
+                         (< e (min p1e p2e)) 1
+                         (< e (max p1e p2e)) 2
+                         (not (some #{e} [p1e p2e])) 3
+                         :else 4)))
+                (vec (repeat (count (:errors ind)) 4)))
+              #_(if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         ;(zero? e) 0
+                         (< e (min p1e p2e)) 1
+                         (< e (max p1e p2e)) 2
+                         (not (some #{e} [p1e p2e])) 3
+                         :else 4)))
+                (vec (repeat (count (:errors ind)) 4)))
+              #_(if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         ;(zero? e) 0
+                         (< e (min p1e p2e)) 1
+                         (< e (max p1e p2e)) 2
+                         (some #{e} [p1e p2e]) 3
+                         :else 4)))
+                (vec (repeat (count (:errors ind)) 4)))
+              (if (and (:parent1-errors ind)
+                       (:parent2-errors ind))
+                (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
+                                             (:errors ind)
+                                             (:parent1-errors ind)
+                                             (:parent2-errors ind))]
+                       (cond
+                         (zero? e) 0
+                         (< e (min p1e p2e)) 0
+                         (< e (max p1e p2e)) 1
+                         (some #{e} [p1e p2e]) 2
+                         :else 3)))
+                (vec (repeat (count (:errors ind)) 3)))
               ;
               (= cat :error-neglect)
               #_(if (and (:parent1-errors ind) (:parent2-errors ind))


a bit

a bit

--- src/codeitlater/core.clj
+++ src/codeitlater/core.clj
@@ -42,8 +42,9 @@
   )

-(defn read-files ;;:= TODO: directory format
-  "(partial read-comments-inline commentMark)"
+;;(partial read-comments-inline commentMark)
+(defn read-files
+  "Read all files depend on root path and file types, find comments inside and return."
   ([commentDict]
    (doall (for [filepath (get-all-files)
                 :when (not (.isDirectory (io/file filepath)))
@@ -58,7 +59,7 @@
                 :when mark]
             (conj (read-comments-in-file filepath mark)
                   filepath))))
-  ([commentDict root & filetypes]
+  ([commentDict root filetypes]
    (let [typepatterns (for [filetype filetypes
                             :when (not= "" filetype)]
                         (list (re-pattern (str ".+" filetype "$"))
@@ -75,7 +76,9 @@
 ;;:= TODO: make diferent behavior of deffirent args.
 ;;:= TODO: make tags options
 (defn -main [& args]
-  (let [commentDict (read-json)]
+  (let [commentDict (read-json)
+        [root & filetypes] args]
     (println args)
-    (println (read-files commentDict "./src" "clj" "")))
+    (println filetypes)
+    (println (read-files commentDict root filetypes)))
 )


CMR-1697: Logging the queue name when we fail to process a message on a queue.

--- message-queue-lib/src/cmr/message_queue/queue/rabbit_mq.clj
+++ message-queue-lib/src/cmr/message_queue/queue/rabbit_mq.clj
@@ -57,7 +57,7 @@
       (do
         ;; give up
         ;; Splunk alert "Indexing from message queue failed and all retries exhausted" dependent on this log message
-        (warn "Max retries exceeded for processing message:" (pr-str msg))
+        (warn "Max retries exceeded for processing message:" (pr-str msg) "on queue:" queue-name)
         (lb/nack ch delivery-tag false false))
       (let [msg (assoc msg :retry-count (inc retry-count))
             wait-q (wait-queue-name queue-name (inc retry-count))


Added 'one' and 'two' without reference to 'add-1' or 'zero'.


point import-metadata help link to correct page: (#1427)

--- src/cljs/main/broadfcui/page/workspace/data/tab.cljs
+++ src/cljs/main/broadfcui/page/workspace/data/tab.cljs
@@ -43,7 +43,7 @@
            (when-not last-crumb-id
              (dropdown/render-info-box
               {:text [:div {} "For more information about importing files, see our "
-                      (links/create-external {:href (config/user-guide-url)} "user guide.")]}))]
+                      (links/create-external {:href "https://software.broadinstitute.org/firecloud/documentation/article?id=10738"} "user guide.")]}))]
           [:div {:style {:backgroundColor "white" :padding "1em"}}
            (case last-crumb-id
              :file-import


log users before making them active

log users before making them active

--- src/pc/billing.clj
+++ src/pc/billing.clj
@@ -1,6 +1,7 @@
 (ns pc.billing
   (:require [clj-time.coerce :refer (to-date)]
             [clj-time.core :as time]
+            [clojure.tools.logging :as log]
             [datomic.api :as d]
             [pc.datomic :as pcd]
             [pc.models.cust :as cust-model]
@@ -84,6 +85,7 @@
         db (pcd/default-db)]
     (doseq [team (team-model/all db)]
       (utils/straight-jacket
+       (log/infof "setting active users for %s" (:team/subdomain team))
        (set-active-users db team :now now)))))

 (defn init []


added Christine to the world

added Christine to the world

--- src/jasons_game/world.clj
+++ src/jasons_game/world.clj
@@ -36,4 +36,7 @@
 (defn populate-world []
   (add-thing {:type :person
               :name "Edwin"
-              :location [400 200]}))
+              :location [400 200]})
+  (add-thing {:type :person
+              :name "Christine"
+              :location [700 300]}))


Rename function parameters for clarity

Rename function parameters for clarity

--- clstreams/src/clstreams/kstreams/impl.clj
+++ clstreams/src/clstreams/kstreams/impl.clj
@@ -14,12 +14,12 @@

 (defn method-wrapping-forms
-  [method-name-sym param-types get-param-wrapper-fn]
+  [method-name-sym param-types param-wrapper-for-type]
   (let [method-call-sym (symbol (str "." (name method-name-sym)))
         param-syms (map (fn [_] (gensym "p")) param-types)]
     `([obj# ~@param-syms]
       (~method-call-sym obj#
-       ~@(map (fn [typ sym] ((get-param-wrapper-fn typ) sym)) param-types param-syms)))))
+       ~@(map (fn [typ sym] ((param-wrapper-for-type typ) sym)) param-types param-syms)))))

 (defn add-refl-to-multimethods-data
@@ -50,17 +50,17 @@
 (defn multimethod-dispatch [& params]
   (vec (map class params)))

-(defn multimethod-exprs [mmethod-name mmethod-data get-param-wrapper-fn]
+(defn multimethod-exprs [mmethod-name mmethod-data param-wrapper-for-type]
   (cons
    `(defmulti ~mmethod-name multimethod-dispatch)
    (for [[dispatch-value {:keys [parameter-types]}] mmethod-data]
      (let [[params-list method-body]
-           (method-wrapping-forms mmethod-name parameter-types get-param-wrapper-fn)]
+           (method-wrapping-forms mmethod-name parameter-types param-wrapper-for-type)]
        `(defmethod ~mmethod-name ~dispatch-value ~params-list ~method-body)))))

-(defn exprs-from-multimethods-data [mm-data get-param-wrapper-fn]
+(defn exprs-from-multimethods-data [mm-data param-wrapper-for-type]
   (mapcat (fn [[method-name method-data]]
-            (multimethod-exprs method-name method-data get-param-wrapper-fn)) mm-data))
+            (multimethod-exprs method-name method-data param-wrapper-for-type)) mm-data))

 (defmacro define-multimethods [mm-def-list]
   (cons 'do (eval mm-def-list)))
@@ -86,11 +86,11 @@
    'org.apache.kafka.streams.kstream.ValueMapper
    (fn [proc-expr] `(java-function org.apache.kafka.streams.kstream.ValueMapper ~proc-expr))})

-(defn dispatch-value-from-param [param-type]
+(defn dispatch-value-from-param [param-type-sym]
   (cond
-    (clojure.string/ends-with? (str param-type) "<>") 'clojure.lang.ISeq
-    (contains? function-type-param-wrappers param-type) 'clojure.lang.IFn
-    :else param-type))
+    (clojure.string/ends-with? (str param-type-sym) "<>") 'clojure.lang.ISeq
+    (contains? function-type-param-wrappers param-type-sym) 'clojure.lang.IFn
+    :else param-type-sym))

 (defn dispatch-value-from-params
   [class-name-sym {:keys [parameter-types return-type]}]


This has to be speeded up!

This has to be speeded up!

--- src/adventofcode/solutions.clj
+++ src/adventofcode/solutions.clj
@@ -108,10 +108,10 @@
         s2int #(Integer/parseInt %)]
     [(keyword action) (s2int x0) (s2int y0) (s2int x1) (s2int y1)]))

-(def ^{:private true} actions {:off    #(aset-int % %2 %3 0)
-                               :on     #(aset-int % %2 %3 1)
-                               :toggle #(let [val (aget % %2 %3)
-                                              new-val (if (zero? val) 1 0)]
+(def ^{:private true} actions {:off    #(time (aset-int % %2 %3 0))
+                               :on     #(time (aset-int % %2 %3 1))
+                               :toggle #(let [val (aget ^ints % %2 %3)
+                                             new-val (if (zero? val) 1 0)]
                                          (aset-int % %2 %3 new-val))})

 (defn day6 []


CMR-1998: Addressed more review comments.

--- virtual-product-app/src/cmr/virtual_product/config.clj
+++ virtual-product-app/src/cmr/virtual_product/config.clj
@@ -37,7 +37,8 @@
   "Get the provider-id given the alias. If the alias is provider-id itself, provider-id is returned. nil is returned if it is not an alias for any provider-id"
   [alias]
   (let [provider-aliases (virtual-product-provider-aliases)]
-    (if (get provider-aliases alias)
+    ;; Check if alias is one of the provider ids defined in provider aliases configuration
+    (if (contains? provider-aliases alias)
       alias
       (some (fn [[provider-id aliases]]
               (when (contains? aliases alias) provider-id)) provider-aliases))))


Removing logging so that the junit ouput can be parsed.

--- system-int-test/src/cmr/system_int_test/system.clj
+++ system-int-test/src/cmr/system_int_test/system.clj
@@ -40,7 +40,6 @@
   ([]
    (start (create-system)))
   ([system]
-   (info "system-int-test System starting")
    (let [started-system (reduce (fn [system component-name]
                                   (update-in system [component-name]
                                              #(when % (lifecycle/start % system))))
@@ -54,7 +53,6 @@
   ([]
    (stop @saved-system))
   ([system]
-   (info "system-int-test System shutting down")
    (when system
      (let [stopped-system (reduce (fn [system component-name]
                                     (update-in system [component-name]


larger scale tests

larger scale tests

--- test/er_cassandra/model/alia/relationship_test.clj
+++ test/er_cassandra/model/alia/relationship_test.clj
@@ -1,9 +1,17 @@
 (ns er-cassandra.model.alia.relationship-test
   (:require
-   [er-cassandra.model.util.test :as tu :refer [fetch-record insert-record upsert-instance]]
+   [er-cassandra.model.util.test :as tu
+    :refer [fetch-record
+            insert-record
+            upsert-instance
+            record-stream
+            instance-stream
+            upsert-instance-stream
+            sync-consume-stream]]
    [clojure.test :as test :refer [deftest is are testing use-fixtures]]
    [schema.test :as st]
    [clj-uuid :as uuid]
+   [manifold.stream :as s]
    [er-cassandra.record :as r]
    [er-cassandra.model.util.timestamp :as ts]
    [er-cassandra.model.types :as t]
@@ -72,6 +80,120 @@
     (is (= "foo" (:nick potrai)))
     (is (= "foo" (:nick potrb)))
     (is (= "foo" (:nick potrbi)))))
+
+(defn create-two-source-relationship
+  "creates two source entities denormalizing to the same target entity"
+  ([cascade-op]
+   (tu/create-table :tpr_source_a
+                    "(ida uuid primary key, factor int)")
+
+   (tu/create-table :tpr_source_b
+                    "(idb uuid primary key, value int)")
+
+   (tu/create-table :tpr_target
+                    (str "(idt uuid primary key, "
+                         " source_a_id uuid, "
+                         " source_b_id uuid, "
+                         " factor int, "
+                         " value int)"))
+
+   (tu/create-table :tpr_target_by_source_a_id
+                    (str "(idt timeuuid, "
+                         " source_a_id uuid, "
+                         " source_b_id uuid, "
+                         " factor int, "
+                         " value int, "
+                         " primary key (source_a_id, idt))"))
+
+   (tu/create-table :tpr_target_by_source_b_id
+                    (str "(idt timeuuid, "
+                         "source_a_id uuid, "
+                         "source_b_id uuid, "
+                         "factor int, "
+                         "value int, "
+                         "primary key (source_b_id, idt))"))
+
+
+   (let [target (t/create-entity
+                 {:primary-table {:name :tpr_target
+                                  :key [:idt]}
+                  :secondary-tables [{:name :tpr_target_by_source_a_id
+                                      :key [:source_a_id :idt]}
+                                     {:name :tpr_target_by_source_b_id
+                                      :key [:source_b_id :idt]}]})
+         source_a (t/create-entity
+                   {:primary-table {:name :tpr_source_a
+                                    :key [:ida]}
+                    :denorm-targets {:test {:target target
+                                            :denormalize {:factor :factor}
+                                            :cascade (or cascade-op :none)
+                                            :foreign-key [:source_a_id]}}})
+
+         source_b (t/create-entity
+                   {:primary-table {:name :tpr_source_b
+                                    :key [:idb]}
+                    :denorm-targets {:test {:target target
+                                            :denormalize {:value :value}
+                                            :cascade (or cascade-op :none)
+                                            :foreign-key [:source_b_id]}}})]
+     [source_a source_b target])))
+
+
+(deftest update-two-sources-many-records-test
+  (let [[sa sb t] (create-two-source-relationship :none)
+
+        acnt 5
+        ;; all source-a records start out with :factor 1
+        saids (repeatedly acnt uuid/v1)
+        sars (for [said saids] {:ida said :factor 1})
+
+
+        bcnt 1000
+        ;; initial source-b record :values are drawn from 1..bcnt
+        sbids (repeatedly bcnt uuid/v1)
+        sbrs (map (fn [sbid v] {:idb sbid :value v}) sbids (iterate inc 1))
+        pstep (+ (quot bcnt acnt) (if (> (mod bcnt acnt) 0) 1 0))
+        ;; bcnt records divided into acnt partitions
+        sbrs-parts (partition pstep pstep nil sbrs)]
+
+    (testing "write initial records"
+      (let [trs (flatten
+                 (for [{ida :ida factor :factor :as sar} sars]
+                   (for [sbrs sbrs-parts]
+                     (for [{idb :idb value :value :as sbr} sbrs]
+                       {:idt (uuid/v1) :source_a_id ida :source_b_id idb :factor factor :value value}))))
+
+            ;; write initial records
+            _ (sync-consume-stream (upsert-instance-stream t trs))
+
+            tr-str (instance-stream t {:buffer-size 10})
+            ftr @(s/reduce conj [] tr-str)]
+
+        (is (= (* acnt bcnt) (count ftr)))
+        (is (= (* acnt bcnt) (->> ftr (map :factor) (reduce +))))
+        (is (= (* acnt (* (/ bcnt 2) (inc bcnt))) (->> ftr (map :value) (reduce +))))))
+
+    (testing "inc the factors, inc the values"
+      (let [isars (->> sars
+                       (map (fn [sar]
+                              (assoc sar :factor 2))))
+
+            a-denorms (doall
+                       (for [isar isars]
+                         @(rel/denormalize tu/*model-session* sa isar :upsert (ts/default-timestamp-opt))))
+            _ (prn a-denorms)
+
+            tr-str (instance-stream t {:buffer-size 10})
+            ftr @(s/reduce conj [] tr-str)]
+
+        (is (= (* acnt bcnt) (count ftr)))
+        (is (= (* acnt bcnt 2) (->> ftr (map :factor) (reduce +))))
+        (is (= (* acnt (* (/ bcnt 2) (inc bcnt))) (->> ftr (map :value) (reduce +))))
+        ))
+
+    ))
+
+

 (deftest cascade-simple-relationship-multiple-records-test


remove use of (unify) with nouns (should be inferred within post-processing rules)

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -282,9 +282,7 @@

    "beach" {:synsem {:cat :noun
                      :sem {:place true
-                           :event false
                            :pred :beach
-                           :buyable false
                            :artifact false}}}

    "become" {:synsem {:cat :verb
@@ -301,7 +299,7 @@

    "bicycle" {:synsem {:cat :noun
                        :sem {:pred :bicycle
-                             :animate false
+                             :artifact true
                              :place false}}}
    "black"
    (unify adjective
@@ -317,14 +315,13 @@
    (unify agreement-noun
           common-noun
           countable-noun
-          {:synsem {:sem {:pred :libro
+          {:synsem {:sem {:artifact true
+                          :pred :libro
                           :legible true
                           :speakable false
                           :mass false
-                          :buyable true
                           :place false
-                          :consumable false
-                          :artifact true}}})
+                          :consumable false}}})

    "break" {:synsem {:cat :verb
                      :sem {:pred :break }}
@@ -341,7 +338,6 @@
                                  :number :sing
                                  :def :def}}}})

-
    "bring" {:synsem {:cat :verb
                    :sem {:pred :bring
                          :subj {:human true}
@@ -370,6 +366,7 @@
    "car" {:synsem {:cat :noun
                    :sem {:pred :car
                          :animate false
+                         :artifact true
                          :edible false
                          :place false}}}

@@ -377,12 +374,10 @@
                      :sem {:human true
                            :pred :carry}}
             :english {:past "carried"}}
-   "cat"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          {:synsem {:sem (unify e/animal {:pred :gatto
-                                          :pet true})}})
+
+   "cat" {:synsem {:cat :noun
+                   :sem {:pred :gatto
+                         :pet true}}}

    "change" {:synsem {:cat :verb
                       :sem {:pred :change}}} ;; TODO: add reflexive sense
@@ -394,7 +389,7 @@
                      :english {:present {:3sing "changes clothes"}
                                :participle "changing clothes"
                                :past "changed clothes"}}
-
+
    "chat" {:synsem {:cat :verb
                     :sem {:pred :chat}}
            :english {:participle "chatting"
@@ -503,23 +498,18 @@

    "download" {:synsem {:cat :verb
                         :sem {:pred :scaricare}}}
-
-   "dog"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          {:synsem {:sem (unify e/animal {:pred :cane
-                                          :pet true})}})
+   "dog" {:synsem {:cat :noun
+                   :sem {:pred :cane
+                         :pet true}}}

    "earn"  {:synsem {:cat :verb
                      :sem {:pred :earn
                            :subj {:human true}}}}
-   "eat"
-   {:english {:past "ate"}
-    :synsem {:cat :verb
-             :sem {:pred :mangiare
-                   :subj {:animate true}
-                   :obj {:edible true}}}}
+   "eat" {:english {:past "ate"}
+          :synsem {:cat :verb
+                   :sem {:pred :mangiare
+                         :subj {:animate true}
+                         :obj {:edible true}}}}

    "eat dinner" {:synsem {:cat :verb
                           :sem {:pred :cenare
@@ -528,11 +518,10 @@
                            :participle "eating dinner"
                            :past "ate dinner"}}

-   "embrace"
-   {:synsem {:cat :verb
-             :sem {:pred :abbracciare}
-             :subj {:human true}
-             :obj {:human true}}}
+   "embrace" {:synsem {:cat :verb
+                       :sem {:pred :abbracciare}
+                       :subj {:human true}
+                       :obj {:human true}}}

    "endure" {:synsem {:cat :verb
                 :sem {:pred :endure}}}
@@ -577,14 +566,10 @@
                 :present {:3sing "falls asleep"}
                 :past "fell asleep"}})

-   "father"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:synsem {:sem {:human true
-                          :pred :father
-                          :child false}}})
+   "father" {:synsem {:cat :noun
+                      :sem {:human true
+                            :pred :father
+                            :child false}}}

    "finish" {:synsem {:cat :verb
                       :sem {:pred :finish}}}
@@ -790,10 +775,10 @@
                      :past "had"}}

    "have dinner" {:synsem {:cat :verb
-                            :sem {:pred :have-dinner}}
-                   :english {:present {:3sing "has dinner"}
-                             :past "had dinner"
-                             :participle "having dinner"}}
+                           :sem {:pred :have-dinner}}
+                  :english {:present {:3sing "has dinner"}
+                            :past "had dinner"
+                            :participle "having dinner"}}
    "have fun"
    (let [subject-semantics (atom {:human true})]
      {:synsem {:cat :verb
@@ -823,18 +808,15 @@
                         :future "have to"
                         :participle "having to"
                         :past "had to"}}
-
-   "he"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :nom
-             :agr {:person :3rd
-                   :gender :masc
-                   :number :sing}
-             :sem {:human true
-                   :pred :lui}
-             :subcat '()}}
-
+   "he" {:synsem {:cat :noun
+                  :pronoun true
+                  :case :nom
+                  :agr {:person :3rd
+                        :gender :masc
+                        :number :sing}
+                  :sem {:human true
+                        :pred :lui}
+                  :subcat '()}}
    "help"
    {:synsem {:cat :verb
              :essere false
@@ -864,41 +846,38 @@
               :sem {:pred :lei
                     :human true}
               :subcat '()}}]
-
-   "herself"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :acc
-             :reflexive true
-             :agr {:person :3rd
-                   :gender :fem
+
+   "herself" {:synsem {:cat :noun
+                       :pronoun true
+                       :case :acc
+                       :reflexive true
+                       :agr {:person :3rd
+                             :gender :fem
                    :number :sing}
-             :sem {:human true
-                   :reflexive true}
-             :subcat '()}}
-    "him"
-    {:synsem {:cat :noun
-              :pronoun true
-              :case :acc
-              :reflexive false
-              :agr {:person :3rd
-                    :gender :masc
-                    :number :sing}
-              :sem {:human true
-                    :pred :lui}
-              :subcat '()}}
-
-   "himself"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :acc
-             :reflexive true
-             :agr {:person :3rd
-                   :gender :masc
+                       :sem {:human true
+                             :reflexive true}
+                       :subcat '()}}
+    "him" {:synsem {:cat :noun
+                    :pronoun true
+                    :case :acc
+                    :reflexive false
+                    :agr {:person :3rd
+                          :gender :masc
+                          :number :sing}
+                    :sem {:human true
+                          :pred :lui}
+                    :subcat '()}}
+
+   "himself" {:synsem {:cat :noun
+                       :pronoun true
+                       :case :acc
+                       :reflexive true
+                       :agr {:person :3rd
+                             :gender :masc
                    :number :sing}
-             :sem {:human true
-                   :reflexive true}
-             :subcat '()}}
+                       :sem {:human true
+                             :reflexive true}
+                       :subcat '()}}

    "his" [{:synsem {:cat :det
                     :agr {:number :sing}
@@ -916,7 +895,6 @@
    "hit" {:english {:past "hit"}
              :synsem {:cat :verb
                       :sem {:pred :hit}}}
-
    "hold"
    {:synsem {:cat :verb
              :sem {:pred :hold}}
@@ -926,14 +904,10 @@
    {:synsem {:cat :verb
              :sem {:pred :hope}}}

-   "house" (unify agreement-noun
-                  common-noun
-                  countable-noun
-                  {:synsem {:sem {:pred :house
-                                  :buyable true
-                                  :event false
-                                  :artifact true
-                                  :place true}}})
+   "house" {:synsem {:cat :noun
+                     :sem {:pred :house
+                           :artifact true
+                           :place true}}}
    "hug"
    {:synsem {:cat :verb
              :sem {:pred :hug
@@ -1110,22 +1084,18 @@
    "learn" {:synsem {:cat :verb
                      :sem {:pred :learn}}}

-   "leave" [
-
-            {:english {:past "left"}
+   "leave" [{:english {:past "left"}
              :synsem {:cat :verb
                       :sem {:pred :leave-behind
                             :obj {:place false}}}}
-
+
             {:english {:note "on a trip"
                        :past "left"}
              :synsem {:cat :verb
-                      :sem {:pred :leave}}}
-
-                         ]
+                      :sem {:pred :leave}}}]

    "lie" {:synsem {:cat :verb
-                :sem {:pred :lie}}}
+                   :sem {:pred :lie}}}

    "lift" {:synsem {:cat :verb
                     :sem {:pred :lift}}}
@@ -1202,44 +1172,37 @@
    "make" {:synsem {:cat :verb
                     :sem {:pred :make}}
            :english {:past "made"}}
-   "man"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          masculine-noun
-          {:english {:plur "men"}
-           :synsem {:sem {:human true
-                          :pred :man
-                          :child false}}})
+   "man" {:english {:plur "men"}
+          :synsem {:sem {:human true
+                         :pred :man
+                         :child false}}}

    "manage" {:synsem {:cat :verb
                 :sem {:pred :manage}}}
-   "may"
-   {:english {:past "might"
-              :participle "able to"
-              :present {:1sing "may"
-                        :2sing "may"
-                        :3sing "may"
-                        :1plur "may"
-                        :2plur "may"
-                        :3plur "may"}
-              :future "be able to"
-              :conditional "be able to"}
-    :synsem {:cat :verb
-             :sem {:pred :may}}}
-   "me"
-   {:synsem {:cat :noun
-             :pronoun true
-             :case :acc
-             :reflexive false
-             :agr {:person :1st
+   "may" {:english {:past "might"
+                    :participle "able to"
+                    :present {:1sing "may"
+                              :2sing "may"
+                              :3sing "may"
+                              :1plur "may"
+                              :2plur "may"
+                              :3plur "may"}
+                    :future "be able to"
+                    :conditional "be able to"}
+          :synsem {:cat :verb
+                   :sem {:pred :may}}}
+   "me" {:synsem {:cat :noun
+                  :pronoun true
+                  :case :acc
+                  :reflexive false
+                  :agr {:person :1st
                    :number :sing}
-             :sem {:human true
-                   :pred :I}
-             :subcat '()}}
+                  :sem {:human true
+                        :pred :I}
+                  :subcat '()}}

    "measure" {:synsem {:cat :verb
-                :sem {:pred :measure}}}
+                       :sem {:pred :measure}}}

    "meet"  {:synsem {:cat :verb
                      :sem {:pred :incontrare}}
@@ -1248,30 +1211,26 @@
    "meeting" {:synsem {:cat :noun
                        :sem {:pred :meeting
                              :event true}}}
-   "mother"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          feminine-noun
-          {:synsem {:sem {:human true
-                          :pred :madre
-                          :child false}}})
+
+   "mother" {:synsem {:cat :noun
+                      :sem {:human true
+                            :pred :madre
+                            :child false}}}

    "move" {:synsem {:cat :verb
                     :sem {:pred :move}}}

    "multiply" {:synsem {:cat :verb
-                :sem {:pred :multiply}}}
+                        :sem {:pred :multiply}}}

    ;; TODO: should not need to provide an irregular plural form
    ;; [:sem :mass]=true should be sufficient.
-   "music"
-   {:synsem {:agr {:number :sing}
-             :cat :noun
-             :sem {:pred :music
-                   :animate false
-                   :place false
-                   :mass true}}}
+   "music" {:synsem {:agr {:number :sing}
+                     :cat :noun
+                     :sem {:pred :music
+                           :animate false
+                           :place false
+                           :mass true}}}
    "my"
    (map #(unify %
                 {:synsem {:cat :det
@@ -1298,19 +1257,18 @@
                     :number number})
          of (atom {:gender gender
                    :number number})]
-     (unify agreement-noun
-            common-noun
-            countable-noun
-            {:synsem {:agr agr
-                      :sem {:animate false
-                            :pred :name
-                            :place false
-                            :physical-object false
-                            :subj of}
-                      :subcat {:1 {:agr agr
-                                   :cat :det
-                                   :def :possessive
-                                   :sem of}}}}))
+     {:synsem {:agr agr
+               :cat :noun
+               :sem {:animate false
+                     :pred :name
+                     :place false
+                     :physical-object false
+                     :subj of}
+               :subcat {:1 {:agr agr
+                            :cat :det
+                            :def :possessive
+                            :sem of}}}})
+
    "note" {:synsem {:cat :verb
                     :sem {:pred :note}}}

@@ -1333,7 +1291,7 @@
         [{:synsem {:agr {:number :sing}}}
          {:synsem {:agr {:number :plur}}}])

-    "ourselves"
+   "ourselves"
    [{:note "♀"
      :synsem {:cat :noun
               :pronoun true
@@ -1442,18 +1400,17 @@
                           :physical-object true
                           :human false}}})

- "remain" [{:synsem {:cat :verb
-                      :sem {:pred :remain}}} ;; for other than italian
+   "remain" [{:synsem {:cat :verb
+                       :sem {:pred :remain}}} ;; for other than italian

-          ;; these two below are for Italian.
-
-           {:english {:note {:it "ri"}}
-            :synsem {:cat :verb
-                      :sem {:pred :remain1}}}
-          {:english {:note {:it "re"}}
-            :synsem {:cat :verb
-                      :sem {:pred :remain2}}}
-]
+             ;; these two below are for Italian.
+
+             {:english {:note {:it "ri"}}
+              :synsem {:cat :verb
+                       :sem {:pred :remain1}}}
+             {:english {:note {:it "re"}}
+              :synsem {:cat :verb
+                       :sem {:pred :remain2}}}]

    "remember"  {:synsem {:cat :verb
                          :sem {:pred :ricordare}}}
@@ -1514,8 +1471,8 @@

    "scrub"  {:synsem {:cat :verb
                      :sem {:pred :scrub}}
-            :english {:participle "scrubbing"
-                      :past "scrubbed"}}
+             :english {:participle "scrubbing"
+                       :past "scrubbed"}}

    "second" (unify adjective
                    {:synsem {:sem {:mod {:pred :first}
@@ -1922,15 +1879,10 @@
            :english {:past "won"
                      :participle "winning"}}

-   "woman"
-   (unify agreement-noun
-          common-noun
-          countable-noun
-          feminine-noun
-          {:english {:plur "women"}
-           :synsem {:sem {:human true
-                          :pred :donna
-                          :child false}}})
+   "woman" {:english {:plur "women"}
+            :synsem {:sem {:human true
+                           :pred :donna
+                           :child false}}}

    "work" [{:synsem {:cat :verb
                      :sem {:pred :work-human
@@ -1950,7 +1902,7 @@
                       :sem {:pred :scrivere}}}

    "yell" {:synsem {:cat :verb
-                :sem {:pred :yell}}}
+                    :sem {:pred :yell}}}

    "you (♂)"
    {:note "♂"


+Juan and me (case:acc)

+Juan and me (case:acc)

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -992,6 +992,16 @@
               :sem {:human true
                     :pred :Juan-and-i}
               :subcat '()}}]
+   "Juan and me"
+   [{:synsem {:cat :noun
+              :pronoun true
+              :case :acc
+              :agr {:gender :masc
+                    :person :1st
+                    :number :plur}
+              :sem {:human true
+                    :pred :Juan-and-i}
+              :subcat '()}}]
    "I"
    [{:english {:note "♂"}
      :synsem {:cat :noun


Focus management #38 - combo box dropdown should hide when combo box loses focus

--- flatguiwidgets/src/flatgui/widgets/combobox/dropdown.clj
+++ flatguiwidgets/src/flatgui/widgets/combobox/dropdown.clj
@@ -62,6 +62,10 @@
         (= reason [:arrow-button])
         (flatgui.widgets.abstractbutton/button-pressed? (get-property component [:arrow-button] :pressed-trigger)))
       true
+      (and
+        (= reason [:editor])
+        (not= :has-focus (:mode (get-property component [:editor] :focus-state))))
+      false
       :else old-visible)))

 (fg/defevolverfn dropdown-row-order-evolver :row-order


Make searching for @user find threads the user sent messages in too

Closes #188

--- src/braid/search/server.clj
+++ src/braid/search/server.clj
@@ -87,11 +87,14 @@
                                   :in $ [?user-name ...] ?g-id
                                   :where
                                   [?g :group/id ?g-id]
+                                  [?t :thread/group ?g]
+                                  [?t :thread/id ?t-id]
+                                  (or (and [?t :thread/mentioned ?user]
+                                           [?m :message/thread ?t])
+                                      (and [?m :message/thread ?t]
+                                           [?m :message/user ?user]))
+                                  [?g :group/user ?user]
                                   [?user :user/nickname ?user-name]
-                                  [?g :group/user ?user]
-                                  [?t :thread/id ?t-id]
-                                  [?t :thread/mentioned ?user]
-                                  [?m :message/thread ?t]
                                   [?m :message/created-at ?time]]
                                 search-db
                                 users


[uploads] Fix display of files with special characters (like spaces)

--- src/braid/uploads/core.cljc
+++ src/braid/uploads/core.cljc
@@ -16,7 +16,10 @@
           [braid.chat.db.thread :as thread]
           [braid.chat.db.group :as group]
           [braid.uploads.db :as db.uploads]
-          [braid.chat.db.user :as user]])))
+          [braid.chat.db.user :as user]]))
+    (:import
+      #?@(:clj
+           [(java.net URLDecoder)])))

 #?(:cljs
    (defn image-embed-view
@@ -183,7 +186,7 @@
             ;; currently, it is possible for a user in another group to access a file
             ;; IF they know its path (which, is behind a UUID, so, non-trivial to guess/enumerate)
             (let [expires-seconds (* 1 24 60 60) ; one day
-                  asset-key (second (re-matches #"^/upload/(.*)" (request :uri)))]
+                  asset-key (URLDecoder/decode (second (re-matches #"^/upload/(.*)" (request :uri))))]
               {:status 302
                :headers {"Cache-Control" (str "private, max-age=" expires-seconds)
                          "Location" (s3/readable-s3-url


fix layer selection and change name

fix layer selection and change name

--- frontend/src/uxbox/main/ui/workspace/sidebar/layers.cljs
+++ frontend/src/uxbox/main/ui/workspace/sidebar/layers.cljs
@@ -123,7 +123,6 @@
               (when (kbd/enter? event)
                 (on-blur event)))
             (on-click [event]
-              (dom/stop-propagation event)
               (dom/prevent-default event)
               (let [parent (.-parentNode (.-target event))]
                 (set! (.-draggable parent) false))
@@ -136,7 +135,7 @@
           :auto-focus true
           :default-value (:name shape "")}]
         [:span.element-name
-         {:on-click on-click}
+         {:on-double-click on-click}
          (:name shape "")]))))

 ;; --- Layer Simple (Component)
@@ -188,6 +187,7 @@
                             "0.5"
                             "1")}
          :on-click select
+         :on-double-click #(dom/stop-propagation %)
          :on-drag-start on-drag-start
          :on-drag-enter on-drag-enter
          :on-drag-leave on-drag-leave


Fix bugs

Fix bugs

--- src/checkin_halake/core.clj
+++ src/checkin_halake/core.clj
@@ -33,15 +33,15 @@
   (POST "/checkin" {{:keys [email password]} :params}
        (let [user (users/login email password)]
          (if (and user (checkin/checkin (:_id user)))
-           (response-with-status :user user)
+           (response-with-status true :user user)
            (response-with-status false :reason "Email/Password combination is not valid"))))
   (POST "/checkout" {{:keys [email password]} :params}
        (let [user (users/login email password)]
          (if (and user (checkin/checkout (:_id user)))
-           (response-with-status :user user)
+           (response-with-status true :user user)
            (response-with-status false :reason "Email/Password combination is not valid"))))
   (GET "/events" _
-       response-with-status :evnets (events/query-events)))
+       (response-with-status true :events (events/query-events))))
 ;;  (not-found "Not found"))

 (defonce headers-key (env :api-request-headers-key))


Add with/log-debug-result macro

Add with/log-debug-result macro

--- src/cider_ci/utils/with.clj
+++ src/cider_ci/utils/with.clj
@@ -39,3 +39,13 @@

 ;(macroexpand '(suppress-and-log-warn (println "hello world")))
+
+
+(defmacro log-debug-result [& expressions]
+  `(let [res# (do ~@expressions)]
+     (logging/debug {:result res#})
+     res#))
+
+
+;(macroexpand-1 '(log-debug-result(+ 1 2)))
+


remove stray cljs.util/debug-prn

remove stray cljs.util/debug-prn

--- src/clj/cljs/repl/rhino.clj
+++ src/clj/cljs/repl/rhino.clj
@@ -81,7 +81,6 @@
                         (ScriptableObject/getProperty "core"))]
         (ScriptableObject/putProperty top-level "_STAR_e"
           (Context/javaToJS ex scope))
-        (util/debug-prn top-level)
         {:status :exception
          :value (.toString ex)
          :stacktrace (stacktrace ex)}))))


better tables definition

better tables definition

--- src/clj/yambox/database.clj
+++ src/clj/yambox/database.clj
@@ -34,12 +34,8 @@
           [:start_money :bigint]
           [:target_money :bigint]
           [:created :timestamp]
-          [:wallet_id :bigint]
-          [:oauth_token "varchar(300)"]))
-      (j/db-do-commands spec
-        "CREATE INDEX campaigns_slug_ix ON campaigns(slug)")
-      (j/db-do-commands spec
-        "CREATE INDEX campaigns_wallet_id_ix ON campaigns(wallet_id)"))))
+          [:wallet_id :bigint "UNIQUE"]
+          [:oauth_token "varchar(300)"])))))

 (defn to-underscore [m]
   (p/map-keys (fn [k] (-> k name (s/replace "-" "_") keyword)) m))


Fixed secretary config.

Fixed secretary config.

--- src/cljs/bookmarx/core.cljs
+++ src/cljs/bookmarx/core.cljs
@@ -15,8 +15,7 @@
             [bookmarx.search :as search]
             [bookmarx.settings :as settings])
   (:require-macros
-    [bookmarx.env :refer [cljs-env]]
-    [cljs.core.async.macros :refer [go]]))
+   [cljs.core.async.macros :refer [go]]))

 (enable-console-print!)

@@ -51,7 +50,7 @@
     (set-cookie! :active 1))

   ;; Setup navigation.
-  (secretary/set-config! :prefix (cljs-env :prefix))
+  (secretary/set-config! :prefix "#")
   (accountant/configure-navigation!
    {:nav-handler #(secretary/dispatch! %)
     :path-exists? #(secretary/locate-route %)})


Remove unused section

Remove unused section

--- src/cljs/geoforms/core.cljs
+++ src/cljs/geoforms/core.cljs
@@ -19,11 +19,6 @@
   [:div [:h2 "About geoforms"]
    [:div [:a {:href "#/"} "go to the home page"]]])

-(defn reagent-forms-example []
-  [:div [:h2 "Welcome to geoforms"]
-   [:div [:a {:href "#/about"} "go to about page"]]
-   [:div [:a {:href "#/"} "go to home"]]])
-
 (defn current-page []
   [:div [(session/get :current-page)]])

@@ -36,9 +31,6 @@

 (secretary/defroute "/about" []
   (session/put! :current-page #'about-page))
-
-(secretary/defroute "/reagent-forms-example" []
-  (session/put! :current-page #'reagent-forms-example))

 ;; -------------------------
 ;; History


renamed library function

renamed library function

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/core.cljs
@@ -9,8 +9,8 @@
             [birdwatch.ui.count-views :as cv]
             [birdwatch.ui.pagination :as pag]
             [birdwatch.state.data :as state]
-            [com.matthiasnehlsen.systems-toolbox.component :as comp]
-            [com.matthiasnehlsen.systems-toolbox.reagent :as r]
+            [com.matthiasnehlsen.systems-toolbox.component :as toolbox-comp]
+            [com.matthiasnehlsen.systems-toolbox.reagent :as toolbox-r]
             [cljs.core.async :refer [chan pub sub buffer sliding-buffer pipe]]))

 (enable-console-print!)
@@ -36,13 +36,13 @@
 (cloud/mount-wordcloud state-pub cmd-chan {:n 250 :every-ms 5000})
 (ts-c/mount-ts-chart   state-pub {:every-ms 1000})

-(def tweets-comp (comp/component-with-channels tw/init-component (sliding-buffer 1) (buffer 1)))
+(def tweets-comp (toolbox-comp/component-with-channels tw/init-component (sliding-buffer 1) (buffer 1)))
 (sub state-pub :app-state (:in-chan tweets-comp))
 (pipe (:out-chan tweets-comp) cmd-chan)

-(r/wrap-component cv/count-view state-pub cmd-chan "tweet-count")
-(r/wrap-component cv/users-count-view state-pub cmd-chan "users-count")
-(r/wrap-component cv/total-count-view state-pub cmd-chan "total-tweet-count")
-(r/wrap-component pag/pagination-view state-pub cmd-chan "pagination")
-(r/wrap-component sv/search-view state-pub cmd-chan "search")
-(r/wrap-component st/sort-view state-pub cmd-chan "sort-buttons")
+(toolbox-r/init-component cv/count-view state-pub cmd-chan "tweet-count")
+(toolbox-r/init-component cv/users-count-view state-pub cmd-chan "users-count")
+(toolbox-r/init-component cv/total-count-view state-pub cmd-chan "total-tweet-count")
+(toolbox-r/init-component pag/pagination-view state-pub cmd-chan "pagination")
+(toolbox-r/init-component sv/search-view state-pub cmd-chan "search")
+(toolbox-r/init-component st/sort-view state-pub cmd-chan "sort-buttons")


drop element at back by default if there is not a dropped-position set

--- src/cljs/re_dnd/events.cljs
+++ src/cljs/re_dnd/events.cljs
@@ -113,7 +113,11 @@
    (when-not type
      (warn "Please set a :type key in the second parameter of options"))
    (if-not dropped-position ;;append
-     (update-in db [:dnd/state :drop-zones drop-zone-id] conj elt)
+     (update-in db [:dnd/state :drop-zones drop-zone-id]
+                (let [elts             (get-in db [:dnd/state :drop-zones drop-zone-id])
+                      dropped-position (count elts)]
+                  (partial insert-at-pos dropped-position))
+                elt)
      (update-in db
                 [:dnd/state :drop-zones drop-zone-id]
                 (partial insert-at-pos dropped-position)


tests for Genetic Reseq, High-Risk Investment, Hostile Takeover, TGTBT

--- src/clj/test/cards-agendas.clj
+++ src/clj/test/cards-agendas.clj
@@ -129,6 +129,55 @@
     (is (= 3 (count (:hand (get-runner)))) "Runner took 2 net damage from Fetal AI")
     (is (= 0 (count (:scored (get-runner)))) "Runner could not steal Fetal AI")))

+(deftest genetic-resequencing
+  "Genetic Resequencing - Place 1 agenda counter on a scored agenda"
+  (do-game
+    (new-game (default-corp [(qty "Genetic Resequencing" 1) (qty "Braintrust" 2)])
+              (default-runner))
+    (play-from-hand state :corp "Braintrust" "New remote")
+    (play-from-hand state :corp "Braintrust" "New remote")
+    (play-from-hand state :corp "Genetic Resequencing" "New remote")
+    (let [bt1 (get-in @state [:corp :servers :remote1 :content 0])
+          bt2 (get-in @state [:corp :servers :remote2 :content 0])
+          gr (get-in @state [:corp :servers :remote3 :content 0])]
+      (score-agenda state :corp bt1)
+      (let [btscored (get-in @state [:corp :scored 0])]
+        (is (= 0 (:counter (refresh btscored))) "No agenda counters on scored Braintrust")
+        (score-agenda state :corp gr)
+        (prompt-select :corp bt2)
+        (is (nil? (:counter (refresh bt2))) "No agenda counters on installed Braintrust; not a valid target")
+        (prompt-select :corp btscored)
+        (is (= 1 (:counter (refresh btscored))) "1 agenda counter placed on scored Braintrust")))))
+
+(deftest high-risk-investment
+  "High-Risk Investment - Gain 1 agenda counter when scored; spend it to gain credits equal to Runner's credits"
+  (do-game
+    (new-game (default-corp [(qty "High-Risk Investment" 1)]) (default-runner))
+    (play-from-hand state :corp "High-Risk Investment" "New remote")
+    (let [hri (get-in @state [:corp :servers :remote1 :content 0])]
+      (score-agenda state :corp hri)
+      (let [hriscored (get-in @state [:corp :scored 0])]
+        (is (= 1 (:counter (refresh hriscored))) "Has 1 agenda counter")
+        (take-credits state :corp)
+        (is (= 7 (:credit (get-corp))))
+        (take-credits state :runner)
+        (is (= 9 (:credit (get-runner))))
+        (card-ability state :corp hriscored 0)
+        (is (= 16 (:credit (get-corp))) "Gained 9 credits")
+        (is (= 2 (:click (get-corp))) "Spent 1 click")
+        (is (= 0 (:counter (refresh hriscored))) "Spent agenda counter")))))
+
+(deftest hostile-takeover
+  "Hostile Takeover - Gain 7 credits and take 1 bad publicity"
+  (do-game
+    (new-game (default-corp [(qty "Hostile Takeover" 1)])
+              (default-runner))
+    (play-from-hand state :corp "Hostile Takeover" "New remote")
+    (let [ht (get-in @state [:corp :servers :remote1 :content 0])]
+      (score-agenda state :corp ht)
+      (is (= 12 (:credit (get-corp))))
+      (is (= 1 (:bad-publicity (get-corp)))))))
+
 (deftest napd-contract
   "NAPD Contract - Requires 4 credits to steal; scoring requirement increases with bad publicity"
   (do-game
@@ -215,6 +264,33 @@
           (core/score state :corp {:card (refresh pb2)})
           (is (= 5 (:agenda-point (get-corp))) "5 advancements: scored for 3 points")))))

+(deftest tgtbt
+  "TGTBT - Give the Runner 1 tag when they access"
+  (do-game
+    (new-game (default-corp [(qty "TGTBT" 2) (qty "Old Hollywood Grid" 1)])
+              (default-runner))
+    (play-from-hand state :corp "TGTBT" "New remote")
+    (play-from-hand state :corp "Old Hollywood Grid" "Server 1")
+    (play-from-hand state :corp "TGTBT" "New remote")
+    (take-credits state :corp)
+    (let [tg1 (get-in @state [:corp :servers :remote1 :content 0])
+          ohg (get-in @state [:corp :servers :remote1 :content 1])
+          tg2 (get-in @state [:corp :servers :remote2 :content 0])]
+      (core/click-run state :runner {:server :remote1})
+      (core/rez state :corp ohg)
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (prompt-select :runner tg1)
+      (prompt-choice :runner "OK") ; Accesses TGTBT but can't steal
+      (is (= 1 (:tag (get-runner))) "Runner took 1 tag from accessing without stealing")
+      (prompt-select :runner ohg)
+      (prompt-choice :runner "Yes") ; Trashes OHG
+      (core/click-run state :runner {:server :remote2})
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (prompt-choice :runner "Steal") ; Accesses TGTBT but can't steal
+      (is (= 2 (:tag (get-runner))) "Runner took 1 tag from accessing and stealing"))))
+
 (deftest the-cleaners
   "The Cleaners - Bonus damage"
   (do-game


Remove dns cache setting from simulation namespace

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -105,7 +105,6 @@
   (apply concat (repeatedly (count scenarios) #(<!! results)))))

 (defn run-simulation [scenarios users & [options]]
- (java.security.Security/setProperty "networkaddress.cache.ttl" "-1")
   (let [requests (or (:requests options) (* users (distinct-request-count scenarios)))
         duration (:duration options)
         step-timeout (or (:timeout-in-ms options) 5000)


Parser changes, fix attempts

Parser changes, fix attempts

--- src/clj_hypergraph_db/core.clj
+++ src/clj_hypergraph_db/core.clj
@@ -69,9 +69,10 @@
   (do
     (info db-type)
     (info tokens)
+    (info (get database-model-parsing-namespaces db-type))
     ;; transform the input list by evaluating each form in the list
     ;; in clj_hypergraph_db.model namespace
-    (map #(binding [*ns* (find-ns (get database-model-parsing-namespaces db-type))] (eval %)) (read-string tokens)))))
+    (map #(binding [*ns* (find-ns (get database-model-parsing-namespaces db-type))] (eval %))  (read-string file)))))


enrich default account settings

enrich default account settings

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -303,12 +303,21 @@
                          :title "Click here to return to the list of accounts."}
      "Back"]))

+(defn- new-account-defaults
+  [{:keys [entity-id parent-id]}]
+  (let [parent (if parent-id
+                 (accounts/find-by-id (env :db) (Integer. parent-id)))
+        account {:entity-id (Integer. entity-id)}]
+    (if parent
+      (-> account
+          (assoc :parent-id (:id parent))
+          (assoc :type (:type parent)))
+      account)))
+
 (defn new-account
   "Renders the new account form"
   ([{params :params :as req}]
-   (new-account req (reduce #(assoc %1 %2 (Integer. (%2 params)))
-                            {}
-                            [:entity-id :parent-id])))
+   (new-account req (new-account-defaults params)))
   ([{params :params} account]
    (let [entity-id (Integer. (:entity-id params))]
      (with-accounts-layout "New account" entity-id {}


RR: show calculate field answers on viewby

--- src/cljs/hatti/map/viewby.cljs
+++ src/cljs/hatti/map/viewby.cljs
@@ -52,6 +52,7 @@
    is a list of list of strings. For other types, a list of strings."
   (cond
    (f/select-one? field) raw-answers
+   (f/calculate? field) raw-answers
 ;   (f/numeric? field)    (evenly-spaced-bins raw-answers 5 "int")
 ;   (f/time-based? field) (evenly-spaced-bins raw-answers 5 "date")
    (f/select-all? field) (->> raw-answers
@@ -81,8 +82,9 @@
         ans-s (preprocess-answers field raw-answers)
         answer->count (frequencies (flatten ans-s))
         sorted (cond
-                (f/categorical? field) (map first
-                                            (sort-by second > answer->count))
+                 (or (f/categorical? field)
+                     (f/calculate? field)) (map first
+                                                (sort-by second > answer->count))
                 (or (f/time-based? field) (f/numeric? field)) (-> ans-s meta :bins))
         sorted-nil-at-end (move-nil-to-end sorted)
         colors (field->colors field)


Add merge! to stage fns.

Add merge! to stage fns.

--- src/cljx/geschichte/stage.cljx
+++ src/cljx/geschichte/stage.cljx
@@ -270,16 +270,20 @@
   (sync! stage repos))

+(defn merge!
+  "Merge multiple heads in a branch of a repository. Optionally reorder
+heads to resolve conflicts."
+  ([stage [user repo branch]]
+     (let [meta (get-in @stage [user repo :meta])]
+       (merge! stage [user repo branch] (repo/merge-heads meta branch meta branch))))
+  ([stage [user repo branch] heads-order]
+     (swap! stage (fn [{{u :user} :config :as old}]
+                    (update-in old [user repo]
+                               #(repo/merge % u branch (:meta %) heads-order))))
+     (sync! stage {user {repo #{branch}}})))
+
+
 (comment
-  ;; example stage
-  {:volatile {:chans [nil nil]
-              :store nil
-              :peer nil}
-   :id 123
-   :user "john"
-   "john" {42 {:id 42
-               :causal-order {}}}}
-
   (require '[geschichte.sync :refer [client-peer]])
   (require '[konserve.store :refer [new-mem-store]])
   (go (def peer (client-peer "TEST-PEER" (<! (new-mem-store)))))
@@ -294,9 +298,10 @@
   ["jim" 42 "featureX"] ;; identity
   (branch! stage ["jim" 42 123] "featureX")
   (checkout! stage ["jim" 42 "featureX"])
-  (transact stage ["john" #uuid "b9f537fa-dace-4b88-b4ec-a81a1c72e6b7" "master"] {:b 2} 'clojure.core/merge)
-  (commit! stage {"john" {#uuid  "b9f537fa-dace-4b88-b4ec-a81a1c72e6b7" #{"master"}}})
-  (merge! stage ["john" 42 "master"])
+  (transact stage ["john" #uuid "36e02e84-a8a5-47e6-9865-e4ac0ba243d6" "master"] {:b 2} 'clojure.core/merge)
+  (go (doseq [i (range 10)]
+        (<! (commit! stage {"john" {#uuid "36e02e84-a8a5-47e6-9865-e4ac0ba243d6" #{"master"}}}))))
+  (merge! stage ["john" #uuid "9bc896ed-9173-4357-abbe-c7eca1512dc5" "master"])
   (pull! stage ["john" 42 "master"] ["jim" 42 "master"])


Progragation of dirtied flag.

Progragation of dirtied flag.

--- src/clojure/freactive/core.clj
+++ src/clojure/freactive/core.clj
@@ -117,31 +117,32 @@
                   compute))))))]
    (clojure.core/reset! data (ReactiveState. reactive-proxy true nil f nil sully-fn))
     (.addWatch data :proxy-forward
-               (fn notify-forwarder [k r old-value new-value]
-                 (let [old-value (:value old-value)
-                       new-value (:value new-value)]
-                   (when (not= old-value new-value)
+               (fn notify-forwarder [k r old-state new-state]
+                 (let [old-value (:value old-state)
+                       new-value (:value new-state)
+                       sullied (and (:dirty new-state) (not (:dirty old-state)))]
+                   (when (or (not= old-value new-value) sullied)
                      (.notifyWatches reactive-proxy old-value new-value)))))
     (#'clojure.core/setup-reference reactive-proxy options)))

 (defn simple [f] (with-meta f (merge (meta f) {:simple true})))

-;; (import '(java.util TimerTask Timer))
+(import '(java.util TimerTask Timer))

-;; (defn test1 []
-;;   (let [a (atom 0)
-;;         b (atom 0)
-;;         c (reactive (fn [] (+ @a @b)))
-;;         d (atom 0)
-;;         e (reactive (fn [] (+ @c @d)))
-;;         task (proxy [TimerTask] []
-;;                (run [] @e @c))]
-;;     (. (new Timer) (schedule task (long 16)))
-;;     (time
-;;      (dotimes [i 1000000]
-;;        (swap! a inc)
-;;        (swap! b inc)
-;;        (swap! d inc)))
-;;     (println @a @b (+ @a @b) @c)))
+(defn test1 []
+  (let [a (atom 0)
+        b (atom 0)
+        c (reactive (fn [] (+ @a @b)))
+        d (atom 0)
+        e (reactive (fn [] (+ @c @d)))
+        task (proxy [TimerTask] []
+               (run [] @e @c))]
+    (. (new Timer) (schedule task (long 16)))
+    (time
+     (dotimes [i 1000000]
+       (swap! a inc)
+       (swap! b inc)
+       (swap! d inc)))
+    (println @a @b (+ @a @b) @c)))

-;; (test1)
+(test1)


parkour.io.mux is not private.

parkour.io.mux is not private.

--- src/clojure/parkour/io/mux.clj
+++ src/clojure/parkour/io/mux.clj
@@ -1,5 +1,4 @@
 (ns parkour.io.mux
-  {:private true}
   (:require [clojure.edn :as edn]
             [parkour (conf :as conf) (mapreduce :as mr)]
             [parkour.graph (conf :as pgc) (dseq :as dseq)]


Complete review function

Complete review function

--- src/antlion_clojure/bot.clj
+++ src/antlion_clojure/bot.clj
@@ -254,7 +254,7 @@
    u]
    (if (from-master? slack res)
      (do
-       (some-> user redis/add-reviewer)
+       (some-> u slack/parse-user redis/add-reviewer)
        (map->Payload {:type :message
                       :user user
                       :channel channel
@@ -273,7 +273,7 @@
    u]
    (if (from-master? slack res)
      (do
-       (some-> user redis/rm-reviewer)
+       (some-> u slack/parse-user redis/rm-reviewer)
        (map->Payload {:type :message
                       :user user
                       :channel channel
@@ -287,10 +287,23 @@
                      :text "ｹﾝｹﾞﾝｶﾞﾅｲｰﾖ!"})))

 (defn- review
-  [slack
-   {:keys [user channel] :as res}
+  [{:keys [user channel] :as res}
    pr]
-  (let [reviewer (some-> (redis/get-all-reviewers) seq rand-nth)]))
+  (let [reviewer (some-> (redis/get-all-reviewers) seq rand-nth)]
+    (cond (not reviewer) (map->Payload {:type :message
+                                        :user user
+                                        :channel channel
+                                        :text (str "ﾚﾋﾞｭﾜｰｶﾞｲﾅｲﾖ!")})
+
+          (not pr) (map->Payload {:type :message
+                                  :user user
+                                  :channel channel
+                                  :text (str "prﾁｮｳﾀﾞｲ!")})
+          :else (map->Payload {:type :message
+                               :user reviewer
+                               :channel channel
+                               :text (str "っ＝[レビューをお願いします]\n"
+                                          pr)}))))

 (defn- help
   [{:keys [user channel] :as res} me]
@@ -305,6 +318,7 @@
                       me " fyi                           : メモ一覧を表示\n"
                       me " set-fyi <title> <body>        : <title> <body>をメモ\n"
                       me " del-fyi <title>               : <title>を削除\n"
+                      me " review <pr>                   : <pr>を誰かに割り振る\n"
                       me " <S-Expression>                : <S-Expression>を評価\n"
                       "------------------ 管理者限定機能 ------------------\n"
                       me " add-allowed-channel <channel> : <channel>を監視対象から外す\n"
@@ -343,6 +357,7 @@
       "del-problem" (del-problem slack res (first args))
       "set-fyi" (set-fyi res (first args) (second args))
       "del-fyi" (del-fyi res (first args))
+      "review" (review res (first args))
       "add-allowed-channel" (add-allowed-channel slack res (first args))
       "rm-allowed-channel" (rm-allowed-channel slack res (first args))
       "add-reviewer" (add-reviewer slack res (first args))


Started profiling

Started profiling

not finished yet.

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

--- src/conexp/layout/force.clj
+++ src/conexp/layout/force.clj
@@ -23,13 +23,19 @@
     (+ (square (- x_1 x_2))
        (square (- y_1 y_2)))))

+(defn- distance
+  "Returns distance of two points."
+  [[x_1 y_1] [x_2 y_2]]
+  (with-doubles [x_1 y_1 x_2 y_2]
+    (Math/sqrt (+ (square (- x_1 x_2)) (square (- y_1 y_2))))))
+
 (defmacro sum
   "Sums up all values of bindings obtained with expr. See for."
   [bindings expr]
   `(reduce +
 	   (double 0)
 	   (for ~bindings
-	     ~expr)))
+	     (double ~expr))))

 ;; Repulsive Energy

@@ -38,30 +44,29 @@
   [[x, y] [[x_1, y_1] [x_2, y_2]]]
   (with-doubles [x, y, x_1, y_1, x_2, y_2]
     (if (and (= x_1 x_2) (= y_1 y_2))
-      (Math/sqrt (line-length-squared [x, y] [x_1, y_1]))
-      (let [ ;; position of projection of [x y] onto the line, single coordinate
+      (distance [x, y] [x_1, y_1])
+      (let [;; position of projection of [x y] onto the line, single coordinate
 	    r (/ (+ (* (- x x_1)
 		       (- x_2 x_1))
 		    (* (- y y_1)
 		       (- y_2 y_1)))
 		 (+ (square (- x_2 x_1))
-		    (square (- y_2 y_1))))]
-	(Math/sqrt (line-length-squared [x, y]
-					(cond
-					 (<= r 0) [x_1, y_1], ; node is behind [x_1, y_1]
-					 (>= r 1) [x_2, y_2], ; node is ahead [x_2, y_2]
-					 :else [(+ x_1 (* r (- x_2 x_1))), (+ y_1 (* r (- y_2 y_1)))])))))))
+		    (square (- y_2 y_1)))),
+	    r (min (max r 0) 1)]
+	(distance [x, y] [(+ x_1 (* r (- x_2 x_1))),
+			  (+ y_1 (* r (- y_2 y_1)))])))))

 (defn- repulsive-energy
   "Computes the repulsive energy of the given layout."
   [[node-positions node-connections]]
   (try
-   (sum [v (keys node-positions),
-	 [x y] node-connections,
-	 :when (and (not= x v)
-		    (not= y v))]
-	(/ 1 (node-line-distance (node-positions v)
-				 [(node-positions x), (node-positions y)])))
+   (let [edges (map (fn [[x y]]
+		      [x y (get node-positions x) (get node-positions y)])
+		    node-connections)]
+     (sum [[v pos-v] node-positions,
+	   [x y pos-x pos-y] edges
+	   :when (not (#{x, y} v))]
+	 (/ (node-line-distance pos-v [pos-x, pos-y]))))
    (catch Exception e
      pos-infinity)))

@@ -87,9 +92,9 @@
   "Returns the gravitative energy of the given layout."
   [[node-positions node-connections] {inf-irrs :inf-irrs,
 				      upper-neighbours :upper-neighbours-of-inf-irrs}]
-  (let [phi_0 (/ Math/PI (+ 1 (count inf-irrs))),
-	E_0 (+ (- phi_0) (- (* (Math/sin phi_0) (Math/cos phi_0)))),
-	E_1 (+ E_0 Math/PI)]
+  (let [phi_0 (double (/ Math/PI (+ 1 (count inf-irrs)))),
+	E_0   (double (+ (- phi_0) (- (* (Math/sin phi_0) (Math/cos phi_0))))),
+	E_1   (double (+ E_0 Math/PI))]
     (try
      (sum [n inf-irrs]
 	  (let [phi_n (double (phi (node-positions n)


world-balance for changed > 0

world-balance for changed > 0

--- src-clj/acha/achievement.clj
+++ src-clj/acha/achievement.clj
@@ -143,9 +143,12 @@
         :time time}))])

 (def world-balance
-  (make-loc-scanner
-    [:world-balance
-    (fn [loc] (= (:added loc 0) (:deleted loc 0)))]))
+  [:world-balance
+   (fn [{:keys [loc author time changed-files]}]
+     (when (and ((fn [loc] (= (:added loc 0) (:deleted loc 0))) loc)
+          (> changed-files 0))
+       {:username author
+        :time time}))])

 (def eraser
   (make-loc-scanner


wrecking ball achievement

wrecking ball achievement

--- src-clj/acha/achievement.clj
+++ src-clj/acha/achievement.clj
@@ -258,6 +258,13 @@
        {:username author
         :time time}))])

+(def wrecking-ball
+  [:wrecking-ball
+   (fn [{:keys [changed-files author time]}]
+     (when (>= changed-files 100)
+       {:username author
+        :time time}))])
+
 ; TODO commit-info achievements
 (def cool-kid
   [:cool-kid
@@ -285,10 +292,6 @@
      nil)])
 (def for-stallman
   [:for-stallman
-   (fn [commit-info]
-     nil)])
-(def wrecking-ball
-  [:wrecking-ball
    (fn [commit-info]
      nil)])
 (def alzheimers


Fixes to clean/activate code.

Fixes to clean/activate code.

--- src-cljs/freactive/core.cljs
+++ src-cljs/freactive/core.cljs
@@ -313,9 +313,10 @@
           (.rawDeref this)
           (set! (.-dirty this) false))))
     (clean [this]
-      (when-let [clean-fn (.-clean-fn this)]
-        (set! (.-dirty this) true)
-        (clean-fn)))
+      (when (identical? 0 watches)
+        (when-let [clean-fn (.-clean-fn this)]
+          (set! (.-dirty this) true)
+          (clean-fn))))
     (updateChild [this key f args]
       (set! (.-change-ks this) [key])
       (apply swap-fn update key f args)
@@ -393,7 +394,7 @@
       (when (aget (.-fwatches this) key)
         (set! (.-watchers this) (dec (.-watchers this)))
         (js-delete (.-fwatches this) key)
-        (when (identical? watchers 0) (.clean this))))
+        (.clean this)))
     (notifyFWatches [this oldVal newVal]
       (goog.object/forEach
        (.-fwatches this)
@@ -433,8 +434,7 @@
       (when (contains? watches key)
         (set! (.-watchers this) (dec watchers))
         (set! (.-watches this) (dissoc watches key))
-        (when (identical? watchers 0)
-          (.clean this)))
+        (.clean this))
       this)

     IKeysetCursor
@@ -467,7 +467,7 @@
                            nil nil #js {} 0 nil)
               activate-fn (fn [] (set! child-cursors (update child-cursors ckey conj cur)))]
           (activate-fn)
-          (set! (.-active-fn cur) activate-fn)
+          (set! (.-activate-fn cur) activate-fn)
           (set! (.-clean-fn cur)
                 (fn []
                   (set! child-cursors


convert routes to new 'defendpoint' macro and tidy up implementations.  also added implementation for password update endpoint.

--- src/metabase/api/user.clj
+++ src/metabase/api/user.clj
@@ -6,55 +6,49 @@
             [metabase.models.user :refer [User]]))

-(def user-list
-  (GET "/" []
-       ;; TODO - permissions check
-       ;; TODO - map to serializer.
-       {:status 200
-        :body (sel :many User :is_active true)}))
+(defendpoint GET "/" []
+  ;; TODO - permissions check
+  ;; TODO - limit the keys available in the response objects
+  (sel :many User :is_active true))

-(def user-get
-  (GET "/:user-id" [user-id]
-       ;; TODO - permissions check
-       ;; TODO - map to serializer.  strip fields (is_active, is_staff).  calculate fields (common_name)
-       (let-or-404 [user (sel :one User :id user-id)]
-                   {:status 200
-                    ;; TODO - we need a reusable way to do something like this for serializing output for responses
-                    :body (select-keys user [:id :email :first_name :last_name :last_login :is_superuser])})))
+
+(defendpoint GET "/:user-id" [user-id]
+  ;; TODO - permissions check
+  ;; TODO - map to serializer.  strip fields (is_active, is_staff).  calculate fields (common_name)
+  (let-or-404 [user (sel :one User :id user-id)]
+    ;; TODO - we need a reusable way to do something like this for serializing output for responses
+    (select-keys user [:id :email :first_name :last_name :last_login :is_superuser])))
+

 (defendpoint GET "/current" []
   (or-404-> (*current-user*)
     (hydrate [:org_perms :organization])))

-(def user-update
-  (PUT "/:user-id" [user-id :as {body :body}]
-       ;; TODO - permissions check
-       ;; TODO - validations (email address must be unique)
-       (let-or-404 [user (sel :one User :id user-id)]
-                   ;; TODO - how can we pass a useful error message in the 500 response on error?
-                   (do
-                     ;; TODO - is there a more idiomatic way to do this?  update row, then select it for output
-                     (upd User user-id
-                          ;; TODO - find a way to make this cleaner.  we don't want to modify the value if it doesn't exist
-                          :email (get body :email (:email user))
-                          :first_name (get body :first_name (:first_name user))
-                          :last_name (get body :last_name (:last_name user)))
-                     (let [updated-user (sel :one User :id user-id)]
-                       {:status 200
-                        :body (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser])})))))

-(def user-update-password
-  (PUT "/:user-id/password" [user-id :as {body :body}]
-       ;; TODO - implementation
-       {:status 200
-        :body {}}))
+(defendpoint PUT "/:user-id" [user-id :as {body :body}]
+  ;; TODO - permissions check
+  ;; TODO - validations (email address must be unique)
+  (let-or-404 [user (sel :one User :id user-id)]
+    ;; TODO - how can we pass a useful error message in the 500 response on error?
+    (do
+     ;; TODO - is there a more idiomatic way to do this?  update row, then select it for output
+     (upd User user-id
+          ;; TODO - find a way to make this cleaner.  we don't want to modify the value if it doesn't exist
+          :email (get body :email (:email user))
+          :first_name (get body :first_name (:first_name user))
+          :last_name (get body :last_name (:last_name user)))
+     (let [updated-user (sel :one User :id user-id)]
+       (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser])))))

-(define-routes
-  ;; TODO - this feels bleh.  is it better to put the actual route data here
-  ;;        and just have the endpoints be plain functions?
-  ;;        best way to automate building this list?
-  user-list
-  user-get
-  user-update
-  user-update-password)
+(defendpoint PUT "/:user-id/password" [user-id :as {body :body}]
+  ;; TODO - password validation
+  ;; TODO - match old password against current one
+  (let-or-404 [user (sel :one User :id user-id)]
+    (upd User user-id
+         :password (get body :password))
+    (let [updated-user (sel :one User :id user-id)]
+      (select-keys updated-user [:id :email :first_name :last_name :last_login :is_superuser]))))
+
+
+(define-routes)


Changed indentation to make individual failures stand out more.

--- src/midje/util/report.clj
+++ src/midje/util/report.clj
@@ -32,33 +32,33 @@
    (list
     (fail-at m)
     (str "You never said " (:name (meta (:function m))) " would be needed with these arguments:")
-    (str (pr-str (:actual m)))))
+    (str "    " (pr-str (:actual m)))))

 (defmethod report-strings :mock-incorrect-call-count [m]
    (list
     (fail-at m)
     (str "You claimed the following was needed, but it was never used:")
-    (str (:expected m))))
+    (str "    " (:expected m))))

 (defmethod report-strings :mock-expected-result-failure [m]
    (list
     (fail-at m)
-    (str "Expected: " (pr-str (:expected m)))
-    (str "  Actual: " (pr-str (:actual m)))))
+    (str "    Expected: " (pr-str (:expected m)))
+    (str "      Actual: " (pr-str (:actual m)))))

 (defmethod report-strings :mock-expected-result-functional-failure [m]
   (list
    (fail-at m)
    "Actual result did not agree with the checking function."
-   (str "    Actual result: " (without-nasty-looking-functions (:actual m)))
-   (str "Checking function: " (pr-str (:expected m)))
+   (str "        Actual result: " (without-nasty-looking-functions (:actual m)))
+   (str "    Checking function: " (pr-str (:expected m)))
    (if (:intermediate-results m)
-     (cons "During checking, these intermediate values were seen:"
-	   (map (fn [[form value]] (str "   " (pr-str form) " => " (pr-str value)))
+     (cons "    During checking, these intermediate values were seen:"
+	   (map (fn [[form value]] (str "       " (pr-str form) " => " (pr-str value)))
 		(:intermediate-results m))))
    (if (:notes m)
-     (cons "The checker said this about the reason:"
-	   (map (fn [note] (str "   " note))
+     (cons "    The checker said this about the reason:"
+	   (map (fn [note] (str "       " note))
  		(:notes m))))))

 (defmethod report-strings :future-fact [m]


Functions to clone or fetch repo mirror

Functions to clone or fetch repo mirror

--- src/branch_handler/core.clj
+++ src/branch_handler/core.clj
@@ -9,8 +9,9 @@
 (require '[clojure.tools.cli       :as cli])
 (require '[clojure.tools.logging   :as log])

-(def verbose true)
+(def verbose false)
 (def port 3000)
+(def workdir "work")

 (defn slurp-
     [filename]
@@ -55,10 +56,36 @@
            (.waitFor)
            (.destroy))))

-(defn clone-or-fetch-bare-repo
-    [repository-url]
-    (log/info "Cloning or fetching bare repository" repository-url)
-    )
+(defn repo-workdir
+    [workdir group reponame]
+    (clojure.string/join "/" [workdir group reponame]))
+
+(defn repodir-exists?
+    [workdir group reponame]
+    (let [f (new java.io.File (repo-workdir workdir group reponame))]
+        (.isDirectory f)))
+
+(defn fetch-mirror-repo
+    [workdir group reponame repository-url]
+    (log/info "Fetching mirror repository" repository-url)
+    ; TODO test --prune
+    (exec "git" "--git-dir" (repo-workdir workdir group reponame) "fetch"))
+
+(defn clone-mirror-repo
+    [workdir group reponame repository-url]
+    (log/info "Cloning mirror repository" repository-url)
+    (exec "git" "clone" "--mirror" repository-url (repo-workdir workdir group reponame)))
+
+(defn clone-or-fetch-mirror-repo
+    [action]
+    (log/info "Cloning or fetching repository")
+    (let [reponame       (:name action)
+          group          (:group action)
+          repository-url (:url action)]
+          (log/info (repo-workdir workdir group reponame))
+          (if (repodir-exists? workdir group reponame)
+              (fetch-mirror-repo workdir group reponame repository-url)
+              (clone-mirror-repo workdir group reponame repository-url))))

 (def actions (java.util.concurrent.LinkedBlockingQueue.))


start separation of store and game loop

start separation of store and game loop

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -44,24 +44,22 @@
       (turn/get-moves-of @current-turn @current-player)
       {})))

+(defn play-game-turn! [move]
+  (swap! app-state update :game game/play-move move))
+
+(defn- handle-game-event!
+  [msg]
+  (case msg
+    :new-game (swap! app-state assoc :game (game/new-game))
+    :restart (swap! app-state update :game #(take-last 1 %))
+    :undo (swap! app-state update :game game/undo-player-move is-ai?)
+    :ai-play (play-game-turn! (ai/best-move @current-turn @current-player))
+    ))
+

 ;; -----------------------------------------
 ;; GAME LOOP
 ;; -----------------------------------------
-
-(defn play-game-turn! [move]
-  (swap! app-state update-in [:game] game/play-move move))
-
-(defn- handle-ai! []
-  (let [move (ai/best-move @current-turn @current-player)]
-    (play-game-turn! move)))
-
-(defn- handle-game-event!
-  [msg]
-  (case msg
-    :new-game (swap! app-state assoc-in [:game] (game/new-game))
-    :restart (swap! app-state update-in [:game] #(take-last 1 %))
-    :undo (swap! app-state update-in [:game] game/undo-player-move is-ai?)))

 (defn start-game-loop
   "Manage transitions between player moves, ai moves, and generic game events"
@@ -74,7 +72,7 @@
         (alt!
           game-events ([msg] (handle-game-event! msg))
           player-events ([coord] (play-game-turn! coord))
-          (async/timeout ai-move-delay) ([_] (if (is-ai? @current-player) (handle-ai!)))
+          (async/timeout ai-move-delay) ([_] (if (is-ai? @current-player) (handle-game-event! :ai-play)))
           )))
     {:player-events player-events
      :game-events game-events}))


Init board

Init board

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -26,7 +26,7 @@
 (defn draw-slices
   "Draw n * m slices from the collection"
   [n slices positions]
-  (map
+  (mapcat
     (fn [k] (map vector
               (repeat (nth slices k))
               (subvec positions (* k n) (* (inc k) n))
@@ -42,7 +42,10 @@
 (defn new-board
   "Create a new board"
   []
-  empty-board)
+  (reduce (fn [r [color [x y]]]
+            (prn [x y])
+            (assoc-in r [x y] color))
+    empty-board (init-positions)))

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

@@ -53,7 +56,7 @@

 (defn empty-cell
   "Draws an empty cell"
-  [x y]
+  [x y color]
   [:rect {:width 0.9
           :height 0.9
           :x (+ 0.05 x)
@@ -69,7 +72,11 @@
      (for [[x y] all-positions]
        ^{:key [x y]}
        (case (get-in @app-state [:board x y])
-         :empty  [empty-cell x y])
+         :empty  [empty-cell x y]
+         :blue [empty-cell x y]
+         :red [empty-cell x y]
+         :green [empty-cell x y]
+         :gray [empty-cell x y])
        ))
    ])


Minor refactoring

Minor refactoring

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -191,11 +191,10 @@
    * And with move scope limitation"
   [moves move-filter]
   (fast-max-key
-    #(transduce
-       (comp
-         (filter move-filter)
-         (map move-strength))
-       + (second %))
+    (fn [[point converted]]
+      (transduce
+        (comp (filter move-filter) (map move-strength))
+        + converted))
     moves))

 (defn worst-immediate-loss


Correct indentation. :)

Correct indentation. :)

--- src/cljs/vinculum/core.cljs
+++ src/cljs/vinculum/core.cljs
@@ -83,14 +83,15 @@
   (fetch-data)
   (js/setInterval fetch-data 10000)
   (om/root
- (fn [app owner]
-   (reify
-     om/IRender
-     (render [_]
-       (html
-        [:div {:class "container"}
-         [:h1 "Weight chart"]
-         [:div {:id "chart"}]
-         [:div {:id "error"}]
-         (om/build line-chart (:weight app) {:opts {:id "chart"}})]))))
- app-state {:target (. js/document (getElementById "app"))}))
+   (fn [app owner]
+     (reify
+       om/IRender
+       (render [_]
+         (html
+          [:div {:class "container"}
+           [:h1 "Weight chart"]
+           [:div {:id "chart"}]
+           [:div {:id "error"}]
+           (om/build line-chart (:weight app) {:opts {:id "chart"}})
+           ]))))
+   app-state {:target (. js/document (getElementById "app"))}))


fixes

fixes

--- src/cljs/worktv/layout.cljs
+++ src/cljs/worktv/layout.cljs
@@ -116,23 +116,16 @@

 (defn data-view [url template refresh]
   (with-let [data (atom nil)
-             last-url (atom url)
-             last-refresh (atom nil)
              load (fn []
                     (GET url :handler #(reset! data %) :response-format :json
-                         :error-handler #(js/console.log "failed fetching " url ";" %))
-                    (reset! last-url url))
-             interval-id (atom nil)]
-    (when (not= refresh @last-refresh)
-      (if @interval-id (.clearInterval js/window @interval-id))
-      (if (and refresh (> refresh 0))
-        (reset! interval-id (js/setInterval load (* refresh 1000))))
-      (reset! last-refresh refresh))
-    (if-not (and @data (= @last-url url)) (load))
+                         :error-handler #(js/console.log "failed fetching " url ";" %)))
+             _ (load)]
+    (js/setTimeout load (* (Math/max 60 refresh) 1000))
     [:div.fit {:style {:overflow "hidden"} :dangerouslySetInnerHTML
                {:__html (js/Mustache.render template (clj->js (or @data "no data")))}}]))

 (defmethod content-view :custom [{:keys [url template title refresh-interval]}]
+  (js/console.log "custom:" url)
   (if (and url template)
     [data-view url template refresh-interval]
     [:div.fit "Missing url and/or template"]))


Support order-by query option from JS.

Support order-by query option from JS.

--- src/common/datomish/js.cljs
+++ src/common/datomish/js.cljs
@@ -8,6 +8,9 @@
      [datomish.pair-chan :refer [go-pair <?]]
      [datomish.promises :refer [go-promise]])
   (:require
+     [datomish.util
+      :as util
+      :refer-macros [raise raise-str cond-let]]
      [cljs.core.async :as a :refer [take! <! >!]]
      [cljs.reader]
      [cljs-promises.core :refer [promise]]
@@ -27,9 +30,29 @@

 (def ^:export db d/db)

+(defn- cljify-options [options]
+  ;; Step one: basic parsing.
+  (let [o (cljify options)]
+    ;; Step two: convert `order-by` into keywords.
+    (if-let [ord (:order-by o)]
+      (assoc o
+             :order-by
+             (map
+               (fn [[var dir]]
+                 [(keyword var)
+                  (case dir
+                        "asc"  :asc
+                        "desc" :desc
+                        nil    :asc
+                        :default
+                        (raise "Unexpected order-by direction " dir
+                               {:direction dir}))])
+               ord))
+      o)))
+
 (defn ^:export q [db find options]
   (let [find (cljs.reader/read-string find)
-        opts (cljify options)]
+        opts (cljify-options options)]
     (take-pair-as-promise!
       (d/<q db find opts)
       clj->js)))
@@ -37,7 +60,6 @@
 (defn ^:export ensure-schema [conn simple-schema]
   (let [simple-schema (cljify simple-schema)
         datoms (simple-schema/simple-schema->schema simple-schema)]
-    (println "Transacting schema datoms" (pr-str datoms))
     (take-pair-as-promise!
       (d/<transact!
         conn


Adding a border algorithm to compute the edges of a lattice

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

--- src/conexp/layouts/util.clj
+++ src/conexp/layouts/util.clj
@@ -93,6 +93,30 @@
   (set-of [x y] [x (base-set lattice),
                  y (base-set lattice),
                  :when (directly-neighboured? lattice x y)]))
+
+(defn- edges-by-border
+  "Computes edges of a lattice by a border algorithm as given by José
+  L. Balcázar and Cristina Tîrnǎucǎ."
+  [lattice]
+  (let [sup (sup lattice)
+        L   (reverse (topological-sort (order lattice) (base-set lattice))),
+        B   #{}
+        H   #{}]
+    (loop [L L, B B, H H]
+      (if (not-empty L)
+        (let [x     (first L),
+              cover (partial-min (order lattice)
+                                 (map #(sup x %) B))]
+          (recur (rest L)
+                 (reduce! (fn [set y]
+                            (disj! set y))
+                          (conj B x)
+                          cover)
+                 (reduce! (fn [set z]
+                            (conj! set [x z]))
+                          H
+                          cover)))
+        H))))

 (defn top-down-elements-in-layout
   "Returns the elements in layout ordered top down."


prompt check list

prompt check list

--- src/pretty/cli/prompt.clj
+++ src/pretty/cli/prompt.clj
@@ -1,7 +1,8 @@
 (ns pretty.cli.prompt
   (:require [pretty.cli.colors :as c]
             [pretty.cli.ansi-escapes :as esc]
-            [schema.core :as s])
+            [schema.core :as s]
+            [clojure.string :as str])
   (:import [jline Terminal]))

 (s/defschema CHOICE {(s/required-key :label) (s/constrained s/Str #(not (clojure.string/blank? %)))
@@ -54,6 +55,12 @@
                      (str (c/cyan " ▸  ") opt-checked-label)
                      (str "    " opt-checked-label)))) opts))

+(defn- restore-terminal!
+  "Restore Terminal configuration"
+  [term]
+  (.restoreTerminal term)
+  (print (esc/cursor-show)))
+
 (defn- prompt-select-list
   "Prompt a list of elements with 1 selected answer" ;TODO write right desc...
   [question choices selected submitted? first-rendering?]
@@ -64,8 +71,7 @@
       (let [opt-selected (nth choices selected nil)
             opt-selected-label (get opt-selected :label)
             opt-selected-val (get opt-selected :value)]
-        (.restoreTerminal term)
-        (print (esc/cursor-show))
+        (restore-terminal! term)
         (println (str "[" (c/green "▸") "] " question ": " (c/cyan opt-selected-label)))
         opt-selected-val)

@@ -90,7 +96,8 @@
                                                  (prompt-select-list question choices (mod (dec selected) num-opts) false false))
                                    (= 66 last) (do
                                                  (clear-list! num-opts)
-                                                 (prompt-select-list question choices (mod (inc selected) num-opts) false false))))))
+                                                 (prompt-select-list question choices (mod (inc selected) num-opts) false false))))
+                               (restore-terminal! term)))
             :else (do
                     (clear-list! num-opts)
                     (prompt-select-list question choices selected false false))))))))
@@ -102,13 +109,13 @@
   (let [term (Terminal/getTerminal)]
     (print (esc/cursor-hide))
     (if (= true submitted?)
-      (let [opt-selected (nth choices selected nil)
-            opt-selected-label (get opt-selected :label)
-            opt-selected-val (get opt-selected :value)]
+      (let [selected-choices (->> choices
+                                  (filter #(= true (get % :checked)))
+                                  (map #(get % :value)))]
         (.restoreTerminal term)
         (print (esc/cursor-show))
-        (println (str "[" (c/green "▸") "] " question ": " (c/cyan opt-selected-label)))
-        opt-selected-val)
+        (println (str "[" (c/green "▸") "] " question ": " (c/cyan (str/join ", " selected-choices))))
+        selected-choices)

       (let [num-opts (count choices)
             tip (if (= true first-rendering?) (c/dim " (UP/DOWN move, SPACE check/uncheck, ENTER submit)") "")]
@@ -120,7 +127,14 @@
           (cond
             (= 10 pressed) (do
                              (clear-list! num-opts)
-                             (prompt-select-list question choices selected true false))
+                             (prompt-check-list question choices selected true false))
+
+            (= 32 pressed) (let [new-choices (map-indexed (fn [i opt]
+                                                            (if (= i selected)
+                                                              (assoc opt :checked (not (get opt :checked false)))
+                                                              opt)) choices)]
+                             (clear-list! num-opts)
+                             (prompt-check-list question new-choices selected false false))

             (= 27 pressed) (let [next (.readCharacter term System/in)]
                              (if (= 91 next)
@@ -131,13 +145,11 @@
                                                  (prompt-check-list question choices (mod (dec selected) num-opts) false false))
                                    (= 66 last) (do
                                                  (clear-list! num-opts)
-                                                 (prompt-check-list question choices (mod (inc selected) num-opts) false false))))))
+                                                 (prompt-check-list question choices (mod (inc selected) num-opts) false false))))
+                               (restore-terminal! term)))
             :else (do
                     (clear-list! num-opts)
-                    (prompt-select-list question choices selected false false))))
-        )))
-
-  )
+                    (prompt-check-list question choices selected false false))))))))

 ; Public functions


cleanup: manual trigger no longer needs to print stuff to terminal, the information where to POST to to trigger the build is passed on to the ui

--- src/lambdaci/manualtrigger.clj
+++ src/lambdaci/manualtrigger.clj
@@ -20,5 +20,4 @@

 (defn wait-for-manual-trigger [& _]
   (let [id (str (java.util.UUID/randomUUID))]
-    (println "waititing for manual trigger, POST to id" id) ;; try returning a result with status-channel and the id, see what the UI can do with it?
     (assoc (wait-for-async #(was-posted? id)) :trigger-id id)))


unnecessary newlines

unnecessary newlines

--- src/latte_compiler/grammar.clj
+++ src/latte_compiler/grammar.clj
@@ -8,10 +8,8 @@

 (def FILE
   (clojure.java.io/resource FILENAME))
-
 (def latte_parser
   (insta/parser FILE :start :program))
-
 (defn wrap
   [name val]
   [name val])
@@ -21,7 +19,6 @@

 (def stringify
   #(->> %& (map str) (apply str) (wrap :ident)))
-
 (def latte
   #(->> (latte_parser %)
     (insta/add-line-and-column-info-to-metadata %)
@@ -30,13 +27,10 @@
        :ident   stringify
        :elitint intify
        })))
-
 (defn parse
   [code]
   (let [parse (latte code)]
     (if (insta/failure? parse)
       (util/err (insta/get-failure parse))
       (util/succ parse)
-      )
-    )
-  )
+      )))


Small bit of optimization; not creating more temporaries than are necessary.

--- src/cortex/compute/math.clj
+++ src/cortex/compute/math.clj
@@ -215,12 +215,19 @@
   ([stream datatype data batch-size]
    (let [batch-size (long batch-size)
          data-shape (m/shape data)
-         data-ary (make-java-array datatype data)
-         ;;synchronous call.
-         data-ptr (drv/host-array->device-buffer stream data-ary :datatype datatype)
-         n-elems (m/ecount data-ary)
+         n-elems (long (apply * data-shape))
+         device (drv/get-device stream)
+         host-buffer (drv/allocate-host-buffer
+                      (drv/get-driver device)
+                      n-elems datatype)
+         dev-buffer (drv/allocate-device-buffer n-elems datatype
+                                                        :device device)
          tensor (core-mat-shape->tensor data-shape batch-size)]
-     (->DeviceArray data-ptr tensor)))
+     (dtype/copy-raw->item! data host-buffer 0)
+     (drv/copy-host->device stream host-buffer 0 dev-buffer 0 n-elems)
+     (drv/sync-stream stream)
+     (resource/release host-buffer)
+     (->DeviceArray dev-buffer tensor)))
   ([stream datatype data] (array stream datatype data 1)))


Update tools-deps to 1.10.3.998

Update tools-deps to 1.10.3.998


fix macroexpand

fix macroexpand

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -1991,7 +1991,7 @@
     "Argument to macroexpand must be quoted")
   (core/let [form (second quoted)
              env &env]
-    (core/loop [form' (ana/macroexpand-1 env form)]
+    (core/loop [form form form' (ana/macroexpand-1 env form)]
       (core/if-not (core/identical? form form')
-        (recur (ana/macroexpand-1 env form'))
-        form'))))
+        (recur form' (ana/macroexpand-1 env form'))
+        `(quote ~form')))))


Remove unused argument.

Remove unused argument.

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -44,9 +44,9 @@
     (load-namespace repl-env ns)))

 (defn- display-error
-  ([ret form js]
-     (display-error ret form js (constantly nil)))
-  ([ret form js f]
+  ([ret form]
+     (display-error ret form (constantly nil)))
+  ([ret form f]
      (when-not (and (seq? form) (= 'ns (first form)))
        (f)
        (println (:value ret))
@@ -74,8 +74,8 @@
              ;;TODO - file bug with google, this is bs error
              ;;this is what you get when you try to 'teach new developers'
              ;;via errors (goog/base.js 104)
-             :error (display-error ret form js)
-             :exception (display-error ret form js
+             :error (display-error ret form)
+             :exception (display-error ret form
                           #(prn "Error evaluating:" form :as js))
              :success (:value ret))))
        (catch Throwable ex


fixed more card-str calls to use state

fixed more card-str calls to use state

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1942,16 +1942,16 @@
                                                 {:title "/trace command" :side %2}
                                                 {:base (max 0 value)
                                                  :msg "resolve successful trace effect"}))
-        "/card-info"  #(resolve-ability %1 %2 {:effect (effect (system-msg (str "shows card-info of " (card-str target) ": " target)))
+        "/card-info"  #(resolve-ability %1 %2 {:effect (effect (system-msg (str "shows card-info of " (card-str state target) ": " target)))
                                                :choices {:req (fn [t] (= (:side t) (side-str %2)))}}
                                         {:title "/card-info command"} nil)
         "/counter"    #(resolve-ability %1 %2 {:effect (effect (set-prop target :counter value)
-                                                               (system-msg (str "sets counters on " (card-str target) " to " value )))
+                                                               (system-msg (str "sets counters on " (card-str state target) " to " value )))
                                                  :choices {:req (fn [t] (= (:side t) (side-str %2)))}}
                                           {:title "/counter command"} nil)
         "/adv-counter" #(resolve-ability %1 %2
                                          {:effect (effect (set-prop target :advance-counter value)
-                                                          (system-msg (str "sets advancement counters on " (card-str target) " to " value )))
+                                                          (system-msg (str "sets advancement counters on " (card-str state target) " to " value )))
                                           :choices {:req (fn [t] (= (:side t) (side-str %2)))}}
                                         {:title "/adv-counter command"} nil)
         "/jack-out"   #(when (= %2 :runner) (jack-out %1 %2 nil))


Don't allow user to move upward from top-level forms

--- src/flense_demo/keymap.cljs
+++ src/flense_demo/keymap.cljs
@@ -13,11 +13,14 @@
      (text/insert ch %)
      (else-fn %)))

+(defn safe-up [loc]
+  (some-> loc z/up (z/ensure z/up)))
+
 (def keymap
   {#{:down} (some-fn text/begin-editing completions/next-completion z/down)
    #{:left} (some-fn text/move-caret-left z/left-or-wrap)
    #{:right} (some-fn text/move-caret-right z/right-or-wrap)
-   #{:up} (some-fn text/cease-editing completions/prev-completion z/up)
+   #{:up} (some-fn text/cease-editing completions/prev-completion safe-up)
    #{:alt :left} text/move-caret-left-by-word
    #{:alt :right} text/move-caret-right-by-word
    #{:shift :left} (some-fn text/adjust-range-left z/prev)


add :previous-zone when hosting cards...

...so it behaves like the move function.

This enables Autoscripter to work correctly when the card is not directly
installed but due to a host'n'install ability like Scheherazade.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1167,7 +1167,8 @@
    (swap! state update-in (cons side (vec zone)) (fn [coll] (remove-once #(not= (:cid %) cid) coll)))
    (let [c (assoc target :host (update-in card [:zone] #(map to-keyword %))
                          :facedown facedown
-                         :zone '(:onhost))] ;; hosted cards should not be in :discard or :hand etc
+                         :zone '(:onhost) ;; hosted cards should not be in :discard or :hand etc
+                         :previous-zone (:zone target))]
      (update! state side (update-in card [:hosted] #(conj % c)))
      (when-let [events (:events (card-def target))]
        (when installed


:bug: Removed last reflection warnings from clj-http.core

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -320,7 +320,7 @@
     (or conn/*connection-manager*
         (conn/make-regular-conn-manager req))))

-(defmulti ^:private  shutdown class)
+(defmulti ^:private shutdown class)
 (defmethod shutdown org.apache.http.conn.HttpClientConnectionManager      [^HttpClientConnectionManager  conn-mgr] (.shutdown conn-mgr))
 (defmethod shutdown org.apache.http.nio.conn.NHttpClientConnectionManager [^NHttpClientConnectionManager conn-mgr] (.shutdown conn-mgr))