Fix run-jetty call.

Fix run-jetty call.

App will now work correctly when run with lein run.

--- src/todo_repl_webapp/handler.clj
+++ src/todo_repl_webapp/handler.clj
@@ -28,6 +28,7 @@
                                               "Eval"))]
           [:div#display.col-md-7.col-md-offset-2]
           (page/include-js "js/eval.js")]))
+
 (defn eval-page [x & xs]
   (html [:h1 "Eval"]
         [:h2 x]))
@@ -38,16 +39,15 @@
   (dosync (alter *tasks-ref* #(cons
                                 (todo/new-task-better x)
                                 %1))))
-(defn add-to-tasks [x]
-  (dosync (alter *tasks-ref* #(cons x %1))))

 (defroutes app-routes
   (GET "/" [] (do (println "get /")
                   (home-page)))
   (POST "/eval" [evalInput]
-    (if (nil? evalInput)
-      (eval-page "nil")
-      (do (println "/eval " evalInput)
+    (do
+      (println "/eval " evalInput)
+      (if (nil? evalInput)
+        (eval-page "nil")
           (binding [*ns* (find-ns 'todo-repl-webapp.handler)]
             (let [result (load-string evalInput)]
               (println "evals to: " result)
@@ -59,4 +59,6 @@
   (handler/site app-routes))

 (defn -main [port]
-  (jetty/run-jetty app-routes {:port (Integer. port) :join? false}))
+  (jetty/run-jetty
+    (handler/site app-routes)
+    {:port (Integer. port) :join? false}))


STORM-273. Error while running storm topologies on Windows using "storm jar"

--- storm-core/src/clj/backtype/storm/util.clj
+++ storm-core/src/clj/backtype/storm/util.clj
@@ -759,7 +759,7 @@

 (defn zip-contains-dir? [zipfile target]
   (let [entries (->> zipfile (ZipFile.) .entries enumeration-seq (map (memfn getName)))]
-    (some? #(.startsWith % (str target file-path-separator)) entries)
+    (some? #(.startsWith % (str target "/")) entries)
     ))

 (defn url-encode [s]


more TODO

more TODO

--- test/com/billpiel/mem_tracer/core_test.clj
+++ test/com/billpiel/mem_tracer/core_test.clj
@@ -517,7 +517,9 @@
 - test reloading ws after code change
 - optional print func log before and after children
 - include ID in string output
+- show file and line num in output
 - bisect recording trees to find bugs
+- split ns and fn name in trace rec and output
 - trace individual fns
 - deep trace (inside fn)
 - query syntax??


Start using gloss

Start using gloss

There are a couple of different threads here. I wish my git skills were
good enough to keep them isolated.

The main theme was switching my half-baked messaging protocol to use
gloss. Although now I wonder whether I'd have been better off using the
groundwork I laid down for compose/decompose in here.

There was also some code refactoring to eliminate duplicates. I'm sure I
want to keep that part.

--- test/frereth_cp/message/handshake_test.clj
+++ test/frereth_cp/message/handshake_test.clj
@@ -9,58 +9,71 @@
             [frereth-cp.message.specs :as specs]
             [frereth-cp.shared.bit-twiddling :as b-t]
             [frereth-cp.util :as utils]
+            [gloss.core :as gloss]
+            [gloss.io :as io]
             [manifold.deferred :as dfrd]
             [manifold.stream :as strm])
   (:import io.netty.buffer.Unpooled))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Specs
+
+(s/def ::prefix (s/nilable bytes?))
+(s/def ::count nat-int?)
+(s/def ::state (s/keys :req [::count
+                             ::prefix]))
+(s/def ::next-object any?)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Magic constants
+
+(def protocol
+  (gloss/compile-frame
+   (gloss/finite-frame :uint16
+                       (gloss/string :utf-8))
+   pr-str
+   edn/read-string))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Helper functions

-;;;; TODO: Consolidate these next 2 to eliminate duplication
+(defn consumer
+  [io-handle prelog time-out succeeded? bs]
+  ;; Note that, at this point, we're blocking the
+  ;; I/O loop.
+  ;; Whatever happens here must return control
+  ;; quickly.
+  (log/info prelog "Message over network")
+  ;; Checking for the server state is wasteful here.
+  ;; And very dubious...depending on implementation details,
+  ;; it wouldn't take much to shift this over to triggering
+  ;; a deadlock (since we're really running on the event loop
+  ;; thread).
+  ;; Actually, I'm a little surprised that this works at all.
+  ;; And it definitely *has* had issues.
+  ;; Q: But is it worth it for the test's sake?
+  (let [state (message/get-state io-handle time-out ::timed-out)]
+    (if (or (= ::timed-out state)
+            (instance? Throwable state)
+            (nil? state))
+      (let [problem (if (instance? Throwable state)
+                      state
+                      (ex-info "Non-exception"
+                               {::problem state}))]
+        (log/error problem prelog "Failed!")
+        (dfrd/error! succeeded? problem))
+      (message/parent->! io-handle (io/encode protocol bs)))))
+
 (defn srvr->client-consumer
+  "This processes bytes that are headed from the server to the client"
   [client-io time-out succeeded? bs]
   (let [prelog (utils/pre-log "server->client consumer")]
-    (log/info prelog "Message from server to client")
-    (let [client-state (message/get-state client-io time-out ::timed-out)]
-      (if (or (= ::timed-out client-state)
-              (instance? Throwable client-state)
-              (nil? client-state))
-        (let [problem (if (instance? Throwable client-state)
-                        client-state
-                        (ex-info "Non-exception in server->client consumer"
-                                 {::problem client-state}))]
-          (log/error problem prelog "Client failed!")
-          (dfrd/error! succeeded? problem))
-        (message/parent->! client-io bs)))))
+    (consumer client-io prelog time-out succeeded? bs)))

 (defn client->srvr-consumer
   [server-io time-out succeeded? bs]
-  ;; Note that, at this point, we're blocking the
-  ;; server's I/O loop.
-  ;; Whatever happens here must return control
-  ;; quickly.
-  (let [prelog (utils/pre-log "client->server")]
-    (log/info prelog "Incoming")
-    ;; Checking for the server state is wasteful here.
-    ;; And very dubious...depending on implementation details,
-    ;; it wouldn't take much to shift this over to triggering
-    ;; a deadlock (since we're really running on the event loop
-    ;; thread).
-    ;; Actually, I'm a little surprised that this works at all.
-    ;; And it definitely *has* had issues.
-    ;; Q: But is it worth it for the test's sake?
-    (let [srvr-state (message/get-state server-io time-out ::timed-out)]
-      (if (or (= ::timed-out srvr-state)
-              (instance? Throwable srvr-state)
-              (nil? srvr-state))
-        (let [problem (if (instance? Throwable srvr-state)
-                        srvr-state
-                        (ex-info "Non-exception in client->server consumer"
-                                 {::problem srvr-state}))]
-          (do
-            (log/error problem prelog "Server failed!")
-            (dfrd/error! succeeded? problem)))
-        (message/parent->! server-io bs)))))
+  (let [prelog (utils/pre-log "server->client consumer")]
+    (consumer server-io prelog time-out succeeded? bs)))

 (defn buffer-response!
   [io-handle
@@ -69,29 +82,22 @@
    success-message
    error-message
    error-details]
-  ;; This actually sends a stream of data.
-  ;; So prepend with the byte count
-  (let [printed (pr-str response)
-        payload (.getBytes printed)
-        response-length (count payload)
-        ;; 2 bytes for length encoding
-        buffer (+ 2 response-length)]
-    (b-t/uint16-pack! buffer 0 response-length)
-    (b-t/byte-copy! buffer 2 response-length payload)
-    (m-t/try-multiple-sends message/child->!
-                            prelog
-                            5
-                            io-handle
-                            buffer
-                            success-message
-                            error-message
-                            error-details)))
-
-(s/def ::prefix (s/nilable bytes?))
-(s/def ::count nat-int?)
-(s/def ::state (s/keys :req [::count
-                             ::prefix]))
-(s/def ::next-object any?)
+  (let [frames (io/encode protocol response)]
+    (doseq [frame frames]
+      (let [array (if (.hasArray frame)
+                    (.array frame)
+                    (let [result (byte-array (.readableBytes frame))]
+                      (.readBytes frame result)))]
+        ;; This is actually a java.nio.HeapByteBuffer.
+        ;; Which is a totally different animal from a reference-counted ByteBuf
+        ;; from netty.
+        (comment (.release frame))
+        (when-not
+            (message/child->! io-handle array)
+          (throw (ex-info "Sending failed"
+                          {::failed-on frame
+                           ::context prelog})))))))
+
 (s/fdef extract-next-object-from-stream
         :args (s/cat :state ::state
                      :bs bytes?)
@@ -101,6 +107,7 @@
   "This is probably generally applicable"
   [{:keys [::prefix]
     :as state} bs]
+  (throw (RuntimeException. "Obsolete"))
   ;; Q: How much easier would using ByteBuf make this?
   ;; As it is, I feel like this needs its own unit test.
   (log/debug "Trying to extract object number"
@@ -141,9 +148,12 @@
   [server-atom state-atom chzbrgr-length bs]
   (let [prelog (utils/pre-log "Server's child callback")
         _ (log/debug prelog "Message arrived at server's child")
-        {:keys [::state]
-         incoming ::next-object} (extract-next-object-from-stream @state-atom bs)]
-    (reset! state-atom state)
+        ;; Hopefully, sticking encode-to-stream in the middle of
+        ;; the mock networking layer will allow this to just
+        ;; go back to working magically again
+        incoming (if-not (keyword? bs)
+                   (io/decode protocol bs)
+                   bs)]
     (when incoming
       (log/debug prelog
                  (str "Matching '" incoming
@@ -184,8 +194,9 @@
   [client-atom client-state succeeded? chzbrgr-length bs]
   (let [prelog (utils/pre-log "Handshake Client: child callback")
         _ (log/debug prelog "Message arrived at client's child")
-        {incoming ::next-object
-         :keys [::state]} (extract-next-object-from-stream @client-state bs)]
+        incoming (if-not (keyword? bs)
+                   (io/decode protocol bs)
+                   bs)]
     (is bs)
     (is (< 0 (count bs)))
     (log/info prelog
@@ -193,11 +204,10 @@
                    @client-state
                    "\nreceived: "
                    incoming ", a " (class incoming)))
-    (reset! client-state state)
     (when incoming
-      (let [{:keys [::count]} state
+      (let [{n ::count} @client-state
             next-message
-            (condp = (dec count)
+            (condp = n
               0 (do
                   (is (= incoming ::orly?))
                   ::yarly)
@@ -238,19 +248,25 @@
                       (log/error ex "This really shouldn't pass")
                       (is (not ex))))
                   nil))]
+        (log/info prelog
+                  incoming
+                  "triggered a response:"
+                  next-message)
         ;; Hmm...I've wound up with a circular dependency
         ;; on the io-handle again.
         ;; Q: Is this a problem with my architecture, or just
         ;; a testing artifact?
         (when next-message
+          (swap! client-state update ::count inc)
           (buffer-response! @client-atom
                             prelog
                             next-message
                             "Buffered bytes from child"
-                            "Giving up on sending message from child"))))))
+                            "Giving up on sending message from child"
+                            {}))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Tests functions
+;;; Tests

 (deftest handshake
   (let [prelog (utils/pre-log "Handshake test")]
@@ -314,9 +330,9 @@

         (try
           (strm/consume (partial client->srvr-consumer server-io time-out succeeded?)
-                        client->server)
+                        (strm/map #(io/encode protocol %) client->server))
           (strm/consume (partial srvr->client-consumer client-io time-out succeeded?)
-                        server->client)
+                        (strm/map #(io/encode protocol %) server->client))

           (let [initial-message (Unpooled/buffer K/k-1)
                 helo (.getBytes (pr-str ::ohai!))]


add a very short delay to throttle test to try and avoid intermittent failures.

--- test/metabase/api/common/throttle_test.clj
+++ test/metabase/api/common/throttle_test.clj
@@ -47,6 +47,7 @@
   ([n k]
    (let [attempt-once (fn []
                       (try
+                        (Thread/sleep 1)
                         (throttle/check test-throttler k)
                         :success
                         (catch Throwable e


Use short month string in digest title.

Use short month string in digest title.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -19,7 +19,7 @@
 (def date-format (time-format/formatter "MMM. d"))
 (def date-format-no-dot (time-format/formatter "MMM d"))
 (def date-format-year (time-format/formatter "MMM. d YYYY"))
-(def digest-subject-format (time-format/formatter "MMMM d, YYYY"))
+(def digest-subject-format (time-format/formatter "MMM d, YYYY"))
 (def date-format-year-comma (time-format/formatter "MMM. d, YYYY"))
 (def day-month-date-year (time-format/formatter "EEEE, MMM. dd, YYYY"))
 (def reminder-date-format (time-format/formatter "EEEE, MMMM d"))


Fix following key in digest message.

Fix following key in digest message.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -379,7 +379,7 @@

 (defn- digest-content
   [{:keys [following unfollowing view-more-url home-url replies-url digest-label org-light-brand-color]}]
-  (let [following? (seq (:following-list following))
+  (let [following? (seq following)
         unfollowing? (seq unfollowing)
         brand-color (or org-light-brand-color config/default-brand-color)
         view-more? (seq view-more-url)]


Working on generated code.

Working on generated code.

--- src/afterglow/fixtures/qxf.clj
+++ src/afterglow/fixtures/qxf.clj
@@ -48,11 +48,12 @@
   "Builds a map containing a channel specification from a QLC+ fixture
   definition."
   [ch]
-  {:name (zip-xml/attr ch :Name)
-   :group (zip-xml/xml1-> ch :Group zip-xml/text)
-   :byte (Integer/valueOf (zip-xml/attr (zip-xml/xml1-> ch :Group) :Byte))
-   :capabilities (mapv qxf-capability->map
-                       (zip-xml/xml-> ch :Capability))})
+  (let [color (zip-xml/xml1-> ch :Colour zip-xml/text)]
+    (merge {:name (zip-xml/attr ch :Name)
+            :group (zip-xml/xml1-> ch :Group zip-xml/text)
+            :byte (Integer/valueOf (zip-xml/attr (zip-xml/xml1-> ch :Group) :Byte))
+            :capabilities (mapv qxf-capability->map (zip-xml/xml-> ch :Capability))}
+           (when color {:color color}))))

 (defn qxf-channnel-assigment->vector
   "Builds a vector containing the offset at which a channel exists in
@@ -69,26 +70,31 @@
   [h]
   (mapv #(inc (Integer/parseInt %)) (zip-xml/xml-> h :Channel zip-xml/text)))

+(defn- qxf-mark-pan-tilt
+  "Adds an flag to a fixture or head when its channel map
+  includes a pan or tilt channel."
+  [channel-specs h]
+  (merge h (when (some #{"Pan" "Tilt"} (map :group (map #(get channel-specs (second %)) (:channels h))))
+             {:has-pan-tilt true})))
+
 (defn- qxf-process-heads
   "Extracts any head-specific channels from a QLC+ mode, given a
   sequence of Head nodes and the vector of mode channel assignments."
-  ([heads all-channels]
-   ;; Just starting; see if there is anything to do, if so set up structures we need
-   (if (seq heads)  ; There are some heads to deal with
-     (let [channel-map (into {} all-channels)]
-       (qxf-process-heads heads channel-map []))
-     [nil all-channels]))  ; There were no heads
+  ([heads channel-map channel-specs]
+   ;; Kick off recursive arity with an empty response vector
+   (qxf-process-heads heads channel-map channel-specs []))

-  ([remaining-heads remaining-channel-map heads-processed]
+  ([remaining-heads remaining-channel-map channel-specs results]
    ;; Recursive head processing
    (if (empty? remaining-heads)
-     [heads-processed (vec remaining-channel-map)] ; Finished, return results
+     [results (vec remaining-channel-map)] ; Finished, return results
      ;; Process the next head
      (loop [head-channel-numbers (sort (qxf-head->vector (first remaining-heads)))
             head-channel-result []
             channels-left remaining-channel-map]
        (if (empty? head-channel-numbers)  ; Finished processing this head
-         (qxf-process-heads (rest remaining-heads) channels-left (conj heads-processed head-channel-result))
+         (qxf-process-heads (rest remaining-heads) channels-left channel-specs
+                            (conj results (qxf-mark-pan-tilt channel-specs {:channels head-channel-result})))
          (let [current (first head-channel-numbers)]
            (recur (rest head-channel-numbers)
                   (conj head-channel-result [current (get channels-left current)])
@@ -97,12 +103,15 @@
 (defn- qxf-mode->map
   "Builds a map containing a mode specification from a QLC+ fixture
   definition. Currently ignores the Physical documentation."
-  [m]
-  (let [all-channels (mapv qxf-channnel-assigment->vector (zip-xml/xml-> m :Channel))
-        [heads other-channels] (qxf-process-heads (zip-xml/xml-> m :Head) all-channels)]
-    {:name (zip-xml/attr m :Name)
-     :channels other-channels
-     :heads heads}))
+  [channel-specs m]
+  (let [channel-specs (into {} (for [spec channel-specs]  ; Turn specs into a map for efficient searching
+                                 [(:name spec) spec]))
+        all-channels (mapv qxf-channnel-assigment->vector (zip-xml/xml-> m :Channel))
+        channel-map (into {} all-channels)
+        [heads other-channels] (qxf-process-heads (zip-xml/xml-> m :Head) channel-map channel-specs)]
+    (qxf-mark-pan-tilt channel-specs {:name (zip-xml/attr m :Name)
+                                      :channels other-channels
+                                      :heads heads})))

 (defn translate-definition
   "Converts a map read by [[convert-qxf]] into an Afterglow fixture
@@ -129,9 +138,9 @@
        :model (zip-xml/text (zip-xml/xml1-> root :Model))
        :type (zip-xml/text (zip-xml/xml1-> root :Type))
        :channels channels
-       :modes (mapv qxf-mode->map (zip-xml/xml-> root :Mode))
+       :modes (mapv (partial qxf-mode->map channels) (zip-xml/xml-> root :Mode))
        :has-pan-channel (some #(= "Pan" (:group %)) channels)
-       :has-tilt-channel (some #(= "Pan" (:group %)) channels)})))
+       :has-tilt-channel (some #(= "Tilt" (:group %)) channels)})))

 (defn convert-qxf
   "Read a fixture definition file in the format (.qxf) used by


error handling

error handling

--- src/atom_finder/atom_patch.clj
+++ src/atom_finder/atom_patch.clj
@@ -105,22 +105,25 @@

 (defn atom-removed-all-commits
   [repo atom-classifier]
+  (pmap
+   (fn [rev-commit]
+     (let [commit-hash (.name rev-commit)]
+     (try
+       [commit-hash
+        (atom-removed-in-commit? repo rev-commit atom-classifier)
+        (bugzilla-ids rev-commit)
+        ]
+       (catch Exception e (do (printf "-- exception parsing commit: \"%s\"\n" commit-hash) [commit-hash nil nil]))
+       (catch Error e     (do (printf "-- error parsing commit: \"%s\"\n" commit-hash) [commit-hash nil nil]))
+       )))
+   (gitq/rev-list repo)))

-  (->> repo
-       gitq/rev-list
-       (pmap #(vector (.name %1)
-                      (atom-removed-in-commit? repo %1 atom-classifier)
-                      (bugzilla-ids %1)
-                      ))
-       )
-  )
-
-;(time (pprint (atom-removed-all-commits ag-repo conditional-atom?)))
-
-;(binding [*out* (clojure.java.io/writer "gcc-conditional-commits.txt")]
-;  (->> conditional-atom?
-;       (atom-removed-all-commits gcc-repo)
-;       (take 10)
-;       (map println)
-;       dorun
-;       time))
+(defn log-atom-removed-all-commits
+  []
+  (binding [*out* (clojure.java.io/writer "gcc-conditional-commits.txt")]
+    (->> conditional-atom?
+         (atom-removed-all-commits gcc-repo)
+         (take 10)
+         (map println)
+         dorun
+         time)))


Take eval-fn as an option instead of a dynamic var

--- src/pinpointer/core.cljc
+++ src/pinpointer/core.cljc
@@ -7,9 +7,6 @@
             [pinpointer.formatter :as formatter]
             [pinpointer.trace :as trace]
             [spectrace.core :as strace]))
-
-(def ^:dynamic *eval-fn*
-  strace/*eval-fn*)

 (def ^:dynamic ^:private *colorize-fn*)

@@ -146,13 +143,13 @@

   Takes the same options as pinpoint."
   ([ed] (pinpoint-out ed {}))
-  ([ed {:keys [width colorize fallback-on-error] :as opts
+  ([ed {:keys [width colorize fallback-on-error eval] :as opts
         :or {width 70, fallback-on-error true}}]
    (if ed
      (let [{:keys [::s/problems ::s/value] :as ed'} (correct-paths ed)
            nproblems (count problems)
            traces (try
-                    (binding [strace/*eval-fn* *eval-fn*]
+                    (binding [strace/*eval-fn* (or eval strace/*eval-fn*)]
                       (trace/traces ed'))
                     (catch #?(:clj Throwable :cljs :default) e e))]
        (cond (vector? traces)
@@ -181,7 +178,8 @@
   The opts map may have the following keys:
     :width - Number of columns to try to wrap the report at. Defaults to 70.
     :colorize - Can either be a keyword :ansi, :none or a fn that takes a color keyword and a string, and returns the colorized string. Defaults to :none.
-    :fallback-on-error - If set to true, falls back to s/explain-printer in case of an error during the analysis. Otherwise, throws the error. Defaults to true."
+    :fallback-on-error - If set to true, falls back to s/explain-printer in case of an error during the analysis. Otherwise, throws the error. Defaults to true.
+    :eval - eval fn to be used to analyze spec errors. Defaults to clojure.core/eval in Clojure, nil in ClojureScript."
   ([spec x] (pinpoint spec x {}))
   ([spec x opts]
    (pinpoint-out (s/explain-data spec x) opts)))


Respect :colorize option

Respect :colorize option

--- src/pinpointer/core.cljc
+++ src/pinpointer/core.cljc
@@ -6,14 +6,26 @@
             [pinpointer.printer :as printer]
             [pinpointer.trace :as trace]))

-(defn default-colorize-fn [color s]
+(def ^:dynamic *colorize-fn*)
+
+(defn- colorize [color s]
+  (*colorize-fn* color s))
+
+(defn- ansi-colorize [color s]
   #?(:clj (clansi/style s color)
      :cljs s))

-(def ^:dynamic *colorize-fn* default-colorize-fn)
+(defn- none-colorize [_ s] s)

-(defn- colorize [color s]
-  (*colorize-fn* color s))
+(def ^:private builtin-colorize-fns
+  {:ansi ansi-colorize
+   :none none-colorize})
+
+(defn- choose-colorize-fn [colorize]
+  (let [colorize (or colorize :none)]
+    (if (keyword? colorize)
+      (get builtin-colorize-fns colorize none-colorize)
+      colorize)))

 (defn- wavy-line [start length]
   (->> (concat (repeat start \space)
@@ -49,25 +61,26 @@
 (defn pinpoint-out
   ([ed] (pinpoint-out ed {}))
   ([{:keys [::s/problems ::s/spec ::s/value] :as ed} {:keys [colorize]}]
-   (if ed
-     (do (println "Some spec errors were detected:")
-         (hline)
-         (doseq [problem problems
-                 :let [trace (trace/trace problem spec value)
-                       [line & lines] (format-data value trace)]]
-           (println "     Input:" line)
-           (doseq [line lines]
-             (println "          :" line))
-           (let [[line & lines] (-> (with-out-str
-                                      (fipp/pprint (:pred problem)))
-                                    (str/split #"\n"))]
-             (println "  Expected:" line)
+   (binding [*colorize-fn* (choose-colorize-fn colorize)]
+     (if ed
+       (do (println "Some spec errors were detected:")
+           (hline)
+           (doseq [problem problems
+                   :let [trace (trace/trace problem spec value)
+                         [line & lines] (format-data value trace)]]
+             (println "     Input:" line)
              (doseq [line lines]
-               (println "           " line)))
-           (when-let [reason (:reason problem)]
-             (println "    Reason:" reason))
-           (hline)))
-     (println "Success!"))))
+               (println "          :" line))
+             (let [[line & lines] (-> (with-out-str
+                                        (fipp/pprint (:pred problem)))
+                                      (str/split #"\n"))]
+               (println "  Expected:" line)
+               (doseq [line lines]
+                 (println "           " line)))
+             (when-let [reason (:reason problem)]
+               (println "    Reason:" reason))
+             (hline)))
+       (println "Success!")))))

 (defn pinpoint
   ([spec x] (pinpoint spec x {}))


+"bread","man","'s"

+"bread","man","'s"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -301,6 +301,18 @@
    "break" {:synsem {:cat :verb
                      :sem {:pred :break }}
             :english {:past "broke"}}
+   "bread"
+   ;; inherently singular.
+   (unify agreement-noun
+          common-noun
+          masculine-noun
+          {:synsem {:sem {:pred :pane
+                          :edible true
+                          :artifact true}
+                    :subcat {:1 {:cat :det
+                                 :number :sing
+                                 :def :def}}}})
+

    "bring" {:synsem {:cat :verb
                    :sem {:pred :bring
@@ -1126,6 +1138,15 @@
    "make" {:synsem {:cat :verb
                     :sem {:pred :make}}
            :english {:past "made"}}
+   "man"
+   (unify agreement-noun
+          common-noun
+          countable-noun
+          masculine-noun
+          {:english {:plur "men"}
+           :synsem {:sem {:human true
+                          :pred :man
+                          :child false}}})

    "manage" {:synsem {:cat :verb
                 :sem {:pred :manage}}}
@@ -1380,6 +1401,11 @@
           :synsem {:cat :verb
                    :sem {:pred :run}}}

+   "s" {:synsem {:cat :det
+                 :def :genitive
+                 :subcat {:1 {:cat :noun
+                              :subcat '()}}}}
+
    "say" {:english {:past "said"}
           :synsem {:cat :verb
                    :sem {:pred :say}}}


~(defn vocab-entry-to-lexeme): support nounplf and nounplm

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -678,7 +678,9 @@
                           :subcat {:1 {:cat :det}}}}]
             (cond
               (or (= vocab-cat "nounplurf")
-                  (= vocab-cat "nounplurm"))
+                  (= vocab-cat "nounplurm")
+                  (= vocab-cat "nounplf")
+                  (= vocab-cat "nounplm"))
               {surface
                [(unify base-unify
                        {:synsem {:agr {:number :plur}}


restrict vp-pronoun phrases to be :infl != past-p

prevents things like:

“je suis m’amusé”

--- src/babel/francais/grammar.clj
+++ src/babel/francais/grammar.clj
@@ -333,12 +333,13 @@
                                            :tense :present}}})
                    (unifyc c21
                            root-is-head-root
-                           {:head {:phrasal true}
+                           {:head {:phrasal true
+                                   :infl {:not :past-p}}
                             :comp {:synsem {:cat :noun
                                             :pronoun true}}
                             :rule "vp-pronoun-phrasal"
-                            :synsem {:cat :verb
-                                     :infl {:not :past}}})
+                            :synsem {:cat :verb}})
+
                    (unifyc h21
                            {:rule "vp-infinitive"
                             :synsem {:aux false
@@ -375,7 +376,7 @@
                    (unifyc h21
                            {:rule "vp-past"
                             :synsem {:aux false
-                                     :infl :past
+                                     :infl :past-p
                                      :cat :verb}})
                    (unifyc h21
                            {:rule "vp-present"
@@ -387,14 +388,13 @@
                    ;; [s-present "je" [vp-pronoun "m'" "amuse"]]
                    (unifyc c21
                            root-is-head
-                           {:head {:phrasal false}
+                           {:head {:phrasal false
                             :comp {:phrasal false
                                    :synsem {:cat :noun
                                             :pronoun true}}
                             :rule "vp-pronoun-nonphrasal"
                             :synsem {:aux false
-                                     :cat :verb
-                                     :infl {:not :past}}})
+                                     :cat :verb}})
                    (unifyc h10
                            {:head {:phrasal false
                                    :synsem {:cat :sent-modifier}}


fixing the watch-and-reload method

fixing the watch-and-reload method

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -199,7 +199,7 @@
   (defonce watch-and-reload-singleton
     (watch-and-reload*
      (merge { :retry-count 100
-              :jsload-callback default-jsload-callback ;; *** deprecated
+              :jsload-callback default-on-jsload ;; *** deprecated
               :on-jsload (or (:jsload-callback opts) default-on-jsload)
               :on-cssload default-on-cssload
               :before-jsload default-before-load
@@ -208,5 +208,7 @@
               :websocket-url (str "ws://" js/location.host "/figwheel-ws")}
             opts))))

-(defn watch-and-reload [& opts]
+;; This takes keyword arguments
+(defn watch-and-reload
+  [& {:keys [] :as opts}]
   (watch-and-reload-with-opts opts))


Now /auto mode will show the corresponding plan

Care is taken to insure that both parts of a merged plan pair
(TPN=HTN) are loaded such that highlighting works as expected.

Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>

--- src/planviz/actions.cljs
+++ src/planviz/actions.cljs
@@ -147,7 +147,7 @@
   (let [action (if (or (:plid action) (= (:type action) :chat)) action
                    (assoc action
                      :plid (:ui/show-plan (st/get-ui-opts))))]
-    ;; (println "MY USER-ACTION" action)
+    (println "MY USER-ACTION" action)
     ;; (rmethod {:success-fn generic-reply :error-fn generic-reply}
     (rmethod {}
       :user-action action)))
@@ -588,7 +588,7 @@
     (if-not from-auto?
       (my-user-action {:type :pan-zoom
                        :pan [0.0 0.0] :zoom 1.0}))
-    true)) ;; for deferreds
+    true))

 (defn visit-nodes [node-id prev-visited node-fn]
   (if (prev-visited node-id)
@@ -656,32 +656,39 @@
                    edge (st/plans-get-edge id))
             {:keys [edge/selected? edge/type edge/from edge/to]} edge]
         (when (not= selected? new-selected?)
-          (st/plans-merge-edge (assoc
-                                 (dissoc edge :plans/ui-opts
-                                   :edge/from :edge/to)
-                                 :edge/selected? new-selected?))
-          (st/plans-merge-node (assoc from :node/selected? new-selected?))
-          (st/plans-merge-node (assoc to :node/selected? new-selected?))
+          (st/plans-merge-edge
+            (assoc
+              (dissoc edge :plans/ui-opts :edge/from :edge/to)
+              :edge/selected? new-selected?))
+          (st/plans-merge-node
+            (assoc
+              (dissoc from :plans/ui-opts :node/tpn-selection)
+              :node/selected? new-selected?))
+          (st/plans-merge-node
+            (assoc
+              (dissoc to :plans/ui-opts :node/tpn-selection)
+              :node/selected? new-selected?))
           (if (keyword-identical? type :aggregation) ;; set interior
             (let [id (node-key-fn from)
                   node (st/plans-get-node id)
                   {:keys [node/end]} node]
               (visit-nodes id #{end}
                 (fn [node]
-                  (st/plans-merge-node (assoc
-                                         (dissoc node :plans/ui-opts :node/tpn-selection)
-                                         :node/selected? new-selected?))
+                  (st/plans-merge-node
+                    (assoc
+                      (dissoc node :plans/ui-opts :node/tpn-selection)
+                      :node/selected? new-selected?))
                   (map-outgoing node
                     (fn [edge]
                       (let [{:keys [edge/type edge/to
                                     edge/weight edge/hidden]} edge]
                         (when (or (activity? type)
                                 (keyword-identical? type :aggregation))
-                          (st/plans-merge-edge (assoc
-                                                 (dissoc edge
-                                                   :plans/ui-opts
-                                                   :edge/from :edge/to)
-                                                 :edge/selected? new-selected?))
+                          (st/plans-merge-edge
+                            (assoc
+                              (dissoc edge
+                                :plans/ui-opts :edge/from :edge/to)
+                              :edge/selected? new-selected?))
                           (node-key-fn to)))))))))))
       :node
       (let [o-id (node-key-fn node)
@@ -689,31 +696,32 @@
                    node (st/plans-get-node id))
             {:keys [node/end node/type node/selected?]} node]
         (when (not= selected? new-selected?)
-          (st/plans-merge-node (assoc
-                                 (dissoc node :plans/ui-opts
-                                   :node/tpn-selection)
-                                 :node/selected? new-selected?))
+          (st/plans-merge-node
+            (assoc
+              (dissoc node :plans/ui-opts :node/tpn-selection)
+              :node/selected? new-selected?))
           (when (begin? type)
-            (st/plans-merge-node (assoc
-                                   (dissoc (st/plans-get-node end)
-                                     :plans/ui-opts :node/tpn-selection)
-                                   :node/selected? new-selected?))
+            (st/plans-merge-node
+              (assoc
+                (dissoc (st/plans-get-node end)
+                  :plans/ui-opts :node/tpn-selection)
+                :node/selected? new-selected?))
             (visit-nodes id #{end}
               (fn [node]
-                (st/plans-merge-node (assoc
-                                       (dissoc node :plans/ui-opts :node/tpn-selection)
-                                       :node/selected? new-selected?))
+                (st/plans-merge-node
+                  (assoc
+                    (dissoc node :plans/ui-opts :node/tpn-selection)
+                    :node/selected? new-selected?))
                 (map-outgoing node
                   (fn [edge]
                     (let [{:keys [edge/type edge/to
                                   edge/weight edge/hidden]} edge]
                       (when (or (activity? type)
                               (keyword-identical? type :aggregation))
-                        (st/plans-merge-edge (assoc
-                                               (dissoc edge
-                                                 :plans/ui-opts
-                                                 :edge/from :edge/to)
-                                               :edge/selected? new-selected?))
+                        (st/plans-merge-edge
+                          (assoc
+                            (dissoc edge :plans/ui-opts :edge/from :edge/to)
+                            :edge/selected? new-selected?))
                         (node-key-fn to))))))))))
       (println "Don't know how to select a" type))))

@@ -865,22 +873,31 @@
 ;; returns proposed HTN selection
 (defn highlight-from-htn [tpn-plid htn-plid csel]
   (loop [sel #{} c (first csel) more (rest csel)]
+    ;; (println "HFH SEL" sel "C" c "MORE" more)
     (if-not c
       ;; already pre-computed to be minimal!
       ;; (minimal-selection (vec sel))
       (vec sel)
       (let [[type id] c
-            _ (println "Corresponding selection" c "in HTN" htn-plid)
+            ;; _ (println "Corresponding selection" c "in HTN" htn-plid)
             sel (case type
                   :node
                   (let [{:keys [node/tpn-selection]} (st/plans-get-node id)
                         tsel (atom sel)]
-                    ;; (println "DEBUG tpn-selection" tpn-selection)
+                    (println "  TPN-SELECTION" tpn-selection)
                     (doseq [s tpn-selection]
-                      (if (:node/id s)
-                        (swap! tsel conj [:node (second (get-begin-node-ref
-                                                          (node-key-fn s)))])
-                        (swap! tsel conj [:edge (edge-key-fn s)])))
+                      (let [node-id (if (:node/id s) (node-key-fn s))
+                            edge-id (if (:edge/id s) (edge-key-fn s))]
+                        (if (keyword? node-id)
+                          (swap! tsel conj
+                            [:node (second (get-begin-node-ref node-id))])
+                          (if (keyword? edge-id)
+                            (swap! tsel conj [:edge edge-id])
+                            (do
+                              (println "ERROR, invalid tpn-selection!")
+                              )))
+                        ;; (println "  S" s "TSEL" @tsel)
+                        ))
                     @tsel)
                   (do
                     (println "highlight of HTN" type "not supported")
@@ -905,7 +922,7 @@
           (let [sel (if (and (vector? csel) (pos? (count csel)))
                       (highlight-from-tpn show-plan corresponding csel)
                       [])]
-            (println "TPN CSEL" csel "SEL" sel)
+            ;; (println "TPN CSEL" csel "SEL" sel)
             (if remote
               (status-msg "Showing TPN correspondence from" remote)
               (status-msg "Showing TPN correspondence"))
@@ -916,7 +933,7 @@
           (let [sel (if (and (vector? csel) (pos? (count csel)))
                       (highlight-from-htn show-plan corresponding csel)
                       [])]
-            (println "HTN CSEL" csel "SEL" sel)
+            ;; (println "HTN CSEL" csel "SEL" sel)
             (if remote
               (status-msg "Showing HTN correspondence from" remote)
               (status-msg "Showing HTN correspondence"))
@@ -977,10 +994,12 @@
   (let [{:keys [node/tpn-selection]} (if node-id (st/plans-get-node node-id))
         {:keys [network/nodes network/edges]} (st/get-network show-network)
         ]
-    (println "DEBUG hft tpn-selection" tpn-selection)
+    ;; (println "DEBUG hft tpn-selection" tpn-selection)
     (doseq [node nodes]
       (st/plans-merge-node
-        (assoc (dissoc node :node/ui-opts :node/tpn-selection) :node/hidden focus?)))
+        (assoc
+          (dissoc node :node/ui-opts :node/tpn-selection)
+          :node/hidden focus?)))
     (doseq [edge edges]
       (let [{:keys [edge/type edge/hidden]} edge]
         (if (and (not (keyword-identical? type :aggregation))
@@ -1011,22 +1030,23 @@
                                     {:xbounds (min-max-fn xbounds [x x])
                                      :ybounds (min-max-fn ybounds [y y])}))
                     (if hidden
-                      (st/plans-merge-node (assoc
-                                             (dissoc node :plans/ui-opts
-                                               :node/tpn-selection)
-                                             :node/hidden false)))
+                      (st/plans-merge-node
+                        (assoc
+                          (dissoc node :plans/ui-opts :node/tpn-selection)
+                          :node/hidden false)))
                     (map-outgoing node
                       (fn [edge]
                         (let [{:keys [edge/type edge/to edge/hidden]} edge]
                           (when (activity? type)
                             (if hidden
-                              (st/plans-merge-edge (assoc
-                                                     (dissoc edge
-                                                       :plans/ui-opts
-                                                       :edge/from :edge/to)
-                                                     :edge/hidden false)))
+                              (st/plans-merge-edge
+                                (assoc
+                                  (dissoc edge
+                                    :plans/ui-opts :edge/from :edge/to)
+                                  :edge/hidden false)))
                             (node-key-fn to)))))))))
-            (let [edge (st/plans-get-edge (composite-key tpn-id (:edge/id s)))
+            (let [edge (st/plans-get-edge
+                         (composite-key tpn-id (:edge/id s)))
                   {:keys [edge/hidden edge/from edge/to]} edge
                   from-x (:node/x from)
                   from-y (:node/y from)
@@ -1035,15 +1055,23 @@
               (println "EDGE BOUND FROM" from-x from-y "TO" to-x to-y)
               (swap! bounds (fn [{:keys [xbounds ybounds]}]
                               {:xbounds (min-max-fn xbounds
-                                          [(min from-x to-x) (max from-x to-x)])
+                                          [(min from-x to-x)
+                                           (max from-x to-x)])
                                :ybounds (min-max-fn ybounds
-                                          [(min from-y to-y) (max from-y to-y)])}))
+                                          [(min from-y to-y)
+                                           (max from-y to-y)])}))
               (if hidden
                 (st/plans-merge-edge
                   (assoc (dissoc edge :edge/from :edge/to :edge/ui-opts)
                     :edge/hidden false)))
-              (st/plans-merge-node (assoc from :node/hidden false))
-              (st/plans-merge-node (assoc to :node/hidden false)))))
+              (st/plans-merge-node
+                (assoc
+                  (dissoc from :plans/ui-opts :node/tpn-selection)
+                  :node/hidden false))
+              (st/plans-merge-node
+                (assoc
+                  (dissoc to :plans/ui-opts :node/tpn-selection)
+                  :node/hidden false)))))
         (zoom-to-bounds @bounds false)
         ))))

@@ -1052,47 +1080,55 @@

 (defn display-plan
   "Display a plan"
-  [plan-id &[opts]]
-  (let [plan-id (if (string? plan-id)
-                  (keyword (string/replace-first plan-id  #"^:" ""))
-                  plan-id)]
-    (when-not (no-plan? plan-id)
-      (let [{:keys [loaded? type corresponding n-keys]} (st/app-get-plan plan-id)
-            showing-loaded? loaded?
-            {:keys [loaded? focus]} (if corresponding (st/app-get-plan corresponding))
-            load-tpn? (and (keyword-identical? type :htn-network) corresponding
-                        (not loaded?))
+  [plid &[opts]]
+  (let [{:keys [load-delay]} opts
+        load-delay (+ (or load-delay 0) 100)
+        opts (assoc opts :load-delay load-delay)
+        plid (if (string? plid)
+                  (keyword (string/replace-first plid  #"^:" ""))
+                  plid)]
+    (when-not (no-plan? plid)
+      (let [{:keys [loaded? type corresponding n-keys]} (st/app-get-plan plid)
+            plid-type type
+            plid-loaded? loaded?
+            {:keys [loaded? focus]} (if corresponding
+                                      (st/app-get-plan corresponding))
+            load-corresponding? (and corresponding (not loaded?))
+            [tpn-plan htn-plan] (if (keyword-identical? plid-type :htn-network)
+                                  [corresponding plid]
+                                  [plid corresponding])
             tooltips? (< n-keys 256)]
-        (println "ACTIONS/DISPLAY-PLAN" plan-id "TYPE" type "OPTS" opts
-          "showing-loaded?" showing-loaded? "load-tpn?" load-tpn?
+        (println "ACTIONS/DISPLAY-PLAN" plid "TYPE" type "OPTS" opts
+          "plid-loaded?" plid-loaded?
+          "load-corresponding?" load-corresponding?
           "focus" focus)
-        (if showing-loaded?
+        (if (and plid-loaded? (not load-corresponding?))
           (do
-            (status-msg "display-plan" plan-id)
-            (st/app-set :app/title (name plan-id))
+            (status-msg "display-plan" plid)
+            (st/app-set :app/title (name plid))
             (st/tooltips tooltips?)
-            (st/show-plan plan-id)
+            (st/show-plan plid)
             (reset opts)
             (if corresponding
               (highlight-relevant))
             (if (and focus (keyword-identical? type :tpn-network))
-              (htn-focus-tpn plan-id (:ui/show-network (st/get-ui-opts))
+              (htn-focus-tpn plid (:ui/show-network (st/get-ui-opts))
                 corresponding focus (as-boolean focus))))
-          (if load-tpn?
-            (-> (load-plan corresponding) ;; LOAD TPN first!
-              (sleep 5) ;; pace the browser
-              (chain #(load-plan plan-id opts))
-              (sleep 100) ;; pace the browser, let TPN finish
-              (chain #(display-plan plan-id opts))
+          (if load-corresponding?
+            (-> (load-plan tpn-plan) ;; LOAD TPN first!
+              (sleep load-delay) ;; pace the browser
+              (chain #(load-plan htn-plan opts))
+              (sleep load-delay) ;; pace the browser, let TPN finish
+              (chain #(display-plan plid opts))
               (tasks/catch #(do
-                              ;; (status-msg "unable to show" plan-id)
+                              (status-msg "unable to show" plid)
                               (st/loading false)
                               (st/app-set :app/loading nil))))
-            (-> (load-plan plan-id opts)
-              (sleep 5) ;; pace the browser
-              (chain #(display-plan plan-id opts))
+            (-> (load-plan plid opts)
+              (sleep load-delay) ;; pace the browser
+              (chain #(display-plan plid opts))
               (tasks/catch #(do
-                              ;; (status-msg "unable to show" plan-id)
+                              (status-msg "unable to show" plid)
                               (st/loading false)
                               (st/app-set :app/loading nil))))))
         true)))) ;; for deferreds
@@ -1124,23 +1160,30 @@
           (not n-keys)
           (do
             (println "cannot load unknown plan" plan-id)
-            (error! d (str "cannot load unknown plan " plan-id)))
+            (tasks/timeout
+              #(error! d (str "cannot load unknown plan " plan-id)))
+            dtimeout)
           (and loaded? (not reload?))
           (do
-            (success! d (str "already loaded plan " plan-id)))
+            ;; (println "DEBUG: already loaded plan" plan-id)
+            (tasks/timeout
+              #(success! d (str "already loaded plan " plan-id)))
+            dtimeout)
           (st/app-get :app/loading)
           (do
             (println "cannot load " plan-id
               " because a load is already in progress...")
-              (error! d (str "cannot load " plan-id
-                           " because a load is already in progress...")))
+            ;; (error! d (str "cannot load " plan-id
+            ;;             " because a load is already in progress..."))
+            (chain dtimeout #(load-plan plan-id opts)))
           :else
           (do
             (status-msg "loading" plan-id)
             (st/loading true)
             (st/app-set :app/loading d)
-            (request-plan-part plan-id have-parts)))
-        dtimeout))))
+            (request-plan-part plan-id have-parts)
+            dtimeout
+            ))))))

 (defn reload-plan [plan-id]
   (-> (load-plan plan-id {:reload? true})
@@ -1286,11 +1329,10 @@
                   (partial max
                     (get-in edge-states [state policy]))))
               (if-not network-updates?
-                (st/plans-merge-edge (assoc
-                                       (dissoc edge
-                                         :plans/ui-opts
-                                         :edge/from :edge/to)
-                                       :edge/hidden hidden)))
+                (st/plans-merge-edge
+                  (assoc
+                    (dissoc edge :plans/ui-opts :edge/from :edge/to)
+                    :edge/hidden hidden)))
               (when (activity? type)
                 (node-key-fn to)))))))
     (get (if (keyword-identical? policy :parallel)
@@ -1319,7 +1361,8 @@
           (let [{:keys [edge/type edge/hidden]} edge]
             (when (keyword-identical? type :aggregation)
               (st/plans-merge-edge
-                (assoc edge
+                (assoc
+                  (dissoc edge :plans/ui-opts :edge/from :edge/to)
                   :edge/state rollup
                   :edge/hidden (not aggregated?)))
               (if aggregated?
@@ -1357,20 +1400,20 @@
       ;; hide parents and siblings (or show all)
       (visit-nodes begin visited
         (fn [node]
-          (st/plans-merge-node (assoc
-                                 (dissoc node :plans/ui-opts :node/tpn-selection)
-                                 :node/hidden focus?
-                                 :node/aggregated? false))
+          (st/plans-merge-node
+            (assoc
+              (dissoc node :plans/ui-opts :node/tpn-selection)
+              :node/hidden focus?
+              :node/aggregated? false))
           (map-outgoing node
             (fn [edge]
               (let [{:keys [edge/type edge/to edge/hidden]} edge]
                 (when (#{:parallel-edge :choice-edge} type)
                   (if (not= focus? hidden)
-                    (st/plans-merge-edge (assoc
-                                           (dissoc edge
-                                             :plans/ui-opts
-                                             :edge/from :edge/to)
-                                           :edge/hidden focus?)))
+                    (st/plans-merge-edge
+                      (assoc
+                        (dissoc edge :plans/ui-opts :edge/from :edge/to)
+                        :edge/hidden focus?)))
                   (node-key-fn to)))))))
       ;; signal my action (before pan/zoom)
       (if e (my-user-action {:type :menu :tag tag :plid plid :node id}))
@@ -1378,11 +1421,11 @@
       (when focus?
         (visit-nodes node-id #{}
           (fn [node]
-            (st/plans-merge-node (assoc
-                                   (dissoc node :plans/ui-opts :node/tpn-selection)
-                                   :node/hidden false
-                                   :node/aggregated?
-                                   (keyword-identical? id (:node/id node))))
+            (st/plans-merge-node
+              (assoc
+                (dissoc node :plans/ui-opts :node/tpn-selection)
+                :node/hidden false
+                :node/aggregated? (keyword-identical? id (:node/id node))))
             (swap! bounds (fn [{:keys [xbounds ybounds]}]
                             (let [{:keys [node/x node/y]} node]
                               {:xbounds (min-max-fn xbounds [x x])
@@ -1392,11 +1435,10 @@
                 (let [{:keys [edge/type edge/to edge/hidden]} edge]
                   (when (#{:parallel-edge :choice-edge} type)
                     (if hidden
-                      (st/plans-merge-edge (assoc
-                                             (dissoc edge
-                                               :plans/ui-opts
-                                               :edge/from :edge/to)
-                                             :edge/hidden false)))
+                      (st/plans-merge-edge
+                        (assoc
+                          (dissoc edge :plans/ui-opts :edge/from :edge/to)
+                          :edge/hidden false)))
                     (node-key-fn to)))))))
         (zoom-to-bounds @bounds e))
       (if-not focus?
@@ -1407,36 +1449,40 @@
 (defn user-action [action]
   (println "USER-ACTION" action)
   (let [client (st/app-get :app/client)
-        {:keys [planviz remote nick type plid selection pan zoom chat
-                tag node edge url tab info network-flows]} action
-        {:keys [loaded? corresponding]} (st/app-get-plan plid)
-        corresponding-loaded? (:loaded? (st/app-get-plan corresponding))
         ui-opts (st/get-ui-opts)
         showing (:ui/show-plan ui-opts)
         show-network (:ui/show-network ui-opts)
         auto-on? (auto?)
         blank-screen? (no-plan? showing)
-        ;; to-show (if blank-screen?
-        ;;           (or corresponding plid)
-        ;;           showing)
+        {:keys [planviz remote nick type plid selection pan zoom chat
+                tag node edge url tab info network-flows]} action
+        action-type type
+        {:keys [loaded? type corresponding]} (st/app-get-plan plid)
+        plid-type type
+        plid-loaded? loaded?
+        {:keys [loaded?]} (st/app-get-plan corresponding)
+        load-corresponding? (and corresponding (not loaded?))
+        [tpn-plan htn-plan] (if (keyword-identical? plid-type :htn-network)
+                              [corresponding plid]
+                              [plid corresponding])
         to-show (if (and auto-on?
                       (not= remote client))
-                    (or corresponding plid))
-        ready? (or
-                 (nil? to-show)
-                 (and (= to-show plid showing) loaded?)
-                 (and (= to-show corresponding showing) corresponding-loaded?))]
+                  (or corresponding plid))
+        ready? (and plid-loaded? (not load-corresponding?)
+                 (= showing to-show))
+        opts {:auto true}]
     (println "  blank-screen?" blank-screen? "showing" showing
-      "loaded?" loaded? "corresponding" corresponding
-      "corresponding-loaded?" corresponding-loaded?
+      "plid" plid "plid-loaded?" plid-loaded?
+      "corresponding" corresponding "loaded?" loaded?
+      "tpn-plan" tpn-plan "htn-plan" htn-plan
       "to-show" to-show "ready?" ready?)
     (if ready?
       (do
-        (case type
+        (case action-type
           :selection
           (when (and (not= remote client) auto-on?)
             (println "REMOTE SET-SELECTION" action)
-            (set-selection plid selection {:auto true})
+            (set-selection plid selection opts)
             (if (keyword-identical? corresponding showing)
               (highlight-relevant (or nick remote))))
           :pan-zoom
@@ -1451,15 +1497,15 @@
           (when (and (not= remote client) auto-on?)
             (cond
               (keyword-identical? tag :info)
-              (println "USER-ACTION type" type "TAG" tag
+              (println "USER-ACTION type" action-type "TAG" tag
                 "NODE" node "EDGE" edge "INFO" info)
               (keyword-identical? tag :url)
-              (println "USER-ACTION type" type "TAG" tag
+              (println "USER-ACTION type" action-type "TAG" tag
                 "URL" url "TAB" tab)
               (#{:htn-focus :htn-blur} tag)
               (let [focus? (keyword-identical? tag :htn-focus)
                     node-id (composite-key plid node)]
-                (println "USER-ACTION type" type "TAG" tag "NODE" node)
+                (println "USER-ACTION type" action-type "TAG" tag "NODE" node)
                 (if (keyword-identical? plid showing)
                   (focus-menu-fn (st/plans-get-node node-id) nil {:tag tag} nil)
                   (st/app-set-plan-value plid :focus (if focus? node-id)))
@@ -1467,7 +1513,7 @@
                   (htn-focus-tpn showing show-network plid node-id focus?)))
               (#{:tpn-show :tpn-hide} tag)
               (let [{:keys [network/begin network/end]} (st/get-network-basics plid)]
-                (println "USER-ACTION type" type "TAG" tag "NODE" node)
+                (println "USER-ACTION type" action-type "TAG" tag "NODE" node)
                 (when (keyword-identical? plid showing)
                   (if (and (keyword-identical? tag :tpn-show)
                         (keyword-identical? node begin))
@@ -1475,33 +1521,42 @@
                     (aggregation-menu-fn (st/plans-get-node (composite-key plid node))
                       nil {:tag tag} nil))))
               (keyword-identical? tag :tpn-network-flows)
-              (println "USER-ACTION type" type "TAG" tag
+              (println "USER-ACTION type" action-type "TAG" tag
                 "NODE" node "NETWORK-FLOWS" network-flows)
               :else
-              (println "USER-ACTION type" type "TAG" tag "not supported")))
-          (println "USER-ACTION type" type "not supported"))
+              (println "USER-ACTION type" action-type "TAG" tag "not supported")))
+          (println "USER-ACTION type" action-type "not supported"))
         true) ;; for deferred
-      (-> (load-plan plid) ;; loading on demand
-        (sleep 3000) ;; pace the browser
-        (chain #(display-plan to-show))
-        (sleep 100) ;; pace the browser
-        (chain #(user-action action))))))
-
-(defn add-plan [plid plan-details]
-  (let [{:keys [ui/show-plan ui/show-network ui/network-type]} (st/get-ui-opts)
-        {:keys [n-keys loaded? corresponding]} (st/app-get-plan plid)]
-    ;; (println "ADD-PLAN" plid "DETAILS" plan-details
-    ;;   "loaded?" loaded? "show-plan" show-plan)
-    (if-not n-keys
-      (st/app-set-plan plid plan-details))
-    (status-msg "executing" plid)
-    (if loaded?
-      ;; only switch if not currently showing this plan or the corresponding one
-      (when-not (or (= show-plan plid) (= show-plan corresponding))
-        (display-plan plid))
-      (-> (load-plan plid) ;; loading on demand
-        (sleep 5) ;; pace the browser
-        (chain #(display-plan plid))))))
+      (if load-corresponding?
+        (-> (load-plan tpn-plan opts) ;; LOAD TPN first!
+          (sleep 5) ;; pace the browser
+          (chain #(load-plan htn-plan opts))
+          (sleep 5) ;; pace the browser
+          (chain #(display-plan to-show opts))
+          (sleep 5) ;; pace the browser
+          (chain #(user-action action)))
+        (-> (load-plan plid opts) ;; loading on demand
+          (sleep 5) ;; pace the browser
+          (chain #(display-plan to-show opts))
+          (sleep 5) ;; pace the browser
+          (chain #(user-action action)))))))
+
+;; FIXME: verify TPN before HTN
+;; (defn add-plan [plid plan-details]
+;;   (let [{:keys [ui/show-plan ui/show-network ui/network-type]} (st/get-ui-opts)
+;;         {:keys [n-keys loaded? corresponding]} (st/app-get-plan plid)]
+;;     ;; (println "ADD-PLAN" plid "DETAILS" plan-details
+;;     ;;   "loaded?" loaded? "show-plan" show-plan)
+;;     (if-not n-keys
+;;       (st/app-set-plan plid plan-details))
+;;     (status-msg "executing" plid)
+;;     (if loaded?
+;;       ;; only switch if not currently showing this plan or the corresponding one
+;;       (when-not (or (= show-plan plid) (= show-plan corresponding))
+;;         (display-plan plid))
+;;       (-> (load-plan plid) ;; loading on demand
+;;         (sleep 5) ;; pace the browser
+;;         (chain #(display-plan plid))))))

 ;; set the state of all nodes and edges to normal in the
 ;; selected and corresponding plan(s)
@@ -1559,7 +1614,7 @@
         (doseq [edge edges]
           (if (activity? edge)
             (st/plans-merge-edge
-              (assoc (dissoc edge :edge/from :edge/to)
+              (assoc (dissoc edge :plan/ui-opts :edge/from :edge/to)
                 :edge/state :normal
                 :edge/hidden
                 (keyword-identical? (:edge/type edge) :aggregation)
@@ -1586,7 +1641,7 @@
         (doseq [edge edges]
           (if (keyword-identical? (:edge/type edge) :activity)
             (st/plans-merge-edge
-              (assoc (dissoc edge :edge/from :edge/to)
+              (assoc (dissoc edge :plan/ui-opts :edge/from :edge/to)
                 :edge/state (get edge-states-keys
                               (mod (swap! i inc) edge-states-n))))))))))

@@ -1978,8 +2033,8 @@
         menu (:ui/menu (st/get-ui-opts))
         target (.-target e)
         ]
-    (println "CLICK" button "@" (.-clientX e) "," (.-clientY e)
-      "b?" browser-contextmenu?)
+    ;; (println "CLICK" button "@" (.-clientX e) "," (.-clientY e)
+    ;;   "b?" browser-contextmenu?)
     ;; (reset! debug-target target)
     ;; (println "bubbles" (.-bubbles e)
     ;;   "cancelable" (.-cancelable e))


Whitespace

Whitespace

--- src/braid/map_embeds/core.cljc
+++ src/braid/map_embeds/core.cljc
@@ -57,5 +57,3 @@
            {:width "100%"}]]

          :priority 1}))))
-
-


Adds markup and responses for auth.

Adds markup and responses for auth.

--- src/cadence/views/training.clj
+++ src/cadence/views/training.clj
@@ -99,8 +99,14 @@

 (defpage auth "/user/auth" []
   (common/layout
-    (let [phrase (model/get-phrase (:_id (model/get-auth)) true)]
-      (common/phrase-fields "authenticate" phrase))))
+    (let [phrase (:phrase (model/get-phrase (:_id (model/get-auth)) true))]
+      (html
+        [:div.page-header [:h1 "Authencticate"]]
+        [:p "If you don't know what this is for please checkout the "
+         (link-to "/#auth" "blurb on the front page") "."]
+        [:div#auth_well.well.container-fluid
+         (common/phrase-fields "authenticate" phrase)
+         [:div#feedback.row-fluid]]))))

 (defpage auth-check [:post "/user/auth"] {:as unkeyed-cadence}
    (let [cadence (keywordize-keys unkeyed-cadence)]
@@ -108,6 +114,12 @@
        (if (patrec/cadence-matches? (model/get-classifier (:_id (model/get-auth))
                                                           (:phrase cadence))
                                     cadence)
-         (flash/put! "Would you look at that, you're you!")
-         (flash/put! "Are you a sneaking spy?"))
-       (flash/put! "There was an error with the cadence you submitted."))))
+         (resp/json {:success true
+                     :conclusive true
+                     :legit true})
+         (resp/json {:sucess true
+                     :conclusive true
+                     :legit false}))
+       (resp/json {:success false
+                   :conclusive false
+                   :legit false}))))


Update doc to mention proper meta (#469)

To use `expose-testables` functions must have the `:testable` meta and not `:private`.

--- test/as_documentation/about_privates/how_to_refer_to_privates_in_facts.clj
+++ test/as_documentation/about_privates/how_to_refer_to_privates_in_facts.clj
@@ -19,7 +19,7 @@
       (#'da/da-called 1) => 8988)))

-;; 2. Alternately, you can tag private vars with ^{:private true} metadata, and then
+;; 2. Alternately, you can tag private vars with ^{:testable true} metadata, and then
 ;;    "expose" them with `expose-testables`.

 (require '[as-documentation.about-privates.privates-for-expose-testables])


Fix moving the file

Fix moving the file

--- src/circleci/backend/build.clj
+++ src/circleci/backend/build.clj
@@ -1,6 +1,6 @@
 (ns circleci.backend.build
   (:use [arohner.utils :only (inspect fold)])
-  (:use [circleci.backend.action :only (validate-action-result!)])
+  (:use [circleci.backend.action :only (continue? validate-action-result!)])
   (:use [circleci.backend.action.bash :only (with-pwd)])
   (:use [circleci.backend.nodes :only (node-info)]))

@@ -20,8 +20,6 @@
                          action
                          node])

-
-
 (defn run-build [build]
   (println "getting node info")
   (let [node (-> build :group (node-info) (first))]


Plugin css override list handling

Plugin css override list handling

--- src/clj/salava/core/layout.clj
+++ src/clj/salava/core/layout.clj
@@ -31,14 +31,19 @@

 (defn css-list [ctx]
-  (->> [:config :core :plugins]
-       (get-in ctx)
-       (cons :core)
-       (map plugin-str)
-       (map    #(str "/css/" % ".css"))
-       (filter #(io/resource (str "public" %)))
-       (concat asset-css)
-       (map #(with-version ctx %))))
+  (let [plugins (get-in ctx [:config :core :plugins])
+        coll (mapcat #(get-in ctx [:config % :css] []) plugins)]
+    (if-not (empty? coll)
+      ; If any plugin defines a list of css files, use those as-is
+      (map #(with-version ctx %) (concat asset-css coll))
+      ; Otherwise, create the list using plugin names
+      (->> plugins
+           (cons :core)
+           (map plugin-str)
+           (map    #(str "/css/" % ".css"))
+           (filter #(io/resource (str "public" %)))
+           (concat asset-css)
+           (map #(with-version ctx %))))))

 (defn js-list [ctx]


storage helpers

storage helpers

--- src/cljs/swarmpit/storage.cljs
+++ src/cljs/swarmpit/storage.cljs
@@ -1,5 +1,6 @@
 (ns swarmpit.storage
-  (:refer-clojure :exclude [get remove]))
+  (:refer-clojure :exclude [get remove])
+  (:require [swarmpit.token :as token]))

 (def storage (.-localStorage js/window))

@@ -16,4 +17,22 @@
 (defn remove
   "Remove value from browser's localStorage by given `key`"
   [key]
-  (.removeItem storage key))+  (.removeItem storage key))
+
+(defn claims
+  []
+  (->> (get "token")
+       (token/decode-jwt)))
+
+(defn user
+  []
+  (get-in (claims) [:usr :username]))
+
+(defn email
+  []
+  (get-in (claims) [:usr :email]))
+
+(defn admin?
+  []
+  (= "admin"
+     (get-in (claims) [:usr :role])))


Simplify.

Simplify.

--- src/cljs/town_client/data.cljs
+++ src/cljs/town_client/data.cljs
@@ -34,7 +34,7 @@
          (if (seq all-params) "?")
          (map->query all-params))))

-(defn get-data [type params path-elements data-channel]
+(defn fetch-data [data-channel type params & path-elements]
   (go
     (let [channels (ajax/make-request
                     (api-url type params path-elements))
@@ -46,9 +46,6 @@
                            ["Error fetching"
                             type params path-elements
                             "status" (:status value)]))))))
-
-(defn fetch-data [channel type params & path-elements]
-  (get-data type params path-elements channel))

 #_(
   ; REPL interaction


Add missing copyright preamble on kdf ns.

--- src/clojure/buddy/core/kdf.clj
+++ src/clojure/buddy/core/kdf.clj
@@ -1,3 +1,17 @@
+;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.be>
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License")
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;;     http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+
 (ns buddy.core.kdf
   "Key derivation function interface."
   (:require [buddy.core.hash :as hash])


shuffle

shuffle

--- src/clojure/nossal/coupons.clj
+++ src/clojure/nossal/coupons.clj
@@ -83,7 +83,7 @@
                 [:section.others
                   [:p.intro "Quer mais descontos?"]

-                  [:p (map (fn [x] [:a {:href (str "/cupons/" x)} "Cupom " (first ((coupom-codes x) :title)) " " [:span (rest ((coupom-codes x) :title))] ]) (keep #(if (not= service %) %) (keys coupom-codes)))]]
+                  [:p (map (fn [x] [:a {:href (str "/cupons/" x)} "Cupom " (first ((coupom-codes x) :title)) " " [:span (rest ((coupom-codes x) :title))] ]) (keep #(if (not= service %) %) (shuffle (keys coupom-codes))))]]
                 [:footer
                   [:p "Este é um presente do fundo " [:a {:href "https://noss.al/"} "do meu ❤"] " para você."]]


http-kit/clojure: (range i) is the same as (range 0 i).

--- src/clojure/src/dnsresolvh.clj
+++ src/clojure/src/dnsresolvh.clj
@@ -67,7 +67,7 @@

     (let [i (count banner-text)]

-    (print (apply str (for [_ (range 0 i)] "=")))) (newline)
+    (print (apply str (for [_ (range i)] "=")))) (newline)
 )

 ; vim:set nu et ts=4 sw=4:


Bugfix: Inspector would sometimes use old node cursors

--- src/alder/ui/components/inspector.cljs
+++ src/alder/ui/components/inspector.cljs
@@ -33,8 +33,8 @@
         inspector-origin (math/mult-point (:matrix graph-xform) inspector-origin)
         [inspector-x inspector-y] inspector-origin]
     (letfn [(set-input-value [node input value]
-              (om/update! node
-                          (node/set-input-value node input value)))
+              (om/transact! node
+                            (fn [n] (node/set-input-value n input value))))

             (render-input-container [input]
               (html


Remove the original atom_counts

Remove the original atom_counts

--- src/atom_finder/script/atom_counts.clj
+++ src/atom_finder/script/atom_counts.clj
@@ -1,37 +0,0 @@
-(ns atom-finder.scripts.atom-counts
-  (:require
-   [atom-finder.util :refer :all]
-   [atom-finder.constants :refer :all]
-   [atom-finder.classifier :refer :all]
-   [clojure.pprint :refer [pprint]]
-   [clojure.set :as set]
-   [schema.core :as s]
-   [clojure.data.csv :as csv]
-   [clojure.string :as str]
-   )
-  (:import
-   [org.eclipse.cdt.core.dom.ast IASTNode]
-   )
-  )
-
-'(->> "~/opt/src/linux"
-      expand-home
-      (pmap-dir-trees
-       (fn [root]
-         {:file (str/replace-first (.getFilePath root) #".*(?=linux)" "")
-          :atom-counts (map-values #(count ((:finder %) root)) atom-lookup)}))
-      (map prn)
-      dorun
-      (log-to "tmp/linux-atom-counts_2017-07-06_01.edn")
-      time
-      )
-
-(->> "linux-atom-counts_2017-09-23_1.edn"
-     ;"gcc-atom-counts_2017-09-23_2.edn"
-     read-data
-     (map :atom-counts)
-     (reduce (partial merge-with +))
-     ((fn [h]
-        (println (clojure.string/join "," (keys h) ))
-        (println (clojure.string/join "," (vals h) ))))
-     pprint)


Remove duplicate routes

Remove duplicate routes

--- src/braid/server/routes/api/public.clj
+++ src/braid/server/routes/api/public.clj
@@ -329,29 +329,3 @@
                  :session nil})))
         {:status 400
          :body "Couldn't exchange token with github"})))
-
-(defroutes api-private-routes
-  (GET "/changelog" []
-    (edn-response {:braid/ok
-                   (-> (io/resource "CHANGELOG.md")
-                       slurp markdown->hiccup)}))
-
-  (GET "/extract" [url :as {ses :session}]
-    (if (some? (user/user-by-id (:user-id ses)))
-      (edn-response (link-extract/extract url))
-      {:status 403
-       :headers {"Content-Type" "application/edn"}
-       :body (pr-str {:error "Unauthorized"})}))
-
-  (GET "/s3-policy" req
-    (if (some? (user/user-by-id (get-in req [:session :user-id])))
-      (if-let [policy (s3/generate-policy)]
-        {:status 200
-         :headers {"Content-Type" "application/edn"}
-         :body (pr-str policy)}
-        {:status 500
-         :headers {"Content-Type" "application/edn"}
-         :body (pr-str {:error "No S3 secret for upload"})})
-      {:status 403
-       :headers {"Content-Type" "application/edn"}
-       :body (pr-str {:error "Unauthorized"})})))


Use format-strings in logging

Use format-strings in logging

--- src/discuss/utils/logging.cljs
+++ src/discuss/utils/logging.cljs
@@ -1,7 +1,9 @@
 (ns discuss.utils.logging
   (:require [goog.log :as glog]
             [discuss.config :as config]
-            [clojure.string :as string]))
+            [clojure.string :as string]
+            [goog.string :refer [format]]
+            [goog.string.format]))

 (def logger (glog/getLogger config/project))

@@ -13,31 +15,36 @@
              :finer goog.debug.Logger.Level.FINER
              :finest goog.debug.Logger.Level.FINEST})

-(defn set-level! [level]
+(defn- set-level! [level]
   (.setLevel logger (get levels level (:info levels))))

-(defn fmt [msgs]
+(defn- fmt [msgs]
   (string/join " " (map pr-str msgs)))

-(defn info [& s]
-  (let [msg (fmt s)]
-    (glog/info logger msg)))
+(defn- format-string
+  "Takes a format string and sets all parameters if available. When only one
+  parameter is provided, this value will be returned."
+  ([fstring params]
+   (apply #(format fstring %) params))
+  ([fstring] fstring))

-(defn debug [& s]
-  (let [msg (fmt s)]
-    (glog/fine logger msg)))
+(defn- make-logging-fn [f fstring params]
+  (f logger (format-string fstring params)))

-(defn error [& s]
-  (let [msg (fmt s)]
-    (glog/error logger msg)))
+(defn info [fstring & params]
+  (make-logging-fn glog/info fstring params))

-(defn warning [& s]
-  (let [msg (fmt s)]
-    (glog/warning logger msg)))
+(defn debug [fstring & params]
+  (make-logging-fn glog/fine fstring params))

-(defn fine [& s]
-  (let [msg (fmt s)]
-    (glog/fine logger msg)))
+(defn error [fstring & params]
+  (make-logging-fn glog/error fstring params))
+
+(defn warning [fstring & params]
+  (make-logging-fn glog/warning fstring params))
+
+(defn fine [fstring & params]
+  (make-logging-fn glog/fine fstring params))

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


Add two versions of main page. Add login menu.

--- src/clj/hatnik/web/server/renderer.clj
+++ src/clj/hatnik/web/server/renderer.clj
@@ -14,77 +14,105 @@
        "client_id=" (:github-id config)
        "&scope=user:email"))

-(defn page-header []
+(defn modal-frames []
+  (hc/html
+   [:div#iModal.modal.fade {:data-keyboard "true"}
+    [:div#iModalDialog.modal-dialog
+     [:div.modal-content
+      [:div#iActionFormHeader.modal-header]
+      [:div#iActionFormBody.modal-body]
+      [:div#iActionFormFooter.modal-footer]]]]
+
+   [:div#iModalProject.modal.fade {:data-keyboard "true"}
+    [:div.modal-dialog
+     [:div.modal-content
+      [:div.modal-header
+       [:h4.modal-title "Creating a new project"]]
+      [:div.modal-body
+       [:form
+        [:input#project-name-input.form-control
+         {:type "text"
+          :placeholder "Project name"}]]]
+      [:div.modal-footer
+       [:button.btn.btn-primary {:onClick "hatnik.web.client.z_actions.send_new_project_request()"} "Create"]]]]]
+
+   [:div#iModalProjectMenu.modal.fade
+    [:div.modal-dialog
+     [:div.modal-content
+      [:div.modal-header
+       [:h4.modal-title "Project menu"]]
+
+      [:div.modal-body
+       [:form
+        [:input#project-name-edit-input.form-control
+         {:type "text"
+          :placeholder "Project name"}]]]
+
+      [:div.modal-footer
+       [:div.btn.btn-primary.pull-left
+        {:onClick "hatnik.web.client.z_actions.update_project()"}
+        "Update"]
+       [:div.btn.btn-danger.pull-right
+        {:onClick "hatnik.web.client.z_actions.delete_project()"}
+        "Delete"]]]]]))
+
+(defn page-menu [user]
   [:nav.navbar.navbar-default {:role "navigation"}
    [:div#navbarCollapse.collapse.navbar-collapse
-    [:ul.nav.navbar-nav.navbar-right
-     [:li
-      [:a.btn
-       {:href github-link} "Login via GitHub"]]]]])
+    (if user
+                                        ; User log in
+      [:ul.nav.navbar-nav.navbar-right
+       [:li
+        [:a {:href "#"} (:email user)]]
+       [:li
+        [:a.btn {:href "/api/logout"} "Logout"]]]
+
+                                        ; User don't log in
+      [:ul.nav.navbar-nav.navbar-right
+       [:li
+        [:a.btn
+         {:href github-link} "Login via GitHub"]]])]])

+(defn work-main-page [req]
+  (hc/html
+   [:div.page-header
+    [:h2 "Project list"]]
+
+   [:div.row
+    [:div.col-md-2
+     [:a.btn.btn-success
+      {:href "#"
+       :onclick "$('#iModalProject').modal()"} "Create new"]]
+    [:div.col-md-10]]
+
+   [:div
+    [:p ""]]
+   [:div#iProjectList.panel-group "Loading..."]))
+
+(defn about-page []
+  [:div.page-header
+   [:h2 "Hatnik?"]])
+
 (defn core-page [req]
-  (hc/html
-   (page-html-head)
-
-   [:body
+  (let [user (:user (:session req))]
+    (hc/html
+     (page-html-head)
+
+     [:body
+      [:div.container
+       (page-menu user)
+
+       (if user
+         (work-main-page req)
+         (about-page))]

-    [:div.container
-     (page-header)
-     [:div.page-header
-      [:h2 "Project list"]]
-
-     [:div.row
-      [:div.col-md-2
-       [:a.btn.btn-success
-        {:href "#"
-         :onclick "$('#iModalProject').modal()"} "Create new"]]
-      [:div.col-md-10]]
-     [:div
-      [:p ""]]
+       (when user (modal-frames))

-     [:div#iProjectList.panel-group "Loading..."]]
+      [:script {:src "/js/jquery-2.1.1.min.js"}]
+      [:script {:src "/js/bootstrap.min.js"}]
+      [:script {:src "http://fb.me/react-0.11.1.js"}]
+
+      (when user
+        [:script {:src "/gen/js/hatnik.js"}])
+])))

-    [:div#iModal.modal.fade {:data-keyboard "true"}
-     [:div#iModalDialog.modal-dialog
-      [:div.modal-content
-       [:div#iActionFormHeader.modal-header]
-       [:div#iActionFormBody.modal-body]
-       [:div#iActionFormFooter.modal-footer]]]]
-
-    [:div#iModalProject.modal.fade {:data-keyboard "true"}
-     [:div.modal-dialog
-      [:div.modal-content
-       [:div.modal-header
-        [:h4.modal-title "Creating a new project"]]
-       [:div.modal-body
-        [:form
-         [:input#project-name-input.form-control
-          {:type "text"
-           :placeholder "Project name"}]]]
-      [:div.modal-footer
-        [:button.btn.btn-primary {:onClick "hatnik.web.client.z_actions.send_new_project_request()"} "Create"]]]]]
-
-    [:div#iModalProjectMenu.modal.fade
-     [:div.modal-dialog
-      [:div.modal-content
-       [:div.modal-header
-        [:h4.modal-title "Project menu"]]
-
-       [:div.modal-body
-        [:form
-         [:input#project-name-edit-input.form-control
-          {:type "text"
-           :placeholder "Project name"}]]]
-
-       [:div.modal-footer
-        [:div.btn.btn-primary.pull-left
-         {:onClick "hatnik.web.client.z_actions.update_project()"}
-         "Update"]
-        [:div.btn.btn-danger.pull-right
-         {:onClick "hatnik.web.client.z_actions.delete_project()"}
-         "Delete"]]]]]
-
-    [:script {:src "/js/jquery-2.1.1.min.js"}]
-    [:script {:src "/js/bootstrap.min.js"}]
-    [:script {:src "http://fb.me/react-0.11.1.js"}]
-    [:script {:src "/gen/js/hatnik.js"}]]))


Linear decay is effectively the default.

--- src/clj/runbld/notifications/slack.clj
+++ src/clj/runbld/notifications/slack.clj
@@ -17,7 +17,7 @@
   (do
     ((opts :logger) "NOTIFYING SLACK")
     (try-try-again
-     {:sleep 500 :tries 20 :decay try/linear}
+     {:sleep 500 :tries 20}
      #(http/post hook
                  {:body js}))))


Add crushing wall trigger cell

Add crushing wall trigger cell

--- src/cljc/robinson/dungeons/temple.cljc
+++ src/cljc/robinson/dungeons/temple.cljc
@@ -163,8 +163,19 @@
          cells-xy)))

 (defn add-crushing-wall
-  [cellsxy]
-  cellsxy)
+  [min-x min-y max-x max-y cellsxy]
+  (if-let [[trap-x trap-y _] (first (filter (fn [[_ _ cell]] (= (get cell :type) :floor)) (rr/rnd-shuffle cellsxy)))]
+    (map (fn [[x y cell]]
+           (if (and (= x trap-x)
+                    (= y trap-y))
+             [x y (assoc cell :type         :crushing-wall-trigger
+                               :room-bounds {:min-x min-x
+                                             :min-y min-y
+                                             :max-x max-x
+                                             :max-y max-y})]
+             [x y cell]))
+           cellsxy)
+    cellsxy))

 (defn add-wall-darts
   [cellsxy]
@@ -187,7 +198,7 @@
   cellsxy)

 (defn add-trap
-  [cellsxy]
+  [min-x min-y max-x max-y cellsxy]
   (case (rr/rand-nth [:crushing-wall :wall-darts :spike-pit :rolling-boulder :snake-trap :gas-trap])
     :crushing-wall
       (add-crushing-wall cellsxy)
@@ -252,7 +263,7 @@
                       cellsxy)
         cellsxy (add-room-features level cellsxy)
         cellsxy (if trap-room?
-                  (add-trap cellsxy)
+                  (add-trap min-x min-y max-x max-y cellsxy)
                   cellsxy)]
    cellsxy))


compare to float instead of decimal

compare to float instead of decimal

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -346,13 +346,12 @@

 (defn- transform-transaction
   [{:keys [quantity
-           account-id
            other-account-id]
     :as quick-entry-trx}]
-  (let [rename-map (if (or (and (> quantity 0M)
-                                (left-side? account))
-                           (and (< quantity 0M)
-                                (not (left-side? account))))
+  (let [rename-map (if (or (and (> quantity 0)
+                                (left-side? @account))
+                           (and (< quantity 0)
+                                (not (left-side? @account))))
                      {:account-id :debit-account-id
                       :other-account-id :credit-account-id}
                      {:account-id :credit-account-id


encode the redirect uri as well

encode the redirect uri as well

--- src/cljs/main/broadfcui/endpoints.cljs
+++ src/cljs/main/broadfcui/endpoints.cljs
@@ -380,7 +380,7 @@

 (defn profile-link-fence-account [provider oauth-code oauth-state redirect-uri on-done ]
   (ajax/call-bond
-   (str "/link/v1/" provider "/oauthcode?oauthcode=" oauth-code "&redirect_uri=" redirect-uri "&state=" (js/encodeURIComponent oauth-state))
+   (str "/link/v1/" provider "/oauthcode?oauthcode=" oauth-code "&redirect_uri=" (js/encodeURIComponent redirect-uri) "&state=" (js/encodeURIComponent oauth-state))
    {:method :post
     :on-done on-done}))


Added real assertion for basic test case.

--- test/blutwurst/database_test.clj
+++ test/blutwurst/database_test.clj
@@ -20,6 +20,7 @@
        (create-test-tables connection-string)
      (let [table-graph (retrieve-table-graph spec)]
        (println table-graph)
-       (is (not (= table-graph nil)))
+       (is (= {:tables '({:name "PERSON" :schema "DBO" :columns ({:name "NAME"} {:name "ID"})})}
+              table-graph))
        ))
    ))


[#165] `atomic*`: eval `max-cas-attempts` (@MysteryMachine)

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -414,9 +414,9 @@

 (defmacro atomic* "Alpha - subject to change. Low-level transaction util."
   [conn-opts max-cas-attempts on-success on-failure]
-    (assert (>= max-cas-attempts 1))
   `(let [conn-opts#  ~conn-opts
          max-idx#    ~max-cas-attempts
+         _# (assert (>= max-idx# 1))
          prelude-result# (atom nil)
          exec-result#
          (wcar conn-opts# ; Hold 1 conn for all attempts


Adding unit tests for multimethod callback functions.

--- test/org/httpkit/client_test.clj
+++ test/org/httpkit/client_test.clj
@@ -61,6 +61,26 @@
                    (/ (double (- (. System (nanoTime)) start#)) 1000000.0)
                    " msecs"))))

+(defmulti callback-multi
+  "Assertions to check multimethods can be used as callbacks"
+  :status)
+
+(defmethod callback-multi 200
+  [{status :status :as resp}]
+  (is (= 200 status))
+  resp)
+
+(defmethod callback-multi 404
+  [{status :status :as resp}]
+  (is (= 404 status))
+  resp)
+
+(defmethod callback-multi :default
+  [{status :status :as resp}]
+  (is (not= 200 status))
+  (is (not= 404 status))
+  resp)
+
 (deftest test-http-client
   (doseq [host ["http://127.0.0.1:4347" "http://127.0.0.1:14347"]]
     (is (= 200 (:status @(http/get (str host "/get") (fn [resp]
@@ -77,6 +97,9 @@
     (is (= 200 (:status @(http/head (str host "/get")))))
     (is (= 200 (:status @(http/post (str host "/post")))))
     (is (= 404 (:status @(http/get (str host "/404")))))
+    (is (= 200 (:status @(http/get (str host "/get") callback-multi))))
+    (is (= 404 (:status @(http/get (str host "/404") callback-multi))))
+    (is (= 204 (:status @(http/get (str host "/204") callback-multi))))
     (let [url (str host "/get")]
       (doseq [_ (range 0 10)]
         (let [requests (doall (map (fn [u] (http/get u)) (repeat 20 url)))]


adjust actions to new command attributes

--- src/aerobio/actions.clj
+++ src/aerobio/actions.clj
@@ -62,14 +62,14 @@

 (defmethod action :run
   [_ eid params get-toolinfo template]
-  (let [{:keys [user cmd action rep compfile]} params
-        rep (if rep :rep nil)
+  (let [{:keys [user cmd phase modifier compfile]} params
+        rep (if modifier :rep nil)
         exp (cmn/get-exp-info eid :exp)
         user (get-mail-recipient user)]
     (cmn/launch-action
      eid user
      get-toolinfo template
-     :action action
+     :action phase
      :rep rep
      :compfile compfile)))

@@ -86,8 +86,8 @@
 #_(->> (cmn/exp-ids) (map #(cmn/get-exp-info % :stats)))
 (defmethod action :rerun
   [_ eid params get-toolinfo template]
-  (let [{:keys [user cmd action rep compfile]} params
-        rep (if rep :rep nil)
+  (let [{:keys [user cmd phase modifier compfile]} params
+        rep (if modifier :rep nil)
         outdir (cmn/get-exp-info eid :out)

         exp (cmn/get-exp-info eid :exp)
@@ -96,7 +96,7 @@
     (cmn/launch-action
      eid user
      get-toolinfo template
-     :action action
+     :action phase
      :rep rep
      :compfile compfile)))

@@ -104,7 +104,7 @@
 (defmethod action :compare
   [_ eid params get-toolinfo template]
   (let [exp (cmn/get-exp-info eid :exp)
-        {:keys [user cmd action rep compfile]} params
+        {:keys [user cmd phase modifier compfile]} params
         recipient (pams/get-params [:email (keyword user)])]
     (cmn/run-comparison
      exp eid recipient compfile get-toolinfo template)))
@@ -112,7 +112,7 @@
 (defmethod action :xcompare
   [_ eid params get-toolinfo template]
   (let [exp (cmn/get-exp-info eid :exp)
-        {:keys [user cmd action rep compfile]} params
+        {:keys [user cmd phase modifier compfile]} params
         user (get-mail-recipient user)]
     (cmn/run-comparison
      exp eid user compfile get-toolinfo template)))
@@ -121,7 +121,7 @@
 (defmethod action :aggregate
   [_ eid params get-toolinfo template]
   (let [exp (cmn/get-exp-info eid :exp)
-        {:keys [user cmd action rep compfile]} params
+        {:keys [user cmd phase modifier compfile]} params
         recipient (pams/get-params [:email (keyword user)])]
     (htts/run-aggregation
      eid recipient compfile get-toolinfo template)))


cleanup, use https connection in meta pipeline to be able to clone without needing a valid ssh key

--- src/devops_101_pipeline/meta/steps.clj
+++ src/devops_101_pipeline/meta/steps.clj
@@ -4,16 +4,13 @@
             [lambdacd.steps.manualtrigger :as manualtrigger]
             [lambdacd.steps.git :as git]))

-(defn pipeline-working-directory []
-  (System/getProperty "user.dir"))
-
-(def devops-101-repo "git@github.com:flosell/devops-101-lambdacd.git") ;; change this if you want to make your own changes
-
+(def devops-101-repo "https://github.com/flosell/lambdacd.git") ;; change this if you want to make your own changes
+(def devops-101-branch "digitalocean")
 (defn wait-for-repo [_ ctx]
-  (git/wait-for-git ctx devops-101-repo "digitalocean"))
+  (git/wait-for-git ctx devops-101-repo devops-101-branch))

 (defn use-digitalocean-branch [& _]
-  {:revision "digitalocean" :status :success})
+  {:revision devops-101-branch :status :success})

 (defn manual-trigger [args ctx]
   (support/chain-steps args ctx
@@ -25,13 +22,8 @@

 (defn build [args ctx]
   (shell/bash ctx (:cwd args)
-              "set -x"
-              "lein test"
               "lein uberjar"))

 (defn deploy [args ctx]
   (shell/bash ctx (:cwd args)
               "bin/deploy-lambdacd.sh"))
-
-(defn stop-to-restart [args ctx]
-  (System/exit 0))


Change implementation to use one shared input queue

--- src/distributed_transducers_poc/rc.clj
+++ src/distributed_transducers_poc/rc.clj
@@ -70,21 +70,18 @@

 (defn uuid [] (str (java.util.UUID/randomUUID)))

-(defn queue-reduce [f xs in-queues out-queue run-locally?]
-  (when run-locally?
-    (doseq [in-queue in-queues]
-      (message-loop (fn [x] (reduce f x)) in-queue out-queue)))
+(defn queue-reduce [f xs in-queue out-queue node-count]
   (let [{:keys [results stop-fn]} (handler-loop out-queue)
         batches (map (fn [a b] [a b]) (partition-all 4096 xs) (range))]
     (thread
       (doseq [[batch index] batches]
-        (sqs/send-message (nth in-queues (mod index (count in-queues)))
-                      {:type "process" :index index :payload batch})))
+        (sqs/send-message in-queue
+                          {:type "process" :index index :payload batch})))
     (let [response (reduce (fn [acc _]
                              (f acc (:payload (<!! results))))
                            (f)
                            batches)]
-      (doseq [in-queue in-queues]
+      (dotimes [_ node-count]
         (sqs/send-message in-queue {:type "stop"}))
       (stop-fn)
       response)))
@@ -96,19 +93,16 @@

 (defn uber-reduce [f f-str xs function-namespace node-count lambda-function-name region]
   (let [out (sqs/create-queue (uuid))
-        in-queues  (doall (map (fn [_]
-                                 (let [queue (sqs/create-queue (uuid))]
-                                   (thread (invoke-lambda {:function f-str
-                                                           :function-namespace (loadable-namespace function-namespace)
-                                                           :in queue
-                                                           :out out}
-                                                          lambda-function-name region))
-                                   queue))
-                               (range node-count)))]
-    (let [response (queue-reduce f xs in-queues out false)]
+        in (sqs/create-queue (uuid))]
+    (dotimes [_ node-count]
+      (thread (invoke-lambda {:function f-str
+                              :function-namespace (loadable-namespace function-namespace)
+                              :in in
+                              :out out}
+                             lambda-function-name region)))
+    (let [response (queue-reduce f xs in out node-count)]
       (Thread/sleep 200)
-      (doseq [in-queue in-queues]
-        (sqs/delete-queue in-queue))
+      (sqs/delete-queue in)
       (sqs/delete-queue out)
       response)))


Changed to remove dev dependencies from the constructed uberwar

--- src/leiningen/ring/uberwar.clj
+++ src/leiningen/ring/uberwar.clj
@@ -2,7 +2,8 @@
   (:use leiningen.ring.util)
   (:require [leiningen.ring.war :as war]
             [leiningen.compile :as compile]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [leinjacker.utils :as lju]))

 (defn default-uberwar-name [project]
   (or (:uberjar-name project)
@@ -40,13 +41,21 @@
     (war/dir-entry war-stream project "" (war/war-resources-path project))
     (jar-entries war-stream project)))

+(defn unmerge-profiles [project]
+  (if-let [unmerge-fn (and (= 2 (lju/lein-generation))
+                           (lju/try-resolve 'leiningen.core.project/unmerge-profiles))]
+    (unmerge-fn project [:default])
+    project))
+
 (defn uberwar
   "Create a $PROJECT-$VERSION.war with dependencies."
   ([project]
      (uberwar project (default-uberwar-name project)))
   ([project war-name]
      (ensure-handler-set! project)
-     (let [project (war/add-servlet-dep project)
+     (let [project (-> project
+                       unmerge-profiles
+                       war/add-servlet-dep)
            result  (compile/compile project)]
        (when-not (and (number? result) (pos? result))
          (let [war-path (war/war-file-path project war-name)]


include large hash map lookup benchmarks

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -222,11 +222,18 @@
     (if (< i 1000)
       (recur (inc i) (conj r [(keyword (str "foo" i)) i]))
       r)))
+(def hash-imap-int-test
+  (loop [i 0 r {}]
+    (if (< i 1000)
+      (recur (inc i) (conj r [i i]))
+      r)))
 (simple-benchmark [coll hash-imap-test] (hash-imap coll) 100)
 (simple-benchmark [coll hash-imap-test] (hash-unordered-coll coll) 100)
 (simple-benchmark [coll pmap] (:f0 coll) 1000000)
 (simple-benchmark [coll pmap] (get coll :f0) 1000000)
 (simple-benchmark [coll pmap] (-lookup coll :f0 nil) 1000000)
+(simple-benchmark [coll pmap] (-lookup ^not-native hash-imap-test :foo500 nil) 1000000)
+(simple-benchmark [coll pmap] (-lookup ^not-native hash-imap-int-test 500 nil) 1000000)
 (simple-benchmark [coll pmap] (assoc coll :g0 32) 1000000)
 (simple-benchmark [coll pmap]
                   (loop [i 0 m coll]


Implement checkpoint on output.

Implement checkpoint on output.

--- src/onyx/plugin/bookkeeper.clj
+++ src/onyx/plugin/bookkeeper.clj
@@ -295,6 +295,8 @@
     (set! in-flight-writes (atom 0))
     this)

+  (checkpoint [this])
+
   (synced? [this epoch]
     (zero? @in-flight-writes)
     true)


Don't start server in future

Don't start server in future

- That just complicates connecting from REPL clients

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -181,19 +181,19 @@
         cli-opts (-> *opts*
                    (select-keys [:host :port :history])
                    (assoc :color (not no-color)
+                          :standalone true
                           :custom-eval eval
                           :custom-init init
                           :skip-default-init skip-init))]
     (core/with-pre-wrap
       (when (or server (not client))
-        (future
-          (try (require 'clojure.tools.nrepl.server)
-               (catch Throwable _
-                 (pod/add-dependencies
-                   (update-in (core/get-env) [:dependencies]
-                     conj '[org.clojure/tools.nrepl "0.2.4"]))))
-          (require 'boot.repl-server)
-          ((resolve 'boot.repl-server/start-server) srv-opts)))
+        (try (require 'clojure.tools.nrepl.server)
+             (catch Throwable _
+               (pod/add-dependencies
+                 (update-in (core/get-env) [:dependencies]
+                   conj '[org.clojure/tools.nrepl "0.2.4"]))))
+        (require 'boot.repl-server)
+        ((resolve 'boot.repl-server/start-server) srv-opts))
       (when (or client (not server))
         (pod/call-worker
           `(boot.repl-client/client ~cli-opts))))))


calling (lazy-seq) in a couple of places

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -153,7 +153,7 @@
   (log/info (str "comp-paths-to-complements: bolt:" ((:morph-ps model) bolt)))
   (into {}
         (map (fn [path]
-               [path (comp-path-to-complements bolt path model depth max-depth)])
+               [path (lazy-seq (comp-path-to-complements bolt path model depth max-depth))])
              (find-comp-paths bolt))))

 (defn comp-path-to-complements
@@ -163,8 +163,8 @@
   (let [spec (get-in bolt path)
         lexemes (shufflefn (get-lexemes model spec))
         bolts-at (if (< depth max-depth)
-                   (generate-all (get-in bolt path) model
-                                 (+ 1 depth) max-depth))
+                   (lazy-seq (generate-all (get-in bolt path) model
+                                           (+ 1 depth) max-depth)))
         lexemes-before-phrases
         (or true (lexemes-before-phrases depth max-depth))]
     (if (not (nil? bolts-at)) (log/info (str "realized? of bolts-at:" (realized? bolts-at))))


use variable 'max-depth' rather than constant '5'

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -55,7 +55,7 @@
   "Return a lazy sequence of every possible tree given a specification and a model."
   [spec model depth & [from-bolts at-path]]
   (log/debug (str "gen@" depth "; spec=" (show-spec spec)))
-  (if (< depth 5)
+  (if (< depth max-depth)
     (let [bolts (or from-bolts
                     (get-bolts-for model spec
                                    depth))]


improve performance by not trying to add lexical heads to parents where [:head :phrasal] = false

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -97,7 +97,9 @@
         ;; this is the relative depth; that is, the depth from the top of the current lightning bolt.
         ;; total-depth, on the other hand, is the depth all the way to the top of the entire
         ;; expression, which might involve several parent lightning bolts.
-        parents (lazy-shuffle (candidate-parents grammar spec))]
+        parents (lazy-shuffle (filter #(= false
+                                          (get-in % [:head :phrasal] false))
+                                      (candidate-parents grammar spec)))]
     (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
           (when (= false (get-in spec [:head :phrasal] false))
             (lazy-mapcat


fix typo

fix typo

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -54,7 +54,7 @@
                       true result))
          result (generate/generate spec model)]
      (if result
-       (conj {:surface #(get-string (get-in % [:italiano]))}
+       (conj {:surface (get-string (get-in result [:italiano]))}
              result)))))

 (defn an-example []