More api tests for flambo

More api tests for flambo

--- test/flambo/api_test.clj
+++ test/flambo/api_test.clj
@@ -62,7 +62,7 @@
         (-> (f/parallelize c [1 2 3 4 5])
             (f/map (f/fn [x] (* 2 x)))
             f/collect
-            vec) => [2 4 6 8 10])
+            #_vec) => [2 4 6 8 10])

       (fact
         "map-to-pair returns an RDD of (K, V) pairs formed by passing each element of the source
@@ -71,7 +71,7 @@
             (f/map-to-pair (f/fn [x] [x 1]))
             (f/map f/untuple)
             f/collect
-            vec) => [["a" 1] ["b" 1] ["c" 1] ["d" 1]])
+            #_vec) => [["a" 1] ["b" 1] ["c" 1] ["d" 1]])

       (fact
         "reduce-by-key returns an RDD of (K, V) when called on an RDD of (K, V) pairs"
@@ -87,9 +87,9 @@
       (fact
         "similar to map, but each input item can be mapped to 0 or more output items;
         mapping function must therefore return a sequence rather than a single item"
-        (-> (f/parallelize c ["Four score and seven years ago our fathers"
-                              "brought forth on this continent a new nation"])
-            (f/flat-map (f/fn [x] (clojure.string/split x #" ")))
+        (-> (f/parallelize c [["Four score and seven years ago our fathers"]
+                              ["brought forth on this continent a new nation"]])
+            (f/flat-map (f/fn [x] (clojure.string/split (first x) #" ")))
             f/collect
             vec) => ["Four" "score" "and" "seven" "years" "ago" "our" "fathers" "brought" "forth" "on" "this" "continent" "a" "new" "nation"])

@@ -135,14 +135,51 @@
                         ["key1" [[2] [22]]]
                         ["key2" [[3] nil]]])

+      (fact
+        "sample returns a fraction of the RDD, with/without replacement,
+        using a given random number generator seed"
+        (-> (f/parallelize c [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15])
+            (f/sample false 0.4 10)
+            f/collect) => [1 4 7 11 14])
+
+      (fact
+        "fold"
+        (-> (f/parallelize c [1 2 3 4 5])
+            (f/fold 0 (f/fn [x y] (+ x y)))) => 15)
+
       #_(fact
-        ""
-        (-> (f/parallelize c ["Four score and seven years ago"])
-            (f/flat-map-to-pair (f/fn [x] (map (fn [x] [x 1])
-                                                    (clojure.string/split x #" "))))
+        "group-by"
+        (-> (f/parallelize c [["key1" 1]
+                              ["key1" 2]
+                              ["key2" 3]
+                              ["key2" 4]
+                              ["key3" 5]])
+            (f/group-by (f/fn [x] (first x)))
+            (f/map f/untuple)
+            f/collect
+            vec) => [["key1" [1 2]] ["key2" [3 4]] ["key3" [5]]])
+
+      #_(fact
+        "group-by-key"
+        (-> (f/parallelize c [["key1" 1]
+                              ["key1" 2]
+                              ["key2" 3]
+                              ["key2" 4]
+                              ["key3" 5]])
+            f/group-by-key
             (f/map f/double-untuple)
             f/collect
-            vec) => [["Four" 1] ["score" 1] ["and" 1] ["seven" 1] ["years" 1] ["ago" 1]])
+            vec) => [])
+
+      #_(fact
+        "flat-map-to-pair"
+        (-> (f/parallelize c [["Four score and seven years ago our fathers"]
+                              ["brought forth on this continent a new nation"]])
+            (f/flat-map-to-pair (f/fn [x] (map (fn [y] [y 1])
+                                               (clojure.string/split (first x) #" "))))
+            #_f/untuple
+            #_f/collect
+            #_vec) => [["Four" 1] ["score" 1] ["and" 1] ["seven" 1] ["years" 1] ["ago" 1]])
       )))

 (facts
@@ -166,4 +203,50 @@
                               ["key2" 4]
                               ["key3" 5]])
             (f/count-by-key)) => {"key1" 2, "key2" 2, "key3" 1})
+
+      (fact
+        "foreach runs a function on each element of the RDD, returns nil; this is usually done for side effcts"
+        (-> (f/parallelize c [1 2 3 4 5])
+            (f/foreach (f/fn [x] x))) => nil)
+
+      (fact
+        "first returns the first element of an RDD"
+        (-> (f/parallelize c [1 2 3 4 5])
+            f/first) => 1)
+
+      (fact
+        "count return the number of elements in an RDD"
+        (-> (f/parallelize c [["a" 1] ["b" 2] ["c" 3] ["d" 4] ["e" 5]])
+            f/count) => 5)
+
+      (fact
+        "collect returns all elements of the RDD as an array at the driver program"
+        (-> (f/parallelize c [[1] [2] [3] [4] [5]])
+            f/collect) => [[1] [2] [3] [4] [5]])
+
+      (fact
+        "distinct"
+        (-> (f/parallelize c [1 2 1 3 4 5 4])
+            f/distinct
+            f/collect
+            vec) => (contains #{1 2 3 4 5}))
+
+      (fact
+        "take returns an array with the first n elements of an RDD"
+        (-> (f/parallelize c [1 2 3 4 5])
+            (f/take 3)) => [1 2 3])
+
+      (fact
+        "glom returns an RDD created by coalescing all elements within each partition into a list"
+        (-> (f/parallelize c [[1] [2] [3] [4] [5]])
+            f/glom
+            f/collect
+            vec) => [[[1]] [[2]] [[3]] [[4] [5]]])
+
+      (fact
+        "cache persists this RDD with a default storage level (MEMORY_ONLY)"
+        (let [cache (-> (f/parallelize c [1 2 3 4 5])
+                        (f/cache))]
+          (-> cache
+              f/collect) => [1 2 3 4 5]))
       )))


Test stream-from with multiple games at once

--- test/gin/stream_test.clj
+++ test/gin/stream_test.clj
@@ -156,6 +156,17 @@
                                                  :game/last-event event-eid}])})}])
     (<!! setup-counter)
     (dd/stream-from conn listen 0 eid attr start)
