Update package litedocx

Update package litedocx

--- src/bakyeono/litedocx.clj
+++ src/bakyeono/litedocx.clj
@@ -4,14 +4,16 @@
   (:require [bakyeono.litedocx.wpml :as w])
   (:use [bakyeono.litedocx.util]))

-(defrecord Resource [id type content-type part-name])
-
 ;;; DOCX package
 (defn check-styles
   [styles document]
   )

-(defn pack-docx
+(defn check-resources
+  [styles document]
+  )
+
+(defn- pack-docx
   "Creates DOCX package.
   Resources are created by w/resources."
   [dst styles resources]
@@ -19,18 +21,7 @@
         rels-rels (w/rels-rels)
         doc-props-app-xml (w/doc-props-app-xml :application "litedocx" :app-version 1.0)
         doc-props-core-xml (w/doc-props-core-xml)
-        word-document-xml (w/word-document-xml
-                            (w/table "a1" :center [964 964 8072]
-                                     (w/tr (w/td 964 (w/p "a" "name"))
-                                           (w/td 964 (w/p "a" "age"))
-                                           (w/td 8072 (w/p "a" "description"))))
-                            (w/p "para1"
-                                 "This is a paragraph.")
-                            (w/img "rId2"
-                                   "18cm"
-                                   "300px"
-                                   :name "foo.png"
-                                   :desc "Image Description: this is a testing image."))
+        word-document-xml (w/word-document-xml)
         word-styles-xml (w/word-styles-xml styles)
         word-rels-document-xml-rels (w/word-rels-document-xml-rels resources)
         word-media-resources (w/word-media-resources resources)
@@ -42,6 +33,83 @@
                  "word/styles.xml" (emit-xml-as-str word-styles-xml)
                  "word/_rels/document.xml.rels" (emit-xml-as-str word-rels-document-xml-rels)]]
     (apply write-zip dst (into entries word-media-resources))))
+
+(defn write-docx
+  "Write API for users."
+  [dst
+   & {:as params
+      :keys [styles resources body
+             application app-version
+             page-width page-height page-orientation
+             page-margin-top page-margin-bottom page-margin-left page-margin-right
+             page-margin-header page-margin-footer
+             title subject creator keywords description last-modified-by]
+      :or {:application "" :app-version ""
+           :page-width "210mm" :page-height "297mm" :page-orientation "portrait"
+           :page-margin-top 720 :page-margin-bottom 720
+           :page-margin-left 720 :page-margin-right 720
+           :page-margin-header 0 :page-margin-footer 0
+           :title "" :subject ""
+           :creator "" :last-modified-by ""
+           :keywords "" :description ""}}]
+  (let [content-types-xml (w/content-types-xml resources)
+        rels-rels (w/rels-rels)
+        doc-props-app-xml (w/doc-props-app-xml params)
+        doc-props-core-xml (w/doc-props-core-xml params)
+        word-document-xml (w/word-document-xml params)
+        word-styles-xml (w/word-styles-xml styles)
+        word-rels-document-xml-rels (w/word-rels-document-xml-rels resources)
+        word-media-resources (w/word-media-resources resources)
+        entries ["[Content_Types].xml" (emit-xml-as-str content-types-xml)
+                 "_rels/.rels" (emit-xml-as-str rels-rels)
+                 "docProps/app.xml" (emit-xml-as-str doc-props-app-xml)
+                 "docProps/core.xml" (emit-xml-as-str doc-props-core-xml)
+                 "word/document.xml" (emit-xml-as-str word-document-xml)
+                 "word/styles.xml" (emit-xml-as-str word-styles-xml)
+                 "word/_rels/document.xml.rels" (emit-xml-as-str word-rels-document-xml-rels)]]
+    (apply write-zip dst (into entries word-media-resources))))
+
+(defn sample1
+  []
+  (write-docx :styles [(w/paragraph-style "headline"
+                                          :font "Sans Serif"
+                                          :font-color "000000"
+                                          :font-size 20
+                                          :bold true
+                                          :align "both")
+                       (w/paragraph-style "date"
+                                          :font "Arial"
+                                          :font-color "4444CC"
+                                          :font-size 12
+                                          :italics true
+                                          :algin "right")
+                       (w/paragraph-style "author"
+                                          :font "Arial"
+                                          :font-color "aa0000"
+                                          :font-size 13
+                                          :algin "right")
+                       (w/paragraph-style "monospace"
+                                          :font "Monospace"
+                                          :font-color "000000"
+                                          :algin "left")
+                       (w/paragraph-style "body")
+                       (w/table-style "table"
+                                      :font "Arial"
+                                      :font-color "449944"
+                                      :align "center")]
+              ;; TODO: need a better way to create resource meta datas
+              :resources (w/resources ["image/png" "foo.png" (load-byte-array "foo.png")])
+              :document [(w/table "a1" :center [964 964 8072]
+                                  (w/tr (w/td 964 (w/p "a" "name"))
+                                        (w/td 964 (w/p "a" "age"))
+                                        (w/td 8072 (w/p "a" "description"))))
+                         (w/p "para1"
+                              "This is a paragraph.")
+                         (w/img "rId2"
+                                "800px"
+                                "600px"
+                                :name "foo.png"
+                                :desc "Image Description: this is a testing image.")]))

 (defn sample-pack
   []
@@ -61,3 +129,4 @@
     "SAMPLE3.docx"
     [(w/paragraph-style "para1" :font "NanumGothic" :font-color "0000AA" :align "both")]
     (w/resources)))
+


No need to sleep on every batch.

No need to sleep on every batch.

--- test/onyx/plugin/input_fault_tolerance_test.clj
+++ test/onyx/plugin/input_fault_tolerance_test.clj
@@ -125,8 +125,8 @@
   {:lifecycle/before-batch (fn [event lifecycle]
                              ; give the peer a bit of time to write
                              ;; the chunks out and ack the batches
-                             (Thread/sleep 3000)
                              (when (zero? (mod (swap! batch-num inc) 3))
+                               (Thread/sleep 3000)
                                (throw (ex-info "Restartable" {:restartable? true}))))})

 (def lifecycles


(PDB-3302) Add db-fallback integration test

--- test/puppetlabs/puppetdb/integration/simple.clj
+++ test/puppetlabs/puppetdb/integration/simple.clj
@@ -84,8 +84,9 @@
                   :version :v4}]
     (try
       (swap! dispatch/metrics svc-utils/clear-counters!)
-      {:app (tkbs/parse-and-bootstrap bootstrap-config-file
-                                      {:config tmp-puppetdb-conf})
+      {:app (tu/without-jmx
+             (tkbs/parse-and-bootstrap bootstrap-config-file
+                                       {:config tmp-puppetdb-conf}))
        :base-url base-url}

       (catch java.net.BindException e
@@ -104,7 +105,8 @@
                           :port port
                           :query-base-url (assoc base-url :prefix "/pdb/query" :version :v4)
                           :command-base-url (assoc base-url :prefix "/pdb/cmd" :version :v1)
-                          :admin-base-url (assoc base-url :prefix "/pdb/admin" :version :v1)}
+                          :admin-base-url (assoc base-url :prefix "/pdb/admin" :version :v1)
+                          :app app}
                          app)))

 (defn pql-query [pdb-server query]
@@ -129,8 +131,8 @@
 (def dev-config-file "./test-resources/puppetserver/puppetserver.conf")
 (def dev-bootstrap-file "./test-resources/puppetserver/bootstrap.cfg")

-(defn run-puppet-server [pdb-server config-overrides]
-  (let [pdb-info (info-map pdb-server)
+(defn run-puppet-server [pdb-servers config-overrides]
+  (let [pdb-infos (map info-map pdb-servers)
         puppetdb-conf (io/file "target/puppetserver/master-conf/puppetdb.conf")]
     (fs/copy-dir "test-resources/puppetserver/ssl" "./target/puppetserver/master-conf/ssl")
     (fs/copy+ "test-resources/puppetserver/puppet.conf" "target/puppetserver/master-conf/puppet.conf")
@@ -138,7 +140,9 @@

     (fs/create puppetdb-conf)
     (ks/spit-ini puppetdb-conf
-                 {:main {:server_urls (str "https://" (:hostname pdb-info) ":" (:port pdb-info))}})
+                 {:main {:server_urls (->> (for [pdb-info pdb-infos]
+                                             (str "https://" (:hostname pdb-info) ":" (:port pdb-info)))
+                                           (clojure.string/join ","))}})

     (let [services (tk-bootstrap/parse-bootstrap-config! dev-bootstrap-file)
           tmp-conf (ks/temp-file "puppetserver" ".conf")
@@ -185,3 +189,21 @@
       "catalogs[certname, environment] {}" [{:certname "localhost", :environment "production"}]
       "factsets[certname, environment] {}" [{:certname "localhost", :environment "production"}]
       "reports[certname, environment] {}" [{:certname "localhost", :environment "production"}])))
+(deftest ^:integration db-fallback
+  (with-open [pg1 (setup-postgres)
+              pg2 (setup-postgres)
+              pdb1 (run-puppetdb pg1 {})
+              pdb2 (run-puppetdb pg2 {})
+              ps (run-puppet-server [pdb1 pdb2] {})]
+
+    (testing "Agent run against pdb1"
+      (run-puppet ps "notify { 'hello, world!': }")
+      (is (= 1 (count (pql-query pdb1 "nodes {}")))))
+
+    (testing "Fallback to pdb2"
+      (tk-app/stop (:app pdb1))
+      (is (= 0 (count (pql-query pdb2 "nodes {}"))))
+
+      (run-puppet ps "notify { 'hello, world!': }")
+      (is (= 1 (count (pql-query pdb2 "nodes {}")))))))
+


use new om/render api

use new om/render api

--- labs/architecture-examples/om/src/todomvc/app.cljs
+++ labs/architecture-examples/om/src/todomvc/app.cljs
@@ -38,7 +38,14 @@
                       :onChange #(toggle-all % todos)})
       (dom/ul #js {:id "todo-list"}
         (into-array
-          (map #(om/render item/todo-item todos [%] opts :id)
+          (map #(om/render item/todo-item todos
+                  {:path [%]
+                   :opts opts
+                   :key :id
+                   :fn (fn [todo]
+                         (if (= (:id todo) (:editing opts))
+                           (assoc todo :editing true)
+                           todo))})
             (range (count todos))))))))

 (defn footer [{:keys [todos] :as app} opts]
@@ -75,7 +82,7 @@
     (into [] (filter #(= (:id %) id) (:todos app)))))

 (defn edit-todo [app todo]
-  (om/replace! todo [:editing] (:id todo)))
+  (om/replace! app [:editing] (:id todo)))

 (defn save-todo [todo text]
   (om/replace! todo (update-in todo [:title] text)))
@@ -122,11 +129,13 @@
                    :id "new-todo"
                    :placeholder "What needs to be done?"
                    :onKeyDown #(handle-new-todo-keydown % app owner)})
-            (om/render main app [:todos]
-              {:chans chans :editing (:editing app)})
-            (om/render footer app []
-              {:active active :completed completed
-               :chans chans :showing :all})))))))
+            (om/render main app
+              {:path [:todos]
+               :opts {:chans chans :editing (:editing app)}})
+            (om/render footer app
+              {:path []
+               :opts {:active active :completed completed
+                      :chans chans :showing :all}})))))))

 (om/root app-state todo-app (.getElementById js/document "todoapp"))


refactoring: thumbnails in separate function

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/entry.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/entry.cljs
@@ -263,6 +263,24 @@
      (when-let [measurements (:measurements entry)]
        [:pre [:code (with-out-str (pp/pprint measurements))]])]))

+(defn thumbnails
+  "Renders thumbnails of photos in linked entries. Respects private entries."
+  [entry entries-map cfg put-fn]
+  (let [ts (:timestamp entry)
+        linked-entries-set (set (:linked-entries-list entry))
+        get-or-retrieve (fn [ts]
+                          (let [entry (get entries-map ts)]
+                            (or entry
+                                (let [missing-entry {:timestamp ts}]
+                                  (put-fn [:entry/find missing-entry])
+                                missing-entry))))
+        with-imgs (filter :img-file (map get-or-retrieve linked-entries-set))
+        filtered (if (:show-pvt cfg) with-imgs (filter u/pvt-filter with-imgs))]
+    [:div.thumbnails
+     (for [img-entry filtered]
+       ^{:key (str "thumbnail" ts (:img-file img-entry))}
+       [:div [m/image-view img-entry "?width=300"]])]))
+
 (defn entry-with-comments
   "Renders individual journal entry. Interaction with application state happens
    via messages that are sent to the store component, for example for toggling
@@ -299,24 +317,4 @@
           (let [n (count comments)]
             [:span {:on-click toggle-comments :on-mouse-enter toggle-comments}
              (str "show " n " comment" (when (> n 1) "s"))])]))
