Fix reverse proxy BE path routes #413

Fix reverse proxy BE path routes
#413

--- src/cljc/swarmpit/routes.cljc
+++ src/cljc/swarmpit/routes.cljc
@@ -2,6 +2,7 @@
   (:require [reitit.core :as r]
             [reitit.coercion.spec :as rss]
             [swarmpit.routes-spec :as spec]
+            [clojure.string :as str]
             #?(:cljs [reitit.frontend :as rf])
             #?(:clj [reitit.swagger :as swagger])
             #?(:clj [swarmpit.version :as version])
@@ -955,6 +956,7 @@
   ([handler params]
    (path-for-backend handler params nil))
   ([handler params query]
-   (-> backend-router
-       (r/match-by-name handler params)
-       (r/match->path query))))
+   (str/replace
+     (-> backend-router
+         (r/match-by-name handler params)
+         (r/match->path query)) #"^/" "")))


Remove some todo's

Remove some todo's

--- src/clojure/picard/client.clj
+++ src/clojure/picard/client.clj
@@ -20,8 +20,6 @@

 ;; TODOS:
 ;; * Requests made with no content-length or transfer-encoding
-;; * First write fails (presumably w/ a kept alive connection
-;; * Unable to obtain a connection?
 ;; * Expiring the connection pool
 ;; * Handling a maximum number of open connections in the pool


+(demo)

+(demo)

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -67,3 +67,15 @@
   ([input model]
    (parse/parse (preprocess input) model)))

+(defn demo [ & [n spec]]
+  "print out _n_ generated sentences to stdout."
+  (let [n (if n (Integer. n)
+              100)
+        spec (if spec (read-string spec)
+                 :top)]
+    (count (filter #(not (nil? %))
+                   (take n (repeatedly
+                            #(println
+                              (let [result
+                                    (generate spec)]
+                                (fo result)))))))))


Made pushgp not keep :parent of individuals, since this was essentially keeping the entire ancestry of an individual and potentially eating up memory.

--- src/clojush/pushgp/pushgp.clj
+++ src/clojush/pushgp/pushgp.clj
@@ -161,6 +161,16 @@
       (when-not use-single-thread (apply await pop-agents)) ;; SYNCHRONIZE
       (println "Done performing parent reversion."))))

