add raw-html storage

add raw-html storage

--- src/clj/ceres/collector.clj
+++ src/clj/ceres/collector.clj
@@ -89,7 +89,7 @@
                       {:url expanded-url
                        :content-type content-type})
                   (catch Exception e (do (error (str e))
-                                         {:url "Not available"
+                                         {:url :not-available
                                           :content-type content-type})))))
             (catch Exception e (do (error (str e))
                                    nil))))
@@ -125,9 +125,16 @@
 (defn store-article
   "Fetch html document, extract title and store them"
   [{:keys [url content-type ts] :as expanded-url}]
-  (let [raw-html url #_(if (= url "Not available") nil (slurp url))
-        html-title (fetch-url-title url) #_(if raw-html (-> (java.io.StringReader. raw-html) enlive/html-resource (enlive/select [:head :title]) first :content first)
-                       nil)]
+  (let [raw-html (if (= url "Not available") nil (slurp url))
+        html-title (if raw-html
+                     (-> (java.io.StringReader. raw-html)
+                         enlive/html-resource
+                         (enlive/select [:head :title])
+                         first
+                         :content
+                         first)
+                     nil)
+        #_(fetch-url-title url)]
     (mc/insert-and-return
      @db
      "articles"
@@ -220,7 +227,6 @@

 (defn store-mention
-  "Yeah"
   [uid pid]
   (mc/insert
    @db
@@ -237,7 +243,6 @@

 (defn store-reaction
-  "a reaction"
   [pub-id source-id]
   (mc/insert @db "reactions" {:publication pub-id :source source-id}))

@@ -252,19 +257,48 @@
     hid
     (:_id (store-hashtag text))))

+
+(defn store-raw-html
+  "Fetch html document and store raw binary in database"
+  [{:keys [url content-type ts] :as expanded-url} url-id]
+  (let [raw-html (if (= url :not-available)
+                   nil
+                   (slurp url))
+        html-title (if raw-html
+                     (-> (java.io.StringReader. raw-html)
+                         enlive/html-resource
+                         (enlive/select [:head :title])
+                         first
+                         :content
+                         first)
+                     :not-available)]
+    (mc/insert-and-return
+     @db
+     "htmls"
+     {:raw raw-html
+      :url url-id})))
+
+
 (defn get-url-id
   "Get url id if exists otherwise store url"
-  [url uid tid ts]
+  [url uid tid ts source?]
   (if-let [url-id (:_id (mc/find-one-as-map @db "urls" {:url url}))]
     url-id
-    (if-let [expanded-url (:url (expand-url url))]
-      (if-let [x-url-id (:_id (mc/find-one-as-map @db "urls" {:url expanded-url}))]
+    (if-let [expanded-url (expand-url url)]
+      (if-let [x-url-id (:_id (mc/find-one-as-map @db "urls" {:url (:url expanded-url)}))]
         x-url-id
-        (:_id (store-url expanded-url uid tid ts)))
+        (if source?
+          (let [new-url-id (:_id (store-url (:url expanded-url) uid tid ts))]
+            (do
+              (store-raw-html expanded-url new-url-id)
+              new-url-id))
+          nil))
       nil)))

-(defn get-type [{:keys [in_reply_to_status_id retweeted_status entities]}]
+(defn get-type
+  "Dispatches tweet type"
+  [{:keys [in_reply_to_status_id retweeted_status entities]}]
   (if in_reply_to_status_id
     :reply
     (if retweeted_status
@@ -286,19 +320,24 @@
       (store-reaction pub-id source-pub-id))))

-(defn store-raw-tweet [status]
+(defn store-raw-tweet
+  "Basic status pipeline"
+  [status]
   (let [oid (ObjectId.)
         doc (update-in status [:created_at] (fn [x] (f/parse custom-formatter x)))
         {:keys [user entities retweeted_status in_reply_to_status_id created_at _id]
          :as record} (from-db-object (mc/insert-and-return @db "tweets" (merge doc {:_id oid})) true)
         uid (get-user-id status)
         hids (doall (map (fn [{:keys [text]}] (get-hashtag-id text)) (:hashtags entities)))
-        type (get-type status)]
+        type (get-type status)
+        source? (news-accounts (:screen_name user))]
     (case type
       :retweet (do (store-simple-reaction uid _id :retweet hids created_at (:id retweeted_status)))
       :reply (do (store-simple-reaction uid _id :reply hids created_at in_reply_to_status_id))
-      :source-or-share (let [url-ids (doall (map #(get-url-id (:expanded_url %) uid _id created_at) (:urls entities)))]
-                         (if (news-accounts (:screen_name user))
+      :source-or-share (let [url-ids (doall (map
+                                             #(get-url-id (:expanded_url %) uid _id created_at source?)
+                                             (:urls entities)))]
+                         (if source?
                            (store-publication uid _id (first url-ids) :source hids created_at)
                            (let [source-pub-id (or (doall (map #(:_id (mc/find-one-as-map @db "publications" {:url %})) url-ids)))
                                  pub-id (:_id (store-publication uid _id nil :share hids created_at))]
@@ -306,286 +345,3 @@
                                (store-reaction pub-id source-pub-id)))))
       :unrelated (store-publication uid _id nil :unrelated hids created_at))
     record))
-
-
-(comment
-
-  ;; export users
-  (time
-   (letfn [(user-exists? [{{:keys [id]} :user}] (mc/find-one @db "users" {:id id}))]
-     (let [tweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 8 1)
-                                                           $lt (t/date-time 2014 9 1)}})]
-       (doall
-        (for [tweet tweets]
-          (when-not (user-exists? tweet)
-            (store-user tweet)))))))
-
-
-
-
-  ;; export urls
-  (time
-   (do
-     (println "Export-urls")
-     (let [origins (mc/find-maps @db "origins" {:source {$ne nil}
-                                                :ts {$gt (t/date-time 2014 8 1)
-                                                     $lt (t/date-time 2014 9 1)}})]
-       (doall
-        (map
-         (fn [{:keys [article tweet ts source]}]
-           (let [uid (:_id (mc/find-one-as-map @db "users" {:screen_name source}))
-                 url (if article
-                       (:url (mc/find-map-by-id @db "articles" article))
-                       nil)]
-             (if url
-               (store-url url uid tweet ts)
-               :unknown)))
-         origins)))))
-
-
-  ;; export un-parsed urls
-  (letfn [(expand-urls [{{:keys [urls]} :entities}]
-            (pmap :expanded_url urls))]
-    (let [tweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 7 1)
-                                                          $lt (t/date-time 2014 7 29)}
-                                             :entities.urls {$ne []}
-                                             :user.screen_name {$in news-accounts}})]
-      (time
-       (doall
-        (pmap
-         (fn [tweet]
-           (let [urls (expand-urls tweet)
-                 uid (:_id (mc/find-one-as-map @db "users" {:screen_name (-> tweet :user :screen_name)}))]
-             (pmap
-              #(store-tmp-url % uid (:_id tweet) (:created_at tweet))
-              urls)))
-         tweets)))))
-
-
-  (letfn [(get-url-id [{{urls :urls} :entities}]
-            (if-not (empty? urls)
-              (:_id (mc/find-one-as-map @db "url" {:url (-> urls first :url expand-url :url)}))
-              nil))
-          (get-uid [{{id :id} :user}]
-            (:_id (mc/find-one-as-map @db "users" {:id id})))
-          (dispatch-tweet [{:keys [retweeted_status in_reply_to_status_id]}]
-            (if in_reply_to_status_id
-              :reply
-              (if retweeted_status
-                :retweet
-                nil)))
-          (get-type [tweet url-id]
-            (if-let [ttype (dispatch-tweet tweet)]
-              ttype
-              (if url-id
-                (if (news-accounts (-> tweet :user :screen_name))
-                  :source
-                  :share)
-                :unknown)))]
-    (let [tweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 7 1)
-                                                          $lt (t/date-time 2014 7 7)}
-                                             :user.screen_name {$in news-accounts}
-                                             :retweeted_status.id_str nil
-                                             :in_reply_to_user_id nil
-                                             :entities.urls {$ne []}})]
-      (time
-       (aprint
-        (->> tweets
-             (take 10)
-             (pmap get-url-id)
-             #_(pmap #(let [url-id (get-url-id %)]
-                        (store-publication (get-uid %)
-                                         (:_id %)
-                                         url-id
-                                         (get-type % url-id)
-                                         (:created_at %)))))))))
-
-
-
-  ;; export tmp urls
-  (letfn [(x-url [url]
-            (let [expanded-url (-> url :url expand-url :url)]
-              (if expanded-url
-                expanded-url
-                url)))]
-    (time
-     (do
-       (println "Export tmp urls")
-       (doall
-        (->> (mc/find-maps @db "tmpurls")
-             (pmap (fn [{:keys [user tweet ts] :as url}]
-                     (store-url (x-url url) user tweet ts))))))))
-
-
-  ;; export all hashtags
-  (letfn [(extract-hashtags [{{:keys [hashtags]} :entities}]
-            (pmap :text hashtags))]
-    (let [tweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 8 1)
-                                                          $lt (t/date-time 2014 9 1)}
-                                             :entities.hashtags {$ne []}})]
-      (time
-       (doall
-        (->> tweets
-             (pmap extract-hashtags)
-             flatten
-             (remove nil?)
-             (into #{})
-             (pmap store-hashtag))))))
-
-  ;; export news publications
-  (letfn [(dispatch-type [{:keys [in_reply_to_status_id retweeted_status entities]}]
-            (if in_reply_to_status_id
-              :reply
-              (if retweeted_status
-                :retweet
-                (if-not (empty? (:urls entities))
-                  :source-or-share
-                  :unrelated))))
-          (transact-publications [{:keys [user _id entities created_at] :as tweet}]
-            (let [uid (:_id (mc/find-one-as-map @db "users" {:id (:id user)}))
-                  url-id (if-not (empty? (:urls entities))
-                           (:_id (mc/find-one-as-map @db "urls" (:tweet _id)))
-                           nil)
-                  hids (if-not (empty? (:hashtags entities))
-                         (->> (:hashtags entities)
-                              (pmap #(:_id (mc/find-one-as-map @db "hashtags" {:text (:text %)})))
-                              (into #{})
-                              vec)
-                         nil)
-                  t-type (dispatch-type tweet)]
-              (store-publication uid _id url-id t-type hids created_at)))]
-    (let [tweets (mc/find-maps @db "tweets"
-                               {:created_at {$gt (t/date-time 2014 8 1)
-                                             $lt (t/date-time 2014 9 1)}
-                                :user.screen_name {$in news-accounts}})]
-      (time
-       (doall
-        (pmap transact-publications tweets)))))
-
-  ;; export retweets
-  (letfn [(transact-publications [{:keys [user _id created_at entities id_str retweeted_status] :as tweet}]
-            (let [uid (:_id (mc/find-one-as-map @db "users" {:id (:id user)}))
-                  hids (if-not (empty? (:hashtags entities))
-                         (->> (:hashtags entities)
-                              (pmap #(:_id (mc/find-one-as-map @db "hashtags" {:text (:text %)})))
-                              (into #{})
-                              vec)
-                         nil)]
-              (store-publication uid _id nil :retweet hids created_at)))]
-    (let [retweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 8 1)
-                                                            $lt (t/date-time 2014 9 1)}
-                                               :retweeted_status {$ne nil}
-                                               :user.screen_name {$nin news-accounts}})]
-      (time (doall (pmap transact-publications retweets)))))
-
-
-
-  ;; export replies
-  (letfn [(transact-publications [{:keys [user _id created_at entities id_str in_reply_to_status_id_str] :as tweet}]
-            (let [uid (:_id (mc/find-one-as-map @db "users" {:id (:id user)}))
-                  hids (if-not (empty? (:hashtags entities))
-                         (->> (:hashtags entities)
-                              (pmap #(:_id (mc/find-one-as-map @db "hashtags" {:text (:text %)})))
-                              (into #{})
-                              vec)
-                         nil)]
-              (store-publication uid _id nil :reply hids created_at)))]
-    (let [retweets (mc/find-maps @db "tweets" {:created_at {$gt (t/date-time 2014 8 1)
-                                                            $lt (t/date-time 2014 9 1)}
-                                               :in_reply_to_status_id_str {$ne nil}
-                                               :user.screen_name {$nin news-accounts}})]
-      (time (doall (pmap transact-publications retweets)))))
-
-
-
-  ;; export shares
-  (letfn [(transact-publications [{:keys [user _id created_at entities id_str in_reply_to_status_id_str] :as tweet}]
-            (let [uid (:_id (mc/find-one-as-map @db "users" {:id (:id user)}))
-                  hids (if-not (empty? (:hashtags entities))
-                         (->> (:hashtags entities)
-                              (pmap #(:_id (mc/find-one-as-map @db "hashtags" {:text (:text %)})))
-                              (into #{})
-                              vec)
-                         nil)]
-              (store-publication uid _id nil :share hids created_at)))]
-    (time
-     (doall
-      (->> (mc/find-maps @db "origins" {:source nil
-                                        :article {$ne nil}
-                                        :ts {$gt (t/date-time 2014 8 1)
-                                             $lt (t/date-time 2014 9 1)}})
-           (pmap (fn [{:keys [tweet]}] (mc/find-map-by-id @db "tweets" tweet)))
-           (pmap (fn [{:keys [in_reply_to_status_id retweeted_status] :as tweet}]
-                   (if (or in_reply_to_status_id retweeted_status)
-                     :no-share
-                     tweet)))
-           (remove #{:no-share})
-           (pmap transact-publications)))))
-
-
-
-  ;; retweet reactions
-  (time
-   (do
-     (say/say "Computation started")
-     (doall
-      (pmap (fn [{:keys [tweet _id]}]
-             (let [{{:keys [id_str]} :retweeted_status} (mc/find-map-by-id @db "tweets" tweet)
-                   {stid :_id} (mc/find-one-as-map @db "tweets" {:id_str id_str})
-                   {spid :_id} (if stid (mc/find-one-as-map @db "publications" {:tweet stid})
-                                   nil)]
-               (store-reaction _id spid)))
-           (mc/find-maps @db "publications" {:type :retweet})))
-     (say/say "Computation completed!")))
-
-
-  ;; reply reactions
-  (time
-   (do
-     (say/say "Computation started")
-     (doall
-      (pmap (fn [{:keys [tweet _id]}]
-             (let [{:keys [in_reply_to_status_id_str]} (mc/find-map-by-id @db "tweets" tweet)
-                   {stid :_id} (mc/find-one-as-map @db "tweets" {:id_str in_reply_to_status_id_str})
-                   {spid :_id} (if stid (mc/find-one-as-map @db "publications" {:tweet stid})
-                                   nil)]
-               (store-reaction _id spid)))
-           (mc/find-maps @db "publications" {:type :reply})))
-     (say/say "Computation completed")))
-
-
-  ;; share reactions
-  (time
-   (do
-     (say/say "Computation started")
-     (doall
-      (pmap
-       (fn [{:keys [tweet _id]}]
-         (let [{aid :article} (mc/find-one-as-map @db "origins" {:tweet tweet})
-               {source-tweet :tweet} (mc/find-one-as-map @db "origins" {:article aid :source {$ne nil}})]
-           (if source-tweet
-             (store-reaction _id source-tweet)
-             nil)))
-       (mc/find-maps @db "publications" {:type :share})))
-     (say/say "Computation completed")))
-
-
-  ;; store mentions
-  (time
-   (do
-     (say/say "Computation started")
-     (doall
-      (pmap
-       (fn [{:keys [_id tweet]}]
-         (let [{{:keys [user_mentions]} :entities} (mc/find-map-by-id @db "tweets" tweet)]
-           (pmap
-            (fn [{:keys [id]}]
-              (let [uid (:_id (mc/find-one-as-map @db "users" {:id id}))]
-                (if uid
-                  (store-mention uid _id)
-                  nil)))
-            user_mentions)))
-       (mc/find-maps @db "publications")))
-     (say/say "Computation completed")))
-
-)


update posh call in main view

update posh call in main view

--- src/cljs/dat/sys/views.cljs
+++ src/cljs/dat/sys/views.cljs
@@ -3,6 +3,7 @@
   (:require [dat.view]
             [posh.reagent :as posh]
             [reagent.core :as r]
+            [taoensso.timbre :as log]
             [re-com.core :as re-com]))

@@ -91,11 +92,12 @@
               [:p {:style {:font-size "18px"}} "Congrats! You've got a Datsys app running :-)"]
               ;; A debug example:
               ;[dat.view/debug "todo instance eids:" @(type-instance-eids-rx app :e.type/Todo)]
-              ;[dat.view/debug "Here's a debug example:"
-               ;@(posh/q (:conn app)
-                        ;'[:find ?e ?t-ident
-                          ;:where [?e :e/type ?t]
-                                 ;[?t :db/ident ?t-ident]])]
+              (log/info "inside the main function")
+              [dat.view/debug "Here's a debug example:"
+               @(posh/q '[:find ?e ?t-ident
+                          :where [?e :e/type ?t]
+                                 [?t :db/ident ?t-ident]]
+                        (:conn app))]
               ;; XXX TODO Get this working now...
               [todos-view app]]])


