Assert required Atom values and default to some global-metadata values

--- src/io/perun/atom.clj
+++ src/io/perun/atom.clj
@@ -12,13 +12,16 @@
 (defn iso-datetime [date]
   (tf/unparse (tf/formatters :date-time-no-ms) (tc/from-date date)))

-(defn generate-atom-str [posts {:keys [site-title description base-url filename]}]
-  ; FIXME: title and link are required, Schema validation?
+(defn generate-atom-str [posts {:keys [site-title description base-url filename] :as global-metadata}]
+  (assert (seq site-title) "Atom XML requires non-empty site-title")
+  (assert (seq base-url) "Atom XML requires full base-url")
+  ;; FIXME: chould validate that it is an URL?
   (xml/emit-str
     (xml/sexp-as-element
       [:feed {:xmlns "http://www.w3.org/2005/Atom"}
        [:title site-title]
-       (if description [:subtitle description])
+       (if (seq description)
+         [:subtitle description])
        [:link {:href (str base-url filename) :rel "self"}]
        [:link {:href base-url}]
        [:updated (->> (take 10 posts)
@@ -28,18 +31,23 @@
                       reverse
                       first)]
        [:id base-url]
-       (for [{:keys [uuid canonical-url content name author author-email] :as post} (take 10 posts)]
-         [:entry
-          [:id (str "urn:uuid:" uuid)]
-          [:title name]
-          (if canonical-url
-            [:link {:href canonical-url}])
-          [:updated (iso-datetime (updated post))]
-          [:content {:type "html"} (str content)]
-          [:author
-           [:name author]
-           (if author-email [:email author-email])]
-          ])])))
+       (for [{:keys [uuid canonical-url content name author author-email] :as post} (take 10 posts)
+             :let [author (or author (:name (:author global-metadata)))
+                   author-email (or author (:email (:author global-metadata)))]]
+         (do
+           (assert (seq uuid) (format "Atom XML requires that each post has a unique uuid, if you need one, use this: %s" (str (java.util.UUID/randomUUID))))
+           (assert (seq author) (format "Atom XML requires that each post has author name."))
+           [:entry
+            [:id (str "urn:uuid:" uuid)]
+            [:title name]
+            (if canonical-url
+              [:link {:href canonical-url}])
+            [:updated (iso-datetime (updated post))]
+            [:content {:type "html"} (str content)]
+            [:author
+             [:name author]
+             (if author-email [:email author-email])]
+            ]))])))

 (defn generate-atom [tgt-path files options]
   (let [atom-filepath (str (:out-dir options) "/" (:filename options))


fix guides link; hide built-ins list

fix guides link; hide built-ins list

--- src/io/perun/site.clj
+++ src/io/perun/site.clj
@@ -7,7 +7,7 @@
                    [:li.dib.mr2 [:a.pv2.ph3.fw6.link.near-black.focus-black {:href uri} label]])]
     [:nav {:role "navigation"}
      [:ul.list.pl0.ma0
-      (nav-item "/guides.html" "Guides")
+      (nav-item "/guides/" "Guides")
       (nav-item "https://github.com/hashobject/perun/wiki" "Community")
       (nav-item "https://github.com/hashobject/perun" "GitHub")]]))

@@ -121,18 +121,20 @@
                        [:p "As things are, at some point you'll get stuck. In this case you can reach out to fellow users on the Clojurians Slack or just open an issue. We're happy to help."]]})]]

-    #_[:section.max-width-4.mx-auto.py4
-       [:h2#plugins "Plugins"]
-       [:p "Perun comes with a set of bundled plugins but what important is that you can also
-             use Boot plugins and easily create your own."]
-       [:p "Here is the list of the current plugins:"]
-       [:ul.list-reset.flex.flex-wrap
-        (->> (:plugins global-meta)
-             (map (fn [plugin]
-                    [:li.col.col-4.p2.border--silver.border
-                     [:span (:name plugin)]
-                     [:p (:description plugin)]])))]
-       #_[:div.py4.border--silver.border-top (:content (first posts))]]]))
+    ;; [:section.max-width-4.mx-auto.py4
+    ;;  [:h2#plugins "Plugins"]
+    ;;  [:p "Perun comes with a set of bundled plugins but what important is that you can also
+    ;;          use Boot plugins and easily create your own."]
+    ;;  [:p "Here is the list of the current plugins:"]
+    ;;  [:ul.list-reset.flex.flex-wrap
+    ;;   (->> (:plugins global-meta)
+    ;;        (map (fn [plugin]
+    ;;               [:li.col.col-4.p2.border--silver.border
+    ;;                [:span (:name plugin)]
+    ;;                [:p (:description plugin)]])))]
+    ;;  [:div.py4.border--silver.border-top (:content (first posts))]]
+
+    ]))

 (defn with-top-nav [& contents]
   (base
@@ -147,7 +149,8 @@
     [:div.ph3.mt5 contents]]))

 (defn edit-link [post]
-  (str "https://github.com/hashobject/perun.io/edit/new/guides/" (:path post)))
+  (let [branch "new"]
+    (str "https://github.com/hashobject/perun.io/edit/" branch "/guides/" (:path post))))

 (defn guide-page [{global-meta :meta post :entry}]
   (with-top-nav


I have no idea how this ever worked

I have no idea how this ever worked

--- src/icecap/handlers/core.clj
+++ src/icecap/handlers/core.clj
@@ -51,7 +51,7 @@
   implicitly added.
   "
   [type schema & fn-tail]
-  `(let [full-schema# (assoc ~schema :type (s/eq type))]
+  `(let [full-schema# (assoc ~schema :type (s/eq ~type))]
      (defmethod get-schema ~type
        [type#]
        full-schema#)


pg/done not correct return on eoi

pg/done not correct return on eoi

--- services/mailp2.clj
+++ services/mailp2.clj
@@ -4,7 +4,7 @@
  :path "",
  :func (fn [recipient subject intro result-maps]
          (cond
-           (pg/eoi? result-maps) (pg/done)
+           (pg/eoi? result-maps) nil ; (pg/done) is sent on ch close!

            (every? map? result-maps)
            (let [base (->> result-maps first :value second fs/dirname)


changed tense names to english (future and imperfect found)

--- babel/italiano/grammar.clj
+++ babel/italiano/grammar.clj
@@ -205,17 +205,17 @@
                            {:rule "s-future-phrasal"
                             :head {:phrasal true}
                             :synsem {:aux false
-                                     :infl :futuro
-                                     :cat :verb
-                                     :sem {:tense :futuro}}})
+                                     :infl :future
+                                     :cat :verb
+                                     :sem {:tense :future}}})
                    (unifyc c10
                            root-is-head
                            {:rule "s-future-nonphrasal"
                             :head {:phrasal false}
                             :synsem {:aux false
-                                     :infl :futuro
-                                     :cat :verb
-                                     :sem {:tense :futuro}}})
+                                     :infl :future
+                                     :cat :verb
+                                     :sem {:tense :future}}})
                    (unifyc c10
                            root-is-head-root
                            {:rule "s-conditional-phrasal"
@@ -234,19 +234,19 @@
                                      :sem {:tense :conditional}}})
                    (unifyc c10
                            root-is-head-root
-                           {:rule "s-imperfetto-phrasal"
+                           {:rule "s-imperfect-phrasal"
                             :head {:phrasal true}
                             :synsem {:aux false
-                                     :infl :imperfetto
+                                     :infl :imperfect
                                      :cat :verb
                                      :sem {:aspect :progressive
                                            :tense :past}}})
                    (unifyc c10
                            root-is-head
-                           {:rule "s-imperfetto-nonphrasal"
-                            :head {:phrasal false}
-                            :synsem {:aux false
-                                     :infl :imperfetto
+                           {:rule "s-imperfect-nonphrasal"
+                            :head {:phrasal false}
+                            :synsem {:aux false
+                                     :infl :imperfect
                                      :cat :verb
                                      :sem {:aspect :progressive
                                            :tense :past}}})
@@ -303,13 +303,13 @@
                            root-is-head
                            {:rule "vp-future"
                             :synsem {:aux false
-                                     :infl :futuro
-                                     :cat :verb}})
-                   (unifyc h21
-                           root-is-head
-                           {:rule "vp-imperfetto"
-                            :synsem {:aux false
-                                     :infl :imperfetto
+                                     :infl :future
+                                     :cat :verb}})
+                   (unifyc h21
+                           root-is-head
+                           {:rule "vp-imperfect"
+                            :synsem {:aux false
+                                     :infl :imperfect
                                      :cat :verb}})
                    (unifyc h21
                            root-is-head


Remove `assortment` options from a previous implementation

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -768,9 +768,7 @@
    e extensions EXTENSIONS [str] "extensions of files to include"
    s sortby     SORTBY     code  "sort entries by function"
    c comparator COMPARATOR code  "sort by comparator function"
-   m meta       META       edn   "metadata to set on each collection entry"
-   n task-name  TASKNAME   str   "name to use for logging messages; only for tasks that use assortment under the hood"
-   t tracer     TRACER     kw    "value to put in `:io.perun/trace`; only for tasks that use assortment under the hood"]
+   m meta       META       edn   "metadata to set on each collection entry"]
   (let [grouper (or grouper #(-> {"index.html" {:entries %}}))
         options (merge +assortment-defaults+ (dissoc *opts* :grouper))]
     (assortment-pre-wrap {:task-name "assortment"


flexmark-java now pulls extensions in transitively from the pegdown profile

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -354,39 +354,7 @@
 (def ^:private markdown-deps
   '[[org.clojure/tools.namespace "0.3.0-alpha3"]
     [com.vladsch.flexmark/flexmark "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-abbreviation "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-anchorlink "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-aside "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-autolink "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-definition "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-emoji "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-escaped-character "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-footnotes "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-gfm-strikethrough "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-gfm-tables "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-gfm-tasklist "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-jekyll-front-matter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-jekyll-tag "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-ins "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-xwiki-macros "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-spec-example "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-superscript "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-tables "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-toc "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-typographic "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-wikilink "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-yaml-front-matter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-ext-zzzzzz "0.15.1"]
-    [com.vladsch.flexmark/flexmark-formatter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-html-parser "0.15.1"]
-    [com.vladsch.flexmark/flexmark-integration-test "0.15.1"]
-    [com.vladsch.flexmark/flexmark-jira-converter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-pdf-converter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-youtrack-converter "0.15.1"]
-    [com.vladsch.flexmark/flexmark-profile-pegdown "0.15.1"]
-    [com.vladsch.flexmark/flexmark-test-util "0.15.1"]
-    [com.vladsch.flexmark/flexmark-util "0.15.1"]
-    [com.vladsch.flexmark/flexmark-parent "0.15.1"]])
+    [com.vladsch.flexmark/flexmark-profile-pegdown "0.15.1"]])

 (def ^:private +markdown-defaults+
   {:out-dir "public"


Make repl start fn the -main fn.

Make repl start fn the -main fn.

--- src/isla/cli.clj
+++ src/isla/cli.clj
@@ -36,7 +36,7 @@
   Which story would you like?\n")))

-(defn start-repl []
+(defn -main [& args]
   (def repl-context (ref (library/get-initial-context)))

   (println)


finished reading 12.5

finished reading 12.5

--- src/joy/ch12.clj
+++ src/joy/ch12.clj
@@ -5,7 +5,8 @@
             HttpServer]
            [java.net InetSocketAddress URLDecoder URI]
            [java.io File FilterOutputStream]
-           [java.util Comparator Collections ArrayList]))
+           [java.util Comparator Collections ArrayList]
+           [java.util.concurrent FutureTask]))

 (def OK java.net.HttpURLConnection/HTTP_OK)

@@ -220,3 +221,42 @@
 (doto (gimmie) (Collections/sort >))
 (doto (gimmie) (Collections/sort <))
 (doto (gimmie) (Collections/sort (complement <)))
+
+(doto (Thread. #(do (Thread/sleep 5000)
+                    (println "haikeeba!")))
+  .start)
+
+(let [f (FutureTask. #(do (Thread/sleep 5000) 42))]
+  (.start (Thread. #(.run f)))
+  (.get f))
+
+;; 12.5 Using Clojure data structures in java
+(.get '[a b c] 1)
+(.get (repeat :a) 138)
+(.containsAll '[a b c] '[b c])
+#_(.add '[a 'b 'c] 'd)
+
+#_(java.util.Collections/sort [3 4 2 1])
+
+(.compareTo [:a] [:a])
+(.compareTo [:a :b] [:a])
+(.compareTo [:a :b] [:a :b :c])
+(sort [[:a :b :c] [:a] [:a :b]])
+
+#_(.compareTo [1 2 3]  '(1 2 3))
+
+(defn shuffle [coll]
+  (seq (doto (java.util.ArrayList. coll)
+         java.util.Collections/shuffle)))
+(shuffle (range 10))
+
+(java.util.Collections/unmodifiableMap
+ (doto (java.util.HashMap.) (.put :a 1)))
+(into {} (doto (java.util.HashMap.) (.put :a 1)))
+
+(def x (java.awt.Point. 0 0))
+(def y (java.awt.Point. 0 42))
+(def points #{x y})
+points
+(.setLocation y 0 0)
+points


Cleanup cruft.

Cleanup cruft.

--- src/ipython_clojure/core.clj
+++ src/ipython_clojure/core.clj
@@ -153,28 +153,6 @@
         (send-message iopub-socket "status" (status-content "idle")
                       parent-header {} session-id)))))

-;; (defn execute-request [message shell-socket iopub-socket executer]
-;;   (let [parent-header (:header message)
-;;         execution-count 1
-;;         session-id (get-in message [:header :session])]
-;;     (send-message iopub-socket "status" (status-content "busy") parent-header {} session-id)
-;;     (send-message iopub-socket "pyin" (pyin-content execution-count message)
-;;                   parent-header {} session-id)
-;;     (send-message shell-socket "execute_reply"
-;;                   {:status "ok"
-;;                    :execution_count execution-count
-;;                    :user_variables {}
-;;                    :payload [{}]
-;;                    :user_expressions {}}
-;;                   parent-header
-;;                   {:dependencies_met "True"
-;;                    :engine session-id
-;;                    :status "ok"
-;;                    :started (now)} session-id)
-;;     (send-message iopub-socket "pyout"  (pyout-content execution-count message user-ns)
-;;                   parent-header {} session-id)
-;;     (send-message iopub-socket "status" (status-content "idle") parent-header {} session-id)))
-
 (defn execute
   "evaluates s-forms"
   ([request] (execute request *ns*))
@@ -213,9 +191,6 @@
             (println "Message type" msg-type "not handled yet. Exiting.")
             (println "Message dump:" message)
             (System/exit -1)))))))