+(defn remove-parents
+  "Removes value from :parent for each individual in the population. This will
+   save memory."
+  [pop-agents {:keys [use-single-thread]}]
+  (dorun (map #((if use-single-thread swap! send)
+                    %
+                    (fn [i] (assoc i :parent nil)))
+              pop-agents))
+  (when-not use-single-thread (apply await pop-agents))) ;; SYNCHRONIZE
+
 ;; this is a wrapper for calculate-hah-solution-rates, which should itself be changed
 (defn calculate-hah-solution-rates-wrapper
   [pop-agents {:keys [use-historically-assessed-hardness error-threshold population-size]}]
@@ -233,6 +243,8 @@
           (timer :fitness)
           ;; possible parent reversion
           (parental-reversion pop-agents generation @push-argmap)
+          ;; remove parents since they aren't used any more
+          (remove-parents pop-agents @push-argmap)
           ;; calculate solution rates if necessary for historically-assessed hardness
           ;; change calculate-hah-solution-rates in the future, to destructure the argmap
           (calculate-hah-solution-rates-wrapper pop-agents @push-argmap)


adding some http trigger tests (#242)

adding some http trigger tests (#242)

--- server/test/spacon/trigger_test.clj
+++ server/test/spacon/trigger_test.clj
@@ -8,24 +8,57 @@
             [camel-snake-kebab.core :refer :all]
             [camel-snake-kebab.extras :refer [transform-keys]]))

+(use-fixtures :once utils/setup-fixtures)
+
 (deftest all-trigger-test
   (is (true? (utils/spec-passed? `trigger/all))))

-(use-fixtures :once utils/setup-fixtures)
+(defn generate-test-trigger []
+  (->> (gen/generate (spec/gen :spacon.specs.trigger/trigger-spec))
+       (transform-keys ->snake_case_keyword)))

-(deftest trigger-get-test []
-  (let [res (utils/request-get "/api/triggers")]
-    (is (some? (:result res)))))
+(deftest trigger-http-crud-test
+  (let [test-trigger(generate-test-trigger)]

-(deftest trigger-crud-test []
-  (let [trigger (gen/generate (spec/gen :spacon.specs.trigger/trigger-spec))
-        d (transform-keys ->snake_case_keyword trigger)
-        new-trigger (utils/request-post "/api/triggers" d)
-        create-res (transform-keys ->kebab-case-keyword (:result new-trigger))
-        read-trigger (utils/request-get (str "/api/triggers/" (:id create-res)))
-        read-res (transform-keys ->kebab-case-keyword (:result read-trigger))
-        delete-trigger (utils/request-delete (str "/api/triggers/" (:id create-res)))
-        delete-res (transform-keys ->kebab-case-keyword (:result delete-trigger))]
-    (is (spec/valid? :spacon.specs.trigger/trigger-spec create-res))
-    (is (spec/valid? :spacon.specs.trigger/trigger-spec read-res))
-    (is (= "success" delete-res))))+    (testing "Creating a trigger through REST api produces a valid HTML response"
+      (let [res (utils/request-post "/api/triggers" test-trigger)
+            new-trigger (transform-keys ->kebab-case-keyword (:result res))]
+        (is (contains? res :result)
+            "Response should have result keyword")
+        (is (spec/valid? :spacon.specs.trigger/trigger-spec new-trigger)
+            "The response should contain a trigger that conforms to the trigger spec")))
+
+    (testing "Retrieving all triggers through REST api produces a valid HTML response"
+      (let [res (-> (utils/request-get "/api/triggers"))
+            trigger (->> res :result first (transform-keys ->kebab-case-keyword))]
+        (is (contains? res :result)
+            "Response should have result keyword")
+        (is (spec/valid? :spacon.specs.trigger/trigger-spec trigger)
+            "The response should contain a trigger that conforms to the trigger spec")))
+
+    (testing "Retrieving trigger by its key through REST api produces a valid HTML response"
+      (let [t (-> (utils/request-get "/api/triggers") :result first)
+            res (-> (utils/request-get (str "/api/triggers/" (:id t))))
+            trigger (transform-keys ->kebab-case-keyword (:result res))]
+        (is (contains? res :result)
+            "Response should have result keyword")
+        (is (spec/valid? :spacon.specs.trigger/trigger-spec trigger)
+            "The response should contain a trigger that conforms to the trigger spec")))
+
+    (testing "Updating a trigger through REST api produces a valid HTML response"
+      (let [trigger (-> (utils/request-get "/api/triggers") :result first)
+            renamed-trigger (->> (assoc trigger :name "foo") (transform-keys ->snake_case_keyword))
+            res (utils/request-put (str "/api/triggers/" (:id trigger)) renamed-trigger)
+            updated-trigger (transform-keys ->kebab-case-keyword (:result res))]
+        (is (contains? res :result)
+            "Response should have result keyword")
+        (is (spec/valid? :spacon.specs.trigger/trigger-spec updated-trigger)
+            "The response should contain a trigger that conforms to the trigger spec")
+        (is (= "foo" (:name updated-trigger))
+            "The response should contain the updated trigger name")))
+
+    (testing "Deleting triggers through REST api produces a valid HTML response"
+      (let [trigger (-> (utils/request-get "/api/triggers") :result first)
+            res (utils/request-delete (str "/api/triggers/" (:id trigger)))]
+        (is (= "success" (:result res))
+            "The response should contain a success message")))))


CRM-258: Added limit of 2000 for page_size.

--- src/cmr/search/api/routes.clj
+++ src/cmr/search/api/routes.clj
@@ -23,7 +23,8 @@
   [context concept-type params headers]
   (let [result-format (get-search-results-format headers)
         pretty? (= (get params :pretty) "true")
-        page-size (or (:page_size params) 10)
+        page-size (Integer/parseInt (or (:page_size params) "10"))
+        page-size (if (> page-size 2000) 2000 page-size)
         _ (info (format "Search for %ss in format [%s] with params [%s]" (name concept-type) result-format params))
         params (dissoc params :pretty :page_size)
         results (query-svc/find-concepts-by-parameters context concept-type params page-size)]
@@ -48,6 +49,3 @@
       handler/site
       ring-json/wrap-json-body
       ring-json/wrap-json-response))
-
-
-


Noir 3 can now be succesfully scanned

Noir 3 can now be succesfully scanned

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -62,11 +62,10 @@
          nil)))

 (defn- has-spoiler? [part]
-  (let [stuff 0]
-   (and (map? (:attrs part))
-        (if-some [id (-> (:attrs part) (:id))]
-          (.contains id "spoiler")
-          nil))))
+  (and (map? (:attrs part))
+       (if-some [id (-> (:attrs part) (:id))]
+         (.contains id "spoiler")
+         nil)))

 (defn death-to-quotes [loc]
   (if (zip/end? loc)
@@ -76,13 +75,15 @@
       (recur (zip/next loc)))))

-;; (defn- remove-quotes [message]
-;;   (remove
-;;    #(and (map? %) (or (has-quote? %) (has-spoiler? %))) message))
+(defn- remove-top-level-quotes [message]
+  (remove
+   #(and (map? %) (or (has-quote? %) (has-spoiler? %))) message))

 (defn- remove-quotes [message]
-  (let [zipped (zip/seq-zip message)]
-    (zip/root (death-to-quotes zipped))))
+  (map #(-> (zip/xml-zip %)
+            (death-to-quotes)
+            (zip/root))
+       (remove-top-level-quotes message)))

 (defn- pair-users-messages [users messages]
   (map (fn [user message] {:user user :message (remove-quotes message)})


Added docstring to compile-matcher

Added docstring to compile-matcher

--- src/compojure/http/routes.clj
+++ src/compojure/http/routes.clj
@@ -78,7 +78,10 @@
 ;; Don't compile paths more than once.
 (decorate-with memoize compile-uri-matcher)

-(defmulti compile-matcher class)
+(defmulti compile-matcher
+  "Compile a string or regex into a form suitable for buing passed to the
+  match-uri function."
+  class)

 (defmethod compile-matcher String
   [path]


Integrate simple pmap and reducers-map processors into main.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -21,6 +21,7 @@
       [experiment-helper :refer :all]
       [local-data-processing-pipeline :refer :all]
       [local-dpp-self-adaptivity :refer :all]
+      [parallel-processing :refer :all]
       [processing-fn-utils :as utils]))
   (:import
     (dsbdp Counter ExperimentHelper ProcessingLoop)
@@ -172,7 +173,7 @@
     proc-fns))

 (defn prepare-in-fn
-  [options scenario in-data in-cntr out-cntr in-chan pipeline queue-size]
+  [options scenario in-data ^Counter in-cntr ^Counter out-cntr in-chan pipeline queue-size]
   (let [batch-delay (:batch-delay options)
         batch-size (:batch-size options)
         create-batched-in-fn (fn [in-fn]
@@ -209,6 +210,18 @@
                                   reducers/append!
                                   (reducers/map direct-proc-fn in-vec))]
                         (.inc out-cntr))))
+                (.endsWith scenario "-simple-pmap")
+                  (let [out-fn (fn [_] (.inc out-cntr))
+                        pmap-proc (create-simple-pmap-processor direct-proc-fn collection-size out-fn)]
+                    (fn [data]
+                      (pmap-proc data)
+                      (.inc in-cntr)))
+                (.endsWith scenario "-simple-reducers-map")
+                  (let [out-fn (fn [_] (.inc out-cntr))
+                        red-proc (create-simple-reducers-map-processor direct-proc-fn collection-size out-fn)]
+                    (fn [data]
+                      (red-proc data)
+                      (.inc in-cntr)))
                 (.endsWith scenario "-async-pipeline")
                   (if
                     (and


Removed typos which oddly didn't affect anything.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -80,7 +80,7 @@
 (defn on-event-focus [snapshot-ts event-ts]
   (when-let [ss (get-in @run-history [:snapshots snapshot-ts])]
     (reset! run-world-hover ss)
-    (.add gdom/classes (gdom/getElement "world-container") "hover")))git g
+    (.add gdom/classes (gdom/getElement "world-container") "hover")))

 (defn on-event-blur [snapshot-ts event-ts]
   (reset! run-world-hover nil)


Only one return msg from item-get/set/del.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -22,41 +22,54 @@
     [coll-state (assoc m :status :ok :value coll-state)]

     "item-get"
-    (do (act item-get actx
-             (aput item-get (:kvs-mgr-ch coll-state)
-                   (assoc m :op :multi-get
-                          :kvs-ident (:kvs-ident coll-state)
-                          :key-reqs [{:res-ch (:res-ch m)
-                                      :key (:key m)
-                                      :sq (parse-sq (:sq m))}])))
+    (let [res-ch (achan actx)]
+      (act item-get actx
+           (aput item-get (:kvs-mgr-ch coll-state)
+                 (assoc (dissoc m :res-ch)
+                   :op :multi-get
+                   :kvs-ident (:kvs-ident coll-state)
+                   :key-reqs [{:res-ch res-ch
+                               :key (:key m)
+                               :sq (parse-sq (:sq m))}]))
+           (aput item-get (:res-ch m)
+                 (dissoc (atake item-get res-ch) :more))
+           (while (atake item-get res-ch)))
+      [coll-state nil])
+
+    "item-set"
+    (let [res-ch (achan actx)]
+      (act item-set actx
+           (aput item-set (:kvs-mgr-ch coll-state)
+                 (assoc (dissoc m :res-ch)
+                   :op :multi-change
+                   :kvs-ident (:kvs-ident coll-state)
+                   :change-reqs [{:res-ch res-ch
+                                  :change-fn
+                                  (cbfg.kvs/mutate-entry
+                                   {:key (:key m)
+                                    :val (:val m)
+                                    :sq (parse-sq (:sq m))})}]))
+           (aput item-set (:res-ch m)
+                 (dissoc (atake item-set res-ch) :more))
+           (while (atake item-set res-ch)))
         [coll-state nil])

-    "item-set"
-    (do (act item-set actx
-             (aput item-set (:kvs-mgr-ch coll-state)
-                   (assoc m :op :multi-change
-                          :kvs-ident (:kvs-ident coll-state)
-                          :change-reqs
-                          [{:res-ch (:res-ch m)
-                            :change-fn
-                            (cbfg.kvs/mutate-entry
-                             {:key (:key m)
-                              :val (:val m)
-                              :sq (parse-sq (:sq m))})}])))
-        [coll-state nil])
-
     "item-del"
-    (do (act item-del actx
-             (aput item-del (:kvs-mgr-ch coll-state)
-                   (assoc m :op :multi-change
-                          :kvs-ident (:kvs-ident coll-state)
-                          :change-reqs
-                          [{:res-ch (:res-ch m)
-                            :change-fn
-                            (cbfg.kvs/mutate-entry
-                             {:deleted true
-                              :key (:key m)
-                              :sq (parse-sq (:sq m))})}])))
+    (let [res-ch (achan actx)]
+      (act item-del actx
+           (aput item-del (:kvs-mgr-ch coll-state)
+                 (assoc (dissoc m :res-ch)
+                   :op :multi-change
+                   :kvs-ident (:kvs-ident coll-state)
+                   :change-reqs [{:res-ch res-ch
+                                  :change-fn
+                                  (cbfg.kvs/mutate-entry
+                                   {:deleted true
+                                    :key (:key m)
+                                    :sq (parse-sq (:sq m))})}]))
+           (aput item-del (:res-ch m)
+                 (dissoc (atake item-del res-ch) :more))
+           (while (atake item-del res-ch)))
         [coll-state nil])

     [coll-state (assoc m :status :invalid :status-info :invalid-op)]))


CMR-8775-01: Control access to Generic API ingest interfaces with a n… (#1784)

* CMR-8775-01: Control access to Generic API ingest interfaces with a new CMR defconfig

* Simplify the defconfig env variable to a simple string and parse it so that there can be no ambiguity in how it is set on parameter store vs en variable

* CMR-8775-01: Adding trim for more defensive programming

* Configuration can include spaces for more protection

* CMR-8775: Removing unnecessary call for setting the parser to be a vector

* CMR-8775-01: fn[item] can be shortened with comp

* replace fn[item] with shorthand comp

--- common-lib/src/cmr/common/config.clj
+++ common-lib/src/cmr/common/config.clj
@@ -237,10 +237,10 @@
 (defconfig generic-ingest-disabled-list
   "This is a toggle to prevent specified generic concepts from being ingested into CMR,
    Should be an array of keys with the name of the schema to be blocked from ingest.
-   Example [\"grid\",\"order-option\"], would prevent grids and order options from being ingested into CMR
+   Example  \"grid,order-option\", would prevent grids and order options from being ingested into CMR
    if no concepts should be blocked from ingest set to an empty array"
   {:default []
-   :parser #(vec (map (fn [item] (keyword item)) (json/parse-string %)))})
+   :parser #(map (comp keyword str/trim) (str/split % #","))})

 (defn check-env-vars
   "Checks any environment variables starting with CMR_ are recognized as known environment variables.


Add ability to load a particular reference column

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -428,12 +428,53 @@
       (log/info "Writing concept data")
       (write-concept-data concepts))))

+(defn ez-load-ref-column
+  [dataset slice refcol]
+  (ez-load-concepts dataset)
+  (with-db (get-db dataset)
+           (let [dataset (name dataset)
+                 definition (read-definition dataset)
+                 concepts (read-concepts definition)
+                 slicedef (get-in definition [:slices (keyword slice)])
+                 refdef (get-in slicedef [:references (keyword refcol)])
+                 concept (:concept refdef)
+                 id (keyword (:id refdef))
+                 slice-cols (map keyword (coll-wrap (:column refdef)))
+                 concept-cols (map keyword (coll-wrap (:id refdef :_id)))
+                 value (keyword (:value refdef))
+                 concept-data (->> (coll/find-maps (data/concept-collection concept))
+                                   (map (fn [row]
+                                          [(into {} (zipmap slice-cols ((apply juxt concept-cols) row)))
+                                           {value (value row)}])))]
+             (log/info "Writing" refcol "for" dataset slice)
+             (doseq [[find-map update-map] concept-data]
+               (coll/update (name slice)
+                            find-map
+                            {"$set" update-map}
+                            :multi true)))))
+
+(defn- set-reference-column
+  [dataset slice column columndef concepts]
+  (let [concept (keyword (:concept columndef))
+        concept-def (concepts concept)
+        collection (concept-collection concept)
+        value (keyword (:value columndef))
+        concept-data (->> (coll/find-maps collection)
+                          (map (fn [row]
+                                 [(concept row)
+                                  (value row)])))]
+    (doseq [[key value] concept-data]
+      (coll/update (name slice)
+                   {(keyword (:column columndef)) key}
+                   {"$set" {(keyword column) value}}
+                   :multi true))))
+
 (defn ez-load-slice
-  [dataset slice]
   "Load one slice for a dataset.
   Does not run Drake to process data first. Also does not run other
   slices that the slice may depend on, so make sure you have all the
   data you need before running this."
+  [dataset slice]
   (let [dataset (name dataset)
         definition (read-definition dataset)
         concepts (read-concepts definition)]


fix indent

fix indent

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -140,7 +140,7 @@
   [attrs]
   (let [new-id (d/tempid :entities)
         {:keys [db-after tempids]} @(d/transact conn
-                                                [(assoc attrs :db/id new-id)])]
+                                      [(assoc attrs :db/id new-id)])]
     (->> (d/resolve-tempid db-after tempids new-id)
          (d/entity db-after))))

@@ -185,9 +185,9 @@
   (if-let [e (user-preference-is-set? user-id k)]
     @(d/transact conn [[:db/add e :user.preference/value (pr-str v)]])
     @(d/transact conn [{:user.preference/key k
-                         :user.preference/value (pr-str v)
-                         :user/_preferences [:user/id user-id]
-                         :db/id #db/id [:entities]}])))
+                        :user.preference/value (pr-str v)
+                        :user/_preferences [:user/id user-id]
+                        :db/id #db/id [:entities]}])))

 (defn user-search-preferences
   "Find the ids of users that have the a given value for a given key set in
@@ -232,8 +232,8 @@
   ; upsert-thread
   (when-not (d/entity (d/db conn) [:thread/id thread-id])
     (d/transact conn (concat [{:db/id (d/tempid :entities)
-                                 :thread/id thread-id
-                                 :thread/group [:group/id group-id]}])))
+                               :thread/id thread-id
+                               :thread/group [:group/id group-id]}])))

   (let [; for users subscribed to mentioned tags, open and subscribe them to
         ; the thread
@@ -351,7 +351,7 @@
 (defn set-user-password!
   [user-id password]
   @(d/transact conn [[:db/add [:user/id user-id]
-                        :user/password-token (password/encrypt password)]]))
+                      :user/password-token (password/encrypt password)]]))

 (defn user-by-id
   [id]
@@ -385,12 +385,12 @@
 (defn get-invite
   [invite-id]
   (some-> (d/pull (d/db conn)
-              [:invite/id
-               {:invite/from [:user/id :user/email :user/nickname]}
-               :invite/to
-               {:invite/group [:group/id :group/name]}]
-              [:invite/id invite-id])
-      db->invitation))
+                  [:invite/id
+                   {:invite/from [:user/id :user/email :user/nickname]}
+                   :invite/to
+                   {:invite/group [:group/id :group/name]}]
+                  [:invite/id invite-id])
+          db->invitation))

 (defn retract-invitation!
   [invite-id]
@@ -441,11 +441,11 @@
 (defn get-open-thread-ids-for-user
   [user-id]
   (d/q '[:find [?thread-id ...]
-                :in $ ?user-id
-                :where
-                [?e :user/id ?user-id]
-                [?e :user/open-thread ?thread]
-                [?thread :thread/id ?thread-id]]
+         :in $ ?user-id
+         :where
+         [?e :user/id ?user-id]
+         [?e :user/open-thread ?thread]
+         [?thread :thread/id ?thread-id]]
        (d/db conn)
        user-id))

@@ -643,22 +643,22 @@
   ; subscribe to a tag they can't?
   (when (user-in-tag-group? user-id tag-id)
     (d/transact conn [[:db/add [:user/id user-id]
-                         :user/subscribed-tag [:tag/id tag-id]]])))
+                       :user/subscribed-tag [:tag/id tag-id]]])))

 (defn user-unsubscribe-from-tag!
   [user-id tag-id]
   (d/transact conn [[:db/retract [:user/id user-id]
-                       :user/subscribed-tag [:tag/id tag-id]]]))
+                     :user/subscribed-tag [:tag/id tag-id]]]))

 (defn user-add-to-group! [user-id group-id]
   (d/transact conn [[:db/add [:group/id group-id]
-                       :group/user [:user/id user-id]]]))
+                     :group/user [:user/id user-id]]]))

 (defn user-make-group-admin! [user-id group-id]
   (d/transact conn [[:db/add [:group/id group-id]
-                       :group/user [:user/id user-id]]
-                      [:db/add [:group/id group-id]
-                       :group/admins [:user/id user-id]]]))
+                     :group/user [:user/id user-id]]
+                    [:db/add [:group/id group-id]
+                     :group/admins [:user/id user-id]]]))

 (defn user-is-group-admin?
   [user-id group-id]
@@ -761,7 +761,7 @@
                                [?thread :thread/tag ?tag]
                                [?msg :message/thread ?thread]
                                [?msg :message/created-at ?time]]
-                              (d/db conn) tag-id)
+                             (d/db conn) tag-id)
         thread-eids (->> all-thread-eids
                          (sort-by second #(compare %2 %1))
                          (map first)
@@ -800,14 +800,14 @@
 (defn save-extension-token!
   [extension-id {:keys [access-token refresh-token]}]
   @(d/transact conn [[:db/add [:extension/id extension-id]
-                        :extension/token access-token]
-                       [:db/add [:extension/id extension-id]
-                        :extension/refresh-token refresh-token]]))
+                      :extension/token access-token]
+                     [:db/add [:extension/id extension-id]
+                      :extension/refresh-token refresh-token]]))

 (defn update-extension-config!
   [extension-id config]
   @(d/transact conn [[:db/add [:extension/id extension-id]
-                       :extension/config (pr-str config)]]))
+                      :extension/config (pr-str config)]]))

 (defn set-extension-config!
   [extension-id k v]
@@ -830,7 +830,7 @@
   [extension-id thread-id]
   (assert (thread-visible-to-extension? thread-id extension-id))
   @(d/transact conn [[:db/add [:extension/id extension-id]
-                        :extension/watched-threads [:thread/id thread-id]]]))
+                      :extension/watched-threads [:thread/id thread-id]]]))

 (defn extensions-watching
   "Get the extensions that are watching the given thread"
@@ -863,7 +863,7 @@
                       (assoc k v)
                       pr-str)]
     (d/transact conn [[:db.fn/cas [:group/id group-id]
-                         :group/settings old-prefs new-prefs]])))
+                       :group/settings old-prefs new-prefs]])))

 (defn public-group-with-name
   [group-name]


adding combine-by-key to api

adding combine-by-key to api

--- src/clj/flambo/api.clj
+++ src/clj/flambo/api.clj
@@ -116,6 +116,14 @@
       .groupByKey
       (.map (function untuple))))

+(defn combine-by-key [rdd create-combiner merge-value merge-combiners]
+  (-> rdd
+      (.map (pair-function identity))
+      (.combineByKey (function create-combiner)
+                     (function2 merge-value)
+                     (function2 merge-combiners))
+      (.map (function untuple))))
+
 (defn sort-by-key
   ([rdd]
      (sort-by-key rdd compare true))


Add priority to SMC and Clone Chip prompts.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -294,6 +294,7 @@
    "Clone Chip"
    {:prevent [:net]
     :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+                 :priority true
                  :choices (req (filter #(and (has? % :type "Program")
                                              (<= (:cost %) (:credit runner))) (:discard runner)))
                  :effect (effect (trash card) (runner-install target))}]}
@@ -1381,7 +1382,7 @@
    "Plascrete Carapace"
    {:data [:counter 4]
     :prevent [:meat]
-    :abilities [{:counter-cost 1 :effect (effect (damage-prevent :meat 1))}]}
+    :abilities [{:counter-cost 1 :msg "prevent 1 meat damage" :effect (effect (damage-prevent :meat 1))}]}

    "Priority Requisition"
    {:choices {:req #(and (= (:type %) "ICE") (not (:rezzed %)))}
@@ -1747,6 +1748,7 @@
    "Self-modifying Code"
    {:prevent [:net]
     :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+                 :priority true
                  :choices (req (filter #(has? % :type "Program") (:deck runner)))
                  :cost [:credit 2]
                  :effect (effect (trash card) (runner-install target) (shuffle! :deck))}]}


Fix Security Testing cleanup code. Fix syntax error in Comet patch.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -317,7 +317,7 @@
                    :effect (effect (draw :runner))}}}

    "Comet"
-   (:effect (effect (gain :memory 1)) :leave-play (effect (lose :memory 1))
+   {:effect (effect (gain :memory 1)) :leave-play (effect (lose :memory 1))
     :events {:play-event
              {:optional {:prompt "Play another event?" :once :per-turn
                          :effect (effect (resolve-ability
@@ -1609,7 +1609,7 @@
                                     {:mandatory true
                                      :effect (effect (resolve-ability
                                                       {:msg "gain 2 [Credits] instead of accessing"
-                                                       :effect (gain :credit 2)} st nil))})))}}}
+                                                       :effect (effect (gain :credit 2))} st nil))})))}}}

    "Self-modifying Code"
    {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))


Removing :prevent from SMC and Clone Chip.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -292,8 +292,7 @@
    {:recurring 1}

    "Clone Chip"
-   {:prevent [:net]
-    :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+   {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
                  :priority true
                  :choices (req (filter #(and (has? % :type "Program")
                                              (<= (:cost %) (:credit runner))) (:discard runner)))
@@ -1770,8 +1769,7 @@
    {:effect (effect (lose :runner :max-hand-size 1))}

    "Self-modifying Code"
-   {:prevent [:net]
-    :abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
+   {:abilities [{:prompt "Choose a program to install" :msg (msg "install " (:title target))
                  :priority true
                  :choices (req (filter #(has? % :type "Program") (:deck runner)))
                  :cost [:credit 2]


Make common functions public. More consistent names.

--- src/clj_diff/myers.clj
+++ src/clj_diff/myers.clj
@@ -38,7 +38,7 @@
         y (- x k)]
     [x y]))

-(defn- longest-snake
+(defn snake
   "Starting at point (x, y) return the x value of the point at the end of the
   longest snake on this diagonal. A snake is a sequence of diagonal moves
   connection match points on the edit graph."
@@ -67,7 +67,7 @@
     (if (seq diagonals)
       (let [k (first diagonals)
             [x y] (next-point d k v)
-            x (longest-snake a b x y n m)
+            x (snake a b x y n m)
             y (- x k)
             v (assoc v k x)]
         (if (and (>= x n) (>= y m))
@@ -95,7 +95,7 @@
             (recur (rest d-range) endpoints)))
         [(+ n m) (- n m) endpoints]))))

-(defn- optimal-path
+(defn- path
   "Reconstruct the optimal path from source to sink using the information
   produced by the ses function."
   [a b d k endpoints]
@@ -109,7 +109,7 @@
             prev-v (get endpoints (dec d))
             [prev-k b] (if (< (x-down prev-v k) (x-up prev-v k))
                          [(inc k) (x-up prev-v k)]
-                         [(dec k) (+ 1 (x-down prev-v k))])
+                         [(dec k) (inc (x-down prev-v k))])
             result (reduce conj
                            (conj result [x y])
                            (reverse
@@ -132,15 +132,8 @@
           []
           additions))

-(defn diff
-  "Create an edit script that may be used to transform a into b. See doc string
-  for clj-diff.core/diff."
-  [a b]
-  (let [a (vec (cons nil a))
-        b (vec (cons nil b))
-        ses (ses a b)
-        optimal-path (apply optimal-path a b ses)
-        script
+(defn path->script [a b path]
+  (let [script
         (reduce (fn [e p]
                   (let [c (:current e)
                         x (first p)
@@ -156,8 +149,18 @@
                 {:current [0 0]
                  :+ []
                  :- []}
-                optimal-path)]
+                path)]
     (-> script
         (dissoc :current)
         (assoc :+ (merge-additions (:+ script))))))

+(defn diff
+  "Create an edit script that may be used to transform a into b. See doc string
+  for clj-diff.core/diff."
+  [a b]
+  (let [a (vec (cons nil a))
+        b (vec (cons nil b))
+        ses (ses a b)
+        optimal-path (apply path a b ses)]
+    (path->script a b optimal-path)))
+


changed password to default

changed password to default

--- src/grape/core.clj
+++ src/grape/core.clj
@@ -9,7 +9,7 @@

 (def dburi "http://localhost:7474/db/data/")
 (def dbusr "neo4j")
-(def dbpw "socke")
+(def dbpw "neo4j")

 (def conn (nr/connect dburi dbusr dbpw))


add authorization header

add authorization header

--- src/mobile_patient/events.cljs
+++ src/mobile_patient/events.cljs
@@ -42,12 +42,15 @@
  :fetch
  (fn [{:keys [base-url uri opts success success-parms spinner-id]}]
    (let [base-url (or base-url @(subscribe [:get-in [:config :base-url]]))
-         response (atom nil)]
+         response (atom nil)
+         token @(subscribe [:get-in [:auth :id_token]])
+         ]
      (if spinner-id (dispatch [:spinner spinner-id true]))
      (-> (js/fetch (str base-url uri (h/parms->query (:params opts)))
                    (clj->js (merge {:redirect "manual"
                                     :method "GET"
-                                    :headers {"Content-Type" "application/json"}}
+                                    :headers (merge {"Content-Type" "application/json"}
+                                                    {"Authorization" (str "Bearer " token)})}
                                    opts)))
          (.then (fn [resp]
                   (reset! response resp)
@@ -86,7 +89,7 @@
               :spinner-id :login
               :success :on-login
               :opts {:params {:response_type "id_token token"
-                             :client_id "sansara"
+                             :client_id "tealnet"
                              :state "state"
                              :scope "openid"}
                      :method "POST"
@@ -106,7 +109,8 @@
                token-data (jwt/get-data-from-token id-token)
                user-id  (:user-id token-data)]
            (assert user-id)
-           {:db (merge db {:access-token (:access_token auth-data)
+           {:db (merge db {:auth auth-data
+                           :access-token (:access_token auth-data)
                            :last-time (.toISOString (js/Date.))})
             :dispatch [:boot user-id]})))
      (do


Fixing wavetable editor size so it shows all panels correctly.

--- src/overtone/gui/wavetable.clj
+++ src/overtone/gui/wavetable.clj
@@ -147,6 +147,7 @@
                       :width 1024 :height 760
                       :minimum-size [320 :by 240])]
          (-> f pack! show!)
+         (pack! f)
          (with-meta
            {:frame f :buf buf}
            {:type ::waveform-editor}))
@@ -180,7 +181,7 @@
              split (top-bottom-split
                      editor
                      (wavetable-thumbnailer table)
-                     :divider-location 0.8)
+                     :divider-location 0.7)
              change-wave-fn (fn [buf]
                               (invoke-later
                                 (try
@@ -195,10 +196,11 @@
                                     (error "Exception in wave change: " ex)))))
              f (frame :title "Wave Table Editor"
                       :content split
-                      :width 600 :height 400
-                      :minimum-size [300 :by 200])]
+                      :width 600 :height 500
+                      :minimum-size [300 :by 300])]
          (add-thumbnail-behavior f change-wave-fn)
          (-> f pack! show!)
+         (pack! f)
          (with-meta
            {:frame f :wavetable table}
            {:type ::wavetable-editor}))


Add fns to decide whether node's parent has a specific class or not

--- src/discuss/utils/common.cljs
+++ src/discuss/utils/common.cljs
@@ -346,6 +346,21 @@
   (toggle-class dom-element class true))

+;;;; DOM Query
+(defn one-of-parent-has-class?
+  "Traverse all the parents of the node and return true, if there is one parent,
+  who has the desired class, id, or whatever.
+
+  Example: (one-of-parent-has-class? \"#discuss-text\" \".modal\")"
+  [selector class]
+  (pos-int? (.-length (.closest ((js* "$") selector) class))))
+
+(defn inside-overlay?
+  "Test if provided node is rendered inside a modal."
+  [query-selector]
+  (one-of-parent-has-class? query-selector "#discuss-overlay"))
+
+
 ;;;; DOM Modifications
 (defn show-overlay
   "Show discuss in an overlay."


update dependencies

update dependencies

--- om-hello-world/project.clj
+++ om-hello-world/project.clj
@@ -2,19 +2,19 @@
   :description "ClojureScript om hello world web app"
     :url "https://github.com/wtfleming/clojurescript-examples"
   :min-lein-version "2.0.0"
-  :dependencies [[org.clojure/clojure "1.6.0"]
-                 [compojure "1.3.1"]
-                 [ring/ring-defaults "0.1.2"]
-                 [sablono "0.2.22"]
-                 [org.om/om "0.8.0"]
-                 [org.clojure/clojurescript "0.0-2511"]]
+  :dependencies [[org.clojure/clojure "1.7.0"]
+                 [compojure "1.4.0"]
+                 [ring/ring-defaults "0.1.5"]
+                 [sablono "0.4.0"]
+                 [org.omcljs/om "0.9.0"]
+                 [org.clojure/clojurescript "1.7.170"]]
   :ring {:handler om-hello-world.core.handler/app}
   :profiles
   {:dev {:dependencies [[javax.servlet/servlet-api "2.5"]
                         [ring-mock "0.1.5"]]}}
   :source-paths ["src/clj"]
-  :plugins [[lein-cljsbuild "1.0.3"]
-            [lein-ring "0.8.13"]]
+  :plugins [[lein-cljsbuild "1.1.1"]
+            [lein-ring "0.9.7"]]
   :cljsbuild {:builds
               [{:id "app"
                 :source-paths ["src/cljs"]


Add level 4 rule

Add level 4 rule

--- src/kevin/core.clj
+++ src/kevin/core.clj
@@ -28,6 +28,10 @@
      [(concat ?p1 ?p2) ?path]]
     [(acted-with-3 ?e1 ?e2 ?path)
      (acted-with-2 ?e1 ?x ?p1)
+     (acted-with ?x ?e2 ?p2)
+     [(concat ?p1 ?p2) ?path]]
+    [(acted-with-4 ?e1 ?e2 ?path)
+     (acted-with-3 ?e1 ?x ?p1)
      (acted-with ?x ?e2 ?p2)
      [(concat ?p1 ?p2) ?path]]])


pagination is fixed

pagination is fixed

--- src/crawler/corpus.clj
+++ src/crawler/corpus.clj
@@ -7,7 +7,7 @@
             [structural-similarity.xpath-text :as xpath-text])
   (:use [clj-xpath.core :only [$x:node+]]
         [clojure.pprint :only [pprint]]
-        [structural-similarity.xpath-text :only [similar?]])
+        [structural-similarity.xpath-text :only [similar? similarity-cosine-char-freq]])
   (:import [java.io PushbackReader]))

 (defn read-corpus-file
@@ -116,259 +116,91 @@
          (< (count yield-nodes)
             (count prev-nodes)))))

-(defn seqs-to-refine
-  [action-seq corpus]
-  (let [action-segments (reductions
-                         (fn [acc x]
-                           (cons x acc))
-                         nil
-                         (reverse action-seq))]
-    ;; the first one is a nil action at a nil
-    ;; point
-    (filter
-     second
-     (map
-      (fn [segment]
-        [segment (try (nth action-seq (count segment))
-                      (catch IndexOutOfBoundsException e nil))])
-      (filter
-       (fn [segment] (refine-segment? segment corpus))
-       action-segments)))))
-
-(defn leaf-fix?
-  [action-seq corpus]
-  (let [documents (filter
-                   (fn [[u x]]
-                     (= (:src-xpath x)
-                        action-seq))
-                   corpus)
-
-        leaves (filter
-                (fn [[u x]]
-                  (:leaf? x))
-                documents)]
-    (< (count leaves)
-       (count documents))))
-
-;; (defn repair-leaf-fuck-up
-;;   "Try to repair the leaf node yield
-;;    rate along the current action seq
-
-;;    muscle URLs we want
-;;    fat URLs we don't"
-;;   [action-seq corpus muscle fat]
-;;   (let [documents (filter
-;;                    (fn [[u x]]
-;;                      (and (:leaf? x)
-;;                           (= (:src-xpath x)
-;;                              action-seq)))
-;;                    corpus)
-
-;;         src-urls (map
-;;                   (fn [[u x]]
-;;                     (:src-url x))
-;;                   documents)
-
-;;         src-docs (map
-;;                   #(corpus %)
-;;                   src-urls)
-
-;;         action-taken (first action-seq)]
-;;     (map
-;;      (fn [[u x]]
-;;       (dom/refine-xpath
-;;        action-taken
-;;        (:body x)
-;;        u
-;;        muscle
-;;        fat))
-;;      src-docs)))
-
-(defn refine-segment
-  [segment action-to-take corpus]
+(defn refine-action
+  "Args:
+    src-page: The body of the source web-page
+    dest-pages: A set of destination pages from the src-page at
+                the specified action (plz don't supply more)
+    action: The actiont taken (not the SRC-action!!!!)
+    dest-page-test: A routine that accepts the source page
+                    [url info] and the dest page [url info] data
+                    structures
+
+  Returns:
+    An {:only :avoid} data structure to augment the XPath"
+  [src-data dest-datas action src-url dest-page-test]
   (let [muscle (map
                 first
                 (filter
-                 (fn [[u x]]
-                   (and
-                    (if (:body x)
-                      (let [action-space (map
-                                          first
-                                          (:xpath-nav-info
-                                           (extractor/state-action
-                                            (:body x)
-                                            {:url u}
-                                            {})))]
-                        (some
-                         (fn [x]
-                           (= x action-to-take))
-                         action-space))
-                      false)
-                    (= (:src-xpath x)
-                       segment)))
-                 corpus))
-        fat     (filter
-                 (fn [[u x]]
-                   (and
-                    (if (:body x)
-                      (let [action-space (map
-                                          first
-                                          (:xpath-nav-info
-                                           (extractor/state-action
-                                            (:body x)
-                                            {:url u}
-                                            {})))]
-                        (not
-                         (some
-                          (fn [x]
-                            (= x action-to-take))
-                          action-space)))
-                      true)
-                    (= (:src-xpath x)
-                       segment)))
-                 corpus)
+                 #(dest-page-test src-data %)
+                 dest-datas))
+
+        fat (map
+             first
+             (filter
+              #(not
+                (dest-page-test src-data %))
+              dest-datas))]
+    (dom/refine-xpath-accuracy action
+                               (-> src-data second :body)
+                               src-url
+                               muscle
+                               fat)))
+
+(defn detect-pagination
+  "Employs the simpler digit-based algorithm.
+   Also refines the XPaths"
+  [a-corpus]
+  (let [digit-anchor-text (filter
+                           (fn [[u x]]
+                             (re-find #"^\d+$" (:src-text x)))
+                           a-corpus)
+
+        pagination-candidates (filter
+                               (fn [[u x]]
+                                 (let [src-url  (:src-url x)
+                                       src-body (:body (a-corpus src-url))]
+                                   (similar? src-body (:body x))))
+                               digit-anchor-text)

-        docs    (map
-                 (fn [[u x]]
-                   [u (:body x)])
-                 (filter
-                  (fn [[u x]]
-                    (= (:src-xpath x)
-                       segment))
-                  corpus))]
-    (first
-     (first
-      (max-key
-       second
-       (frequencies
-        (map
-         (fn [[u  b]]
-           (dom/refine-xpath-accuracy segment
-                                      b
-                                      u
-                                      muscle
-                                      fat))
-         docs)))))))
-
-(defn refine-model-with-positions
-  "Try to maximize the model yield with position info"
-  [model corpus]
-  (map
-   (fn [[action-seq count]]
-     (let [leaf-fix-decision (leaf-fix? action-seq corpus)
-
-           leaf-muscle (map
-                        first
-                        (filter
-                         (fn [[u x]]
-                           (and (:leaf? x)
-                                (= (:src-xpath x)
-                                   action-seq)))
-                         corpus))
-
-           leaf-fat    (map
-                        first
-                        (filter
-                         (fn [[u x]]
-                           (and (not (:leaf? x))
-                                (= (:src-xpath x)
-                                   action-seq)))
-                         corpus))
-
-           leaf-src-urls (map
-                          (fn [[u x]]
-                            (:src-url x))
-                          (filter
-                           (fn [[u x]]
-                             (= (:src-xpath x)
-                                action-seq))
-                           corpus))
-
-           leaf-src-docs (map
-                          (fn [u]
-                            (:body (corpus u)))
-                          leaf-src-urls)
-
-           leaf-fix (first
+        action-and-pagination (distinct
+                               (map
+                                (fn [[u x]]
+                                  [(-> x :path rest) (-> x :path first)])
+                                pagination-candidates))
+
+        dest-page-test (fn [src-data dest-data]
+                         (similar? (-> src-data second :body)
+                                   (-> dest-data second :body)))]
+    {:actions (into {} action-and-pagination)
+
+     :refine  (into
+               {}
+               (map
+                (fn [[action-seq paging-action]]
+                  (let [full-action-seq   (cons paging-action action-seq)
+
+                        docs-at-xpath     (filter
+                                           (fn [[u x]]
+                                             (= (:path x) full-action-seq))
+                                           a-corpus)
+
+                        grouped-by-source (group-by
+                                           (fn [[u x]]
+                                             (:src-url x))
+                                           docs-at-xpath)]
+                    [[action-seq paging-action]
                      (first
-                      (max-key
-                       second
-                       (frequencies
-                        (map
-                         (fn [[u b]]
-                           (if leaf-fix-decision
-                             (dom/refine-xpath-accuracy (first action-seq)
-                                                        b
-                                                        u
-                                                        leaf-muscle
-                                                        leaf-fat)
-                             {}))
-                         (map vector leaf-src-urls leaf-src-docs))))))]
-       {:action action-seq
-        :segments-to-fix
-        (cons
-         [action-seq leaf-fix]
-         (map
-          (fn [[segment action]]
-            (refine-segment segment action corpus))
-          (seqs-to-refine action-seq
-                          corpus)))
-        :count count}))
-   model))
-
-(defn refine-pagination-with-positions
-  "Pagination is a 2-tuple from an action seq
-   to a pagination action you take at that point
-
-   as a result the muscle is the portions marked by
-   the crawler as pagination from a source link.
-
-   the fat is the stuff that didn't make the cut"
-  [action-seq paging-action corpus]
-  (let [src-docs (filter
-                  (fn [[u x]]
-                    (= (:src-xpath x)
-                       action-seq))
-                  corpus)
-
-        paging-docs (map
-                     (fn [[u x]]
-                       (let [actions (:xpath-nav-info
-                                      (extractor/state-action (:body x)
-                                                              {:url u}
-                                                              {}))
-                             links   (map
-                                      (fn [l]
-                                        [l (corpus l)])
-                                      (first
-                                       (map
-                                        :hrefs
-                                        (filter
-                                         #(= (:xpath %)
-                                             paging-action)
-                                         actions))))
-
-                             muscle  (map
-                                      first
-                                      (filter
-                                       (fn [[u x2]]
-                                         (and (:body x2) (xpath-text/similar? (:body x2)
-                                                                              (:body x))))
-                                       links))
-
-                             fat     (map
-                                      first
-                                      (filter
-                                       (fn [[u x2]]
-                                         (or (nil? x2)
-                                             (not (xpath-text/similar? (:body x2)
-                                                                       (:body x)))))
-                                       links))]
-                         (dom/refine-xpath-accuracy paging-action (:body x) u muscle fat)))
-                     src-docs)]
-    [paging-action
-     (first
-      (first
-       (max-key
-        second
-        (frequencies paging-docs))))]))
+                      (last
+                       (sort-by
+                        second
+                        (frequencies
+                         (map
+                          (fn [[src-url xs]]
+                            (refine-action [src-url (a-corpus src-url)]
+                                           xs
+                                           paging-action
+                                           src-url
+                                           dest-page-test))
+                          grouped-by-source)))))]))
+                action-and-pagination))}))


Implement resolving mapped-to links

Implement resolving mapped-to links

--- src/custard/parser.clj
+++ src/custard/parser.clj
@@ -24,6 +24,14 @@

 (defn path->segments [path]
   (fs/split (strip-extension path)))
+
+;;;; Node idents and links
+
+(defn node->ident [node]
+  [:node (:name node)])
+
+(defn node->link [node]
+  {:name (:name node)})

 ;;;; Parsing

@@ -122,11 +130,7 @@
             (:children node))))

 (defn build-graph [flat-tree]
-  (letfn [(node->ident [node]
-            [:node (:name node)])
-          (node->link [node]
-            {:name (:name node)})
-          (parse-node [graph node]
+  (letfn [(parse-node [graph node]
             (let [ident (node->ident node)
                   child-links (mapv node->link (:children node))
                   linked-node (assoc node :children child-links)]
@@ -145,12 +149,23 @@
 (defn merge-file-data [m [path data]]
   (update-in m (path->segments path) recursive-merge data))

+(defn create-mapped-to-links [graph]
+  (letfn [(lookup-mapped-to [graph ident]
+            (let [nodes (mapv #(get-in graph %) (:nodes graph))]
+              (filterv #(some #{ident} (:mapped-here %)) nodes)))
+          (create-mapped-to [graph ident]
+            (let [node (get-in graph ident)
+                  link (node->link node)
+                  targets (lookup-mapped-to graph link)]
+              (assoc-in graph (conj ident :mapped-to) targets)))]
+    (reduce create-mapped-to graph (:nodes graph))))
+
 (defn process-files [path->data]
   (let [data (reduce merge-file-data {} path->data)
         tree (parse-tree data)
         flat-tree (flatten-tree tree)
         graph (build-graph flat-tree)]
-    graph))
+    (create-mapped-to-links graph)))

 (defn parse-yaml [data]
   (try


allow :this and :super to be used with type-desc

--- src/insn/util.clj
+++ src/insn/util.clj
@@ -269,7 +269,9 @@
   Class
   (type-desc [c] (type-desc (.getName c)))
   Keyword
-  (type-desc [k] (check-valid "type descriptor" type-keyword? k))
+  (type-desc [k]
+    (or (some-> (class-keyword? k) deref type-desc)
+        (check-valid "type descriptor" type-keyword? k)))
   Sequential
   (type-desc [s] (str "[" (type-desc (first s))))
   String


expose zone-id?

expose zone-id?

--- src/java_time.clj
+++ src/java_time.clj
@@ -40,7 +40,7 @@
    available-zone-ids zone-id zone-offset
    offset-date-time offset-time zoned-date-time
    system-clock fixed-clock offset-clock tick-clock clock?
-   zoned-date-time? offset-date-time? offset-time?
+   zone-id? zoned-date-time? offset-date-time? offset-time?
    with-zone-same-instant with-offset with-offset-same-instant]

   [java-time.mock


Remove errant character

Remove errant character

--- src/io/aviso/twixt.clj
+++ src/io/aviso/twixt.clj
@@ -115,7 +115,7 @@
   Each path must exist.

   An asset path does not start with a leading slash.
-  ΩThe default asset resolver locates each asset on the classpath under `META-INF/assets/`.
+  The default asset resolver locates each asset on the classpath under `META-INF/assets/`.

   - `context` - the `:twixt` key, extracted from the Ring request map
   - `paths` - asset paths"


Reduce unnecessary keys in leaf

Reduce unnecessary keys in leaf

--- src/onyx/types.clj
+++ src/onyx/types.clj
@@ -1,13 +1,9 @@
 (ns onyx.types)

-(defrecord Leaf [message id offset flow])
+(defrecord Leaf [message flow])

-(defn input
-  ([message]
-   (->Leaf message nil nil nil))
-  ([id message]
-   ;; FIXME: THROWING AWAY ID, NO LONGER REQUIRED
-   (->Leaf message nil nil nil)))
+(defn input [message]
+  (->Leaf message nil))

 (defrecord Route [flow exclusions post-transformation action])


Added create and read for wishlist redis

--- src/wishlistd/models/redis.clj
+++ src/wishlistd/models/redis.clj
@@ -1,14 +1,28 @@
 (ns wishlistd.models.redis
   (:require [redis.core :as r])
-  (:use wishlistd.code))
+  (:use [wishlistd.code]
+        [cheshire.core]))

 (def db {:host "127.0.0.1" :port 6379 :db 0})

 (defn new-code []
   "Generates random codes until it finds one that doesn't exist."
   (r/with-server db
-    (let [code (random-code)]
+    (let [code (random-code 8)]
       (if (r/exists code)
-        code
-        (new-code)))))
-      +        (new-code)
+        code))))
+
+(defn create-wishlist [wishlist]
+  (let [code (new-code)
+        with-code (assoc wishlist :code code)
+        as-json (encode with-code)]
+    (r/with-server db
+      (r/set code as-json))
+    code))
+
+(defn read-wishlist [code]
+  (r/with-server db
+    (decode
+      (r/get code))))
+


Clojure 1.2.1 reveals a bug.

Clojure 1.2.1 reveals a bug.

--- src/midje/doc.clj
+++ src/midje/doc.clj
@@ -124,7 +124,11 @@
   :print-facts        (2)  -- print fact descriptions in addition to namespaces.
 "} midje-print-levels)

-(def midje-print-level midje-print-levels)
+(defn alternate-doc-source [copy original]
+  (intern *ns* (vary-meta copy assoc :doc (:doc (meta (resolve original))))))
+
+(alternate-doc-source 'midje-print-level 'midje-print-levels)
+

 (def ^{:doc "
   * A common form:
@@ -143,8 +147,8 @@
     (fact :integration ...)
     (fact {:priority 5} ...)
 "} midje-facts)
-(def midje-fact midje-facts)
-
+
+(alternate-doc-source 'midje-fact 'midje-facts)

 (def ^{:doc "
   (facts \"about checkers\"
@@ -224,8 +228,7 @@
        ...)
 "} midje-setup)

-(def midje-teardown midje-setup)
-
+(alternate-doc-source 'midje-teardown 'midje-setup)

 (def ^{:doc "
   * For checks


Clean up dead code and rename kw lookups

--- src/korhal/interop.clj
+++ src/korhal/interop.clj
@@ -38,7 +38,7 @@
 ;; type definitions

 ;; unit type kw lookup is a special case to add in the minerals and geysers
-(def unit-type-kw-lookup
+(def unit-type-kws
   (merge {:mineral jnibwapi.types.UnitType$UnitTypes/Resource_Mineral_Field
           :geyser jnibwapi.types.UnitType$UnitTypes/Resource_Vespene_Geyser}
          (zipmap (map keyword (take-nth 2 unit-types))
@@ -69,40 +69,16 @@
 (gen-type-ids-map explosion-type-ids 'jnibwapi.types.ExplosionType$ExplosionTypes explosion-types)
 (gen-type-ids-map order-type-ids 'jnibwapi.types.OrderType$OrderTypes order-types)

-(gen-type-kw-map upgrade-type-kw-lookup 'jnibwapi.types.UpgradeType$UpgradeTypes upgrade-types)
-(gen-type-kw-map tech-type-kw-lookup 'jnibwapi.types.TechType$TechTypes tech-types)
-(gen-type-kw-map unit-command-type-kw-lookup 'jnibwapi.types.UnitCommandType$UnitCommandTypes unit-command-types)
-(gen-type-kw-map race-type-kw-lookup 'jnibwapi.types.RaceType$RaceTypes race-types)
-(gen-type-kw-map unit-size-type-kw-lookup 'jnibwapi.types.UnitSizeType$UnitSizeTypes unit-size-types)
-(gen-type-kw-map weapon-type-kw-lookup 'jnibwapi.types.WeaponType$WeaponTypes weapon-types)
-(gen-type-kw-map bullet-type-kw-lookup 'jnibwapi.types.BulletType$BulletTypes bullet-types)
-(gen-type-kw-map damage-type-kw-lookup 'jnibwapi.types.DamageType$DamageTypes damage-types)
-(gen-type-kw-map explosion-type-kw-lookup 'jnibwapi.types.ExplosionType$ExplosionTypes explosion-types)
-(gen-type-kw-map order-type-kw-lookup 'jnibwapi.types.OrderType$OrderTypes order-types)
-
-(defn gen-upgrade-type-kw-lookup []
-  (intern *ns*
-          (symbol 'upgrade-type-kw-lookup)
-          (zipmap (map keyword (take-nth 2 upgrade-types))
-                  (map #(eval `(. jnibwapi.types.UpgradeType$UpgradeTypes ~%)) (take-nth 2 (rest upgrade-types))))))
-(gen-upgrade-type-kw-lookup)
-
-(defn gen-tech-type-ids []
-  (intern *ns*
-          (symbol 'tech-type-ids)
-          (->> (map #(vector (eval `(.getID ~(symbol (str "jnibwapi.types.TechType$TechTypes/" %))))
-                             (eval (symbol (str "jnibwapi.types.TechType$TechTypes/" %))))
-                   (take-nth 2 (rest tech-types)))
-               (flatten)
-               (apply hash-map))))
-(gen-tech-type-ids)
-
-(defn gen-tech-type-kw-lookup []
-  (intern *ns*
-          (symbol 'tech-type-kw-lookup)
-          (zipmap (map keyword (take-nth 2 tech-types))
-                  (map #(eval `(. jnibwapi.types.TechType$TechTypes ~%)) (take-nth 2 (rest tech-types))))))
-(gen-tech-type-kw-lookup)
+(gen-type-kw-map upgrade-type-kws 'jnibwapi.types.UpgradeType$UpgradeTypes upgrade-types)
+(gen-type-kw-map tech-type-kws 'jnibwapi.types.TechType$TechTypes tech-types)
+(gen-type-kw-map unit-command-type-kws 'jnibwapi.types.UnitCommandType$UnitCommandTypes unit-command-types)
+(gen-type-kw-map race-type-kws 'jnibwapi.types.RaceType$RaceTypes race-types)
+(gen-type-kw-map unit-size-type-kws 'jnibwapi.types.UnitSizeType$UnitSizeTypes unit-size-types)
+(gen-type-kw-map weapon-type-kws 'jnibwapi.types.WeaponType$WeaponTypes weapon-types)
+(gen-type-kw-map bullet-type-kws 'jnibwapi.types.BulletType$BulletTypes bullet-types)
+(gen-type-kw-map damage-type-kws 'jnibwapi.types.DamageType$DamageTypes damage-types)
+(gen-type-kw-map explosion-type-kws 'jnibwapi.types.ExplosionType$ExplosionTypes explosion-types)
+(gen-type-kw-map order-type-kws 'jnibwapi.types.OrderType$OrderTypes order-types)

 ;; common calls to get state vars and collections

@@ -253,22 +229,22 @@
 (defn build
   ([builder point to-build] (build builder (.x point) (.y point) to-build))
   ([builder tile-x tile-y to-build] (.build api (.getID builder) tile-x tile-y
-                                            (.getID (to-build unit-type-kw-lookup)))))
+                                            (.getID (to-build unit-type-kws)))))

 (defn build-addon [building to-build]
-  (.buildAddon api (.getID building) (.getID (to-build unit-type-kw-lookup))))
+  (.buildAddon api (.getID building) (.getID (to-build unit-type-kws))))

 (defn train [building to-train]
-  (.train api (.getID building) (.getID (to-train unit-type-kw-lookup))))
+  (.train api (.getID building) (.getID (to-train unit-type-kws))))

 (defn morph [unit morph-to]
-  (.morph api (.getID unit) (.getID (morph-to unit-type-kw-lookup))))
+  (.morph api (.getID unit) (.getID (morph-to unit-type-kws))))

 (defn research [unit to-research]
-  (.research api (.getID unit) (.getID (to-research tech-type-kw-lookup))))
+  (.research api (.getID unit) (.getID (to-research tech-type-kws))))

 (defn upgrade [unit to-upgrade]
-  (.upgrade api (.getID unit) (.getID (to-upgrade upgrade-type-kw-lookup))))
+  (.upgrade api (.getID unit) (.getID (to-upgrade upgrade-type-kws))))

 (defn set-rally-point
   ([rally-unit target-unit-or-point]


Avoid duplication in tasks list in help task

--- src/leiningen/help.clj
+++ src/leiningen/help.clj
@@ -2,8 +2,19 @@
   "Display a list of tasks or help for a given task."
   (:use [leiningen.util.ns :only [namespaces-matching]]))

-(def tasks (sort (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %))
-                         (namespaces-matching "leiningen"))))
+(defn- ordered-distinct
+  "Just like distinct, but for ordered coll"
+  ([[x & xs]]
+     (ordered-distinct x xs))
+  ([x xs]
+     (if (seq xs)
+       (if (= x (first xs))
+         (recur x (rest xs))
+         (lazy-seq (cons x (ordered-distinct (first xs) (rest xs)))))
+       nil)))
+
+(def tasks (ordered-distinct (sort (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %))
+                                           (namespaces-matching "leiningen")))))

 (defn get-arglists [task]
   (for [args (:arglists (meta task))]


Fix 24->12hr conversion at midnight & noon for #34.

The modular math converts 24hr midnight (`00`) and noon (`12`) both to
`0` which the 12hr format calls `12` making us fail the adjustment
check. We now explicitly handle this cronological oddity with a
substitution of `12` for `0`.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -817,6 +817,7 @@
                                  java.util.Locale/US)
             _ (.setTime found-cal found-date)
             adjusted-hours (mod (.get found-cal Calendar/HOUR_OF_DAY) 12)
+            adjusted-hours (if (= 0 adjusted-hours) 12 adjusted-hours)
             _ (.set found-cal Calendar/HOUR_OF_DAY adjusted-hours)
             ^Date adjusted-date (.getTime found-cal)]
         (if (= adjusted-date (:ctime expected-version))


Tidy up repo tag schema for non-"no-parent" case.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -408,7 +408,7 @@
        (keep second)
        (filter :ops)))

-(def repo-tag-version "1")
+(def repo-tag-version "2")

 (defn get-repo-tag-version
   [gitdir]
@@ -456,8 +456,8 @@
                                     (:version p)
                                     (s/replace (:root p) #"/" "%")
                                     (subs sha 0 7)
-                                    (and snaps "snaps")
-                                    (and (empty? parents) "no-parent")]))]
+                                    (when snaps "snaps")
+                                    (when (empty? parents) "no-parent")]))]
           (git {:gitdir gitdir} "tag" "-f" tag sha))))

     ;; TODO: clean up abandoned voom-- and voom-branch-- tags


