add dotest to lazytest2

add dotest to lazytest2

--- src/main/clojure/com/stuartsierra/lazytest2.clj
+++ src/main/clojure/com/stuartsierra/lazytest2.clj
@@ -224,10 +224,37 @@
         [opts decl] (options decl)
         {:keys [contexts strategy]} opts
         children (vec decl)
-        csym (gensym "c")]
-    `(let [~csym ~(if contexts
+        sym (gensym "c")]
+    `(let [~sym ~(if contexts
                     (do (assert (vector? contexts))
                         `(ContextualContainer ~contexts ~children '~m nil))
                     `(SimpleContainer ~children '~m nil))]
-       ~(when (:name m) `(intern *ns* '~(:name m) ~csym))
-       ~csym)))
+       ~(when (:name m) `(intern *ns* '~(:name m) ~sym))
+       ~sym)))
+
+(defmacro dotest
+  "Creates an assertion function consisting of arbitrary code.
+  Passes if it does not throw an exception.  Use assert for value
+  tests.
+
+  decl    => name? docstring? [binding*] body*
+  binding => symbol context
+
+  name  => a symbol, will def a Var if provided.
+"
+  [& decl]
+  (let [[m decl] (attributes decl)
+        bindings (first decl)
+        body (next decl)
+        sym (gensym "c")]
+    (assert (vector? bindings))
+    (assert (even? (count bindings)))
+    (let [pairs (partition 2 bindings)
+          locals (map first pairs)
+          contexts (map second pairs)]
+      `(let [~sym ~(if (seq contexts)
+                     `(ContextualAssertion ~contexts (fn ~locals ~@body :ok)
+                                           '~m nil)
+                     `(SimpleAssertion (fn [] ~@body :ok) '~m nil))]
+         ~(when (:name m) `(intern *ns* '~(:name m) ~sym))
+         ~sym))))


linty fix

linty fix

--- src/metabase/driver/query_processor/resolve.clj
+++ src/metabase/driver/query_processor/resolve.clj
@@ -71,7 +71,7 @@
                   this
                   (resolve-field parent field-id->fields))
       parent-id (assoc this :parent (or (field-id->fields parent-id)
-                                        (->FieldPlaceholder parent-id)))
+                                        (map->FieldPlaceholder {:field-id parent-id})))
       :else     this))

   (resolve-table [{:keys [table-id], :as this} table-id->table]


Refactor query generation

Refactor query generation

--- src/zoo_event/events.clj
+++ src/zoo_event/events.clj
@@ -24,16 +24,26 @@
                         (where {:project project}))
              (str "events_" type "_" project))))