-
-; snagged from http://stackoverflow.com/questions/7684656/clojure-eval-code-in-different-namespace
-

 (defrecord Heartbeat [addr]
     Runnable


removed

removed


Explicitly call mongo connect.

Explicitly call mongo connect.

--- src/notes/handler.clj
+++ src/notes/handler.clj
@@ -25,7 +25,8 @@

 (DateTimeZone/setDefault DateTimeZone/UTC)

-(mg/connect-via-uri! (mongo-connection-uri uid pwd))
+(defn connect-mongo! []
+  (mg/connect-via-uri! (mongo-connection-uri uid pwd)))

 (defn save-note! [note]
   (mc/insert "notes" note))
@@ -92,7 +93,8 @@
   (route/not-found "Not Found"))

 (def app
-  (handler/site app-routes))
+  (do (connect-mongo!)
+    (handler/site app-routes)))

 (defn -main [port]
   (jetty/run-jetty app {:port (Integer. port)}))


fix v2 repo parsing

fix v2 repo parsing

--- src/cljs/swarmpit/component/service/create_image.cljs
+++ src/cljs/swarmpit/component/service/create_image.cljs
@@ -239,7 +239,7 @@
                         (last filtered-repositories)
                         #(onclick-handler
                            (if (= "registry" (:type registry))
-                             (du/repository (:url registry) repository)
+                             (du/repository (:url registry) (:name item))
                              (:name item))))) filtered-repositories)))))]]))))

 (rum/defc form < rum/reactive


Add a conforming user-agent header

Add a conforming user-agent header

--- src/main/clojure/conexp/fca/applications/wikidata.clj
+++ src/main/clojure/conexp/fca/applications/wikidata.clj
@@ -5,6 +5,7 @@
                                              conclusion tautology?]]
             [conexp.fca.fast :refer :all]
             [conexp.io.contexts :refer :all]
+            [conexp.base :refer [conexp-version]]
             [clojure.java.io :as io]
             [clojure.string :as str]
             [clojure.set :refer :all]
@@ -16,9 +17,21 @@
   "Wikidata SPARQL query endpoint URI"
   "https://query.wikidata.org/bigdata/namespace/wdq/sparql")

+(def ^:dynamic *tool-uri*
+  "URI to include in tool banner and HTTP user agent header"
+  "https://github.com/tomhanika/conexp-clj")
+
 (def ^:dynamic *tool-banner*
   "tool banner to send with SPARQL queries"
-  "#TOOL:conexp-clj, https://github.com/tomhanika/conexp-clj")
+  (str "#TOOL:conexp-clj, " *tool-uri*))
+
+(def ^:dynamic *tool-agent*
+  "user agent to send with SPARQL queries"
+  (str "conexp-clj/"
+       (conexp-version)
+       " ("
+       *tool-uri*
+       ")"))

 (def ^:dynamic *max-entities-per-query*
   "maximum number of entities requested in a single query (entities
@@ -43,6 +56,7 @@
                    (str *tool-banner*
                         "\n"
                         qry)}