Add index on relation 'r-tree field 'name.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1036,7 +1036,7 @@
 (pldb/db-rel r-branch name sha)
 (pldb/db-rel r-commit ^:index sha ctime tree-sha)
 (pldb/db-rel r-commit-parent ^:index sha ^:index parent-sha)
-(pldb/db-rel r-tree ^:index sha name type ^:index obj-sha)
+(pldb/db-rel r-tree ^:index sha ^:index name type ^:index obj-sha)
 (pldb/db-rel r-proj obj-sha ^:index proj-name vmajor vminor vinc vqual has-snaps?)

 (defn git-logic-tuples


unneeded func

unneeded func

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -192,11 +192,6 @@

 ; Big list of cues from examples
 ; 2DO: learn and delete
-
-(defn blue-on-one
-  "Assing blue color to a big PAR"
-  []
-  (show/add-effect! :color (afterglow.effects.color/color-effect "simple-blue" (params/build-color-param :h 120 :s 100 :l light-param) (show/fixtures-named "rgb-1"))))

 (defn global-color-cue
   "Create a cue-grid entry which establishes a global color effect."


type hint to fix with-graphics performance issue

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -9,10 +9,10 @@
         [quil.util :only [int-like? resolve-constant-key length-of-longest-key gen-padding print-definition-list]]
         [quil.applet :only [current-applet applet-stop applet-state applet-start applet-close applet defapplet applet-safe-exit current-graphics *graphics*]]))