+    (go (dotimes [i 25]
+          (<! (timeout 1500))
+          @(d/transact conn (let [game (d/entity db [:game/id "some-other-game"])
+                                  event-eid (d/tempid :db.part/user)
+                                  game-eid (:db/id game)]
+                              [{:db/id event-eid
+                                :event/type :some-other-event
+                                :event/game game-eid
+                                :event/tx (d/tempid :db.part/tx)}
+                               {:db/id game-eid
+                                :game/last-event event-eid}]))))
     (let [first-batch (dotimes [i 50]
                         @(d/transact conn [[:inc]]))
           _ (<!! first-counter-done)


CMR-3169: Reformatted test xml

CMR-3169: Reformatted test xml

--- search-app/test/cmr/search/test/xslt.clj
+++ search-app/test/cmr/search/test/xslt.clj
@@ -358,15 +358,15 @@
 				    <Collection>
 				        <DataSetId>ASTER Level 1 precision terrain corrected registered at-sensor radiance V003</DataSetId>
 				    </Collection>
-              		<OnlineResources>
-                      <OnlineResource>
-                        <URL>http://acdisc.gsfc.nasa.gov/opendap/HDF-EOS5/GLDAS_NOAH10_3H.2.0:GLDAS_NOAH10_3H.A19480101.0300.020.jpg</URL>
-                        <Description>Some image</Description>
-                        <Type>Browse</Type>
-              		    <MimeType>image/jpeg</MimeType>
-                      </OnlineResource>
-            		</OnlineResources>
-				    <Orderable>true</Orderable>
+        		<OnlineResources>
+                <OnlineResource>
+                  <URL>http://acdisc.gsfc.nasa.gov/opendap/HDF-EOS5/GLDAS_NOAH10_3H.2.0:GLDAS_NOAH10_3H.A19480101.0300.020.jpg</URL>
+                  <Description>Some image</Description>
+                  <Type>Browse</Type>
+        		    <MimeType>image/jpeg</MimeType>
+                </OnlineResource>
+      		</OnlineResources>
+				  <Orderable>true</Orderable>
 				</Granule>")

 (def echo10-granule-browse-uppercase (str/replace echo10-granule-browse "Browse" "BROWSE"))


titanic lattice added

titanic lattice added

--- src/main/clojure/conexp/fca/lattices.clj
+++ src/main/clojure/conexp/fca/lattices.clj
@@ -433,6 +433,25 @@
       intents
       (remove #{(attributes context)} intents))))

+(defn iceberg-lattice
+  "Returns for a given context ctx its iceberg lattice."
+  ([ctx]
+    (iceberg-lattice ctx 0))
+  ([ctx minsupp]
+    (let [intents  (titanic-iceberg-intent-seq ctx minsupp)
+          concepts (map
+                     #(vector (attribute-derivation ctx %) %)
+                     intents)]
+      (make-lattice-nc concepts
+                       (fn <= [[A _] [C _]]
+                         (subset? A C))
+                       (fn inf [[A _] [C _]]
+                         (let [A+C (intersection A C)]
+                           [A+C (object-derivation ctx A+C)]))
+                       (fn sup [[_ B] [_ D]]
+                         (let [B+D (intersection B D)]
+                           [(attribute-derivation ctx B+D) B+D]))))))
+
 ;;;

 nil


Add failing test case

Add failing test case

--- test/test/datascript.cljs
+++ test/test/datascript.cljs
@@ -195,7 +195,16 @@
     (testing "nested navigation"
       (is (= (-> (e 1) :children first :children) #{(e 100) (e 101)}))
       (is (= (-> (e 10) :children first :father) (e 10)))
-      (is (= (-> (e 10) :father :children) #{(e 10)})))
+      (is (= (-> (e 10) :father :children) #{(e 10)}))
+
+      (testing "after touch"
+        (let [e1  (e 1)
+              e10 (e 10)]
+          (d/touch e1)
+          (d/touch e10)
+          (is (= (-> e1 :children first :children) #{(e 100) (e 101)}))
+          (is (= (-> e10 :children first :father) (e 10)))
+          (is (= (-> e10 :father :children) #{(e 10)})))))

     (testing "backward navigation"
       (is (= (:_children (e 1))  nil))


use value of billing project, not option index, when creating workspace.

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
@@ -57,7 +57,7 @@
      (swap! state dissoc :server-error :validation-errors)
      (if-let [fails (input/validate refs "wsName")]
        (swap! state assoc :validation-errors fails)
-       (let [project (:selected-project @state)
+       (let [project (nth (:billing-projects props) (int (:selected-project @state)))
              name (input/get-text refs "wsName")
              desc (common/get-text refs "wsDescription")
              attributes (if (clojure.string/blank? desc) {} {:description desc})]


unit test for native mongo query.

unit test for native mongo query.

--- test/metabase/driver/mongo_test.clj
+++ test/metabase/driver/mongo_test.clj
@@ -4,8 +4,10 @@
             [korma.core :as k]
             [metabase.db :refer :all]
             [metabase.driver :as driver]
-            (metabase.models [field :refer [Field]]
+            (metabase.models [database :refer [Database]]
+                             [field :refer [Field]]
                              [table :refer [Table] :as table])
+            [metabase.query-processor :as qp]
             [metabase.test.data :as data]
             [metabase.test.data.datasets :as datasets]
             [metabase.test.util :refer [expect-eval-actual-first resolve-private-fns]])
@@ -66,6 +68,18 @@
                                             :port 3000
                                             :dbname "bad-db-name?connectTimeoutMS=50"}))

+(expect-when-testing-mongo
+  {:status :completed
+   :row_count 1
+   :data {:rows [[1]]
+          :columns ["count"]
+          :cols [{:description nil, :table_id nil, :special_type nil, :name "count", :extra_info {}, :id nil, :target nil, :display_name "count", :preview-display true, :base_type :UnknownField}]
+          :native_form {:collection "venues"
+                        :query "[{\"$project\": {\"_id\": \"$_id\"}}, {\"$match\": {\"_id\": {\"$eq\": 1}}}, {\"$group\": {\"_id\": null, \"count\": {\"$sum\": 1}}}, {\"$sort\": {\"_id\": 1}}, {\"$project\": {\"_id\": false, \"count\": true}}]"}}}
+  (qp/process-query {:native   {:query "[{\"$project\": {\"_id\": \"$_id\"}}, {\"$match\": {\"_id\": {\"$eq\": 1}}}, {\"$group\": {\"_id\": null, \"count\": {\"$sum\": 1}}}, {\"$sort\": {\"_id\": 1}}, {\"$project\": {\"_id\": false, \"count\": true}}]"
+                                :collection "venues"}
+                     :type     :native
+                     :database (:id (mongo-db))}))

 ;; ## Tests for individual syncing functions


Use ipv4 address by default for service instances (#147)

* -- use ipv4 address by default for service instances created by discovery

* -- feedback from @dposada
 - throw exception if no IPv4 address is available

--- waiter/src/waiter/discovery.clj
+++ waiter/src/waiter/discovery.clj
@@ -10,50 +10,47 @@
 ;;
 (ns waiter.discovery
   (:require [clojure.tools.logging :as log])
-  (:import org.apache.curator.x.discovery.ServiceDiscoveryBuilder
-           org.apache.curator.x.discovery.ServiceInstance
-           org.apache.curator.x.discovery.UriSpec
-           (org.apache.curator.x.discovery ServiceDiscovery ServiceCache)
-           (org.apache.curator.framework CuratorFramework)))
+  (:import (java.net Inet4Address)
+           (org.apache.curator.framework CuratorFramework)
+           (org.apache.curator.x.discovery ServiceCache ServiceDiscovery ServiceDiscoveryBuilder
+                                           ServiceInstance ServiceInstanceBuilder UriSpec)))

 (defn- ->service-instance
-  [id svc-name {:keys [host port]}]
-  (let [builder (.. ServiceInstance
-                    builder
-                    (id id)
-                    (name svc-name)
-                    (uriSpec (UriSpec. "{scheme}://{address}:{port}/{endpoint}"))
-                    (port port))
-        builder' (if (= host "0.0.0.0")
-                   builder
-                   (.address builder host))]
-    (.build builder')))
+  [id service-name {:keys [host port]}]
+  (let [builder (-> (ServiceInstance/builder)
+                    (.id id)
+                    (.name service-name)
+                    (.uriSpec (UriSpec. "{scheme}://{address}:{port}/{endpoint}"))
+                    (.port port)
+                    (.address (if (= host "0.0.0.0")
+                                (let [inet-addresses (ServiceInstanceBuilder/getAllLocalIPs)
+                                      ipv4-address (->> inet-addresses
+                                                        (some #(when (instance? Inet4Address %) %)))]
+                                  (if ipv4-address
+                                    (.getHostAddress ipv4-address)
+                                    (throw (ex-info "No IPv4 address found for host"
+                                                    {:id id
+                                                     :inet-addresses inet-addresses
+                                                     :service-name service-name}))))
+                                host)))]
+    (.build builder)))

 (defn- ->service-discovery
   [^CuratorFramework curator base-path instance]
-  (.. ServiceDiscoveryBuilder
-      (builder Void)
-      (client curator)
-      (basePath base-path)
-      (thisInstance instance)
-      build))
+  (-> (ServiceDiscoveryBuilder/builder Void)
+      (.client curator)
+      (.basePath base-path)
+      (.thisInstance instance)
+      (.build)))

 (defn- ->service-cache
-  [^ServiceDiscovery service-discovery svc-name]
-  (.. service-discovery
-      serviceCacheBuilder
-      (name svc-name)
-      build))
-
-(defn- ->service-provider
-  [^ServiceDiscovery service-discovery svc-name]
-  (.. service-discovery
-      serviceProviderBuilder
-      (serviceName svc-name)
-      build))
+  [^ServiceDiscovery service-discovery service-name]
+  (-> service-discovery
+      (.serviceCacheBuilder)
+      (.name service-name)
+      (.build)))

 (defn- get-instance-url [service-instance protocol endpoint]
-  ; (.buildUriSpec service-instance {"endpoint" endpoint})
   (str protocol "://" (.getAddress service-instance) ":" (.getPort service-instance) "/" endpoint))

 (defn- create-unregistration-hook
@@ -98,15 +95,12 @@
   [router-id curator service-name discovery-path {:keys [host port]}]
   (let [instance (->service-instance router-id service-name {:host host :port port})
         discovery (->service-discovery curator discovery-path instance)
-        ^ServiceCache cache (->service-cache discovery service-name)]
+        cache (->service-cache discovery service-name)]
     (log/info "Using service name:" service-name "for router id:" router-id)
     (.start discovery)
     (create-unregistration-hook discovery instance)
     (.start cache)
     (log/info "Started service cache with peers:" (.getInstances cache))
-    {:service-instance instance
+    {:service-cache cache
      :service-discovery discovery
-     :service-cache cache}))
-
-(comment
-  (.. ServiceDiscoveryBuilder (builder nil)))
+     :service-instance instance}))


unused test removed

unused test removed

--- Clojure-Websockets/MainApp/test/birdwatch/data_test.clj
+++ Clojure-Websockets/MainApp/test/birdwatch/data_test.clj
@@ -1,33 +0,0 @@
-(ns birdwatch.data-test
-  (:require [clojure.test :refer :all]
-            [birdwatch.data :refer :all]))
-
-;; first round of tests, with an empty accumulator.
-(def tweets1 [{:retweeted_status {:id_str "1" :retweet_count 1111 :favorite_count 111}}
-              {:retweeted_status {:id_str "2" :retweet_count 2222 :favorite_count 222}}
-              {:retweeted_status {:id_str "3" :retweet_count 3333 :favorite_count 333}}
-              {:retweeted_status {:id_str "4" :retweet_count 4444 :favorite_count 444}}
-              {:retweeted_status {:id_str "5" :retweet_count 5555 :favorite_count 555}}])
-
-(def by-rt1 (retweets tweets1 {}))
-(def by-rt-exp1 {:1 1111 :2 2222 :3 3333 :4 4444 :5 5555})
-(deftest rt-test1  (testing "expected equals actual" (is (= by-rt1 by-rt-exp1))))
-
-(def by-fav1 (favorites tweets1 {}))
-(def by-fav-exp1 {:1 111 :2 222 :3 333 :4 444 :5 555})
-(deftest fav-test1 (testing "expected equals actual" (is (= by-fav1 by-fav-exp1))))
-
-;; test with previous results as accumulator (to simulate merging results)
-;; expectation: only merge tweets with higher counts (assumption: favorite- and rt-counts go up)
-(def tweets2 [{:retweeted_status {:id_str "1" :retweet_count 11 :favorite_count 11}}
-              {:retweeted_status {:id_str "2" :retweet_count 22222 :favorite_count 2222}}
-              {:retweeted_status {:id_str "4" :retweet_count 44444 :favorite_count 4444}}
-              {:retweeted_status {:id_str "6" :retweet_count 6666 :favorite_count 666}}])
-
-(def by-rt2 (retweets tweets2 by-rt1))
-(def by-rt-exp2 {:1 1111 :2 22222 :3 3333 :4 44444 :5 5555 :6 6666})
-(deftest rt-test2  (testing "expected equals actual" (is (= by-rt2 by-rt-exp2))))
-
-(def by-fav2 (favorites tweets2 by-fav1))
-(def by-fav-exp2 {:1 111 :2 2222 :3 333 :4 4444 :5 555 :6 666})
-(deftest fav-test2 (testing "expected equals actual" (is (= by-fav2 by-fav-exp2))))


better handling of target options

better handling of target options

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -174,8 +174,8 @@

                                  (when invalid?
                                    (dom/title nil
-                                              (str "This action links to "  (:layer/ui-target layer) ", but no shapes have that name."
-                                                   " Right-click on a shape to name it " (:layer/ui-target layer))))
+                                              (str "This action links to \""  (:layer/ui-target layer) "\", but no shapes have that name."
+                                                   " Right-click on a shape's border to name it " (:layer/ui-target layer))))
                                  (svg-element selected-eids
                                               (assoc layer
                                                 :onMouseDown #(do
@@ -318,9 +318,11 @@
     om/IRender
     (render [_]
       (let [{:keys [cast! db]} (om/get-shared owner)
-            targets (map first (d/q '{:find [?id]
-                                      :where [[_ :layer/ui-id ?id]]}
-                                    @db))]
+            ;; TODO: figure out how to handle nils in datascript
+            targets (remove nil?
+                            (map first (d/q '{:find [?id]
+                                              :where [[_ :layer/ui-id ?id]]}
+                                            @db)))]
         (dom/foreignObject #js {:width "100%"
                                 :height "100%"
                                 :x x
@@ -354,7 +356,9 @@
                        (dom/option #js {:value ""}
                                    "None")

-                       (for [target targets]
+                       (for [target (sort (distinct (concat targets
+                                                            (when (:layer/ui-target layer)
+                                                              [(:layer/ui-target layer)]))))]
                          (dom/option #js {:value target}
                                      target))))))))))


adds an input dropdown

adds an input dropdown

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -302,7 +302,8 @@

 (defn layer-properties [{:keys [layer x y]} owner]
   (reify
-    om/IInitState (init-state [_] {:listener-key (.getNextUniqueId (.getInstance IdGenerator))})
+    om/IInitState (init-state [_] {:listener-key (.getNextUniqueId (.getInstance IdGenerator))
+                                   :input-expanded false})
     om/IDidMount
     (did-mount [_]
       (.focus (om/get-node owner "id-input"))
@@ -346,21 +347,26 @@
                                       ;; TODO: defaults for each layer when we create them
                                       :onChange #(cast! :layer-ui-id-edited {:value (.. % -target -value)})}))
                     (when-not (= :layer.type/line (:layer/type layer))
-                      (dom/div nil
-                        (apply
-                         dom/select #js {:type "text"
-                                         :ref "reference-input"
-                                         :value (or (:layer/ui-target layer) "")
-                                         ;; TODO: defaults for each layer when we create them
-                                         :onChange #(cast! :layer-ui-target-edited {:value (.. % -target -value)})}
-                         (dom/option #js {:value ""}
-                                     "None")
-
-                         (for [target (sort (distinct (concat targets
-                                                              (when (:layer/ui-target layer)
-                                                                [(:layer/ui-target layer)]))))]
-                           (dom/option #js {:value target}
-                                       target)))))))))))
+                      (dom/div #js {:className "text-select"}
+                        (dom/div #js {:className "input-container"}
+                          (dom/input #js {:type "text"
+                                          :ref "target-input"
+                                          :value (or (:layer/ui-target layer) "")
+                                          :onClick #(.focus (om/get-node owner "target-input"))
+                                          :onChange #(cast! :layer-ui-target-edited {:value (.. % -target -value)})})
+                          (dom/button #js {:onClick #(do (om/update-state! owner :input-expanded not)
+                                                         false)}
+                                      "\\/"))
+                        (apply dom/div #js {:className "target-options"}
+                               (when (om/get-state owner :input-expanded)
+                                 (for [target (sort (distinct (concat targets
+                                                                      (when (:layer/ui-target layer)
+                                                                        [(:layer/ui-target layer)]))))]
+                                   (dom/div #js {:className "target-option"
+                                                 :onClick #(do (cast! :layer-ui-target-edited {:value target})
+                                                               (om/set-state! owner :input-expanded false)
+                                                               (.focus (om/get-node owner "target-input")))}
+                                     target))))))))))))

 (defn svg-canvas [payload owner opts]
   (reify


Fix docs links in enterprise header

Fix docs links in enterprise header

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -181,12 +181,12 @@
                      [:li (maybe-active nav-point :pricing)
                       [:a.menu-item {:href "/pricing/"} "Pricing"]]))
                  [:li (maybe-active nav-point :documentation)
-                  [:a.menu-item {:href "https://circleci.com/docs/"}
+                  [:a.menu-item {:href "/docs/"}
                    (if (config/enterprise?)
                     "CircleCI Documentation"
                     "Documentation")]]
                  (if (config/enterprise?)
-                   [:li [:a.menu-item {:href "https://enterprise-docs.circleci.com"} "Enterprise Documentation"]])
+                   [:li [:a.menu-item {:href "/docs/enterprise/"} "Enterprise Documentation"]])
                  [:li [:a.menu-item {:href "https://discuss.circleci.com" :target "_blank"} "Discuss"]]
                  (when (config/show-marketing-pages?)
                    (list


add children comments

add children comments

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -6,6 +6,7 @@
             [frontend.datascript :as ds]
             [frontend.datetime :as datetime]
             [frontend.db :as fdb]
+            [frontend.models.issue :as issue-model]
             [frontend.sente :as sente]
             [frontend.urls :as urls]
             [frontend.utils :as utils]
@@ -39,7 +40,7 @@
                     :data-placeholder-nil "How can we improve Precursor?"
                     :data-placeholder-busy "Your idea in less than 140 characters?"}]])))))