+    :headers {"User-Agent" *tool-agent*}
     :http-builder-fns [disable-cookies]}))

 (defmacro with-sparql-bindings


track paid event in intercom

track paid event in intercom

--- frontend/analytics.cljs
+++ frontend/analytics.cljs
@@ -85,6 +85,7 @@

 (defn track-payer [login]
   (mixpanel/track "Paid")
+  (intercom/track :paid-for-plan)
   (pa/track "payer" {:orderId login})
   (twitter/track-payer)
   (adroll/record-payer))


enable websocket compression

enable websocket compression

quite pointless to do this for a local connections
but some messages can get quite large and maybe
this does something.

--- src/main/shadow/undertow.clj
+++ src/main/shadow/undertow.clj
@@ -25,7 +25,8 @@
            [io.undertow.server.handlers.proxy LoadBalancingProxyClient ProxyHandler]
            [java.net URI]
            [io.undertow.protocols.ssl UndertowXnioSsl]
-           [org.xnio.ssl XnioSsl]))
+           [org.xnio.ssl XnioSsl]
+           [io.undertow.websockets.extensions PerMessageDeflateHandshake]))

 (defn ring* [handler-fn]
   (reify
@@ -294,58 +295,61 @@

   (let [{:keys [handler-fn]} props

+        ws-callback
+        (reify
+          WebSocketConnectionCallback
+          (onConnect [_ exchange channel]
+            (let [ws-in (.getAttachment exchange WS-IN)
+                  ws-out (.getAttachment exchange WS-OUT)
+                  ws-loop (.getAttachment exchange WS-LOOP)
+
+                  handler-fn
+                  (fn [channel msg]
+                    (if-not (some? msg)
+                      (async/close! ws-in)
+                      (async/put! ws-in msg)))
+
+                  close-task
+                  (reify ChannelListener
+                    (handleEvent [this ignored-event]
+                      (async/close! ws-in)
+                      (async/close! ws-out)))]
+
+              (.. channel (addCloseTask close-task))
+              (.. channel (getReceiveSetter) (set (WsTextReceiver. handler-fn)))
+              (.. channel (resumeReceives))
+
+              (go (loop []
+                    ;; try to send remaining messages before disconnect
+                    ;; if loop closes after putting something on ws-out
+                    (alt! :priority true
+                      ws-out
+                      ([msg]
+                       (if (nil? msg)
+                         ;; when out closes, also close in
+                         (async/close! ws-in)
+                         ;; try to send message, close everything if that fails
+                         (do (try
+                               (WebSockets/sendTextBlocking msg channel)
+                               ;; just ignore sending to a closed channel
+                               (catch ClosedChannelException e
+                                 (async/close! ws-in)
+                                 (async/close! ws-out)))
+                             (recur))))
+
+                      ws-loop
+                      ([_] :closed)))
+
+                  (.close exchange)
+
+                  ;; probably already closed, just in case
+                  (async/close! ws-out)
+                  (async/close! ws-in)
+                  ))))
+
         ws-handler
-        (Handlers/websocket
-          (reify
-            WebSocketConnectionCallback
-            (onConnect [_ exchange channel]
-              (let [ws-in (.getAttachment exchange WS-IN)
-                    ws-out (.getAttachment exchange WS-OUT)
-                    ws-loop (.getAttachment exchange WS-LOOP)
-
-                    handler-fn
-                    (fn [channel msg]
-                      (if-not (some? msg)
-                        (async/close! ws-in)
-                        (async/put! ws-in msg)))
-
-                    close-task
-                    (reify ChannelListener
-                      (handleEvent [this ignored-event]
-                        (async/close! ws-in)
-                        (async/close! ws-out)))]
-
-                (.. channel (addCloseTask close-task))
-                (.. channel (getReceiveSetter) (set (WsTextReceiver. handler-fn)))
-                (.. channel (resumeReceives))
-
-                (go (loop []
-                      ;; try to send remaining messages before disconnect
-                      ;; if loop closes after putting something on ws-out
-                      (alt! :priority true
-                        ws-out
-                        ([msg]
-                          (if (nil? msg)
-                            ;; when out closes, also close in
-                            (async/close! ws-in)
-                            ;; try to send message, close everything if that fails
-                            (do (try
-                                  (WebSockets/sendTextBlocking msg channel)
-                                  ;; just ignore sending to a closed channel
-                                  (catch ClosedChannelException e
-                                    (async/close! ws-in)
-                                    (async/close! ws-out)))
-                                (recur))))
-
-                        ws-loop
-                        ([_] :closed)))
-
-                    (.close exchange)
-
-                    ;; probably already closed, just in case
-                    (async/close! ws-out)
-                    (async/close! ws-in)
-                    )))))
+        (-> (Handlers/websocket ws-callback)
+            (.addExtension (PerMessageDeflateHandshake. true 6)))

         handler
         (ring*


Make greys more evenly spaced; choose more congruous blue


Silky smooth scrolling (thanks @zachallaun for (go) help)

* Emit touchmoves immediately.
* Increase distance of initial scroll (touchmove) required to initiate a scroll.

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -234,41 +234,46 @@
          (= (cur-t :type) "touchmove")
          (or (= (prev-t :type) "touchmove")
              (and (= (prev-t :type) "touchstart")
-                  (= (prev-t :age) 0)
-                  (> (distance (cur-t :position) (prev-t :position)) 5))))))
+                  (> (.abs js/Math (- (-> prev-t :position :y) (-> cur-t :position :y)))
+                     10))))))

 (defmulti handle-touch (fn [t touches out-c] (:type t)))

 (defmethod handle-touch "touchstart"
   [{touch-id :touch-id :as t} touches out-c]
-  (assoc touches touch-id t))
+  (go
+   (assoc touches touch-id t)))

 (defmethod handle-touch "touchmove"
   [{touch-id :touch-id :as t} touches out-c]
-  (if (scroll? touches t)
-    (let [{{x1 :x y1 :y} :position} (get touches touch-id)
-          {{x2 :x y2 :y} :position} t]
-      (assoc touches touch-id
-             (-> t (assoc :x-distance (- x1 x2)) (assoc :y-distance (- y1 y2)))))
-    touches))
+  (go
+   (if (scroll? touches t)
+     (let [{{x1 :x y1 :y} :position} (get touches touch-id)
+           {{x2 :x y2 :y} :position} t
+           scroll (-> t (assoc :x-distance (- x1 x2)) (assoc :y-distance (- y1 y2)))]
+       (println scroll)
+       (>! out-c scroll)
+       (assoc touches touch-id scroll))
+     touches)))

 (defmethod handle-touch "touchend"
   [{touch-id :touch-id :as t} touches out-c]
-  (assoc touches touch-id t))
+  (go
+   (assoc touches touch-id t)))

 (defn emit-touch?
   [{t-type :type t-age :age} touches]
-  (or (and (or (= t-type "touchstart") (= t-type "touchend"))
-           (> t-age 0))
-      (= t-type "touchmove")))
+  (and (or (= t-type "touchstart") (= t-type "touchend"))
+       (> t-age 1)))

 (defn touch-tick
   [touches out-c]
   (let [{emit true keep false} (group-by emit-touch? (vals touches))]
-    (onto-chan out-c (or (vals (select-keys touches (map :touch-id emit))) '()) false)
-    (reduce (fn [m k] (update-in m [k :age] inc))
-            (select-keys touches (map :touch-id keep))
-            (map :touch-id keep))))
+    (go
+     (onto-chan out-c (or (vals (select-keys touches (map :touch-id emit))) '()) false)
+     (reduce (fn [m k] (update-in m [k :age] inc))
+             (select-keys touches (map :touch-id keep))
+             (map :touch-id keep)))))

 (defn touch-chan
   [canvas-id wait]
@@ -279,8 +284,8 @@
     (go (loop [touches {}]
           (let [[v _] (alts! [c-touchstart c-touchmove c-touchend (timeout wait)])]
             (if (nil? v)
-              (recur (touch-tick touches out-c))
-              (recur (handle-touch v touches out-c))))))
+              (recur (<! (touch-tick touches out-c)))
+              (recur (<! (handle-touch v touches out-c)))))))
     out-c))

 (defn step-time


Only check vert collisions - no horizontal scrolling


Display info, make Mjpeg view fill screen, report activity lifecycle

--- src/clojure/uk/org/potentialdifference/darknet/main.clj
+++ src/clojure/uk/org/potentialdifference/darknet/main.clj
@@ -76,7 +76,7 @@
         (doto mjpeg-view
           ;; (.setResolution width height)
           (.setSource stream)
-          (.setDisplayMode MjpegView/SIZE_BEST_FIT))))
+          (.setDisplayMode MjpegView/SIZE_FULLSCREEN))))
     mjpeg-view))

 (defn stream-view [^Context activity instruction]
@@ -121,6 +121,9 @@
     (set! (.-width params) (int fit-w))
     (set! (.-height params) (int fit-h))
     (on-ui
+        (toast (format "Fit (%d x %d) to (%d x %d)"
+                       width height
+                       (int fit-w) (int fit-h)))
         (doto view
           (.setLayoutParams params)
           (.requestLayout)))))
@@ -153,10 +156,14 @@
                            (set! (.-width params) (int fit-w))
                            (set! (.-height params) (int fit-h))
                            (on-ui
+                               (toast (format "Fit (%d x %d) to (%d x %d)"
+                                              width height
+                                              (int fit-w) (int fit-h)))
                                (doto surface
                                  (.setLayoutParams params)
                                  (.requestLayout)))
                            (when (and from to)
+                             (log/i "darknet" "stream-video" from to width height)
                              (server/stream-video from to width height)))))]
         (doto (.getHolder surface)
           (.setType SurfaceHolder/SURFACE_TYPE_PUSH_BUFFERS)
@@ -214,13 +221,13 @@
 (defn swap-view! [activity view]
   (replace-view! activity view))

-(def idle-screen
+(defn idle-screen [color]
   [:relative-layout {:layout-width :fill
                      :layout-height :fill}
    [:text-view {:text " °"
                 :id ::status-indicator
                 :text-size 50
-                :text-color Color/RED}]])
+                :text-color color}]])

 (defn setup-video-view [view activity path]
   (doto view
@@ -230,7 +237,7 @@
      (reify
        MediaPlayer$OnCompletionListener
        (onCompletion [this mp]
-         (swap-view! activity (layout activity idle-screen)))))
+         (swap-view! activity (layout activity (idle-screen Color/GREEN))))))
     (.start))
   view)

@@ -272,7 +279,9 @@

   (onCreate [^Activity this bundle]
     (.superOnCreate this bundle)
-    (let [on-message (fn [str]
+    (let [sizes {:rear  (camera/preview-sizes 0)
+                 :front (camera/preview-sizes 1)}
+          on-message (fn [str]
                        (let [instruction (->instruction str)
                              sv (fn [view] ;; Menononic: swap-view!
                                   (swap-view! this view))]
@@ -284,19 +293,18 @@
                                "saveLocally" (save-locally! this instruction)
                                "viewRemote" (sv (view-remote this instruction))
                                "viewLocal" (sv (view-local this instruction))
-                               #_"info" #_(sv (layout [:text-view {:text
-                                                                   (let [out (java.io.StringWriter.)]
-                                                                     (pprint sizes out)
-                                                                     (.toString out))}]))
-                               "stop" (sv (layout this idle-screen))
-                               :default))))
-          sizes {:rear  (camera/preview-sizes 0)
-                 :front (camera/preview-sizes 1)}]
+                               "info" (sv (layout this [:text-view {:text
+                                                                    (let [out (java.io.StringWriter.)]
+                                                                      (pprint sizes out)
+                                                                      (.toString out))}]))
+                               "stop" (sv (layout this (idle-screen Color/GREEN)))
+                               :default))))]
       (helper/fullscreen! this)
       (helper/keep-screen-on! this)
       (helper/landscape! this)
       (let [client (atom nil)]
         (letfn [(new-client []
+                  (log/i "darknet" "new client called")
                   (reset! client
                           (websocket/connect!
                            (:ws-url config)
@@ -306,13 +314,13 @@
                             :on-close (fn [code reason remote]
                                         (log/i "darknet on close" code reason remote)
                                         (set-status! this Color/RED)
-                                        (Thread/sleep 200)
+                                        (Thread/sleep 1000)
                                         (new-client))
                             :on-message on-message
                             :on-error (fn [e]
                                         (log/i "darknet on error" (.getMessage e))
                                         (set-status! this Color/RED)
-                                        (Thread/sleep 200))})))]
+                                        (Thread/sleep 1000))})))]
           (new-client)))
       (on-ui
           (set-content-view! this
@@ -322,5 +330,20 @@
                              :orientation :vertical
                              :layout-width :fill
                              :layout-height :fill}
-             idle-screen])))))
-
+             (idle-screen Color/RED)]))))
+  (onStart [this]
+           (.superOnStart this)
+           (log/i "darknet on start"))
+  (onResume [this]
+            (.superOnResume this)
+            (log/i "darknet on resume"))
+  (onPause [this]
+           (.superOnPause this)
+           (log/i "darknet on pause"))
+  (onStop [this]
+          (.superOnStop this)
+          (log/i "darknet on stop"))
+  (onDestroy [this]
+             (.superOnDestroy this)
+             (log/i "darknet on destroy")))
+


To improve debugging speed, remember the tab we were last on.