-(defn- current-surface
+(defn- ^PGraphics current-surface
   "Retrieves current drawing surface. It's either current graphics or current applet if graphics is nil"
   []
-  (or (current-graphics) (current-applet)))
+  (or (current-graphics) (.-g (current-applet))))

 (defn
   ^{:requires-bindings true


fix zone not implemented for java.time.ZoneOffset fixes #102

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -330,6 +330,7 @@

   ZoneOffset
   (zone-offset [z] z)
+  (zone [z] z)

   OffsetDateTime
   (time [odt] (cljc.java-time.offset-date-time/to-local-time odt))


removed plug2 specific code

removed plug2 specific code

--- src/show/dom.cljs
+++ src/show/dom.cljs
@@ -1,5 +1,5 @@
 (ns show.dom
-  (:require [plug2.core :refer [pluggable?]])
+  ;; (:require [plug2.core :refer [pluggable?]])
   (:refer-clojure :exclude [map meta time])
   (:require-macros [show.dom :as dom]))

@@ -7,10 +7,12 @@
   opts)

 (defn process-body [body]
-  (if (pluggable? body) @body body))
+  ;; (if (pluggable? body) @body body)
+  body)

 (defn array-map? [o]
-  (instance? cljs.core/PersistentArrayMap o))
+  (instance? cljs.core/PersistentArrayMap o)
+  (map? o))

 (defn process-args [vs]
   (let [vs          (remove nil? vs)
@@ -18,10 +20,7 @@
                       [(first vs) (rest vs)]
                       [nil        vs])
         opts        (into {} (for [[k v] opts]
-                               [k (if (array-map? v) (clj->js v) v)]))
-        opts        (if (contains? opts :key)
-                      opts
-                      (assoc opts :key (gensym)))]
+                               [k (if (array-map? v) (clj->js v) v)]))]
     [(process-opts opts)
      (clojure.core/map process-body body)]))