-
-     ; TODO: move thumbnails section in separate function
-     (let [linked-entries-set (set (:linked-entries-list entry))
-           with-imgs (filter
-                       :img-file
-                       (map (fn [ts]
-                              (let [entry (get entries-map ts)]
-                                (or
-                                  entry
-                                  (let [missing-entry {:timestamp ts}]
-                                    (put-fn [:entry/find missing-entry])
-                                    missing-entry))))
-                            linked-entries-set))
-           filtered (if (:show-pvt cfg)
-                      with-imgs
-                      (filter u/pvt-filter with-imgs))]
-       [:div.thumbnails
-        (for [img-entry filtered]
-          ^{:key (str "thumbnail" ts (:img-file img-entry))}
-          [:div
-           [m/image-view img-entry "?width=300"]])])]))
+     [thumbnails entry entries-map cfg put-fn]]))


Remove profiles.clj

Remove profiles.clj

--- profiles.clj
+++ profiles.clj
@@ -1 +0,0 @@
-{}


fix: [bug] dom nesting was wrong

fix: [bug] dom nesting was wrong

--- src/bulk_trader/core.cljs
+++ src/bulk_trader/core.cljs
@@ -54,7 +54,7 @@
   (.log js/console "inside e-trade"))

 (defn e-edit-data-save [e]
-  (let [data (.-value (.-firstChild (.-parentNode (.-parentNode (.-target e)))))]
+  (let [data (.-value (.-firstChild (.-parentNode (.-parentNode (.-parentNode (.-target e))))))]
     (swap! g/app-state assoc :data (p/parse data)))
   (clear-overlay e))

@@ -114,14 +114,17 @@
                          [:h3 nil "Logged in to trader: "
                           [:mark nil (:trader data)]]
                          (if (empty? (:data data))
-                           [:div nil [:label nil
-                                      [:button {:className "btn btn-default"
-                                                :onClick e-edit-data}
-                                       "Enter / Copy-Paste"]
-                                      [:label nil
-                                       [:button {:className "btn btn-default"
-                                                 :onClick e-upload-data}
-                                        "Upload"]]]]
+                           [:div nil
+                            [:label nil
+                             [:button {:className "btn btn-default"
+                                       :onClick e-edit-data}
+                              "Enter / Copy-Paste"]]
+                            [:label nil
+                             [:input {:type "file"
+                                      :className "fileinput"}]
+                             [:button {:className "btn btn-default"
+                                       :onClick e-upload-data}
+                              "Upload"]]]
                            [:div nil
                             [:div nil [:label nil
                                        [:button {:className "btn btn-default"


Fix the eastwood `:wrong-tag` warning on `extend-protocol` macro

The details for the linter warning are outlined here:
https://github.com/jonase/eastwood#wrong-tag-warnings-in-uses-of-extend-type-and-extend-protocol-macro

This is the only version that both (a) avoids reflection, and (b)
Eastwood will not warn about.  It calls the function extend, and
uses a correct type tag ^bytes on the first argument.

--- src/caesium/byte_bufs.clj
+++ src/caesium/byte_bufs.clj
@@ -39,11 +39,13 @@
 (defprotocol BufLen
   (^Long buflen [this]))

+(extend (Class/forName "[B")
+  BufLen
+  {:buflen
+   (fn [^bytes this]
+     (long (alength this)))})
+
 (extend-protocol BufLen
-  (Class/forName "[B")
-  (buflen [this]
-    (long (alength ^bytes this)))
-
   ByteBuffer
   (buflen [this]
     (long (.remaining ^ByteBuffer this))))


Remove unused core namespace require on maybe ns.

--- src/cats/monad/maybe.cljc
+++ src/cats/monad/maybe.cljc
@@ -32,8 +32,7 @@
       (maybe/just 1)
       ;; => #<Just [1]>
   "
-  (:require [cats.protocols :as p]
-            [cats.core :as m]))
+  (:require [cats.protocols :as p]))

 (declare maybe-monad)


Fix up leibniz and refactor goal handling

It compiles and runs! Doesn't get the right answer yet though. Also most
of the rules are still missing.

It doesn't use an explicit goal anymore. Instead when the first rule set
fails to match, the control system switches to the next rule set and so
on. A more sophisticated system might be nice as an extension, but this is
pretty simple.

--- src/chapter3/leibniz.cljs
+++ src/chapter3/leibniz.cljs
@@ -7,56 +7,58 @@
 (defn nested-diff-x2? [d v]
   (= v (d :e1)))
 (def diff-sum-rule
-  ['differentiate
-   '(d (nested-diff-sum? e3) (? v1))
+  ['(d (nested-diff-sum? e3) (? v1))
    #(list '+ (list 'd (% :e1) (% :v1)) (list 'd (% :e2) (% :v1)))
    "diff-sum-rule"])
 (def diff-x-rule
-  ['differentiate
-   '(d (nested-diff-x1? e1) (nested-diff-x2? e2))
+  ['(d (nested-diff-x1? e1) (nested-diff-x2? e2))
    1
    "diff-x-rule"])
 ; other rules go here ...

 ; TODO: Clojure HAS to have a class/record facility to do this...
-(def rule-goal first)
-(def rule-pattern second)
-(defn rule-action [rule] (nth rule 2))
-(defn rule-name [rule] (nth rule 3))
+(def rule-pattern first)
+(defn rule-action [rule] second)
+(defn rule-name [rule] (nth rule 2))
+
 (def rules
-  [diff-sum-rule diff-x-rule])
+  [[diff-sum-rule diff-x-rule]
+   [; TODO: arithmetic simplication rules go here
+    ]])
+
 ;;; control scheme ;;;
 ; (I don't know--that's just what the book calls it)
-(declare try-rule1)
+(declare try-rule)
 (defn try-rule-on-list [rule expressions]
   (if (empty? expressions)
     nil
-    (if-let [temp (try-rule1 rule (first expressions))]
+    (if-let [temp (try-rule rule (first expressions))]
       (cons temp (rest expressions))
       (when-let [temp (try-rule-on-list rule (rest expressions))]
         (cons (first expressions) temp)))))
-(defn fire [rule]
+(defn fire [rule d]
   (println (rule-name rule) " fires.")
-  ((rule-action rule)))
-(defn try-rule1 [rule expression]
-  (cond
-    (atom? expression) nil
-    (match-state (rule-pattern rule) expression) (fire rule)
-    :else (try-rule-on-list rule expression)))
+  ((rule-action rule) d))
 (defn try-rule [rule expression]
-  (if (= current-goal (rule-goal rule))
-    (try-rule1 rule expression)))
+  (if (atom? expression)
+    nil
+    (if-let [d (match-state (rule-pattern rule) expression)]
+      (fire rule d)
+      (try-rule-on-list rule expression))))
 (defn try-rules [rules formula]
-  (loop [rules-left rules]
+  (loop [rules-left rules
+         formula formula]
     (cond
       (empty? rules-left) nil ; no rules applied -- fail
       (atom? formula) nil ; ??? (reduced to an atom?) -- fail
       :else (if-let [new-formula (try-rule (first rules-left) formula)]
               new-formula
               (recur (rest rules-left) formula)))))
-(defn control []
-  ; TODO: current-formula is unbound
-  (loop [current-formula '()]
-      (if-let [new-formula (try-rules rules current-formula)]
-        (recur new-formula)
-        current-formula)))
+(defn control [formula rules]
+  (loop [formula formula
+         rules rules]
+    (if-let [new-formula (try-rules (first rules) formula)]
+      (recur new-formula rules)
+      (if (empty? (rest rules))
+        formula
+        (recur formula (rest rules))))))


More informative error message

More informative error message

--- src-cljs/frontend/send/resolve.cljs
+++ src-cljs/frontend/send/resolve.cljs
@@ -41,5 +41,6 @@
                          (chan 1 (comp
                                   (map #(get % read-from-key))
                                   (map #(hash-map (:key ast) %)))))
-            (throw (ex-info "Unknown key" {:key read-from-key}))))))
+            (throw (ex-info (str "Unknown key " read-from-key)
+                            {:key read-from-key}))))))
      channel)))


[inbox] Show count of documents in Inbox

--- src-cljs/pepa/workflows/inbox2.cljs
+++ src-cljs/pepa/workflows/inbox2.cljs
@@ -47,8 +47,10 @@

 (defrecord InboxColumnSource [id]
   ColumnSource
-  (column-title [_ _]
-    "Inbox")
+  (column-title [inbox state]
+    (str "Inbox "
+         (when-let [ps (seq (column-pages inbox state))]
+           (str "(" (count ps) ")"))))
   (column-header-url [_]
     nil)
   (column-pages [_ state]
@@ -394,12 +396,11 @@
   (let [columns (om/get-state owner :columns)
         target  (first (filter #(= (:id %) target) columns))
         source  (first (filter #(= (:id %) source) columns))
-        ;; Remove page-ids already in `target'
         existing-pages (mapv :id (if (satisfies? ColumnSource target)
                                    (column-pages target state)
                                    []))
         pages (into []
-                    (comp (remove (set existing-pages))
+                    (comp (remove (set existing-pages)) ; remove page-ids already in `target'
                           (map page-cache)
                           (map om/value))
                     page-ids)


remove tokens from analysis

remove tokens from analysis

--- src/clj/ceres/curator.clj
+++ src/clj/ceres/curator.clj
@@ -156,7 +156,7 @@
   (loop [counter 0
          max-path 0
          users []
-         tokens []
+         ;;tokens []
          pub-times []
          hashtags []
          delays []
@@ -165,7 +165,7 @@
       {:size counter
        :height max-path
        :users users
-       :tokens tokens
+       ;;:tokens tokens
        :pub-times pub-times
        :hashtags (mapv #(-> % :text clojure.string/lower-case) hashtags)
        :delays delays}
@@ -180,7 +180,7 @@
          (let [user (-> node :tweet :user)]
              (conj users (:screen_name user)))
          users)
-       (if (zip/node loc)
+       #_(if (zip/node loc)
          (conj
           tokens
           (clojure.set/difference


* src/clj/cljs/compiler.clj: simplify emit :invoke conditions

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -697,10 +697,12 @@
                   [f false]))))
           [f false])]
     (emit-wrap env
-      (emits f (when-not (or fn? js?) ".call") "("
-                 (let [args (if (or fn? js?) args (cons "null" args))]
-                   (comma-sep args))
-                 ")"))))
+      (cond
+       (or fn? js?)
+       (emits f "(" (comma-sep args)  ")")
+
+       :else
+       (emits f ".call(" (comma-sep (cons "null" args)) ")")))))

 (defmethod emit :new
   [{:keys [ctor args env]}]


Fix wrong type annotation in conn-mgr and hide a var.

--- src/clj_http/conn_mgr.clj
+++ src/clj_http/conn_mgr.clj
@@ -24,7 +24,7 @@
             DefaultConnectingIOReactor)
            (org.apache.http.nio.conn NoopIOSessionStrategy)))