--- src/re_demo/core.cljs
+++ src/re_demo/core.cljs
@@ -1,6 +1,7 @@
 (ns re-demo.core
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [reagent.core       :as    reagent]
+            [alandipert.storage-atom :refer [local-storage]]
             [re-com.util        :as    util]
             [re-com.core        :as    core]
             [re-com.tabs]
@@ -22,27 +23,30 @@
 (enable-console-print!)

 (def tabs-definition
-  [ {:id ::welcome   :label "Welcome"    :panel welcome/panel}
-    {:id ::basics    :label "Basics"     :panel basics/panel}
-    {:id ::dropdown  :label "Dropdowns"  :panel dropdowns/panel}
-    {:id ::alerts    :label "Alerts"     :panel alerts/panel}
-    {:id ::tabs      :label "Tabs"       :panel tabs/panel}
-    {:id ::popovers  :label "Popovers"   :panel popovers/panel}
-    {:id ::date      :label "Date"       :panel date-chooser/panel}
-    {:id ::time      :label "Time"       :panel time/panel}
-    {:id ::lists     :label "List"       :panel lists/panel}
-    {:id ::tour      :label "Tour"       :panel tour/panel}
-    {:id ::modals    :label "Modals"     :panel modals/panel}
-    {:id ::boxes1    :label "Boxes-1"    :panel boxes/panel1}
-    {:id ::boxes2    :label "Boxes-2"    :panel boxes/panel2}
-    {:id ::layouts   :label "Layouts"    :panel layouts/panel}])
+  [ {:id ::welcome   :label "Welcome"     :panel welcome/panel}
+    {:id ::basics    :label "Basics"      :panel basics/panel}
+    {:id ::dropdown  :label "Dropdowns"   :panel dropdowns/panel}
+    {:id ::alerts    :label "Alerts"      :panel alerts/panel}
+    {:id ::tabs      :label "Tabs"        :panel tabs/panel}
+    {:id ::popovers  :label "Popovers"    :panel popovers/panel}
+    {:id ::date      :label "Date Picker" :panel date-chooser/panel}
+    {:id ::time      :label "Time"        :panel time/panel}
+    {:id ::lists     :label "List"        :panel lists/panel}
+    {:id ::tour      :label "Tour"        :panel tour/panel}
+    {:id ::modals    :label "Modals"      :panel modals/panel}
+    {:id ::boxes1    :label "Boxes-1"     :panel boxes/panel1}
+    {:id ::boxes2    :label "Boxes-2"     :panel boxes/panel2}
+    {:id ::layouts   :label "Layouts"     :panel layouts/panel}])

 ;; http://css-tricks.com/functional-css-tabs-revisited/   (see the demo)
 ;;
 (defn main
   []
-  (let [selected-tab-id (reagent/atom (:id (first tabs-definition)))]
+  (let [
+         id-store        (local-storage (atom nil) ::id-store)
+         selected-tab-id (reagent/atom (if  (nil? @id-store) (:id (first tabs-definition)) @id-store))   ;; id of the selected tab
+         _               (add-watch selected-tab-id nil #(reset! id-store %4))]
     (fn _main
       []
       [h-box


Add the "riemann" tag in index instrumentation

--- src/riemann/index.clj
+++ src/riemann/index.clj
@@ -105,7 +105,9 @@

       Instrumented
       (events [this]
-        (let [base {:state "ok" :time (unix-time)}]
+        (let [base {:state "ok"
+                    :time (unix-time)
+                    :tags ["riemann"]}]
           (map (partial merge base)
                [{:service "riemann index size"
                  :metric (.size hm)}])))


revise help text

revise help text

--- src/riffmuse/core.clj
+++ src/riffmuse/core.clj
@@ -10,7 +10,7 @@
 (def ^:private help
 "riffmuse is a command-line tool that algorithmically generates notes within a given scale, hopefully inspiring you to create a riff using those notes.

-It takes only one command-line argument, representing the scale you'd like your riff in.
+Simply pass the scale you'd like your riff in as command-line arguments. Input is not case-sensitive, and can be abbreviated in a variety of ways.

 Examples:


more detail in "unsupported encoding" message

--- src/sledge/server.clj
+++ src/sledge/server.clj
@@ -50,7 +50,11 @@
 (defn media-links [r]
   (let [e-t (:encoding-type r)
         enc (or (get encoding-types e-t)
-                (throw (Exception. (str "unsupported encoding-type " e-t))))
+                (throw (Exception. (str "unsupported encoding-type "
+                                        e-t
+                                        " for "
+                                        (:pathname r)
+                                        ))))
         basename (base64 (:pathname r))]
     (reduce (fn [h fmt]
               (assoc h fmt { "href" (str "/bits/" basename "."  fmt)}))


Extra backup file

Extra backup file

--- src/tango/export2.clj
+++ src/tango/export2.clj
@@ -345,8 +345,10 @@
   (log/info (str "Export Results to " export-path " with " activities-with-result))
   (let [in-xml (get-xml-from-file export-path)
         class-results (map activity-result->class-result activities-with-result)
-        out-xml (reduce add-results-to-dp-xml in-xml class-results)]
+        out-xml (reduce add-results-to-dp-xml in-xml class-results)
+        out-xml-orig (reduce add-results-to-dp-xml in-xml [])]
     (make-copy-with-timestamp export-path)
+    (spit (str "orig_" export-path) (ppxml (xml/emit-str out-xml-orig)))
     (spit export-path (ppxml (xml/emit-str out-xml)))))

 (defn smoke-test [] (export-results (activities-with-result) "dp.xml"))


implement `GET /api/meta/db/:id/idfields`

--- src/metabase/api/meta/db.clj
+++ src/metabase/api/meta/db.clj
@@ -7,7 +7,7 @@
             [metabase.db :refer :all]
             [metabase.driver :as driver]
             (metabase.models common
-                             [hydrate :refer [hydrate]]
+                             [hydrate :refer [hydrate simple-batched-hydrate]]
                              [database :refer [Database]]
                              [field :refer [Field]]
                              [org :refer [org-can-read org-can-write]]
@@ -66,6 +66,12 @@
 (defendpoint GET "/:id/tables" [id]
   (sel :many Table :db_id id (order :name)))

+(defendpoint GET "/:id/idfields" [id]
+  (read-check Database id)
+  (let [table_ids (sel :many :id Table :db_id id)]
+    (-> (sel :many Field :table_id [in table_ids] :special_type "id")
+        (simple-batched-hydrate Table :table_id :table))))
+
 (defendpoint POST "/:id/sync" [id]
   (let-404 [db (sel :one Database :id id)]   ; TODO - run sync-tables asynchronously
            (driver/sync-tables db))


Call sassc with sh

Call sassc with sh

--- src/leiningen/new/chestnut/env/dev/clj/chestnut/dev.clj
+++ src/leiningen/new/chestnut/env/dev/clj/chestnut/dev.clj
@@ -42,5 +42,5 @@
 (defn start-sass []
   (future
     (println "Starting sass.")
-    (lein/-main ["auto" "sassc" "once"])))
+    (sh "lein" "auto" "sassc" "once")))
 {{/sass?}}


Comment update

Comment update

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/interface.clj
+++ src/obcc/build/interface.clj
@@ -32,6 +32,8 @@
     tree))

 (defn compile [path config]
+  ;; aggregate all of the interfaces declared in the config,
+  ;; add the virtual "project.cci", and strip any nils
   (let [interfaces (->> config getinterfaces (cons "project") (remove nil?))
         protopath (io/file path "build/proto/project.proto")]


Compare times using milliseconds.

Compare times using milliseconds.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -255,7 +255,7 @@
              (pos? limit))
          (boolean? count)]}
   (let [order-fn (if (= order :desc) r/desc r/asc)
-        unread-cap-seconds (* 60 60 24 config/threads-unread-cap-days)
+        unread-cap-ms (* 60 60 24 config/threads-unread-cap-days 1000)
         read-items-map (r/coerce-to (zipmap (map :item-id read-items) (map :read-at read-items)) :object)]
     (db-common/with-timeout db-common/default-timeout
       (as-> (r/table "interactions") query
@@ -278,18 +278,21 @@
                                ;; Default to the root comment created-at
                                (r/default (r/get-field row :created-at))
                                (r/iso8601)
-                               (r/to-epoch-time))
+                               (r/to-epoch-time)
+                               (r/mul 1000)
+                               (r/round))
               entries-base (-> (r/table "entries") (r/get (r/get-field row [:resource-uuid])))
               unread-thread? (r/or (r/not (r/contains (r/keys read-items-map) (r/get-field row :resource-uuid)))
-                                   (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/round))
+                                   (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/mul 1000) (r/round))
                                          (-> (r/get-field row :resource-uuid)
                                           (as-> x (r/get-field read-items-map x))
                                           (r/iso8601)
                                           (r/to-epoch-time)
+                                          (r/mul 1000)
                                           (r/round))))
-              unread-with-cap? (r/or unread-thread?
-                                     (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/round))
-                                           (-> (r/now) (r/to-epoch-time) (r/sub unread-cap-seconds) (r/round))))]
+              unread-with-cap? (r/and unread-thread?
+                                      (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/mul 1000) (r/round))
+                                            (-> (r/now) (r/to-epoch-time) (r/mul 1000) (r/round) (r/sub unread-cap-ms))))]
           {:reply-count (r/count interactions-base)
            ;; Date of the last added comment on this thread
            :last-activity-at last-activity-at
@@ -297,11 +300,9 @@
            :sort-value (r/branch unread-with-cap?
                          ;; If the item is unread and was published in the cap window
                          ;; let's add the cap window to the publish timestamp so it will sort before the read items
-                         (-> sort-value-base
-                          (r/add unread-cap-seconds)
-                          (r/round))
+                         (r/add sort-value-base unread-cap-ms)
                          ;; The timestamp in seconds
-                         (r/round sort-value-base))
+                         sort-value-base)
            ;; Entry data
            :entry  (r/pluck entries-base [:publisher])})))
        ;; Filter by user-visibility