Misc style fixes

Misc style fixes

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -1,8 +1,8 @@
 (ns metabase.pulse
   (:require [clojure.java.io :as io]
             (clojure [pprint :refer [cl-format]]
-                     [string :refer [upper-case]]
-                     [stacktrace :refer [print-stack-trace]])
+                     [stacktrace :refer [print-stack-trace]]
+                     [string :refer [upper-case]])
             [clojure.tools.logging :as log]
             (clj-time [coerce :as c]
                       [core :as t]
@@ -325,12 +325,12 @@
         xmin   (apply min xs)
         xmax   (apply max xs)
         xrange (- xmax xmin)
-        xs'    (map #(/ (float (- % xmin)) xrange) xs)
+        xs'    (map #(/ (double (- % xmin)) xrange) xs)
         ys     (map second rows)
         ymin   (apply min ys)
         ymax   (apply max ys)
         yrange (max 1 (- ymax ymin)) ; `(max 1 ...)` so we don't divide by zero
-        ys'    (map #(/ (float (- % ymin)) yrange) ys) ; cast to float to avoid "Non-terminating decimal expansion" errors
+        ys'    (map #(/ (double (- % ymin)) yrange) ys) ; cast to double to avoid "Non-terminating decimal expansion" errors
         rows'  (reverse (take-last 2 rows))
         values (map (comp format-number second) rows')
         labels (format-timestamp-pair (map first rows') (first cols))]
@@ -426,7 +426,7 @@
       [:div {:style (style font-style
                            {:color       "#EF8C8C"
                             :font-weight 700
-                            :padding     "16px"})}
+                            :padding     :16px})}
        "An error occurred while displaying this card."])))