+(defn- date-query
+  [query from to]
+  (cond
+    (and from to) (where query (between :created_at [(to-sql-time from) (to-sql-time to)]))
+    from (where query (> :created_at (to-sql-time from)))
+    to (where  query (< :created_at (to-sql-time to)))
+    true query))
+
+(defn- str-to-int
+  [string & [default]]
+  (if string
+    (Integer/parseInt string)
+    (or default 0)))
+
 (defn- query
   [ent {:keys [from to per_page page]}]
-  (let [per_page (if per_page (Integer/parseInt per_page) 100)
-        page (if page (Integer/parseInt page) 0)
-        q (select* ent)
-        q (cond
-            (and from to) (where q (between :created_at [(to-sql-time from) (to-sql-time to)]))
-            from (where q (> :created_at (to-sql-time from)))
-            to (where  q (< :created_at (to-sql-time to)))
-            true q)]
+  (let [per_page (str-to-int per_page 100)
+        page (str-to-int page)
+        q (-> (select* ent)
+              (date-query from to))]
     (select q
             (order :created_at :DESC)
             (limit per_page)
@@ -41,8 +51,9 @@

 (defn- db-response
   [ent params & [mime]]
-  (resp-ok (mapv filter-user-data (query ent params))
-           (or mime app-mime)))
+  (let [result (query ent params)]
+    (resp-ok (mapv filter-user-data result)
+             (or mime app-mime))))

 (def process-event ^{:private true}
   (comp #(str % "\n") generate-string filter-user-data :event))


formatting

formatting

--- src/leiningen/leinsync/commands.clj
+++ src/leiningen/leinsync/commands.clj
@@ -34,7 +34,7 @@
                                        %
                                        commit-msg
                                        ((keyword %)
-                                         (pr/read-all-target-project-clj projects)))
+                                        (pr/read-all-target-project-clj projects)))
                     projects)
         committed-project (seq (map :project (filter #(= :committed (:status %)) status)))
         not-committed-project (seq (map :project (filter #(not= :committed (:status %)) status)))]


Loading pipelines shouldn't deal with validations

--- src/vip/data_processor/validation/xml.clj
+++ src/vip/data_processor/validation/xml.clj
@@ -259,11 +259,9 @@
 (def version-pipelines
   {"3.0" [sqlite/attach-sqlite-db
           load-xml]
-   "5.1" (concat [load-xml-ltree
-                  xml.v5/load-xml-street-segments]
-                 v5-validations/validations
-                 [load-xml-tree-validations
-                  set-input-as-xml-output-file])})
+   "5.1" [load-xml-ltree
+          xml.v5/load-xml-street-segments
+          set-input-as-xml-output-file]})

 (defn branch-on-spec-version [{:keys [spec-version] :as ctx}]
   (if-let [pipeline (get version-pipelines spec-version)]


use a promise to load medium language model

--- test/babel/test/es.cljc
+++ test/babel/test/es.cljc
@@ -1,6 +1,7 @@
 (ns babel.test.es
   (:refer-clojure :exclude [get-in])
-  (:require [babel.engine :as engine]
+  (:require [babel.directory :refer [models]]
+            [babel.engine :as engine]
             [babel.espanol :refer [analyze generate parse]]
             [babel.espanol.grammar :as grammar]
             [babel.espanol.morphology :refer [fo]]
@@ -12,15 +13,18 @@
             #?(:cljs [babel.logjs :as log])
             [dag_unify.core :refer [get-in]]))

-(def small (grammar/small))
-(def medium (grammar/medium))
+(defn small [] (-> ((-> models :es)) deref))
+(def medium-model (promise))
+(defn medium [] (if (realized? medium-model)
+                  @medium-model
+                  @(deliver medium-model (grammar/medium))))

 (deftest generate-conditional
   (let [result (generate {:synsem {:subcat '()
                                    :sem {:pred :sleep
                                          :subj {:pred :I}
                                          :tense :conditional}}}
-                         small
+                         (grammar/small)
                          {:truncate-children false})]
     (is (= :1st (get-in result [:comp :synsem :agr :person])))
     (is (= :sing (get-in result [:comp :synsem :agr :number])))
@@ -32,17 +36,17 @@
                 {:root {:espanol {:espanol "abrazar"}}
                  :synsem {:sem {:subj {:pred :I}}
                           :infl :preterito}}
-                small
+                (grammar/small)
                 {:truncate-children false})]
     (is (or (= "yo abracé" (fo result))
             (= "abracé" (fo result))))))

 (deftest llamarse
-  (let [result (engine/expression small {:synsem {:sem {:pred :be-called}}})]
+  (let [result (engine/expression (grammar/small) {:synsem {:sem {:pred :be-called}}})]
     (is (not (empty? (fo result))))))

 (deftest llamo
-  (let [result (fo (engine/expression small
+  (let [result (fo (engine/expression (grammar/small)
                                       {:synsem {:sem {:tense :present
                                                       :aspect :progressive
                                                       :subj {:pred :I}


fix typo

fix typo

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -918,7 +918,7 @@
     (repeatedly #(-> spec generate morph time println))))

 (defn sentences-with-pronoun-objects-small []
-  (let [lexicon (:lexicon models)
+  (let [lexicon (:lexicon model)
         transitive-verbs
         (filter (fn [k]
                   (let [lexemes (->> (get lexicon k)


let the canvas take the focus when you click on it

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -455,7 +455,7 @@
                                      (.stopPropagation event)
                                      ((:handle-mouse-down handlers) event))
                       :onMouseUp (fn [event]
-                                   (.preventDefault event)
+                                   ;(.preventDefault event)
                                    (.stopPropagation event)
                                    ((:handle-mouse-up handlers) event))
                       :onWheel (fn [event]


fix node problems

fix node problems

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -226,7 +226,7 @@
                      (path-parts (fix-node-request-url request-url))))]
           (aset (.-cache js/require) cache-path nil)
           (callback (try
-                      (js/require (string/join "/" ["." ".." request-url]))
+                      (js/require cache-path)
                       (catch js/Error e
                         (utils/log :error (str  "Figwheel: Error loading file " cache-path))
                         (utils/log :error (.-stack e))


[fix #3057] fix chat-contact.identity must be of type string error

--- src/status_im/protocol/handlers.cljs
+++ src/status_im/protocol/handlers.cljs
@@ -181,19 +181,19 @@

 (re-frame/reg-fx
   ::participant-invited-to-group-message
-  (fn [{:keys [chat-id current-identity identity from message-id timestamp]}]
+  (fn [{:keys [group-id current-identity identity from message-id timestamp]}]
     (let [inviter-name (:name (contacts/get-by-id from))
           invitee-name (if (= identity current-identity)
                          (i18n/label :t/You)
                          (:name (contacts/get-by-id identity)))]
       (re-frame/dispatch
-        [:chat-received-message/add
-         {:from "system"
-          :group-id chat-id
-          :timestamp timestamp
-          :message-id message-id
-          :content (str (or inviter-name from) " " (i18n/label :t/invited) " " (or invitee-name identity))
-          :content-type constants/text-content-type}]))))
+       [:chat-received-message/add
+        {:from "system"
+         :group-id group-id
+         :timestamp timestamp
+         :message-id message-id
+         :content (str (or inviter-name from) " " (i18n/label :t/invited) " " (or invitee-name identity))
+         :content-type constants/text-content-type}]))))

 (re-frame/reg-fx
   ::pending-messages-delete
@@ -507,13 +507,12 @@
          {:keys [group-id identity message-id timestamp]} :payload}]]
     (let [admin (get-in chats [group-id :group-admin])]
       (when (= from admin)
-        (merge
-          {::participant-invited-to-group-message {:group-id group-id :current-public-key current-public-key
-                                                   :identity identity :from from :message-id message-id
-                                                   :timestamp timestamp}}
-          (when-not (and (= current-public-key identity) has-contact?)
-            {:db (update-in db [:chats group-id :contacts] conj {:identity identity})
-             ::chats-add-contact [group-id [identity]]}))))))
+        (merge {::participant-invited-to-group-message {:group-id group-id :current-public-key current-public-key
+                                                        :identity identity :from from :message-id message-id
+                                                        :timestamp timestamp}}
+               (when-not (and (= current-public-key identity) has-contact?)
+                 {:db (update-in db [:chats group-id :contacts] conj {:identity identity})
+                  ::chats-add-contact [group-id identity]}))))))

 (handlers/register-handler-fx
   ::you-removed-from-group


Fix cascading runtime field lookup

Fix cascading runtime field lookup

--- pigpen-cascading/src/main/clojure/pigpen/cascading/runtime.clj
+++ pigpen-cascading/src/main/clojure/pigpen/cascading/runtime.clj
@@ -95,7 +95,7 @@
 (defn field-lookup [values arg]
   (cond
     (string? arg) arg
-    (symbol? arg) (get values arg)
+    (symbol? arg) (values arg)
     :else (throw (ex-info "Unknown arg" {:arg arg, :values values}))))

 (s/defmethod eval-expr :code
@@ -118,7 +118,7 @@
         tuple-entry (.getArguments function-call)
         values (fn [f]
                  (hybrid->clojure
-                   (.getObject tuple-entry (name f))))]
+                   (.getObject tuple-entry (pr-str f))))]
     (doseq [r (->> projections
                 (map (partial eval-projections values))
                 (cross-product)


Another server bound to "localhost"

Another server bound to "localhost"

It seems that the previous issue, that only manifests itself on Travis
CI, was fixed with binding the server to "localhost". This failure is in
a different place and I'm hoping that binding it to "localhost" will
resolve it.

--- test/refactor_nrepl/ns/resolve_missing_test.clj
+++ test/refactor_nrepl/ns/resolve_missing_test.clj
@@ -12,7 +12,7 @@

 (defn session-fixture
   [f]
-  (with-open [server (server/start-server :handler *handler*)
+  (with-open [server (server/start-server :bind "localhost" :handler *handler*)
               transport (nrepl/connect :port (:port server))]
     (let [client (nrepl/client transport Long/MAX_VALUE)]
       (binding [*session* (nrepl/client-session client)]


Tried fixing a server null pointer exception

This may fix it

--- src/webapp/framework/server/core.clj
+++ src/webapp/framework/server/core.clj
@@ -40,7 +40,7 @@
            (if (:action params) (:action params) (:systemaction params))
            " "

-           (if (or (> (count (keys (load-string (:params params)))) 0) post-data)
+           (if (or (> (count (keys (load-string (str (:params params))))) 0) post-data)
              (str  (:params params)))
            " "


CIRCLE-1609 add tests for data acrobatics with containers steps (#1518)

* CIRCLE-1609 add tests for data acrobatics with containers steps
* CIRCLE-1609 review fixes

--- test-cljs/frontend/models/test_build.cljs
+++ test-cljs/frontend/models/test_build.cljs
@@ -37,3 +37,42 @@
          "queued"               "Status-Queued"
          "not_running"          "Status-Queued"
          "scheduled"            "Status-Queued")))
+
+(deftest containers-test
+  (testing "should not modify complete containers"
+    (let [build {:parallel 2
+                 :steps [{:actions [{:index 0 :step 0} {:index 1 :step 0}]}
+                         {:actions [{:index 0 :step 1} {:index 1 :step 1}]}]}]
+
+      (is (= [{:index 0 :actions [{:index 0 :step 0} {:index 0 :step 1}]}
+              {:index 1 :actions [{:index 1 :step 0} {:index 1 :step 1}]}]
+             (build-model/containers build)))))
+
+  (testing "should add dummy step for containers without some steps"
+    (let [build {:parallel 2
+                 :steps [{:actions [{:index 0 :step 0} {:index 1 :step 0}]}
+                         {:actions [{:index 0 :step 1}]}
+                         {:actions [{:index 0 :step 2} {:index 1 :step 2}]}]}]
+
+      (is (= [{:index 0 :actions [{:index 0 :step 0} {:index 0 :step 1} {:index 0 :step 2}]}
+              {:index 1 :actions [{:index 1 :step 0} {:index 1 :step 1 :status "running" :filler-action true} {:index 1 :step 2}]}]
+             (build-model/containers build)))))
+
+  (testing "should replicate not parallel steps"
+    (let [build {:parallel 2
+                 :steps [{:actions [{:index 0 :step 0} {:index 1 :step 0}]}
+                         {:actions [{:index 0 :step 1 :parallel false}]}
+                         {:actions [{:index 0 :step 2} {:index 1 :step 2}]}]}]
+
+      (is (= [{:index 0 :actions [{:index 0 :step 0} {:index 0 :step 1 :parallel false} {:index 0 :step 2}]}
+              {:index 1 :actions [{:index 1 :step 0} {:index 0 :step 1 :parallel false} {:index 1 :step 2}]}]
+             (build-model/containers build)))))
+
+  (testing "should fill skipped steps"
+    (let [build {:parallel 2
+                 :steps [{:actions [{:index 0 :step 0} {:index 1 :step 0}]}
+                         {:actions [{:index 0 :step 2} {:index 1 :step 2}]}]}]
+
+      (is (= [{:index 0 :actions [{:index 0 :step 0} {:index 0 :step 1 :status "running" :filler-action true} {:index 0 :step 2}]}
+              {:index 1 :actions [{:index 1 :step 0} {:index 1 :step 1 :status "running" :filler-action true} {:index 1 :step 2}]}]
+             (build-model/containers build))))))


wip on comment routing

wip on comment routing

--- src/polismath/math/conversation.clj
+++ src/polismath/math/conversation.clj
@@ -295,6 +295,14 @@
                        (keys votes-base))}]))
         group-clusters))))

+
+(defn importance-metric
+  [A P S E]
+  (let [p (/ (+ P 1) (+ S 2))
+        a (/ (+ A 1) (+ S 2))]
+    (* (- 1 p) (+ E 1) a)))
+
+
 (def small-conv-update-graph
   "For computing small conversation updates (those without need for base clustering)"
   (merge
@@ -590,6 +598,30 @@
                             (reduce *)))
                      tid-gid-probs)]
                tid-consensus))
+
+      :comment-priorities
+      (plmb/fnk [conv group-votes pca tids]
+        (let [group-votes (:group-votes conv)
+              extremities (into {} (map vector tids (:comment-extremity pca)))]
+          (plmb/map-from-keys
+            (fn [tid]
+              (let [{:as total-votes :keys [A D S P]}
+                    ;; reduce over votes per group, already aggregated
+                    (reduce
+                      (fn [votes [gid data]]
+                        (let [{:as data :keys [A S D]} (get-in data [:votes tid])
+                              data (assoc data :P (+ (- S (+ A D))))]
+                          ;; Add in each of the data's kv count pairs
+                          (reduce
+                            (fn [votes' [k v]]
+                              (update votes' k + v))
+                            votes
+                            data)))
+                      {:A 0 :D 0 :S 0 :P 0}
+                      group-votes)
+                    extremity (get extremities tid)]
+                (importance-metric A P S extremity)))
+            tids)))

       :repness


Add clojure 1.6 and clojure 1.5 to the test suite.

--- profiles.clj
+++ profiles.clj
@@ -1,5 +1,5 @@
 {:dev
- {:aliases {"test-all" ["with-profile" "dev,1.8:dev" "test"]}
+ {:aliases {"test-all" ["with-profile" "dev,1.8:dev,1.6:dev,1.5:dev:dev" "test"]}
   :codeina {:sources ["src"]
             :exclude [buddy.core.sign.impl]
             :reader :clojure
@@ -8,6 +8,7 @@
             :src-uri-prefix "#L"}
   :plugins [[funcool/codeina "0.3.0"]
             [lein-ancient "0.6.7"]]}
-
+ :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}
+ :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
  :1.8 {:dependencies [[org.clojure/clojure "1.8.0-beta2"]]}}


added installation notes for keepassx

added installation notes for keepassx

--- src/org/domaindrivenarchitecture/pallet/crate/managed_vm/office.clj
+++ src/org/domaindrivenarchitecture/pallet/crate/managed_vm/office.clj
@@ -15,4 +15,17 @@
   (actions/package "hyphen-de")
   (actions/package "hunspell-de-de")
   (actions/package "libreoffice")
-  )+  )
+
+; Install keepassx on ubuntu 14.04
+;
+; sudo add-apt-repository ppa:eugenesan/ppa
+; apt-get update
+; apt-get install keepassx
+; https://chrome.google.com/webstore/detail/chromeipass/ompiailgknfdndiefoaoiligalphfdae?hl=en-US
+; https://addons.mozilla.org/DE/firefox/addon/keefox/?src=search or
+; https://addons.mozilla.org/DE/firefox/addon/passifox/?src=search
+;
+; open: do a security risk & trust check
+; Fossa reviews very old keepass but not keepassx
+; https://joinup.ec.europa.eu/community/eu-fossa/og_page/code-review-log


(maint) Clean up ns form

(maint) Clean up ns form

--- src/puppetlabs/kitchensink/json.clj
+++ src/puppetlabs/kitchensink/json.clj
@@ -1,4 +1,5 @@
-(ns ^{:doc "Cheshire related functions
+(ns puppetlabs.kitchensink.json
+  "Cheshire related functions

   This front-ends the common set of core cheshire functions:

@@ -8,11 +9,9 @@
   * parse-stream

   This namespace when 'required' will also setup some common JSON encoders
-  globally, so you can avoid doing this for each call."}
-
-  puppetlabs.kitchensink.json
-  (:require [cheshire.generate :as generate]
-            [cheshire.core :as core]
+  globally, so you can avoid doing this for each call."
+  (:require [cheshire.core :as core]
+            [cheshire.generate :as generate]
             [clj-time.coerce :as coerce]
             [clj-time.core :as clj-time]
             [clojure.java.io :as io]


Removes log

Removes log

--- src/cljs/proto/goods_search_reframe.cljs
+++ src/cljs/proto/goods_search_reframe.cljs
@@ -59,7 +59,6 @@
   [good shop price]
   (go
     (let [saved-price (<! (http/post "/api/shops/price" {:json-params {:shop shop :good good :price price}}))]
-      (.log js/console "Saved price")
       (dispatch [:saved-price (:body saved-price)]))))


added club info for competitors

added club info for competitors

--- src/cljs_bjj_tournament/competitors.cljs
+++ src/cljs_bjj_tournament/competitors.cljs
@@ -146,6 +146,7 @@
           [competitor-field "Gender" :gender competitor]
           [competitor-field "YOB" :yob competitor]
           [competitor-field "Belt" :belt competitor]
+          [competitor-field "Club" :club-name competitor]
           [button
            :label "Save"
            :on-click (fn []


cleanup

cleanup

--- src/clojure/zensols/nlparse/stanford.clj
+++ src/clojure/zensols/nlparse/stanford.clj
@@ -270,24 +270,6 @@
           awmap (zipmap keys (map attr-fn-map keys))]
       (into {} (filter second awmap)))))

-(defn- parse-tree-to-map [node senti-node]
-  (when node
-    (let [label (.label node)
-          [pchild schild] (if-not (.isLeaf node)
-                            (let [pchild (.getChildrenAsList node)]
-                             [pchild
-                              (if senti-node
-                                (.getChildrenAsList senti-node)
-                                (repeat (count pchild) nil))]))]
-      (merge {:label (->> label .value)}
-             (select-keys (->> label anon-word-map)
-                          [:token-index :index-range])
-             (let [score (.score node)]
-               (if-not (Double/isNaN score)
-                 {:score score}))
-             (if pchild
-               {:child (map parse-tree-to-map pchild schild)})))))
-
 (defn- parse-tree-to-map [node]
   (when node
     (let [label (.label node)]
@@ -343,13 +325,11 @@
 (defn- anon-sent-map [anon]
   (->> [[:text (text- anon)]
         [:sent-index (sent-index- anon)]
-        [:parse-tree (parse-tree-to-map (parse-tree- anon)
-                                        ;(sentiment-tree- anon)
-                                        )]
+        [:parse-tree (parse-tree-to-map (parse-tree- anon))]
         [:dependency-parse-tree
          (dep-parse-tree-to-map (dependency-parse-tree- anon))]
         [:sentiment-class (sentiment-class- anon)]
-        [:sentiment-tree (parse-tree-to-map (sentiment-tree- anon))]
+        ;[:sentiment-tree (parse-tree-to-map (sentiment-tree- anon))]
         [:tokens (map anon-word-map (tokens- anon))]]
        util/map-if-data))


Updated comment.

Updated comment.

--- umm-lib/src/cmr/umm/dif/collection/platform.clj
+++ umm-lib/src/cmr/umm/dif/collection/platform.clj
@@ -11,7 +11,7 @@
       {:short-name short-name
        :long-name long-name
        ;; DIF does not have platform type in its xml, but it is a required field in ECHO10.
-       ;; We make a dummy type here to facilitate cross fromat conversion
+       ;; We make a dummy type here to facilitate cross format conversion
        :type "dummy"})))

 (defn xml-elem->Platforms


Add check for bad outcomes

Add check for bad outcomes

--- src/angelic/search/implicit/dash_astar_opt.clj
+++ src/angelic/search/implicit/dash_astar_opt.clj
@@ -254,6 +254,8 @@
        (util/print-debug 1 "eval" nm (if (get-output-set s) :out :no-out))
        (if-not (get-output-set s) ; Not evaluated yet -- evalute description and publish output
          (let [[out-set reward status] (fs/apply-opt fs inp-set)]
+	   (when-not out-set (util/assert-is (= reward Double/NEGATIVE_INFINITY)
+					     "Bad outcome: %s" [(fs/fs-name fs) reward status]))
            (set-sf! s #(make-summary reward status %))
            (when out-set (set-output-set! s out-set)))
          (do (set-sf! s sg/or-summary) ; Evaluated to live -- generate children now.


Mark unicode namespace as un-tested

Mark unicode namespace as un-tested

--- src/useful/experimental/unicode.clj
+++ src/useful/experimental/unicode.clj
@@ -1,4 +1,5 @@
-(ns useful.experimental.unicode
+(ns ^{:dont-test "Just aliases for other functions/macros"}
+  useful.experimental.unicode
   (:use [useful.utils :only [map-entry]]
         [useful.macro :only [defalias macro-do]]))


make git_test more readable, split up tests

--- test/clj/lambdacd/steps/git_test.clj
+++ test/clj/lambdacd/steps/git_test.clj
@@ -56,40 +56,41 @@
    :result-channel result-channel
    :is-killed is-killed})

-(defn- execute-wait-for-async [git-src-dir last-seen-revision result-channel is-killed]
-  (let [ctx (ctx-with last-seen-revision result-channel is-killed)
-        ch (async/go (wait-for-git ctx (repo-uri-for git-src-dir) "master"))]
-    (Thread/sleep 500) ;; dirty hack to make sure we started waiting before making the next commit
-    ch))
+(defn- execute-wait-for-async
+  ([git-src-dir last-seen-revision]
+   (execute-wait-for-async git-src-dir last-seen-revision (async/chan 100) (atom false)))
+  ([git-src-dir last-seen-revision result-channel is-killed]
+    (let [ctx (ctx-with last-seen-revision result-channel is-killed)
+          ch (async/go (wait-for-git ctx (repo-uri-for git-src-dir) "master"))]
+      (Thread/sleep 500) ;; dirty hack to make sure we started waiting before making the next commit
+      ch)))

 (deftest wait-for-git-test
   (testing "that it returns immediately (since it has no last known revision), calls after that wait for the next commit independent of whether the commit occurred before or after starting to wait"
-    (let [is-not-killed (atom false)
-          result-channel (async/chan 100)
-          create-output (create-test-repo)
-          git-src-dir (:dir create-output)
-          original-head-commit (last (:commits create-output))
-          commit-hash-with-nothing-waiting-for-it (commit-to git-src-dir)
-          wait-for-commit-that-happend-while-not-waiting-ch (execute-wait-for-async git-src-dir original-head-commit result-channel is-not-killed)
-          wait-for-commit-that-happend-while-not-waiting-ch-result  (get-value-or-timeout-from wait-for-commit-that-happend-while-not-waiting-ch)
-          wait-started-while-not-having-a-new-commit-ch (execute-wait-for-async git-src-dir commit-hash-with-nothing-waiting-for-it result-channel is-not-killed)
+    (let [test-repo (create-test-repo)
+          git-src-dir (:dir test-repo)
+          original-head-commit (last (:commits test-repo))
+          wait-started-while-not-having-a-new-commit-ch (execute-wait-for-async git-src-dir original-head-commit)
           commit-hash-after-waiting-started-already (commit-to git-src-dir)
-          wait-started-while-not-having-a-new-commit-result (get-value-or-timeout-from wait-started-while-not-having-a-new-commit-ch)
-          ]
-      (is (= commit-hash-with-nothing-waiting-for-it (:revision wait-for-commit-that-happend-while-not-waiting-ch-result)))
-      (is (= :success (:status wait-for-commit-that-happend-while-not-waiting-ch-result)))
+          wait-started-while-not-having-a-new-commit-result (get-value-or-timeout-from wait-started-while-not-having-a-new-commit-ch)]
       (is (= commit-hash-after-waiting-started-already (:revision wait-started-while-not-having-a-new-commit-result)))
       (is (= :success (:status wait-started-while-not-having-a-new-commit-result)))))
+  (testing "that waiting returns immediately when a commit happened while it was not waiting"
+    (let [test-repo (create-test-repo)
+          git-src-dir (:dir test-repo)
+          original-head-commit (last (:commits test-repo))
+          commit-hash-with-nothing-waiting-for-it (commit-to git-src-dir)
+          wait-for-commit-that-happend-while-not-waiting-ch-result  (get-value-or-timeout-from (execute-wait-for-async git-src-dir original-head-commit))]
+      (is (= commit-hash-with-nothing-waiting-for-it (:revision wait-for-commit-that-happend-while-not-waiting-ch-result)))
+      (is (= :success (:status wait-for-commit-that-happend-while-not-waiting-ch-result)))))
   (testing "that when no previous commit is known, we just wait for the next one"
-    (let [is-not-killed (atom false)
-          result-channel (async/chan 100)
-          create-output (create-test-repo)
-          git-src-dir (:dir create-output)
-          wait-for-ch (execute-wait-for-async git-src-dir nil result-channel is-not-killed)
+    (let [git-src-dir (:dir (create-test-repo))
+          wait-for-ch (execute-wait-for-async git-src-dir nil)
           new-commit-hash (commit-to git-src-dir)
           wait-for-result (get-value-or-timeout-from wait-for-ch)]
-      (is (= new-commit-hash (:revision wait-for-result)))))
+      (is (= new-commit-hash (:revision wait-for-result)))
+      (is (= :success (:status wait-for-result)))))
   (testing "that it retries until being killed if the repository cannot be reached"
     (let [is-killed (atom false)
           result-ch (execute-wait-for-async "some-uri-that-doesnt-exist" nil (async/chan 10) is-killed)]


Refactor: reuse tenant-conn-fixture in a.l.l.t.engine-test

--- backend/test/akvo/lumen/lib/transformation/engine_test.clj
+++ backend/test/akvo/lumen/lib/transformation/engine_test.clj
@@ -1,7 +1,6 @@
 (ns akvo.lumen.lib.transformation.engine-test
   {:functional true}
-  (:require [akvo.lumen.fixtures :refer [migrate-tenant rollback-tenant summarise-transformation-logs-fixture]]
-            [akvo.lumen.test-utils :refer [test-tenant test-tenant-conn]]
+  (:require [akvo.lumen.fixtures :refer [migrate-tenant rollback-tenant summarise-transformation-logs-fixture tenant-conn-fixture *tenant-conn*]]
             [akvo.lumen.lib.transformation.engine :refer :all]
             [akvo.lumen.test-utils :as tu]
             [cheshire.core :as json]
@@ -15,18 +14,13 @@

 (def columns (vec (take 3 (json/parse-string (slurp (io/resource "columns_test.json"))))))

-(def ^:dynamic *tenant-conn*)
+(defn fixture [f]
+  (db-drop-test-table *tenant-conn*)
+  (db-test-table *tenant-conn*)
+  (db-test-data *tenant-conn*)
+  (f))

-(defn fixture [f]
-  (migrate-tenant test-tenant)
-  (binding [*tenant-conn* (test-tenant-conn test-tenant)]
-    (db-drop-test-table *tenant-conn*)
-    (db-test-table *tenant-conn*)
-    (db-test-data *tenant-conn*)
-    (f)
-    (rollback-tenant test-tenant)))
-
-(use-fixtures :once fixture summarise-transformation-logs-fixture tu/spec-instrument)
+(use-fixtures :once tenant-conn-fixture fixture summarise-transformation-logs-fixture tu/spec-instrument)

 (def transformations
   {:ops [{"op" "core/to-titlecase"


allow sending by email to be turned off

allow sending by email to be turned off

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7819 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -46,20 +46,21 @@
       (dorun (map #(println (.getAbsolutePath %)) outdated-dlls))
       (println "\n\n"))))

-(defn send-full-report [mode]
+(defn send-full-report [mode send?]
   (let [report
         (with-out-str
           (report-build-errors 32 mode)
           (report-build-errors 64 mode))]
-    (when-not (empty? report)
-     (with-session
-       "mmbuilderrors@gmail.com" (slurp "C:\\pass.txt") "smtp.gmail.com" 465 "smtp" true
-       (send-email (text-email ["info@micro-manager.org"] "mm build errors" report)))
-    report
-    )))
+    (when send
+      (when-not (empty? report)
+        (with-session
+          "mmbuilderrors@gmail.com" (slurp "C:\\pass.txt") "smtp.gmail.com" 465 "smtp" true
+          (send-email (text-email ["info@micro-manager.org"] "mm build errors" report)))
+        (println report)
+        ))))

 (defn -main [mode]
-  (send-full-report (get {"inc" :inc "full" :full} mode)))
+  (send-full-report (get {"inc" :inc "full" :full} mode) true))


[CS NH] Log errors in pipeline and re-throw

Re-throwing allows squishy to place the failed message on the failed
queue.

--- src/vip/data_processor/pipeline.clj
+++ src/vip/data_processor/pipeline.clj
@@ -1,5 +1,6 @@
 (ns vip.data-processor.pipeline
-  (:require [clojure.tools.logging :as log]))
+  (:require [clojure.tools.logging :as log]
+            [clojure.stacktrace :as stacktrace]))

 (defn try-validation [validation ctx]
   (try
@@ -18,11 +19,14 @@
           (recur (assoc next-ctx :pipeline (rest (:pipeline ctx))))))
       ctx)))

-;;; TODO: throw exception (if there is one) so that squishy will put
-;;; the message that started this whole process on the fail queue
 (defn process [pipeline initial-input]
   (let [ctx {:input initial-input
              :pipeline pipeline}
         result (run-pipeline ctx)]
     (log/info result)
+    (when-let [ex (:exception result)]
+      (log/error (with-out-str (stacktrace/print-stack-trace ex)))
+      (throw (ex-info "Exception during processing" {:exception ex
+                                                     :initial-ctx ctx
+                                                     :final-ctx result})))
     result))


Added a util function.

Added a util function.

--- dev-resources/src/dragon/dev.clj
+++ dev-resources/src/dragon/dev.clj
@@ -21,6 +21,7 @@
             [markdown.core :as md]
             [selmer.parser :as selmer]
             [taoensso.timbre :as log]
+            [trifl.core :refer [->int]]
             [trifl.java :as java]))

 (logger/set-level! ['dragon] :debug)


Fix doc-print to strip leading whitespace properly

--- dev-src/clj/comic_reader/dev.clj
+++ dev-src/clj/comic_reader/dev.clj
@@ -1,15 +1,16 @@
 (ns comic-reader.dev
   (:require [clojure.repl :refer :all]
             [clojure.tools.namespace.repl :refer [clear refresh]]
-            [clansi.core :refer [style]]))
+            [clansi.core :refer [style]]
+            [clojure.string :as str]))

 (declare doc-print goto-ns)

 (defn welcome []
   (doc-print
-   "Welcome to the comic reader. If you want to add a new site,
-  run `(add-site)'.  If you want to work on the frontend,
-  run `(develop-frontend)'."))
+   "Welcome to the Comic Reader!
+    - If you want to add a new site, run `(add-site)'.
+    - If you want to work on the frontend, run `(develop-frontend)'."))

 (defn add-site []
   (doc-print
@@ -28,7 +29,7 @@
   (goto-ns 'comic-reader.frontend-dev))

 (defn- doc-print [msg]
-  (println " " msg))
+  (printf "\n%s\n\n" (str/replace msg  #"\n +" "\n")))

 (defn- goto-ns [ns]
   (require ns)


Mark's solutions.

Mark's solutions.

--- src/clojure_club/x106_number_maze/mbastian.clj
+++ src/clojure_club/x106_number_maze/mbastian.clj
@@ -1,4 +1,56 @@
-(ns clojure-club.x106-number-maze.mbastian)
+(ns clojure-club.x106-number-maze.mbastian
+  (:import (clojure.lang PersistentQueue)))

-;TODO
-;Copy my answer from https://github.com/markbastian/clojure-exercises/tree/master/src/main/cljc/clojure4/misc once it's ready.
+;Produce only the number of steps.
+(defn number-maze[s g]
+  (letfn[(nbrs[x] (cond-> [(* 2 x) (+ x 2)] (even? x) (conj (/ x 2))))]
+    (inc (count (take-while #(not (% g)) (iterate #(reduce into #{} (map nbrs %)) #{s}))))))
+
+(number-maze 9 2)
+(number-maze 2 9)
+
+;Return a single path
+(defn number-path [s g]
+  (letfn [(nbrs [x] (cond-> [(+ 2 x) (* 2 x)] (even? x) (conj (/ x 2))))]
+    (loop [v {} [[n :as edge] :as q] (conj PersistentQueue/EMPTY [s :done])]
+      (cond
+        (v g) (reverse (take-while (complement #{:done}) (iterate v g)))
+        (v n) (recur v (pop q))
+        :default (recur (conj v edge) (into (pop q) (map (fn [x] [x n]) (nbrs n))))))))
+
+(number-path 7 43)
+(number-path 9 2)
+(number-path 2 9)
+
+;Return them all
+(defn number-paths[s g]
+  (letfn[(nbrs[x] (cond-> [(* 2 x) (+ x 2)] (even? x) (conj (/ x 2))))
+         (expand [paths] (for [path paths n (nbrs (peek path))
+                               :when (not-any? #{n} path)] (conj path n)))]
+    (->> (iterate expand [[s]])
+         (some #(when (some (comp #{g} peek) %) %))
+         (filter (comp #{g} peek)))))
+
+;(time (number-paths 1 4137))
+(time (number-paths 7 43))
+(time (number-paths 9 2))
+(time (number-paths 2 9))
+(time (number-paths 2 4))
+
+;Return them all
+(defn number-paths1[s g]
+  (letfn[(nbrs[x] (cond-> [(* 2 x) (+ x 2)] (even? x) (conj (/ x 2))))
+         (expand [paths] (for [{:keys [path visited]} paths n (nbrs (peek path))
+                               :when ((complement visited) n)]
+                           {:path (conj path n) :visited (conj visited n)}))]
+    (let [pred (comp #{g} peek :path)]
+      (->> (iterate expand [{:path [s] :visited #{s}}])
+           (some #(when (some pred %) %))
+           (filter pred)
+           (mapv :path)))))
+
+;(time (number-paths1 1 4137))
+(time (number-paths1 7 43))
+(time (number-paths1 9 2))
+(time (number-paths1 2 9))
+(time (number-paths1 2 4))


Remove unused macros

Remove unused macros

--- test/pani/core_test.cljs
+++ test/pani/core_test.cljs
@@ -1,5 +1,5 @@
 (ns pani.core-test
-  (:require-macros [cemerick.cljs.test :refer [is deftest with-test run-tests testing test-var done]]
+  (:require-macros [cemerick.cljs.test :refer [is deftest done]]
                    [cljs.core.async.macros :refer [go go-loop]])
   (:require [cemerick.cljs.test :as t]
             [cljs.core.async :refer [<!]]


add prefix for before and after time  in EN

--- resources/duckling/rules/en.time.clj
+++ resources/duckling/rules/en.time.clj
@@ -606,11 +606,11 @@
   ; One-sided Intervals

   "until <time-of-day>"
-  [#"(?i)(anytime )?(before|until|up to)" (dim :time)]
+  [#"(?i)(anytime |sometimes? )?(before|until|up to)" (dim :time)]
   (merge %2 {:direction :before})

   "after <time-of-day>"
-  [#"(?i)(anytime )?after" (dim :time)]
+  [#"(?i)(anytime |sometimes? )?after" (dim :time)]
   (merge %2 {:direction :after})

   ; ;; In this special case, the upper limit is exclusive


clojure: improved mapping of node signatures

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -86,9 +86,11 @@
       (into {} (for [[key vals] nclass] [(first vals) key])))))

 (defn map-sig [M sig]
-  (into (vector)
-        (map (fn [s] (->> s (map #(.times % M)) sort (into (vector))))
-             sig)))
+  (let [p (.times (first (first sig)) M)
+        op (.times M (Operator. (.minus (.modZ p) p)))]
+    (into (vector)
+          (map (fn [s] (->> s (map #(.times % op)) sort (into (vector))))
+               sig))))

 (defn extend-matrix [M]
   (let [n (.numberOfRows M)
@@ -97,12 +99,6 @@
     (.setSubMatrix M* 0 0 M)
     (.set M* n m (Whole/ONE))
     M*))
-
-(defn equal-sigs? [a b]
-  (let [d (.minus (first (first a)) (first (first b)))]
-    (and (every? (partial instance? Whole)
-                 (map #(.get d %) (range (inc (.getDimension d)))))
-         (= (map-sig (Operator. d) b) a))))

 (defn morphism [net v w M]
   (when (.isUnimodularIntegerMatrix M)
@@ -128,7 +124,7 @@
             (instance? IEdge a)
             (recur (assoc src2img a b) (conj (pop q) [(.target a) (.target b)]))

-            (not (equal-sigs? (map-sig op (sigs a)) (sigs b)))
+            (not= (map-sig op (sigs a)) (sigs b))
             nil

             :else


actually change figwheel path

actually change figwheel path

--- src/leiningen/new/frontend_happiness.clj
+++ src/leiningen/new/frontend_happiness.clj
@@ -14,7 +14,7 @@
               ["resources/public/index.html" (render "resources/public/index.html" data)]
               ["resources/public/stylesheets/main.css" (render "resources/public/stylesheets/main.css" data)]
               ["src/{{sanitized}}/main/core.cljs" (render "src/frontend_happiness/main/core.cljs" data)]
-              ["src/{{sanitized}}/figwheel/main_figwheel.cljs" (render "src/frontend_happiness/main/main_figwheel.cljs" data)]
+              ["src/{{sanitized}}/figwheel/main_figwheel.cljs" (render "src/frontend_happiness/figwheel/main_figwheel.cljs" data)]
               ["LICENSE" (render "LICENSE" data)]
               ["README.md" (render "README.md" data)]
               [".gitignore" (render ".gitignore" data)]


Updated to latest radix.

Updated to latest radix.

--- src/leiningen/new/mr_clojure/project.clj
+++ src/leiningen/new/mr_clojure/project.clj
@@ -9,7 +9,7 @@
                  [environ "1.0.0"]
                  [mixradio/graphite-filter "1.0.0"]
                  [mixradio/instrumented-ring-jetty-adapter "1.0.4"]
-                 [mixradio/radix "1.0.5"]
+                 [mixradio/radix "1.0.9"]
                  [net.logstash.logback/logstash-logback-encoder "3.2"]
                  [org.clojure/clojure "1.6.0"]
                  [org.clojure/tools.logging "0.3.1"]


add diagnostics to (default) lexical compilation rules

--- src/babel/francais/lexicon.cljc
+++ src/babel/francais/lexicon.cljc
@@ -32,7 +32,63 @@
    (map-function-on-map-vals
     (fn [lexical-string lexical-val]
       (phonize lexical-val lexical-string)))
+
+   (map-function-on-map-vals
+    (fn [lexical-string lexical-vals]
+      (map (fn [lexical-val]
+             (if (or (= (string? (get-in lexical-val [:français :present :1sing])))
+                     (= (string? (get-in lexical-val [:français :boot-stem1]))))
+               (unify {:français {:present {:regular false}}}
+                      lexical-val)
+               lexical-val))
+           lexical-vals)))
+
+   (default {:synsem {:cat :verb}
+             :d1 true
+             :français {:present {:regular true}}})
+
+   (map-function-on-map-vals
+    (fn [lexical-string lexical-vals]
+      (map (fn [lexical-val]
+             (if (and (= (string? (get-in lexical-val [:français :imperfect :1sing])))
+                      (= :verb (get-in lexical-val [:synsem :cat])))
+               (unify {:français {:imperfect {:regular false}}}
+                      lexical-val)
+               lexical-val))
+           lexical-vals)))
+
+   (default {:synsem {:cat :verb}
+             :français {:imperfect {:regular true}}
+             :d2 true})
+
+   (map-function-on-map-vals
+    (fn [lexical-string lexical-vals]
+      (map (fn [lexical-val]
+             (if (and (= (string? (get-in lexical-val [:français :future :1sing])))
+                      (= :verb (get-in lexical-val [:synsem :cat])))
+               (unify {:français {:future {:regular false}}}
+                      lexical-val)
+               lexical-val))
+           lexical-vals)))
+
+   ;; Mark lexemes with no :cat with their own :cat to avoid matching any rules after this.
+   (default {:gender-pronoun-agreement false
+             :synsem {:cat :lexeme-with-an-unspecified-category}
+             :d-no-cat true})

+   ;; Agreement between subject pronouns and verbs.
+   (default {:gender-pronoun-agreement true
+             :synsem {:cat :noun
+                      :pronoun true
+                      :agr {:gender gender}
+                      :sem {:gender gender}
+                      :subcat '()}
+             :d-gpa true})
+
+   (default {:synsem {:cat :verb}
+             :français {:future {:regular true}}
+             :d-future true})
+
    ((fn [lexicon]
       (let [exceptions (apply merge-with concat
                               (map (fn [x]
@@ -41,22 +97,19 @@
                                    (morph/exception-generator lexicon)))]
         (apply merge-with concat
                [exceptions lexicon]))))
-
-   ;; Mark lexemes with no :cat with their own :cat to avoid matching any rules after this.
-   (default {:gender-pronoun-agreement false
-             :synsem {:cat :lexeme-with-an-unspecified-category}})
-
-   ;; Agreement between subject pronouns and verbs
-   (default {:gender-pronoun-agreement true
-             :synsem {:cat :noun
-                      :pronoun true
-                      :agr {:gender gender}
-                      :sem {:gender gender}
-                      :subcat '()}})
+
+   ;; Prevent irregular infinitives ({:present :regular false})
+   ;; from matching phrase structure rules intended for non-infinitives.
+   (default {:synsem {:cat :verb}
+             :français {:exception false
+                        :present {:regular false
+                                  :conjugated false}}
+             :d-verb-irreg true})

    ;; Verbs are *not* aux unless explicitly stated as such..
    (default {:synsem {:cat :verb
-                      :aux false}})
+                      :aux false}
+             :d-verb-aux false})

    ;; ..but for verbs that *are* aux, then:
    (default {:synsem {:sem verb-aux-sem
@@ -66,11 +119,14 @@
                                    :sem verb-aux-sem
                                    :cat :verb
                                    :aux false
-                                   :subcat {:1 verb-aux-subject}}}}})
+                                   :subcat {:1 verb-aux-subject}}}}
+             :d-verb-aux true})
+
    ;; All pronouns are nouns.
    (default {:synsem {:cat :noun
-                      :pronoun true}})
-
+                      :pronoun true}
+             :d-noun true})
+
    ;; Make an intransitive version of every verb which has a path [:sem :obj].
    intransitivize


use new constrain-vals-if calling signature

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -2169,24 +2169,15 @@
                               ;; TODO: rewrite italian-specific-rules as (constrain-vals-if)(one or more)
                               italian-specific-rules)

-
                  (constrain-vals-if
                   (fn [val]
-                    :top)
-                  (fn [val]
-                    (unify val {:synsem {:sem {:blah 99}}})))
-
-                 (constrain-vals-if
-                  (fn [val]
-                    (if (get universals (get-in val [:synsem :sem :pred]))
-                      :top
-                      :fail))
+                    (not (nil? (get universals (get-in val [:synsem :sem :pred])))))
                   (fn [val]
                     (get universals (get-in val [:synsem :sem :pred]))))

                  ;; TODO: refactor this; it's very monolithic currently:
                  intransitivize
-
+
                  ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
                  ;; TODO: refactor this; it's very monolithic currently:
                  transitivize
@@ -2206,7 +2197,13 @@
                                        :case case}
                               :italiano {:cat cat
                                          :case case}}))))
-
+                 (constrain-vals-if
+                  (fn [val]
+                    (= (get-in val [:synsem :cat])
+                       :verb))
+                  (fn [val]
+                    (unify val {:stage1 :ok})))
+
                  ;; If a verb is not specifically marked as reflexive, it
                  ;; is {:reflexive false}, to prevent generation of reflexive
                  ;; sentences using nonreflexive verbs.
@@ -2223,7 +2220,7 @@
                          (= :none (get-in val [:synsem :sem :reflexive] :none))))
                   (fn [val]
                     (unify val {:synsem {:sem {:reflexive false}}})))
-
+
                  ;; if object is not specified, then set to :unspec.
                  ;; this prevents translations that may have actual objects - e.g. would allow translations like:
                  ;; "io mangio" => "I eat the bread" whereas a better translation is simply "I eat".


add universals

add universals

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -12,6 +12,11 @@
                                transitive transitivize verb-aux verb-subjective]]
    [dag_unify.core :refer [fail? get-in merge]]))

+;; TODO: move this somewhere like 'universal-lexicon' and use in all lexicons.
+(def universals
+  {:say {:synsem {:sem {:subj {:human true}}}}
+   :tell {:synsem {:sem {:subj {:human true}}}}})
+
 (def lexicon-source
   {"Luisa"
    {:synsem {:sem {:pred :luisa


remove exclude of clojure.core/merge

remove exclude of clojure.core/merge

--- src/babel/italiano/workbook.clj
+++ src/babel/italiano/workbook.clj
@@ -1,5 +1,5 @@
 (ns babel.italiano.workbook
-  (:refer-clojure :exclude [get-in merge resolve find parents])
+  (:refer-clojure :exclude [get-in resolve find parents])
   (:require
    [babel.italiano :refer [analyze generate parse]]
    [babel.italiano.grammar :refer [small medium np-grammar]]


add support for var.foo and local.foo syntax

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -92,27 +92,52 @@
     (when (:macro (meta var))
       var)))

+(defn resolve-sym [sym env]
+  (or (resolve-var sym env)
+      (get-in env [:locals sym])))
+
+(defn desugar-symbol [form env]
+  (let [ns (namespace form)
+        n (name form)]
+    (cond
+
+     ;; js/foo -> (js* "foo")
+     (= "js" ns)
+     (list 'js* (name form))
+
+     ;; js-ns/foo -> (. js/js-ns -foo)
+     (and ns (get-in (env/deref-env)
+                     [:namespaces (resolve-ns (symbol ns) env) :js-namespace]))
+     (let [target (symbol "js" (str (resolve-ns (symbol ns) env)))
+           op (symbol (name form))]
+       (list '. target (symbol (str "-" (name form)))))
+
+     ;; js-var (. js/js-ns -var)
+     (and (not ns)
+          (not (get-in env [:locals form]))
+          (= :js-var (:op (resolve-var form env))))
+     (let [{:keys [namespace name]} (resolve-var form env)]
+       (list '. (symbol "js" (str namespace)) (symbol (str "-" name))))
+
+     ;; var.foo -> (. var -foo)
+     (let [idx (.indexOf n ".")
+           sym (and (pos? idx)
+                    (symbol ns (.substring n 0 idx)))]
+       (and (not= idx -1)
+            (not (resolve-sym form env))
+            (not= sym form)
+            (resolve-sym sym env)))
+     (let [idx (.indexOf n ".")
+           sym (symbol ns (.substring n 0 idx))]
+       (list '. sym (symbol (str "-" (.substring n (inc idx) (count n))))))
+
+     :else form)))
+
 (defn desugar-host-expr [form env]
   (-> (cond
+
       (symbol? form)
-      (let [ns (namespace form)]
-        (cond
-         (= "js" ns)
-         (list 'js* (name form))
-
-         (and ns (get-in (env/deref-env)
-                         [:namespaces (resolve-ns (symbol ns) env) :js-namespace]))
-         (let [target (symbol "js" (str (resolve-ns (symbol ns) env)))
-               op (symbol (name form))]
-           (list '. target (symbol (str "-" (name form)))))
-
-         (and (not ns)
-              (not (get-in env [:locals form]))
-              (= :js-var (:op (resolve-var form env))))
-         (let [{:keys [namespace name]} (resolve-var form env)]
-           (list '. (symbol "js" (str namespace)) (symbol (str "-" name))))
-
-         :else form))
+      (desugar-symbol form env)

       (and (seq? form)
            (symbol? (first form)))
@@ -122,29 +147,46 @@
             op-s   (str op)]
         (cond

+         ;; (.foo bar ..) -> (. bar foo ..)
          (= (first opname) \.)
          (let [[target & args] expr
                args (list* (symbol (subs opname 1)) args)]
            (list '. target (if (= 1 (count args))
                              (first args) args)))

+         ;; (foo. ..) -> (new foo ..)
          (= (last opname) \.)
          (list* 'new (symbol (subs op-s 0 (dec (count op-s)))) expr)

-         (= "js" opns) ;; (js/foo ..) -> ((js* "foo") ..)
+         ;; (js/foo ..) -> ((js* "foo") ..)
+         (= "js" opns)
          (list* (list 'js* opname) expr)

+         ;; (js-ns/foo ..) -> (. js/js-ns foo ..)
          (and opns (get-in (env/deref-env)
                            [:namespaces (resolve-ns (symbol opns) env) :js-namespace]))
          (let [target (symbol "js" (str (resolve-ns (symbol opns) env)))
                op (symbol opname)]
            (list '. target (list* op expr)))

+         ;; (js-var ..) -> (. js/js-ns var ..)
          (and (not opns)
               (not (get-in env [:locals op]))
               (= :js-var (:op (resolve-var op env))))
          (let [{:keys [namespace name]} (resolve-var op env)]
            (list '. (symbol "js" (str namespace)) (list* name expr)))
+
+         ;; (var.foo ..) -> (. var foo ..)
+         (let [idx (.indexOf opname ".")
+               sym (and (pos? idx)
+                        (symbol opns (.substring opname 0 idx)))]
+           (and (not= idx -1)
+                (not (resolve-sym form env))
+                (not= sym form)
+                (resolve-sym sym env)))
+         (let [idx (.indexOf opname ".")
+               sym (symbol opns (.substring opname 0 idx))]
+           (list '. sym (list* (symbol (.substring opname (inc idx) (count opname))) expr)))

          :else form))
       :else form)


parent, path and root support in persistence

--- src/main/clojure/pdok/featured/persistence.clj
+++ src/main/clojure/pdok/featured/persistence.clj
@@ -17,8 +17,28 @@
   (current-validity [this dataset collection id])
   (last-action [this dataset collection id])
   (childs [this dataset parent-collection parent-id child-collection])
+  (parent [this dataset collection id] "Returns [collection id] tuple or nil")
   (close [_])
   )
+
+(defn path [persistence dataset collection id]
+  "Returns sequence of [collection id] tuples. Parents first. Root only means empty sequence"
+  (when (and dataset collection id)
+    (if-let [[parent-collection parent-id] (parent persistence dataset collection id)]
+      (loop [path (list)
+             pc  parent-collection
+             pid parent-id]
+        (if-let [[new-pc new-pid] (parent persistence dataset pc pid)]
+          (recur (conj path [new-pc new-pid]) new-pc new-pid)
+          path))
+      (list))))
+
+(defn root [persistence dataset collection id]
+  "Return [collection id] tuple with self if no other root"
+  (let [path (path persistence dataset collection id)]
+    (if (empty? path)
+      [collection id]
+      (first path))))

 (def ^:dynamic *jdbc-schema* :featured)
 (def ^:dynamic *jdbc-features* :feature)
@@ -94,6 +114,26 @@
                       dataset parent-collection parent-id child-collection] :as-arrays? true)]
       results)))

+(defn- jdbc-load-parent-cache [db dataset collection]
+  (j/with-db-connection [c db]
+    (let [results
+          (j/query c [(str "SELECT feature_id, parent_collection, parent_id FROM " (qualified-features)
+                           " WHERE dataset = ? AND collection = ?")
+                      dataset collection] :as-arrays? true)
+          for-cache (map (fn [[feature-id parent-collection parent-id]]
+                           [dataset collection feature-id] [parent-collection parent-id])
+                         (drop 1 results))]
+      for-cache)))
+
+(defn- jdbc-get-parent [db dataset collection id]
+  (j/with-db-connection [c db]
+    (let [result
+          (j/query c [(str "SELECT parent_collection, parent_id FROM " (qualified-features)
+                           " WHERE dataset = ? AND collection = ? AND feature_id = ?"
+                           " AND parent_collection is not null")
+                      dataset collection id] :as-arrays? true)]
+      (first result))))
+
 (defn- jdbc-insert
   ([db version action dataset collection id validity geometry attributes]
    (jdbc-insert db (list [version action dataset collection id validity geometry attributes])))
@@ -152,6 +192,8 @@
     (-> (jdbc-last-stream-validity-and-action db dataset collection id) second))
   (childs [_ dataset parent-collection parent-id child-collection]
     (jdbc-get-childs db dataset parent-collection parent-id child-collection))
+  (parent [_ dataset collection id]
+    (jdbc-get-parent db dataset collection id))
   (close [this] this)
   )

@@ -160,7 +202,8 @@
     (conj acc id)))

 (deftype CachedJdbcProcessorPersistence [db stream-batch stream-batch-size stream-cache stream-load-cache?
-                                         link-batch link-batch-size childs-cache childs-load-cache?]
+                                         link-batch link-batch-size childs-cache childs-load-cache?
+                                         parent-cache parent-load-cache?]
   ProcessorPersistence
   (init [this] (jdbc-init db) this)
   (stream-exists? [this dataset collection id]
@@ -168,11 +211,14 @@
   (create-stream [this dataset collection id]
     (create-stream this dataset collection id nil nil))
   (create-stream [_ dataset collection id parent-collection parent-id]
-    (let [key-fn (fn [dataset collection _ p-col p-id] [dataset p-col p-id collection])
-          value-fn append-cached-child
+    (let [childs-key-fn (fn [dataset collection _ p-col p-id] [dataset p-col p-id collection])
+          childs-value-fn append-cached-child
+          parent-key-fn (fn [dataset collection id _ _] [dataset collection id])
+          parent-value-fn (fn [_ _ _ _ pc pid] [pc pid])
           batched (with-batch link-batch link-batch-size (partial jdbc-create-stream db))
-          cache-batched (with-cache childs-cache batched key-fn value-fn)]
-      (cache-batched dataset collection id parent-collection parent-id)))
+          cache-batched (with-cache childs-cache batched childs-key-fn childs-value-fn)
+          double-cache-batched (with-cache parent-cache cache-batched parent-key-fn parent-value-fn)]
+      (double-cache-batched dataset collection id parent-collection parent-id)))
   (append-to-stream [_ version action dataset collection id validity geometry attributes]
     (let [key-fn   (fn [_ _ dataset collection id _ _ _] [dataset collection id])
           value-fn (fn [_ _ action _ _ _ validity _ _] [validity action])
@@ -180,13 +226,13 @@
           cache-batched (with-cache stream-cache batched key-fn value-fn)]
       (cache-batched version action dataset collection id validity geometry attributes)))
   (current-validity [_ dataset collection id]
-    (let [key-fn (fn [& params] (->> params (take 3)))
+    (let [key-fn (fn [dataset collection id] [dataset collection id])
           load-cache (fn [dataset collection id]
                        (when (stream-load-cache? dataset collection) (jdbc-load-cache db dataset collection)))
           cached (use-cache stream-cache key-fn load-cache)]
       (first (cached dataset collection id))))
   (last-action [_ dataset collection id]
-    (let [key-fn (fn [& params] (->> params (take 3)))
+    (let [key-fn (fn [dataset collectioni id] [dataset collection id])
           load-cache (fn [dataset collection id]
                        (when (stream-load-cache? dataset collection) (jdbc-load-cache db dataset collection)))
           cached (use-cache stream-cache key-fn load-cache)]
@@ -199,6 +245,16 @@
                          (jdbc-load-childs-cache db dataset parent-collection child-collection)))
           cached (use-cache childs-cache key-fn load-cache)]
       (cached dataset parent-collection parent-id child-collection)))
+  (parent [_ dataset collection id]
+    (let [key-fn (fn [dataset collection id] [dataset collection id])
+          load-cache (fn [dataset collection _]
+                       (when (parent-load-cache? dataset collection)
+                         (jdbc-load-parent-cache db dataset collection)))
+          cached (use-cache parent-cache key-fn load-cache)
+          q-result (cached dataset collection id)]
+      (if (some #(= nil %) q-result)
+        nil
+        q-result)))
   (close [this]
     (flush-batch stream-batch (partial jdbc-insert db))
     (flush-batch link-batch (partial jdbc-create-stream db))
@@ -218,9 +274,12 @@
         link-batch-size (or (:link-batch-size config) (:batch-size config) 10000)
         link-batch (ref (clojure.lang.PersistentQueue/EMPTY))
         childs-cache (ref (cache/basic-cache-factory {}))
-        childs-load-cache? (once-true-fn)]
+        childs-load-cache? (once-true-fn)
+        parent-cache (ref (cache/basic-cache-factory {}))
+        parent-load-cache? (once-true-fn)]
     (CachedJdbcProcessorPersistence. db stream-batch stream-batch-size stream-cache stream-load-cache?
-                                     link-batch link-batch-size childs-cache childs-load-cache?)))
+                                     link-batch link-batch-size childs-cache childs-load-cache?
+                                     parent-cache parent-load-cache?)))

 ;; (def ^:private pgdb {:subprotocol "postgresql"
 ;;                      :subname "//localhost:5432/pdok"


More cutting

More cutting

--- src/catalysis/client/views.cljs
+++ src/catalysis/client/views.cljs
@@ -2,19 +2,7 @@
   (:require [catalysis.client.ws :as socket]))

-;; Rewrite in terms of posh XXX
-(defn tasks-view
-  [tasks-data]
-  [:div
-   [:h2 "Todo"]
-   [:table
-    [:tr [:th "Task"] [:th "Tags"]]
-    (for [task (tasks-data)]
-      [:tr
-       [:td (:e/name task)]
-       [:td (for [tag (:e/tags task)]
-              (tag-view tag))]])]])
-
+;; TODO build application view here

 (defn main [conn]
   [:div


Include all functions from record ins active.clojure.config to unbreak test.

--- src/active/clojure/config.cljc
+++ src/active/clojure/config.cljc
@@ -33,7 +33,9 @@
       [clojure.set :as set])
      (:import java.net.URL)]
     :cljs
-    [(:require [active.clojure.condition :as c] [clojure.set :as set])
+    [(:require [active.clojure.condition :as c]
+               [clojure.set :as set]
+               active.clojure.record)
      (:require-macros
       [active.clojure.record :refer [define-record-type]])]))


Fix ordering of functions.

Fix ordering of functions.

--- src/afterglow/effects/cues.clj
+++ src/afterglow/effects/cues.clj
@@ -247,43 +247,6 @@
            :end-keys end-keys
            :priority priority
            :held held))))
-
-(defn current-cue-color
-  "Given a cue, an active effect map, and a metronome snapshot
-  representing the moment for which the user interface is being
-  rendered, return the color with which the cue should be rendered on
-  a cue grid. If the cue is not currently running, `active` should be
-  `nil`. Handles the delegation to the cue's dynamic color function if
-  one has been assigned. Useful dynamic color functions are built
-  by [[color-fn-from-cue-var]] and [[color-fn-from-param]]."
-  [cue active show snapshot]
-  (if-let [f (:color-fn cue)]
-    (or (f cue active show snapshot) (:color cue))
-    (:color cue)))
-
-(defn color-fn-from-cue-var
-  [var-spec]
-  "Builds a dynamic cue color function which reports the color of a
-  cue based on the content of a cue variable, given the cue variable
-  map. If the cue variable is temporary, when the cue is not running,
-  the function returns non-dynamic cue color. When running, or if the
-  variable is not temporary, it looks up the value of the specified
-  cue variable, and returns that. If the variable is `nil`, the
-  non-dynamic cue color is returned."
-  (fn [cue active show _]
-    (if (or active (keyword? (:key var-spec)))
-      (or (get-cue-variable cue var-spec :show show :when-id (:id active))
-          (:color cue))
-      (:color cue))))
-
-(defn color-fn-from-param
-  "Builds a dynamic cue color function which reports the color of a
-  cue based on the value of a dynamic parameter. If the parameter
-  evaluates to `nil`, the non-dynamic cue color is returned."
-  [param]
-  (params/validate-param-type param :com.evocomputing.colors/color)
-  (fn [cue active show snapshot]
-    (or (params/evaluate param show snapshot nil) (:color cue))))

 ;; TODO: A compound function cue which takes a vector of functions
 ;;       and htp/velocity/level/var-label-overrides and builds a
@@ -529,3 +492,40 @@
     :control (midi/remove-control-mapping device-filter channel note f)
     :note (midi/remove-note-mapping device-filter channel note f)))

+(defn current-cue-color
+  "Given a cue, an active effect map, and a metronome snapshot
+  representing the moment for which the user interface is being
+  rendered, return the color with which the cue should be rendered on
+  a cue grid. If the cue is not currently running, `active` should be
+  `nil`. Handles the delegation to the cue's dynamic color function if
+  one has been assigned. Useful dynamic color functions are built
+  by [[color-fn-from-cue-var]] and [[color-fn-from-param]]."
+  [cue active show snapshot]
+  (if-let [f (:color-fn cue)]
+    (or (f cue active show snapshot) (:color cue))
+    (:color cue)))
+
+(defn color-fn-from-cue-var
+  [var-spec]
+  "Builds a dynamic cue color function which reports the color of a
+  cue based on the content of a cue variable, given the cue variable
+  map. If the cue variable is temporary, when the cue is not running,
+  the function returns non-dynamic cue color. When running, or if the
+  variable is not temporary, it looks up the value of the specified
+  cue variable, and returns that. If the variable is `nil`, the
+  non-dynamic cue color is returned."
+  (fn [cue active show _]
+    (if (or active (keyword? (:key var-spec)))
+      (or (get-cue-variable cue var-spec :show show :when-id (:id active))
+          (:color cue))
+      (:color cue))))
+
+(defn color-fn-from-param
+  "Builds a dynamic cue color function which reports the color of a
+  cue based on the value of a dynamic parameter. If the parameter
+  evaluates to `nil`, the non-dynamic cue color is returned."
+  [param]
+  (params/validate-param-type param :com.evocomputing.colors/color)
+  (fn [cue active show snapshot]
+    (or (params/evaluate param show snapshot nil) (:color cue))))
+


update class-constant-test for cljs

update class-constant-test for cljs

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -1679,11 +1679,11 @@
             {:a [{:b 2 :c 1}]}])))
   )

-#?(:clj
-  (deftest class-constant-test
-    (let [f (fn [p] (fn [v] (str p (inc v))))]
-      (is (= (str String 2) (multi-transform (s/terminal (f String)) 1)))
-      )))
+(deftest class-constant-test
+  (let [f (fn [p] (fn [v] (str p (inc v))))]
+    (is (= (str #?(:clj String :cljs js/String) 2)
+           (multi-transform (s/terminal (f #?(:clj String :cljs js/String))) 1)))
+    ))

 #?(:clj
   (do


Import java.io.StringWriter into util package

--- src/bakyeono/litedocx/util.clj
+++ src/bakyeono/litedocx/util.clj
@@ -1,6 +1,7 @@
 (ns bakyeono.litedocx.util
   "Custom utilities used in litedocx."
-  (:import [java.io DataInputStream FileInputStream OutputStream StringReader])
+  (:import [java.io DataInputStream FileInputStream OutputStream])
+  (:import [java.io StringReader StringWriter])
   (:import [java.util.zip ZipEntry ZipOutputStream])
   (:require [clojure.string :as str])
   (:require [clojure.zip :as z])
@@ -89,7 +90,7 @@
 (defn emit-xml-as-str
   "Emits XML data as string."
   [data]
-  (with-open [writer (java.io.StringWriter.)]
+  (with-open [writer (StringWriter.)]
     (xml/emit data writer)
     (.flush writer)
     (.toString writer)))


better keys for arrows

better keys for arrows

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -755,7 +755,8 @@
                      (get-in drawing [:relation :layer]))
             (let [layer (get-in drawing [:relation :layer])
                   layer-center (layers/center layer)]
-              (dom/g #js {:className "layer-arrows in-progress"}
+              (dom/g #js {:className "layer-arrows in-progress"
+                          :key "in-progress"}
                 (svg-element (assoc layer
                                     :selected? true
                                     :className "shape-layer layer-outline layer-arrow"
@@ -768,7 +769,8 @@

           ;; in-progress outlines for shapes
           (when (keyboard/arrow-shortcut-active? app)
-            (apply dom/g #js {:className "arrow-handles"}
+            (apply dom/g #js {:className "arrow-handles"
+                              :key "arrow-handles"}
                    (for [layer (ds/touch-all '[:find ?t :where [?t :layer/type :layer.type/rect]] db)]
                      (om/build arrow-handle
                                (assoc layer
@@ -776,7 +778,8 @@
                                {:react-key (:db/id layer)}))))

-          (apply dom/g #js {:className "layer-arrows"}
+          (apply dom/g #js {:className "layer-arrows"
+                            :key "layer-arrows"}
                  (for [pointer-datom pointer-datoms
                        :let [origin (or (get drawing-layers (:e pointer-datom))
                                         (get subscriber-layers (:e pointer-datom))
@@ -802,7 +805,7 @@
                                         :layer/type :layer.type/path
                                         :layer/path (layers/arrow-path [start-x start-y] [end-x end-y])
                                         :selected? selected?))]
-                     (dom/g nil
+                     (dom/g #js {:key (str (:db/id origin) "-" (:db/id dest))}
                        (svg-element (assoc props
                                            :className "layer-handle"
                                            :onMouseDown #(do (utils/stop-event %)


Single stroke width for drawing selection

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -100,11 +100,12 @@
                                                                          (get-in sel [:layer/end-y]))})]
                                     (dom/rect
                                      (clj->js (assoc (svg/layer->svg-rect (:camera payload) sel
-                                                                          true
+                                                                          false
                                                                           cast!)
                                                 :fill "gray"
                                                 :fillOpacity "0.25"
-                                                :strokeDasharray "5,5")))))
+                                                :strokeDasharray "5,5"
+                                                :strokeWidth 1)))))
                                 (dom/text #js {:x 15
                                                :y 15} (pr-str (dissoc payload :layers)))]
                                [(when (cameras/guidelines-enabled? payload)


remove extraneous whitespace

remove extraneous whitespace

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -82,7 +82,6 @@
               (str "View " project-name " »")])
            (when (and (feature/enabled? :ui-v2) (= :build (:navigation-point app)))
              (om/build build-head/build-head-actions app))])))))
-

 (defn head-admin [app owner]
   (reify


train->emoji

train->emoji

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -21,21 +21,23 @@
 (defn- key->emoji [s]
   (str s ":"))

+(defn- train->emojis [t]
+  (->> (map key->emoji t)
+       (apply str)))
+
 (defn- train [& wagons]
-  (let [front  (key->emoji (rand-nth-weighted locomotives))
-        back   (key->emoji (rand-nth-weighted train-endings))
-        middle (->> (map key->emoji wagons)
-                    (cycle)
-                    (take num-wagons)
-                    (apply str))]
-    (str front middle back)))
+  (let [front  (rand-nth-weighted locomotives)
+        back   (rand-nth-weighted train-endings)
+        middle (take num-wagons (cycle wagons))]
+    (->> [front middle back]
+         (flatten)
+         (train->emojis))))

 (def ^:private train-coffee (partial train :coffee))

 (defn- train-custom [& wagons]
   (->> (cons :steam_locomotive wagons)
-       (map key->emoji)
-       (apply str)))
+       (train->emojis)))

 (defn rand-train []
   (rand-sexp


Extract functionality of different types of runs (multiple rounds or given duration) to protocol.

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -29,12 +29,31 @@
     (go (>! c (run)))
     ret))

-(defn- run-scenarios-in-parallel [scenario-runners parallel-count end-fn]
+(defprotocol RunnerProtocol
+  (continue-run? [runner current-time])
+  (run-range [runner number-of-users])
+  (runner-info [runner]))
+
+(deftype DurationRunner [duration]
+  RunnerProtocol
+  (continue-run? [_ start] (time/before? (local-time/local-now) (time/plus start duration)))
+  (run-range [_ _] (range))
+  (runner-info [_] (str "duration " duration)))
+
+(deftype RoundsRunner [number-of-rounds]
+  RunnerProtocol
+  (continue-run? [_ _] true)
+  (run-range [_ number-of-users] (range (* number-of-users number-of-rounds)))
+  (runner-info [_] (str "rounds " number-of-rounds)))
+
+(defn- run-scenarios-in-parallel [scenario-runners parallel-count runner]
   (with-channels [cs parallel-count]
-    (let [ps (map vector (iterate inc 0) cs)]
+    (let [scenario-start (local-time/local-now)
+          ps (map vector (iterate inc 0) cs)]
       (doseq [[i c] ps]
         (go (>! c ((nth scenario-runners i)))))
-      (let [results-with-new-run (take-while end-fn (map (partial collect-result-and-run-next cs) (drop parallel-count scenario-runners)))
+      (let [results-with-new-run (take-while (fn [_] (continue-run? runner scenario-start))
+                                             (map (partial collect-result-and-run-next cs) (drop parallel-count scenario-runners)))
             results-rest (repeatedly parallel-count (partial collect-result cs))]
         (concat results-with-new-run results-rest)))))

@@ -61,20 +80,16 @@
     end-result)))

 (defn- run-nth-scenario-with-multiple-users [scenarios users rounds duration i]
-  (let [scenario-start (local-time/local-now)
+  (let [
+        scenario-start (local-time/local-now)
         result (promise)
         scenario (nth scenarios i)
-        ;TODO Implement these using protocols instead of multiple ifs
-        range-seq (if (nil? duration) (range (* users rounds)) (range))
-        extra-info (if (nil? duration)
-                     (str "rounds " rounds)
-                     (str "duration " duration))
-        end-fn (if (nil? duration)
-                 (fn [{:keys [id]}] (<= id (* users rounds)))
-                 (fn [_] (time/before? (local-time/local-now) (time/plus scenario-start duration))))
-        scenario-runs (map (partial run-scenario-async scenario) range-seq)]
-     (println (str "Running scenario " (:name scenario) " with " users " users and " extra-info "."))
-     (deliver result (run-scenarios-in-parallel scenario-runs users end-fn))
+        runner (if (nil? duration)
+                 (RoundsRunner. rounds)
+                 (DurationRunner. duration))
+        scenario-runs (map (partial run-scenario-async scenario) (run-range runner users))]
+     (println (str "Running scenario " (:name scenario) " with " users " users and " (runner-info runner) "."))
+     (deliver result (run-scenarios-in-parallel scenario-runs users runner))
     result))

 (defn run-simulation [scenarios users & [options]]


fix combat trajectory on missed ball

fix combat trajectory on missed ball

--- src/cljs/dodgeball/combat.cljs
+++ src/cljs/dodgeball/combat.cljs
@@ -45,11 +45,11 @@

 (defn trajectory [unit magnitude]
   (let [m  (clamp-slope (slope unit))
-        dy (/ magnitude (Math/sqrt (+ 1 (* m m))))
-        dx (* m dy)]
+        dx (/ magnitude (Math/sqrt (+ 1 (* m m))))
+        dy (* m dx)]
     (println "M: " m " DX: " dx " DY: " dy)
-    {:x (+ (:x (state/selected-unit)) (Math/floor dx))
-     :y (+ (:y (state/selected-unit)) (Math/floor dy))}))
+    {:x (+ (:x (state/selected-unit)) (Math/round dx))
+     :y (+ (:y (state/selected-unit)) (Math/round dy))}))

 (defn position-ball [{:keys [x y] :as coords} id]
   (if (out-of-bounds x y)


Add transform-results multimethod

Add transform-results multimethod

--- src/clj/cglossa/search/core.clj
+++ src/clj/cglossa/search/core.clj
@@ -3,13 +3,18 @@

 (defmulti run-queries
   "Multimethod for actually running the received queries in a way that is
-  appropriate for the search engine of the corpus in question. The default
-  search engine is CWB, and hence the :default case is implemented in
-  cglossa.search.cwb."
-  (fn [corpus _ _]
-    (:search_engine corpus)))
+  appropriate for the search engine of the corpus in question."
+  (fn [corpus _ _] (keyword (:search_engine corpus))))
+
+(defmulti transform-results
+  "Multimethod for transforming search results in a way that is
+  appropriate for the search engine of the corpus in question."
+  (fn [corpus _] (keyword (:search_engine corpus))))

 (defn search [corpus-id queries]
-  (let [search      (db/run-sql "create vertex Search")
-        corpus      (first (db/sql-query "select from #TARGET" {:target corpus-id}))]
-    (run-queries corpus search queries)))
+  (let [search  (db/run-sql "create vertex Search")
+        corpus  (first (db/sql-query "select from #TARGET" {:target corpus-id}))
+        results (run-queries corpus search queries)]
+    (-> search
+        db/vertex->map
+        (assoc :results (transform-results corpus results))) ))


implement Reflection and Spy Camera

implement Reflection and Spy Camera

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -454,6 +454,10 @@
                                            :effect (req (move state :corp target :deck {:front true}))}
                                          rr nil))})))}}}

+   "Reflection"
+   {:in-play [:memory 1 :link 1]
+    :events {:jack-out {:msg (msg "force the Corp to reveal " (:title (first (shuffle (:hand corp)))) " from HQ")}}}
+
    "Replicator"
    {:events {:runner-install
              {:optional {:req (req (is-type? target "Hardware"))
@@ -505,6 +509,21 @@
    {:in-play [:memory 1]
     :recurring 2
     :events {:successful-trace {:req (req run) :effect (effect (damage :brain 1 {:card card}))}}}
+
+   "Spy Camera"
+   {:abilities [{:cost [:click 1]
+                 :label "Look at the top X cards of your Stack"
+                 :msg "look at the top X cards of their Stack and rearrange them"
+                 :effect (req (let [n (count (filter #(= (:title %) (:title card))
+                                                     (all-installed state :runner)))]
+                                (prompt! state side card
+                                                    (str "Drag cards from the Temporary Zone back onto your Stack") ["OK"] {})
+                                (doseq [c (take n (:deck runner))] (move state side c :play-area))))}
+                {:label "[Trash]: Look at the top card of R&D"
+                 :msg "trash it and look at the top card of R&D"
+                 :effect (effect (prompt! card (str "The top card of R&D is "
+                                                    (:title (first (:deck corp)))) ["OK"] {})
+                                 (trash card {:cause :ability-cost}))}]}

    "The Personal Touch"
    {:hosting {:req #(and (has-subtype? % "Icebreaker")


activate/deactivate only the specific 2 cards swapped with Turntable

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -572,13 +572,13 @@
                                                                      (dissoc sw :abilities :events))))
                                                   (gain-agenda-point state :runner (- swpts-runner stpts-runner))
                                                   (gain-agenda-point state :corp (- stpts-corp swpts-corp))
-                                                  (doseq [c (get-in @state [:corp :scored])]
+                                                  (let [c (find-cid (:cid st) (get-in @state [:corp :scored]))]
                                                     (let [abilities (:abilities (card-def c))
                                                           c (merge c {:abilities abilities})]
                                                       (update! state :corp c)
                                                       (when-let [events (:events (card-def c))]
                                                         (register-events state side events c))))
-                                                  (doseq [r (get-in @state [:runner :scored])]
+                                                  (let [r (find-cid (:cid sw) (get-in @state [:runner :scored]))]
                                                     (deactivate state :corp r))
                                                   (system-msg state side (str "uses Turntable to swap "
                                                                               (:title st) " for " (:title sw)))


decrease margin around the page

decrease margin around the page

--- src/clj/just_married/labels.clj
+++ src/clj/just_married/labels.clj
@@ -9,12 +9,23 @@
 (def ^:private default-n-cols 3)
 (def ^:private file-name "labels.pdf")

+(def pdf-options
+  {:title                  "Address List"
+   :left-margin            2
+   :right-margin           2
+   :top-margin             2
+   :bottom-margin          2
+   :size                   :a4
+   :font                   {:size     12
+                            :encoding :unicode}
+   :register-system-fonts? true})
+
 (def table-options
   {:width-percent    100
    :horizontal-align :right})

 (def cell-options
-  {:align :right
+  {:align   :right
    :padding (repeat 4 8)})

 (def countries-mappping
@@ -57,7 +68,7 @@
   "Place all the labels in a table generating the right pdf code"
   [addresses]
   (pdf/pdf
-   [{}
+   [pdf-options
     (gen-table addresses default-n-cols)]
    file-name)


Small fix

Small fix

--- src/clj/salava/oauth/google.clj
+++ src/clj/salava/oauth/google.clj
@@ -46,10 +46,11 @@
     (throw+ "oauth/Unexpectederroroccured")
     (let [access-token (google-access-token ctx code "/oauth/google")
           google-user (d/oauth-user ctx (str (:user-info-api api)"?access_token=" access-token ) {} parse-google-user)
-          user-id (d/get-or-create-user ctx "google" google-user current-user-id)]
+          user (d/get-or-create-user ctx "google" facebook-user current-user-id)
+          user-id (if (map? user) (:user-id user) user)]
       (do
        (d/update-user-last_login ctx user-id)
-       {:status "success" :user-id user-id})))
+       (if (map? user) (merge {:status "success"} user) {:status "success" :user-id user-id}))))
    (catch Object _
     {:status "error" :message _})))


Wrap history setup with a try/catch

Wrap history setup with a try/catch

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -89,6 +89,9 @@

 (defn ^:export run []
   (rf/dispatch [:initialize])
-  (history/hook-browser-navigation!)
+  (try
+    (history/hook-browser-navigation!)
+    (catch js/Error e
+      nil))
   (reagent/render [comic-reader]
                   (.-body js/document)))


Make the comic buttons activate the reader view

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -56,10 +56,9 @@
       (when-let [comic-list @comic-list]
         [:ul (map (comp
                    (id-btn-for-callback
-                    #(.log js/console
-                           (str "You clicked the "
-                                (:id %)
-                                " button!")))
+                    #(go-to (read-path {:comic (:name %)
+                                        :volume 1
+                                        :page 1})))
                    #(assoc % :id (:name %)))
                   comic-list)]))))


Fix capitalisation

Fix capitalisation

--- src/cljs/load_test_om/form.cljs
+++ src/cljs/load_test_om/form.cljs
@@ -55,7 +55,7 @@

 (defn rate-selection [{:keys [rate] :as form}]
   (dom/div #js {:className "load-test-form--field load-test-form--field__rate"}
-           (dom/div #js {:className "label"} "rate:")
+           (dom/div #js {:className "label"} "Rate:")
            (dom/input #js {:className "input" :type "number" :value rate :min "1" :max "20" :step "1"
                            :onChange (partial handle-rate-change form)})))


Added a few more policies. I think most of the commonly used ones are in here now.

--- src/clojure/alfresco/behave.clj
+++ src/clojure/alfresco/behave.clj
@@ -15,8 +15,7 @@
 ; limitations under the License.

 (ns alfresco.behave
-  (:require [clojure.string :as s]
-            [alfresco.core  :as c]
+  (:require [alfresco.core  :as c]
             [alfresco.model :as m])
   (:import [org.alfresco.repo.policy JavaBehaviour
                                      Behaviour$NotificationFrequency]))
@@ -51,6 +50,45 @@
                             b#)
        nil)))

+(def ^:private policies
+  "A list of all of the Alfresco policies supported by lambdalf (note: doesn't include all of the available policies).
+  This list is used by the gen-policy-registration-fns macro to generate the various registration methods and Alfresco
+  Java API interop boilerplate."
+  [
+    ;clojure-fn-name         alfresco-policy-class                                                      policy-method             policy-method-parameters
+    ;----------------------- -------------------------------------------------------------------------- ------------------------- --------------------------------
+    ; NodeServicePolicies
+    ['on-create-node!        'org.alfresco.repo.node.NodeServicePolicies$OnCreateNodePolicy             'onCreateNode             '[child-assoc-ref]]
+    ['on-update-node!        'org.alfresco.repo.node.NodeServicePolicies$OnUpdateNodePolicy             'onUpdateNode             '[node]]
+    ['on-move-node!          'org.alfresco.repo.node.NodeServicePolicies$OnMoveNodePolicy               'onMoveNode               '[old-child-assoc-ref new-child-assoc-ref]]
+    ['on-update-properties!  'org.alfresco.repo.node.NodeServicePolicies$OnUpdatePropertiesPolicy       'onUpdateProperties       '[node before-props after-props]]
+    ['on-delete-node!        'org.alfresco.repo.node.NodeServicePolicies$OnDeleteNodePolicy             'onDeleteNode             '[child-assoc-ref is-node-archived?]]
+    ['on-restore-node!       'org.alfresco.repo.node.NodeServicePolicies$OnRestoreNodePolicy            'onRestoreNode            '[child-assoc-ref]]
+    ['on-set-node-type!      'org.alfresco.repo.node.NodeServicePolicies$OnSetNodeTypePolicy            'onSetNodeType            '[node old-type new-type]]
+    ['on-add-aspect!         'org.alfresco.repo.node.NodeServicePolicies$OnAddAspectPolicy              'onAddAspect              '[node aspect-qname]]
+    ['on-remove-aspect!      'org.alfresco.repo.node.NodeServicePolicies$OnRemoveAspectPolicy           'onRemoveAspect           '[node aspect-qname]]
+    ['on-create-child-assoc! 'org.alfresco.repo.node.NodeServicePolicies$OnCreateChildAssociationPolicy 'onCreateChildAssociation '[child-assoc-ref is-new-node?]]
+    ['on-delete-child-assoc! 'org.alfresco.repo.node.NodeServicePolicies$OnDeleteChildAssociationPolicy 'onDeleteChildAssociation '[child-assoc-ref]]
+    ['on-create-assoc!       'org.alfresco.repo.node.NodeServicePolicies$OnCreateAssociationPolicy      'onCreateAssociation      '[node-assoc-ref]]
+    ['on-delete-assoc!       'org.alfresco.repo.node.NodeServicePolicies$OnDeleteAssociationPolicy      'onDeleteAssociation      '[node-assoc-ref]]
+
+    ; ContentServicePolicies
+    ['on-content-update!          'org.alfresco.repo.content.ContentServicePolicies$OnContentUpdatePolicy         'onContentUpdate         '[node is-new-content?]]
+    ['on-content-property-update! 'org.alfresco.repo.content.ContentServicePolicies$OnContentPropertyUpdatePolicy 'onContentPropertyUpdate '[node property-qname before-value after-value]]
+    ['on-content-read!            'org.alfresco.repo.content.ContentServicePolicies$OnContentReadPolicy           'onContentRead           '[node]]
+
+    ; VersionServicePolicies
+    ['on-create-version! 'org.alfresco.repo.version.VersionServicePolicies$OnCreateVersionPolicy 'onCreateVersion '[class-ref-qname node version-properties node-details]]
+
+    ; CopyServicePolicies
+    ['on-copy-complete! 'org.alfresco.repo.copy.CopyServicePolicies$OnCopyCompletePolicy 'onCopyComplete '[class-ref-qname source-node target-node is-copy-to-new-node? copy-map]]
+
+    ; CheckOutCheckInServicePolicies
+    ['on-check-out!        'org.alfresco.repo.coci.CheckOutCheckInServicePolicies$OnCheckOut       'onCheckOut       '[working-copy-node]]
+    ['on-check-in!         'org.alfresco.repo.coci.CheckOutCheckInServicePolicies$OnCheckIn        'onCheckIn        '[node]]
+    ['on-cancel-check-out! 'org.alfresco.repo.coci.CheckOutCheckInServicePolicies$OnCancelCheckOut 'onCancelCheckOut '[node]]
+  ])
+
 (defn- third
   "The third item in the given collection."
   [col]
@@ -60,22 +98,6 @@
   "The fourth item in the given collection."
   [col]
   (first (next (next (next col)))))
-
-(def ^:private policies
-  "A list of all of the Alfresco policies supported by lambdalf.  This list is used by the macro below to
-  generate the various registration methods and Alfresco Java API interop boilerplate."
-  [
-    ;clojure-fn-name        alfresco-policy-class                                                policy-method       policy-method-parameters
-    ['on-create-node!       'org.alfresco.repo.node.NodeServicePolicies$OnCreateNodePolicy       'onCreateNode       '[child-assoc-ref]]
-    ['on-update-node!       'org.alfresco.repo.node.NodeServicePolicies$OnUpdateNodePolicy       'onUpdateNode       '[node]]
-    ['on-move-node!         'org.alfresco.repo.node.NodeServicePolicies$OnMoveNodePolicy         'onMoveNode         '[old-child-assoc-ref new-child-assoc-ref]]
-    ['on-update-properties! 'org.alfresco.repo.node.NodeServicePolicies$OnUpdatePropertiesPolicy 'onUpdateProperties '[node before-props after-props]]
-    ['on-delete-node!       'org.alfresco.repo.node.NodeServicePolicies$OnDeleteNodePolicy       'onDeleteNode       '[child-assoc-ref is-node-archived?]]
-    ['on-restore-node!      'org.alfresco.repo.node.NodeServicePolicies$OnRestoreNodePolicy      'onRestoreNode      '[child-assoc-ref]]
-
-    ['on-add-aspect!        'org.alfresco.repo.node.NodeServicePolicies$OnAddAspectPolicy        'onAddAspect        '[node aspect-qname]]
-    ['on-remove-aspect!     'org.alfresco.repo.node.NodeServicePolicies$OnRemoveAspectPolicy     'onRemoveAspect     '[node aspect-qname]]
-  ])

 (defmacro ^:private gen-policy-registration-fns
   "Generates all policy registration fns defined in the 'policies' vector."


Fixed bug in sessions reported by David Nolen

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -111,7 +111,7 @@
 (defn- get-request-session
   "Retrieve the session using the 'session' cookie in the request."
   [request]
-  (if-let [session-data (-> request :cookies :session)]
+  (if-let [session-data (-> request :cookies :compojure-session)]
     (read-session session-data)))

 (defn- assoc-request-session
@@ -134,14 +134,22 @@
       (assoc :session (dissoc session :flash)))))

 (defn- set-session-cookie
-  "Set the session cookie on the response."
-  [request response]
-  (let [new?   (:new-session? request)
-        cookie (session-cookie new? (:session response))
-        update (set-cookie :compojure-session cookie, :path "/")]
+  "Set the session cookie on the response if required."
+  [request response session]
+  (let [new?    (:new-session? request)
+        cookie  (session-cookie new? session)
+        update  (set-cookie :compojure-session cookie, :path "/")]
     (if cookie
       (update-response request response update)
       response)))
+
+(defn- save-handler-session
+  "Save the session for a handler if required."
+  [request response session]
+  (when (or (:session response)
+            (:new-session? request)
+            (not-empty (:flash request)))
+    (write-session session)))

 (defn with-session
   "Wrap a handler in a session of the specified type. Session type defaults to
@@ -154,13 +162,11 @@
         (let [request  (-> request assoc-cookies
                                    assoc-request-session
                                    assoc-request-flash)
-              response (handler request)]
+              response (handler request)
+              session  (or (:session response) (:session request))]
           (when response
-            (if (or (:session response) (:new-session? request))
-              (write-session (:session response))
-              (if (not-empty (:flash request))
-                (write-session (:session request))))
-            (set-session-cookie request response)))))))
+            (save-handler-session request response session)
+            (set-session-cookie   request response session)))))))

 ;; User functions for modifying the session


Add tests for new integrate-ident function

--- spec/untangled/client/core_spec.cljs
+++ spec/untangled/client/core_spec.cljs
@@ -107,6 +107,52 @@
       (assertions
         (get-in @state [:many :path]) => [[:table 99] [:table 3] [:table 77]]))))

+(specification "integrate-ident"
+  (let [state {:a {:path [[:table 2]]}
+                  :b     {:path [[:table 2]]}
+                  :d     [:table 6]
+                  :many  {:path [[:table 99] [:table 88] [:table 77]]}
+                  }]
+    (behavior "Can append to an existing vector"
+      (assertions
+       (-> state
+           (uc/integrate-ident [:table 3] :append [:a :path])
+           (get-in [:a :path]))
+       => [[:table 2] [:table 3]])
+      (assertions
+       "(is a no-op if the ident is already there)"
+       (-> state
+           (uc/integrate-ident [:table 3] :append [:a :path])
+           (get-in [:a :path]))
+       => [[:table 2] [:table 3]]))
+    (behavior "Can prepend to an existing vector"
+      (assertions
+       (-> state
+           (uc/integrate-ident [:table 3] :prepend [:b :path])
+           (get-in [:b :path]))
+       => [[:table 3] [:table 2]])
+      (assertions
+       "(is a no-op if already there)"
+       (-> state
+           (uc/integrate-ident [:table 3] :prepend [:b :path])
+           (get-in [:b :path]))
+       => [[:table 3] [:table 2]]))
+    (behavior "Can create/replace a to-one ident"
+      (assertions
+       (-> state
+           (uc/integrate-ident [:table 3] :replace [:d])
+           (get-in [:d]))
+       => [:table 3]
+       (-> state
+           (uc/integrate-ident [:table 3] :replace [:c :path])
+           (get-in [:c :path]))
+       => [:table 3]))
+    (behavior "Can replace an existing to-many element in a vector"
+      (assertions
+       (-> state
+           (uc/integrate-ident [:table 3] :replace [:many :path 1])
+           (get-in [:many :path]))
+       => [[:table 99] [:table 3] [:table 77]]))))

 (specification "Untangled Application -- clear-pending-remote-requests!"
   (let [channel (async/chan 1000)


Update hello-world version.

Update hello-world version.

--- examples/hello-world/project.clj
+++ examples/hello-world/project.clj
@@ -1,7 +1,6 @@
-(defproject hello-world "0.27.0-SNAPSHOT"
+(defproject hello-world "0.27.0"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.10.1"]
-                 [uncomplicate/neanderthal "0.27.0-SNAPSHOT"]
-                 [neanderthal-stick "0.1.0-SNAPSHOT"]]
+                 [uncomplicate/neanderthal "0.27.0"]]
   :jvm-opts ^:replace [#_"--add-opens=java.base/jdk.internal.ref=ALL-UNNAMED"])


Add Twitter summary card

Add Twitter summary card

--- src/cornwalltechjam/layout.clj
+++ src/cornwalltechjam/layout.clj
@@ -65,6 +65,11 @@
     [:link {:href "/assets/css/style-blue.css", :rel "stylesheet", :title "default"}]
     [:link {:href "/assets/css/width-full.css", :rel "stylesheet", :title "default"}]
     [:link {:href "/assets/css/techjam.css", :rel "stylesheet"}]
+    [:meta {:name "twitter:card", :content "summary"}]
+    [:meta {:name "twitter:site", :content "@cornwalltechjam"}]
+    [:meta {:name "twitter:title", :content title}]
+    [:meta {:name "twitter:description", :content description}]
+    [:meta {:name "twitter:image", :content "https://avatars1.githubusercontent.com/u/18351576"}]
     "<!-- HTML5 shim and Respond.js IE8 support of HTML5 elements and media queries -->" "\n    " "<!--
 [if lt IE 9]>\n        <script src=\"/assets/js/html5shiv.min.js\"></script>\n        <script src=\"/assets/js/respond.min.js\"></script>\n    <!
 [endif]-->" "\n"]