Added utility functions

Added utility functions

string-rsplit starts splitting from right of string

parent-paths and expand-paths get from a list of path names
all possible paths from root to leaf

--- src/cljs/repodoc/utils.cljs
+++ src/cljs/repodoc/utils.cljs
@@ -98,3 +98,38 @@
   equal"
   [paths]
   (sort #(apply compare (cut-vec %1 %2)) paths))
+
+(defn string-rsplit
+  "Split string from right to left
+  returning items original order"
+  [s & args]
+  (reverse
+    (map clojure.string/reverse
+         (apply clojure.string/split (clojure.string/reverse s) args))))
+
+(defn parent-paths
+  "Return a list of given path's
+  parents starting from root downward
+  /a/b/c -> [/a /a/b /a/b/c]"
+  [path]
+  (let
+    [[_ & dirs] (clojure.string/split path #"/")]
+    (reduce
+      (fn [acc p]
+        (cond
+          (nil? acc) [[p]]
+          :else (conj acc (conj (last acc) p))))
+      nil
+      dirs)))
+
+(defn expand-paths
+  "Generates a list of unique
+  paths from given paths
+  [/a/b/c /a/c /a/d] ->
+  [/a /a/b /a/b/c /a/c /a/d]"
+  [paths]
+  (distinct
+    (apply concat
+      (map
+        parent-paths
+        paths))))


Remove commented out experiments:

Remove commented out experiments:

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -311,11 +311,6 @@

 (defn faction-settings [{:as views-ctx :keys [conn dispatch translate]}]
   (with-let [faction (subs/faction-to-configure conn)
-             ;color (when @faction
-              ;       (-> @faction
-              ;           :faction/color
-              ;           name
-              ;           string/capitalize))
              selected-player-type (r/atom nil)
              hide-settings (fn [ev]
                              (when ev (.preventDefault ev))
@@ -332,7 +327,7 @@
                                  :on-hide hide-settings}
      [:> js/ReactBootstrap.Modal.Header {:close-button true}
       [:> js/ReactBootstrap.Modal.Title
-       (str "Configure Faction: " ;color)]]
+       (str "Configure Faction: "
             (when @faction
               (-> @faction
                   :faction/color


Fix comment

Fix comment

--- src/cljx/robinson/main.cljx
+++ src/cljx/robinson/main.cljx
@@ -198,7 +198,7 @@

                 {:current-state :start
                  :time 0})
-              ;TODO: read from local storage
+              ;; Read from local storage
               #+cljs
               (if-let [world @world-storage]
                 world


Moved common util method from indexer-app to common-lib.

--- src/cmr/common/concepts.clj
+++ src/cmr/common/concepts.clj
@@ -59,3 +59,8 @@
   [{:keys [concept-type sequence-number provider-id]}]
   (let [prefix (concept-type->concept-prefix concept-type)]
     (format "%s%d-%s" prefix sequence-number provider-id)))
+
+(defn concept-id->type
+  "Returns concept type for the given concept-id"
+  [concept-id]
+  (concept-prefix->concept-type (subs concept-id 0 1)))


Big speedup for hierarchy induction with large domains.

--- src/exp/sas_hierarchy_induction.clj
+++ src/exp/sas_hierarchy_induction.clj
@@ -2,7 +2,7 @@
   (:require [edu.berkeley.ai.util :as util]
             [edu.berkeley.ai.util  [graphs :as graphs] [graphviz :as gv]]
             [exp [env :as env]  [hierarchy :as hierarchy] [sas :as sas] [sas-analysis :as sas-analysis]])
-  (:import [java.util HashMap HashSet IdentityHashMap]))
+  (:import [java.util HashMap HashSet Collection IdentityHashMap]))

 ;; Attempt to do simplest thing that works for cyclic graphs.
@@ -10,6 +10,10 @@

 ;; TODO: check cyclic behavior of vv-hla, make sure it's OK.
  ; (may fail to do all deductions for new init-sets.)
+
+;; TODO: put back greedy optimization for DAG bits
+
+;; NEW here: fix to speedup new edges.

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -61,6 +65,7 @@
 ;; Memoized partial computations to speed up acylic edge generation.
 (def #^HashMap *forward-reachability-cache* nil)
 (def #^HashMap *backward-reachability-cache* nil)
+(def #^HashMap *good-edge-cache* nil) ; Map from [var, to-val] to HashSet of unused edges.

 (defn forward-reachable-nodes-and-necessary-predecessors [var-name from-val]
   (util/cache-with *forward-reachability-cache* [var-name from-val]
@@ -72,7 +77,7 @@
     (graphs/compute-reachable-nodes-and-necessary-predecessors
      (map reverse (util/safe-get *simple-dtgs* var-name)) to-val)))

-(defn get-possibly-acyclic-edges
+#_ (defn get-possibly-acyclic-edges
   "Return a list of edges, where those provably on no acyclic s-t path have been eliminated.
    Do so in polynomial time, possibly missing some always-cyclic edges."
   [var from-val to-val]
@@ -84,6 +89,48 @@
              b (backward-sets b)]
          (and f b (empty? (clojure.set/intersection f b)))))
      (util/safe-get *simple-dtgs* var))))
+
+#_ (defn get-possibly-acyclic-edges
+  "Return a list of new edges, where those provably on no acyclic s-t path have been eliminated.
+   Do so in polynomial time, possibly missing some always-cyclic edges.  Only returns new edges for
+   a particular to-val."
+  [var from-val to-val]
+  (let [forward-sets  (forward-reachable-nodes-and-necessary-predecessors var from-val)
+        backward-sets (backward-reachable-nodes-and-necessary-predecessors var to-val)]
+    (filter
+     (fn [[a b]]
+       (let [e [a b to-val]]
+         (when-not (.contains *used-edge-cache* e)
+           (let [f (forward-sets a)
+                 b (backward-sets b)]
+             (when (and f b (empty? (clojure.set/intersection f b)))
+               (.add *used-edge-cache* e)
+               true)))))
+     (util/safe-get *simple-dtgs* var))))
+
+(defn get-possibly-acyclic-edges
+  "Return a list of new edges, where those provably on no acyclic s-t path have been eliminated.
+   Do so in polynomial time, possibly missing some always-cyclic edges.  Only returns new edges for
+   a particular to-val."
+  [var from-val to-val]
+  (let [k         [var to-val]
+        cache-val #^HashSet (or (.get *good-edge-cache* k)
+                                (let [v (HashSet. #^Collection
+                                          (remove #(= (first %) to-val) (util/safe-get *simple-dtgs* var)))]
+                                  (.put *good-edge-cache* k v)
+                                  v))]
+    (when-not (empty? cache-val)
+      (let [forward-sets  (forward-reachable-nodes-and-necessary-predecessors var from-val)
+            backward-sets (backward-reachable-nodes-and-necessary-predecessors var to-val)]
+        (filter
+         (fn [[a b :as e]]
+           (when (.contains cache-val e)
+             (let [f (forward-sets a)
+                   b (backward-sets b)]
+               (when (and f b (empty? (clojure.set/intersection f b)))
+                 (.remove cache-val e)
+                 true))))
+         (util/safe-get *simple-dtgs* var))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Protocol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -227,8 +274,8 @@
         any-new? (some identity (doall (map #(add-new-vv-edge! var dst-val %) edges)))]
 ;    (when any-new? (println "adding edges" edges "for" src-val "-->" dst-val))
 ;    (gv/graphviz-el edges)
-    (when-not (or (seq edges) (= src-val dst-val))
-      (println "Warning: trying to induce impossible path from" src-val "to" dst-val))
+;    (when-not (or (seq edges) (= src-val dst-val))
+;      (println "Warning: trying to induce impossible path from" src-val "to" dst-val))
 ;    (util/assert-is (or (seq edges) (= src-val dst-val)) "%s" [src-val dst-val])
     (reset! src?-atom true)
     (when any-new?
@@ -582,6 +629,7 @@
               *hla-cache*     (HashMap.)
               *forward-reachability-cache* (HashMap.)
               *backward-reachability-cache* (HashMap.)
+              *good-edge-cache* (HashMap.)
               ]
 ;      (println "VVS"  *var-val-sets*)
       (let [goal-action (util/safe-singleton (get-in *extended-dtgs* [sas/goal-var-name sas/goal-false-val sas/goal-true-val]))


Rework HTML of account page, add send button

--- src/freecoin/views/account_page.clj
+++ src/freecoin/views/account_page.clj
@@ -30,26 +30,31 @@
             [freecoin.routes :as routes]))

 (defn render-wallet [wallet]
-  [:li {:style "margin: 1em"}
-   [:div {:class "card pull-left"}
-    [:span (str "name: " (:name wallet))]
-    [:br]
-    [:span (str "email: " (:email wallet))]
-    [:br]
-    [:span {:class "qrcode pull-left"}
-     [:img {:src (routes/path :qrcode :uid (:uid wallet))}]]
-    [:span {:class "gravatar pull-right"}
-     [:img {:src (clavatar/gravatar (:email wallet) :size 87 :default :mm)}]]]])
+  (let [email (:email wallet)]
+    [:div {:class "wallet-details"}
+     [:div {:class "card"}
+      [:span (str "Name: " (:name wallet))]
+      [:br]
+      [:span (str "Email: ") [:a {:href (str "mailto:" email)} email]]
+      [:br]
+      [:span {:class "qrcode pull-left"}
+       [:img {:src (routes/path :qrcode :uid (:uid wallet))}]]
+      [:span {:class "gravatar pull-right"}
+       [:img {:src (clavatar/gravatar (:email wallet) :size 87 :default :mm)}]]
+      [:div {:class "clearfix"}]]]))

 (defn build [context]
   (let [wallet (:wallet context)
         balance (:balance context)]
     {:body-class "func--account-page--body"
+     :title "Welcome to Freecoin"
      :body [:div
-            [:ul {:style "list-style-type: none;"}
-             (render-wallet wallet)]
-            [:div {:class "balance pull-left"}
+            (render-wallet wallet)
+            [:div {:class "balance"}
              (str "Balance: ")
              [:span {:class "func--account-page--balance"}
-              balance]]]
-     :title "Welcome to freecoin"}))
+              balance]]
+            [:div
+             [:a {:class "btn btn-primary" :href (routes/path :get-transaction-form)}
+              (str "Send currency")]]]
+     }))


Set reason code only when a task fails

Set reason code only when a task fails

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -240,7 +240,7 @@
                (transact-with-retries conn
                                       (concat
                                         [[:instance/update-state instance instance-status]]
-                                        (when (and (not previous-reason) reason)
+                                        (when (and (#{:instance.status/failed} instance-status) (not previous-reason) reason)
                                           [[:db/add instance :instance/reason-code (mesos-reason->cook-reason-code reason)]])
                                         (when (#{:instance.status/success
                                                  :instance.status/failed} instance-status)


remove add-images-changed-watch

remove add-images-changed-watch

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

--- plugins/SlideExplorer2/src/slide_explorer/cache.clj
+++ plugins/SlideExplorer2/src/slide_explorer/cache.clj
@@ -91,9 +91,9 @@

 (defn get-image
   "Get the image located at key. If image is in memory, will return it. If image
-   is not in memory, nil will be returned, but the image will be added to
-   the map asynchronously so that the next get-image request will return the image
-   in memory."
+   is not in memory, nil will be returned, but the image will be read from file and
+   added to the map asynchronously so that a future get-image request will return
+   the image in memory."
   [cache-agent key]
   (if-let [mem-val (clojure.core/get @cache-agent key)]
     (do (send-off cache-agent hit-item key)
@@ -108,13 +108,6 @@
   [cache-agent key]
   (or (not (nil? (@cache-agent key)))
       (.exists (File. (key-map-to-file-name cache-agent key)))))
-
-(defn add-images-changed-watch
-  "Adds a watch that is only triggered when images have changed."
-  [cache-agent key fun]
-  (add-watch cache-agent key (fn [key reference old new]
-                               (when (not= old new)
-                                 (fun key reference old new)))))

 (defn image-cache
   "Creates an image cache that uses a LRU policy to store memory-cache-size


Fix typo in Generic SQL features implementation :unamused:

--- src/metabase/driver/generic_sql.clj
+++ src/metabase/driver/generic_sql.clj
@@ -70,6 +70,7 @@
    :apply-page          (resolve 'metabase.driver.generic-sql.query-processor/apply-page)
    :current-datetime-fn (constantly (k/sqlfn* :NOW))
    :excluded-schemas    (constantly nil)
+   :set-timezone-sql    (constantly nil)
    :stddev-fn           (constantly :STDDEV)})

@@ -185,7 +186,7 @@
 (defn features [driver]
   (set (cond-> [:foreign-keys
                 :standard-deviation-aggregations]
-         (:set-timezone-sql driver) (conj :set-timezone))))
+         (set-timezone-sql driver) (conj :set-timezone))))

 (defn IDriverSQLDefaultsMixin
   "Default implementations of methods in `IDriver` for SQL drivers."


explain what the credit is for

explain what the credit is for

--- src-cljs/frontend/components/plan.cljs
+++ src-cljs/frontend/components/plan.cljs
@@ -331,7 +331,7 @@
               [:span "Discount"]]
              (when (neg? (:plan/account-balance plan))
                [:div.content.make.store-credit
-                [:span (str "You have " (format-stripe-cents (Math/abs (:plan/account-balance plan))) " of available credit.")]])))])))))
+                [:span (str "You have " (format-stripe-cents (Math/abs (:plan/account-balance plan))) " of credit for future payments.")]])))])))))

 (def plan-components
   {:start start


Collection concept id extractor should support NegatedCondition.

--- src/cmr/search/services/collection_concept_id_extractor.clj
+++ src/cmr/search/services/collection_concept_id_extractor.clj
@@ -51,11 +51,6 @@
     [_]
     (errors/internal-error! "extract-collection-concept-ids does not support CollectionQueryCondition"))

-  cmr.search.models.query.NegatedCondition
-  (extract-collection-concept-ids
-    [_]
-    (errors/internal-error! "extract-collection-concept-ids does not support NegatedCondition."))
-
   ;; catch all extractor
   java.lang.Object
   (extract-collection-concept-ids


Fix typmo

Fix typmo

--- src/containium/deployer.clj
+++ src/containium/deployer.clj
@@ -113,7 +113,7 @@
     (start [_ systems]
       (let [config (config/get-config (require-system Config systems) :fs)
             manager (require-system Manager systems)]
-        (println "Starting filesystem deploymer, using config" config "...")
+        (println "Starting filesystem deployer, using config" config "...")
         (assert (:deployments config) "Missing :deployments configuration for FS system.")
         (let [dir (file (:deployments config))]
           (assert (.exists dir) (str "The directory '" dir "' does not exist."))


Documentation.

Documentation.

--- clj_record/validation/built_ins.clj
+++ clj_record/validation/built_ins.clj
@@ -1,10 +1,14 @@
 (ns clj-record.validation.built-ins)

-(defn match [pattern]
+(defn match
+  "Returns a validation function matching value against pattern."
+  [pattern]
   #(re-find pattern (str %)))

-(defn non-match [pattern]
+(defn non-match
+  "Returns a validation function ensuring value doesn't match pattern."
+  [pattern]
   (complement (match pattern)))

 (def numeric? (non-match #"\D"))


Enforce login code for atom-event-store

Enforce login code for atom-event-store

--- src/rill/event_store/atom_store.clj
+++ src/rill/event_store/atom_store.clj
@@ -13,6 +13,7 @@

 (defn client-opts
   [user password]
+  {:pre [user password]}
   (if (and user password)
     {:basic-auth [user password]}))

@@ -30,5 +31,6 @@
     (event/post uri stream-id from-version events (client-opts user password))))

 (defn atom-event-store
-  [uri & [opts]]
-  (->AtomStore uri (:user opts) (:password opts)))
+  [uri & [{:keys [user password]}]]
+  {:pre [user password uri]}
+  (->AtomStore uri user password))


Use article-list component for all article lists

--- frontend/components/documentation.cljs
+++ frontend/components/documentation.cljs
@@ -118,7 +118,7 @@
       (html
        [:div
         (doc-utils/render-haml-template "docs_title" {:article doc})
-        (if (:category doc)
+        (if-not (empty? (:children doc))
           (om/build article-list (assoc doc :article doc))
           (doc-utils/render-haml-template (:slug doc) (assoc doc :article doc)))]))))


set {:français {T {:regular true/false}}} for T= any of {:present,:future,:imperfect}

--- src/babel/francais/lexicon.cljc
+++ src/babel/francais/lexicon.cljc
@@ -89,10 +89,32 @@
         (apply merge-with concat
                [exceptions lexicon]))))

+   ;; set {<tense> {:regular false}} if {<tense> {:1sing}} exists for
+   ;; <tense> is any of {:present,:future,:imperfect}.
+   (if-then {:synsem {:cat :verb}
+             :français {:future {:1sing :top}}}
+            {:français {:future {:regular false}}})
+
+   (if-then {:synsem {:cat :verb}
+             :français {:imperfect {:1sing :top}}}
+            {:français {:imperfect {:regular false}}})
+
+   (if-then {:synsem {:cat :verb}
+             :français {:present {:1sing :top}}}
+            {:français {:present {:regular false}}})
+
+
+   ;; set {<tense> {:regular true}} otherwise for
+   ;; <tense> is any of {:present,:future,:imperfect}.
+   (default {:synsem {:cat :verb}
+             :d-verb-reg-future true
+             :français {:future {:regular true}}})
+   (default {:synsem {:cat :verb}
+             :d-verb-reg-imperfect true
+             :français {:imperfect {:regular true}}})
    (default {:synsem {:cat :verb}
              :d-verb-reg-present true
              :français {:present {:regular true}}})
-   ;; TODO: as with {:d-verb-reg-present true}, add {:d-verb-reg-imperfect,-future, etc}

    ;; Prevent irregular infinitives ({:present :regular false})


+agreement-of-obj-of-main-verb

+agreement-of-obj-of-main-verb

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -23,6 +23,10 @@
 (def lexicon-source
   (let [adjective it-pos/adjective
         agreement-noun it-pos/agreement-noun
+        agreement-of-obj-of-main-verb
+        (let [agr (atom :top)]
+          {:synsem {:subcat {:2 {:agr agr
+                                 :subcat {:2 {:agr agr}}}}}})
         cat-of-pronoun it-pos/cat-of-pronoun
         common-noun it-pos/common-noun
         comparative it-pos/comparative
@@ -369,15 +373,12 @@
                       :subj {:human true}}}}

       ;; 4. "avere" that takes a transitive verb: e.g. "io l'ho vista (i saw her)"
-      (let [agr-of-obj-of-main-verb (atom :top)]
-        {:unify [verb-aux verb-subjective avere-common]
-         :note "avere(aux): takes trans"
-         :synsem {:infl :present
-                  :subcat {:2 {:agr agr-of-obj-of-main-verb
-                               :reflexive false
-                               :subcat {:2 {:agr agr-of-obj-of-main-verb
-                                            :pronoun true}}
-                               :essere false}}}})
+      {:unify [verb-aux verb-subjective avere-common agreement-of-obj-of-main-verb]
+       :note "avere(aux): takes trans"
+       :synsem {:infl :present
+                :subcat {:2 {:reflexive false
+                             :subcat {:2 {:pronoun true}}
+                             :essere false}}}}

       ;; 5. "avere" that takes an intransitive verb or a transitive verb within a VP
       ;;    with the object (e.g. "io ho dormito (i slept)" or "io ho [mangiato la pizza] (i ate the pizza)"


ragazza: unify with agreement-noun,common-noun,countable-noun, and feminine noun

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1786,11 +1786,15 @@

    "recuperare" {:synsem {:cat :verb
                           :sem {:pred :recover}}}
-
-   "ragazza" {:synsem {:cat :noun
-                       :agr {:gender :fem}
-                       :sem {:pred :girl
-                             :human true}}}
+   "ragazza"
+   (unify agreement-noun
+          common-noun
+          countable-noun
+          feminine-noun
+          {:synsem {:cat :noun
+                    :agr {:gender :fem}
+                    :sem {:pred :girl
+                          :human true}}})

    "restare" {:synsem {:essere true
                             :cat :verb


use config instead of env in api routes

use config instead of env in api routes

--- src/braid/server/routes/api.clj
+++ src/braid/server/routes/api.clj
@@ -11,8 +11,7 @@
             [chat.server.sync :as sync]
             [chat.server.s3 :as s3]
             [braid.api.embedly :as embedly]
-            [braid.server.conf :refer [config]]
-            [environ.core :refer [env]]))
+            [braid.server.conf :refer [config]]))

 (defn- edn-response [clj-body]
   {:headers {"Content-Type" "application/edn; charset=utf-8"}
@@ -104,7 +103,7 @@
                                          :avatar avatar-url
                                          :nickname nickname
                                          :password password})
-                  referer (get-in req [:headers "referer"] (env :site-url))
+                  referer (get-in req [:headers "referer"] (config :site-url))
                   [proto _ referrer-domain] (string/split referer #"/")]
               (do
                 (db/user-add-to-group! (user :id) (invite :group-id))
@@ -134,7 +133,7 @@
                        :body (str "A user is already registered with that email.\n"
                                   "Log in and try joining"))
                 (let [id (register-user email group-id)
-                      referer (get-in req [:headers "referer"] (env :site-url))
+                      referer (get-in req [:headers "referer"] (config :site-url))
                       [proto _ referrer-domain] (string/split referer #"/")]
                   {:status 302 :headers {"Location" (str proto "//" referrer-domain)}
                    :session (assoc (req :session) :user-id id)
@@ -151,7 +150,7 @@
             (if-let [user-id (get-in req [:session :user-id])]
               (do
                 (join-group user-id group-id)
-                (let [referer (get-in req [:headers "referer"] (env :site-url))
+                (let [referer (get-in req [:headers "referer"] (config :site-url))
                       [proto _ referrer-domain] (string/split referer #"/")]
                   {:status 302
                    :headers {"Location" (str proto "//" referrer-domain "/" group-id "/inbox")}
@@ -174,7 +173,7 @@
                        :body (str "A user is already registered with that email.\n"
                                   "Log in and try joining"))
                 (let [id (register-user email group-id)
-                      referer (get-in req [:headers "referer"] (env :site-url))
+                      referer (get-in req [:headers "referer"] (config :site-url))
                       [proto _ referrer-domain] (string/split referer #"/")]
                   {:status 302 :headers {"Location" (str proto "//" referrer-domain)}
                    :session (assoc (req :session) :user-id id)
@@ -191,7 +190,7 @@
             (if-let [user-id (get-in req [:session :user-id])]
               (do
                 (join-group user-id group-id)
-                (let [referer (get-in req [:headers "referer"] (env :site-url))
+                (let [referer (get-in req [:headers "referer"] (config :site-url))
                       [proto _ referrer-domain] (string/split referer #"/")]
                   {:status 302
                    :headers {"Location" (str proto "//" referrer-domain "/" group-id "/inbox")}
@@ -211,7 +210,7 @@
         (if-let [user (db/user-by-id user-id)]
           (if-let [err (:error (invites/verify-reset-nonce user token))]
             (assoc fail :body err)
-            (let [referer (get-in req [:headers "referer"] (env :site-url))
+            (let [referer (get-in req [:headers "referer"] (config :site-url))
                   [proto _ referrer-domain] (string/split referer #"/")]
               (db/set-user-password! (user :id) new-password)
               {:status 301


change language for info message when multilang dir is not in jar

--- src/clj/backtype/storm/util.clj
+++ src/clj/backtype/storm/util.clj
@@ -328,7 +328,7 @@
   (try-cause
     (exec-command! (str "unzip -qq " jarpath " " dir "/** -d " destdir))
   (catch ExecuteException e
-    (log-message "Error when trying to extract " dir " from " jarpath))
+    (log-message "Could not extract " dir " from " jarpath))
   ))

 (defn ensure-process-killed! [pid]


Fix another instance of not keywordizing site

--- src/clj/comic_reader/server.clj
+++ src/clj/comic_reader/server.clj
@@ -33,17 +33,18 @@

 (defn get-comics-list [{{:keys [site]} :params
                         :as request}]
-  (if-let [comic-list (scrape/fetch-list
-                       (sites/comic-list-data (keyword site)))]
-    (edn-response comic-list)
-    (edn-response (gen-error-data request) 404)))
+  (let [site (keyword site)]
+    (if-let [comic-list (scrape/fetch-list
+                         (sites/comic-list-data site))]
+      (edn-response comic-list)
+      (edn-response (gen-error-data request) 404))))

 (defn get-comic-chapter [site comic chapter]
   (first
    (drop (dec chapter)
          (sort-by :url
                   (scrape/fetch-list
-                   (sites/chapter-list-data (keyword site)
+                   (sites/chapter-list-data site
                                             comic))))))

 (defn get-following-pages [site comic chapter-map page]
@@ -54,7 +55,8 @@

 (defn get-comic-imgs [{{:keys [site comic chapter page]} :params
                        :as request}]
-  (let [chapter-map (get-comic-chapter site comic
+  (let [site (keyword site)
+        chapter-map (get-comic-chapter site comic
                                        (safe-read-string chapter))
         page-list (get-following-pages site comic
                                        chapter-map


fix Medium and Nerve Agent installation corner case

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -339,7 +339,11 @@
    {:abilities [{:cost [:click 1] :effect (effect (gain :credit 2)) :msg "gain 2 [Credits]"}]}

    "Medium"
-   {:events {:no-action {:req (req (and run
+   {:effect (req (when (and run
+                            (= (first (get-in @state [:run :server])) :rd)
+                            (not current-ice))
+                   (update! state side (assoc card :medium-active true))))
+    :events {:no-action {:req (req (and run
                                         (= (first (get-in @state [:run :server])) :rd)
                                         (not current-ice)
                                         (> (get-virus-counters state side card) 0)))
@@ -367,7 +371,11 @@
    {:recurring 2}

    "Nerve Agent"
-   {:events {:no-action {:req (req (and run
+   {:effect (req (when (and run
+                            (= (first (get-in @state [:run :server])) :hq)
+                            (not current-ice))
+                   (update! state side (assoc card :nerve-active true))))
+    :events {:no-action {:req (req (and run
                                         (= (first (get-in @state [:run :server])) :hq)
                                         (not current-ice)
                                         (> (get-virus-counters state side card) 0)))


Add UI for sending bug reports

Add UI for sending bug reports

--- src/cljc/robinson/feedback.cljc
+++ src/cljc/robinson/feedback.cljc
@@ -2,43 +2,55 @@
 (ns robinson.feedback
   (:require [clj-http.client :as client]
             [seesaw.core :as ss]
+            [seesaw.border :as ss-border]
             [seesaw.forms :as ss-forms]
             [clojure.data.json :as json]))

-(defn frame-content
-  []
-  (ss-forms/forms-panel
-    "pref,4dlu,80dlu,8dlu,pref,4dlu,80dlu"
-    :column-groups [[1 5]]
-    :items [(ss-forms/separator "General")
-            "Company" (ss-forms/span (ss/text) 5)
-            "Contact" (ss-forms/span (ss/text) 5)
-            (ss-forms/separator "Propeller")
-            "PTI/kW"  (ss/text :columns 10) "Power/kW" (ss/text :columns 10)
-            "R/mm"    (ss/text :columns 10) "D/mm"     (ss/text :columns 10)]
-    :default-dialog-border? true))
+(defn upload-report [data]
+  (client/post "http://aaron-santos.com:3000/reports"
+               {:body (json/write-str
+                        (clojure.walk/postwalk (fn [v] (if (char? v)
+                                                         (str v)
+                                                         v))
+                                               data))
+                :content-type :json}))

 (defn send-report [state]
-  (let [
+  (let [date              (str (new java.util.Date))
+        version           (get state :version)
+        user-id           (get state :user-id)
         upload-input      (ss/checkbox :selected? true)
-        description-input (ss/text :columns 80 :rows 25 :multi-line? true :wrap-lines? true)
+        description-input (ss/text :columns 80
+                                   :rows 25
+                                   :multi-line? true
+                                   :wrap-lines? true
+                                   :border (ss-border/line-border :color "#aab"))
         send-button       (ss/button :text "Send")
         cancel-button     (ss/button :text "Cancel")
         content (ss-forms/forms-panel
                   "right:pref,4dlu,pref"
                   :items [
-                    "Date:"          (str (new java.util.Date))
-                    "Version:"       (get state :version)
-                    "User-id:"       (get state :user-id)
+                    "Date:"          date
+                    "Version:"       version
+                    "User-id:"       user-id
                     "Upload save?"   upload-input
-                    "What happened?" description-input
+                    "What happened?" description-input
                     "" send-button      (ss-forms/next-line)
-                    "" cancel-button])]
+                    "" cancel-button])
+        frame (ss/frame :title "Report an Issue",
+                        :content content
+                        :resizable? false
+                        :on-close :hide)]
+  (ss/listen cancel-button :mouse-clicked (fn [e] (ss/hide! frame)))
+  (ss/listen send-button :mouse-clicked (fn [e] (upload-report
+                                                  {:date date
+                                                   :version version
+                                                   :user-id user-id
+                                                   :world (if (ss/value upload-input)
+                                                            (get state :world)
+                                                            nil)})))
   (->
-    (ss/frame :title "Report an Issue",
-              :content content
-              :resizable? false
-              :on-close :hide)
+    frame
     ss/pack!
     ss/show!)))


Increase screen safe zone size from 5 to 8

--- src/cljc/robinson/viewport.cljc
+++ src/cljc/robinson/viewport.cljc
@@ -50,7 +50,7 @@
          {v-x :x v-y :y} :pos}
         (get-in state [:world :viewport])
         ;; safe zone size
-        s 5]
+        s 8]

     (xy-in-rect? x y (+ v-x s) (+ v-y s)
                      (- v-width (* 2 s)) (- v-height (* 2 s)))))


Don't use an offset

Don't use an offset

The default behavior is actually what we want

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -66,7 +66,6 @@
       (fn [this]
         (let [wp (js/Waypoint.
                   #js {:element (reagent/dom-node this)
-                       :offset "bottom-in-view"
                        :handler #(r/go-to
                                   (r/read-path
                                    {:site site


Allow dots in middle names

Allow dots in middle names

--- src/cljs/db_quiz/normalize.cljs
+++ src/cljs/db_quiz/normalize.cljs
@@ -7,7 +7,7 @@
 (def ^:private lowercase
   "Regular expression for lowercase characters.
   (Since JavaScript lacks Unicode character classes)"
-  "[a-záčďéíňóöřšťúž]")
+  "[a-záčďéíňóöřšťúž\\.]")

 (def ^:private uppercase
   "Regular expression for uppercase characters."


Fix story-list-item unbinding

Fix story-list-item unbinding

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -125,10 +125,10 @@

 (def story-list-item
   (with-meta story-list-item-fn
-    {:component-will-unmount #(let [story (get (.. % -props -argv) 1)
-                                    id (@story :id)]
-                                (binding [base/closer-root [:story-list-item id]]
-                                  (base/unbind! story [:preview])))}))
+    {:component-will-unmount #(let [story (get (.. % -props -argv) 1)]
+                                (when-let [id (:id @story)]
+                                  (binding [base/closer-root [:story-list-item id]]
+                                    (base/unbind! story [:preview]))))}))

 (defn top-stories [stories items]
   [:ol.stories


Add note about Albers projection.

Add note about Albers projection.

--- src/cljx/c2/geo/projection.cljx
+++ src/cljx/c2/geo/projection.cljx
@@ -33,7 +33,7 @@
                       p (/ (sqrt (- C (* 2 n (sin (* radians-per-degree lat)))))
                            n)]
                   [(+ (* scale p (sin t)) (first translate))
-                   (+ (* scale (- (* p (cos t)) p0))
+                   (+ (* scale (- (* p (cos t)) p0)) ;;Note that we've negated the p0 - p*cos(t) term so the projection is into a coordinate system where positive y is downward.
                       (second translate))])))


Added SimpleAttribute for re-binding.

Added SimpleAttribute for re-binding.

--- src/clojure/freactive/core.cljc
+++ src/clojure/freactive/core.cljc
@@ -822,6 +822,7 @@
      (when (.-dispose this)
        (try
          (.dispose this)
+         true
          (catch :default e
            (.warn js/console "Error while disposing state" e this))))))

@@ -837,8 +838,7 @@
    (do
      (deftype ReactiveAttribute [#?(:cljs id) the-ref ^BindingInfo binding-info set-fn enqueue-fn
                                  #?(:cljs ^:mutable disposed
-                                          :clj ^:volatile-mutable disposed)
-                                 ]
+                                          :clj ^:volatile-mutable disposed)]
        IFn
        (#?(:cljs -invoke :clj invoke) [this new-val]
          (.dispose this)
@@ -858,14 +858,23 @@
          ((.-remove-watch binding-info) the-ref #?(:cljs id :clj this))
          (enqueue-fn #(.set this))))

+     (deftype SimpleAttribute [set-fn enqueue-fn]
+       IFn
+       (#?(:cljs -invoke :clj invoke) [this new-val]
+         (.dispose this)
+         (bind-attr* new-val set-fn enqueue-fn))
+       #?(:cljs Object :clj IReactiveAttributeImpl)
+       (dispose [this] (set-fn nil)))
+
      (defn bind-attr* [the-ref set-fn enqueue-fn]
        (if (satisfies? IDeref the-ref)
-         (let [binding (ReactiveAttribute. #?(:cljs (new-reactive-id)) the-ref (get-binding-fns the-ref) set-fn enqueue-fn false)]
+         (let [binding
+               (ReactiveAttribute. #?(:cljs (new-reactive-id)) the-ref (get-binding-fns the-ref) set-fn enqueue-fn false)]
            (.set binding)
            binding)
          (do
            (set-fn the-ref)
-           set-fn)))
+           (SimpleAttribute. set-fn enqueue-fn))))

      (defn attr-binder** [enqueue-fn]
        (fn attr-binder* [set-fn]


Simplify using higher-order functions.

Simplify using higher-order functions.

--- src/afterglow/show.clj
+++ src/afterglow/show.clj
@@ -582,9 +582,7 @@
                       :else
                       (let [range (- min max)]
                         (fn [midi-val] (float (+ max (/ (* midi-val range) 127))))))
-        calc-fn (if (nil? transform-fn)
-                  scale-fn
-                  (fn [midi-val] (transform-fn (scale-fn midi-val))))]
+        calc-fn (apply comp (filter identity [transform-fn scale-fn]))]
     (midi/add-control-mapping midi-device-name channel control-number (str "show:" (:id show) ":var" (keyword variable))
                               (fn [msg] (with-show show
                                           (set-variable! variable (calc-fn (:velocity msg))))))))


log libraries require

log libraries require

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -8,11 +8,11 @@
                                   small-lexicon small-plus-vp-pronoun
                                   small-plus-plus-np]]
    [babel.english.morphology :as morph :refer [fo]]
-   #?(:cljs [babel.logjs :as log])
    [babel.over :refer [over]]
    [babel.parse :as parse]
    [clojure.repl :refer [doc]]
    [clojure.string :as string]
+   #?(:cljs [babel.logjs :as log])
    #?(:clj [clojure.tools.logging :as log])
    [dag_unify.core :refer [deserialize dissoc-paths
                            fail? fail-path get-in serialize strip-refs


Namespace compojure import

Namespace compojure import

--- src/bookshelf/core.clj
+++ src/bookshelf/core.clj
@@ -4,7 +4,7 @@
   (:use [ring.adapter.jetty :as jetty])
   (:use [ring.middleware.reload :as reload])
   (:use [ring.middleware.stacktrace :as stacktrace])
-  (:use [compojure.core :refer :all])
+  (:use [compojure.core :as compojure])
   (:use [compojure.route :as route])
   (:use [hiccup.page :as hiccup])
   (:use [clojure.java.jdbc :as sql])
@@ -71,7 +71,7 @@
           [:td (make-notes row counts)]])]])))

 (defroutes handler
-  (GET "/" [] (library-files-html))
+  (compojure/GET "/" [] (library-files-html))
   (route/not-found "Invalid request"))

 (def app


baked jars, v1. still need to combine :include-context and :bake-jar

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -48,7 +48,12 @@
 (defn add-source-files [task & [prefix]]
   (when-not (:omit-source *project*)
     (add-zipfileset task {:dir (source-dir)       :prefix prefix :includes "**/*.clj"})
-    (add-zipfileset task {:dir (file "src" "jvm") :prefix prefix :includes "**/*.java"})))
+    (add-zipfileset task {:dir (file "src" "jvm") :prefix prefix :includes "**/*.java"}))
+  (when (:bake-jar *project*)
+    (let [bakepath (System/getProperty "bake.path")]
+      (if (.endsWith bakepath ".jar")
+        (add-zipfileset task {:src bakepath :prefix prefix :excludes "cake.clj"})
+        (add-zipfileset task {:dir bakepath :prefix prefix :excludes "cake.clj" :includes "**/*.clj"})))))

 (def cake-context
 "(ns cake)


adding index after jail reinitialization

--- src/cartagena/core.clj
+++ src/cartagena/core.clj
@@ -80,7 +80,7 @@
         init-players (vec (map :player players-draw-pile))
         draw-pile (:draw-pile (last players-draw-pile))
         pirates-in-jail (vec (flatten (map #(repeat 6 %) (map :color players))))
-        board (assoc board 0 {:icon :jail :pirates pirates-in-jail})]
+        board (assoc board 0 {:index 0 :icon :jail :pirates pirates-in-jail})]
     (reset! game-state {:board board
                         :players init-players
                         :player-order (vec (map :name init-players))


Better npr-test.

Better npr-test.

--- src/cbfg/npr-test.cljs
+++ src/cbfg/npr-test.cljs
@@ -54,16 +54,18 @@
     (TestNPRStreamRequest. (merge token {:op :stream-request
                                          :start-sq (count (:items @client))})))
   (client-rollback [this actx stream-request rollback-msg]
-    (swap! client #(update-in % [:hist] conj {:rollback-msg rollback-msg}))
+    (swap! client #(update-in % [:hist] conj rollback-msg))
     nil)
   (client-snapshot-beg [this actx stream-request snapshot-beg]
-    (swap! client #(update-in % [:hist] conj {:snapshot-beg snapshot-beg}))
+    (swap! client #(update-in % [:hist] conj snapshot-beg))
     nil)
   (client-snapshot-end [this actx stream-request snapshot-beg snapshot-end]
-    (swap! client #(update-in % [:hist] conj {:snapshot-end snapshot-end}))
+    (swap! client #(update-in % [:hist] conj snapshot-end))
     nil)
   (client-snapshot-item [this actx stream-request snapshot-beg snapshot-item]
-    (swap! client #(update-in % [:hist] conj {:snapshot-item snapshot-item}))
+    (swap! client #(-> %
+                       (update-in [:hist] conj snapshot-item)
+                       (update-in [:items] conj (:item snapshot-item))))
     nil))

 (defn test-npr [actx]
@@ -71,8 +73,10 @@
        (let [n (atom 0)]
          (if (and (let [client-to-server-ch (achan tn)
                         server-to-client-ch (achan tn)
-                        server (TestNPRServer. (atom {:hist [] :items [2 4 6]}))
-                        client (TestNPRClient. (atom {:hist [] :items []}))
+                        server-atom (atom {:hist [] :items [2 4 6]})
+                        server (TestNPRServer. server-atom)
+                        client-atom (atom {:hist [] :items []})
+                        client (TestNPRClient. client-atom)
                         cs (make-npr-client-session tn
                                                     client {:opaque 1 :lane "a"}
                                                     client-to-server-ch
@@ -84,11 +88,11 @@
                                                     server-to-client-ch)
                         cresult (atake tn cs)
                         sresult (atake tn ss)]
-                    (do (println "client result" cresult)
-                        (println "server result" sresult)
-                        (println server)
+                    (do (println server)
                         (println client)
-                        true)))
+                        (and (e n nil sresult nil)
+                             (e n (:status cresult) :ok nil)
+                             (e n (:items @client-atom) [2 4 6] nil)))))
            "pass"
            (str "FAIL: on test-lane #" @n)))))


Added run-net atom.

Added run-net atom.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -60,11 +60,11 @@
                   [21 :event [:a 21]]
                   [22 :event [:b 22]]]}))

-(def run-world
-  (atom {:a 10}))
-
-(def run-world-hover
-  (atom nil))
+(def run-world (atom {:a 10}))
+
+(def run-world-hover (atom nil))
+
+(def run-net (atom nil))

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

@@ -183,11 +183,13 @@
                                  }}
                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                           ;         :first-taker-actx actx-or-nil}}.
-                  :gen-id gen-id})
-            net-listen-ch (achan-buf world 10)
-            net-connect-ch (achan-buf world 10)]
+                  :gen-id gen-id})]
+        (reset! run-net {:net-listen-ch (achan-buf world 10)
+                         :net-connect-ch (achan-buf world 10)})
         (process-events vis event-delay event-ch step-ch render-ch)
-        (make-net world net-listen-ch net-connect-ch)
+        (make-net world
+                  (:net-listen-ch @run-net)
+                  (:net-connect-ch @run-net))
         (let [prog (get-el-value "prog")
               prog-js (str "with (cbfg.world.t1) {" prog "}")
               prog-res (try (js/eval prog-js) (catch js/Object ex ex))]


Using parameterized server-conn-loop in t2.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -2,7 +2,8 @@
   (:require-macros [cbfg.act :refer [act act-loop achan achan-buf aput atake atimeout]])
   (:require [cbfg.world.t1 :refer [prog-base-now prog-curr-now prog-evt
                                    wait-done addr-override-xy]]
-            [cbfg.world.base]))
+            [cbfg.world.base]
+            [cbfg.world.net]))

 (defn make-t2-cmd-handlers [st]
   {"add"   (fn [c] (assoc c :rq #(cbfg.world.base/example-add % c)))
@@ -14,6 +15,10 @@
   (cbfg.world.t1/world-vis-init-t "cbfg.world.t2"
                                   (make-t2-cmd-handlers nil) el-prefix
                                   cbfg.world.t1/ev-msg init-event-delay))
+
+(defn server-conn-loop [actx server-send-ch server-recv-ch close-server-recv-ch]
+  (cbfg.world.net/server-conn-loop actx server-send-ch server-recv-ch close-server-recv-ch
+                                   :make-lane-fn cbfg.world.lane/make-fenced-pump-lane))

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

@@ -27,7 +32,8 @@
                    [server-addr port listen-result-ch])
              (when-let [[accept-ch close-accept-ch]
                         (atake server-init listen-result-ch)]
-               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)))
+               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch
+                                                  :server-conn-loop server-conn-loop)))
            (reset! done true))
       (wait-done done)
       (prog-evt world :kv-server {:server-addr server-addr :server-port port}


Forwarding realms-list request to server-handler.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -18,7 +18,7 @@

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

-(defn server-handler [server-state m]
+(defn server-handler [actx server-state m]
   (case (:op m)
     :authenticate
     (if-let [{:keys [realm user pswd]} m]
@@ -28,6 +28,8 @@
           [server-state (assoc (dissoc m :pswd) :status :mismatch)])
         [server-state (assoc (dissoc m :pswd) :status :invalid)])
       [server-state (assoc (dissoc m :pswd) :status :invalid)])
+    "realms-list"
+    [server-state (assoc m :result (keys (:realms server-state)))]
     nil))

 (defn rq-authenticate [actx m]
@@ -48,12 +50,14 @@

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

-(defn lane-handler [lane-state m]
+(defn lane-handler [actx lane-state m]
   (case (:op m)
     "realms-list"
-    (if-let [cred (:cred lane-state)]
-      [lane-state (assoc m :status :invalid)]
-      [lane-state (assoc m :status :not-authenticated)])
+    (let [server-state-ch (:server-state-ch m)]
+      (act fwd-realms-list actx
+           (aput fwd-realms-list server-state-ch
+                 (assoc m :cred (:cred lane-state))))
+      [lane-state nil])
     nil))

 (defn rq-handle-lane [actx m] ; Forward to lane-state-ch to handle the request.
@@ -103,7 +107,7 @@
                                             (assoc m :status :ok)))
                               (recur name ((:update-fn m) state)))
                   (when unknown-fn
-                    (when-let [[state2 res] (unknown-fn state m)]
+                    (when-let [[state2 res] (unknown-fn state-loop state m)]
                       (when (and res (:res-ch m))
                         (aput-close state-loop (:res-ch m) res))
                       (recur name state2))))))


Prevent non-existent Drakefiles from throwing errors

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -229,7 +229,7 @@
     (log/info "Saving definition for" dataset)
     (save-dataset-definition dataset definition)

-    (when (.exists drakefile)
+    (when (and drakefile (.isFile drakefile))
       (log/info "Running Drakefile")
       ;; The following is Dark Drake Magic.
       (drake/run-workflow drakefile :targetv ["=..."]))


whitespace cleanup and remove unused let variable

--- src/cheshire/parse.clj
+++ src/cheshire/parse.clj
@@ -28,7 +28,6 @@
              (recur mmap#))
            (persistent! mmap#))))))

-
 (definline parse-array [^JsonParser jp key-fn bd? array-coerce-fn]
   (let [jp (tag jp)]
     `(let [array-field-name# (.getCurrentName ~jp)]
@@ -39,26 +38,25 @@
          (if-not (identical? (.getCurrentToken ~jp)
                              JsonToken/END_ARRAY)
            (let [coll# (conj! coll#
-                         (parse* ~jp ~key-fn ~bd? ~array-coerce-fn))]
+                              (parse* ~jp ~key-fn ~bd? ~array-coerce-fn))]
              (.nextToken ~jp)
              (recur coll#))
            (persistent! coll#))))))

 (defn lazily-parse-array [^JsonParser jp key-fn bd? array-coerce-fn]
   (lazy-seq
-    (loop [chunk-idx 0, buf (chunk-buffer 32)]
-      (if (identical? (.getCurrentToken jp) JsonToken/END_ARRAY)
-
-        (chunk-cons (chunk buf) nil)
-
-        (let [coll# (chunk-append buf (parse* jp key-fn bd? array-coerce-fn))]
-          (.nextToken jp)
-          (let [chunk-idx* (unchecked-inc chunk-idx)]
-            (if (< chunk-idx* 32)
-              (recur chunk-idx* buf)
-              (chunk-cons
-                (chunk buf)
-                (lazily-parse-array jp key-fn bd? array-coerce-fn)))))))))
+   (loop [chunk-idx 0, buf (chunk-buffer 32)]
+     (if (identical? (.getCurrentToken jp) JsonToken/END_ARRAY)
+       (chunk-cons (chunk buf) nil)
+       (do
+         (chunk-append buf (parse* jp key-fn bd? array-coerce-fn))
+         (.nextToken jp)
+         (let [chunk-idx* (unchecked-inc chunk-idx)]
+           (if (< chunk-idx* 32)
+             (recur chunk-idx* buf)
+             (chunk-cons
+              (chunk buf)
+              (lazily-parse-array jp key-fn bd? array-coerce-fn)))))))))

 (defn parse* [^JsonParser jp key-fn bd? array-coerce-fn]
   (condp identical? (.getCurrentToken jp)


refactoring; fix issue where tick! constantly swaps clock atoms

* Did away with `absolute-time` and `relative-time` which were confusingly named
  and not actually doing much.

* Made `current-time` a pure function that operates on a clock, not a clock
  atom.

* Minor refactoring/renaming.

* Made `start!` and `swap!` do all work inside of a single `swap!`, rather than
  de-refing and then swapping afterwards, which is error-prone.

* I noticed that `repeat!` would stop working after a couple of repeats. As I
  dug in, I realized that `tick!` is called not just periodically, but basically
  constantly. Which is good, except that it was also swapping every clock atom
  on every single tick! I suspect that `tick!` and `schedule!` were fighting
  each other, and `tick!` was winning.

  The only reason that `tick!` should ever swap a clock atom is if it's removing
  events that it just executed. And that only happens right after events are
  executed, so we can just swap when that happens. Making that change fixed the
  issue I was seeing.

--- src/chronoid/core.cljs
+++ src/chronoid/core.cljs
@@ -25,14 +25,6 @@

 (defn clock
   [& {:as attrs}]
-
-(defn- current-time*
-  "Internal implementation for the public function current-time, which works
-   on atom-wrapped clocks.
-
-   This internal version works on non-atom-wrapped clocks."
-  [{:keys [context] :as clock}]
-  (* 1000 (.-currentTime context)))
   (let [ctx        (swap! audio-context #(or % (new-audio-context)))
         id         (gensym "clock")
         clock      (merge default-options
@@ -47,18 +39,8 @@

 (defn current-time
   "Returns the current time of a clock's audio context, in milliseconds."
-  [clock]
-  (current-time* @clock))
-
-(defn- absolute-time
-  "Converts from relative -> absolute time."
-  [clock rel-time]
-  (+ rel-time (current-time* clock)))
-
-(defn- relative-time
-  "Converts from absolute -> relative time."
-  [clock abs-time]
-  (- abs-time (current-time* clock)))
+  [{:keys [context]}]
+  (* 1000 (.-currentTime context)))

 (defn- event*
   "Constructor for an event. Requires `action`, `clock` (as an atom) and
@@ -87,16 +69,16 @@
 (declare execute! schedule*)

 (defn- tick!
-  "This function is ran periodically, and at each tick it executes
-   events for which `currentTime` is included in their tolerance interval."
-  [clock]
-  (let [{:keys [events]} @clock
+  "This function is run constantly, and at each tick it executes events for
+   which `currentTime` is included in their tolerance interval."
+  [clock-atom]
+  (let [{:keys [events] :as clock} @clock-atom
         current-time (current-time clock)
         execute-now? #(<= (:earliest-time %) current-time)
-        now (take-while execute-now? events)]
-    (doseq [event now] (execute! event))
-    (swap! clock assoc :events (drop-while execute-now? (:events @clock))
-                       :current-time current-time)))
+        events-due   (take-while execute-now? events)]
+    (doseq [event events-due] (execute! event))
+    (when (seq events-due)
+      (swap! clock-atom update :events #(drop-while execute-now? %)))))

 (defn- index-by-time
   "Does a binary search to find the index of the first event whose deadline is
@@ -145,8 +127,8 @@
 (declare repeat!)

 (defn- execute!
-  [{:keys [action clock-id latest-time deadline repeat-time] :as event}]
-  (let [clock (get *clocks* clock-id)]
+  [{:keys [action clock-id latest-time repeat-time] :as event}]
+  (let [clock @(get *clocks* clock-id)]
     (when (< (current-time clock) latest-time)
       (action))
     (when repeat-time
@@ -155,12 +137,12 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn set-timeout!
-  "Schedules `f` after `delay` milliseconds. Returns the event.
+  "Schedules `f` after `delay-ms` milliseconds. Returns the event.

    `opts` may contain :tolerance-early and :tolerance-late for optionally
    overriding the clock's timing window for events."
-  [clock-atom f delay & {:as opts}]
-  (create-event! clock-atom f (absolute-time @clock-atom delay) opts))
+  [clock-atom f delay-ms & {:as opts}]
+  (create-event! clock-atom f (+ (current-time @clock-atom) delay-ms) opts))

 (defn callback-at-time!
   "Schedules `f` to run before `deadline`. Returns the event.
@@ -189,10 +171,10 @@

 (defn- time-stretch!*
   "Internal implementation for time-stretching a single event."
-  [{:keys [repeat-time clock-id deadline earliest-time] :as event}
+  [{:keys [repeat-time clock-id deadline] :as event}
    time-reference
    ratio]
-  (let [clock       (get *clocks* clock-id)
+  (let [clock       @(get *clocks* clock-id)
         deadline    (+ time-reference (* ratio (- deadline time-reference)))
         repeat-time (when repeat-time (* repeat-time ratio))
         repeats     (when repeat-time
@@ -200,9 +182,7 @@
     (clear! event)
     (schedule! (assoc event :repeat-time repeat-time)
                (if repeats
-                 (first (drop-while #(>= (current-time clock)
-                                         %)
-                                    repeats))
+                 (first (drop-while #(>= (current-time clock) %) repeats))
                  deadline))))

 (defn time-stretch!
@@ -221,7 +201,7 @@
    event's clock."
   ([e ratio]
    (let [{:keys [clock-id]} (if (sequential? e) (first e) e)
-         clock (get *clocks* clock-id)]
+         clock @(get *clocks* clock-id)]
      (time-stretch! e (current-time clock) ratio)))
   ([e time-reference ratio]
    (if (sequential? e)
@@ -230,21 +210,26 @@

 (defn start!
   "Remove all scheduled events and start the clock."
-  [clock]
-  (let [{:keys [context started]} @clock]
-    (when-not started
-      (swap! clock assoc :events [])
-      (let [clock-node (doto (.createScriptProcessor context 256 1 1)
-                         (.connect (.-destination context))
-                         (aset "onaudioprocess" #(tick! clock)))]
-        (swap! clock assoc :clock-node clock-node :started true)
-        clock))))
+  [clock-atom]
+  (swap! clock-atom
+         (fn [{:keys [context started] :as clock}]
+           (if started
+             clock
+             (let [clock-node (doto (.createScriptProcessor context 256 1 1)
+                                (.connect (.-destination context))
+                                (aset "onaudioprocess" #(tick! clock-atom)))]
+               (assoc clock
+                      :started    true
+                      :events     []
+                      :clock-node clock-node))))))

 (defn stop!
   "Stops the clock."
-  [clock]
-  (let [{:keys [started clock-node]} @clock]
-    (when started
-      (.disconnect clock-node)
-      (swap! clock assoc :started false :clock-node nil)
-      clock)))
+  [clock-atom]
+  (swap! clock-atom
+         (fn [{:keys [started clock-node] :as clock}]
+           (if started
+             (do
+               (.disconnect clock-node)
+               (-> clock (assoc :started false) (dissoc :clock-node)))
+             clock))))


Doc edit.

Doc edit.

--- src/clj/forma/rain.clj
+++ src/clj/forma/rain.clj
@@ -154,7 +154,7 @@

 ;; (Note that none of the various matrix transformations required by
 ;; FORMA have been done to the data, yet. We need to account for the
-;; horizontal swap and vertical flip, when we do our index lookup.
+;; horizontal swap and vertical flip, when we do our index lookup.)

 (defn valid-modis?
   "Checks a MODIS tile coordinate against the set of all MODIS tiles


Added log message for Kate's abilility

Added log message for Kate's abilility

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1094,6 +1094,7 @@
    {:effect (effect (gain :link 1))
     :events {:pre-install {:once :per-turn
                            :req (req (some #(= % (:type target)) '("Hardware" "Program")))
+                           :msg (msg "reduce the install cost of " (:title target) " by 1 [Credits]")
                            :effect (effect (install-cost-bonus -1))}}}

    "Kati Jones"


Fix reflection warnings.

Fix reflection warnings.

--- src/clojars/config.clj
+++ src/clojars/config.clj
@@ -50,14 +50,14 @@

 (def env-vars
   [["CONFIG_FILE" :config-file]
-   ["PORT" :port #(Integer. %)]
+   ["PORT" :port #(Integer/parseInt %)]
    ["BIND" :bind]
    ["DATABASE_URL" :db]
    ["MAIL_URL" :mail parse-mail-uri]
    ["REPO" :repo]
    ["KEY_FILE" :key-file]
    ["NAILGUN_BIND" :nailgun-bind]
-   ["NAILGUN_PORT" :nailgun-port #(Integer. %)]])
+   ["NAILGUN_PORT" :nailgun-port #(Integer/parseInt %)]])

 (defn parse-env []
   (reduce
@@ -72,17 +72,17 @@
        ["-h" "--help" "Show this help text and exit" :flag true]
        ["-f" "Read configuration map from a file" :name :config-file]
        ["-p" "--port" "Port to listen on for web requests"
-        :parse-fn #(Integer. %) :default (:port defaults)]
+        :parse-fn #(Integer/parseInt %) :default (:port defaults)]
        ["-b" "--bind" "Address to bind to for web requests"
         :default (:address defaults)]
        ["--db" "Database URL like sqlite:data/db"]
        ["--mail" "SMTP URL like smtps://user:pass@host:port?from=me@example.org"]
        ["--repo" "Path to store jar files in"]
        ["--key-file" "SSH authorized_keys file to write to"]
-       ["--nailgun-port" "Listen port for nailgun (for scp)" :parse-fn #(Integer. %)]
+       ["--nailgun-port" "Listen port for nailgun (for scp)" :parse-fn #(Integer/parseInt %)]
        ["--nailgun-bind" "Bind address for nailgun" :default (:nailgun-bind defaults)]
        ["--bcrypt-work-factor" "Difficulty factor for bcrypt password hashing"
-        :parse-fn #(Integer. %) :default (:bcrypt-work-factor defaults)]))
+        :parse-fn #(Integer/parseInt %) :default (:bcrypt-work-factor defaults)]))

 (defn parse-file [f]
   (read-string (slurp (io/file f))))


Docstring for posterity.

Docstring for posterity.

--- src/ahnentafel/server/pages/layout.clj
+++ src/ahnentafel/server/pages/layout.clj
@@ -3,6 +3,9 @@

 (defmacro def-layout-template [name & forms]
+  "Anaphoric macro for defining templates in the 'standard' layout.
+Defines two parmaters: DATA (the data passed down from the handler) and
+ARGS (rest argument)."
   `(html/deftemplate ~name "site/templates/index.html" [~'data & ~'args]
      ~@forms
      [:#version] (html/content (:version ~'data))))


include icon on changelog menu entry

include icon on changelog menu entry

--- src/braid/client/ui/styles/header.cljs
+++ src/braid/client/ui/styles/header.cljs
@@ -115,6 +115,9 @@
           [:&.group-uploads:after
            (mixins/fontawesome \uf0ee)]

+          [:&.changelog:after
+           (mixins/fontawesome \uf1da)]
+
           [:&.settings:after
            (mixins/fontawesome \uf013)]]]]]


Handle check when not actually anonymous connecting

--- src/braid/core/client/core/events.cljs
+++ src/braid/core/client/core/events.cljs
@@ -699,9 +699,11 @@

 (reg-event-fx
   :core/websocket-anon-connected
-  (fn [_ _]
-    {:dispatch-n [[:set-login-state :anon-connected]
-                  [:core/load-readonly-group]]}))
+  (fn [{db :db} _]
+    (if (= :anon-ws-connect (:login-state db))
+      {:dispatch-n [[:set-login-state :anon-connected]
+                    [:core/load-readonly-group]]}
+      {:dispatch-n [[:core/websocket-needs-auth]]})))

 (reg-event-fx
   :core/load-readonly-group


Hightlight when no unreads and current

Hightlight when no unreads and current

--- src/cljs/openslack/views/channels.cljs
+++ src/cljs/openslack/views/channels.cljs
@@ -26,6 +26,7 @@
             attrs {:on-click #(navigate (room-route {:name name}))
                    :class-name (cond
                                 (and current (> unread 0)) "highlighted unread"
+                                (and current (= unread 0)) "highlighted"
                                 (> unread 0) "unread"
                                 :else "")}]
         ;; (console/log "channel$render" name unread)
@@ -54,4 +55,3 @@
                                                       :key :local}))
              [:li.add
               [:span "+"] "Add new channel\n              "]]]))))))
-


Make privare automatic constructors on accessrules types.

--- src/clojure/buddy/auth/accessrules.clj
+++ src/clojure/buddy/auth/accessrules.clj
@@ -59,6 +59,9 @@

   (toString [self]
     (with-out-str (print [v]))))
+
+(alter-meta! #'->RuleSuccess assoc :private true)
+(alter-meta! #'->RuleError assoc :private true)

 (defn success
   "Function that return a success state


added nested tests

added nested tests

--- datomic-dsl/test/datomic_dsl/add_nested_test.clj
+++ datomic-dsl/test/datomic_dsl/add_nested_test.clj
@@ -14,4 +14,27 @@
             "author" "Charles Nordoff"}
     "borrower" {"name" "John Smith"}
     "date" "today"}})
-
+
+(def nested-datomic-add-syntax
+  "Convert data structure to datomic syntax."
+  (convert-dsl-to-datomic-syntax "borrowevent" nest-datom-dsl))
+
+;;(pprint nested-datomic-add-syntax)
+
+(def add-result
+  "Keep a reference to the transaction result"
+  (d/transact conn nested-datomic-add-syntax))
+
+(def borrowed-datom
+  "Query against the result"
+  (d/touch
+   (d/entity
+    (d/db conn)
+    (d/q '[:find ?e . :where [?e :borrower/name]]
+         (d/db conn)))))
+
+;;(pprint borrowed-datom)
+
+(deftest datom-added-test
+  (testing "Is the datom added in the database?"
+    (is (= 1 (count borrower-datom)))))


Fixing spelling error.

Fixing spelling error.

--- src/cmr/indexer/data/elasticsearch.clj
+++ src/cmr/indexer/data/elasticsearch.clj
@@ -92,7 +92,7 @@
         conn (context->conn context)
         response (bulk/bulk conn bulk-operations)]
     (when (:errors response)
-      (errors/internal-error! (format "Bulk indexing failed with repsonse %s" response)))))
+      (errors/internal-error! (format "Bulk indexing failed with response %s" response)))))

 (deftracefn save-document-in-elastic


Re-frame refactor almost complete.  Removed most of old code.

--- src-cljs/tea_time/core.cljs
+++ src-cljs/tea_time/core.cljs
@@ -63,14 +63,6 @@
        [:div {:dangerouslySetInnerHTML
               {:__html (md->html docs)}}]]])])

-
-;; (def teas-list (reagent/atom nil))
-;; (def new-tea (reagent/atom nil))
-(def edit-tea-id (reagent/atom nil))
-(def edit-tea (reagent/atom nil))
-(def edit-tea-snap (reagent/atom nil))
-(def show-edit (reagent/atom false))
-
 (re-frame/register-handler
   :process-teas-response
   (fn [app-db [_ response]]
@@ -97,26 +89,27 @@
   :delete-tea
   (fn [app-db [_ id]]
     (ajax/GET (str "/api/teas/" id "/delete")
-              :error-handler (fn [response] (println "DELETE-TEA ERROR" response))
+              :error-handler (fn [response] (println "DELETE-TEA ERROR " response))
               :handler #(re-frame/dispatch [:process-delete]))
     app-db))

+;; -- SAVE FOR TESTING ASYNC DOM UPDATE --
 ;(re-frame/register-handler
-  ;:update-tea
-  ;(fn [app-db [_ id new-name]]
-    ;(.setTimeout js/window #(ajax/GET (str "/api/teas/" id "/update/" new-name)
-                                  ;:error-handler (fn [response]
-                                                  ;(println "UPDATE-TEA ERROR" response))
-                                  ;:handler (fn [response] (println response))) 4000)
-    ;app-db))
+;:update-tea
+;(fn [app-db [_ id new-name]]
+;(.setTimeout js/window #(ajax/GET (str "/api/teas/" id "/update/" new-name)
+;:error-handler (fn [response]
+;(println "UPDATE-TEA ERROR" response))
+;:handler (fn [response] (println response))) 4000)
+;app-db))

 (re-frame/register-handler
   :update-tea
   (fn [app-db [_ id new-name]]
     (ajax/GET (str "/api/teas/" id "/update/" new-name)
-      :error-handler (fn [response]
-                      (println "UPDATE-TEA ERROR" response))
-      :handler (fn [response] (println response)))
+              :error-handler (fn [response]
+                               (println "UPDATE-TEA ERROR " response))
+              :handler (fn [response] (println response)))
     app-db))

@@ -147,7 +140,7 @@
     (assoc-in app-state [:teas-list] (replace {replaced-by
                                                {:id (:id replaced-by)
                                                 :name edit-tea-input}}
-                                      (:teas-list app-state)))))
+                                              (:teas-list app-state)))))

 (re-frame/register-sub
   :teas
@@ -160,21 +153,13 @@
     (reaction (:new-tea @db))))