-(def insecure-context-verifier
+(def ^:private insecure-context-verifier
   {
    :context (-> (SSLContexts/custom)
                 (.loadTrustMaterial nil (reify TrustStrategy
@@ -32,7 +32,7 @@
                 (.build))
    :verifier NoopHostnameVerifier/INSTANCE})

-(def ^SSLIOSessionStrategy insecure-socket-factory
+(def ^SSLConnectionSocketFactory insecure-socket-factory
   (let [{:keys [context  verifier]} insecure-context-verifier]
     (SSLConnectionSocketFactory. ^SSLContext context
                                  ^HostnameVerifier verifier)))


CLJS-774: ensure correct cljs.reader inst and ratio parsing.

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -133,7 +133,7 @@
   (let [groups (re-find* ratio-pattern s)
         numinator (aget groups 1)
         denominator (aget groups 2)]
-    (/ (js/parseInt numinator) (js/parseInt denominator))))
+    (/ (js/parseInt numinator 10) (js/parseInt denominator 10))))

 (defn- match-float
   [s]
@@ -468,7 +468,7 @@
 (def ^:private timestamp-regex #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?")

 (defn ^:private parse-int [s]
-  (let [n (js/parseInt s)]
+  (let [n (js/parseInt s 10)]
     (if-not (js/isNaN n)
       n)))


Set position when creating entity

Set position when creating entity

--- src/cljs/engine/core.cljs
+++ src/cljs/engine/core.cljs
@@ -12,13 +12,13 @@

 ;; TODO make a record and protocol for an entity
 (defn create-entity!
-  [stage img]
+  [stage img pos-x pos-y anc-x anc-y]
   (let [texture (js/PIXI.Texture.fromImage img)
         sprite (js/PIXI.Sprite. texture)]
-    (set! (.-position.x sprite) 500)
-    (set! (.-position.y sprite) 300)
-    (set! (.-anchor.x sprite) .05)
-    (set! (.-anchor.y sprite) .05)
+    (set! (.-position.x sprite) pos-x)
+    (set! (.-position.y sprite) pos-y)
+    (set! (.-anchor.x sprite) anc-x)
+    (set! (.-anchor.y sprite) anc-y)
     (swap! entities conj sprite)))

 (defn render-entity [stage e]
@@ -71,6 +71,6 @@
     (.setInterval js/window #(draw renderer stage) (/ 1000 60))))

 (defn start []
-  (create-entity! stage "static/images/bunny.png")
+  (create-entity! stage "static/images/bunny.png" 500 500 0.05 0.05)
   (render-loop)
   (game-loop))


Fix pausing and unpausing of the game loop

--- src/cljs/engine/core.cljs
+++ src/cljs/engine/core.cljs
@@ -60,10 +60,10 @@
           (do
             (render-system s/state)
             (request-animation #(game-loop now dt step)))
-          ;; FIX paused game will end the game loop
-          (when-not (:paused @s/game)
-            (iter-systems s/state step)
-            (recur (- dt step))))))))
+          (if (:paused @s/game)
+            (recur (- dt step))
+            (do (iter-systems s/state step)
+                (recur (- dt step)))))))))

 (defn set-interval
   "Creates an interval loop of n calls to function f per second.


Improved speed by reflecting over y=0. Made background full screen. Committed by Ben Weintraub.

--- src/cljs/jackal/core.cljs
+++ src/cljs/jackal/core.cljs
@@ -4,21 +4,21 @@
             [dommy.core :as dommy :refer-macros [sel1]]
             [quil.core :as q :include-macros true]
             [quil.middleware :as m]))
-            ;; [jackal.common :as common :refer-macros [mandelbrot-set-iterations]]))
-

 (enable-console-print!)

+(def range-min -3)
+(def range-max 3)
+(def screen-width (.-innerWidth js/window))
+(def screen-height (.-innerHeight js/window))
 (def max-iterations 50)
-(def scaling-factor 200)
+(def scaling-factor (/ screen-width (- range-max range-min)))
 (def range-step-size (/ 1 scaling-factor))
 (def rect-size 1)
-(def pixel-offset-x 600)
-(def pixel-offset-y 400)
-(def range-min -2)
-(def range-max 2)
+(def pixel-offset-x (/ screen-width 2))
+(def pixel-offset-y (/ screen-height 2))
 (def canvas-name "fractal-canvas")
-
+(def actual-range (range range-min range-max range-step-size))

 (defn offset-pixel-coordinate-x
   [x]
@@ -29,15 +29,18 @@
   (+ pixel-offset-y y))

 (defn scale-pixel-coordinate
-  [x]
-  (* scaling-factor x))
+  [val]
+  (* val scaling-factor))

-(defn add-canvas
+(defn init-canvas
   []
   (let [canvas-element (dommy/create-element :canvas)]
     (dommy/append!
      (sel1 :body)
-     (dommy/set-attr! canvas-element :id canvas-name :width 1200 :height 750))))
+     (dommy/set-attr! canvas-element
+                      :id canvas-name
+                      :width screen-width
+                      :height screen-height))))

 (defn setup []
   (q/frame-rate 60)
@@ -47,27 +50,28 @@

 (defn draw
   []
-  (q/translate pixel-offset-x pixel-offset-y)
   (doseq [x (range range-min range-max range-step-size)
           y (range 0 range-max range-step-size)]
-    (let [scaled-x (scale-pixel-coordinate x)
-          scaled-y (scale-pixel-coordinate y)
+    (let [scaled-x (* scaling-factor x)
+          scaled-y (* scaling-factor y)
+          offset-scaled-x (+ pixel-offset-x scaled-x)
+          offset-scaled-y (+ pixel-offset-y scaled-y)
+          y-inv (q/floor (+ (* -1 scaled-y) pixel-offset-y))
           iterations (numerics/mandelbrot-set-iterations x y max-iterations)
           col (mod (+ iterations 128) 255)]
       (q/fill col 255 (if (= iterations max-iterations) 0 255))
-      (q/rect scaled-x scaled-y rect-size rect-size)
-      ;; reflecting over y=0, for performance (though a true mandelbrot set
-      ;; is not exactly symmetrical)
-      (q/rect scaled-x (* -1 scaled-y) rect-size rect-size))))
+      (q/rect offset-scaled-x y-inv rect-size rect-size)
+      (q/rect offset-scaled-x offset-scaled-y rect-size rect-size)))
+  (q/no-loop))

-(add-canvas)
+(init-canvas)

 (q/defsketch mandlebrot-set
   :host canvas-name
   :title "The Mandelbrot Set"
   :setup setup
   :draw draw
-  :size [1200 750]
+  :size [screen-width screen-height]
   :middleware [m/fun-mode])

 (println "hello world.")


Improve search and course table

Improve search and course table

--- src/cljs/kulive/view.cljs
+++ src/cljs/kulive/view.cljs
@@ -9,24 +9,27 @@
 (defn search-component
   []
   (let [search-input (re-frame/subscribe [:search-input])
-        course-count (re-frame/subscribe [:count-courses-in-search])]
+        course-count (re-frame/subscribe [:count-courses-in-search])
+        displayed-courses (re-frame/subscribe [:courses-to-display])]
     (fn []
       [:form {:style {:margin-bottom "1rem"}}
-       [:div.row
-        [:div {:class "six columns"}
-         [:label {:for "search-courses"} (str "Course Search (" @course-count ")")]
-         [:input.u-full-width
-          {:id "search-courses"
-           :type "search"
-           :autoComplete "off"
-           :on-change #(re-frame/dispatch
-                        [:search-input-entered (-> % .-target .-value)])
-           :on-key-down #(if (= (.-which %) 13)
-                           (do (re-frame/dispatch
-                                [:course-search-entered])
-                               (.preventDefault %))
-                           nil)
-           :placeholder "Course ID, Title, Professor, etc..."}]]]])))
+       [:label {:for "search-courses"} (str "Course Search (" @course-count ")")]
+       [:input
+        {:id "search-courses"
+         :type "search"
+         :style {:width "50%"}
+         :autoComplete "off"
+         :on-change #(re-frame/dispatch
+                      [:search-input-entered (-> % .-target .-value)])
+         :on-key-down #(if (= (.-which %) 13)
+                         (do (re-frame/dispatch
+                              [:course-search-entered])
+                             (.preventDefault %))
+                         nil)
+         :placeholder "Course ID, Title, Professor, etc..."}]
+       (if (= 1 (count @displayed-courses))
+         [:button.button-primary
+          {:style {:margin-left ".8rem" :margin-botton "15px"}} "Add course"])])))

 (defn course-row-component [course]
   "Row with course info"
@@ -53,7 +56,7 @@
                       [:th "Credits"]
                       [:th "Class"]]]
              [:tbody (if (= 1 (count @courses-to-display))
-                       {:style {:background "#f5f6f0"}})
+                       {:style {:background "#f4faff"}})
               (for [course @courses-to-display]
                 ^{:key (get-in (val course) [:kr :number])}
                 [course-row-component course])]