Change parens to square brackets in :only clause

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -4,7 +4,7 @@
            external MIDI devices and automatically hooking into
            Overtone's event system." }
   (:use [overtone.sc.dyn-vars]
-        [overtone.at-at :only (mk-pool every)]
+        [overtone.at-at :only [mk-pool every]]
         [overtone.libs event counters]
         [overtone.sc.defaults :only [INTERNAL-POOL]]
         [overtone.helpers.system :only [mac-os?]]


remove leiningen configuration from git

remove leiningen configuration from git

--- ssclj/jar/project.clj
+++ ssclj/jar/project.clj
@@ -1,108 +0,0 @@
-(defproject com.sixsq.slipstream/ssclj "3.6-SNAPSHOT"
-  :description    "Clojure REST resources"
-  :url            "http://sixsq.com"
-  :license {:name "Apache License, Version 2.0"
-            :url  "http://www.apache.org/licenses/LICENSE-2.0"}
-
-  :source-paths   ["src/main/clojure"]
-  :test-paths     ["src/test/clojure"]
-  :resource-paths ["src/main/resources"]
-
-  :dependencies [[org.clojure/clojure                       "1.8.0"]
-                 [org.clojure/tools.logging                 "0.3.1"]
-                 [org.clojure/tools.namespace               "0.2.10"]
-                 [org.clojure/tools.cli                     "0.3.3"]
-                 [org.clojure/data.json                     "0.2.6"]
-                 [org.clojure/java.classpath                "0.2.3"]
-                 [superstring                               "2.1.0"]
-                 [prismatic/schema                          "1.0.3"]
-                 [clj-time/clj-time                         "0.11.0"]
-                 [clj-stacktrace/clj-stacktrace             "0.2.8"]
-                 [metrics-clojure/metrics-clojure           "2.5.1"]
-                 [metrics-clojure-ring/metrics-clojure-ring "2.5.1"
-                   :exclusions [[cheshire/cheshire]] ]
-                 [metrics-clojure-jvm/metrics-clojure-jvm   "2.5.1"]
-                 [metrics-clojure-graphite/metrics-clojure-graphite   "2.5.1"]
-
-                 [fs/fs                                     "1.3.3"]
-                 [org.slf4j/slf4j-log4j12                   "1.7.13"]
-                 [instaparse                                "1.4.1"]
-                ; ;; Authentication service
-                 [com.sixsq.slipstream/auth                 "3.5-SNAPSHOT"]
-                ; ;; Environment settings
-                 [environ                                   "1.0.1"]
-                ; ;; database
-                 [honeysql                                  "0.6.2"]
-                 [org.clojure/java.jdbc                     "0.4.2"]
-                 [korma                                     "0.4.2"]
-                 [org.hsqldb/hsqldb                         "2.3.3"]
-                ; ;; http related
-                 [javax.servlet/javax.servlet-api           "3.1.0"]
-                 [ring/ring-core                            "1.4.0"]
-                 [ring/ring-json                            "0.4.0"]
-                 [compojure/compojure                       "1.4.0"]
-                 [clj-http                                  "2.0.0"]
-
-                 [aleph                                     "0.4.1-beta4"]
-
-                 ;; Elastic search
-                 [org.elasticsearch/elasticsearch           "2.3.1"]
-                 [me.raynes/fs                              "1.4.6"]]
-
-  :plugins      [[lein-ancient                              "0.6.8"]
-                 [lein-expectations                         "0.0.7"]
-                 [lein-autoexpect                           "1.4.2"]
-                 [lein-environ                              "1.0.0"]
-                 [com.jakemccrary/lein-test-refresh         "0.5.5"]
-                 [lein-kibit                                "0.1.2"]
-                 [jonase/eastwood                           "0.2.1"]
-                 [lein-cloverage                            "1.0.3"]]
-
-  :repl-options {;; What to print when the repl session starts.
-                :welcome
-                (println (str
-                  ;; These first lines are the default ones:
-                  "\n"
-                  "      Docs: (doc function-name-here)\n"
-                  "            (find-doc \"part-of-name-here\")\n"
-                  "    Source: (source function-name-here)\n"
-                  "   Javadoc: (javadoc java-object-or-class-here)\n"
-                  "      Exit: Control+D or (exit) or (quit)\n"
-                  "   Results: Stored in vars *1, *2, *3, an exception in *e\n"
-                  "\n"
-                  ;; This line is related to the SlipStream project:
-                  "API Server:      (require '[com.sixsq.slipstream.ssclj.app.server :as server])\n"
-                  "                 (def state (server/start 8201))\n"
-                  "Event Seeding:   (require '[com.sixsq.slipstream.ssclj.resources.seeds.event :as es])\n"
-                  "                 (es/seed! 10 :bob)\n"
-                  "Usage Seeding:   (require '[com.sixsq.slipstream.ssclj.usage.seeds.usages :as us])\n"
-                  "                 (us/seed-summaries! 10 :bob [\"aws\" \"exo\"])\n"
-                  ))
-                }
-
- :profiles {
-  ; :provided
-  ;   { :dependencies [[reply/reply "0.3.4" :exlusions [[cheshire/cheshire]]]] }
-
-   :uberjar
-     { :aot [#"com.sixsq.slipstream.ssclj.api.acl*"]
-       :env {  :clj-env        "production"
-               :config-path    "config-hsqldb-mem.edn"}
-       :jvm-opts ["-Dlogfile.path=production"]}
-
-   :dev
-     { :env {  :clj-env        "development"
-               :config-path    "config-hsqldb.edn"}
-       :jvm-opts ["-Dlogfile.path=development"]
-       :dependencies [ [peridot/peridot "0.4.1"]
-                       [expectations/expectations "2.1.4"]]}
-   :test
-     { :env {  :clj-env        "test"
-               :config-path    "config-hsqldb-mem.edn"}
-
-       :jvm-opts ["-Dlogfile.path=test"]
-
-       :dependencies [ [peridot/peridot "0.4.1"]
-                       [expectations/expectations "2.1.4"]]}
-  }
-  )


Ensure that we have schema since the beginning

--- src/photon/default_projs.clj
+++ src/photon/default_projs.clj
@@ -9,13 +9,14 @@
   (sfn/fn [p n]
     (let [ps (get p (:stream-name n) {})
           old-total (get ps :total-events 0)
+          new-total (inc old-total)
           old-schema (get ps :schema {})
-          schema (if (< (rand) 0.02)
+          schema (if (or (< old-total 10) (< (rand) 0.02))
                    (clj-schema-inspector.core/serialise
                     (clj-schema-inspector.core/add-map
                      old-schema (:payload n)))
                    old-schema)]
-      (assoc p (:stream-name n) {:total-events (inc old-total)
+      (assoc p (:stream-name n) {:total-events new-total
                                  :schema schema}))))

 (def default-projections


New output wrap works

New output wrap works

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -58,7 +58,7 @@
  (def ^{:private true} cache-trait summaries/lazy-cached-summarizer-node)
 #_ (def ^{:private true} cache-trait summaries/pseudo-cached-summarizer-node)

-(def *no-identical-nonterminal-outputs* false #_true)
+(def *no-identical-nonterminal-outputs* true )
 (def *decompose-cache*   nil #_  true) ;; nil for none, or bind to hashmap

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -84,10 +84,10 @@
    ^ArrayList outputs (ArrayList.)]
   []
   Watched
-  (add-watcher! [sw w] #_(println :AW sw w)
-    (.add watchers w)
+  (add-watcher! [sw w] #_(println :AW sw w) #_ (assert (not (some #(= % w) watchers)))
+    (.add watchers w)
     (doseq [o (doall (seq outputs))] (w o))#_ (println :WF sw))
-  (add-output! [sw o] #_ (println :AO sw o)
+  (add-output! [sw o] #_ (println :AO sw o)
     (.add outputs o)
     (doseq [w (doall (seq watchers))] (w o)) #_(println :OF sw))
   (get-outputs [sw] (doall (seq outputs))))
@@ -238,12 +238,8 @@
 ;;  (Since we don't keep only first solution)
 (defn add-sp-child! [sp child-sp]
   (assert (not (terminal? sp)))
-  (if (and *no-identical-nonterminal-outputs*
-           (= (output-set sp) (output-set child-sp)))
-    (do (connect-and-watch! sp child-sp #(add-sp-child! sp %))
-        (summaries/summary-changed! sp ))
-    (do (summaries/summary-changed-local! sp)
-        (add-output! sp child-sp))))
+  (summaries/summary-changed-local! sp)
+  (add-output! sp child-sp))

 ;; Note: All nonterminal subproblems use or-summary for ri-fn
@@ -262,10 +258,28 @@
     (when subsuming-sp (summaries/connect! @ts-atom (tree-summarizer subsuming-sp) true))
     ret))

-;;
+;; TODO: better grouping -- allow adding etc?
 (defn make-output-collecting-subproblem [inner-sp]
-  )
-
+  (let [ts  (tree-summarizer inner-sp)
+        ret (traits/reify-traits [simple-cached-node simple-watched ]
+             summaries/Summarizable (summarize       [s] (or-summary s (top-down-bound ts)))
+             Subproblem             (stub            [s] (stub inner-sp))
+                                    (output-set      [s] (output-set inner-sp))
+                                    (tree-summarizer [s] ts)
+                                    (terminal?       [s] false)
+                                    (refine-input    [s ni] (refine-input inner-sp ni)))
+        child-watch (fn child-watch [o]
+                      (if (= (output-set inner-sp) (output-set o))
+                        (do (connect-and-watch! ret o child-watch)
+                            (summaries/summary-changed! ret))
+                        (add-sp-child! ret o)))]
+    (connect-and-watch! ret inner-sp child-watch)
+    ret))
+
+(defn output-wrap [sp]
+  (if *no-identical-nonterminal-outputs*
+    (make-output-collecting-subproblem sp)
+    sp))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;     Subproblem Types and Stubs     ;;;;;;;;;;;;;;;;;;;;;;;
@@ -275,13 +289,7 @@

 (declare make-fs-seq-stub get-atomic-stub)

-;; We have to do it this way to cope iwth *no-identical-nt-outputs
-(defn get-atomic-sp-child-stubs [atomic-sp]
-  (filter #(instance? angelic.search.implicit.fah_astar_eval2.Stub %)
-          (summaries/node-ordinary-children atomic-sp)))
-
-
-;; Problem -- if we watch ret but yank out its children, we also double count ...
+

 (defn- make-atomic-subproblem [stub function-set subsuming-sp out-set reward status]
   (let [inp-set  (input-set stub)
@@ -293,18 +301,17 @@

           (and subsuming-sp (not (terminal? subsuming-sp)))
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false or-summary ri-fn reward)]
-            (doseq [c (get-atomic-sp-child-stubs ret)] ;;
-              (connect-and-watch! ret c
-                (fn [sub-out]
-                  (connect-and-watch! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))
-                  (summaries/summary-changed! ret)))) ;; TODO: needed?
-            ret)
+            (connect-and-watch! ret subsuming-sp
+              (fn [sub-out]
+                (connect-and-watch! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))
+                (summaries/summary-changed! ret))) ;; TODO: needed?
+            (output-wrap ret))

           :else
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false or-summary ri-fn reward)]
             (doseq [child (map #(make-fs-seq-stub inp-set %) (fs/child-seqs function-set inp-set))]
               (connect-and-watch! ret child #(add-sp-child! ret %)))
-            ret))))
+            (output-wrap ret)))))