-(defonce app-db (reagent/atom {}))
-
-;(defn get-teas
-  ;"Gets the list of all teas from the website"
-  ;[]
-  ;(ajax/GET "/api/teas" :handler (fn [response] (reset! app-db (assoc-in @app-db [:teas-list] response)))))
-
- ;;(reset! app-db (assoc-in app-db [:teas-list] response))
-
+;; These two fn's need to be put into re-frame handlers.
 (defn delete-tea
   "Sends a get request that deletes the tea argument"
   [name]
   (ajax/GET (str "/api/teas/" name "/delete")
             :error-handler (fn [response] (println "DELETE-TEA ERROR" response))
-            :handler (fn [response] (println name " deleted") (re-frame/dispatch [:load-teas])(reset! edit-tea-snap nil))))
+            :handler (fn [response] (println name " deleted") (re-frame/dispatch [:load-teas]))))

 (defn post-to-teas-db
   "Sends an Ajax Request to the API route to post the tea from the form to the database"
@@ -184,15 +169,6 @@
              :handler (fn [] (println "New Tea Posted"))
              :error-handler (fn [err] (println "New Tea Failed To Post" err))))

-
-(defn update-edit-form
-  "show/hide the show-edit-form"
-  [id name]
-  (println "update-edit-form" id "||" name "||" show-edit "||" @show-edit)
-  (reset! edit-tea-id (second id))
-  (reset! edit-tea (second name))
-  (reset! edit-tea-snap (second name)))
-
 (defn value-event
   [event]
   (-> event .-target .-value))