-(defn comment-form [{:keys [issue-id]} owner {:keys [issue-db]}]
+(defn comment-form [{:keys [issue-id parent-id]} owner {:keys [issue-db]}]
   (reify
     om/IInitState (init-state [_] {:comment-body ""})
     om/IRenderState
@@ -49,9 +50,11 @@
          [:form {:on-submit #(do (utils/stop-event %)
                                  (when (seq comment-body)
                                    (d/transact! issue-db [{:db/id issue-id
-                                                           :issue/comments {:db/id -1
-                                                                            :comment/body comment-body
-                                                                            :frontend/issue-id (utils/squuid)}}])
+                                                           :issue/comments (merge {:db/id -1
+                                                                                :comment/body comment-body
+                                                                                :frontend/issue-id (utils/squuid)}
+                                                                                (when parent-id
+                                                                                {:comment/parent parent-id}))}])
                                    (om/set-state! owner :comment-body "")))}
           [:input {:type "text"
                    :value comment-body
@@ -83,38 +86,68 @@
              [:span.issue-vote-count (count (:issue/votes issue))]
              (common/icon :north)]))))))

-(defn single-comment [{:keys [comment-id]} owner]
-  (reify
-    om/IInitState
-    (init-state [_] {:listener-key (.getNextUniqueId (.getInstance IdGenerator))})
+
+(defn single-comment [{:keys [comment-id issue-id]} owner {:keys [ancestors]
+                                                           :or {ancestors #{}}}]
+  (reify
+    om/IInitState
+    (init-state [_] {:listener-key (.getNextUniqueId (.getInstance IdGenerator))
+                     :replying? false})
     om/IDidMount
     (did-mount [_]
       (fdb/add-entity-listener (om/get-shared owner :issue-db)
                                comment-id
                                (om/get-state owner :listener-key)
                                (fn [tx-report]
-                                 (om/refresh! owner))))
+                                 (om/refresh! owner)))
+      (fdb/add-attribute-listener (om/get-shared owner :issue-db)
+                                  :comment/parent
+                                  (om/get-state owner :listener-key)
+                                  (fn [tx-report]
+                                    (when (first (filter #(= comment-id (:v %))
+                                                         (:tx-data tx-report)))
+                                      (om/refresh! owner)))))
     om/IWillUnmount
     (will-unmount [_]
       (fdb/remove-entity-listener (om/get-shared owner :issue-db)
                                   comment-id
-                                  (om/get-state owner :listener-key)))
-    om/IRender
-    (render [_]
+                                  (om/get-state owner :listener-key))
+      (fdb/remove-attribute-listener (om/get-shared owner :issue-db)
+                                     :comment/parent
+                                     (om/get-state owner :listener-key)))
+    om/IRenderState
+    (render-state [_ {:keys [replying?]}]
       (let [{:keys [issue-db cast!]} (om/get-shared owner)
             comment (d/entity @issue-db comment-id)]
         (html
          [:div.comment
-          [:div (:comment/body comment)]])))))
+          [:div (:comment/body comment)]
+          [:div.reply
+           (if replying?
+             (om/build comment-form {:issue-id issue-id
+                                     :parent-id comment-id})
+             [:a {:role "button"
+                  :on-click #(om/set-state! owner :replying? true)}
+              "reply"])]
+          (when-not (contains? ancestors (:db/id comment)) ; don't render cycles
+            [:div.comment-children {:style {:margin-left "5px"}}
+             (for [id (utils/inspect (issue-model/direct-descendants @issue-db comment))]
+               (om/build single-comment {:issue-id issue-id
+                                         :comment-id id}
+                         {:key :comment-id
+                          :opts {:ancestors (conj ancestors (:db/id comment))}}))])])))))

 (defn comments [{:keys [issue]} owner]
   (reify
     om/IRender
     (render [_]
-      (html
-       [:div.issue-comments
-        (for [{:keys [db/id]} (:issue/comments issue)]
-          (om/build single-comment {:comment-id id} {:key :comment-id}))]))))
+      (let [{:keys [issue-db]} (om/get-shared owner)]
+        (html
+         [:div.issue-comments
+          (for [{:keys [db/id]} (issue-model/top-level-comments issue)]
+            (om/build single-comment {:comment-id id
+                                      :issue-id (:db/id issue)}
+                      {:key :comment-id}))])))))

 (defn issue [{:keys [issue-id]} owner]
   (reify


don't load components on pages without a component definition

--- src-cljs/main.cljs
+++ src-cljs/main.cljs
@@ -21,12 +21,13 @@

 (defn- get-page-component
   [app-state]
-  [((keyword (:page app-state)) pages) app-state])
+  (if-let [page (:page app-state)]
+    [((keyword page) pages) app-state]))

 (defn init
   [app-state]
-    (reagent/render-component
-     (get-page-component app-state)
-     (dom/getElement "app-content")))
+  (if-let [page-component (get-page-component app-state)]
+    (reagent/render-component page-component (dom/getElement "app-content"))
+    (js/console.debug "Abandoning init: no component is defined for this page")))

 (init (get-app-state))