@@ -370,6 +377,7 @@
 ;; TODO: remove ss ?
 ;; Note: this is the only place logic depends on summary.  Potential for problems?
 (defn- make-pair-subproblem [subsuming-sp pair-stub left-sp right-sp]
+;  (println "mps" pair-stub)
   (let [expand-right? (not (can-split? left-sp) ) #_(terminal? left-sp)
         [ss watch stub-f]
         (if expand-right?
@@ -383,10 +391,15 @@
                  (let [left-done? (atom false)]
                    (fn [s b]
                      (when (and (not @left-done?) (not (summary/live? (summaries/summary left-sp))))
-                       (reset! left-done? true) (println "BOO")
+                       (reset! left-done? true) #_(println "BOO" pair-stub left-sp right-sp (class right-sp))
                        (summaries/disconnect! s ss)
-                       (add-watcher! left-sp (fn [o] (def *sum* [s left-sp o]) (throw (RuntimeException. "Solved and children."))))
-                       (add-sp-child! s (make-nt-pair-subproblem subsuming-sp pair-stub left-sp right-sp)))
+                       (add-watcher! left-sp (fn [o] (def *sum* [s left-sp o])
+                                               (throw (RuntimeException. "Solved and children."))))
+                       ;; TODO: do more efficiently?
+                       (connect-and-watch! s (make-pair-stub2 subsuming-sp left-sp (stub right-sp))
+                                           (fn [os] (connect-and-watch! s os #(add-child-sp! s %))))
+ ;                       (add-sp-child! s (make-pair-subproblem subsuming-sp pair-stub left-sp right-sp))
+                       )
                      (or-summary s b))))
              (fn [s ri] (make-pair-stub1 s (refine-input left-sp ri)
                           (subproblem-name right-sp) #(refine-input right-sp %)))
@@ -400,7 +413,7 @@
         (connect-and-watch! ret (stub-f o) #(add-sp-child! ret %))
         (summaries/summary-changed! ret))) ;; TODO: efficiency?

-    ret))
+    (output-wrap ret)))

@@ -448,7 +461,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- choose-leaf [verified-summary]
-  (println "VS"  verified-summary)  (def *sum* verified-summary)  (Thread/sleep 10)
+ ;  (println "VS"  verified-summary)  (def *sum* verified-summary)  (Thread/sleep 10)
   (->> (summary/extract-leaf-seq verified-summary (comp empty? summary/children))
        (map summary/source)
        (filter can-evaluate?)


Organize

Organize

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -55,11 +55,15 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Watches      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;; Stubs have at most one output (SP), SPs have any number

 (defprotocol Watched
   (add-watcher! [s w] "Add a watcher to be notified of all outputs to this.
                        A watcher is just a fn of new-subproblem.")
-  (add-output!  [sw o]    "O is a subproblem")
+  (add-output!  [sw o] "O is a subproblem.  sw may have an updated summary,
+                        but will not call summary-changed! on its parents.
+                        The receiver is responsible for handling this change.
+                        This allows handling decrease+increase in lock-step. ")
   (get-outputs  [sw]  "List current outputs"))

 (def *out-count* (atom 1))
@@ -78,51 +82,43 @@
     (doseq [w (doall (seq watchers))] (swap! *out-count* inc) (w o)))
   (get-outputs [sw] (doall (seq outputs))))

-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Watches      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;; Every watcher of a stub must also have it as an OR in its summary
-;; (possibly added with something else).
-;; Receiver of update is responsible for updating its summary --
-;;  implicitly, watched's summary may have changed, without cascading up the tree
-;; This allows changes in lock-step, so we don't end up with inconsistency problems.
-;; (decrease + increase)
-
-
-
-
 (defn connect-and-watch! [p c f]
   (summaries/connect! p c false)
   (add-watcher! c f))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Subproblems     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Protocols     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defprotocol Evaluable
-  (evaluate!      [s]))
-
-(defn can-evaluate? [s]
-  (instance? angelic.search.implicit.fah_astar_eval2.Evaluable s))
-
-;; Stub implements node, watched, possibly Evaluable, cached, Summarizable
-;;  -- Has at most a single output, not included in local reward -- goes dead
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Stubs     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defprotocol Stub
   (stub-name   [s])
   (input-set   [s]))

-(defn get-stub-output [s] (util/safe-singleton (get-outputs s)))
-
 (traits/deftrait simple-stub [name inp] [] [summaries/simple-cached-node simple-watched]
-  Stub (input-set [s] inp) (stub-name [s] name))
+  Stub (input-set [s] inp)
+       (stub-name [s] name))

 (defmethod print-method angelic.search.implicit.fah_astar_eval2.Stub [s o]
   (print-method (format "#<ST$%8h %s>" (System/identityHashCode s) (stub-name s)) o))

+
+;; Stub must implement Summarizable, optionally implements Evaluable
+
+(defprotocol Evaluable (evaluate! [s]))
+(defn can-evaluate? [s] (instance? angelic.search.implicit.fah_astar_eval2.Evaluable s))
+
+(defn set-stub-output! [stub sp]
+  (assert (empty? (get-outputs stub)))
+  (summaries/summary-changed-local! stub)
+  (add-output! stub sp))
+
+(comment (defn get-stub-output [s] (util/safe-singleton (get-outputs s))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Subproblems     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defprotocol Subproblem
   (stub              [s])
@@ -137,18 +133,27 @@
   (print-method (format "#<SP$%8h %s>" (System/identityHashCode (stub sp)) (subproblem-name sp)) o))

+(defn connect-subsuming! [child subsuming-sp]
+  (when subsuming-sp (summaries/connect! child (tree-summarizer subsuming-sp) true)))
+
+(defn add-sp-child! [sp child-sp]
+  (assert (not (terminal? sp)))
+  (summaries/summary-changed-local! sp)
+  (add-output! sp child-sp))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Tree Summarizer  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-;; Expects to be a parent of inside, but not have inside as a child.
-;; All children are tree summarizers.
-;; Non-subsuming children must be added by calling connect-child-sp!
+
+
+;; TODO: propagate top-down-bounds downward in smarter way using existing IS?
+;; TODO: we need to make sure tree sums get called on add-output! first to ensure
+;;       consistency with top-down-bounds ?
+;; TODO: top-down bound business does not actually help at all
+;;  (except ensuring consistency if we're asserting it...)
+
 (defprotocol TreeSummarizer
   (top-down-bound    [s])
   (add-top-down-bound! [s b]))
-
-;; TODO: propagate top-down-bounds downward in smarter way using existing IS?
-;; TODO: we need to make sure tree sums get called on add-output! first to ensure
-;;       consistency with top-down-bounds ?

 (defn tree-summarizer? [s] (instance? angelic.search.implicit.fah_astar_eval2.TreeSummarizer s))

@@ -165,23 +170,13 @@
                         (summaries/summary-changed! s)))
      summaries/Summarizable (summarize [s] (summaries/or-summary s @tdb-atom)))))

-(defn connect-subsuming! [child subsuming-sp]
-  (when subsuming-sp (summaries/connect! child (tree-summarizer subsuming-sp) true)))
-
 (defn init-tree-summarizer! [ts inner-sp subsuming-sp]
   (connect-and-watch! ts inner-sp
     (fn [child-sp]
       (summaries/connect! ts (tree-summarizer child-sp) false)
       (add-top-down-bound! (tree-summarizer child-sp) (top-down-bound ts))
-      (summaries/summary-changed! ts))) ;; TODO: speedup?
+      (summaries/summary-changed! ts))) ;; TODO: speedup by checking child reward?
   (connect-subsuming! ts subsuming-sp))
-
-;; TODO: top-down bound business does not actually help at all ?
-;; TODO: look at this.
-(comment         (let [my-sum (summaries/summary ret)
-                child-sum (summaries/summary (tree-summarizer child-sp))]
-            (when-not (summary/>= my-sum child-sum)
-              (summaries/summary-changed! ret))))

 (defn get-inner-sp [ts]
   (->> (summaries/node-ordinary-children ts)
@@ -195,17 +190,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblem Impl  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn set-stub-output! [stub sp]
-  (assert (empty? (get-outputs stub)))
-  (summaries/summary-changed-local! stub)
-  (add-output! stub sp))
-
-(defn add-sp-child! [sp child-sp]
-  (assert (not (terminal? sp)))
-  (summaries/summary-changed-local! sp)
-  (add-output! sp child-sp))
-

 (traits/deftrait simple-subproblem
   [stb out-set ts term? ri-fn] []
@@ -221,12 +205,21 @@
   (let [ts  (make-tree-summarizer init-bound)
         ret (traits/reify-traits [(simple-subproblem stub out-set ts terminal? ;; Note ni may have different context.
                                                      (fn [s ni] (if (= ni (input-set stub)) stub (ri-fn s ni))))]
-              summaries/Summarizable (summarize       [s] (summary-fn s (top-down-bound ts))))]
+              summaries/Summarizable (summarize [s] (summary-fn s (top-down-bound ts))))]
     (init-tree-summarizer! ts ret subsuming-sp)
     ret))

+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Wrappers     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TODO: simplify these, avoid extra stub steps when possible ?
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;     Output Collection     ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;; TODO: collect children too ?
-
 (declare make-output-collecting-subproblem)
 (defn make-output-collecting-stub [inner-stub]
   (assert (not (= (first (stub-name inner-stub)) :OS)))
@@ -257,7 +250,7 @@
                 (connect-and-watch! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %)))))))
     ret))

-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;     State Abstraction     ;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare make-state-abstracted-subproblem)
@@ -279,17 +272,13 @@
     ret))

-;; TODO: getting multi-levels of wrapping...
-;; Must state abstract when
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;     Subproblem Types and Stubs     ;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;     Core Subproblems     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Atomic       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare make-fs-seq-stub get-atomic-stub)
-

 (defn- make-atomic-subproblem [stub function-set subsuming-sp out-set reward status]
   (let [inp-set  (input-set stub)
@@ -313,11 +302,6 @@
               (connect-and-watch! ret child #(add-sp-child! ret %)))
             ret))))

-
-
-
-
-
 ;; Note: this is double-stage to lazily generate children.  Could be simpler single-stage.
 (defn- make-atomic-stub [name subsuming-sp inp-set function-set]
   (let [state (atom :ready) ;; set to [out-set reward] after first eval, then :go after second.
@@ -331,7 +315,6 @@
                                     (min (summaries/subsuming-bound s) (second @state)) s)))
          Evaluable
          (evaluate! [s]
-;                    (println "evals" s)
            (assert (not (= :go @state)))
            (let [ready? (= :ready @state)]
              (if-let [[out-set reward :as op] (if ready? (fs/apply-opt function-set inp-set) @state)]
@@ -344,23 +327,21 @@
                    (do (reset! state op) (summaries/summary-changed! s))))
                (do (reset! state :go) (summaries/summary-changed! s))))))]
     (connect-subsuming! ret subsuming-sp)