@@ -204,18 +180,18 @@
     (fn [tea]
       (if @edit?
         [:tr
-          [:td
-            [:input.form-control {:type "text"
-                                  :value @tmp-edit
-                                  :on-change #(reset! tmp-edit (value-event %))}]
-            [:button.btn.btn-success.pull-right
-              {:on-click (fn [e]
-                          (re-frame/dispatch
-                            [:replace-tea tea @tmp-edit])
-                          (swap! edit? not))}
-              "Finalize"]]]
+         [:td
+          [:input.form-control {:type "text"
+                                :value @tmp-edit
+                                :on-change #(reset! tmp-edit (value-event %))}]
+          [:button.btn.btn-success.pull-right
+           {:on-click (fn [e]
+                        (re-frame/dispatch
+                          [:replace-tea tea @tmp-edit])
+                        (swap! edit? not))}
+           "Finalize"]]]
         [:tr
-          [:td.pull-left {:on-click #(swap! edit? not)} (:name tea)]]))))
+         [:td.pull-left {:on-click #(swap! edit? not)} (:name tea)]]))))

 (defn tealister
   "The page component for listing tea"
@@ -223,32 +199,14 @@
   (let [teas (re-frame/subscribe [:teas])]
     (fn []
       [:div.row
-        [:table.table.table-striped
-          [:thead
-            [:tr
-              [:th "Tea Name"]]]
-          [:tbody
-            (for [tea @teas]
-              ^{:key tea}
-              [tea-edit-toggler tea])]]])))
-
-              ;(fn [tea
-                    ;^{:key tea}
-                    ;[:tr
-                      ;[:td.pull-left (tea-edit-toggler tea)]]])
-                      ;; [:td [:input.btn.btn-success {:type "button" :value "Edit" :on-click (fn [_] (update-edit-form (:id tea) (:name tea)))}]]])
-              ;@teas)]]])))
-
-
-(defn sync-atom-to-event
-  [the-atom target-value]
-  (reset! the-atom (->
-                    target-value
-                    .-target
-                    .-value)))
-
-;; (def sync-new-tea (partial sync-atom-to-event new-tea))
-(def sync-edit-tea (partial sync-atom-to-event edit-tea))
+       [:table.table.table-striped
+        [:thead
+         [:tr
+          [:th "Tea Name"]]]
+        [:tbody
+         (for [tea @teas]
+           ^{:key tea}
+           [tea-edit-toggler tea])]]])))

 (defn tea-adder
   "A component for the tea-adder form"
@@ -258,40 +216,14 @@
     (fn []
       (println @tmp-new-tea)
       [:div.row
-        [:div.col-md-12
-          [:input.form-control {:type "text"
-                                :placeholder "Name of New Tea"
-                                :value @tmp-new-tea
-                                :on-change #(re-frame/dispatch [:new-tea-entry (value-event %)])}]
-          [:input.btn.btn-primary {:type "button"
-                                   :value (str "Add " @tmp-new-tea)
-                                   :on-click #(println "button clicked")}]]])))
-
-;;(post-to-teas-db @tmp-new-tea)
-
-;(defn tea-edit
-  ;"The edit/delete form component"
-  ;[]
-  ;(fn []
-    ;[:div.form-group
-     ;[:div.row [:div.col-md-12]
-       ;[:button.btn.btn-info {:on-click (fn [_] (swap! show-edit not))} "Show/Hide edit form"]
-       ;[:div.p (str "Preview: " (or @edit-tea-snap "*no tea selected*") " -> " (or @edit-tea "*no tea selected*"))]
-       ;[:div.p]
-       ;[:form {:style {:visibility (if @show-edit
-                                     ;"visible"
-                                     ;"hidden")}}
-        ;[:input.form-control {:field :text :id :change-tea :value @edit-tea :on-change sync-edit-tea
-         ;[:input.btn.btn-info {:type "submit" :value "Update Tea Name" :on-click #((update-tea @edit-tea-id @edit-tea))}]
-                                                                                ;(reset! edit-tea nil)
-                                                                                ;(reset! edit-tea-snap nil)}]]
-       ;[:input.btn.btn-danger {:type "button" :value (str "Delete " @edit-tea-snap) :on-click #(delete-tea @edit-tea)}]]]))
-
-;; tea-edit can be re-written so that it will look like the tea is being
-;; modified in place on the DOM -- as a sort of preview -- then once the
-;; update button is clicked, the result can be sent to the db.
-
-;; this passes the value of the new tea atom into the post-to-teas-db function
+       [:div.col-md-12
+        [:input.form-control {:type "text"
+                              :placeholder "Name of New Tea"
+                              :value @tmp-new-tea
+                              :on-change #(re-frame/dispatch [:new-tea-entry (value-event %)])}]
+        [:input.btn.btn-primary {:type "button"
+                                 :value (str "Add " @tmp-new-tea)
+                                 :on-click #(println "button clicked")}]]])))

 (defn list-page []
   [:div.container


CMR-2201: Fixed problem with cascading deletes.

--- metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
+++ metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
@@ -555,7 +555,7 @@
       (when (= :collection concept-type)
         (doseq [[concept-id revision-id] concept-id-revision-id-tuples]
           ;; delete the related tag associations
-          (delete-associated-tag-associations context concept-id revision-id)
+          (delete-associated-tag-associations context concept-id (long revision-id))
           (ingest-events/publish-collection-revision-delete-msg context concept-id revision-id)))
       (c/force-delete-concepts db provider concept-type concept-id-revision-id-tuples))))


Users can now quickly PM other users from their cards - Hover a user's name while in a conversation and click PM - Currently populates the message with 'Hi @user!' - It'd be better if it was blank but there's a restriction on events

--- src/braid/core/client/ui/views/user_hover_card.cljs
+++ src/braid/core/client/ui/views/user_hover_card.cljs
@@ -30,7 +30,18 @@
          #_"If I had a profile, it would be here"]]

        [:div.actions
-        #_[:a.pm "PM"]
+
+          ; Open a new message with the selected user on click
+          [:a.pm
+            {:on-click
+              (fn [e]
+                (.preventDefault e)
+                (println "Opening new chat with user: " user-id " in group: " @open-group-id)
+                (dispatch [:new-message
+                            { :group-id @open-group-id
+                              :content (str "Hi @" user-id "!")
+                              :mentioned-user-ids [user-id]}]))}
+            "PM"]
         #_[:a.mute "Mute"]

         [search-button-view (str "@" (user :nickname))]


fix: add Garden/Less CSS gen to build prep-tasks

Fixes #110

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -79,5 +79,7 @@
              :main         {{ns-name}}.server
              :aot          [{{ns-name}}.server]
              :uberjar-name "{{name}}.jar"
-             :prep-tasks   ["compile" ["prod"]{{{prep-garden}}}{{{prep-less}}}]}{{/handler?}}
-   })
+             :prep-tasks   ["compile" ["prod"]{{{prep-garden}}}{{{prep-less}}}]}{{/handler?}}}
+
+  :prep-tasks [{{#garden?}}["garden" "once"]{{/garden?}}{{#less?}}
+               ["less" "once"]{{/less?}}])


Fix parenthesis not matching error main

Fix parenthesis not matching error main

--- src/verbose_spoon/model/queries.clj
+++ src/verbose_spoon/model/queries.clj
@@ -219,14 +219,15 @@
                     (= itype "Project") (str query-part (conj-where-or-and "Main_View.Type = 'Project' "))
                     (= itype "Course") (str query-part (conj-where-or-and "Main_View.Type = 'Course' "))
                     :else query-part)
-        query-part (if (empty? categories)
+        dont-use-parens (empty? categories)
+        query-part (if dont-use-parens
                      query-part
                      (str query-part (format (conj-where-or-and "(Main_View.Category_Name = '%s' " "AND ") (first categories))))
         categories (rest categories)
-        query-part (str (reduce #(str %1 (format (conj-where-or-and "Main_View.Category_Name = '%s' " "OR ") %2)) query-part categories) ")")
+        query-part (if dont-use-parens query-part (str (reduce #(str %1 (format (conj-where-or-and "Main_View.Category_Name = '%s' " "OR ") %2)) query-part categories) ") "))
         query-final (str query-part (conj-where-or-and "Main_View.Name LIKE '%") title "%'")
+        tmp (clojure.pprint/pprint query-final)
         query-results (concat dept-req-tuples (j/query mysql-db [query-final]))]
-    (clojure.pprint/pprint query-final)
     query-results))

 (defn wrap-quotes [variable]


[CS] Print :public-id at end of pipeline

--- src/vip/data_processor/pipeline.clj
+++ src/vip/data_processor/pipeline.clj
@@ -47,7 +47,7 @@
              :fatal {}
              :pipeline pipeline}
         result (run-pipeline ctx)]
-    (log/info (select-keys result [:import-id :db :xml-output-file]))
+    (log/info (select-keys result [:import-id :public-id :db :xml-output-file]))
     (when-let [ex (:exception result)]
       (psql/fail-run (:import-id result)
                      (with-out-str (stacktrace/print-throwable ex)))


Testing different way of serving index.html

--- src/clj/rakethopp_reagent/server.clj
+++ src/clj/rakethopp_reagent/server.clj
@@ -28,10 +28,8 @@
   ;;       :headers {"Content-Type" "text/plain"}
   ;;       :body (pr-str ["Hello" :from 'Heroku])})
   (GET "/" []
-       {:status 200
-        :headers {"Content-Type" "text/plain"}
-        :body (io/file "public/index.html")
-        })
+       (io/resource "public/index.html")
+       )
   ;; (ANY "*" []
   ;;      (route/not-found (slurp (io/resource "404.html"))))
   )


Use time bounds from time.cljs instead of assuming bounds of 0800 and 2400

This is inside the `find-replacement-lessons-within-time` function,
where more serious refactors are needed.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -1213,7 +1213,9 @@
                          ttLessonInfoToShift)})))
         {:augTTLessonInfoMapToShift {},
          ; nil = free slot, true = occupied slot
-         :occupiedVec      (vec (map (fn [t] nil) (range 800 2400 50)))}
+         :occupiedVec      (vec (map (fn [t] nil)
+                                     (range time-helper/TIME-INDEX-MIN
+                                            (inc time-helper/TIME-INDEX-MAX))))}
         ; go through each row in the day, below the current row
         (drop (inc rowNum) (map vector (range (count ttDay)) ttDay))))))


--- src/cljs/phonecat_re_frame/core.cljs
+++ src/cljs/phonecat_re_frame/core.cljs
@@ -33,7 +33,19 @@
  (fn [db]
    (reaction (:order-prop @db))))

-(re-frame/register-handler
+<<<<<<< HEAD
+(re-frame/register-handler
+=======
+(re-frame/register-subs
+:phone-query
+(fn [db [_ phone-id]]
+  (let [phone-details-reaction (reaction (:phone-details @db))]
+    (reaction ((fn []
+                 ((keyword phone-id) @phone-details-reaction)))))))
+
+
+(re-frame/register-pure-handler
+>>>>>>> dff3fe5... add back handlers for loading individual phone data
  :process-phones-response
  (fn
    [app-state [_ response]]
@@ -56,13 +68,38 @@
                    :keywords? true})
    app-state))

-(re-frame/register-handler
- :initialise-db             ;; usage: (dispatch [:initialise-db])
- (fn
-   [_ _]                   ;; Ignore both params (db and v).
-   {:phones []
-    :search-input ""
-    :order-prop "name"}))
+   (re-frame/register-pure-handler
+    :process-phone-detail-response
+    (fn
+      [app-state [_ [phone-id response]]]
+      (assoc-in app-state [:phone-details (keyword phone-id)] response)))
+
+   (re-frame/register-pure-handler
+    :process-phone-detail-bad-response
+    (fn
+      [app-state [_ [phone-id response]]]
+      (println "Error getting phone detail for id: " phone-id)
+      (println response)
+      app-state))
+
+   (re-frame/register-pure-handler
+    :load-phone-detail
+    (fn
+      [app-state [_ phone-id]]
+      (ajax/GET (str "phones/" phone-id ".json")
+                {:handler #(re-frame/dispatch [:process-phone-detail-response [phone-id %1]])
+                 :error-handler #(re-frame/dispatch [:process-phone-detail-bad-response [phone-id %1]])
+                 :response-format :json
+                 :keywords? true})))
+
+
+(re-frame/register-pure-handler
+   :initialise-db             ;; usage: (dispatch [:initialise-db])
+   (fn
+     [_ _]                   ;; Ignore both params (db and v).
+     {:phones []
+      :search-input ""
+      :order-prop "name"}))

 (defn handle-search-input-entered
   [app-state [_ search-input]]
@@ -286,7 +323,8 @@

 (secretary/defroute "/phones/:phone-id" {:as params}
   (session/put! :current-page #'phone-page)
-  (session/put! :params params))
+  (session/put! :params params)
+  (re-frame/dispatch [:load-phone-detail (:phone-id params)]))

 (defn redirect-to
   [resource]


Simplify IAuthorization protocol.

Simplify IAuthorization protocol.

--- src/clojure/buddy/auth/protocols.clj
+++ src/clojure/buddy/auth/protocols.clj
@@ -13,10 +13,6 @@

 (defprotocol IAuthorization
   "Base protocol for all authorization backends."
-  (do-unauthorized [_ request metadata]
-    "Execute when a authenticated user enters on unathorized
-    location and unauthorized exception is raised.")
-  (do-unauthenticated [_ request metadata]
-    "Execute when a unauthenticated user enters on unauthorized
-    location and unauthorized exception is raised."))
-
+  (handle-unauthorized [_ request metadata]
+    "Function that are executed when a NotAuthorizedException
+    is raised from ring handler execution."))