azulenoids.clj: factored out the unique function.

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -7,6 +7,15 @@

 (defn iterate-cycle [coll x]
   (reductions #(%2 %1) x (cycle coll)))
+
+(defn unique [coll key-fun]
+  (letfn [(step [acc x]
+                (let [[seen _] acc
+                      key (key-fun x)]
+                  (if (seen key)
+                    [seen false]
+                    [(conj seen key) x])))]
+         (filter identity (map second (reductions step [#{} false] coll)))))

 (defn walk [ds D & idxs]
   (reduce #(.op ds %2 %1) D idxs))
@@ -48,7 +57,7 @@
       (zipmap (drop (mod (- 19 p) 16) octagon-boundary)
               (take 16 template-boundary)))))

-(defn apply-to-template [ds oct2tmp]
+(defn on-template [ds oct2tmp]
   (let [tmp2oct (clojure.set/map-invert oct2tmp)
         tmp (DynamicDSymbol. template)]
     (doseq [D (keys tmp2oct)]
@@ -57,7 +66,7 @@
     (doseq [D (keys tmp2oct)]
       (if (not (.definesV tmp 1 2 D))
         (.redefineV tmp 1 2 D (.v ds 1 2 (tmp2oct D)))))
-    (-> tmp .dual .minimal .canonical)))
+    tmp))

 (def octa-sets (filter #(-> %1 max-curvature .isNegative not)
                        (lazy-seq (new CombineTiles octagon))))
@@ -68,19 +77,10 @@
         :when (-> dsym .curvature2D .isZero)]
     dsym))

-(defn azul-syms-raw []
-  (for [ds octa-syms o2t boundary-mappings] (apply-to-template ds o2t)))
-
 (def azul-syms
-  (letfn [(step [acc ds]
-                (let [[seen _] acc
-                      key (.invariant ds)]
-                  (if (seen key)
-                    [seen false]
-                    [(conj seen key) ds])))]
-         (for [entry (reductions step [#{} false] (azul-syms-raw))
-               :when (second entry)]
-           (second entry))))
+  (let [raw (for [ds octa-syms o2t boundary-mappings] (on-template ds o2t))]
+    (for [ds (unique raw #(-> %1 .minimal .invariant))]
+      (-> ds .dual .minimal .canonical))))

 (defn -main []
   (do


selfdual2d.clj generates symbols with the required face size restrictions.

--- clojure/org/gavrog/clojure/selfdual2d.clj
+++ clojure/org/gavrog/clojure/selfdual2d.clj
@@ -1,6 +1,7 @@
 (ns org.gavrog.clojure.selfdual2d
-  (:use (org.gavrog.clojure [util :only [unique]]
-                            [delaney :only [s v size dim curvature]]))
+  (:use (org.gavrog.clojure
+          [util :only [unique]]
+          [delaney :only [s v size dim curvature orbit-reps]]))
   (:import (org.gavrog.jane.fpgroups SmallActionsIterator)
            (org.gavrog.jane.numbers Whole)
            (org.gavrog.joss.dsyms.basic DSymbol)
@@ -8,9 +9,20 @@
            (org.gavrog.joss.dsyms.generators DefineBranching2d))
   (:gen-class))

+(defn minimal? [ds] (.isMinimal ds))
+
 (defn self-dual? [ds] (= ds (.dual ds)))

+(defn euclidean? [ds] (= (curvature ds 1) 0))
+
 (defn proto-euclidean? [ds] (>= (curvature ds 1) 0))
+
+(defn face-sizes [ds]
+  (map #(.m ds 0 1 %) (orbit-reps ds [0 1])))
+
+(defn good-face-sizes? [ds]
+  (let [t (face-sizes ds)]
+    (and (<= (count (unique t)) 2) (some #(= 3 %) t))))

 (defn andp [& preds]
   (fn [& args]
@@ -21,3 +33,11 @@
     (filter (andp self-dual? proto-euclidean?)
             (map #(.flat (DSCover. G %))
                  (SmallActionsIterator. (.getPresentation G) max-size false)))))
+
+;; All self-dual, 2d euclidean tilings with only two face sizes and at least
+;; one triangle.
+(defn d-syms [max-size]
+  (for [dset (d-sets max-size)
+        dsym (lazy-seq (DefineBranching2d. dset 3 3 Whole/ZERO))
+        :when ((andp self-dual? minimal? euclidean? good-face-sizes?) dsym)]
+    dsym))


removing console logging

removing console logging

--- src/app/cljs/one/sample/model.cljs
+++ src/app/cljs/one/sample/model.cljs
@@ -20,7 +20,6 @@

 (add-watch docs :documents-state-key
            (fn [k r o n]
-             (.log js/console "docs watcher")
              (dispatch/fire :documents-changed n)))

 (defn uuid []


Update Commons FileUpload dependency to 1.3.2

This addresses vulnerability: http://www.cvedetails.com/cve/CVE-2016-3092/
Fixes #255.

--- ring-core/project.clj
+++ ring-core/project.clj
@@ -7,7 +7,7 @@
   :dependencies [[org.clojure/clojure "1.5.1"]
                  [ring/ring-codec "1.0.1"]
                  [commons-io "2.5"]
-                 [commons-fileupload "1.3.1"]
+                 [commons-fileupload "1.3.2"]
                  [clj-time "0.11.0"]
                  [crypto-random "1.2.0"]
                  [crypto-equality "1.0.0"]]


whitespace

whitespace

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -517,7 +517,7 @@
             settings (state-utils/merge-inputs project inputs project-model/notification-keys)]
         (html
          [:div
-          [:h2 "Chatroom setup for" (vcs-url/project-name (:vcs_url project))]
+          [:h2 "Chatroom setup for " (vcs-url/project-name (:vcs_url project))]
           [:div.chat-rooms
            (for [chat-spec [{:service "Hipchat"
                              :icon "chat-i-hip"


log errors in response macros

log errors in response macros

--- s3/src/s3/webutil.clj
+++ s3/src/s3/webutil.clj
@@ -41,6 +41,7 @@
   `(try
      (json-resp ~data)
      (catch Exception ex#
+       (error ex#)
        (error-status ex#))))

 (defmacro user-> [cookies form]
@@ -57,6 +58,7 @@
          (json-resp (-> user# ~form)))
        (json-resp {"error" "Authentication required"} 401))
      (catch Exception ex#
+       (error ex#)
        (error-status ex#))))

 (defmacro text-plain-auth-> [cookies form]
@@ -66,4 +68,5 @@
          (-> user# ~form))
        (json-resp {"error" "Authentication required"} 401))
      (catch Exception ex#
+       (error ex#)
        (error-status ex#))))


+TODO

+TODO

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -322,6 +322,19 @@
               (log/debug (str "result of conjugate: " result))
               result)))))

+;; TODO create a class LinguisticStructure: which is simply a
+;; clojure map. This class has a method: '.toString()'. As the
+;; clojure docs explain :
+;;
+;; https://clojuredocs.org/clojure.core/str
+;;
+;; With one arg x, returns x.toString().
+;;
+;; If we define such a class, then then we can just do e.g.:
+;;
+;; (str (generate {:synsem {:cat :verb :subcat []}}))
+;;   => "je parle"
+;;
 (defn fo [input &
           {:keys [from-language show-notes]
            :or {from-language nil


Encoding with memoization

Encoding with memoization

--- src/clj/algorithms_clj/huffman.clj
+++ src/clj/algorithms_clj/huffman.clj
@@ -48,23 +48,30 @@
 ;; Encoding
 ;; -----------------------------------------------------------

-(defn get-bits
-  [{:keys [lhs rhs] :as huffman-tree} val dirs]
-  (cond
-    (= 1 (count huffman-tree)) dirs
-    (-> lhs :values val) (recur lhs val (conj dirs 0))
-    (-> rhs :values val) (recur rhs val (conj dirs 1))
-    ))
+(defn ^:private get-bits
+  [huffman-tree val]
+  (defn get-bits-impl [{:keys [lhs rhs] :as huffman-tree} dirs]
+    (cond
+      (= 1 (count huffman-tree)) dirs
+      (-> lhs :values val) (recur lhs (conj dirs 0))
+      (-> rhs :values val) (recur rhs (conj dirs 1))
+      ))
+  (get-bits-impl huffman-tree []))
+
+(defn tree->decoder
+  "Build a decoder with memoization"
+  [huffman-tree]
+  (memoize #(get-bits huffman-tree %)))

 (defn encode-with
-  "Encode a stream of values with the tree provided as first parameter"
-  [huffman-tree values]
-  (reduce #(get-bits huffman-tree %2 %1) [] values))
+  "Encode a stream of values with the decoder provided as first parameter"
+  [decoder values]
+  (transduce (mapcat decoder) conj [] values))

 (defn encode
   "Encode a stream, using the stream frequences to build the huffman tree"
   [values]
-  (encode-with (make-tree (frequencies values)) values))
+  (encode-with (tree->decoder (make-tree (frequencies values))) values))

 ;; -----------------------------------------------------------
@@ -78,6 +85,11 @@
 ;; -----------------------------------------------------------

 (def m (sorted-map :a 1 :b 2 :c 3 :d 3 :e 5))
+(def t (make-tree m))
+
+(defn tests []
+  (prn (encode-with (tree->decoder t) [:a :b]))
+  (prn (encode [:a :b])))


Fix Alpha and Omega.

Fix Alpha and Omega.

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -47,7 +47,7 @@
 (def cards-icebreakers
   {"Alpha"
    (auto-icebreaker ["All"]
-                    {:abilities [{:cost [:credit 1] :req (req (and run (zero? (:position run))))
+                    {:abilities [{:cost [:credit 1] :req (req (= (:position run) (count (:ices run))))
                                   :msg "break 1 subroutine on the outermost ICE protecting this server"}
                                  {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})

@@ -270,7 +270,7 @@

    "Omega"
    (auto-icebreaker ["All"]
-                    {:abilities [{:cost [:credit 1] :req (req (= (:position run) (dec (count (:ices run)))))
+                    {:abilities [{:cost [:credit 1] :req (req (= 1 (:position run)))
                                   :msg "break 1 subroutine on the innermost ICE protecting this server"}
                                  {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})


Addapt the sse handler to the async behavior of futura publishers.

--- src/clojure/catacumba/impl/sse.clj
+++ src/clojure/catacumba/impl/sse.clj
@@ -46,14 +46,15 @@
   "Start the sse connection with the client
   and dispatch it in a special hanlder."
   [^DefaultContext context handler]
-  (let [out (async/chan 1 (map event))
-        pub (schannel/publisher out {:close true})
-        tfm (helpers/action transform-event)
-        sse' (ServerSentEvents/serverSentEvents pub tfm)
-        ctx (:catacumba/context context)]
+  (let [^Context ctx (:catacumba/context context)
+        out (async/chan 1 (map event))
+        pub (->> (schannel/publisher out {:close true})
+                 (.stream ctx))
+        tfm (helpers/action transform-event)]
     (async/thread
       (handler context out))
-    (.render ctx sse')))
+    (->> (ServerSentEvents/serverSentEvents pub tfm)
+         (.render ctx))))

 (defmethod handlers/adapter :catacumba/sse
   [handler]


Only enable the Reload button when necessary

--- src/clojure/nightcode/builders.clj
+++ src/clojure/nightcode/builders.clj
@@ -93,12 +93,12 @@
       (ui/config! view id :background (when-not is-set? (color/color :red))))))

 (defn toggle-enable!
-  [{:keys [view process]} path]
+  [{:keys [view process last-reload]} path]
   (let [is-java-project? (lein/is-java-project? path)
         is-running? (not (nil? @process))
         buttons {:#run-button (not is-running?)
                  :#run-repl-button (not is-running?)
-                 :#reload-button is-running?
+                 :#reload-button (not (nil? @last-reload))
                  :#build-button (not is-running?)
                  :#test-button (not is-running?)
                  :#clean-button (not is-running?)
@@ -118,17 +118,20 @@
         ; keep track of the processes and the last reload timestamp
         process (atom nil)
         auto-process (atom nil)
-        last-reload (atom 0)
+        last-reload (atom nil)
         ; create the main panel that will hold the console and buttons
         build-group (s/border-panel
                       :center (s/config! console :id :build-console))
         ; create the actions for each button
         run! (fn [_]
+               (when (lein/is-java-project? path)
+                 (reset! last-reload (System/currentTimeMillis)))
                (lein/run-project! process in out path))
         run-repl! (fn [_]
+                    (when (not (lein/is-java-project? path))
+                      (reset! last-reload (System/currentTimeMillis)))
                     (lein/run-repl-project! process in out path)
-                    (s/request-focus! (-> console .getViewport .getView))
-                    (reset! last-reload (System/currentTimeMillis)))
+                    (s/request-focus! (-> console .getViewport .getView)))
         reload! (fn [_]
                   (if (lein/is-java-project? path)
                     (lein/run-hot-swap! in out path)
@@ -197,7 +200,11 @@
                                        :listen [:action auto-build!]
                                        :focusable? false)])]
     ; refresh the builder when the process state changes
-    (add-watch process :refresh-builder (fn [_ _ _ _] (show-builder! path)))
+    (add-watch process
+               :refresh-builder
+               (fn [_ _ _ new-state]
+                 (when (nil? new-state) (reset! last-reload nil))
+                 (show-builder! path)))
     ; add the buttons to the main panel and create shortcuts
     (doto build-group
       (s/config! :north btn-group)
@@ -217,7 +224,8 @@
     {:view build-group
      :close-fn! #(stop! nil)
      :should-remove-fn #(not (utils/is-project-path? path))
-     :process process}))
+     :process process
+     :last-reload last-reload}))

 (defn show-builder!
   [path]


Employee not found logic lokking better. But needs to be triggered elsewhere

--- src/cljs/metime/components/employee.cljs
+++ src/cljs/metime/components/employee.cljs
@@ -29,14 +29,19 @@
     c))

 (defn fetch-employee [url-with-id]
+  (println "About to fetch emloyee")
   (let [c (chan)]
     (go (let [emp (first ((<! (http/get url-with-id)) :body))]
          (if-not (nil? emp)
-           ((println (str "Employee: " emp))
-            (>! c emp))
-            ((println "not found")
-             (>! c "not found"))))
-    c)))
+           (do
+             (println (str "Employee: " emp))
+             (>! c emp))
+
+            (do
+              (println "--->not found")
+              (>! c "not found")))))
+    c))
+

 (defn employee-name [firstname lastname]
   (let [disp-name (str firstname " " lastname)
@@ -140,23 +145,26 @@
                 "employee")

   (will-mount [_]
-              (println "Mounting employee component")
               (let [url-with-id (str (:url opts) (:id app))]
+                (println "will-mount")
                 (go
-                 (println "About to fetch")
                  (let [emp (<! (fetch-employee url-with-id))]
-                  (println "Fetched")
                   (if (= emp "not found")
-                     (om/transact! app #(dissoc % :employee))
-                     (om/transact! app #(assoc % :employee emp)))))))
+                     (do
+                       (println "NOT FOUND!!!")
+                       (om/transact! app #(dissoc % :employee)))
+
+                     (do
+                       (println "Found OK!")
+                       (om/transact! app #(assoc % :employee emp))))))))

   (render [_]
           (println "Rendering")
           (html
-                 ;;(if (contains? app :employee)
+                 (if (contains? app :employee)
                    [:h1 "Stuff about the employee goes here"
                      [:div (str "Email: " (:email (:employee app)))]]
-                   ;;[:h1 "Sorry, we couldn't find that employee."])
+                   [:h1 "Sorry, we couldn't find that employee."])
                  )))


Accessibility Improvements

Accessibility Improvements

--- src/cljs/salava/location/ui/explore.cljs
+++ src/cljs/salava/location/ui/explore.cljs
@@ -59,48 +59,29 @@
                  (js/L.marker. (clj->js {:icon icon :title title}))
                  (.on "click" (click-cb item unique-count)))))))})))

-#_(defn filter-autocomplete [kind state]
-    (let [filter (cursor state [kind])
-          class-name (str (name kind) "-filter")
-          placeholder (keyword "location" (str (name kind) "FilterField"))]
-      (fn []
-        [autocomplete/autocomplete
-         {:value (:value @filter)
-          :on-change (fn [item]
-                       (swap! filter assoc :value (:key item))
-                       (.trigger (js/jQuery (str "div.badges-filter ." class-name " input")) "change"))
-          :search-fields   [:value]
-          :items           (:autocomplete @filter)
-          :no-results-text " "
-          :placeholder     (t placeholder)
-          :control-class   (str "form-control " class-name)
-          :max-results     100}])))
-
 (defn filter-autocomplete [kind state]
   (let [filter (cursor state [kind])
         class-name (str (name kind) "-filter")
         placeholder (keyword "location" (str (name kind) "FilterField"))]
-    (create-class
-     {:reagent-render
-      (fn []
-        [autocomplete/autocomplete
-         {:value (:value @filter)
-          :on-change (fn [item]
-                       (swap! filter assoc :value (:key item))
-                       (.trigger (js/jQuery (str "div.badges-filter ." class-name " input")) "change"))
-          :search-fields   [:value]
-          :items           (:autocomplete @filter)
-          :no-results-text " "
-          :placeholder     (t placeholder)
-          :control-class   (str "form-control " class-name)
-          :max-results     100}])
-      :component-did-mount
-      (fn []
-        (do
-          (-> (sel1 ".autocomplete__input")
-              (dommy/set-attr! :aria-label (t placeholder)))
-          (-> (sel1 ".autocomplete__clear-button")
-              (dommy/set-attr! :aria-label (t :location/clearField)))))})))
+    (fn []
+      [autocomplete/autocomplete
+       {:value (:value @filter)
+        :on-change (fn [item]
+                     (swap! filter assoc :value (:key item))
+                     (.trigger (js/jQuery (str "div.badges-filter ." class-name " input")) "change"))
+        :search-fields   [:value]
+        :items           (:autocomplete @filter)
+        :no-results-text " "
+        :placeholder     (t placeholder)
+        :control-class   (str "form-control " class-name)
+        :max-results     100}])))
+
+(defn autocomplete-accessibility-fix []
+  (doseq [input (sel :.autocomplete__input)
+          bt (sel :.autocomplete__clear-button)]
+    (do
+      (dommy/set-attr! input :aria-label (dommy/attr input :placeholder))
+      (dommy/set-attr! bt :aria-label (t :location/clearField)))))

 (defn map-view [state]
   (create-class
@@ -200,6 +181,8 @@
                                    #(get-markers (.val (js/jQuery "input[name=map-type]:checked")) my-map layer-group (query-opt))
                                    1000)))]

+        (autocomplete-accessibility-fix)
+
         (.addTo layer-group my-map)

         (.on my-map "moveend" redraw-map!)


Revert :history changes made in wrong branch.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1,4 +1,3 @@
-
 (ns clojush.pushgp.genetic-operators
   (:use [clojush util random individual globals interpreter translate pushstate]
         clojush.instructions.tag
@@ -377,7 +376,7 @@
                                 (conj result-genome (nth (if use-s1 s1 s2) i))
                                 (dec iteration-budget)))))]
     (make-individual :genome new-genome
-                     :history [(:history parent1)(:history parent2)]
+                     :history (:history parent1)
                      :ancestors (if maintain-ancestors
                                   (cons (:genome parent1) (:ancestors parent1))
                                   (:ancestors parent1)))))
@@ -400,7 +399,7 @@
                                 (drop (second p1-points)
                                       genome1)))]
     (make-individual :genome new-genome
-                     :history [(:history parent1)(:history parent2)]
+                     :history (:history parent1)
                      :ancestors (if maintain-ancestors
                                   (cons (:genome parent1) (:ancestors parent1))
                                   (:ancestors parent1)))))
@@ -432,7 +431,7 @@
                                  short-genome-lengthened
                                  long-genome)))]
       (make-individual :genome new-genome
-                       :history [(:history parent1) (:history parent2)]
+                       :history (:history parent1)
                        :ancestors (if maintain-ancestors
                                     (cons (:genome parent1) (:ancestors parent1))
                                     (:ancestors parent1))))))
@@ -591,7 +590,7 @@
     (assoc (make-individual :genome (if (or variant (diversifying? new-genome argmap))
                                       new-genome
                                       [])
-                            :history [(:history parent1) (:history parent2)]
+                            :history (:history parent1)
                             :ancestors (if maintain-ancestors
                                          (cons (:genome parent1) (:ancestors parent1))
                                          (:ancestors parent1)))


Upgrade karma to 4.3.0

Upgrade karma to 4.3.0

--- src/deps.cljs
+++ src/deps.cljs
@@ -1,5 +1,5 @@
 {:npm-dev-deps {"shadow-cljs"           "2.8.52"
-                "karma"                 "4.2.0"
+                "karma"                 "4.3.0"
                 "karma-chrome-launcher" "3.1.0"
                 "karma-cljs-test"       "0.1.0"
                 "karma-junit-reporter"  "1.2.0"}}


turn down logging

turn down logging

--- src/babel/over.clj
+++ src/babel/over.clj
@@ -87,14 +87,14 @@

 (defn moreover-head [parent child lexfn-sem-impl morph]
   (do
-    (log/debug (str "moreover-head (candidate) parent: [" (get-in parent [:rule]) "] '" (morph parent) "' sem:    " (strip-refs (get-in parent '(:synsem :sem) :no-semantics))))
-    (log/debug (str "moreover-head (candidate) head child: [" (get-in parent [:child]) "] '" (morph child) "' sem:" (strip-refs (get-in child '(:synsem :sem) :top))))
+    (log/trace (str "moreover-head (candidate) parent: [" (get-in parent [:rule]) "] '" (morph parent) "' sem:    " (strip-refs (get-in parent '(:synsem :sem) :no-semantics))))
+    (log/trace (str "moreover-head (candidate) head child: [" (get-in parent [:child]) "] '" (morph child) "' sem:" (strip-refs (get-in child '(:synsem :sem) :top))))
     (let [result
           (unifyc parent
                   (unifyc {:head child}
                           {:head {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}}))]
       (if (not (fail? result))
-        (let [debug (log/debug (str "moreover-head: " (get-in parent '(:rule)) " succeeded: " (:rule result)
+        (let [debug (log/debug (str "moreover-head: " (get-in parent '(:rule)) " succeeded: " (get-in result [:rule])
                                     ":'" (morph result) "'"))
               debug (log/debug (str "moreover-head: child matched parent's desired head synsem:"
                                     (strip-refs (get-in parent [:head :synsem]))))
@@ -105,7 +105,7 @@

         ;; else: attempt to put head under parent failed: provide diagnostics through log/debug messages.
         (let [fail-path (get-fail-path (get-in parent [:head]) child)
-              debut (log/debug (str "moreover-head: failed to add head: '" (morph child) "' to parent: " (get-in parent [:rule])))
+              debut (log/trace (str "moreover-head: failed to add head: '" (morph child) "' to parent: " (get-in parent [:rule])))
               debug (log/trace (str "parent " (get-in parent [:rule])
                                     " wanted head with: "
                                     (strip-refs (get-in parent [:head :synsem]))))
@@ -115,11 +115,11 @@
                                      (unifyc child
                                              {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}})
                                      [:synsem]))))
-              debug (log/debug (str "fail-path: " (get-fail-path (get-in parent [:head])
+              debug (log/trace (str "fail-path: " (get-fail-path (get-in parent [:head])
                                                                  child)))
-              debug (log/debug (str "  parent@" fail-path "="
+              debug (log/trace (str "  parent@" fail-path "="
                                     (get-in parent (concat [:head] fail-path))))
-              debug (log/debug (str "    head@" fail-path "="
+              debug (log/trace (str "    head@" fail-path "="
                                     (get-in child fail-path)))]
           :fail)))))


Data visualisation root.

Data visualisation root.

--- from-repl.clj
+++ from-repl.clj
@@ -22,3 +22,4 @@
 (render-site "AgileDevelopment/01_basic_testing")
 (render-site "WebServices/01_running_Flask")
 (render-site "WebServices/02_AJAX")
+(render-site "WebServices/04_data_visualisation")


rearrange app state: common parent for search term & result

and create a parent component for search entry & results that mirrors it

and perform searches only when RET pressed, not on every input event

--- src-cljs/core.cljs
+++ src-cljs/core.cljs
@@ -23,12 +23,15 @@

 (def app-state
   (atom
-    {:results []
+    {:search {
+              :term {}
+              :results []
+              }
      :player-queue []
      }))

 (defn search-results []
-  (om/ref-cursor (:results (om/root-cursor app-state))))
+  (om/ref-cursor (:results (:search (om/root-cursor app-state)))))

 (defn player-queue []
   (om/ref-cursor (:player-queue (om/root-cursor app-state))))
@@ -80,7 +83,8 @@

 (defn xhr-search [term]
-  (let [channel (chan)]
+  (let [term (filter second term)
+        channel (chan)]
     (.send XhrIo "/tracks.json"
            (fn [e]
              (let [xhr (.-target e)
@@ -102,28 +106,17 @@
             (js/parseInt (get % "track")))
    tracks))

-(defn results-view [results owner]
-  (reify
-    om/IWillMount
-    (will-mount [_]
-      (let [channel (om/get-shared owner :search-channel)]
-        (go (loop []
-              (let [search-for (<! channel)
-                    tracks (<! (xhr-search search-for))
-                    sorted (sorted-tracks tracks)]
-                (om/update! results (vec sorted))
-                (recur))))))
-    om/IRender
-    (render [this]
-      (let [tracks (om/observe owner (search-results))
-            button (dom/button
+(defn results-view [tracks owner]
+  (reify
+    om/IRender
+    (render [this]
+      (let [button (dom/button
                     #js {:onClick
                          (fn [e] (doall (map #(enqueue-track %)
                                              tracks)))}
                     "+")
             track-components
-            (om/build-all results-track-view tracks
-                          )]
+            (om/build-all results-track-view tracks)]
         (if (mobile?)
           (apply dom/div #js {:className "results tracks" }
                  (dom/div #js {:className "track"}
@@ -173,12 +166,15 @@
                )))))

-(defn filters-view [app owner]
+(defn search-entry-view [term owner]
   (reify
     om/IRenderState
     (render-state [this state]
       (let [search-chan (om/get-shared owner :search-channel)
-            filters (:filters app)]
+            send-search (fn [e]
+                          (let [str (.. e -target -value)]
+                            (om/update! term [:_content] str)
+                            (put! search-chan {:_content str})))]
         (dom/div nil
                  (dom/h1
                   #js {:id "sledge"}
@@ -187,12 +183,16 @@
                                   :id "search-term"
                                   :type "text"
                                   :placeholder "Search artist/album/title"
-                                  :value (:search-term state)
+                                  :value (:string state)
                                   :onChange
                                   (fn [e]
-                                    (let [term (.. e -target -value)]
-                                      (om/set-state! owner :search-term term)
-                                      (put! search-chan {:_content term})))
+                                    (let [str (.. e -target -value)]
+                                      (om/set-state! owner :string str)
+                                      ))
+                                  :onKeyUp
+                                  (fn [e] (if (= 13 (.-which e))
+                                            (send-search e)))
+                                  :onBlur send-search
                                   }))
                  (apply dom/div #js {:className "filters" }
                         (map #(dom/span #js {:className "filter"
@@ -200,7 +200,7 @@
                                              (fn [e] (put! search-chan
                                                            {(first %) nil}))}
                                         (str (name (first %)) ": " (second  %)))
-                             (filter second filters))))))))
+                             (filter second term))))))))

 (defn best-media-url [r]
   (let [urls (get r "_links")]
@@ -228,15 +228,32 @@
                                  })
                  )))))

+(defn search-view [search owner]
+  (reify
+    om/IWillMount
+    (will-mount [_]
+      (let [channel (om/get-shared owner :search-channel)]
+        (go (loop []
+              (let [search-for (merge (:term @search) (<! channel))
+                    _ (om/update! search [:term] search-for)
+                    tracks (<! (xhr-search search-for))
+                    sorted (sorted-tracks tracks)]
+                (om/update! search [:results] (vec sorted))
+                (recur))))))
+    om/IRender
+    (render [this]
+      (dom/div nil
+               (om/build search-entry-view (:term search)
+                         {:init-state {:string ""}})
+               (dom/h2 nil "results")
+               (om/build results-view (:results search))))))
+
 (defn app-view [app owner]
   (reify
     om/IRender
     (render [this]
       (dom/div nil
-               (om/build filters-view app
-                         {:init-state {:search-term ""}})
-               (dom/h2 nil "results")
-               (om/build results-view (:results app))
+               (om/build search-view (:search app))
                (dom/h2 nil "queue")
                (om/build queue-view app)
                (om/build player-view app)


search-chan messagesa re now maps

search-chan messagesa re now maps

start work to combine search with filters by removing the update-filters
code and use the search channel for both

--- src-cljs/core.cljs
+++ src-cljs/core.cljs
@@ -26,7 +26,6 @@
     {:results []
      :player-queue []
      :filters {}
-     :search-term ""
      :device-type nil
      }))

@@ -90,7 +89,7 @@
                    r (js->clj o)]
                (put! channel r)))
            "POST"
-           term
+           (get term "_content")
            {"Content-Type" "text/plain"}
            )
     channel))
@@ -170,25 +169,12 @@
                     queue (range 0 999))
                )))))

-;; XXX need to do some url encoding here, I rather suspect
+
 (defn filters-view [app owner]
   (reify
-    om/IWillMount
-    (will-mount [_]
-      (let [channel (om/get-state owner :update-filters)]
-        (go (loop []
-              (let [new-filter (<! channel)]
-                (println [:new-filter new-filter])
-                (om/transact! app [:filters] #(merge % new-filter))
-                #_ (send-query
-                 (om/get-state owner :search-term)
-                 (:filters @app)
-                 (om/get-state owner :new-results))
-                (recur))))))
     om/IRenderState
     (render-state [this state]
-      (let [chan (:update-filters state)
-            search-chan (om/get-shared owner :search-channel)
+      (let [search-chan (om/get-shared owner :search-channel)
             filters (:filters app)]
         (dom/div nil
                  (dom/h1
@@ -203,12 +189,12 @@
                                   (fn [e]
                                     (let [term (.. e -target -value)]
                                       (om/set-state! owner :search-term term)
-                                      (put! search-chan term)))
+                                      (put! search-chan {"_content" term})))
                                   }))
                  (apply dom/div #js {:className "filters" }
                         (map #(dom/span #js {:className "filter"
                                              :onClick
-                                             (fn [e] (put! chan
+                                             (fn [e] (put! search-chan
                                                            {(first %) nil}))}
                                         (str (name (first %)) ": " (second  %)))
                              (filter second filters))))))))


clojure (pgraph-morphisms): use mutable Java array in Floyd-Warshall code

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -22,16 +22,20 @@

 (defn distances [net]
   "Pair-wise distances between vertices using the Floyd-Warshall algorithm"
-  (let [nodes (iterator-seq (.nodes net))
+  (let [nodes (vec (iterator-seq (.nodes net)))
         edges (iterator-seq (.edges net))
         n (count nodes)
-        dist (into {} (for [v nodes, w nodes] [[v w] (if (= v w) 0 n)]))
-        dist (into dist (for [e edges, e* [e (.reverse e)]]
-                          [[(.source e*) (.target e*)] 1]))]
-    (reduce (fn [d [u v w]]
-              (assoc d [v w] (min (d [v w]) (+ (d [v u]) (d [u w])))))
-            dist
-            (for [u nodes, v nodes, w nodes] [u v w]))))
+        idx (into {} (for [i (range n)] [(nth nodes i) i]))
+        dist (make-array Long/TYPE n n)]
+    (doseq [i (range n), j (range n)]
+      (aset dist i j (if (= i j) 0 n)))
+    (doseq [e edges, e* [e (.reverse e)]]
+      (aset dist (idx (.source e*)) (idx (.target e*)) 1))
+    (doseq [i (range n), j (range n), k (range n)]
+      (aset dist j k (min (aget dist j k) (+ (aget dist j i) (aget dist i k)))))
+    (into {}
+          (for [u nodes, v nodes]
+            [[u v] (aget dist (idx u) (idx v))]))))

 (defn diameter [net]
   (apply max (vals (distances net))))


minor cleanup of async loop

minor cleanup of async loop

--- src/bolt/core.cljs
+++ src/bolt/core.cljs
@@ -30,7 +30,7 @@
             (dom/input #js {:type "text" :id "search_term" :autoFocus "autofocus"})
             (dom/input #js {:type "submit" :value "Search"}))))

-(defn process-search
+(defn process-search*
   "For now this is just a local config lookup but this could interact
   with another service."
   [input]
@@ -39,10 +39,14 @@
      :url (get-in config/config [:commands (keyword cmd)])
      :args args}))

+(defn process-search
+  [event-data chan]
+  (put! chan [:ui.search (process-search* event-data)]))
+
 (defn handle-event [app event event-data {:keys [chan]}]
   (.log js/console "Event: " (pr-str event event-data))
   (case event
-    :service.search (put! chan [:ui.search (process-search event-data)])
+    :service.search (process-search event-data chan)
     :ui.search  (om/update! app assoc :search-result event-data)
     (.log js/console "No event found for" event event-data)))

@@ -99,7 +103,7 @@
 (defroute "/to/:command" [command]
   (om/root app-state bolt-app (.getElementById js/document "app"))
   ;; need cursor for error handling
-  (om/update! cursor assoc :search-result (process-search command)))
+  (om/update! cursor assoc :search-result (process-search* command)))

 (def history (History.))


Refactor value unboxing to protocols.

Refactor value unboxing to protocols.

--- mysql/src/finagle_clojure/mysql/value.clj
+++ mysql/src/finagle_clojure/mysql/value.clj
@@ -1,55 +1,52 @@
 (ns finagle-clojure.mysql.value
-  "A collection of helpers for polymorphically boxing and unboxing Finagle-MySQL values,
+  "A collection of private helpers for polymorphically boxing and unboxing Finagle-MySQL values,
   which is to say, subclasses of [[com.twitter.finagle.exp.mysql.Value]]."
   (:import (com.twitter.finagle.exp.mysql Value ByteValue ShortValue IntValue LongValue DoubleValue FloatValue
                                           StringValue Type RawValue BigDecimalValue NullValue EmptyValue
                                           NullValue$ EmptyValue$ DateValue$ TimestampValue)
-           (java.util TimeZone Date))
+           (java.util TimeZone))
   (:require [finagle-clojure.options :as opt]))

+(defprotocol BoxValue
+  (box [v]))
+
+(defprotocol UnboxValue
+  (unbox [v]))
+
 (defn- raw-type [^RawValue val] (.typ val))
-
-;; These might reasonably be named apply and unapply, but I'm cautious of clashing with Clojure core.
-(defmulti box class)
-(defmulti unbox class)
 (defmulti unbox-raw raw-type)

 (def utc-zone
   (TimeZone/getTimeZone "UTC"))

-;; Punting on arbitrary timezone conversions for now, as UTC<->UTC is almost always the right thing to do.
 (def utc-timestamp-value
   (TimestampValue. utc-zone utc-zone))

-(defmethod box Byte           [b] (ByteValue. b))
-(defmethod box Short          [s] (ShortValue. s))
-(defmethod box Integer        [i] (IntValue. i))
-(defmethod box Long           [l] (LongValue. l))
-(defmethod box Float          [f] (FloatValue. f))
-(defmethod box Double         [d] (DoubleValue. d))
-(defmethod box String         [s] (StringValue. s))
-(defmethod box nil            [_] NullValue$/MODULE$)
-(defmethod box BigDecimal     [d] (-> d (scala.math.BigDecimal.) (BigDecimalValue/apply)))
-(defmethod box java.util.Date [d] (-> d (.getTime) (java.sql.Date.) (box)))
-(defmethod box java.sql.Date  [d] (.apply DateValue$/MODULE$ d))
-(defmethod box java.sql.Timestamp [t] (.apply utc-timestamp-value t))
+(extend-protocol BoxValue
+  Byte               (box [b] (ByteValue. b))
+  Short              (box [s] (ShortValue. s))
+  Integer            (box [i] (IntValue. i))
+  Long               (box [l] (LongValue. l))
+  Float              (box [f] (FloatValue. f))
+  Double             (box [d] (DoubleValue. d))
+  String             (box [s] (StringValue. s))
+  nil                (box [_] NullValue$/MODULE$)
+  BigDecimal         (box [d] (-> d (scala.math.BigDecimal.) (BigDecimalValue/apply)))
+  java.util.Date     (box [d] (-> d (.getTime) (java.sql.Date.) (box)))
+  java.sql.Date      (box [d] (.apply DateValue$/MODULE$ d))
+  java.sql.Timestamp (box [t] (.apply utc-timestamp-value t)))

-(defmethod box :default [val]
-  (throw (RuntimeException. (str "Don't know how to box value: " val))))
-
-(defmethod unbox ByteValue   [^ByteValue b]   (-> b (.b)))
-(defmethod unbox ShortValue  [^ShortValue s]  (-> s (.s)))
-(defmethod unbox IntValue    [^IntValue i]    (-> i (.i)))
-(defmethod unbox LongValue   [^LongValue l]   (-> l (.l)))
-(defmethod unbox FloatValue  [^FloatValue f]  (-> f (.f)))
-(defmethod unbox DoubleValue [^DoubleValue d] (-> d (.d)))
-(defmethod unbox StringValue [^StringValue s] (-> s (.s)))
-(defmethod unbox NullValue$  [^NullValue _]   nil)
-(defmethod unbox EmptyValue$ [^EmptyValue _]  nil)
-(defmethod unbox RawValue    [^RawValue val]  (unbox-raw val))
-
-(defmethod unbox :default    [val]
-  (throw (RuntimeException. (str "Don't know how to unbox value: " val))))
+(extend-protocol UnboxValue
+  ByteValue   (unbox [^ByteValue b]   (-> b (.b)))
+  ShortValue  (unbox [^ShortValue s]  (-> s (.s)))
+  IntValue    (unbox [^IntValue i]    (-> i (.i)))
+  LongValue   (unbox [^LongValue l]   (-> l (.l)))
+  FloatValue  (unbox [^FloatValue f]  (-> f (.f)))
+  DoubleValue (unbox [^DoubleValue d] (-> d (.d)))
+  StringValue (unbox [^StringValue s] (-> s (.s)))
+  NullValue$  (unbox [^NullValue _]   nil)
+  EmptyValue$ (unbox [^EmptyValue _]  nil)
+  RawValue    (unbox [^RawValue val]  (unbox-raw val)))

 (defmethod unbox-raw (Type/NewDecimal) [^RawValue val]
   (when-let [^scala.math.BigDecimal bd (-> val (BigDecimalValue/unapply) (opt/get))]


org-sync/do-update

org-sync/do-update

--- org-mode/src/com/gfredericks/org_sync.clj
+++ org-mode/src/com/gfredericks/org_sync.clj
@@ -2,8 +2,12 @@
   "Generic syncing logic."
   (:refer-clojure :exclude [merge])
   (:require
+   [clojure.java.io :as io]
+   [clojure.tools.logging :as log]
    [com.gfredericks.org-editor :as org])
-  (:import (java.time ZonedDateTime ZoneId)))
+  (:import
+   (java.io File)
+   (java.time ZonedDateTime ZoneId)))

 ;; Add this to top:

@@ -27,7 +31,7 @@
   [time-zone category sections]
   {::org/prelude
    (filterv identity
-            ["-*- eval: (auto-revert-mode 1); eval: (real-auto-save-mode 1); real-auto-save-interval: 1 -*-"
+            ["-*- eval: (auto-revert-mode 1); eval: (real-auto-save-mode 1); real-auto-save-interval: 15 -*-"
              (when category (str "#+CATEGORY: " category))
              ""
              "This file is generated automatically; edits may not be preserved."
@@ -145,3 +149,27 @@
                   (wrap-in-archive-file-prelude time-zone category
                                                 (concat (::org/sections deleted)
                                                         new-deleted-entries)))})))
+
+(defmacro ^:private with-atomic-write
+  [[binding filename] & body]
+  `(let [filename# ~filename
+         tmp# (File. (str filename# ".tmp"))]
+     (with-open [~binding (io/writer tmp#)]
+       ~@body)
+     (or (.renameTo tmp# (File. filename#))
+         (throw (ex-info "Failed to rename file in atomic write!" {:filename filename#})))))
+
+(defn do-update
+  [live-file archive-file deleted-file new-entries merge-opts]
+  (let [read-file #(with-open [r (io/reader %)] (org/parse-file r))
+        write-file (fn [f content]
+                     (log/info "Writing to %s" f)
+                     (with-atomic-write [w f]
+                       (org/write-file w content)))
+        {:keys [live archive deleted]} (merge {:live    (read-file live-file)
+                                               :archive (read-file archive-file)
+                                               :deleted (read-file deleted-file)}
+                                              new-entries merge-opts)]
+    (when live (write-file live-file live))
+    (when archive (write-file archive-file archive))
+    (when deleted (write-file deleted-file deleted))))


delay loading expound until used (saves couple ms on startup)

--- src/main/shadow/cljs/devtools/errors.clj
+++ src/main/shadow/cljs/devtools/errors.clj
@@ -10,7 +10,6 @@
             [shadow.build.resolve :as resolve]
             [shadow.cljs.devtools.config :as config]
             [shadow.build.warnings :as w]
-            [expound.alpha :as expound]
             [shadow.jvm-log :as log]
             [shadow.cljs.util :as util]
             [clojure.java.io :as io])
@@ -114,9 +113,13 @@
         (.write w "\n")
         ))

-  (.write w (with-out-str
-              (expound/printer data)
-              #_(s/explain-out (select-keys data [::s/problems])))))
+  (locking comp/target-require-lock
+    (require 'expound.alpha)
+
+    (let [printer (resolve 'expound.alpha/printer)]
+      (.write w (with-out-str
+                  (printer data)
+                  #_(s/explain-out (select-keys data [::s/problems])))))))

 (defmethod ex-data-format ::ns-form/invalid-ns
   [w e {:keys [config] :as data}]


Remove invalid test.

Remove invalid test.

--- test/clj/qualityclj/routes/home_test.clj
+++ test/clj/qualityclj/routes/home_test.clj
@@ -2,6 +2,3 @@
   (:require [qualityclj.models.db :as db])
   (:use qualityclj.routes.home
         clojure.test))
-
-(deftest proper-git-url
-  (is (thrown? IllegalArgumentException (import-project "hello"))))


println

println

--- src/ci3/github.clj
+++ src/ci3/github.clj
@@ -37,6 +37,8 @@
                        :headers  { "Authorization" (str "token " gh-token) }})
                    :body
                    (json/parse-string))]
+    (println sha full_name target_url)
+    (println (str "https://api.github.com/repos/" full_name "/statuses/" sha))
     (println status)
     status))


Fix follow-ups link and complete follow-up board.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -48,7 +48,7 @@
 (defun url

   ([org-slug nil]
-  (str "/" org-slug  "/follow-ups"))
+  (str "/orgs/" org-slug  "/follow-ups"))

   ([org-slug board-slug]
   (str (board-url/url org-slug board-slug) "/entries"))
@@ -164,7 +164,7 @@
         follow-ups-list (if (= access-level :public)
                           []
                           (map #(if (= (-> % :assignee :user-id) user-id)
-                                  (assoc % :links [(complete-follow-up-link org-uuid board-uuid entry-uuid (:uuid %))])
+                                  (assoc % :links [(complete-follow-up-link org-slug board-slug entry-uuid (:uuid %))])
                                   %)
                            (:follow-ups entry)))
         links (if secure-access?


connect to default db during postgres setup

--- test/vip/data_processor/test_helpers.clj
+++ test/vip/data_processor/test_helpers.clj
@@ -71,8 +71,9 @@
     (log/info "Recreating the test database")
     (let [database-name (config [:postgres :database])
           jdbc-config {:dbtype "postgresql"
-                       :dbname ""  ; do not connect to a db for creating/dropping
-                       :host (config [:postgres :host])
+                       :dbname "postgres"  ; connect to the default db for
+                                           ; creating/dropping your test
+                                           ; database
                        :port (config [:postgres :port])
                        :user (config [:postgres :user])
                        :password (config [:postgres :password])}]


Make ugen checks either raise exceptions or print out errors depending on *checking*. Fixes #179.

--- src/overtone/sc/machinery/ugen/specs.clj
+++ src/overtone/sc/machinery/ugen/specs.clj
@@ -99,10 +99,6 @@
   metadata). Simply returns nil."
   [rate num-outs args ugen spec] nil)

-(defn- with-checking-disabling [f ugen]
-  (if *checking*
-    (f ugen)
-    ugen))

 (defn- with-debugging [f ugen]
   (when *debugging*
@@ -148,18 +144,21 @@
                      nil))
                  (fun rate num-outs args ugen spec))]

-    (if (string? result)
-      (throw (IllegalArgumentException. (str "Error in checker for ugen "
-                                             (overtone-ugen-name (:name spec))
-                                             ":\n"
-                                             result
-                                             "\n"
-                                             (ugen-arg-info spec ugen)
-                                             (when *debugging*
-                                               (str
-                                                "\n\nUgen:\n"
-                                                (with-out-str (pprint (simplify-ugen ugen))))))))
-      ugen)))
+    (when (string? result)
+      (let [error-message (str "Error in checker for ugen "
+                               (overtone-ugen-name (:name spec))
+                               ":\n"
+                               result
+                               "\n"
+                               (ugen-arg-info spec ugen)
+                               (when *debugging*
+                                 (str
+                                  "\n\nUgen:\n"
+                                  (with-out-str (pprint (simplify-ugen ugen))))))]
+        (if *checking*
+          (throw (IllegalArgumentException. error-message))
+          (println error-message))))
+    ugen))

 (defn- check-arg-rates [spec ugen]
   (let [cur-rate (REVERSE-RATES (:rate ugen))
@@ -421,12 +420,12 @@
                   floater
                   appender
                   auto-rater
-                  (with-checking-disabling nil-arg-checker)
-                  (with-checking-disabling bespoke-checker)
+                  nil-arg-checker
+                  bespoke-checker
                   associative->id
-                  (with-checking-disabling rate-checker)
-                  (with-checking-disabling sanity-checker)
-                  (with-checking-disabling arg-name-checker)
+                  rate-checker
+                  sanity-checker
+                  arg-name-checker
                   (with-debugging (partial print-args-post-processing spec)))))))

 (defn- with-fn-names


(maint) Fix log message db-name

(maint) Fix log message db-name

Before this used `name` which logged the clojure function instead of the
`db-name`

```
Ensuring clojure.core$name@5d616d65 database is up to date
```

Now it will log a more intelligible name like

```
Ensuring default database is up to date
```

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -606,7 +606,7 @@
   ;; A C-c (SIGINT) will close the pool via the shutdown hook, which
   ;; will then cause the pool connection to throw a (generic)
   ;; SQLException.
-  (log/info (trs "Ensuring {0} database is up to date" name))
+  (log/info (trs "Ensuring {0} database is up to date" db-name))
   (let  [migrator (:migrator-username db-config)]
     (with-open [db-pool (-> (assoc db-config
                                    :pool-name (if db-name


Add time delta.

Add time delta.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -56,6 +56,7 @@
         delta-cntr (delta-counter)
         stats-fn (fn []
                    (println
+                     "time-delta:" (delta-cntr :time (System/currentTimeMillis)) ";"
                      "in:" (long (/ (delta-cntr :in (.value in-cntr)) 1000)) "k;"
                      "out:" (long (/ (delta-cntr :out (.value out-cntr)) 1000)) "k;"))
         out-fn (fn [_ _]


comment edit

comment edit

--- src/strictly_specking/edn_string_nav.clj
+++ src/strictly_specking/edn_string_nav.clj
@@ -183,12 +183,13 @@
 #_(->> (file-to-initial-position "project.clj")
        (->root-loc))

+;; *** TODO add end line and end column
 (defn get-path-in-clj-file
   "Given the name of a file that holds a collection of EDN data or
    a project.clj file. This function will traverse the given path and
    return a map of the following info:

-     :line - the line number where the found item
+     :line   - the line number of the found item
      :column - the column number of the found item
      :value  - the value of the found item
      :path   - the path that was supplied as an argument


More robust implementation

More robust implementation

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -786,8 +786,8 @@
        :hp (power-as (typical-power :W) :hp)))))

 (def quantity-generate-measurement-map
-  {:angle                  (fn [& _] (typical-azimuth (rand-nth (range 360))))
-   :duration               (fn [& _] (make-measurement (rand-nth (range 60)) :min))
+  {:angle                  (fn [& _] (typical-azimuth (* 360 (rand))))
+   :duration               (fn [& _] (make-measurement (* 60 (rand)) :min))
    :density                typical-density
    :energy                 typical-total-pump-energy
    :force                  typical-force


Repair issues

Repair issues

Previous commits had at least two issues. First, if one specified the
`top-f` argument to `typical-stage-extent`, the code failed because it
assumed that the value returned by evaluation `top-f` was a measurement
magnitude, but it was now a sequence of a magnitude and a unit.

Second, repairing the first issue uncovered a broader issue. The helper
function `as-f` returned a function that failed if the `from` and `to`
units were identical.

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -74,10 +74,12 @@
 (def other last)

 (defn as-f [from-unit to-unit factor]
-  (fn [[magnitude from] to]
-    (condp = [from to]
-      [from-unit to-unit] [(* magnitude factor) to]
-      [to-unit from-unit] [(/ magnitude factor) to])))
+  (fn [[magnitude from :as from-measurement] to]
+    (if (= from to)
+      from-measurement
+      (condp = [from to]
+        [from-unit to-unit] [(* magnitude factor) to]
+        [to-unit from-unit] [(/ magnitude factor) to]))))

 (defn density-as [[from-magnitude from-unit substance] to-unit]
   (let [[target-magnitude _] ((as-f :lb-per-cu-ft :kg-per-m3 16.0185) [from-magnitude from-unit] to-unit)]
@@ -133,8 +135,14 @@
    (typical-stage-extent typical-stage-top))
   ([top-f]
    (let [top (top-f)
-         length (typical-stage-length)]
-     (vector top (+ top length)))))
+         raw-length (typical-stage-length)
+         length (length-as raw-length (unit top))]
+     (vector top (make-measurement (+ (magnitude top) (magnitude length)) (unit length))))))
+
+(defn typical-stage-bottom
+  ([] (second (typical-stage-extent)))
+  ([length-unit]
+   (second (typical-stage-extent (constantly (typical-stage-top length-unit))))))

 (defn rand-easting []
   (let [minimum-easting 167000


add some tests for merge-step-results

add some tests for merge-step-results

--- test/clj/lambdacd/steps/support_test.clj
+++ test/clj/lambdacd/steps/support_test.clj
@@ -141,4 +141,20 @@
   (testing "that nothing bad happens if steps don't have global values"
     (is (= {} (merge-globals [{:x :y } {} {:z 1 :global {}} ])))
     (is (= {} (merge-globals [ ])))
-    (is (= {} (merge-globals [{:x :y } {} {:z 1} ])))))+    (is (= {} (merge-globals [{:x :y } {} {:z 1} ])))))
+
+(deftest merge-step-results-test
+  (testing "that step-results are merged"
+    (is (= {:foo :bar :bar :baz} (merge-step-results [{:foo :bar} {:bar :baz}]))))
+  (testing "that nothing bad happens from empty results"
+    (is (= { :bar :baz} (merge-step-results [{} {:bar :baz}])))
+    (is (= { } (merge-step-results [])))
+    (is (= { } (merge-step-results [{} {}]))))
+  (testing "that later step-results overwrite earlier ones"
+    (is (= {:foo :baz} (merge-step-results [{:foo :bar} {:foo :baz}]))))
+  (testing "that there is a special status handling"
+    (is (= {:status :success} (merge-step-results [{:status :success} {:status :success}])))
+    (is (= {:status :failure} (merge-step-results [{:status :success} {:status :failure}])))
+    (is (= {:status :unknown} (merge-step-results [{:status :unknown} {:status :success}]))) ; non-success trumps order
+    (is (= {:status :unknown} (merge-step-results [{:status :failure} {:status :unknown}]))) ; non-success overwrites in order
+    (is (= {:status :failure} (merge-step-results [{:status :failure} {:status :success}]))))) ; non-success trumps order


WIP add api transactions update test

WIP add api transactions update test

--- test/clj_money/api/transactions_test.clj
+++ test/clj_money/api/transactions_test.clj
@@ -89,13 +89,13 @@
                                           :memo "salary item"}]}]
                    (= actual expected)))})

-;(deftest-update update-a-transaction
-;  {:resource-name "transaction"
-;   :find-updated-resource-fn #(transactions/find-by-id storage-spec %)
-;   :update-fn api/update
-;   :comparison-fn #(= (:name %) "Bag o' Money")
-;   :update-params {:name "Bag o' Money"
-;                   :type "asset"}})
+(deftest-update update-a-transaction
+  {:resource-name "transaction"
+   :find-updated-resource-fn #(transactions/find-by-id storage-spec (:id %) (:transaction-date %))
+   :update-fn api/update
+   :comparison-fn #(= (:name %) "Bag o' Money")
+   :update-params {:name "Bag o' Money"
+                   :type "asset"}})

 (deftest-delete delete-a-transaction
   {:resource-name "transaction"


Add field to view/edit root entity type

Add field to view/edit root entity type

Also removed `:cursor "pointer"` from the validation check/x marks since it makes them look clickable

Prerequisites had already been removed from the UI

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_configs/method_config_editor.cljs
@@ -26,11 +26,12 @@

 (defn- commit [state refs config props]
   (let [workspace-id (:workspace-id props)
-        name (get-text refs "confname")
+        [name rootEntityType] (get-text refs "confname" "rootentitytype")
         inputs (into {} (map (juxt identity #(get-text refs (str "in_" %))) (keys (config "inputs"))))
         outputs (into {} (map (juxt identity #(get-text refs (str "out_" %))) (keys (config "outputs"))))
         new-conf (assoc config
                    "name" name
+                   "rootEntityType" rootEntityType
                    "inputs" inputs
                    "outputs" outputs
                    "workspaceName" workspace-id)]
@@ -179,10 +180,10 @@
 (defn- validation-status [invalid?]
   (if invalid?
     (icons/font-icon {:style {:paddingLeft "0.5em" :padding "1em 0.7em"
-                              :color (:exception-red style/colors) :cursor "pointer"}}
+                              :color (:exception-red style/colors)}}
       :x)
     (icons/font-icon {:style {:paddingLeft "0.5em" :padding "1em 0.7em"
-                              :color (:success-green style/colors) :cursor "pointer"}}
+                              :color (:success-green style/colors)}}
       :status-done)))

 (defn- input-output-list [config value-type invalid-values editing?]
@@ -218,10 +219,16 @@
     [:div {:style {:marginLeft 330}}
      (create-section-header "Method Configuration Name")
      (create-section
-       [:div {:style {:display (when editing? "none") :padding "0.5em 0 1em 0"}}
-        (config "name")]
-       [:div {:style {:display (when-not editing? "none")}}
-        (style/create-text-field {:ref "confname" :defaultValue (config "name")})])
+       (if editing?
+         (style/create-text-field {:ref "confname" :style {:width 500}
+                                   :defaultValue (config "name")})
+         [:div {:style {:padding "0.5em 0 1em 0"}} (config "name")]))
+     (create-section-header "Root Entity Type")
+     (create-section
+       (if editing?
+         (style/create-text-field {:ref "rootentitytype" :style {:width 500}
+                                   :defaultValue (config "rootEntityType")})
+         [:div {:style {:padding "0.5em 0 1em 0"}} (config "rootEntityType")]))
      (create-section-header "Inputs")
      (input-output-list config "inputs" invalid-inputs editing?)
      (create-section-header "Outputs")


registration order

registration order

--- test/zensols/actioncli/resource_test.clj
+++ test/zensols/actioncli/resource_test.clj
@@ -3,6 +3,10 @@
   (:require [clojure.java.io :as io]
             [clojure.string :as s])
   (:require [zensols.actioncli.resource :refer :all]))
+
+(register-resource :data :system-file "data" :system-default "../data")
+(register-resource :runtime-gen :pre-path :data :system-file "db")
+(register-resource :root-pkg :constant "clojure" :type :resource)

 (deftest test-register
   (testing "register"


send sentry msg in the response

send sentry msg in the response

--- src/open_company/api/companies.clj
+++ src/open_company/api/companies.clj
@@ -84,17 +84,16 @@
   :allowed-methods [:get]

   ;; Get a list of companies
-  :exists? (fn [_]
-              (when c/dsn
-                (raven/capture c/dsn {
-                  :message "Test Exception Message"
-                  :tags {:version "0.0.1"}
-                  :logger "main-logger"
-                  :extra {
-                    :my-key 1
-                    :some-other-value "foo bar"}}))
-              {:sentry c/dsn})
-  :handle-ok (fn [ctx] (json/generate-string {:collection (array-map :sentry (:sentry ctx))} {:pretty true})))
+  :exists? (fn [_] {:sentry c/dsn})
+  :handle-ok (fn [ctx]
+                (let [sentry-resp (raven/capture (:sentry ctx) {
+                                :message "Bago test test"
+                                :tags {:version "0.0.1"}
+                                :logger "main-logger"
+                                :extra {
+                                  :my-key 1
+                                  :some-other-value "foo bar"}})]
+                  (json/generate-string {:collection (array-map :sentry (:sentry ctx) :resp sentry-resp)} {:pretty true}))))

 ;; ----- Routes -----


web/scrape.clj: add output for ignored files

To prevent timeout.

--- src/org/altlaw/jobs/web/scrape.clj
+++ src/org/altlaw/jobs/web/scrape.clj
@@ -40,8 +40,7 @@
       (map handle-scraper-result
            (handler/run-scrapers download))
       (do (log/debug "Ignoring MIME type " type)
-          (h/report-progress)
-          nil))))
+          [[:ignored (:request_uri download)]]))))

 (def mapper-map (partial h/standard-map my-map))


Indentation

Indentation

--- src/ombs/route.clj
+++ src/ombs/route.clj
@@ -10,12 +10,13 @@
             ))

 (defroutes main-routes
-           (GET "/" [_] handler/index)
-           (GET "/user" [_] handler/user)
-           (POST "/login" request handler/login)
-           (POST "/register" {params :params} (handler/register params))
-           (GET  "/register" [_] handler/regpage)
-           (not-found "Page not found") )
+  (GET  "/" [params] handler/index)
+  (GET  "/user" [_] handler/user)
+  (POST "/login" request handler/login)
+  (POST "/logout" request handler/logout)
+  (POST "/register" {params :params} (handler/register params))
+  (GET  "/register" [_] handler/regpage)
+  (not-found "Page not found") )

 (def engine
   (-> main-routes


adding basic error checking and ability to pass in and api key

--- src/rodeo/core.clj
+++ src/rodeo/core.clj
@@ -2,39 +2,68 @@
   (:require [cheshire.core :as che]
             [clj-http.client :as http]))

-(def ^:const api-key (get (System/getenv) "GEOCODIO_API_KEY"))
-(def ^:const geocode-url (str "http://api.geocod.io/v1/geocode?api_key=" api-key))
-(def ^:const parse-url (str "http://api.geocod.io/v1/parse?api_key=" api-key))
+(def ^:const api-key-name "GEOCODIO_API_KEY")
+(def ^:const geocode-base-url "http://api.geocod.io/v1/geocode?api_key=")
+(def ^:const parse-base-url "http://api.geocod.io/v1/parse?api_key=")
+(def ^:const env-exception-text (str "The " api-key-name " environment variable was not set.
+                                     Set the variable or pass in the api key to this function."))
+
+(defn- get-env-variable []
+  (get (System/getenv) api-key-name))

 (defn- geocodio-get [url address]
-  (let [get-url (str parse-url "&q=" address)]
+  (let [get-url (str url "&q=" address)]
     (-> get-url
         (http/get)
         (:body)
-        (che/parse-string true))))
+        (che/parse-string true))))
+
+(defn- geocodio-post [url body]
+  (che/parse-string
+    (->> {:body body :content-type :json :accept :json}
+         (http/post url)
+         (:body)) true))

 (defn batch
-  "Takes a vector of addresses and
+  "Takes a seq of addresses and
+  and optional api key and
   makes a request to Geocodio.
   Returns a Clojure map of results."
-  [addresses]
-  (let [addr-json (che/generate-string addresses)]
-    (che/parse-string
-      (->> {:body addr-json :content-type :json :accept :json}
-           (http/post geocode-url)
-           (:body)) true)))
+  ([addresses]
+    (if-let [env-api-key (get-env-variable)]
+      (let [addr-json (che/generate-string addresses)
+            url (str geocode-base-url env-api-key)]
+        (geocodio-post url addr-json))
+      (throw (Exception. env-exception-text))))
+
+  ([addresses api-key]
+    (let [addr-json (che/generate-string addresses)
+          url (str geocode-base-url api-key)]
+      (geocodio-post url addr-json))))

 (defn single
-  "Takes a single address string and
+  "Takes a single address string and an optional api key and
   makes a request to Geocodio. Returns
   a Clojure map of results"
-  [address]
-  (geocodio-get geocode-url address))
+  ([address]
+    (if-let [env-api-key (get-env-variable)]
+      (geocodio-get (str geocode-base-url env-api-key) address)
+      (throw (Exception. env-exception-text))))
+
+  ([address api-key]
+    (let [url (str geocode-base-url api-key)]
+      (geocodio-get url address))))

 (defn components
-  "Takes a single address string and
-  returns a clojure map of the components
-  of that address (street, city, etc as a
+  "Takes a single address string and an optional
+  api key and returns a clojure map of the components
+  of that address (street, city, etc as a
   Clojure map"
-  [address]
-  (geocodio-get parse-url address))
+  ([address]
+    (if-let [env-api-key (get-env-variable)]
+      (geocodio-get (str parse-base-url env-api-key) address)
+      (throw (Exception. env-exception-text))))
+
+  ([address api-key]
+   (let [url (str parse-base-url api-key)]
+     (geocodio-get url address))))


State side-effect of config when loading

Change-Id: Ia73786113a1ad6f79fc31f6e558309dd8e304bc1

--- src/config.clj
+++ src/config.clj
@@ -52,7 +52,7 @@

 ;;; Interface

-(defn load []
+(defn load! []
   (reset! config (config-and-env)))

 (defn get [& keys]


Error calls were missing arguments.

Error calls were missing arguments.

--- src/such/casts.clj
+++ src/such/casts.clj
@@ -21,7 +21,7 @@
     (case (count substrings)
       1 (vector nil (symbol (first substrings)))
       2 (into [] (map symbol substrings))
-      (!/not-namespace-and-name))))
+      (!/not-namespace-and-name s))))

 (defn- named-namespace [named]
   (if (string? named)
@@ -133,7 +133,7 @@
                    (case (count substrings)
                      1 (vector nil (symbol (first substrings)))
                      2 (into [] (map symbol substrings))
-                     (!/not-namespace-and-name)))]
+                     (!/not-namespace-and-name substrings)))]
     (cond (string? val)
           (pairify (str/split val #"/"))

@@ -144,7 +144,7 @@
           (vector (ns-name (.ns val)) (.sym val))

           :else
-          (!/not-namespace-and-name))))
+          (!/not-namespace-and-name val))))

 (defn as-symbol-without-namespace
   "The argument *must* be a symbol, string, keyword, or var. In all cases, the