shitty race

shitty race

--- src/tabby/net.clj
+++ src/tabby/net.clj
@@ -55,6 +55,7 @@
                             ;(warn (:id @state) " accepting peer connection from: " (:src handshake))
                             (when-not (get-in @state [:peers (:src handshake) :socket])
                               ;; TODO: revisit this, not sure why we can't just overwrite it
+                              ;; race condition I think
                               (swap! state assoc-in [:peers (:src handshake) :socket] s))
                             (s/connect s (:rx-chan @state)))

@@ -68,7 +69,7 @@
                                 (d/recur))))))

        :client-handshake (let [client-index (utils/gen-uuid)]
-                           (info (:id @state) "client connected: " client-index)
+                           (warn (:id @state) "client connected: " client-index)
                            (swap! state update :clients cs/create-client client-index s)
                            (d/loop []
                              (-> (s/take! s ::none)
@@ -161,7 +162,7 @@
     ;;; state is an atom
     ;;; ----------------------------------------------------------------
     (a/go-loop [t (current-time)]
-      (when (seq? (:tx-queue @state))
+      (when-not (empty? (:tx-queue @state))
         (swap! state transmit))
       (if (a/alt!
             (:rx-chan @state) ([v] (if v (handle-rx-pkt state (- (current-time) t) v) false))


Remove throw

Remove throw

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -184,15 +184,13 @@
                  {:status 500
                   :body (format "Internal Server Error: %s" (pr-str data))})))

-        (d/catch #(do
-                    (throw %)
-                    (identity {:status 500 :body
-                                 (html
-                                  [:body
-                                   [:h1 "Internal Server Error"]
-                                   [:p (str %)]
-                                   [:h2 "Swagger op"]
-                                   [:pre (with-out-str (clojure.pprint/pprint swagger-op))]])})))))))
+        (d/catch #(identity {:status 500 :body
+                             (html
+                              [:body
+                               [:h1 "Internal Server Error"]
+                               [:p (str %)]
+                               [:h2 "Swagger op"]
+                               [:pre (with-out-str (clojure.pprint/pprint swagger-op))]])}))))))

 ;; TODO: pets should return resource-metadata with a (possibly deferred) model