@@ -66,18 +69,21 @@
         credit-sum (re-frame/subscribe [:sum-credits-in-my-courses])]
     (fn []
       [:div
-       [:h4 "My Courses"]
+       [:div
+        [:h4 {:style {:display "inline-block"
+                      :margin-right "2rem"}} "My Courses"]
+        [:label {:style {:display "inline-block"}}
+         "Total credits: " (str @credit-sum)]]
        (if (empty? @my-courses)
          [:p "No courses yet"]
          [:div
-          [:label "Total credits: " (str @credit-sum)]
           [:ul (for [course @my-courses]
                  ^{:key (hash (first course))} [:li (str/join " " course)])]])])))

 (defn home-page []
   [:div.container
    [:div {:style {:margin-top "4%" :margin-bottom "5%"}}
-    [:h2 "KU Live"]
+    [:h2 "KU_LIVE"]
     [search-component]
     [courses-table-component]
     [my-courses-component]


Show dates for all weekdays.

Show dates for all weekdays.

--- src/cljs/tunnit/core.cljs
+++ src/cljs/tunnit/core.cljs
@@ -2,7 +2,7 @@
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [cljs-time.core :as t]
-            [cljs-time.format :as format]
+            [cljs-time.format :as f]
             [om-tools.dom :as ot :include-macros true]
             [om-tools.core :refer-macros [defcomponent]]
             [clojure.string :as str]
@@ -10,15 +10,13 @@

 (enable-console-print!)

-(defn week []
-  (subs
-    (get
-      (str/split
-        (format/unparse (format/formatters :week-date) (t/now))
-        #"-")
-      1) 1))
+(defn week-nr []
+  (subs (get (str/split
+               (f/unparse (f/formatters :week-date) (t/now))
+               #"-")
+             1) 1))

-(def app-state (atom {:text (str "Viikko " (week)) :date ""}))
+(def app-state (atom {:text (str "Viikko " (week-nr)) :date ""}))

 (def day-map
   {1 {:name "Ma" :date ""}
@@ -27,25 +25,34 @@
    4 {:name "To" :date ""}
    5 {:name "Pe" :date ""}
    6 {:name "La" :date ""}
-   7 {:name "Su" :date ""}})
+   7 {:name "Su" :date ""}
+   })

 (def date-format
-  (format/formatter "dd.MM."))
+  (f/formatter "dd.MM."))

-(defn update-vals [m f & args]
-  (reduce
-    (fn [r [k v]] (assoc r k (apply f v args)))
-    {} m))
+(defn parse-date [date]
+  (f/unparse date-format date))

-(defn today []
-  (format/unparse date-format (t/now)))
-
-(defn week-day [date]
+(defn week-day-nr [date]
   (t/day-of-week date))

+(defn map-kv
+  "Given a map and a function of two arguments, returns the map
+  resulting from applying the function to each of its entries. The
+  provided function must return a pair (a two-element sequence.)"
+  [m f]
+  (into {} (map (fn [[k v]] (f k v)) m)))
+
+(defn count-date [k v]
+  (let [today-nr (week-day-nr (t/now))
+        date (t/minus (t/now)
+                      (t/days (- today-nr k)))]
+    [k (assoc v :date (parse-date date))]
+  ))
+
 (defn week-dates []
-  (assoc-in day-map [(week-day (t/now))
-                      :date] (today)))
+  (map-kv day-map count-date))

 (defcomponent week-view [app owner]
               (render [this]
@@ -58,7 +65,7 @@

 (defcomponent app-view [app owner]
               (render [this]
-                      (print (format/show-formatters))
+                      (print (f/show-formatters))
                       (ot/div {:class "column-main"}
                               (dom/h1 nil (str (:text app) " " (:date app)))
                               (om/build week-view app)


A working impl

A working impl

--- src/angelic/search/implicit/dash_astar_simple.clj
+++ src/angelic/search/implicit/dash_astar_simple.clj
@@ -11,111 +11,44 @@
 ;; Take dash_astar_opt_simple and add back complexities from
 ;; dash_astar.clj.

-;; Do bounded suboptimal by propagating pessimistic into optimistic, versus
-;; other way?  Issue was that ???
-
-;; One issue is with propagation -- can't just take the min thing, need
-;; to construct a composite summary.
-;; But this doesn't rule out pess-side thing, since the same fn could be used
-;; on either side.
-
-;; Note: ignoring subsumption, communication only needs to happen at leaves.
-;; Problem can just be with aliasing.
+;; For now, just do single tree on (pess, opt) pairs. (or pure opt).
+;; Ideally, would have separate opt & pess trees as well for caching.
+
+;; Rationale for why we need this:
 ;; Suppose I have A, B.  Opt description of A has 3 branches of output.
 ;; Pess has single empty branch.  [-inf -inf] is valid description of this branch.
 ;;  i.e., doing things that way is effectively pessimistic about opt.

-;; Going other way, spse we have single vacuous opt branch.
-;; Suppose I have some vacuous pessimistic description.  I accumulate
-;; all upper bounds there,
-
-;; Right way to do it is: store the combined info in the opt-pess subsumption links.
-;; Or, just make nodes opt-pess pairs.  But then, we lose out on caching.
-;; Can just add caching on top -- but we may want separate opt-only tree still?
-;; Actually, pretty clear we still want separate trees, so knowledge transfers to
-;; new pess match with a given opt, for example.
-;; So, we actually want to build three trees for now.
-
-;; Are we guaranteed that every pess has an opt parent?  Even in presence
-;; of ouptut collecting, etc. ?
-;; Bridge means: exists some set of sequences that produce this opt, pess set pair.
-
 ;; Can try to do this as: separate trees, plus "bridge" superstructure built on
 ;; top.  Or, as scaffolding which controls construction of lower trees.
 ;; Scaffolding seems preferable.

-;; There's this logic that goes with names that's independent of everything.
-;; Drop SA
-;; Atomic = leaf
-;; Pair = sum of individuals.
-
-;; Then there's refinement logic --
-;; How to generate and propagate children.
-;; If we have all children,
-
-;; What if we think of this as just pair thing?  Conceptually, really simple.
-;; If this is the "ontological" thing, construting other trees after the fact
-;; should be easy .... . . . ..
-;; Start with that, just for fun.
-
+;; Also try to add real output collecting, since without it, any change
+;; in a recursive hierarchy can trigger an infinite loop.
 ;; NOTE: output collecting is not really good enough, since any change in
 ;; recursive hierarchy can trigger infinite loop.  Need hierarchical
 ;; collecting of some sort.

+;; Except this comes with problems of its own, loses current syntatic guarantees.
 ;; This really throws a wrengh in things, cause output things are no longer really
 ;; subproblems, shouldn't have tree summarizers (?), etc.
-;; Well, why not?
-
-
-;; Doing things this way, have to stay optimistic!  I.e., always publish, then decrease
-;; lcoally ...
-
-;; Note issue with subsumption at atomic: wrapped thing can become blocked, and we're stuck.
-
-;; Two obvious problems
-;; 1.  Once blocked propagates, solved can't beat it.
-;; 2.  Massive proliferation of subproblems with cycles -- probbly due to OC ??
-
-;; TODO: TODO TODO TODO why refining of outer children in refine-input ?
-
-;; TODO: lots of expnad-pairs in dm.
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Utilities      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;      Change Scheduling      ;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Trying to keep cached summaries up-to-date while simultaneously modifying the
-;; subproblem graph is quite difficult and potentially error-prone.
-;; This code allows the set of root subproblems with changed summaries to be recorded
-;; during evaluation and tree update, and then played back once the tree is fixed,
-;; decoupling the processes of tree change and summary updates.
-
-;; Only increase should ever be change of status. live->blocked or solved.
-;; This can only happen starting at expanded atomic leaf.
-;; It can happen automatically, with no explicit calls to summary.
-;; Iff status is increased with identical cost, propagate it all the way up
-;; until hit a +.
-;; Otherwise, it's a decrease.
-;; Increase never changes children.
-;; by simply following active links as long as cost i
+
+;; Solution to avoid huge syntactic/semantic mess of true hierarchical output
+;; collection, and infinite loops of flat output collection:
+;; - Only allow each to grow on a single step.  But, this is slow.
+;; Impelemented: start new OC after input refined.  Don't add to OC if > reward.
+
+;; TODO: RI of child not connected to child of RI.
+
+;; TODO: put back bounding
+;; (Currently asserting consistency in a sense, despite DM not having it.
+;;  Causes some errors, e.g., with rand-nth.)

 ;; TODO: summary/+ should take order into account !  live iff left live or left solved, right live, ..

-;; In fact, what does blocked even do for us ? ?  ??? ? ?? ? ?? ??
-;; Just forces us to work on left sometimes, that's all.
-;; It's not a real part of the summary.
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblems  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Subproblem has keys :name :input-set :output-set  :expand! :refine-input-fn
-;; and fns  publish-child! list-children subscribe-children!
-;;  subsuming-sps add-subsuming-sp! sp-ts

 (defn- make-subproblem
   "Make a subproblem with the given name and input-set.  If this is a wrapping
@@ -130,9 +63,8 @@
                :output-sets out-set
                :ts-atom (atom wrapped-ts)
                :child-channel    (channel/make-channel)
-               :inner-child-channel (channel/make-channel)
+               :constituent-channel (channel/make-channel)
                :subsuming-sp-set (IdentityHashMap.)
-               :child-output-map        (HashMap.)
                :refine-input-fn ri-fn
                :summarize-fn summary-fn)
     {:type ::Subproblem}))
@@ -168,41 +100,36 @@
 (defn- connect-ts! [p c]
   (sg/connect! p (sp-ts c)))

-;; TODO: issue is a general one with summary propagation and loops
-;; This was never really properly handled -- lazy was the way out.
-
-;; TODO TODO: this solution is not correct in presence of bounding ...
-;; Is there an easy way to fix it ? ??
-;; OC should treat parent as a child.

 (declare publish-child! refine-input)

-(defn refine-channel [channel refined-sp]
-  (channel/subscribe! channel #(publish-child! refined-sp (refine-input % (:input-sets refined-sp))))
+(defn refine-constituents! [parent-sp refined-sp]
+  (channel/subscribe!
+   (:constituent-channel parent-sp)
+   #(publish-child! refined-sp true (refine-input % (:input-sets refined-sp))))
   refined-sp)

-;; TODO: put out-sets back?
-
-(defn make-output-collector [config nm inp-sets out-sets]
+(defn make-output-collector [config k nm inp-sets out-sets]
   (make-subproblem
    config
-   [:OC nm #_ out-sets #_ (angelic.env.state/extract-context (second out-sets) (angelic.env.state/current-context (second out-sets)))] inp-sets out-sets nil
-   (fn ri-fn [oc ni]
+   [(gensym "oc") nm] inp-sets out-sets nil
+   (fn ri-fn [oc ni]
      (if (fs/eq-sets = ni inp-sets)
        oc
-       (refine-channel (:inner-child-channel oc) (make-output-collector config nm ni out-sets))))
+       (do (.remove ^HashMap (:oc-map config) k) ;; Prevent further modifications.
+           (refine-constituents! oc (make-output-collector config nil nm ni out-sets)))))
    (util/safe-get config :or-summarize)))

 (defn- publish-inner-child! [sp child-sp]
-  (connect-and-watch! sp child-sp (partial publish-child! sp))
-  (channel/publish! (:inner-child-channel sp) child-sp)
+  (connect-and-watch! sp child-sp (partial publish-child! sp false))
   (sg/status-increased! sp child-sp))

-(defn publish-child! [sp child-sp]
+(defn publish-child! [sp constituent? child-sp]
   (when child-sp
     (util/print-debug 2 "AC" sp child-sp)
     (util/assert-is (not (identical? sp child-sp)))
+    (when constituent? (channel/publish! (:constituent-channel sp) child-sp))
     (if (and (util/safe-get (:config sp) :collect?)
              (fs/eq-sets fs/=-state-sets (:output-sets sp) (:output-sets child-sp)))
       (publish-inner-child! sp child-sp)
@@ -210,18 +137,21 @@
             (sg/connect-subsumed! (sp-ts sp) (sp-ts child-sp))
             (sg/connect! (sp-ts sp) (sp-ts child-sp))
             (sg/status-increased! (sp-ts sp) (sp-ts child-sp)))
-          (if (util/safe-get (:config sp) :collect?)
-            (let [^HashMap com (:child-output-map sp)
-                  [oc new?] (or (when-let [oc  (.get com (:output-sets child-sp))]
+          (if (= :hierarchical (util/safe-get (:config sp) :collect?))
+            (let [^HashMap com (:oc-map (:config sp))
+                  k         [(:name sp) (System/identityHashCode sp) (:output-sets child-sp)]
+                  [oc new?] (or (when-let [oc  (.get com k)]
                                   [oc false])
                                 (let [oc (make-output-collector
-                                          (:config sp) (:name sp) (:input-sets sp) (:output-sets child-sp))]
-                                  (.put com (:output-sets child-sp) oc)
+                                          (:config sp) k (:name sp) (:input-sets sp) (:output-sets child-sp))]
+                                  (.put com k oc)
                                   [oc true]))]
-              (publish-inner-child! oc child-sp)
-              (when new? (channel/publish! (:child-channel sp) oc)))
-            (do (channel/publish! (:child-channel sp) child-sp)))))))
-;; TODO: how to refine-input of output collector ??
+              (if (or new? (<= (summary/max-reward (sg/summary child-sp)) (summary/max-reward (sg/summary oc))))
+                (do (publish-inner-child! oc child-sp)
+                    (when new?
+                      (channel/publish! (:child-channel sp) oc)))
+                (channel/publish! (:child-channel sp) child-sp)))
+            (channel/publish! (:child-channel sp) child-sp))))))

 (defn subsuming-sps        [s] (keys (:subsuming-sp-set s)))
@@ -246,7 +176,7 @@
                     (add-subsuming-sp! can-child can-subsuming-child))))))))))))