-    (if *no-identical-nonterminal-outputs*
-      (make-output-collecting-stub ret)
-      ret)))
+    ret))

 ;; Note: we must always wrap in S-A stub to get effects out of logger.
 ;; TODO: do something more with subsuming?
 (defn- get-atomic-stub [subsuming-sp inp-set function-set]
   (let [full-name [:Atomic (fs/fs-name function-set)
                    (if *state-abstraction* (fs/extract-context function-set inp-set) inp-set)]
-        name [:Atomic (fs/fs-name function-set)]]
+        make-stub #(let [r (make-atomic-stub [:Atomic (fs/fs-name function-set)] subsuming-sp % function-set)]
+                     (if *no-identical-nonterminal-outputs* (make-output-collecting-stub r) r))]
     (if-let [^HashMap dc *decompose-cache*]
       (if *state-abstraction*
-        (let [logged-inp (fs/get-logger function-set inp-set)
-              stub (util/cache-with dc full-name (make-atomic-stub name subsuming-sp logged-inp function-set))]
+        (let [stub (util/cache-with dc full-name (make-stub (fs/get-logger function-set inp-set)))]
           (make-state-abstracted-stub stub inp-set))
-        (util/cache-with dc full-name (make-atomic-stub name subsuming-sp inp-set function-set)))
-     (make-atomic-stub name subsuming-sp inp-set function-set))))
+        (util/cache-with dc full-name (make-stub inp-set)))
+     (make-stub inp-set))))

@@ -368,11 +349,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   Sequences    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare make-pair-stub1 make-pair-stub2)
-
-
-(defn can-split? [sp]
-  (or (summary/live? (summaries/summary sp))
-      (seq (get-outputs sp))))

 ;; TODO: fix up subsuming, parent, etc.
 ;; nils at bottom should chase subsuming-sp.