add TODO

add TODO

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1,3 +1,4 @@
+;; TODO: nouns do not need {:essere false}
 (ns babel.italiano.lexicon
   (:refer-clojure :exclude [get-in merge])
   (:require


fix vivere

fix vivere

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -2056,15 +2056,16 @@

    "vivere"
    [{:synsem {:cat :verb
-             :sem {:pred :live}}
-    :italiano {:passato "vissuto"
-               :future-stem "vivr"
-               :essere true}}
+              :sem {:pred :live}
+              :essere true}
+     :italiano {:passato "vissuto"
+                :future-stem "vivr"}}
+
     {:synsem {:cat :verb
-             :sem {:pred :live}}
-    :italiano {:passato "vissuto"
-               :future-stem "vivr"
-               :essere false}}]
+              :sem {:pred :live}
+              :essere true}
+     :italiano {:passato "vissuto"
+                :future-stem "vivr"}}]

    "voi"
    [{:synsem {:cat cat-of-pronoun


group rules by :cat = {:noun,:verb,:prep}

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -104,6 +104,7 @@

       exception-generator2 ;; add new keys to the map for all exceptions found.

+      ;; <noun default rules>
       (default ;; a noun by default is neither a pronoun nor a propernoun.
        {:synsem {:cat :noun
                  :pronoun false
@@ -146,7 +147,23 @@
                    :case case}
           :italiano {:cat cat
                      :case case}}))
-
+
+      (default ;; determiner-noun agreement
+       (unify {:synsem {:cat :noun
+                        :pronoun false
+                        :propernoun false
+                        :subcat {:1 {:cat :det}
+                                 :2 '()}}}
+              (let [agr (atom :top)
+                    cat (atom :top)]
+                {:italiano {:agr agr
+                            :cat cat}
+                 :synsem {:cat cat
+                          :agr agr
+                          :subcat {:1 {:agr agr}}}})))
+      ;; </noun default rules>
+
+      ;; <verb default rules>
       (default ;; a verb's first argument's case is nominative.
        {:synsem {:cat :verb
                  :subcat {:1 {:cat :noun
@@ -156,7 +173,7 @@
        {:synsem {:cat :verb
                  :subcat {:2 {:cat :noun
                               :case :acc}}}})
-
+
       (default ;;  a verb's first argument defaults to the semantic subject of the verb.
        (let [subject-semantics (atom :top)]
          {:synsem {:cat :verb
@@ -190,20 +207,38 @@
                  :subcat {:1 {:top :top}
                           :2 {:top :top}
                           :3 '()}}})
-
-      (default ;;  a preposition's first argument defaults to the semantic object of preposition.
+
+      (default ;; a verb agrees with its first argument
+       (let [subject-agreement (atom :top)]
+         {:synsem {:cat :verb
+                   :subcat {:1 {:agr subject-agreement}}
+                   :agr subject-agreement}}))
+
+      (default ;; aux defaults to false.
+       {:synsem {:cat :verb
+                 :aux false}})
+
+      (default ;; essere defaults to false.
+       {:synsem {:cat :verb
+                 :essere false}})
+
+      (default ;; reflexive defaults to false.
+       {:synsem {:cat :verb
+                 :aux false
+                 :sem {:reflexive false}}})
+
+      ;; </verb default rules>
+
+      ;; <preposition default rules>
+      (default ;;  a preposition's semantic object defaults to its first argument.
        (let [object-semantics (atom :top)]
          {:synsem {:cat :prep
                    :subcat {:1 {:cat :noun
                                 :sem object-semantics}}
                    :sem {:obj object-semantics}}}))
-
-      (default ;; a verb agrees with its first argument
-       (let [subject-agreement (atom :top)]
-         {:synsem {:cat :verb
-                   :subcat {:1 {:agr subject-agreement}}
-                   :agr subject-agreement}}))
-
+      ;; </preposition default rules>
+
+      ;; <category-independent>
       (default ;; morphology looks in :italiano, so share relevant grammatical pieces of
        ;; info (:agr, :cat, :infl, and :essere) there so it can see them.
        (let [agr (atom :top)
@@ -218,34 +253,7 @@
                    :cat cat
                    :essere essere
                    :infl infl}}))
-
-
-      (default ;; aux defaults to false.
-       {:synsem {:cat :verb
-                 :aux false}})
-
-      (default ;; essere defaults to false.
-       {:synsem {:cat :verb
-                 :essere false}})
-
-      (default ;; reflexive defaults to false.
-       {:synsem {:cat :verb
-                 :aux false
-                 :sem {:reflexive false}}})
-
-      (default ;; noun agreement
-       (unify {:synsem {:cat :noun
-                        :pronoun false
-                        :propernoun false
-                        :subcat {:1 {:cat :det}
-                                 :2 '()}}}
-              (let [agr (atom :top)
-                    cat (atom :top)]
-                {:italiano {:agr agr
-                            :cat cat}
-                 :synsem {:cat cat
-                          :agr agr
-                          :subcat {:1 {:agr agr}}}})))
+      ;; </category-independent>

       phonize2 ;; for each value v of each key k, set the [:italiano :italiano] of v to k, if not already set
       ;; e.g. by exception-generator2.
@@ -261,7 +269,7 @@
                      (= :none (get-in % [:synsem :agr :gender] :none))
                      (= false (get-in % [:synsem :propernoun] false))
                      (= false (get-in % [:synsem :pronoun] false))))
-           (and (log/warn (str "ignoring lexical entry with :cat=:noun but no gender specified: " %))
+           (and (log/warn (str "ignoring common noun with no gender specified: " %))
                 false)))

      ;; filter out entries with no :cat.


clean up of API namespace code

clean up of API namespace code

--- src/datasplash/api.clj
+++ src/datasplash/api.clj
@@ -6,16 +6,22 @@
              [core :as dt]
              [bq :as bq]]))

-(def make-transit-coder dt/make-transit-coder)
-(def generate-input dt/generate-input)
+;;;;;;;;;;;;
+;; Coders ;;
+;;;;;;;;;;;;
+
+(def make-nippy-coder dt/make-transit-coder)
+
+;;;;;;;;;;;;;;;
+;; Operators ;;
+;;;;;;;;;;;;;;;
+
 (def view dt/view)
 (def pardo dt/pardo)
 (def identity dt/didentity)
 (def map dt/dmap)
 (def filter dt/dfilter)
 (def mapcat dt/dmapcat)
-(def to-edn dt/to-edn)
-(def from-edn dt/from-edn)
 (def with-keys dt/with-keys)
 (def group-by-key dt/group-by-key)
 (def group-by dt/dgroup-by)
@@ -31,6 +37,11 @@
 (def combine-by dt/combine-by)
 (def combine-fn dt/combine-fn)
 (def juxt dt/djuxt)
+
+;;;;;;;;;;;;;;;;;
+;; Combinators ;;
+;;;;;;;;;;;;;;;;;
+
 (def sum dt/sum)
 (def max dt/dmax)
 (def min dt/dmin)
@@ -44,3 +55,11 @@
 (def read-edn-file dt/read-edn-file)
 (def write-text-file dt/write-text-file)
 (def write-edn-file dt/write-edn-file)
+(def generate-input dt/generate-input)
+
+;;;;;;;;;;;;;
+;; Formats ;;
+;;;;;;;;;;;;;
+
+(def to-edn dt/to-edn)
+(def from-edn dt/from-edn)


Cleaning up logic/demographics

Cleaning up logic/demographics

--- src/civs/logic/demographics.clj
+++ src/civs/logic/demographics.clj
@@ -8,7 +8,6 @@
     [civs.logic.globals :refer :all])
   (:import [civs.model.core Population Tribe]))

-(import '(java.util Random))
 (import '(com.github.lands Biome))

 (require '[civs.model.core :as model])
@@ -163,7 +162,6 @@
     (check-in-range res 0.975 1.025 (str "Prosperity humidity modifier for " biome " at " humidity " : " res))
     res))

-
 (defn prosperity-temperature-multiplier-at [world pos]
   (let [biome (biome-at world pos)
         temperature (temperature-at world pos)]
@@ -342,7 +340,7 @@
     (Population. new-children new-young-men new-young-women new-old-men new-old-women)))

 (defn update-tribe-population
-  "TODO this sum the various deltas to the tribe population"
+  "this sum the various deltas to the tribe population"
   [tribe deltas]
   (let [new-population (reduce sum-population (.population tribe) deltas)]
     (assoc tribe :population new-population)))


Renamed some vars in mask

Renamed some vars in mask

--- src/clj/forma/trends/filter.clj
+++ src/clj/forma/trends/filter.clj
@@ -32,7 +32,6 @@
     (deseasonalize 23 (s/sample-uniform 200))"
   [freq ts]
   {:pre [(>= (count ts) freq)
-         (when nil? ts)
          (< 1 freq)]}
   (let [x (dummy-mat freq (i/nrow ts))
           xt (i/trans x)
@@ -138,15 +137,15 @@
                  (- right left))))

 (defn mask
-  "Apply `pred` to `coll1` to create a mask over `coll2`, returning a vector of
-   valid values and nils. If a value in `coll1` passes `pred`, the value in the
-   corresponding location in `coll2` will be included in the output vector.
+  "Apply `pred` to `coll-a` to create a mask over `coll-b`, returning a vector of
+   valid values and nils. If a value in `coll-a` passes `pred`, the value in the
+   corresponding location in `coll-b` will be included in the output vector.
    Otherwise, that location will be set to `nil`."
-  [pred coll1 coll2]
-  {:pre [(= (count coll1) (count coll2))]}
+  [pred coll-a coll-b]
+  {:pre [(= (count coll-a) (count coll-b))]}
   (map #(when-not (pred %2) %1)
-       coll2
-       coll1))
+       coll-b
+       coll-a))

 (defn replace-index-set
   "replace values in `coll` with `new-val` for all indices in


Improve splitting sentences

Improve splitting sentences

--- src/cljs/db_quiz/normalize.cljs
+++ src/cljs/db_quiz/normalize.cljs
@@ -271,7 +271,7 @@
                       (if (> (count a) maximum-length)
                           a
                           (str a ". " b)))
-                    (split description #"\.\s+"))
+                    (split description #"\.\s+(?=[A-ZÁČĎÉÍŇÓŘŠŤÚŽ])"))
             :else description)
       description)))


Combines play and pause buttons. Moves play to the same row as clear.

--- src/cljs/game_of_life/core.cljs
+++ src/cljs/game_of_life/core.cljs
@@ -188,8 +188,7 @@
                                     [0 0 0 1 1 1]
                                     [0 0 0 1 1 1]] rows columns))

-(defonce queenbee (utils/expand-to [
-                                    [0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0]
+(defonce queenbee (utils/expand-to [[0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0]
                                     [0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0]
                                     [0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1]
                                     [1 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1]
@@ -210,10 +209,6 @@
                                    [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0]]
                                   rows columns))

-
-
-
-
 ;; -------------------------
 ;; View

@@ -223,24 +218,36 @@
             :on-mouse-out #(set-preview nil)
             :class "small-btn blue"} name])

+(defn play-button []
+  (let [running? (not (nil? (:timer @app-state)))
+        play-pause! #(if running?
+                      (stop-game!)
+                      (start-game!))
+        class (if running?
+                "full-btn red"
+                "full-btn green")
+        name (if running?
+                "PAUSE"
+                "PLAY")]
+     [:div
+      [:button {:on-click play-pause!
+                :class class} name]]))
+
+(defn clear-button []
+  [:div
+      [:button {:on-click #(reset-board!)
+                :class "full-btn dark-gray"} "CLEAR"]])
+
 (defn game-of-life []
   [:div {:style {:margin "0px 0px 0px 0px"}}
    [:div [:h3 "Game of life"]
     [game-of-life-board]]

-   (let [running? (not (nil? (:timer @app-state)))]
-     [:div
-      [:div {:class "half-size"}
-       [:button {:on-click #(start-game!)
-                 :disabled running?
-                 :class "full-btn green"} "PLAY"]]
-      [:div {:class "half-size"}
-       [:button {:on-click #(stop-game!)
-                 :disabled (not running?)
-                 :class "full-btn red"} "PAUSE"]]])
    [:div
-    [:button {:on-click #(reset-board!)
-              :class "full-btn dark-gray"} "CLEAR"]]
+    [:div {:class "half-size"}
+     [play-button]]
+    [:div {:class "half-size"}
+     [clear-button]]]

    [:div
     [:h5 "space ships"]


Append ? to all boolean options

Append ? to all boolean options

--- src/com/hypirion/clj_xchart.clj
+++ src/com/hypirion/clj_xchart.clj
@@ -120,7 +120,7 @@
 (defn- set-legend!
   [^Styler styler
    {:keys [background-color border-color font padding
-           position series-line-length visible]}]
+           position series-line-length visible?]}]
   (doto-cond
    styler
    background-color (.setLegendBackgroundColor (colors background-color background-color))
@@ -129,20 +129,22 @@
    padding (.setLegendPadding (int padding))
    position (.setLegendPosition (legend-positions position))
    series-line-length (.setLegendSeriesLineLength (int series-line-length))
-   (not (nil? visible)) (.setLegendVisible visible)))
+   (not (nil? visible?)) (.setLegendVisible (boolean visible?))))

 (defn- set-chart-title-style!
   [^Styler styler
-   {:keys [box-background-color box-border-color box-visible
-           font padding visible]}]
-  (doto-cond
-   styler
-   box-background-color (.setChartTitleBoxBackgroundColor (colors box-background-color box-background-color))
-   box-border-color (.setChartTitleBoxBorderColor (colors box-border-color box-border-color))
-   (not (nil? box-visible)) (.setChartTitleBoxVisible (boolean box-visible))
-   font (.setChartTitleFont font)
-   padding (.setChartTitlePadding (int padding))
-   visible (.setChartTitleVisible visible)))
+   {:keys [box font padding visible?]}]
+  (let [{box-background-color :background-color
+         box-border-color :color
+         box-visible? :visible?} box]
+    (doto-cond
+     styler
+     box-background-color (.setChartTitleBoxBackgroundColor (colors box-background-color box-background-color))
+     box-border-color (.setChartTitleBoxBorderColor (colors box-border-color box-border-color))
+     (not (nil? box-visible?)) (.setChartTitleBoxVisible (boolean box-visible?))
+     font (.setChartTitleFont font)
+     padding (.setChartTitlePadding (int padding))
+     (not (nil? visible?)) (.setChartTitleVisible (boolean visible?)))))

 (defn- set-chart-style!
   [^Styler styler
@@ -156,12 +158,12 @@

 (defn- set-plot-style!
   [^Styler styler
-   {:keys [background-color border-color border-visible content-size]}]
+   {:keys [background-color border-color border-visible? content-size]}]
   (doto-cond
    styler
    background-color (.setPlotBackgroundColor (colors background-color background-color))
    border-color (.setPlotBorderColor (colors border-color border-color))
-   (not (nil? border-visible)) (.setPlotBorderVisible (boolean border-visible))
+   (not (nil? border-visible?)) (.setPlotBorderVisible (boolean border-visible?))
    content-size (.setPlotContentSize (double content-size))))

 (defn- set-series-style!
@@ -199,37 +201,37 @@

 (defn- set-axis-ticks!
   [^AxesChartStyler styler
-   {:keys [labels marks padding visible line-visible]}]
+   {:keys [labels marks padding visible? line-visible?]}]
   (let [{:keys [color font]} labels]
     (doto-cond
      styler
      color (.setAxisTickLabelsColor (colors color color))
      font (.setAxisTickLabelsFont font)))
-  (let [{:keys [length color stroke visible]} marks]
+  (let [{:keys [length color stroke visible?]} marks]
     (doto-cond
      styler
      length (.setAxisTickMarkLength (int length))
      color (.setAxisTickMarksColor (colors color color))
      stroke (.setAxisTickMarksStroke stroke)
-     (not (nil? visible)) (.setAxisTicksMarksVisible (boolean visible))))
+     (not (nil? visible?)) (.setAxisTicksMarksVisible (boolean visible?))))
   (doto-cond
    styler
    padding (.setAxisTickPadding (int padding))
-   (not (nil? line-visible)) (.setAxisTicksLineVisible (boolean line-visible))
-   (not (nil? visible)) (.setAxisTicksVisible (boolean visible))))
+   (not (nil? line-visible?)) (.setAxisTicksLineVisible (boolean line-visible?))
+   (not (nil? visible?)) (.setAxisTicksVisible (boolean visible?))))

 (defn- set-axis-title!
   [^AxesChartStyler styler
-   {:keys [font visible padding]}]
+   {:keys [font visible? padding]}]
   (doto-cond
    styler
    font (.setAxisTitleFont font)
    padding (.setAxisTitlePadding (int padding))
-   (not (nil? visible)) (.setAxisTitleVisible (boolean visible))))
+   (not (nil? visible?)) (.setAxisTitleVisible (boolean visible?))))

 (defn- set-axis-plot!
   [^AxesChartStyler styler
-   {:keys [grid-lines margin tick-marks]}]
+   {:keys [grid-lines margin tick-marks?]}]
   (let [{:keys [horizontal? vertical? visible? color stroke]} grid-lines]
     (doto-cond
      styler
@@ -241,7 +243,7 @@
   (doto-cond
    styler
    margin (.setPlotMargin (int margin))
-   (not (nil? tick-marks)) (.setPlotTicksMarksVisible (boolean tick-marks))))
+   (not (nil? tick-marks?)) (.setPlotTicksMarksVisible (boolean tick-marks?))))

 (defn- set-x-axis-style!
   [^AxesChartStyler styler
@@ -319,7 +321,7 @@
     (let [{:keys [x y error-bars style]} data
           {:keys [marker-color marker-type
                   line-color line-style line-width
-                  fill-color show-in-legend]} style]
+                  fill-color show-in-legend?]} style]
       (doto-cond
        (if error-bars
          (add-raw-series chart s-name x y error-bars)
@@ -330,7 +332,7 @@
        line-style (.setLineStyle line-style)
        line-width (.setLineWidth (float line-width))
        fill-color (.setFillColor (colors fill-color fill-color))
-       (not (nil? show-in-legend)) (.setShowInLegend (boolean show-in-legend))))))
+       (not (nil? show-in-legend?)) (.setShowInLegend (boolean show-in-legend?))))))

 ;; TODO: Add in font as a shortcut to set all fonts not yet set.