-;; Note: used to verify =-state-sets on entry to sa
+;; Note: we used to verify =-state-sets on entry to sa
 (defn refine-input    [s ni]
   (if (fs/eq-sets = (:input-sets s) ni)
     s
@@ -307,16 +237,6 @@

 ;; Initially we are evaluated but have no children. (Lazy can be simulated by hierarchy)
 ;; Expanding generates and publishes child subproblems, based on children of subsuming if possible.
-
-
-
-;; TODO: this assumes no inner child releases another inner child.
-;; Note: treatment of subsuming-sps was wrong in several ways ...
-;; Right thing is: if not expandable, start fresh.
-;; If expandable and expanded, do current thing (except, also wait on inner???)
-;; If expandable and not expanded, do current thing
-;; (problem is, inner bits may be hidden; may have non-correspondence).
-;; TODO: all-child-channel!

 (defmacro cache-under [dc ks body]
   `(if-let [^HashMap dc# ~dc]
@@ -340,16 +260,17 @@
              (fn summarize [s] (@summary-fn s)))
             :subsuming-sp subsuming-sp
             :expanded?-atom expanded?
+            :data [config fs inp-sets out-sets rewards status]
             :expand!-fn
             (fn expand! [s]
               (util/print-debug 1 "expand" nm)
               (reset! expanded? true)
               (reset! summary-fn (util/safe-get config :or-summarize))
               (if (and subsuming-sp @(:expanded?-atom subsuming-sp)) ;; TODO: don't require expanded?
-                (do (refine-channel (:child-channel subsuming-sp) s)
-                    (refine-channel (:inner-child-channel subsuming-sp) s))
+;                (do (refine-channel (:child-channel subsuming-sp) s))
+                (refine-constituents! subsuming-sp s)
                 (doseq [ref-name (refinement-names config fs inp-sets)]
-                  (publish-child! s (get-subproblem config ref-name inp-sets))))))))))))
+                  (publish-child! s true (get-subproblem config ref-name inp-sets))))))))))))

 (defmethod get-subproblem :Atomic [config [_ fs] inp-sets]
   (make-atomic-subproblem config fs inp-sets nil))
@@ -391,7 +312,7 @@
 		      (sg/disconnect! ss (sp-ts right-sp))
 		      (subscribe-children! left-sp (fn [c] (def *bad* [ss c]) (assert (not "S + C"))))
 		      (connect-and-watch! ss right-sp
-                        #(publish-child! (util/safe-singleton (sg/parent-nodes ss))
+                        #(publish-child! (util/safe-singleton (sg/parent-nodes ss)) false
                                          (make-pair-subproblem config left-sp %))))
 	  ss          (assoc (sg/make-simple-cached-node)
                         :summarize-fn
@@ -411,13 +332,12 @@
                           (go-right! ss)))
 	  ret (make-subproblem config nm (:input-sets left-sp) (:output-sets right-sp) nil
 		(fn ri-fn [s ni]
-		  (refine-channel (:child-channel s)
-                   (make-half-pair-subproblem config (refine-input left-sp ni) #(refine-input right-sp %))))
+                  (make-half-pair-subproblem config (refine-input left-sp ni) #(refine-input right-sp %)))
                 (util/safe-get config :or-summarize))]
       (sg/connect! ret ss)
       (connect-ts! ss right-sp)
       (connect-and-watch! ss left-sp
-	#(publish-child! ret (make-pair-subproblem config % (refine-input right-sp (:output-sets %)))))
+	#(publish-child! ret false (make-pair-subproblem config % (refine-input right-sp (:output-sets %)))))
       ret)))

 (defn make-half-pair-subproblem [config left-sp right-fn]
@@ -429,13 +349,11 @@
    (get-subproblem config left-name inp-sets)
    #(get-subproblem config right-name %)))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    SA Wrapper     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-
-
 ;; Note: subsumed subproblems can have different irrelevant vars
-;; Also note: new input can have subset of variables of old. (=-state-sets does ntthis now).
+;; Also note: new input can have subset of variables of old.
 (defn- make-state-abstracted-subproblem [config fs inner-sp inp-sets]
   (when inner-sp
     (let [ret (make-subproblem
@@ -447,13 +365,11 @@
                  (if (fs/eq-sets fs/=-state-sets ni inp-sets) sp
                      (let [log-ni (fs/map-sets fs/get-logger fs ni)
                            ri     (refine-input inner-sp log-ni)]
-                       (refine-channel (:child-channel sp)
-                         (make-state-abstracted-subproblem config fs ri ni)))))
+                       (make-state-abstracted-subproblem config fs ri ni))))
                (util/safe-get config :or-summarize))]
       (connect-and-watch! ret inner-sp
-       #(publish-child! ret (make-state-abstracted-subproblem config fs % inp-sets)))
+       #(publish-child! ret false (make-state-abstracted-subproblem config fs % inp-sets)))
       ret)))
-

 (defmethod get-subproblem :SA [config [_ inner-n :as n] inp-sets]
   (let [fs (atomic-name-fs inner-n)]
@@ -463,21 +379,18 @@
       inp-sets)))

-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Planning ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare *root*)
-
-(defn- expand! [s]  ((:expand!-fn s) s))

 (defn extract-action [sp]
   (let [fs (second (:name sp)) n (fs/fs-name fs)]
     (when-not (= (first n) :noop) fs)))

 (defn implicit-dash-a* [henv & {:as opts}]
-  (let [defaults {:collect?               true  ; Don't publish child subproblems with identical outputs?
+  (let [defaults {:collect?               :flat ; Collect children with = output? nil, :flat, or :hierarchical
                   :decompose?             true  ; Decomposition.  Requires :collect?
                   :abstract?              true  ; State Abstraction.  Requires :d
                   :choice-fn              last  ; Choose a child node to evaluate
@@ -495,12 +408,17 @@
                               {:or-summarize sg/or-summary
                                :make-summary (fn [[p-r o-r] stat src]
                                                (summary/make-simple-summary
-                                                (min (sg/get-bound src) o-r) stat src))})))
+                                                (min (sg/get-bound src) o-r) stat src))}))
+                      (assoc :oc-map (HashMap.)))
         [init fs] (fs/make-init-pair henv)
-        root      (sp-ts (make-atomic-subproblem config fs [(when (:weight opts) init) init] nil))]
+        root      (sp-ts (make-atomic-subproblem config fs [(when (:weight opts) init) init] nil))
+        expand!   (if (= (:collect? config) :hierarchical)
+                    (fn [s] ((:expand!-fn s) s) #_ (.clear ^HashMap (:oc-map config)))
+                    (fn [s] ((:expand!-fn s) s)))]
     (let [ks (util/keyset defaults)] (doseq [k (keys opts)] (util/assert-is (ks k))))
     (when (:abstract? config)  (assert (:decompose? config)))
     (when (:decompose? config)  (assert (:collect? config)))
+    (assert (contains? #{nil :flat :hierarchical} (:collect? config)))
     (def *root* root)
     (case (:search-strategy config)
           :ldfs (do (sg/ldfs! root (:choice-fn config) Double/NEGATIVE_INFINITY expand!)
@@ -521,11 +439,11 @@

 ;; (do (use 'clojure.test) (use 'angelic.test.search.implicit.dash-astar-opt-simple) (run-tests 'angelic.test.search.implicit.dash-astar-opt-simple))

-;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 0 (let [h (make-nav-switch-hierarchy (make-random-nav-switch-env 20 4 0) true)]  (time (println (run-counted #(identity (implicit-dash-a* h :gather true :d true :s :eager :dir :right))) @sg/*summary-count*)))))
-
-;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 0 (let [h (make-discrete-manipulation-hierarchy  (make-random-hard-discrete-manipulation-env 3 3))]   (time (println (run-counted #(identity (implicit-dash-a*-opt h :gather true :d true :s :eager :dir :right))) @sg/*summary-count*)))))
-
-;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 1 (let [h (make-discrete-manipulation-hierarchy  (make-discrete-manipulation-env-regions [4 4] [1 1] [ [ [2 2] [3 3] ] ] [ [:a [2 2] [ [3 3] [3 3 ] ] ] ] 1 2 2 1))]   (time (println (run-counted #(identity (implicit-dash-a* h :gather true :d true :s :eager :dir :right))) @sg/*summary-count*)))))
+;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 0 (let [h (make-nav-switch-hierarchy (make-random-nav-switch-env 20 4 0) true)]  (time (println (run-counted #(identity (implicit-dash-a* h))) @sg/*summary-count*)))))
+
+;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 0 (let [h (make-discrete-manipulation-hierarchy  (make-random-hard-discrete-manipulation-env 3 3))]   (time (println (run-counted #(identity (implicit-dash-a*-opt h))) @sg/*summary-count*)))))
+
+;; (dotimes [_ 1] (reset! sg/*summary-count* 0) (debug 1 (let [h (make-discrete-manipulation-hierarchy  (make-discrete-manipulation-env-regions [4 4] [1 1] [ [ [2 2] [3 3] ] ] [ [:a [2 2] [ [3 3] [3 3 ] ] ] ] 1 2 2 1))]   (time (println (run-counted #(identity (implicit-dash-a* h))) @sg/*summary-count*)))))


Notes

Notes

--- src/angelic/search/implicit/dash_astar_simple.clj
+++ src/angelic/search/implicit/dash_astar_simple.clj
@@ -7,6 +7,10 @@
   (:import [java.util HashMap ArrayList IdentityHashMap]))

 (set! *warn-on-reflection* true)
+
+;; TODO: before publish:
+FIX refine-input for oc subproblem to solution in thesis
+FIX no publications from solved.

 ;; Take dash_astar_opt_simple and add back complexities from
 ;; dash_astar.clj.
@@ -114,6 +118,7 @@

 (declare publish-child! refine-input)

+;; TODO: this can cycle, if oc includes itself?!
 (defn refine-constituents! [parent-sp refined-sp]
   (channel/subscribe!
    (:constituent-channel parent-sp)


Allowing running of sub-ns for all tests.

--- dev/user.clj
+++ dev/user.clj
@@ -10,9 +10,27 @@

 (alter-var-root #'*out* (constantly *out*))

-(def system nil)
+(defn all-tests
+  "Utility function for running all tests in the project namespace."
+  ([] (all-tests ""))
+  ([sub-ns] (clojure.test/run-all-tests (re-pattern (str "ahnentafel" sub-ns ".*")))))

-(defn all-tests [] (clojure.test/run-all-tests #"ahnentafel.*"))
+(def system
+  "Var to hold instance of the system"
+  nil)
+
+(defn- stop-server [system]
+  (when-let [server (:server system)]
+    (.stop server)
+    (dissoc system :server)))
+
+(defn- start-server [system port]
+  (let [server (run-jetty (:handler system) {:port port :join? false})]
+    (assoc system :server server)))
+
+(defn init []
+  "Construct the current environment"
+  (alter-var-root #'system (constantly (system/system))))

 (defn stop []
   "Shut down the system, if running."


Add command to start midje autotest

Add command to start midje autotest

--- dev/user.clj
+++ dev/user.clj
@@ -4,16 +4,17 @@
             [clojure.tools.logging :refer [info error] :as log]
             [com.stuartsierra.component :as component]
             [clojure.tools.namespace.repl :refer [refresh refresh-all]]
+            [midje.repl :as midje]
             ))

 (def system nil)

 (defn init
   "Constructs the current development system."
-  []
+  [& [config-file]]
   (alter-var-root
    #'system
-   (constantly (ruuvi.system/create-system "dev/config.edn"))))
+   (constantly (ruuvi.system/create-system (or config-file "dev/config.edn") ))))

 (defn start
   "Starts the current development system."
@@ -38,10 +39,18 @@
   (init)
   (start))

-(defn reset []
+(defn reset
+  "Stop any running components, reload all files and restart components."
+  []
   (stop)
   (info "Resetting...")
   (refresh :after 'user/go)
   (info "Reset complete")
   :reset-complete)

+(defn start-autotest
+  "Start auto testing for test/ruuvi. When a file is changed, dependant midje tests are executed."
+  []
+  (midje/autotest :dirs "test/ruuvi")
+  )
+


Change ES endpoint to point to aliased docker hostname

--- dev/user.clj
+++ dev/user.clj
@@ -21,7 +21,7 @@
   (alter-var-root #'system
     (constantly (sys/system {:jetty {:port 9400
                                      :join? false}
-                             :elasticsearch {:endpoint "http://localhost:9200"}}))))
+                             :elasticsearch {:endpoint "http://docker:9200"}}))))

 (defn start
   "Starts the current development system."


use tools.namespace to check warnings

use tools.namespace to check warnings

--- dev/user.clj
+++ dev/user.clj
@@ -1,5 +1,5 @@
 (comment

-  (with-warnings (require 'insn.clojure-test :reload-all))
+  (with-warnings (refresh))

   )


pass Java core types directly in bake (so we can pass things like Sockets and InputStreams to the project classloader)

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -9,7 +9,7 @@
 (def global-root (.getPath (File. (System/getProperty "user.home") ".cake")))

 (defn classpath []
-  (map #(str "file:" (.getPath %) (if (.isDirectory %) "/" " "))
+  (map #(str "file:" (.getPath %) (if (.isDirectory %) "/" ""))
        (concat (map file [(System/getProperty "bake.path")
                           "src/" "src/clj/" "classes/" "resources/" "dev/" "test/" "test/classes/"])
                (fileset-seq {:dir "lib"     :includes "*"})
@@ -40,32 +40,48 @@
        (conj v form)))
    [] bindings))

+(defn- separate-bindings
+  "Separate bindings based on whether their value is a Java core type or not, because Java types
+   should be passed directly to the project classloader, while other values should be serialized."
+  [bindings]
+  (reduce (fn [b [sym val]]
+            (if (.getClassLoader (class val))
+              (update b 0 conj  sym val)
+              (update b 1 assoc sym val)))
+          [[] {}]
+          (partition 2 bindings)))
+
+(defn- shared-bindings []
+  `[~'cake/*current-task* '~*current-task*
+    ~'cake/*project*      '~*project*
+    ~'cake/*context*      '~*context*
+    ~'cake/*script*       '~*script*
+    ~'cake/*opts*         '~*opts*
+    ~'cake/*pwd*          '~*pwd*
+    ~'cake/*env*          '~*env*
+    ~'cake/*vars*         '~*vars*])
+
 (defn project-eval [ns-forms bindings body]
-  (let [form
-        `(do (ns ~(symbol (str "bake.task." (name *current-task*)))
-               (:use ~'cake)
-               ~@ns-forms)
-             (let ~(quote-if odd? bindings)
-               ~@body))]
-    (eval-in
-     classloader
-     `(fn [ins# outs#]
-        (clojure.main/with-bindings
-          (bake.io/with-streams ins# outs#
-            (binding [~'cake/*current-task* '~*current-task*
-                      ~'cake/*project*      '~*project*
-                      ~'cake/*context*      '~*context*
-                      ~'cake/*script*       '~*script*
-                      ~'cake/*opts*         '~*opts*
-                      ~'cake/*pwd*          '~*pwd*
-                      ~'cake/*env*          '~*env*
-                      ~'cake/*vars*         '~*vars*]
-              (eval '~form)))))
-     *ins* *outs*)))
+  (let [[let-bindings object-bindings] (separate-bindings bindings)
+        temp-ns (gensym "bake")
+        form
+        `(do (binding [*ns* nil]
+               (ns ~temp-ns
+                 (:use ~'cake)
+                 ~@ns-forms))
+             (fn [ins# outs# ~@(keys object-bindings)]
+               (clojure.main/with-bindings
+                 (bake.io/with-streams ins# outs#
+                   (binding ~(shared-bindings)
+                     (let ~(quote-if odd? let-bindings)
+                       (in-ns '~temp-ns)
+                       (try ~@body
+                            (finally (remove-ns '~temp-ns)))))))))]
+    (apply eval-in classloader form *ins* *outs* (vals object-bindings))))

 (defmacro bake
   "Execute code in a your project classloader. Bindings allow passing state to the project
-   classloader. Namespace forms like use and require must be specified before bindings."
+   classloader. Namespace forms like use and require must be specified before bindings."
   {:arglists '([ns-forms* bindings body*])}
   [& forms]
   (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]


Fix broken examples styleguide link

Fix broken examples styleguide link

--- src/clj/clojuredocs/pages/intro.clj
+++ src/clj/clojuredocs/pages/intro.clj
@@ -190,7 +190,7 @@
         [:p "Sharing your knowledge with fellow Clojurists is easy:"]
         [:p
          "First, take a look at the "
-         [:a {:href "/examples-style-guide"} "examples style guide"]
+         [:a {:href "/examples-styleguide"} "examples style guide"]
          ", and then add an example for your favorite var (or pick one from the list)."]
         [:p "In addition to examples, you also have the ability to add 'see also' references between vars."]]]]]]])


cleaner and more composable integration

cleaner and more composable integration

--- src/clj/com/rpl/specter/zipper.cljx
+++ src/clj/com/rpl/specter/zipper.cljx
@@ -7,9 +7,17 @@
     [com.rpl specter])
   (:require [clojure [zip :as zip]]))

-(def VECTOR-ZIP (view zip/vector-zip))
-(def SEQ-ZIP (view zip/seq-zip))
-(def XML-ZIP (view zip/xml-zip))
+(defpath zipper [constructor]
+  (select* [this structure next-fn]
+    (next-fn (constructor structure)))
+  (transform* [this structure next-fn]
+    (zip/root (next-fn (constructor structure)))
+    ))
+
+(def VECTOR-ZIP (zipper zip/vector-zip))
+(def SEQ-ZIP (zipper zip/seq-zip))
+(def XML-ZIP (zipper zip/xml-zip))
+
 (def NEXT (view zip/next))
 (def RIGHT (view zip/right))
 (def RIGHTMOST (view zip/rightmost))
@@ -17,23 +25,11 @@
 (def DOWN (view zip/down))
 (def LEFTMOST (view zip/leftmost))
 (def UP (view zip/up))
-(def ROOT (view zip/root))

 (defpath NODE []
   (select* [this structure next-fn]
     (next-fn (zip/node structure))
     )
   (transform* [this structure next-fn]
-    (zip/root (zip/edit structure next-fn))
+    (zip/edit structure next-fn)
     ))
-
-(defn edited [path update-fn]
-  (fixed-pathed-path [late path]
-    (select* [this structure next-fn]
-      (next-fn
-        (zip/edit structure
-                  #(compiled-transform late update-fn %))))
-    (transform* [this structure next-fn]
-      (next-fn
-        (zip/edit structure
-                  #(compiled-transform late update-fn %))))))


Properly handle camelcase options

Properly handle camelcase options

--- src/cljs/asciinema_player/core.cljs
+++ src/cljs/asciinema_player/core.cljs
@@ -5,6 +5,7 @@
             [asciinema-player.util :as util]
             [cljs.core.async :refer [chan >! <! timeout close!]]
             [clojure.walk :as walk]
+            [clojure.set :refer [rename-keys]]
             [ajax.core :refer [GET]])
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

@@ -219,5 +220,7 @@
     (create-player-with-state state dom-node)))

 (defn ^:export CreatePlayer [dom-node width height frames-url duration options]
-  (let [options (js->clj options :keywordize-keys true)]
+  (let [options (-> options
+                    (js->clj :keywordize-keys true)
+                    (rename-keys {:autoPlay :auto-play :fontSize :font-size}))]
     (create-player dom-node width height frames-url duration options)))


Create a working repl client using a CrossPageChannel (XPC).

--- src/cljs/clojure/browser/repl2.cljs
+++ src/cljs/clojure/browser/repl2.cljs
@@ -8,59 +8,97 @@

 (ns clojure.browser.repl2
   (:require [clojure.browser.net   :as net]
-            [clojure.browser.event :as event]))
+            [clojure.browser.event :as event]
+            [goog.json :as gjson]))
+
+;; Notes
+;; =====
+;;
+;; Using keywords for the service names does not work in Chrome or
+;; FireFox. This may be an encoding issue. Set the content-encoding to
+;; UTF-8 for the inner peer page.
+;;
+;; --

 (defn log-obj [obj]
   (.log js/console obj))

-;; See my notes inline. Delete them whenever you want.
+;; Outer/Parent Peer
+;; =================
+;;
+;; The code in this section will be run in the parent page which
+;; exists in the application's domain. This is where code will be
+;; evaluated.

-(def result-state (atom nil))
+(def parent-channel (atom nil))

-;; Can't send a new post while in the middle of another connection. I
-;; changed this so that instead of sending the result back we store the
-;; result in an atom and return. The result will be sent when the connection
-;; is ready.
-
-(defn process-block
-  "Process a single block of JavaScript received from the server"
-  [connection block]
+(defn evaluate-javascript
+  "Given a block of JavaScript, evaluate it and transmit the result to
+  the inner peer of the cross domain channel."
+  [block]
   (log-obj (str "evaluating: " block))
   (let [result (try (js* "eval(~{block})")
                     (catch js/Error e (pr-str e)))]
     (log-obj (str "result: " result))
-    (reset! result-state result)))
+    (net/transmit @parent-channel "return-value" result)))

-;; We are long polling so this cannot time out.
+(defn create-cross-domain-channel
+  "Create a cross domain channel with an iframe which can communicate
+  with the REPL server."
+  [url]
+  (let [chnl (doto (net/xpc-connection {:peer_uri (str url "/repl")})
+               (net/register-service "evaluate-javascript" evaluate-javascript)
+               (net/connect document.body
+                            (fn [] (log-obj "Parent channel connected."))
+                            (fn [iframe] (set! iframe.style.display "none"))))]
+    (reset! parent-channel chnl)))
+
+(defn connect
+  "Connect to a ClojureScript REPL server located at the passed url."
+  [url]
+  (goog.events/listen js/window "load" #(create-cross-domain-channel url)))
+
+;; Inner peer
+;; =========
+;;
+;; The code in this section will be run in the child iframe and can
+;; communicate with REPL server.
+
+(def state (atom {:connection nil :url nil}))
+
+(def child-channel (atom nil))

 (defn transmit-post [connection url data]
   (net/transmit connection url "POST" data nil 0))

-;; on-ready is called when the connection is ready to send.
-
-(defn on-ready [connection url]
-  (log-obj "connection is ready")
-  (let [result @result-state]
-    (log-obj (str "sending: " result))
-    (transmit-post connection url result)))
-
-(defn start-repl
+(defn start-repl-connection
   "Start the REPL loop"
   [url]
-  (let [connection (net/xhr-connection url)]
+  (let [connection (net/xhr-connection)]
+    (reset! state {:connection connection :url url})
     (event/listen connection
                   :success
                   (fn [e]
-                    (process-block connection
-                                   (.getResponseText e/currentTarget ()))))
-    (event/listen connection
-                  :ready
-                  (fn [e]
-                    (on-ready connection url)))
+                    (net/transmit @child-channel
+                                  "evaluate-javascript"
+                                  (.getResponseText e/currentTarget ()))))
     ;; The server is expecting to see the string "ready" for the
     ;; initial connection.
     (transmit-post connection url "ready")))

-;; The client will need to monitor the conenction and re-open it if it
-;; has been closed. There are all kinds of error states that we need
-;; to deal with.
+(defn return-value [val]
+  (log-obj (str "sending: " val))
+  (transmit-post (:connection @state) (:url @state) val))
+
+;; I can't get this to work using the clojure.browser.net api.
+
+(defn inner-peer-channel
+  "This function will be called from a script in the child iframe."
+  [repl-url]
+  (let [cfg (gjson/parse (.getParameterValue (goog.Uri. window.location.href) "xpc"))
+        chnl (doto (goog.net.xpc.CrossPageChannel. cfg)
+               (net/register-service "return-value" return-value)
+               (.connect #(log-obj "Child channel connected.")))]
+    (do (reset! child-channel chnl)
+        (js/setTimeout #(start-repl-connection repl-url) 500))))
+


Addeed rel='external' to link

Addeed rel='external' to link

--- src/cljs/ikea_clojure_cup/core.cljs
+++ src/cljs/ikea_clojure_cup/core.cljs
@@ -67,8 +67,8 @@
    [:div#footer.container
     "IFLOGS is not endorsed or affiliated with IKEA."
     [:br]
-    [:sup "© "]
-    [:a {:href "http://www.icm-consulting.com.au/"} "ICM Consulting Pty Ltd B.V 2010"]
+    [:sup "©"]
+    [:a {:href "http://www.icm-consulting.com.au/" :target "_blank" :rel "external"} "ICM Consulting Pty Ltd B.V 2010"]
     [:div.serial-text.pull-right.hidden-xs "AA-498638-1"]
     [:div.serial-number.pull-right.hidden-xs (first (shuffle (range 10000 20000)))]]])


Revise some documentation

Revise some documentation

--- src/main/clojure/cascade/internal/viewbuilder.clj
+++ src/main/clojure/cascade/internal/viewbuilder.clj
@@ -19,13 +19,13 @@

 (defn convert-render-result
   [any]
-  "Checks the result of invoking a rending function or closure, to ensure that only
+  "Checks the result of invoking a rendering function (or evaluating a symbol), to ensure that only
    acceptible values are returned."
   (cond
     ; A map is assumed to be a DOM node
     (map? any) (if (:cascade-dom-node ^any) any (fail "Not a DOM node: %s" (ppstring any)))
     (string? any) (text-node any)
-    (number? any) (text-node (str any))
+    (number? any) (raw-node (str any))
     true (throw (RuntimeException.
       (format "A rendering function returned %s. Rendering functions should return nil, a string, a seq of DOM nodes, or a single DOM node."
     (pr-str any))))))
@@ -54,7 +54,6 @@

   (def parse-name
     ; An attribute or element name is either a keyword or a form that yields a keyword.
-    ; TODO: support for qualified names ([:prefix :name]).
     (match-first match-keyword))

   (def parse-body
@@ -69,7 +68,7 @@

   ; Accept a single form that will act as a renderer, returning a render
   ; result, which will be combined with other render results via the
-  ; parse-forms parser.
+  ; parse-forms parser. This form may be a symbol or a list (a function call).
   (def parse-form
        (domonad [form match-form]
          form))
@@ -79,6 +78,12 @@

   (def parse-forms
     (domonad [forms (none-or-more parse-single-form)]
+      ; We really want to evaluate the forms top to bottom. Without the lazy sequence,
+      ; evaluation would be bottom to top. It would not matter, except for the
+      ; issue of JavaScript library and stylesheet injection, which implies as specific
+      ; ordering. Perhaps there's a solution related to monads, as a way of dealing with
+      ; the ordering issues without the expense of lazy evaluation (and forcing the entire
+      ; DOM tree to be realized).
       `(lazy-seq (combine ~@forms))))
 ) ; with-monad parser-m


Port defresolver from Pathom 3

Port defresolver from Pathom 3

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -1538,26 +1538,172 @@
   (cond-> (merge {::sym sym ::resolve resolve} options)
     transform transform))

+; region defresolver
+
 #?(:clj
-   (defmacro defresolver [& args]
-     (let [{:keys [sym docstring arglist config body]}
-           (s/conform (s/cat
-                        :sym simple-symbol?
-                        :docstring (s/? string?)
-                        :arglist (s/coll-of any? :kind vector? :count 2)
-                        :config any?
-                        :body (s/* any?))
-             args)
-           fqsym  (if (namespace sym)
-                    sym
-                    (symbol (name (ns-name *ns*)) (name sym)))
-           defdoc (cond-> [] docstring (conj docstring))]
-       `(def ~sym
+   (do
+     (s/def ::simple-keys-binding
+       (s/tuple #{:keys} (s/coll-of ident? :kind vector?)))
+
+     (s/def ::qualified-keys-binding
+       (s/tuple
+         (s/and qualified-keyword? #(= (name %) "keys"))
+         (s/coll-of simple-symbol? :kind vector?)))
+
+     (s/def ::as-binding
+       (s/tuple #{:as} simple-symbol?))
+
+     (s/def ::map-destructure
+       (s/every
+         (s/or :simple-keys-binding ::simple-keys-binding
+               :qualified-keys-bindings ::qualified-keys-binding
+               :as ::as-binding)
+         :kind map?))
+
+     (s/def ::operation-argument
+       (s/or :sym symbol?
+             :map ::map-destructure))
+
+     (s/def ::operation-args
+       (s/coll-of ::operation-argument :kind vector? :min-count 0 :max-count 2))
+
+     (s/def ::defresolver-args
+       (s/and
+         (s/cat :name simple-symbol?
+                :docstring (s/? string?)
+                :arglist ::operation-args
+                :options (s/? map?)
+                :body (s/+ any?))
+         (fn must-have-output-visible-map-or-options [{:keys [body options]}]
+           (or (map? (last body)) options)))))
+
+   :cljs
+   (s/def ::defresolver-args any?))
+
+(defn as-entry? [x] (= :as (first x)))
+
+(defn extract-destructure-map-keys-as-keywords [m]
+  (into #{}
+        (comp
+          (remove as-entry?)
+          (mapcat
+            (fn [[k vals]]
+              (map #(keyword (or (namespace %)
+                                 (namespace k)) (name %)) vals))))
+        m))
+
+(defn params->resolver-options [{:keys [arglist options body docstring]}]
+  (let [[input-type input-arg] (last arglist)
+        last-expr (last body)]
+    (cond-> options
+      (and (map? last-expr) (not (::output options)))
+      (assoc ::output (data->shape last-expr))
+
+      docstring
+      (assoc ::docstring docstring)
+
+      (and (= :map input-type)
+           (not (::input options)))
+      (assoc ::input (extract-destructure-map-keys-as-keywords input-arg)))))
+
+(defn normalize-arglist
+  "Ensures arglist contains two elements."
+  [arglist]
+  (loop [arglist arglist]
+    (if (< (count arglist) 2)
+      (recur (into '[[:sym _]] arglist))
+      arglist)))
+
+(defn full-symbol [sym ns]
+  (if (namespace sym)
+    sym
+    (symbol ns (name sym))))
+
+#?(:clj
+   (defmacro defresolver
+     "Defines a new Pathom resolver.
+
+     Resolvers are the central abstraction around Pathom, a resolver is a function
+     that contains some annotated information and follow a few rules:
+
+     1. The resolver input must be a map, so the input information is labelled.
+     2. A resolver must return a map, so the output information is labelled.
+     3. A resolver also receives a separated map containing the environment information.
+
+     Here are some examples of how you can use the defresolver syntax to define resolvers:
+
+     The verbose example:
+
+         (pco/defresolver song-by-id [env {:acme.song/keys [id]}]
+           {::pco/input     #{:acme.song/id}
+            ::pco/output    [:acme.song/title :acme.song/duration :acme.song/tone]
+            ::pco/params    []
+            ::pco/transform identity}
+           (fetch-song env id))
+
+     The previous example demonstrates the usage of the most common options in defresolver.
+
+     But we don't need to write all of that, for example, instead of manually saying
+     the ::pco/input, we can let the defresolver infer it from the param destructuring, so
+     the following code works the same (::pco/params and ::pco/transform also removed, since
+     they were no-ops in this example):
+
+         (pco/defresolver song-by-id [env {:acme.song/keys [id]}]
+           {::pco/output [:acme.song/title :acme.song/duration :acme.song/tone]}
+           (fetch-song env id))
+
+     This makes for a cleaner write, now lets use this format and write a new example
+     resolver:
+
+         (pco/defresolver full-name [env {:acme.user/keys [first-name last-name]}]
+           {::pco/output [:acme.user/full-name]}
+           {:acme.user/full-name (str first-name \" \" last-name)})
+
+     The first thing we see is that we don't use env, so we can omit it.
+
+         (pco/defresolver full-name [{:acme.user/keys [first-name last-name]}]
+           {::pco/output [:acme.user/full-name]}
+           {:acme.user/full-name (str first-name \" \" last-name)})
+
+     Also, when the last expression of the defresolver is a map, it will infer the output
+     shape from it:
+
+         (pco/defresolver full-name [{:acme.user/keys [first-name last-name]}]
+           {:acme.user/full-name (str first-name \" \" last-name)})
+
+     You can always override the implicit input and output by setting on the configuration
+     map.
+
+     Standard options:
+
+       ::pco/output - description of resolver output, in EQL format
+       ::pco/input - description of resolver input, as a set
+       ::pco/params - description of resolver parameters, in EQL format
+       ::pco/transform - a function to transform the resolver configuration before instantiating the resolver
+
+     Note that any other option that you send to the resolver config will be stored in the
+     index and can be read from it at any time.
+     "
+     {:arglists '([name docstring? arglist options? & body])}
+     [& args]
+     (let [{:keys [name arglist body docstring] :as params}
+           (-> (s/conform ::defresolver-args args)
+               (update :arglist normalize-arglist))
+
+           arglist' (s/unform ::operation-args arglist)
+           fqsym    (full-symbol name (str *ns*))
+           defdoc   (cond-> [] docstring (conj docstring))]
+       `(def ~name
           ~@defdoc
-          (resolver '~fqsym
-            (cond-> ~config
-              ~docstring (assoc ::docstring ~docstring))
-            (fn ~sym ~arglist ~@body))))))
+          (resolver '~fqsym ~(params->resolver-options params)
+            (fn ~name ~arglist'
+              ~@body))))))
+
+(s/fdef defresolver
+  :args ::defresolver-args
+  :ret any?)
+
+; endregion

 (defn attr-alias-name [from to]
   (symbol (str (munge (subs (str from) 1)) "->" (munge (subs (str to) 1)))))


WIP on a new data representation

WIP on a new data representation

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -3,309 +3,71 @@
   up examples, symbols, namespaces and artifacts as values without
   regard to the implementation of the datastore. Ports of Grimoire to
   different datastores should only need to tweak this namespace."
-
+  (:refer-clojure :exclude [isa?])
   (:require [grimoire.util :as util]
+            [grimoire.types :refer :all]
             [clojure.java.io :as io]
             [clojure.string :as string]
             [clj-semver.core :as semver]))

-(defmacro maybe-file [& forms]
-  `(let [f (apply io/file forms)]
-     (when (.exists f) f)))
+(defn isa? [t o]
+  (= (:type o) t))

-(def type-file  ":type.txt")
-(def docs-file  ":docs.txt")
-(def notes-file ":notes.txt")
-(def url-file   ":url.txt")
-(def added-file ":added.txt")
+(defn ->T [t parent name]
+  {:type   t
+   :parent parent
+   :name   name
+   :uri    (str (:uri parent)
+                (when (:uri parent) "/")
+                name)})

-;; Group stuff
-;;--------------------------------------------------------------------
-(defrecord GroupHandle [handle name])
-
-(defn list-groups
-  "λ [config] → (Seq GroupHandle)
-
-  Provides an interface for enumeriating all known Maven groups as group handle
-  objects which can be used to enumerate artifacts or for documentation. Returns
-  an unordered sequence of GroupHandles."
-
-  [{{docs :docs} :datastore}]
-  {:pre [(or (instance? java.io.File docs)
-             (instance? java.lang.String docs))]}
-  (let [f (io/file docs)]
-    (when (and (.exists f)
-               (.isDirectory f))
-      (for [f' (.listFiles f)
-            :when (.isDirectory f')
-            :when (= "group" (slurp (io/file f' type-file)))]
-        (->GroupHandle f' (. f' (getName)))))))
-
-;; Artifact stuff
-;;--------------------------------------------------------------------
-(defrecord ArtifactHandle [handle parent name])
-
-(defn list-artifacts
-  "λ [config ← Map, group ← GroupHandle] → (Seq ArtifactHandle)
-
-  Provides an interface for enumerating all the known artifacts in a given
-  Group. Returns an unordered sequence of ArtifactHandles."
-
-  [config group]
-  {:pre [(instance? GroupHandle group)]}
-  (when-let [f (:handle group)]
-    (for [f'    (.listFiles f)
-          :when (.isDirectory f')
-          :when (= "artifact" (slurp (io/file f' type-file)))]
-      (->ArtifactHandle f' group (. f' (getName))))))
-
-;; Version stuff
-;;--------------------------------------------------------------------
-(defrecord VersionHandle [handle parent name])
-
-(defn list-versions
-  "λ [config ← Map, artifact ← ArtifactHandle] → (Seq VersionHandle)
-
-  Provides an interface for enumerating all the known versions if a given
-  Artifact. Returns a sequence of VersionHandles."
-
-  [config artifact]
-  {:pre [(instance? ArtifactHandle artifact)]}
-  (when-let [f (:handle artifact)]
-    (for [f'    (.listFiles f)
-          :when (.isDirectory f')]
-      (->VersionHandle f' artifact (. f' (getName))))))
-
-(defn- list-type-filtered [type ctor config parent]
-  (when-let [f (:handle parent)]
-    (for [f'    (.listFiles f)
-          :when (.isDirectory f')
-          :let  [typef (io/file f' type-file)]
-          :when (.exists typef)
-          :when (= type (slurp typef))]
-      (ctor f' parent (. f' (getName))))))
-
-;; Namespace stuff
-;;--------------------------------------------------------------------
-(defrecord NamespaceHandle [handle parent name])
-
-(defn list-namespaces
-  "λ [config ← Map, version ← VersionHandle] → (Seq NamespaceHandle)
-
-  Provides a mechanism for enumerating all the known namespaces in a
-  given Version. Returns an unordered sequence of
-  VersionHandles."
-
-  [config version]
-  {:pre [(instance? VersionHandle version)]}
-  (list-type-filtered "ns" ->NamespaceHandle config version))
-
-;; Package stuff
-;;--------------------------------------------------------------------
-(defrecord PackageHandle [handle parent name])
-
-(defn list-packages
-  "λ [config ← Map, version ← VersionHandle] → (Seq PackageHandle)
-
-  Provides a mechanism for enumerating all of the Java packages in a given
-  Version entity. Returns an unordered sequence of PackageHandles."
-
-  [config version]
-  {:pre [(instance? VersionHandle version)]}
-  (list-type-filtered "package" ->PackageHandle config version))
-
-;; Def stuff
-;;--------------------------------------------------------------------
-;; Type one of #{:symbol :var :fn :macro :class}
-(defrecord DefHandle [handle parent name type])
-
-(defn- list-ns-contents [ctor type config parent]
-  (when-let [f (:handle parent)]
-    (for [f'    (.listFiles f)
-          :when (.isDirectory f')
-          :let  [typef (io/file f' type-file)]
-          :when (.exists typef)
-          :when (= type (slurp typef))]
-      (ctor f' parent (. f' (getName)) type))))
-
-(defn list-vars
-  "λ [config ← Map, namespace ← NamespaceHandle] → (Seq DefHandle)
-
-  Provides a mechanism for enumerating all the vars (dynamic variables) packaged
-  within a given Namespace. Returns an unordered sequence of DefHandles."
-
-  [config namespace]
-  {:pre [(instance? NamespaceHandle namespace)]}
-  (list-ns-contents ->DefHandle "var" config namespace))
-
-(defn list-fns
-  "λ [config ← Map, namespace ← NamespaceHandle] → (Seq DefHandle)
-
-  Provides a mechanism for enumerating all of the functions (fns) def'd within
-  the given namespace. Returns a sequence of unordered DefHandles."
-
-  [config namespace]
-  {:pre [(instance? NamespaceHandle namespace)]}
-  (list-ns-contents ->DefHandle "fn" config namespace))
-
-(defn list-macros
-  "λ [config ← Map, namespace ← NamespaceHandle] → (Seq DefHandle)
-
-  Provides a mechanism for enumerating all of the macros def'd within the given
-  namespace. Returns an unordered sequence of DefHandles."
-
-  [config namespace]
-  {:pre [(instance? NamespaceHandle namespace)]}
-  (list-ns-contents ->DefHandle "macro" config namespace))
-
-(defn list-symbols
-  "λ [config ← Map, namespace ← NamespaceHandle] → (Seq DefHandle)
-
-  Provides a mechanism for enumerating all the symbols (non-def'd symbols with
-  special meanings). Returns an unordered sequence of DefHandles representing
-  these symbols."
-
-  [config namespace]
-  {:pre [(instance? NamespaceHandle namespace)]}
-  (list-ns-contents ->DefHandle "symbol" config namespace))
-
-;; Class stuff
-;;--------------------------------------------------------------------
-(defrecord ClassHandle [handle parent name])
-
-(defn list-classes
-  "λ [config ← Map, package ← PackageHandle] → (Seq ClassHandle)
-
-  Provides a mechanism for enumerating all of the classes in a given Java
-  package. Returns an unordered seuqence of ClassHandles."
-
-  [config package]
-  {:pre [(instance? PackageHandle package)]}
-  (list-type-filtered ->ClassHandle "class" config namespace))
-
-;; Notes, Examples & things
-;;--------------------------------------------------------------------
 (defn thing->artifact [thing]
-  (if-not (instance? ArtifactHandle thing)
+  (if-not (isa? :artifact thing)
     (when thing (recur (:parent thing)))
     thing))

 (defn thing->version [thing]
-  (if-not (instance? VersionHandle thing)
+  (if-not (isa? :version thing)
     (when thing (recur (:parent thing)))
     thing))

 (defn thing->path
-  "λ [thing ← (Σ GroupHandle
-                 ArtifactHandle
-                 VersionHandle
-                 NamespaceHandle
-                 PackageHandle
-                 DefHandle
-                 ClassHandle)] → String
-
-  Provides a mechanism for converting one of the Handle objects into a
+  "Provides a mechanism for converting one of the Handle objects into a
   cannonical \"path\" which can be serialized, deserialized and walked back into
   a Handle."

   [thing]
+  (or (:uri thing)
+      (->> thing
+           (iterate :parent)
+           (take-while identity)
+           (reverse)
+           (map :name)
+           (interpose "/")
+           (apply str))))
+
+(defn path->thing [path]
+  (->> (string/split path #"/")
+       (map vector [:group :artifact :version :namespace :def])
+       (reduce (fn [parent [t el]]
+                 (->T t parent el))
+               nil)))
+
+(defn thing->relative-path [t thing]
   (->> thing
        (iterate :parent)
-       (take-while identity)
+       (take-while #(not (= (:type %1) t)))
        (reverse)
        (map :name)
        (interpose "/")
        (apply str)))

-(def type-table
-  {"group"    ->GroupHandle
-   "artifact" ->ArtifactHandle
-   "version"  ->VersionHandle
-   "ns"       ->NamespaceHandle
-   "package"  ->PackageHandle
-   "var"      (fn [parent name]
-                (->DefHandle parent name "var"))
-   "fn"       (fn [parent name]
-                (->DefHandle parent name "fn"))
-   "macro"    (fn [parent name]
-                (->DefHandle parent name "macro"))
-   "symbol"   (fn [parent name]
-                (->DefHandle parent name "symbol"))
-   "class"    ->ClassHandle})
-
-(defn path->thing
-  "Attempts to construct the most deeply nested _documentation_ value possible given a"
-  [config path]
-  (let [parts (string/split path #"/")]
-    (loop [parent       nil
-           [part parts] parts]
-      (if-not parent
-        (let [typef (io/file )])
-        ))))
-
-(defn thing->relative-path [class thing]
-  (->> thing
-       (iterate :parent)
-       (take-while #(not (instance? class %1)))
-       (reverse)
-       (map :name)
-       (interpose "/")
-       (apply str)))
-
-(defn thing->root-to [class thing]
+(defn thing->root-to [t thing]
   (->> thing
        (iterate :parent)
        (take-while identity)
        (reverse)
-       (take-while #(not (instance? class %1)))
+       (take-while #(not (= (:type %1) t)))
        (map :name)
        (interpose "/")
        (apply str)))
-
-(defn thing->notes-handle
-
-  [config {handle :handle :as thing}]
-  (let [f (io/file handle notes-file)]
-    (when (.exists f) f)))
-
-(defn thing->url-handle
-
-  [config {handle :handle :as thing}]
-  (let [f (io/file handle url-file)]
-    (if (.exists f) f
-        (recur config (:parent thing)))))
-
-(defn thing->docs-handle
-
-  [config {handle :handle :as thing}]
-  (let [f (io/file handle docs-file)]
-    (when (.exists f) f)))
-
-(defn thing->added-handle
-
-  [config {handle :handle :as thing}]
-  (let [f (io/file handle added-file)]
-    (when (.exists f) f)))
-
-(defn semver:in-range [v0 vf v]
-  (and (>= (semver/cmp v0 v) 0)
-       (<= (semver/cmp v vf) 0)))
-
-(defn thing->example-handles
-
-  [{{notes :notes} :datastore :as config} thing]
-  (let [v0       (or (slurp (thing->added-handle thing))
-                     "1.0.0")
-        vf       (:name (thing->version thing))
-        artifact (thing->artifact thing)
-        versions (list-versions config artifact)
-        apath    (thing->relative-path VersionHandle thing)
-        bpath    (thing->root-to VersionHandle thing)]
-    (for [v     versions
-          :when (semver:in-range v0 vf (:name v))
-          :let  [d (io/file (io/file notes bpath)
-                            apath)]
-          :when (and (.exists d)
-                     (.isDirectory d))
-          f     (.listFiles d)]
-      f)))


add contact using event handler

add contact using event handler

--- src/om_tut/core.cljs
+++ src/om_tut/core.cljs
@@ -43,19 +43,25 @@
               (>= c 2) (assoc :middle middle)))))

 (defn add-contact [data owner]
-  (let [input-el (om/get-node owner "new-contact")
-        new-contact (-> input-el
+  (let [new-contact (-> (om/get-node owner "new-contact")
                         .-value
                         parse-contact)]
     (when new-contact
       (om/transact! data :contacts #(conj % new-contact))
-      (set! (.-value input-el) ""))))
+      (om/set-state! owner :text ""))))
+
+(defn handle-change [e owner {:keys [text]}]
+  (let [value (.. e -target -value)]
+    (if-not (re-find #"[0-9]" value)
+      (om/set-state! owner :text value)
+      (om/set-state! owner :text text))))

 (defn contacts-view [data owner]
   (reify
     om/IInitState
     (init-state [_]
-                {:delete (chan)})
+                {:delete (chan)
+                 :text ""})
     om/IWillMount
     (will-mount [_]
                 (let [delete (om/get-state owner :delete)]
@@ -65,14 +71,15 @@
                                         (fn [xs] (vec (remove #(= contact %) xs))))
                           (recur))))))
     om/IRenderState
-    (render-state [this {:keys [delete]}]
+    (render-state [this state]
             (dom/div nil
                      (dom/h2 nil "Contact List")
                      (apply dom/ul nil
                             (om/build-all contact-view (:contacts data)
-                                          {:init-state {:delete delete}}))
+                                          {:init-state {:delete (:delete state)}}))
                      (dom/div nil
-                              (dom/input #js {:type "text" :ref "new-contact"})
+                              (dom/input #js {:type "text" :ref "new-contact" :value (:text state)
+                                              :onChange #(handle-change % owner state)})
                               (dom/button #js {:onClick #(add-contact data owner)} "Add Contact"))))))

 (om/root contacts-view app-state


substitute +context+ in file fn

substitute +context+ in file fn

--- src/cake/file.clj
+++ src/cake/file.clj
@@ -5,15 +5,21 @@
   (:import [org.apache.tools.ant.taskdefs Copy Move Touch Delete Mkdir]
            [java.io File]))

-(defn expand-path [& path]
+(defn- expand-path [path]
   (let [root (or (first path) "")]
     (cond (instance? File root)  (cons (.getPath root) (rest path))
           (.startsWith root "/") path
           (.startsWith root "~") (cons (.replace root "~" (System/getProperty "user.home")) (rest path))
           :else                  (cons *root* path))))

+(defn- substitute-context [path]
+  (if-let [context (:context *project*)]
+    (.replace (str path) "+context+" (name context))
+    path))
+
 (defn file-name [& path]
-  (join (File/separator) (apply expand-path path)))
+  (join (File/separator)
+        (map substitute-context (expand-path path))))

 (defn file
   "Create a File object from a string or seq"


[#10928] Always show blocked users

[#10928] Always show blocked users

--- src/status_im/ui/screens/contacts_list/views.cljs
+++ src/status_im/ui/screens/contacts_list/views.cljs
@@ -32,33 +32,31 @@
             contacts      [:contacts/active]]
     [react/view {:flex 1}
      [topbar/topbar {:title :t/contacts}]
-     (if (seq contacts)
-       [react/scroll-view {:flex 1}
-        [add-new-contact]
-        (when (pos? blocked-contacts-count)
-          [react/view {:margin-vertical 16}
-           [quo/list-item
-            {:title               (i18n/label :t/blocked-users)
-             :icon                :main-icons/cancel
-             :theme               :negative
-             :accessibility-label :blocked-users-list-button
-             :chevron             true
-             :accessory           :text
-             :accessory-text      blocked-contacts-count
-             :on-press            #(re-frame/dispatch [:navigate-to :blocked-users-list])}]])
+     [react/scroll-view {:flex 1}
+      [add-new-contact]
+      (when (pos? blocked-contacts-count)
+        [react/view {:margin-vertical 16}
+         [quo/list-item
+          {:title               (i18n/label :t/blocked-users)
+           :icon                :main-icons/cancel
+           :theme               :negative
+           :accessibility-label :blocked-users-list-button
+           :chevron             true
+           :accessory           :text
+           :accessory-text      blocked-contacts-count
+           :on-press            #(re-frame/dispatch [:navigate-to :blocked-users-list])}]])
+      (if (seq contacts)
         [list.views/flat-list
          {:data                      contacts
           :key-fn                    :address
-          :render-fn                 contacts-list-item}]]
-       [react/view {:flex 1}
-        [add-new-contact]
+          :render-fn                 contacts-list-item}]
         [react/view {:align-items :center :flex 1 :justify-content :center}
          [react/text {:style {:color colors/gray :margin-vertical 24}}
           (i18n/label :t/you-dont-have-contacts)]
          [quo/button
           {:accessibility-label :invite-friends
            :on-press #(list-selection/open-share {:message (i18n/label :t/get-status-at)})}
-          (i18n/label :t/invite-friends)]]])]))
+          (i18n/label :t/invite-friends)]])]]))

 (defview blocked-users-list []
   (letsubs [blocked-contacts [:contacts/blocked]]


Use mutual recursion to make the sym/sexpr dance clearer.

--- src/kolmogorov_music/kolmogorov.clj
+++ src/kolmogorov_music/kolmogorov.clj
@@ -10,22 +10,21 @@
 (defn definition [sym]
   (-> sym sexpr last))

+(declare complexity-sexpr)
+
 (defn complexity-sym [sym ns]
   (if (in-ns? sym ns)
     (->> (definition sym)
          flatten
-         (map #(-> % (complexity-sym ns) inc))
-         (apply +))
+         (complexity-sexpr ns))
     0))

-(defn complexity-sexpr [sexpr ns]
-  (if (seq? sexpr)
-    (->> sexpr
-         (map #(-> % (complexity-fn ns) inc))
-         (apply +))
-    (complexity-fn sexpr ns)))
+(defn complexity-sexpr [ns sexpr]
+  (->> sexpr
+       (map #(complexity-sym % ns))
+       (reduce + (count sexpr))))

-(defmacro complexity [sexpr]
-  (complexity-sexpr sexpr *ns*))
-
-(complexity (+ 4 4))
+(defmacro complexity [expr]
+  (if (seq? expr)
+    (complexity-sexpr *ns* expr)
+    (complexity-sym expr *ns*)))