@@ -381,8 +357,7 @@
 ;; TODO: remove ss ?
 ;; Note: this is the only place logic depends on summary.  Potential for problems?
 (defn- make-pair-subproblem [subsuming-sp pair-stub left-sp right-sp]
-;  (println "mps" pair-stub)
-  (let [expand-right? (not (can-split? left-sp) )
+  (let [expand-right? (not (or (summary/live? (summaries/summary left-sp)) (seq (get-outputs left-sp))))
         [ss watch stub-f]
         (if expand-right?
           [(summaries/make-sum-summarizer [(tree-summarizer left-sp) right-sp])
@@ -421,8 +396,6 @@

     ret))

-
-
 ;; TODO: remove children as they are no longer needed ?
 (defn- make-pair-stub2 [subsuming-sp left-sp right-stub]
   (let [ret (traits/reify-traits
@@ -467,19 +440,13 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-;; TODO: simplify this.
 (defn- get-root-subproblem [inp-set fs]
-  (let [root-stub (get-atomic-stub nil inp-set fs)
-        inner-root (first (summary/extract-leaf-source-seq (summaries/summary root-stub)))
-        ret       (atom nil)]
-    (add-watcher! inner-root (fn [root] (reset! ret root)))
-    (evaluate! inner-root)
-    (evaluate! inner-root)
-    (assert @ret)
-    @ret))
+  (let [root-stub (make-atomic-stub nil nil inp-set fs)]
+    (dotimes [_ 2] (evaluate! root-stub))
+    (util/safe-singleton (get-outputs root-stub))))

 (defn implicit-fah-a*-eval2 [henv]
-  (binding [summaries/*cache-method* :eager
+  (binding [summaries/*cache-method* :lazy
             *decompose-cache* (when *decompose-cache* (HashMap.))]
     (summaries/solve
      (tree-summarizer (apply get-root-subproblem (fs/make-init-pair henv)))


fix reading of possible conditional ns forms

--- sidecar/src/figwheel_sidecar/core.clj
+++ sidecar/src/figwheel_sidecar/core.clj
@@ -170,11 +170,8 @@
   (try
     (when (.exists (as-file file-path))
       (with-open [rdr (io/reader file-path)]
-        (-> (java.io.PushbackReader. rdr)
-            read
-            second
-            #_name
-            #_underscore)))
+        (let [forms (ana/forms-seq* rdr file-path)]
+          (second (first forms)))))
     (catch java.lang.RuntimeException e
       nil)))


Hide 'test' button for noop action. This commit fixes behaviour that was recently broken.

--- src/cljs/hatnik/web/client/form/add_action.cljs
+++ src/cljs/hatnik/web/client/form/add_action.cljs
@@ -42,7 +42,7 @@
                   #js {:className "btn btn-primary pull-left"
                        :onClick #(action/send-new-action data-pack)} "Submit")

-                 (when-not (= :noop type)
+                 (when-not (= :noop (:type data))
                    (dom/button
                     #js {:className "btn btn-default"
                          :onClick #(action/test-action data-pack)} "Test")))))))
@@ -61,7 +61,7 @@
             #js {:className "btn btn-primary pull-left"
                  :onClick #(action/update-action data-pack)} "Update")

-           (when-not (= :noop type)
+           (when-not (= :noop (:type data))
              (dom/button
               #js {:className "btn btn-default"
                    :onClick #(action/test-action data-pack)} "Test")))))))


Replace printlns with appropriate logging calls

--- src/rente/ws.clj
+++ src/rente/ws.clj
@@ -14,7 +14,7 @@
   [_]
   (swap! ping-counts inc)
   (when (= 0 (mod @ping-counts 10))
-    (println "ping counts: " @ping-counts)))
+    (log/info "Ping counts:" @ping-counts)))

 (defmethod event-msg-handler :rente/testevent
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
@@ -26,7 +26,7 @@
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (let [session (:session ring-req)
         uid     (:uid     session)]
-    (println "Unhandled event: %s" event)
+    (log/info "Unhandled event:" event)
     (when ?reply-fn
       (?reply-fn {:umatched-event-as-echoed-from-from-server event}))))


Remove an unneeded conditional and clean up now that expand-init-option now does just that.

--- clj_record/core.clj
+++ clj_record/core.clj
@@ -85,12 +85,7 @@
             expand-init-option-fn (ns-resolve option-ns 'expand-init-option)]
         (if (nil? expand-init-option-fn)
           (throw (IllegalArgumentException. (format "%s/expand-init-option not defined" option-ns))))
-        (reduce
-          (fn [def-forms option-form]
-            (let [new-defs (apply expand-init-option-fn model-name option-form)]
-              (if new-defs (conj def-forms new-defs) def-forms)))
-          def-forms
-          options)))
+        (into def-forms (map #(apply expand-init-option-fn model-name %) options))))
     []
     option-groups))


simplify joy-* functions

simplify joy-* functions

--- input.clj
+++ input.clj
@@ -86,36 +86,15 @@
 	(get-axis :vertical)])

 (defn joy-left? []
-	(let [h (get-axis :horizontal)
-		  oh (first @axis-cache)]
-		(if (and (< h -0.3) (> oh -0.3))
-			(do (swap! axis-cache #(identity [h (last %)]))
-				true)
-			false)))
+	(< (get-axis :horizontal) -0.3))

 (defn joy-right? []
-	(let [h (get-axis :horizontal)
-		  oh (first @axis-cache)]
-		(if (and (> h 0.3) (< oh 0.3))
-			(do (swap! axis-cache #(identity [h (last %)]))
-				true)
-			false)))
+	(> (get-axis :horizontal) 0.3))

 (defn joy-up? []
-	(let [v (get-axis :vertical)
-		  ov (last @axis-cache)]
-
-		(if (and (< v -0.3) (> ov -0.3))
-			(do (swap! axis-cache #(identity [(first %) v]))
-				true)
-			false)))
+	(> (get-axis :vertical) 0.3))

 (defn joy-down? []
-	(let [v (get-axis :vertical)
-		  ov (last @axis-cache)]
-		(if (and (> v 0.3) (< ov 0.3))
-			(do (swap! axis-cache #(identity [(first %) v]))
-				true)
-			false)))
+	(< (get-axis :vertical) -0.3))


upgrade clojurescript and core.async

upgrade clojurescript and core.async

--- cljs/puzzle/project.clj
+++ cljs/puzzle/project.clj
@@ -2,9 +2,9 @@
   :description "lichess.org puzzle solver"
   :source-paths ["src-clj"]
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2202" :exclusions [org.apache.ant/ant]]
-                 [org.clojure/core.async "0.1.278.0-76b25b-alpha"]
-                 [jayq "2.5.0"]]
+                 [org.clojure/clojurescript "0.0-2268" :exclusions [org.apache.ant/ant]]
+                 [org.clojure/core.async "0.1.303.0-886421-alpha"]
+                 [jayq "2.5.1"]]
   :plugins [[lein-cljsbuild "1.0.3"]]
   :cljsbuild {
               :builds {


WIP: improve media queries

WIP: improve media queries

--- src/cljss/media.clj
+++ src/cljss/media.clj
@@ -79,16 +79,16 @@

 (s/def ::media-condition
   (s/alt
-    :modifier (s/? ::media-not)
+    :m-modifier (s/? ::media-not)
     :condition (s/cat
                  :in-parens ::media-in-parens
                  :conditions (s/* (s/alt
-                                    :modifier ::media-and
-                                    :modifier ::media-or)))))
+                                    :m-modifier ::media-and
+                                    :m-modifier ::media-or)))))

 (s/def ::media-in-parens
-  (s/or
-    :condition ::media-condition
+  (s/alt
+    :condition-in-parens (s/spec ::media-condition)
     :feature ::media-feature))

 (s/def ::media-not
@@ -108,14 +108,14 @@

 (s/def ::media-condition-without-or
   (s/alt
-    :condition ::media-not
+    :m-modifiers ::media-not
     :condition (s/cat
                  :in-parens ::media-in-parens
-                 :conditions (s/* ::media-and))))
+                 :m-modifiers (s/* ::media-and))))

 (s/def ::media-query
   (s/alt
-    :condition ::media-condition
+    :mq-condition ::media-condition
     :query (s/cat
              :modifier (s/? ::modifiers)
              :media-type ::media-types
@@ -124,6 +124,12 @@
                             :logical #{:and}
                             :cond-without-or ::media-condition-without-or)))))

+(s/def ::media-query-list
+  (s/or
+    :media-query ::media-query
+    :media-query-list (s/coll-of ::media-query)))
+
+
 ;;
 ;; AST compiler
 ;;
@@ -133,25 +139,48 @@

 (defmulti compile-media-query #'compile-media-query-dispatch)

+(defmethod compile-media-query :media-query-list [[_ media-query-list]]
+  (->> media-query-list
+       (map compile-media-query)
+       (interpose ", ")
+       flatten))
+
+(defmethod compile-media-query :media-query [[_ media-query]]
+  (flatten (compile-media-query media-query)))
+
 (defmethod compile-media-query :query [[_ query]]
   (->> (seq query) (map compile-media-query)))

 (defmethod compile-media-query :modifier [[_ modifier]]
   (name modifier))

+(defmethod compile-media-query :m-modifier [[_ m-modifier]]
+  (map compile-media-query m-modifier))
+
+(defmethod compile-media-query :m-modifiers [[_ m-modifiers]]
+  (mapcat
+    #(map compile-media-query %)
+    m-modifiers))
+
 (defmethod compile-media-query :media-type [[_ media-type]]
   (name media-type))

 (defmethod compile-media-query :condition [[_ condition]]
   (->> (seq condition) (map compile-media-query)))

+(defmethod compile-media-query :mq-condition [[_ condition]]
+  (compile-media-query condition))
+
 (defmethod compile-media-query :conditions [[_ conditions]]
-  (mapcat
-    #(compile-media-query [:condition %])
-    conditions))
+  (mapcat compile-media-query conditions))
+
+(defmethod compile-media-query :condition-in-parens [[_ condition-in-parens]]
+  (compile-media-query condition-in-parens))

 (defmethod compile-media-query :logical [[_ logical]]
-  (name logical))
+  (if (= logical :or)
+    ","
+    (name logical)))

 (defmethod compile-media-query :cond-without-or [[_ condition]]
   (compile-media-query condition))
@@ -171,7 +200,7 @@
     :else feature-value))

 (defmethod compile-media-query :plain [[_ {:keys [feature-name feature-value]}]]
-  (let [feature-name  (compile-media-query [:feature-name feature-name])
+  (let [feature-name (compile-media-query [:feature-name feature-name])
         feature-value (compile-media-query [:feature-value feature-value])]
     (str "(" feature-name ":" feature-value ")")))

@@ -182,24 +211,24 @@
   (str "(" (name bool) ")"))

 (defmethod compile-media-query :basic-range [[_ {:keys [left operator right]}]]
-  (let [left     (compile-media-query left)
-        right    (compile-media-query right)
+  (let [left (compile-media-query left)
+        right (compile-media-query right)
         operator (name operator)]
     (str "(" left " " operator " " right ")")))

 (defmethod compile-media-query :complex-range
   [[_ [_ {:keys [left left-operator feature-name right-operator right]}]]]
-  (let [left           (compile-media-query [:feature-value left])
-        feature-name   (compile-media-query [:feature-name feature-name])
-        right          (compile-media-query [:feature-value right])
-        left-operator  (name left-operator)
+  (let [left (compile-media-query [:feature-value left])
+        feature-name (compile-media-query [:feature-name feature-name])
+        right (compile-media-query [:feature-value right])
+        left-operator (name left-operator)
         right-operator (name right-operator)]
     (str "(" left " " left-operator " " feature-name " " right-operator " " right ")")))

 (defn -compile-media-query [query]
-  (let [ret (s/conform ::media-query query)
+  (let [ret (s/conform ::media-query-list query)
         ret (if (= ::s/invalid ret)
-              (throw (Error. (s/explain ::media-query query)))
+              (throw (Error. (s/explain ::media-query-list query)))
               (compile-media-query ret))]
     (->> (flatten ret)
          (clojure.string/join " ")
@@ -222,17 +251,17 @@
          ["" []])))

 (defmethod compile-media :styles [{styles :styles}]
-  (let [pseudo  (filterv utils/pseudo? styles)
+  (let [pseudo (filterv utils/pseudo? styles)
         pstyles (->> pseudo
                      (reduce
                        (fn [coll [rule styles]]
                          (conj coll (c/collect-styles (str (:cls @c/env*) (subs (name rule) 1)) styles)))
                        []))
-        styles  (filterv (comp not utils/pseudo?) styles)
+        styles (filterv (comp not utils/pseudo?) styles)
         [static values] (c/collect-styles (:cls @c/env*) styles)
-        values  (->> pstyles
-                     (mapcat second)
-                     (into values))]
+        values (->> pstyles
+                    (mapcat second)
+                    (into values))]
     [(str "{" (apply str static (map first pstyles)) "}")
      values]))

@@ -243,6 +272,7 @@
   (c/reset-env! {:cls "class"})

   (build-media
-    {[:only :screen :and [:min-width "300px"]]
+    {[[:only :screen :and [:min-width "300px"]]
+      [:print :and [:color]]]
      {:font-size 'p
       :&:hover   {:color 'g}}}))


Restructure clojars-app buildup

Restructure clojars-app buildup

compojure lets defroutes just take another ring handler, so
the extra if check is not needed.

--- src/clojars/web.clj
+++ src/clojars/web.clj
@@ -150,8 +150,8 @@
                             "Page not found"
                             (not-found-doc)))))

-(defroutes repo-routes
-  (context "/repo" request
+(defroutes clojars-app
+  (context "/repo" _
            (-> repo/routes
                (friend/authenticate
                 {:credential-fn
@@ -161,32 +161,24 @@
                                        (find-user-by-user-or-email id)]
                               {:username user :password password})))
                  :workflows [(workflows/http-basic :realm "clojars")]
-                 :unauthorized-handler (partial workflows/http-basic-deny "clojars")})
-               (repo/wrap-file (:repo config)))))
-
-(def site-app
-  (site
-   (-> main-routes
-       (friend/authenticate
-        {:credential-fn
-         (partial creds/bcrypt-credential-fn
-                  (fn [id]
-                    (when-let [{:keys [user password]}
-                               (find-user-by-user-or-email id)]
-                      {:username user :password password})))
-         :workflows [(workflows/interactive-form)
-                     registration/workflow]
-         :login-uri "/login"
-         :default-landing-uri "/"
-         :unauthorized-handler
-         (fn [r]
-           (-> (redirect "/login")
-               (assoc-in [:session ::friend/unauthorized-uri] (:uri r))))})
-       (wrap-resource "public")
-       (wrap-file-info))))
-
-(def clojars-app
-  (fn [{:keys [uri] :as r}]
-    (if (.startsWith uri "/repo/")
-      (repo-routes r)
-      (site-app r))))
+                 :unauthorized-handler
+                 (partial workflows/http-basic-deny "clojars")})
+               (repo/wrap-file (:repo config))))
+  (site (-> main-routes
+      (friend/authenticate
+       {:credential-fn
+        (partial creds/bcrypt-credential-fn
+                 (fn [id]
+                   (when-let [{:keys [user password]}
+                              (find-user-by-user-or-email id)]
+                     {:username user :password password})))
+        :workflows [(workflows/interactive-form)
+                    registration/workflow]
+        :login-uri "/login"
+        :default-landing-uri "/"
+        :unauthorized-handler
+        (fn [r]
+          (-> (redirect "/login")
+              (assoc-in [:session ::friend/unauthorized-uri] (:uri r))))})
+      (wrap-resource "public")
+      (wrap-file-info))))


Added the query parameter 'q' to API.

Added the query parameter 'q' to API.

--- web/src/sound_effector/controllers/api/sound_effect.clj
+++ web/src/sound_effector/controllers/api/sound_effect.clj
@@ -1,11 +1,14 @@
 (ns sound-effector.controllers.api.sound-effect
   (:require
+    [clojure.string :as string]
     [ring.util.response :refer [response]]
     [compojure.core :refer [defroutes GET]]
     [sound-effector.models.sound-effect :as model]))

-(defn show-list []
-  (response (model/read)))
+(defn show-list [query]
+  (if (string/blank? query)
+    (response (model/read))
+    (response (model/search query))))

 (defroutes routes
-           (GET "/api/sound-effects" [] (show-list)))
+           (GET "/api/sound-effects*" {params :query-params} (show-list (get params "q"))))


fix(backend): join the server on main ns

--- backend/src/uxbox/main.clj
+++ backend/src/uxbox/main.clj
@@ -17,4 +17,5 @@

 (defn -main
   [& args]
-  (mount/start))
+  (mount/start)
+  (.join uxbox.http/server))


Upgrade a whole bunch of the deps

Upgrade a whole bunch of the deps

--- build.boot
+++ build.boot
@@ -7,32 +7,32 @@
                  [org.clojure/clojure "1.8.0"]
                  [commons-io "2.4"]

-                 [org.slf4j/slf4j-log4j12 "1.6.6"]
-                 [clj-time "0.10.0"]
-                 [commons-collections/commons-collections "3.2.1"]
+                 [org.slf4j/slf4j-log4j12 "1.7.18"]
+                 [clj-time "0.11.0"]
+                 [commons-collections/commons-collections "3.2.2"]

-                 [compojure "1.4.0"]
+                 [compojure "1.5.0"]
                  [ring "1.4.0"]
-                 [org.optaplanner/optaplanner-core "6.2.0.Final" :exclusions [commons-io]]
-                 [ring/ring-defaults "0.1.2"]
+                 [org.optaplanner/optaplanner-core "6.3.0.Final" :exclusions [commons-io commons-codec]]
+                 [ring/ring-defaults "0.2.0"]
                  [org.clojure/tools.namespace "0.2.10"]
-                 [org.danielsz/system "0.1.9" :exclusions [org.clojure/tools.namespace]]
-                 [environ "1.0.0"]
+                 [org.danielsz/system "0.2.0" :exclusions [org.clojure/tools.namespace]]
+                 [environ "1.0.2"]
+                 [org.clojure/java.jdbc "0.4.2"]
                  [lobos "1.0.0-beta3" :exclude [org.clojure/java.jdbc]]
                  [org.xerial/sqlite-jdbc "3.8.11.2"]
-                 [org.clojure/java.jdbc "0.3.7"]
                  [korma "0.4.2"]

-                 [http-kit "2.1.18"]
+                 [http-kit "2.1.19"]
                  [de.ubercode.clostache/clostache "1.4.0"]
-                 [bouncer "0.3.3"]
+                 [bouncer "1.0.0"]
                  [ring/ring-json "0.4.0"]
                  [org.clojure/data.json "0.2.6"]
                  [danlentz/clj-uuid "0.1.6"]

                  [ring/ring-mock "0.3.0" :scope "test"]
                  [peridot "0.4.3" :scope "test"]
-                 [com.h2database/h2 "1.3.172"]
+                 [com.h2database/h2 "1.4.191"]

                  [cljfmt "0.4.1"]
                  [me.raynes/fs "1.4.6"]