@@ -394,14 +396,14 @@
     (let [{:keys [x y bubble style]} data
           {:keys [marker-color marker-type
                   line-color line-style line-width
-                  fill-color show-in-legend]} style]
+                  fill-color show-in-legend?]} style]
       (doto-cond
        (add-raw-series chart s-name x y bubble)
        line-color (.setLineColor (colors line-color line-color))
        line-style (.setLineStyle line-style)
        line-width (.setLineWidth (float line-width))
        fill-color (.setFillColor (colors fill-color fill-color))
-       (not (nil? show-in-legend)) (.setShowInLegend (boolean show-in-legend))))))
+       (not (nil? show-in-legend?)) (.setShowInLegend (boolean show-in-legend?))))))

 (defn bubble-chart
   "Returns a bubble chart"
@@ -433,8 +435,8 @@
   ([series]
    (pie-chart series {}))
   ([series
-    {:keys [width height title circular theme render-style annotation-distance
-            start-angle draw-all-annotations donut-thickness annotation-type]
+    {:keys [width height title circular? theme render-style annotation-distance
+            start-angle draw-all-annotations? donut-thickness annotation-type]
      :or {width 640 height 500}
      :as styling}]
    {:pre [series]}
@@ -445,8 +447,8 @@
       (.getStyler chart)
       theme (.setTheme (themes theme theme))
       render-style (.setDefaultSeriesRenderStyle (pie-render-styles render-style))
-      (not (nil? circular)) (.setCircular (boolean circular))
-      (not (nil? draw-all-annotations)) (.setDrawAllAnnotations (boolean draw-all-annotations))
+      (not (nil? circular?)) (.setCircular (boolean circular?))
+      (not (nil? draw-all-annotations?)) (.setDrawAllAnnotations (boolean draw-all-annotations?))
       annotation-distance (.setAnnotationDistance (double annotation-distance))
       donut-thickness (.setDonutThickness (double donut-thickness))
       start-angle (.setStartAngleInDegrees (double start-angle))


Create base path if it doesn't exist

Create base path if it doesn't exist

--- src/com/okl/tokenmgr/tokens.clj
+++ src/com/okl/tokenmgr/tokens.clj
@@ -98,6 +98,9 @@

 (defn get-apps [path]
   "get all of the applications after a particular path"
+
+  (if-not (.get-item storage base-path)
+    (.create storage base-path "" ""))
   (let [full-path (path->full-path path)]
   (map
    #(hash-map :name (subs (get % :name) (inc (count base-path)))


Retrieving a random article from the UI

Retrieving a random article from the UI

--- src-cljs/tropology/core.cljs
+++ src-cljs/tropology/core.cljs
@@ -206,15 +206,12 @@
   (let [current-article (re-frame/subscribe [:article-data :current-article])]
     (fn []
       [:span
-       ; TODO Max size for the image
        [:img {:class "profile-image img-responsive pull-left" :src (:image @current-article) :alt (:title @current-article)}]
        [:div {:class "profile-content"}
         [:h1 {:class "name"} (:title @current-article)]
         [:p (:description @current-article)]]
-       ; TODO: Create as a button
-       [:a {:class "btn btn-cta-primary pull-right"}
-        [:i {:class "fa fa-paper-plane"}]
-        "Random Article"]]
+       [button-item "Random Article" "btn-cta-primary pull-right" [:load-article ""] false [:i {:class "fa fa-paper-plane"}]]
+       ]
       )))

 (defn reference-display []