Add (failing) iterator tests

Add (failing) iterator tests

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -369,8 +369,7 @@
                       :assoc! (.assoc! tree (nth action 1) (nth action 2))
                       :dissoc! (.dissoc! tree (nth action 1)))
         sorted-map-result (contains? sorted-map (nth action 1))]
-    (and (= tree-result sorted-map-result)
-         (or (empty? tree) (.valid! tree)))))
+    (= tree-result sorted-map-result)))

 (defn lookup-prop [gen]
   (prop/for-all [min-keys gen/s-pos-int
@@ -378,7 +377,45 @@
                  action gen]
                 (run-lookup-prop min-keys actions action)))

-;; TODO test assoc!/dissoc! results
+(def gen-next
+  (gen/tuple (gen/return :next)))
+
+(def gen-seek
+  (gen/tuple (gen/return :seek) gen-key))
+
+(def gen-movement
+  (gen/one-of [gen-next gen-seek]))
+
+(defn apply-to-iterator [iterator movements]
+  (for [movement movements]
+    (case (nth movement 0)
+      :next (.next iterator)
+      :seek (.seek iterator (nth movement 1)))))
+
+(defn apply-to-elems [elems movements]
+  (let [elems (atom elems)]
+    (for [movement movements]
+      (case (nth movement 0)
+        :next (let [result (first @elems)]
+                (swap! elems rest)
+                result)
+        :seek (do
+                (swap! elems (fn [elems] (drop-while #((fn [a b] (lt a b)) (nth % 0) (nth movement 1)) elems)))
+                (first @elems)))))) ;; TODO should seek consume the elem?
+
+(defn run-iterator-prop [min-keys actions movements]
+  (let [tree (apply-to-tree (tree min-keys) actions)
+        sorted-map (apply-to-sorted-map (sorted-map-by #(cond (== %1 %2) 0 (lt %1 %2) -1 (gt %1 %2) 1)) actions)
+        iterator-results (apply-to-iterator (iterator tree) movements)
+        elems-results (apply-to-elems (seq sorted-map) movements)]
+    (= iterator-results elems-results)))
+
+(def iterator-prop
+  (prop/for-all [min-keys gen/s-pos-int
+                 actions (gen/vector gen-action)
+                 movements (gen/vector gen-movement)]
+                (run-iterator-prop min-keys actions movements)))
+
 ;; TODO iterator tests

 (comment
@@ -391,6 +428,8 @@
   (dc/quick-check 1000 total-prop)
   (dc/quick-check 100 (building-prop gen-assoc))
   (dc/quick-check 100 (building-prop gen-action))
+  (dc/quick-check 100 (lookup-prop gen-action))
+  (dc/quick-check 100 iterator-prop)

   (defn f []
     (time


logging improvements

logging improvements

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -92,7 +92,7 @@
 there is only one child for each parent, and that single child is the
 head of its parent. generate (above) 'decorates' each returned lightning bolt
 of this function with complements."
-  (log/debug (str "lightning-bolt@" depth " with spec: " (strip-refs spec)))
+  (log/debug (str "lightning-bolt@" depth " with cat: " (get-in spec [:synsem :cat])))
   (let [maxdepth 3 ;; maximum depth of a lightning bolt: H1 -> H2 -> H3 where H3 must be a lexeme, not a phrase.
         morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
         debug (log/trace (str "lightning-bolt@" depth " grammar:" (string/join ", " (map #(get-in % [:rule]) grammar))))
@@ -120,7 +120,8 @@
                           (log/debug (str "candidate lexemes for: " (get-in parent [:rule]) " empty?:" (empty? candidate-lexemes)))
                           (if (some fail? candidate-lexemes)
                             (throw (exception (str "some candidate lexeme was fail?=true!"))))
-                          (log/debug
+                          (log/trace
+                           (str "candidate head lexemes for:"
                                 (get-in parent [:rule]) ": '"
                                 (string/join "','"
                                              (map (fn [lexeme]
@@ -141,7 +142,7 @@
                                 (log/warn (str "all " (count candidate-lexemes) " candidate lexeme(s):"
                                                (string/join ","
                                                             (sort (map morph candidate-lexemes)))
-                                               " failed for parent: " (get-in parent [:rule]) " with spec: " (strip-refs spec)))))
+                                               " failed for parent: " (get-in parent [:rule])))))
                             result))))
                     (remove nil? candidate-heads))

@@ -156,12 +157,12 @@
                                               (get-in parent [:head])
                                               (+ 1 depth)
                           (if (empty? phrasal-children)
-                            (let [message (str "no phrasal children for parent: " (morph parent) "(rule=" (get-in parent [:rule]) ") and spec: " (strip-refs spec))]
+                            (let [message (str "no phrasal children for parent: '" (morph parent) "' with rule: " (get-in parent [:rule]) ") and cat: " (get-in spec [:synsem :cat]))]
                               (log/debug message))
                             ;; else; there are phrasal-children, so attach them below parent:
                             (do
                               (log/debug (str "phrasal-children:" (string/join "," (map morph phrasal-children))))
-                              (log/debug (str "calling overh with parent: [" (get-in parent [:rule]) "]" "'" (morph parent) "'"
+                              (log/debug (str "calling overh with parent: [" (get-in parent [:rule]) "]:" "'" (morph parent) "'"
                                               " and " (count phrasal-children) " phrasal children."))
                               (over/overh parent phrasal-children morph)))
                           )
@@ -181,8 +182,6 @@
                     (if (map? bolt) (get-in bolt [:rule]))
                     " '" (morph bolt) "'"
                     "]"))
-    (log/debug (str "add-complement to bolt with path:" path))
-
     (if (not (= bolt-spec :no-path)) ;; check if this bolt has this path in it.
       (let [immediate-parent (get-in bolt (butlast path))
             start-time (current-time)
@@ -238,14 +237,14 @@

                            ;; lazy-sequence of phrasal complements to pass one-by-one to the above (map)'s function.
                            (do
-                             (log/debug (str "generating phrasal complements with spec: " (strip-refs spec)))
+                             (log/debug (str "generating phrasal complements with cat: " (get-in spec [:synsem :cat])))
                              (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
                                (if (not (empty? phrasal-complements))
                                  (log/debug (str "phrasal complements were not empty; first: "
                                                  (get-in (first phrasal-complements) [:rule])))
                                  ;; phrasal complements were empty.
                                  (if (= true (get-in spec [:phrasal] false))
-                                   (log/warn (str "no phrasal complements of spec: " (strip-refs spec)
+                                   (log/warn (str "no phrasal complements of: " (:cat spec)
                                                   " could be generated."))))

                                (if (lexemes-before-phrases)


get rid of json lib as we don't use it

get rid of json lib as we don't use it

--- src/blogiseq/core.clj
+++ src/blogiseq/core.clj
@@ -4,7 +4,6 @@
     [hiccup.core :as hiccup]
     [hiccup.page :as hiccup-page]
     [hiccup.element :as hiccup-element]
-    [clojure.data.json :as json]
     [compojure.core :as compojure]
     [compojure.route :as compojure-route]
     [markdown.core :as md]))


clearer twitter-card function

clearer twitter-card function

--- src/bløggr/posts.clj
+++ src/bløggr/posts.clj
@@ -8,18 +8,18 @@
 (def lead-length 500)
 (def twitter-card-length 190)

-(defn twitter-card-template
   "Create twitter cards in document head"
   [{header :header description :twitter-lead}]
-  (html/html [:meta {:name "twitter:card"
-                     :content (if (:image header) "summary_large_image" "summary")}]
-             [:meta {:name "twitter:site" :content "@stianeikeland"}]
-             [:meta {:name "twitter:title" :content (:title header)}]
-             [:meta {:name "twitter:description" :content description}]
-             [:meta {:name "twitter:creator" :content "@stianeikeland"}]
-             (when (:image header)
-               [:meta {:name "twitter:image:src"
-                       :content (str "http://blog.eikeland.se" (:image header))}])))
+  (let [img (:image header)
+        card {:card (if img "summary_large_image" "summary")
+              :site "@stianeikeland"
+              :title (:title header)
+              :description description
+              :creator "@stianeikeland"
+              :image:src (when img (str "http://blog.eikeland.se" img))}
+        twitter-card (for [[k v] card]
+                       [:meta {:name (str "twitter:" (name k)) :content v}])]
+    (apply html/html twitter-card)))

 (html/deftemplate post-template "layouts/post.html" [{header :header body :body :as post}]
                   [:head] (html/html-content (slurp "resources/partials/head.html"))


Fix chapter headings

Fix chapter headings

--- src/catalog/latex.clj
+++ src/catalog/latex.clj
@@ -12,12 +12,12 @@
             [comb.template :as template]))

 (def temp-name "/tmp/catalog.tex")
-(def translations {:hörbuch "Hörbücher"
-                   :braille "Braille"
-                   :grossdruck "Grossdruck"
-                   :e-book "E-Books"
-                   :hörfilm "Hörfilme"
-                   :ludo "Spiele"
+(def translations {:hörbuch "Neue Hörbücher"
+                   :braille "Neue Braillebücher"
+                   :grossdruck "Neue Grossdruckbücher"
+                   :e-book "Neue E-Books"
+                   :hörfilm "Neue Hörfilme"
+                   :ludo "Neue Spiele"
                    :belletristik "Belletristik"
                    :sachbücher "Sachbücher"
                    :kinder-und-jugendbücher "Kinder- und Jugendbücher"


fix source size on tile draw

fix source size on tile draw

--- src/client/paint.cljs
+++ src/client/paint.cljs
@@ -70,8 +70,8 @@
               ; source coordinates (on (draw-board! "game-canvas" new-board cell-size (:level @state) rows-cutoff))
               sx (* cell-size col) ; Cell-size is based on tilemap, always extract with that size
               sy (* cell-size row)
-              sw scale
-              sh scale
+              sw cell-size
+              sh cell-size

               ; destination coordinates (on canvas)
               dx (* scale x)


game engine dev mode

game engine dev mode

--- src/clj/game/main.clj
+++ src/clj/game/main.clj
@@ -7,6 +7,8 @@
   (:gen-class :main true))

 (add-encoder java.lang.Object encode-str)
+
+(def ctx (ZMQ/context 1))

 (def commands
   {"say" core/say
@@ -42,9 +44,34 @@
       (update-in params [:args :card :zone] #(map (fn [k] (if (string? k) (keyword k) k)) %))
       params)))

+(defn run [socket]
+  (while true
+    (let [{:keys [gameid action command side args text] :as msg} (convert (.recv socket))
+          state (@game-states gameid)]
+      (try
+        (case action
+          "start" (core/init-game msg)
+          "remove" (swap! game-states dissoc gameid)
+          "do" ((commands command) state (keyword side) args)
+          "notification" (swap! state update-in [:log]
+                                #(conj % {:user "__system__" :text text}))
+          "quit" (system-msg state (keyword side) "left the game"))
+        (if (#{"start" "do"} action)
+          (.send socket (generate-string (assoc @(@game-states gameid) :action action)))
+          (.send socket (generate-string "ok")))
+        (catch Exception e
+          (println "Error in Thread " action command (get-in args [:card :title]) e)
+          (.send socket (generate-string (assoc @(@game-states gameid) :action action))))))))
+
+(defn dev []
+  (println "[Dev] Listening on port 1043 for incoming commands...")
+  (let [socket (.socket ctx ZMQ/REP)]
+    (.bind socket "tcp://127.0.0.1:1043")
+    (run socket)))
+
 (defn -main []
-  (let [ctx (ZMQ/context 1)
-        worker-url "inproc://responders"
+  (println "[Prod] Listening on port 1043 for incoming commands...")
+  (let [worker-url "inproc://responders"
         router (doto (.socket ctx ZMQ/ROUTER) (.bind "tcp://127.0.0.1:1043"))
         dealer (doto (.socket ctx ZMQ/DEALER) (.bind worker-url))]
     (dotimes [n 2]
@@ -53,23 +80,6 @@
         (fn []
           (let [socket (.socket ctx ZMQ/REP)]
             (.connect socket worker-url)
-            (while true
-              (let [{:keys [gameid action command side args text] :as msg} (convert (.recv socket))
-                    state (@game-states gameid)]
-                (try
-                  (case action
-                    "start" (core/init-game msg)
-                    "remove" (swap! game-states dissoc gameid)
-                    "do" ((commands command) state (keyword side) args)
-                    "notification" (swap! state update-in [:log]
-                                          #(conj % {:user "__system__" :text text}))
-                    "quit" (system-msg state (keyword side) "left the game"))
-                  (if (#{"start" "do"} action)
-                    (.send socket (generate-string (assoc @(@game-states gameid) :action action)) ZMQ/NOBLOCK)
-                    (.send socket (generate-string "ok") ZMQ/NOBLOCK))
-                  (catch Exception e
-                    (println "Error in Thread " n action command (get-in args [:card :title]) e)
-                    (.send socket (generate-string "error") ZMQ/NOBLOCK))))))))))
+            (run socket))))))

-    (.start (Thread. #(.run (ZMQQueue. ctx router dealer))))
-    (println "Listening on port 1043 for incoming commands...")))
+    (.start (Thread. #(.run (ZMQQueue. ctx router dealer))))))


Fix Kioo template

Fix Kioo template

Fix Kioo template to properly bring in the footer elements.

--- src/cljs/app/app.cljs
+++ src/cljs/app/app.cljs
@@ -80,7 +80,7 @@
   {[:.downloads] (kioo/content (for [[k v] @data] ;^{:key (name (gensym k))}
                                  (kryvos-download k v)))})

-(defsnippet theme-bar "templates/theme-bar.html" [:footer] []
+(defsnippet theme-bar "templates/theme-bar.html" [:.link-list] []
   {[:a] (kioo/set-attr :onclick #())})

 (deftemplate page "index.html" []


Import date as string in bq if before 1970

--- src/datasplash/bq.clj
+++ src/datasplash/bq.clj
@@ -52,7 +52,7 @@
   [v]
   (cond
     (instance? java.util.Date v) (try ( if(< (.getYear ^java.util.Date v) 1970) (.format (new java.text.SimpleDateFormat "YYYY-MM-dd HH:mm:ss") ^java.util.Date v) (int (/ (.getTime ^java.util.Date v) 1000)))
-                                      (catch Exception e (log/errorf "error when parsing date : %s" e)))
+                                      (catch Exception e (log/errorf "error when parsing date %s" v)))
     (set? v) (into '() v)
     (keyword? v) (name v)
     (symbol? v) (name v)


Reinstated accidentally deleted upsert fn

--- src/diary/datomic.clj
+++ src/diary/datomic.clj
@@ -4,6 +4,9 @@
             [clojure.java.io :as io])
   (:import datomic.Util))

+
+(defn upsert [conn entry]
+  (d/transact conn [entry]))

 (defn create [conn entry]
   (let [ res @(upsert conn (assoc entry :db/id (d/tempid :db.part/user)))


Check connectivity on startup

Check connectivity on startup

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -8,14 +8,16 @@
             [discuss.references.integration :as rint]
             [discuss.utils.common :as lib]
             [discuss.utils.logging :as log]
-            [discuss.views :as views]))
+            [discuss.views :as views]
+            [discuss.communication.connectivity :as comcon]))

-(enable-console-print!)

 ;; Initialization
 (defn ^:export main []
+  (enable-console-print!)
   (log/debug "Loaded %s %s" config/project (lib/project-version))
   (om/add-root! parser/reconciler views/Discuss (gdom/getElement (lib/prefix-name "main")))
+  (comcon/check-connectivity-of-hosts)
   (rint/request-references)
   (comlib/init!))
 (main)


Some random flailing with debug

Some random flailing with debug

--- src/fatlip/debug.cljs
+++ src/fatlip/debug.cljs
@@ -4,11 +4,11 @@
             [fatlip.protocols :refer [nodes succs Node]]
             [fatlip.sparse :refer [input->SparseGraph]]
             [fatlip.order :refer [SparseGraph->FlatGraph]]
-            [fatlip.plot :refer [FlatGraph->ClassGraphs ys pathify plot-xs]]
+            [fatlip.plot :refer [FlatGraph->ClassGraphs ys plot-xs min-y max-y]]
             [fatlip.draw.d3 :refer [data->path]]))

-(defn plot-alignments
+#_(defn plot-alignments
   [flat-graph max-slope min-arc-radius layer-sep node-sep char-sep]
   (let [{:keys [layers characters]} flat-graph]
     (->> flat-graph
@@ -18,7 +18,7 @@
          (map #(plot-xs % layers max-slope layer-sep)))))

-(defn input->plots
+#_(defn input->plots
   [input & {:keys [max-slope min-arc-radius layer-sep node-sep char-sep]
             :or {max-slope 10
                  min-arc-radius 15
@@ -41,12 +41,12 @@
 (defn plot-coarse
   [flat-graph max-slope min-arc-radius layer-sep node-sep char-sep]
   (let [{:keys [layers characters]} flat-graph
-        class-graphs (FlatGraph->ClassGraphs flat-graph)
-        node-ys (map #(ys % node-sep char-sep) class-graphs)]
-    (map (fn [n-ys]
-           (let [nodes (map (fn [node]
+        class-graphs (FlatGraph->ClassGraphs flat-graph)]
+    (map (fn [class-graph]
+           (let [node-ys (ys class-graph node-sep char-sep)
+                 nodes (map (fn [node]
                               {:x (* layer-sep (:layer-id node))
-                               :y (get n-ys node)
+                               :y (get node-ys node)
                                :id (:id node)})
                             (nodes flat-graph))
                  edges (map (fn [edge]
@@ -54,18 +54,26 @@
                                     node-2 (:dest edge)]
                                 {:x1 (* layer-sep (:layer-id node-1))
                                  :x2 (* layer-sep (:layer-id node-2))
-                                 :y1 (get n-ys node-1)
-                                 :y2 (get n-ys node-2)}))
-                            (reduce set/union (vals (succs flat-graph))))]
-             {:nodes nodes :edges edges}))
-         node-ys)))
+                                 :y1 (get node-ys node-1)
+                                 :y2 (get node-ys node-2)}))
+                            (reduce set/union (vals (succs flat-graph))))
+                 ;; min-x is always 0 for these debug graphs
+                 mn-x 0
+                 mx-x (* layer-sep (dec (count layers)))
+                 mn-y (min-y class-graph node-sep char-sep)
+                 mx-y (max-y class-graph node-sep char-sep)
+                 ;; _ (println mn-x mx-x mn-y mx-y)
+                 vbox (s/join " " [(- mn-x 50) (- mn-y 50) (+ 100 (- mx-x mn-x)) (+ 100 (- mx-y mn-y))])]
+             {:nodes nodes :edges edges :vbox vbox}))
+         class-graphs)))

 (defn draw-d3-coarse!
   [plot-data]
   (doall (map
           (fn [p-data]
-            (let [svg (-> js/d3 (.select "#app") (.append "svg") (.attr "viewBox" "-50 0 4000 1000"))]
+            (let [svg (-> js/d3 (.select "#app") (.append "svg") (.attr "viewBox" (:vbox p-data))
+                          (.attr "preserveAspectRatio" "xMidYMid meet"))]
               (-> svg
                   (.selectAll "path")
                   (.data (clj->js (:edges p-data)))


Allow bulk add / remove of classes

Allow bulk add / remove of classes

--- src/gitique/util.cljs
+++ src/gitique/util.cljs
@@ -22,7 +22,14 @@
   ([selector element]
    (.querySelectorAll element selector)))

-(defn add-class [element class] (.add (.-classList element) class))
-(defn remove-class [element class] (.remove (.-classList element) class))
+(defn add-class
+  "Add all classes passed to `element`"
+  [element & classes]
+  (doseq [class classes] (.add (.-classList element) class)))
+
+(defn remove-class
+  "Remove all classes passed from `element`"
+  [element & classes]
+  (doseq [class classes] (.remove (.-classList element) class)))

 (defn child-text [parent selector] (.-textContent (qs selector parent)))


Give some guidance on first start up

Give some guidance on first start up

--- src/greenyet/core.clj
+++ src/greenyet/core.clj
@@ -66,19 +66,34 @@
           (header "Last-Modified" (format-date (.toDate last-changed)))))))

+(def config-help (str/join "\n"
+                           ["To kick off, why don't you create a file hosts.yaml with"
+                            ""
+                            "- hostname: localhost"
+                            "  system: greenyet"
+                            "  environment: Development"
+                            ""
+                            "and a status_url.yaml with"
+                            ""
+                            "- url: http://%hostname%:3000/"
+                            "  system: greenyet"
+                            ""]))
+
 (defn init []
+  (try
+    (poll/start-polling (config/hosts-with-config config-dir) timeout-in-ms)
+    (catch FileNotFoundException e
+      (binding [*out* *err*]
+        (println (.getMessage e))
+        (println)
+        (println config-help))
+      (System/exit 1)))
   (println "Starting greenyet with config")
   (->> config-params
        (map (fn [[env-var value]]
               (format "  %s: '%s'" env-var value)))
        (map println)
-       doall)
-  (try
-    (poll/start-polling (config/hosts-with-config config-dir) timeout-in-ms)
-    (catch FileNotFoundException e
-      (binding [*out* *err*]
-        (println (.getMessage e)))
-      (System/exit 1))))
+       doall))

 (def handler
   (-> render


Import `cats.labs.sugar` into `cats.core` ns.

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -26,7 +26,7 @@
 (ns cats.core
   "Category Theory abstractions for Clojure"
   #?(:cljs
-     (:require-macros [cats.core :refer (mlet)]))
+     (:require-macros [cats.core :refer (mlet alet)]))
   #?(:cljs
      (:require [cats.protocols :as p]
                [clojure.set]
@@ -463,6 +463,155 @@
                 ~@(map second bindings))
          (alet* batches env body)))))

+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; applicative "idiomatic apply"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro ap
+  "Apply a pure function to applicative arguments, e.g.
+
+   (ap + (just 1) (just 2) (just 3))
+   ;; => #<Just [6]>
+   (ap str [\"hi\" \"lo\"] [\"bye\" \"woah\" \"hey\"])
+   ;; => [\"hibye\" \"hiwoah\" \"hihey\"
+          \"lobye\" \"lowoah\" \"lohey\"]
+
+   `ap` is essentially sugar for `(apply fapply (pure f) args)`,
+   but for the common case where you have a pure, uncurried,
+   possibly variadic function.
+
+   `ap` actually desugars in `alet` form:
+
+   (macroexpand-1 `(ap + (just 1) (just2)))
+   ;; => (alet [a1 (just 1) a2 (just 2)] (+ a1 a2))
+
+   That way, variadic functions Just Work, without needing to specify
+   an arity separately.
+
+   If you're familiar with Haskell, this is closest to writing
+   \"in Applicative style\": you can straightforwardly convert
+   pure function application to effectful application by with
+   some light syntax (<$> and <*> in case of Haskell, and `ap` here).
+
+   See the original Applicative paper for more inspiration:
+   http://staff.city.ac.uk/~ross/papers/Applicative.pdf"
+  [f & args]
+  (let [syms (repeatedly (count args) (partial gensym "arg"))]
+    `(alet [~@(interleave syms args)]
+        (~f ~@syms))))
+
+(defmacro ap->
+  "Thread like `->`, within an applicative idiom.
+
+  Compare:
+
+  (macroexpand-1 `(-> a b c (d e f)))
+  => (d (c (b a) e f)
+
+  with:
+
+  (macroexpand-1 `(ap-> a b c (d e f))
+  => (ap d (ap c (ap b a) e f))
+  "
+  [x & forms]
+  (loop [x x, forms forms]
+    (if forms
+      (let [form (first forms)
+            threaded (if (seq? form)
+                       (with-meta `(ap ~(first form) ~x ~@(next form)) (meta form))
+                       `(ap ~form ~x))]
+        (recur threaded (next forms)))
+      x)))
+
+(defmacro ap->>
+  "Thread like `->>`, within an applicative idiom.
+   See `cats.labs.sugar/ap->` for more in-depth discussion."
+  [x & forms]
+  (loop [x x, forms forms]
+    (if forms
+      (let [form (first forms)
+            threaded (if (seq? form)
+                       (with-meta `(ap ~(first form) ~@(next form)  ~x) (meta form))
+                       `(ap ~form ~x))]
+        (recur threaded (next forms)))
+      x)))
+
+(defmacro as-ap->
+  "Thread like `as->`, within an applicative idiom.
+   See `cats.labs.sugar/ap->` for more in-depth discussion."
+  [expr name & forms]
+  `(let [~name ~expr
+         ~@(interleave (repeat name) (for [form forms] `(ap ~@form)))]
+     ~name))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Monadic arrow macros.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro ->=
+  "Like `->`, but with monadic binding instead of pure application.
+   A mnemonic for the name is a pun on `>>=`, the monadic bind operator,
+   and clojure's regular arrow macros.
+
+   You can think of it as generalizing the `some->` thread macro
+   to all Monads instead of just Maybe.
+
+   Alternatively, if you think of the regular thread macro as
+   sugar for `let`:
+
+   (-> :a b (c (other args)) d)
+   =>
+   (let [res (b :a)
+         res (c res (other args))
+         res (d res)]
+     res)
+
+   Then `->=` is sugar for cats.core/mlet:
+
+   (->= m-a b (c (other args)) d)
+   (mlet [res m-a
+          res (c res (other args))
+          res (d res)]
+     (return res))
+
+   Note that extra args in this context are assumed pure, and will
+   be evaluated along with the function itself; this also matches
+   the behavior of `some->` wrt extra args.
+
+   Threading through pure functions is somewhat awkward, but can be done:
+
+   (->= m-a
+        monadic-fn
+        (-> pure-fn
+            other-pure-fn
+            m/return)
+        other-monadic-fn)"
+  [expr & forms]
+  (let [g (gensym)
+        pstep (fn [step] `(-> ~g ~step))]
+    `(mlet [~g ~expr
+              ~@(interleave (repeat g) (map pstep forms))]
+           (return ~g))))
+
+(defmacro ->>=
+  "Like ->>, but with monadic binding instead of pure application.
+   See `cats.labs.sugar/->=` for more in-depth discussion."
+  [expr & forms]
+  (let [g (gensym)
+        pstep (fn [step] `(->> ~g ~step))]
+    `(mlet [~g ~expr
+              ~@(interleave (repeat g) (map pstep forms))]
+           (return ~g))))
+
+(defmacro as->=
+  "Like `as->`, but with monadic binding instead of pure application.
+   See `cats.labs.sugar/->=` for more in-depth discussion."
+  [expr name & forms]
+  `(mlet [~name ~expr
+            ~@(interleave (repeat name) forms)]
+     (return ~name)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Curry Facilities
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Check for max-lanes.

Check for max-lanes.

--- src/cbfg/lane.cljs
+++ src/cbfg/lane.cljs
@@ -13,7 +13,7 @@
    responses on the out-ch than arrive 'after' the lane closing, so an
    out-ch consumer should handle and/or drop those late responses.
    So, to avoid confusion, a client should avoid reusing lane-names."
-  [actx in-ch out-ch make-lane-fn]
+  [actx in-ch out-ch make-lane-fn & {:keys [max-lanes]}]
   (act-loop lane-pump actx [lane-chs {} lane-chs-tot 0]
             (if-let [m (atake lane-pump in-ch)]
               (if (= (:op m) :lane-close)
@@ -26,12 +26,16 @@
                 (if-let [lane-ch (get lane-chs (:lane m))]
                   (do (aput lane-pump lane-ch m)
                       (recur lane-chs lane-chs-tot))
-                  (if-let [lane-ch (make-lane-fn lane-pump (:lane m) out-ch)]
-                    (do (aput lane-pump lane-ch m)
-                        (recur (assoc lane-chs (:lane m) lane-ch)
-                               (inc lane-chs-tot)))
+                  (if (or (not max-lanes) (< (count lane-chs) max-lanes))
+                    (if-let [lane-ch (make-lane-fn lane-pump (:lane m) out-ch)]
+                      (do (aput lane-pump lane-ch m)
+                          (recur (assoc lane-chs (:lane m) lane-ch)
+                                 (inc lane-chs-tot)))
+                      (do (aput lane-pump out-ch
+                                (assoc m :status :failed :status-info :make-lane))
+                          (recur lane-chs lane-chs-tot)))
                     (do (aput lane-pump out-ch
-                              (assoc m :status :failed :status-info :make-lane))
+                              (assoc m :status :full :status-info :max-lanes))
                         (recur lane-chs lane-chs-tot)))))
               (doseq [[lane-name lane-ch] lane-chs] ; Close lane-chs & exit.
                 (aclose lane-pump lane-ch)))))


Add benchmarks

Add benchmarks

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -33,16 +33,16 @@
     "path = ? AND tenant = ? AND rollup = ? AND period = ? "
     "AND time >= ? AND time <= ? ORDER BY time ASC;")))

-(defn std-cleaner
-  "Standard cleaner."
-  [data]
-  (println "Cleaning data with standard cleaner...")
+(defn remove-cleaner
+  "Remove cleaner."
+  [data]
+  (println "Cleaning data with remove cleaner...")
   (let [cdata (time (doall (remove nil? data)))]
     (println "Number of rows:" (count cdata))
     (println)
     cdata))

-(defn r-cleaner
+(defn rremove-cleaner
   "R/remove cleaner."
   [data]
   (println "Cleaning data with r/remove cleaner...")
@@ -51,32 +51,41 @@
     (println)
     cdata))

-(defn std-reducer
-  "Standard reducer."
-  [data]
-  (println "Reducing data with standard reducer...")
-  (let [rdata (time (doall (reduce into data)))]
-    (println "Number of rows:" (count rdata))
-    (println)
-    rdata))
-
-(defn flatten-reducer
-  "Flatten reducer."
-  [data]
-  (println "Reducing data with flatten reducer...")
-  (let [rdata (time (doall (flatten data)))]
-    (println "Number of rows:" (count rdata))
-    (println)
-    rdata))
-
-(defn rflatten-reducer
-  "R/flatten reducer."
-  [data]
-  (println "Reducing data with r/flatten reducer...")
-  (let [rdata (time (doall (into [] (r/flatten data))))]
-    (println "Number of rows:" (count rdata))
-    (println)
-    rdata))
+(defn reduce-flatter
+  "Reduce flatter."
+  [data]
+  (println "Flatting data with reduce...")
+  (let [fdata (time (doall (reduce into data)))]
+    (println "Number of rows:" (count fdata))
+    (println)
+    fdata))
+
+(defn rreduce-flatter
+  "R/reduce flatter."
+  [data]
+  (println "Flatting data with r/reduce...")
+  (let [fdata (time (doall (r/reduce into [] data)))]
+    (println "Number of rows:" (count fdata))
+    (println)
+    fdata))
+
+(defn flatten-flatter
+  "Flatten flatter."
+  [data]
+  (println "Flatting data with flatten...")
+  (let [fdata (time (doall (flatten data)))]
+    (println "Number of rows:" (count fdata))
+    (println)
+    fdata))
+
+(defn rflatten-flatter
+  "R/flatten flatter."
+  [data]
+  (println "Flatting data with r/flatten...")
+  (let [fdata (time (doall (into [] (r/flatten data))))]
+    (println "Number of rows:" (count fdata))
+    (println)
+    fdata))

 (defn par-fetch [session fetch! paths tenant rollup period from to]
   "Fetch data in parallel fashion."
@@ -250,11 +259,12 @@
     (println)
     (let [paths (es-get-paths eshost path tenant)
           data (c-get-data chost paths tenant rollup period from to)
-          std-rdata (std-reducer data)
-          flatten-rdata (flatten-reducer data)
-          rflatten-rdata (rflatten-reducer data)
-          std-cdata (std-cleaner std-rdata)
-          r-cdata (r-cleaner std-rdata)]))
+          reduce-fdata (reduce-flatter data)
+          rreduce-fdata (rreduce-flatter data)
+          flatten-fdata (flatten-flatter data)
+          rflatten-fdata (rflatten-flatter data)
+          remove-cdata (remove-cleaner reduce-fdata)
+          rremove-cdata (rremove-cleaner reduce-fdata)]))
   (println "Finish time:" (tl/format-local-time (tl/local-now) :rfc822)))

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


Add shutdown-agents

Add shutdown-agents

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -126,14 +126,19 @@
 (defn c-get-data
   "Get data from C*."
   [host paths tenant rollup period from to]
-  (let [session (-> (alia/cluster {:contact-points [host]})
-                    (alia/connect keyspace))
-        fetch! (fetchq session)]
-    (println "Getting data form Cassandra...")
-    (let [data (time (doall (par-fetch session fetch! paths tenant
-                                       rollup period from to)))]
-      (newline)
-      data)))
+  (try
+    (println "Connecting to Cassandra...")
+    (let [session (-> (alia/cluster {:contact-points [host]})
+                      (alia/connect keyspace))
+          fetch! (fetchq session)]
+      (println "Getting data form Cassandra...")
+      (let [data (time (doall (par-fetch-pmap session fetch! paths tenant
+                                              rollup period from to)))]
+        (newline)
+        data))
+    (catch Exception e
+      (shutdown-agents)
+      (throw e))))

 ;;------------------------------------------------------------------------------
 ;; ElasticSearch


Fix metric counter

Fix metric counter

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -91,7 +91,7 @@
         (wlog/info (str title ":"))
         (when-not @wlog/print-log?
           (println title)
-          (prog/init (count all-paths)))
+          (prog/init (* (count all-paths) (count rollups))))
         (let [paths-rollups (for [p all-paths r rollups] [p r])
               futures (doall (map #(cp/future tpool
                                               (proc-fn (second %) (first %)))


Integrate new pre-in-fn and further integrate out-fn.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -175,31 +175,31 @@
     proc-fns))

 (defn prepare-in-fn
-  [options scenario in-data ^Counter in-cntr out-fn in-chan pipeline queue-size]
+  [options scenario in-data pre-in-fn out-fn in-chan pipeline queue-size]
   (let [batch-delay (:batch-delay options)
         batch-size (:batch-size options)
         create-batched-in-fn (fn [in-fn]
                                (fn []
                                  (doseq [i (repeat batch-size 0)]
-                                   (in-fn in-data)
-                                   (.inc in-cntr))
+                                   (in-fn (pre-in-fn in-data)))
                                  (sleep batch-delay)))
         create-flood-in-fn (fn [in-fn]
                              (fn []
-                               (in-fn in-data)
-                               (.inc in-cntr)))
+                               (in-fn (pre-in-fn in-data))))
         direct-proc-fn (create-direct-proc-fn scenario)
         collection-size (:collection-size options)
         partition-size (:partition-size options)
         in-fn (cond
                 (.endsWith scenario "-direct")
                   (fn []
-                    (out-fn (direct-proc-fn in-data)))
+                    (out-fn
+                      (direct-proc-fn
+                        (pre-in-fn in-data))))
                 (.endsWith scenario "-direct-pmap")
                   (let [d (repeat collection-size in-data)]
                     (doall d)
                     (fn []
-                      (doseq [obj (pmap direct-proc-fn d)]
+                      (doseq [obj (pmap (fn [in-obj] (direct-proc-fn (pre-in-fn in-obj))) d)]
                         (out-fn obj))))
                 (.endsWith scenario "-direct-reducers-map")
                   (let [in-vec (vec (repeat collection-size in-data))]
@@ -209,18 +209,16 @@
                                     partition-size
                                     reducers/cat
                                     reducers/append!
-                                    (reducers/map direct-proc-fn in-vec))]
+                                    (reducers/map (fn [in-obj] (direct-proc-fn (pre-in-fn in-obj))) in-vec))]
                         (out-fn obj))))
                 (.endsWith scenario "-simple-pmap")
                   (let [pmap-proc (create-simple-pmap-processor direct-proc-fn collection-size out-fn)]
                     (fn []
-                      (pmap-proc in-data)
-                      (.inc in-cntr)))
+                      (pmap-proc (pre-in-fn in-data))))
                 (.endsWith scenario "-simple-reducers-map")
                   (let [red-proc (create-simple-reducers-map-processor direct-proc-fn collection-size partition-size out-fn)]
                     (fn []
-                      (red-proc in-data)
-                      (.inc in-cntr)))
+                      (red-proc (pre-in-fn in-data))))
                 (.endsWith scenario "-async-pipeline")
                   (if
                     (and
@@ -256,6 +254,17 @@
     (println "Using options:" options)
     (println "Using args:" arguments)
     (let [in-cntr (Counter.)
+          pre-in-fn (if (:latency options)
+                      (do
+                        (println "Creating latency measurement pre-in-fn.")
+                        (fn [in-obj]
+                          (.inc in-cntr)
+                          (LatencyProbe. in-obj)))
+                      (do
+                        (println "Creating default measurement pre-in-fn.")
+                        (fn [in-obj]
+                          (.inc in-cntr)
+                          in-obj)))
           out-cntr (Counter.)
           latency-probe-collector (LatencyProbeCollector.)
           out-fn (if (:latency options)
@@ -290,7 +299,7 @@
                     (async/chan queue-size))
           out-chan (if (.contains scenario "async-pipeline")
                      (async/chan queue-size))
-          in-fn (prepare-in-fn options scenario in-data in-cntr out-fn in-chan pipeline queue-size)
+          in-fn (prepare-in-fn options scenario in-data pre-in-fn out-fn in-chan pipeline queue-size)
           in-loop (ProcessingLoop.
                     "DataGenerationLoop"
                     in-fn)
@@ -369,8 +378,7 @@
           (println "Starting async-pipeline-go input creation.")
           (async/go
             (loop []
-              (async/>! in-chan in-data)
-              (.inc ^Counter in-cntr)
+              (async/>! in-chan (pre-in-fn in-data))
               (recur)))
           (sleep 130000))
         (do


Refactor main: extract functionality to distinct functions.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -171,6 +171,70 @@
     (println "proc-fns:" proc-fns)
     proc-fns))

+(defn prepare-in-fn
+  [options scenario in-data in-cntr out-cntr in-chan pipeline queue-size]
+  (let [batch-delay (:batch-delay options)
+        batch-size (:batch-size options)
+        create-batched-in-fn (fn [in-fn]
+                               (fn []
+                                 (doseq [i (repeat batch-size 0)]
+                                   (in-fn in-data)
+                                   (.inc in-cntr))
+                                 (sleep batch-delay)))
+        create-flood-in-fn (fn [in-fn]
+                             (fn []
+                               (in-fn in-data)
+                               (.inc in-cntr)))
+        direct-proc-fn (create-direct-proc-fn scenario)
+        collection-size (:collection-size options)
+        partition-size (:partition-size options)
+        in-fn (cond
+                (.endsWith scenario "-direct")
+                  (fn []
+                    (direct-proc-fn in-data)
+                    (.inc out-cntr))
+                (.endsWith scenario "-direct-pmap")
+                  (let [d (repeat collection-size in-data)]
+                    (doall d)
+                    (fn []
+                      (doseq [_ (pmap direct-proc-fn d)]
+                        (.inc out-cntr))))
+                (.endsWith scenario "-direct-reducers-map")
+                  (let [in-vec (vec (repeat collection-size in-data))]
+                    (doall in-vec)
+                    (fn []
+                      (doseq [_ (reducers/fold
+                                  partition-size
+                                  reducers/cat
+                                  reducers/append!
+                                  (reducers/map direct-proc-fn in-vec))]
+                        (.inc out-cntr))))
+                (.endsWith scenario "-async-pipeline")
+                  (if
+                    (and
+                      (not (nil? in-data))
+                      (> batch-delay 0)
+                      (> batch-size 0))
+                    (create-batched-in-fn
+                      (fn [data]
+                        (async/>!! in-chan data)))
+                    (if
+                      (not (nil? in-data))
+                      (create-flood-in-fn
+                        (fn [data]
+                          (async/>!! in-chan data)))))
+                (and
+                  (not (nil? in-data))
+                  (not (nil? pipeline))
+                  (> batch-delay 0)
+                  (> batch-size 0)) (create-batched-in-fn (get-in-fn pipeline))
+                (and
+                  (not (nil? in-data))
+                  (not (nil? pipeline))) (create-flood-in-fn (get-in-fn pipeline))
+                :default (if (not (.contains scenario "async-pipeline"))
+                           (fn [] (.inc out-cntr))))]
+    in-fn))
+
 (defn -main [& args]
   (println "Starting dsbdp main...")
   (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
@@ -199,72 +263,14 @@
                        @proc-fns
                        (fn [_ _]
                          (.inc out-cntr))))
-          batch-delay (:batch-delay options)
-          batch-size (:batch-size options)
           in-chan (if (.contains scenario "async-pipeline")
                     (async/chan queue-size))
           out-chan (if (.contains scenario "async-pipeline")
                      (async/chan queue-size))
-          create-batched-in-fn (fn [in-fn]
-                                 (fn []
-                                   (doseq [i (repeat batch-size 0)]
-                                     (in-fn in-data)
-                                     (.inc in-cntr))
-                                   (sleep batch-delay)))
-          create-flood-in-fn (fn [in-fn]
-                               (fn []
-                                 (in-fn in-data)
-                                 (.inc in-cntr)))
-          direct-proc-fn (create-direct-proc-fn scenario)
-          collection-size (:collection-size options)
-          partition-size (:partition-size options)
+          in-fn (prepare-in-fn options scenario in-data in-cntr out-cntr in-chan pipeline queue-size)
           in-loop (ProcessingLoop.
                     "DataGenerationLoop"
-                    (cond
-                      (.endsWith scenario "-direct")
-                        (fn []
-                          (direct-proc-fn in-data)
-                          (.inc out-cntr))
-                      (.endsWith scenario "-direct-pmap")
-                        (let [d (repeat collection-size in-data)]
-                          (doall d)
-                          (fn []
-                            (doseq [_ (pmap direct-proc-fn d)]
-                              (.inc out-cntr))))
-                      (.endsWith scenario "-direct-reducers-map")
-                        (let [in-vec (vec (repeat collection-size in-data))]
-                          (doall in-vec)
-                          (fn []
-                            (doseq [_ (reducers/fold
-                                        partition-size
-                                        reducers/cat
-                                        reducers/append!
-                                        (reducers/map direct-proc-fn in-vec))]
-                              (.inc out-cntr))))
-                      (.endsWith scenario "-async-pipeline")
-                        (if
-                          (and
-                            (not (nil? in-data))
-                            (> batch-delay 0)
-                            (> batch-size 0))
-                          (create-batched-in-fn
-                            (fn [data]
-                              (async/>!! in-chan data)))
-                          (if
-                            (not (nil? in-data))
-                            (create-flood-in-fn
-                              (fn [data]
-                                (async/>!! in-chan data)))))
-                      (and
-                        (not (nil? in-data))
-                        (not (nil? pipeline))
-                        (> batch-delay 0)
-                        (> batch-size 0)) (create-batched-in-fn (get-in-fn pipeline))
-                      (and
-                        (not (nil? in-data))
-                        (not (nil? pipeline))) (create-flood-in-fn (get-in-fn pipeline))
-                      :default (if (not (.contains scenario "async-pipeline"))
-                                 (fn [] (.inc out-cntr)))))
+                    in-fn)
           async-out-count-loop (if
                                  (and
                                    (.endsWith scenario "-async-pipeline")
@@ -284,6 +290,7 @@
                                (async/<! out-chan)
                                (.inc ^Counter out-cntr)
                                (recur))))
+          direct-proc-fn (create-direct-proc-fn scenario)
           async-pipeline (if
                            (and
                              (.contains scenario "-async-pipeline")


Add boot-notify helper functions to boot.notify ns

--- boot/worker/src/boot/notify.clj
+++ boot/worker/src/boot/notify.clj
@@ -47,3 +47,40 @@
                 (fn [& _#] (swap! ~warnings inc)))
           ~@body)
        (catch Throwable _ `(do ~@body))))
+
+(defn- ^{:boot/from :jeluard/boot-notify} program-exists?
+  [s]
+  (= 0 (:exit (sh "sh" "-c" (format "command -v %s" s)))))
+
+(defprotocol Notifier
+  (-supported? [this] "Check if this notifier is supported on current platform")
+  (-notify [this m] "Perform the notification"))
+
+(deftype ConsolePrintNotifier
+    []
+  Notifier
+  (-supported? [_] true)
+  (-notify [_ {:keys [message title]}] (printf "%s: %s" title message)))
+
+(deftype TerminalNotifierNotifier
+    []
+  Notifier
+  (-supported? [_] (program-exists? "terminal-notifier"))
+  (-notify [_ {:keys [message title icon pid]}]
+    (sh "terminal-notifier" "-message" message "-title" title "-contentImage" icon "-group" pid)))
+
+(deftype NotifySendNotifier
+    []
+  Notifier
+  (-supported? [_] (program-exists? "notify-send"))
+  (-notify [_ {:keys [message title icon]}] (sh "notify-send" title message "--icon" icon)))
+
+(def ^{:boot/from :jeluard/boot-notify} default-notifier
+  (condp = (System/getProperty "os.name")
+    "Mac OS X" (TerminalNotifierNotifier.)
+    "Linux" (NotifySendNotifier.)
+    (ConsolePrintNotifier.)))
+
+(defn ^{:boot/from :jeluard/boot-notify} notify!
+  [s m]
+  (-notify default-notifier (assoc m :message s)))


Full asplan + SA seems to work.

Full asplan + SA seems to work.

--- src/exp/asplan.clj
+++ src/exp/asplan.clj
@@ -346,7 +346,8 @@
 (defn make-if-deadlock-hla [hierarchy var dl-plan nodl-plan]
   (let [name [:if-deadlock var (map env/action-name dl-plan) (map env/action-name nodl-plan)]
         av   (action-var var)
-        pc   (:full-context hierarchy )#_(util/safe-get-in hierarchy [:precondition-context-map var])]
+        pc   ;(:full-context hierarchy )#_
+             (util/safe-get-in hierarchy [:precondition-context-map var])]
     (reify :as this
       env/Action
        (action-name [] name)
@@ -362,7 +363,8 @@
 (defn make-achieve-precondition-hla [hierarchy var dst-val]
   (let [name [:achieve-precondition var dst-val]
         av   (action-var var)
-        pc   (:full-context hierarchy )#_(util/safe-get-in hierarchy [:precondition-context-map var])]
+        pc   ;(:full-context hierarchy )#_
+             (util/safe-get-in hierarchy [:precondition-context-map var])]
     (reify :as this
       env/Action
        (action-name [] name)
@@ -402,8 +404,8 @@
   (let [name          [:fire-action effect-var]
         reduced-pm    (dissoc (:precond-map a) effect-var)
         child-var-map (:child-var-map hierarchy)
-        pc            (:full-context hierarchy ) #_
-                      (util/safe-get-in hierarchy [:precondition-context-map effect-var]) #_
+        pc            ;(:full-context hierarchy ) #_
+                      ;(util/safe-get-in hierarchy [:precondition-context-map effect-var]) #_
                       (into #{(action-var effect-var)}
                             (apply concat
                                    (for [p (keys reduced-pm)]


add exclusions to ui dependencies

add exclusions to ui dependencies

--- ui/project.clj
+++ ui/project.clj
@@ -18,7 +18,7 @@

   :npm {:dependencies []}

-  :plugins [[lein-figwheel "0.5.9"]
+  :plugins [[lein-figwheel "0.5.9" :exclusions [[org.clojure/clojure]]]
             [lein-cljsbuild "1.1.5" :exclusions [[org.clojure/clojure]]]
             [lein-npm "0.6.2"]]

@@ -55,7 +55,7 @@
                                   [figwheel-sidecar "0.5.9"]
                                   [com.cemerick/piggieback "0.2.1"]]
                    :plugins [[lein-kibit "0.1.3"]
-                             [lein-bikeshed "0.4.1"]]
+                             [lein-bikeshed "0.4.1" :exclusions [[org.clojure/tools.cli]]]]
                    :source-paths ["src" "dev"]
                    :repl-options {:port 8230
                                   :nrepl-middleware [dirac.nrepl/middleware]


CMR-1694: Added a minor comment in the code.

--- ingest-app/src/cmr/ingest/api/routes.clj
+++ ingest-app/src/cmr/ingest/api/routes.clj
@@ -151,6 +151,7 @@
   "Set concept-id and revision-id for the given concept based on the headers. Ignore the
   revision-id if no concept-id header is passed in."
   [concept headers]
+  ;; The header concept-id exists primarily to support backwards compatibility with Catalog Rest
   (if-let [concept-id (or (get headers "cmr-concept-id") (get headers "concept-id"))]
     (assoc concept :concept-id concept-id)
     concept))


Clean up

Clean up

Rename speed to velocity.
Smarter multi-functions.

--- src/asteroids/core.clj
+++ src/asteroids/core.clj
@@ -60,11 +60,11 @@
                                                    :life-time 400}}
                        :fire       {:size           (/ ship-size 2.5)
                                     :shape          [[-1.0 -1.0] [1.0 -1.0] [0.0 1.0]]
-                                    :color          (fn [] (Color. (random-int 230 256) (random-int 60 220) (random-int 0 50)))
+                                    :color          #(Color. (random-int 230 256) (random-int 60 220) (random-int 0 50))
                                     :spread         0.2
-                                    :speed          -0.7
+                                    :speed          #(random -0.8 -0.5)
                                     :acceleration   0
-                                    :rotation-speed (fn [] (random -5 5))
+                                    :rotation-speed #(random -5 5)
                                     :cooldown       30
                                     :life-time      400}
                        :missile    {:size         (/ ship-size 3)
@@ -74,21 +74,21 @@
                                     :speed        0
                                     :acceleration 3
                                     :damage       15
-                                    :cooldown     5000
+                                    :cooldown     8000
                                     :explosion    {:size      30
-                                                   :color     (Color. 230 230 250)
+                                                   :color     (Color. 220 220 250)
                                                    :life-time 200}}
                        :bomb       {:size         (/ ship-size 3)
                                     :shape        [[-1.0 -1.0] [0.0 -1.5] [1.0 -1.0] [1.1 1.0] [0.0 1.5] [-1.0 1.0]]
-                                    :color        (Color. 50 250 10)
+                                    :color        (Color. 10 250 50)
                                     :speed        0.8
                                     :acceleration 0
                                     :damage       1
-                                    :cooldown     10000
+                                    :cooldown     5000
                                     :explosion    {:size      20
                                                    :color     (Color. 180 220 180)
-                                                   :life-time 250
-                                                   :damage    2}}
+                                                   :life-time 160
+                                                   :damage    3}}
                        })

 (def actions {
@@ -144,7 +144,7 @@
    :shots          []

    :position       [(/ width 2) (/ height 2)]
-   :speed          [0 0]
+   :velocity       [0 0]
    :acceleration   0

    :direction      0
@@ -167,12 +167,13 @@
      :else expr))
   ([expr] (get-expr-value expr nil)))

-(defn create-shot [ammunition-type {ship-pos :position ship-size :size ship-dir :direction ship-speed :speed}]
+(defn create-shot [ammunition-type {ship-pos :position ship-size :size ship-dir :direction ship-velocity :velocity}]
   (let [{:keys [spread size shape color acceleration direction rotation-speed damage life-time]} (get ammunition-types ammunition-type)
         move-dir (if spread (+ ship-dir (random (- spread) spread)) ship-dir)
         dir-vec (m/rotate-vec move-dir [0 1])
         position (m/vec+vec ship-pos (m/num*vec ship-size dir-vec))
-        speed (m/vec+vec ship-speed (m/num*vec (-> ammunition-types ammunition-type :speed) dir-vec))]
+        speed (get-expr-value (-> ammunition-types ammunition-type :speed))
+        velocity (m/vec+vec ship-velocity (m/num*vec speed dir-vec))]
     {:type           ammunition-type

      :size           (get-expr-value size)
@@ -181,7 +182,7 @@
      :paint-method   fill-polygon

      :position       position
-     :speed          speed
+     :velocity       velocity
      :acceleration   (get-expr-value acceleration 0)

      :direction      (get-expr-value direction move-dir)
@@ -202,7 +203,7 @@
      :paint-method   fill-circle

      :position       position
-     :speed          [0 0]
+     :velocity       [0 0]
      :acceleration   0

      :direction      0
@@ -215,11 +216,11 @@
     nil))

 (defn create-asteroid
-  ([size pos speed]
+  ([size pos velocity]
    (let [size (vary asteroid-size-variance size)
          direction (rand (* 2 (Math/PI)))
          dir-vec (m/rotate-vec direction [0 1])
-         speed (m/vec+vec speed (m/num*vec (rand asteroid-max-speed) dir-vec))
+         velocity (m/vec+vec velocity (m/num*vec (rand asteroid-max-speed) dir-vec))
          position (m/vec+vec pos (m/num*vec size dir-vec))
          rotation-speed (rand asteroid-max-rotation-speed)
          num-points (Math/round (+ size 3.0))
@@ -237,7 +238,7 @@
       :paint-method   draw-polygon

       :position       position
-      :speed          speed
+      :velocity       velocity
       :acceleration   0

       :direction      direction
@@ -255,9 +256,8 @@
      (create-asteroid size [x y]))))

 (defn create-asteroids
-  ([num size] (map create-asteroid (repeat num size)))
-  ([num size pos speed] (map create-asteroid (repeat num size) (repeat num pos) (repeat num speed)))
-  #_(repeat num (create-asteroid size pos speed)))
+  ([num size] (repeatedly num #(create-asteroid size)))
+  ([num size pos velocity] (repeatedly num #(create-asteroid size pos velocity))))

 (defn play-sound
   ([sound gain]
@@ -324,10 +324,7 @@
         (recur (rest coll1) coll2 (conj coll1-result obj1))))))

 (defmulti handle-damage (fn [{type :type}]
-                          (cond
-                            (#{:projectile :missile :bomb} type) :shot
-                            (#{:ship :asteroid} type) type
-                            :else :other)))
+                          (if (type (set (keys ammunition-types))) :shot type)))

 (defmethod handle-damage :ship [{:keys [damage-taken life] :as ship}]
   (when damage-taken (play-sound (if (<= life damage-taken) "ship-destroyed" "ship-hit")))
@@ -342,12 +339,12 @@
     (create-explosion position (-> ammunition-types type :explosion))
     shot))

-(defmethod handle-damage :asteroid [{:keys [damage-taken size position speed] :as asteroid}]
+(defmethod handle-damage :asteroid [{:keys [damage-taken size position velocity] :as asteroid}]
   (if damage-taken
-    (create-asteroids damage-taken (/ size (sqrt damage-taken)) position speed)
+    (create-asteroids damage-taken (/ size (sqrt damage-taken)) position velocity)
     asteroid))

-(defmethod handle-damage :other [object]
+(defmethod handle-damage :default [object]
   object)

 (defn resolve-all-collision [{shots :shots :as ship} asteroids]
@@ -357,11 +354,11 @@
         shots (->> shots
                    (map handle-damage)
                    flatten
-                   (filter (comp not nil?)))
+                   (remove nil?))
         asteroids (->> asteroids
                        (map handle-damage)
                        flatten
-                       (filter (comp not nil?)))]
+                       (remove nil?))]
     [(assoc ship :shots shots) asteroids]))

 (defn win? [asteroids]
@@ -396,12 +393,12 @@
   (reduce fire-weapon ship weapons))

 (defn basic-move
-  ([{:keys [direction rotation-speed speed acceleration position] :as object} wrap?]
+  ([{:keys [direction rotation-speed velocity acceleration position] :as object} wrap?]
    (let [direction (+ direction (* rotation-speed turn-millis 0.001))
-         speed (m/vec+vec speed (m/rotate-vec direction [0 (* acceleration turn-millis 0.001)]))
-         [x y] (m/vec+vec speed position)]
+         velocity (m/vec+vec velocity (m/rotate-vec direction [0 (* acceleration turn-millis 0.001)]))
+         [x y] (m/vec+vec velocity position)]
      (assoc object :direction direction
-                   :speed speed
+                   :velocity velocity
                    :position (if wrap? [(mod x width) (mod y height)] [x y]))))
   ([object] (basic-move object true)))

@@ -410,19 +407,13 @@
 (defmethod move :ship [{shots :shots :as ship}]
   (let [ship (basic-move ship)
         shots (->> shots
-                   (filter (comp not out-of-bounds?))
+                   (remove out-of-bounds?)
                    (map move)
-                   (filter (comp not nil?)))]
+                   (remove nil?))]
     (assoc ship :shots shots)))

-(defmethod move :projectile [projectile]
-  (basic-move projectile false))
-
-(defmethod move :bomb [bomb]
-  (basic-move bomb false))
-
-(defmethod move :missile [missile]
-  (basic-move missile false))
+(defmethod move :default [object]
+  (basic-move object false))

 (defmethod move :fire [{:keys [life-time color] :as fire}]
   (if (< life-time turn-millis)
@@ -461,7 +452,7 @@
 (defn move-many [coll]
   (->> coll
        (map move)
-       (filter (comp not nil?))))
+       (remove nil?)))

 (defn set-rotation [{rotation :rotation :as ship} value activate?]
   (let [rotation (if activate?
@@ -535,8 +526,7 @@
     (.fillOval x y (- x1 x) (- y1 y)))
   nil)

-(defmulti paint (fn [_ {type :type}]
-                  (if (= type :ship) :ship :other)))
+(defmulti paint (fn [_ {type :type}] type))

 (defmethod paint :ship [g {:keys [shape life-colors life cockpit-shape cockpit-color shots paint-method] :as ship}]
   (doseq [shot shots]
@@ -548,7 +538,7 @@
     (paint-method g polygon color)
     (paint-method g cockpit-polygon cockpit-color)))

-(defmethod paint :other [g {:keys [shape color paint-method] :as object}]
+(defmethod paint :default [g {:keys [shape color paint-method] :as object}]
   (let [transformation (get-transformation-matrix object point-size)
         polygon (polygon-to-screen shape transformation)]
     (paint-method g polygon color)))


Releasing web-template 0.5.1

Releasing web-template 0.5.1

--- modules/web-template/project.clj
+++ modules/web-template/project.clj
@@ -1,6 +1,6 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/web-template "0.5.1-SNAPSHOT"
+(defproject juxt.modular/web-template "0.5.1"
   :description "A modular extension that supports template data that is determined by the web request"
   :url "https://github.com/juxt/modular/tree/master/modules/template"
   :license {:name "The MIT License"


Add three arity version of verify that uses information conveying exceptions

--- src/useful/utils.clj
+++ src/useful/utils.clj
@@ -12,9 +12,12 @@

 (defmacro verify
   "Raise exception unless test returns true."
-  [test exception]
-  `(when-not ~test
-     (throw (fix ~exception string? #(Exception. ^String %)))))
+  ([test exception]
+     `(when-not ~test
+        (throw (fix ~exception string? #(Exception. ^String %)))))
+  ([test msg info]
+     `(when-not ~test
+        (throw (ex-info ~msg ~info)))))

 (defmacro returning
   "Compute a return value, then execute other forms for side effects.


Added try catch around mongo connect.

Added try catch around mongo connect.

--- src/cadence/server.clj
+++ src/cadence/server.clj
@@ -32,7 +32,9 @@
     (if (not= mode :dev) (server/add-middleware require-https))
     (server/add-middleware wrap-gzip)
     (server/add-middleware friend/authenticate friend-settings)
-    (model/connect config/storage)
+    (try (model/connect config/storage)
+      (catch java.io.IOException e
+        (println "ERROR: Could not connect to MongoDB.")))
     (server/start port (let [opts {:mode mode
                                    :ns 'cadence}]
                          (if (not= mode :dev)


Snapshots work, but not restore due to om cursor render issues.

Running into issues where OM exceptions with...

    Uncaught Error: Cannot manipulate cursor outside of render phase,
    only om.core/transact!, om.core/update!, and cljs.core/deref
    operations allowed.

Might have to rethink using OM for this due to all the direct
access needed by the ago snapshot/restore system.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -6,7 +6,8 @@
             [goog.dom :as gdom]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [ago.core :refer [make-ago-world ago-chan ago-timeout ago-snapshot]]
+            [ago.core :refer [make-ago-world ago-chan ago-timeout
+                              ago-snapshot ago-restore]]
             [cbfg.vis :refer [listen-el get-el-value get-el-innerHTML]]
             [cbfg.net :refer [make-net]]
             [cbfg.lane]
@@ -14,10 +15,11 @@
             [cbfg.world.lane]
             [cbfg.world.base :refer [world-cmd-loop]]))

-(def prog-base    (atom {}))  ; Stable parts of prog.
+(def prog-base    (atom {}))  ; Stable parts of prog, even during time-travel.
 (def prog-curr    (atom {}))  ; The current prog-frame.
 (def prog-hover   (atom nil)) ; A past prog-frame while hovering over prog-history.
-(def prog-history (atom []))  ; Each event is [ts label prog-frame agw-snapshot].
+(def prog-history (atom []))  ; Each event is [ts label prog-frame].
+(def prog-ss      (atom {}))  ; ts => agw-snapshot.

 (defn prog-init [world]
   (reset! prog-base {:world world
@@ -30,10 +32,11 @@
   (reset! prog-hover nil)
   (reset! prog-history []))

-(defn prog-event [world label fn]
-  (let [prog-frame (swap! prog-curr fn)
-        ago-ss (ago-snapshot ((:get-agw (first world))))]
-    (swap! prog-history #(conj % [(count %) label prog-frame ago-ss]))))
+(defn prog-event [world label prog-frame-fn]
+  (let [prog-next (swap! prog-curr prog-frame-fn)
+        ts (count @prog-history)]
+    (swap! prog-history #(conj % [ts label prog-next]))
+    (swap! prog-ss #(assoc % ts (ago-snapshot ((:get-agw (first world))))))))

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

@@ -42,8 +45,12 @@
          (map (fn [[k v]] (dom/li nil (str k ":" (count v))))
               prog-frame)))

-(defn on-prog-frame-click [ts label prog-frame]
-  (println :on-prog-frame-click ts label))
+(defn on-prog-frame-restore [ts label prog-frame]
+  ; Time-travel to the past if snapshot is available.
+  (when-let [ago-ss (get @prog-ss ts)]
+    (reset! prog-curr prog-frame)
+    (swap! prog-history #(vec (take (+ ts 1) %)))
+    (ago-restore ((:get-agw (first (:world @prog-base)))) ago-ss)))

 (defn on-prog-frame-focus [ts label prog-frame]
   (reset! prog-hover prog-frame)
@@ -55,8 +62,8 @@

 (defn render-events [app owner]
   (apply dom/ul nil
-         (map (fn [[ts label prog-frame ago-ss]]
-                (dom/li #js {:onClick #(on-prog-frame-click ts label prog-frame)
+         (map (fn [[ts label prog-frame]]
+                (dom/li #js {:onClick #(on-prog-frame-restore ts label prog-frame)
                              :onMouseEnter #(on-prog-frame-focus ts label prog-frame)
                              :onMouseLeave #(on-prog-frame-blur)}
                         (str ts (apply str label) prog-frame)))


Specialized render-client-hist for t1.

Specialized render-client-hist for t1.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -35,6 +35,49 @@
                      :reqs    {}}) ; { opaque-ts => [req, [[reply-ts reply] ...] }.
   (reset! prog-evts []))

+; -------------------------------------------------------------------
+
+(defn filter-r [r] (if (map? r)
+                     (-> r
+                         (dissoc :opaque)
+                         (dissoc :op)
+                         (dissoc :fence))
+                     r))
+
+(defn render-client-hist-html [client-hist]
+   (apply str
+          (flatten ["
"
+                    (map (fn [[ts [request responses]]]
+                           ["
"
+                              "
"
+                              "
" request
+                              "

"
+                              "   <button id='replay-" ts "'>"
+                              "    < replay requests to here</button>"
+                              "
"
+                              (map (fn [[response-ts response]]
+                                     ["
"
+                                      (-> (filter-r response)
+                                          (dissoc :lane)
+                                          (dissoc :delay)
+                                          (dissoc :sleep))
+                                      "
"])
+                                   (reverse responses))
+                              "
	"
+                              "
"])
+                         (sort #(compare [(:lane (first (second %1))) (first %1)]
+                                         [(:lane (first (second %2))) (first %2)])
+                               client-hist))
+                    "
"])))
+
+; -------------------------------------------------------------------
+
 (defn prog-evt [world label prog-frame-fn]
   (let [prog-prev @prog-curr
         prog-next (swap! prog-curr #(prog-frame-fn (update-in % [:ts] inc)))
@@ -43,14 +86,13 @@
     (when need-snapshot ; Only snapshot when quiescent.
       (swap! prog-ss #(assoc % (:ts prog-next) (ago-snapshot (actx-agw world)))))
     (when (not= (:reqs prog-prev) (:reqs prog-next))
-      (set-el-innerHTML "reqs"
-                        (cbfg.world.base/render-client-hist-html (:reqs prog-next))))))
+      (set-el-innerHTML "reqs" (render-client-hist-html (:reqs prog-next))))))

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

 (defn on-prog-frame-focus [prog-frame]
   (set-el-innerHTML "net-hover"
-                    (cbfg.world.base/render-client-hist-html (:reqs prog-frame)))
+                    (render-client-hist-html (:reqs prog-frame)))
   (.add gdom/classes (gdom/getElement "net-container") "hover"))

 (defn on-prog-frame-blur []


handle AI icebreakers

handle AI icebreakers

Additional logic to account for AI breakers. Is using `=` too strict?

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -18,7 +18,9 @@
                                                          (or (:current-strength card) (:strength card)))))
                       pumpnum (when strdif (int (Math/ceil (/ strdif (:pump pumpabi)))))]
                   (update! state side (assoc card :abilities
-                           (if (and (:rezzed current-ice) (some #(has? current-ice :subtype %) (:breaks card))
+                           (if (and (:rezzed current-ice)
+                                    (or (some #(has? current-ice :subtype %) (:breaks card))
+                                        (= (:breaks card) "All"))
                                     (> strdif 0))
                              (vec (cons {:auto-pump true :cost [:credit (* pumpcst pumpnum)]
                                          :label (str "Match strength of " (:title current-ice))} abs))


fixes

fixes

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1843,7 +1843,7 @@
       :msg (msg "trash " (:title target)) :effect (effect (trash target))}]}

    "Utopia Shard"
-   {:abilities [{:effect (effect (trash :corp (take 2 (shuffle (:hand corp)))) (trash card))
+   {:abilities [{:effect (effect (trash-cards :corp (take 2 (shuffle (:hand corp)))) (trash card))
                  :msg "force the Corp to discard 2 cards from HQ at random"}]}

    "Valencia Estevez: The Angel of Cayambe"
@@ -2148,7 +2148,7 @@
    {:advanceable :always :abilities [{:msg "end the run" :effect (effect (end-run))}]}

    "Bandwidth"
-   {:abilities [{:msg "give the Runner 1 tag" :effect (effect (gain :runner :tag 1))}}
+   {:abilities [{:msg "give the Runner 1 tag" :effect (effect (gain :runner :tag 1))}]}

    "Bastion"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}
@@ -2210,7 +2210,8 @@
    {:abilities [{:msg "do 3 net damage" :effect (effect (damage :net 3))}]}

    "Cortex Lock"
-   {:abilities [{:msg "do 1 net damage" :effect (effect (damage :net 1))}]}
+   {:abilities [{:msg "do 1 net damage for each unused memory the Runner has"
+                 :effect (effect (damage :net (:memory runner)))}]}

    "Curtain Wall"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}
@@ -2429,8 +2430,8 @@
    "Negotiator"
    {:abilities [{:msg "gain 2 [Credits]" :effect (effect (gain :credit 2))}
                 {:prompt "Choose a program to trash" :label "Trash a program"
-                 :msg (msg "trash " (:title target))
-                 :choices (req (get-in runner [:rig :program])) :effect (effect (trash target))}}
+                 :choices {:req {:req #(= (:zone %) [:rig :program])}}
+                 :msg (msg "trash " (:title target)) :effect (effect (trash target))}]}

    "Neural Katana"
    {:abilities [{:msg "do 3 net damage" :effect (effect (damage :net 3))}]}


Comment out dev stuff in local

Comment out dev stuff in local

--- src/clj/inky/local.clj
+++ src/clj/inky/local.clj
@@ -145,12 +145,13 @@
       {:port port :join? false})))

+(comment

-(defonce ss (atom nil))
+  (defonce ss (atom nil))

-(defn restart []
-  (when @ss
-    (@ss))
-  (reset! ss (start-server 4658 "/Users/zk/napplelabs/tmpinky/dommytest")))
+  (defn restart []
+    (when @ss
+      (@ss))
+    (reset! ss (start-server 4658 "/Users/zk/napplelabs/tmpinky/dommytest")))

-(restart)
+  (restart))


Add mean to maths.

Add mean to maths.

--- src/cljx/c2/maths.cljx
+++ src/cljx/c2/maths.cljx
@@ -41,6 +41,12 @@
   [(apply min xs)
    (apply max xs)])

+(defn mean
+  "Arithemetic mean of collection"
+  [xs]
+  (/ (reduce + xs)
+     (count xs)))
+
 (defn irange
   "Inclusive range; same as core/range, but includes the end."
   ([start] (range start))


#1 Working version with maven retrieved alfresco

--- src/leiningen/amp/deploy.clj
+++ src/leiningen/amp/deploy.clj
@@ -91,10 +91,10 @@

 (defn- copy-war
   "Copies the WAR file where to install the AMP into a working location"
-  [project]
-  (let [temp-war (io/file (:target-path project) "__amp_target.war")]
-    (-> (find-dependency project)
-        (io/copy temp-war))
+  [{:keys [amp-target-war] :as project}]
+  (let [dependency (find-dependency project)
+        temp-war (io/file (:target-path project) (dep-to-filename amp-target-war))]
+    (io/copy dependency temp-war)
     temp-war))

 (defn- install!


Improment --list option: notify the difference if the hash value does not machts on all project

--- src/leiningen/namespaces.clj
+++ src/leiningen/namespaces.clj
@@ -15,8 +15,9 @@
 (def src-path-def [:source-paths])
 (def test-path-def [:test-paths])
 (def resource-path-def [:resource-paths])
-(def hash-length 10)
 (def standard-test-cmd [["./lein.sh" "clean"] ["./lein.sh" "test"]])
+(def hash-length 8)
+(def empty-occurence-str "X ")

 ;;;; Read target project  helper  ;;;;
 (defn ->target-project-path [project-name]
@@ -199,6 +200,17 @@
     (update-resource! resource target-project source-project-desc (project-clj-of target-projects-desc target-project)))
   (m/info "*\n****************************************************************\n"))

+(defn log-resouces-table [m resource-name]
+  (m/info "\n* List of" resource-name)
+  (m/info "     -"
+          empty-occurence-str
+          "                        :  the namespace/resource does not exist in the project although it has been specified")
+  (m/info "     - hash-value (.i.e ddfa3d66) :  the namespace/resource is defined in the project.clj")
+  (m/info "                                    "
+          "|resource| ==> 5532BDEA | means that the hash value doesn't match on all projects\n")
+  (pp/print-table (sort-by :name m))
+  (m/info "\n"))
+
 (defn aggregate [result [namespace project]]
   (let [project-occurence (if (contains? result namespace)
                             (merge-with str project (get result namespace))
@@ -219,7 +231,7 @@
    (take (count projects) (repeat initial-value))))

 (defn md5-hash
-  ([paths] (str/join "|" (map #(md5-hash % hash-length) paths)))
+  ([paths] (str/join " | " (map #(md5-hash % hash-length) paths)))
   ([path length]
    (let [hash-value (d/digest "md5" (io/as-file path))
          hash-length (dec (count hash-value))]
@@ -227,7 +239,7 @@

 (defn project-occurence-render [paths project]
   (if (empty? paths)
-    {project (str "O ")}
+    {project empty-occurence-str}
     {project (md5-hash paths)}))

 (defn resource-occurence [resource project project-desc render]
@@ -261,20 +273,30 @@
        :name    (last name-segments)})
     {:name (name k)}))

+(defn mark-value-as-different [v]
+  (if (empty? v)
+    ""
+    (str "==> " (str/upper-case v))))
+
+(defn uppercase-map [m]
+  (zipmap (keys m)
+          (map mark-value-as-different (vals m))))
+
+(defn unterline-different-values [m]
+  (let [unique-values (->> (vals m)
+                           (filter not-empty)
+                           (set))]
+    (if (= 1 (count unique-values))
+      m
+      (uppercase-map m))))
+
 (defn ->pretty-print-structure [data selector]
   (reduce-kv
    (fn [m k v] (conj m (merge
                         (occurence-map-for k selector)
-                        v)))
+                        (unterline-different-values v))))
    []
    data))
-
-(defn log-resouces-table [m resource-name]
-  (m/info "\n* List of" resource-name)
-  (m/info "     - hash-value (.i.e a3d66)  :  the namespace/resource is defined in the project.clj")
-  (m/info "     - X  :                     :  the namespace/resource does not exist in the project")
-  (pp/print-table (sort-by :name m))
-  (m/info "\n"))

 (defn build-resource-table [projects selector render]
   (-> projects


got node-zip working which is fantastic, you should try it, and made add work correctly eg no weirdness on dupe adds

--- src/lseq_tree/lseq_node.cljc
+++ src/lseq_tree/lseq_node.cljc
@@ -5,17 +5,29 @@
 (defn find-in [xs n]
   (.indexOf xs n))

+(defrecord Node [triple element sub-counter children])
+
+(defn count-elements
+  [{:keys [sub-counter element]}]
+  (if element
+    (inc sub-counter)
+    sub-counter))
+
+(defn count-children
+  [children]
+  (reduce + (map count-elements children)))
+
 (defn node-zip
   [root]
   (z/zipper
-    (fn [_] true)
-    (fn [n] (if (vector? n)
-              (seq n)
-              (:children n)))
-    (fn [n c] nil) ;do not use any editing on the tree
+    (fn [node] (:children node))
+    (fn [node] (seq (:children node)))
+    (fn [{:keys [triple element]} children]
+      (->Node triple
+              element
+              (count-children children)
+              (sorted :triple children)))
     root))
-
-(defrecord Node [triple element sub-counter children])

 (defn node
   [[triple & xs] element]
@@ -35,26 +47,51 @@
   [{:keys [children] :as node} triple]
   (find-in (map :triple children) triple))

+(defn nth-child
+  "Returns the loc of the nth child of the node at this loc, or
+  nil if no children or nth-child"
+  [loc n]
+  (when (z/branch? loc)
+    (let [[node path] loc
+          cs (z/children loc)
+          c (nth cs n nil)]
+      (when (and cs c)
+        (with-meta [c
+                    {:l (if (> n 0) (vec (take n cs)) [])
+                     :pnodes (if path
+                               (conj (:pnodes path) node)
+                               [node])
+                     :ppath path
+                     :r (drop (+ n 1) cs)}]
+                   (meta loc))))))
+
 (defn add
   "adds a node with one child at each level(a limb) to the children of a node"
   ; TODO use a indexes func on a limb instead of this
-  [{:keys [children triple] :as node}
-   {-children :children -element :element -triple :triple
-    :as limb}]
-  (let [node* (update-in node [:sub-counter] inc)
-        index (triple-in node* -triple)
-        length (count children)]
-    ;does the path exist
-    (if (or (< index 0)
-            (= length 0))
-      (assoc node* :children (merge-child children limb))
-      ;does the limb have children
-      (if (= (count -children) 0)
-        ; is their something at the index
-        (if (get-in children [index :element])
-          node
-          (assoc-in node* [:children index :element] -element))
-        (update-in node* [:children index] #(add % (first -children)))))))
+  [node limb]
+  (let [paths (indexes node limb)]
+    (if (last paths)
+      (loop [[head & tail] paths,
+             node-loc (node-zip node),
+             limb limb]
+        (let [node-child (nth-child node-loc head)]
+          (if (empty? tail)
+            (if (-> node-child z/node :element)
+              node
+              (-> node-child
+                  (z/edit assoc :element (:element limb))
+                  z/root))
+            (recur tail
+                   node-child
+                   (first (:children limb))))))
+      (loop [[head & tail] paths
+             node-loc (node-zip node)
+             limb limb]
+        (if-not head
+          (-> node-loc (z/append-child limb) z/root)
+          (recur tail
+                 (nth-child node-loc head)
+                 (first (:children limb))))))))

 (defn del
   [this node]
@@ -79,16 +116,14 @@
   (let [paths (indexes node limb)]
     (if (some nil? paths)
       nil
-      (loop [paths paths,
-             node node,
+      (loop [[head & tail] paths,
+             {:keys [children] :as node} node,
              acc (if (:element node) 1 0)]
-        (let [head (first paths), tail (next paths)
-              {:keys [children]} node]
-          (if head
-            (recur tail
-                   (nth children head)
-                   (+ acc (left-to-right head node)))
-            (dec acc))))))) ;zero-based index
+        (if head
+          (recur tail
+                 (nth children head)
+                 (+ acc (left-to-right head node)))
+          (dec acc)))))) ;zero-based index

 (defn indexes
   "returns a vector of numbers for each level that the index of a limb is
@@ -107,8 +142,8 @@
                 (= (count children) 0))
           (conj path index)
           (recur (conj path index)
-                 (get-in node [:children index])
-                 (get-in limb [:children 0])))))))
+                 (nth children index)
+                 (first (:children limb))))))))

 (defn crawl-to
   "returns a zipper with it's location where the index in a node"


There should be a pure CLJS dais chain

There should be a pure CLJS dais chain

--- src/daisneon/dais.cljs
+++ src/daisneon/dais.cljs
@@ -1,8 +1,194 @@
 (ns daisneon.dais)
+
+;; ----------
+;; This is an implementation of the Dais Interceptor Chain
+;; written in ClojureScript and using ClojureScript data types (Records, keywords, persistent collections)
+;;
+;; There is support for static chain execution using JavaScript Arrays
+;; --------------------------------------------------------------------

 (enable-console-print!)

-(defn ^:export main [& args]
+(defrecord Interceptor [name enter leave error])
+
+(extend-protocol IPrintWithWriter
+  Interceptor
+  (-pr-writer [i writer _]
+    (write-all writer (str "#Interceptor{:name " (.-name i) "}"))))
+
+(defprotocol IntoInterceptor
+  (-interceptor [t] "Given a value, produce an Interceptor Record."))
+
+(extend-protocol IntoInterceptor
+  PersistentHashMap
+  (-interceptor [t] (map->Interceptor t))
+  PersistentArrayMap
+  (-interceptor [t] (map->Interceptor t))
+
+  Interceptor
+  (-interceptor [t] t)
+
+  object
+  (-interceptor [t]
+    (->Interceptor (.-name t) (.-enter t) (.-leave t) (.-error t))))
+
+(defn interceptor-name
+  [n]
+  (if-not (or (nil? n) (keyword? n))
+    (throw (ex-info (str "Name must be keyword or nil; Got: " (pr-str n)) {:name n}))
+    n))
+
+(defn interceptor?
+  [o]
+  (= (type o) Interceptor))
+
+(defn valid-interceptor?
+  [o]
+  (if-let [int-vals (and (interceptor? o)
+                           (vals (select-keys o [:enter :leave :error])))]
+    (and (some identity int-vals)
+         (every? fn? (remove nil? int-vals))
+         (or (interceptor-name (:name o)) true) ;; Could return `nil`
+         true)
+    false))
+
+(defn interceptor
+  "Given a value, produces and returns an Interceptor (Record)."
+  [t]
+  {:pre [(if-not (satisfies? IntoInterceptor t)
+           (throw (ex-info "You're trying to use something as an interceptor that isn't supported by the protocol; Perhaps you need to extend it?"
+                           {:t t
+                            :type (type t)}))
+           true)]
+   :post [(valid-interceptor? %)]}
+  (-interceptor t))
+
+(declare handle-leave)
+(declare handle-error)
+
+(defn handle-enter [context]
+  (loop [ctx context]
+    (if (empty? (:dais/queue ctx))
+     ctx
+      (let [{queue :dais/queue
+             stack :dais/stack} ctx
+            interceptor (peek queue)
+            old-context ctx
+            new-queue (pop queue)
+            ;; conj on nil returns a list, acts like a stack:
+            new-stack (conj stack interceptor)
+            partial-ctx (assoc ctx
+                               :dais/queue new-queue
+                               :dais/stack new-stack)
+            enter-fn (:enter interceptor)
+            new-context (if (fn? enter-fn)
+                          (try
+                            (enter-fn partial-ctx)
+                            (catch :default e
+                              (assoc (dissoc partial-ctx :dais/queue)
+                                     :error e)))
+                          partial-ctx)]
+
+        (if (:error new-context)
+          (handle-error new-context)
+          (recur (if (some #(% new-context) (:dais/terminators new-context))
+                   (handle-leave (dissoc new-context :dais/queue))
+                   new-context)))))))
+
+(defn handle-array-enter [context]
+  (reduce
+    (fn [ctx interceptor]
+      (let [partial-ctx (update-in ctx [:dais/stack] conj interceptor)
+            enter-fn (:enter interceptor)
+            new-context (if (fn? enter-fn)
+                          (try
+                            (enter-fn partial-ctx)
+                            (catch :default e
+                              (assoc (dissoc partial-ctx :dais/queue)
+                                     :error e)))
+                          partial-ctx)]
+        (if (:error new-context)
+          (reduced (handle-error new-context))
+          (if (some #(% new-context) (:dais/terminators new-context))
+            (reduced (handle-leave (dissoc new-context :dais/queue)))
+            new-context))))
+    context
+    (:dais/queue context)))
+
+(defn handle-leave [context]
+  (loop [ctx context]
+    (if (empty? (:dais/stack ctx))
+     (dissoc ctx
+             :dais/stack
+             "dais.stack")
+      (let [stack (:dais/stack ctx)
+            interceptor (peek stack)
+            old-context ctx
+            new-stack (pop stack)
+            partial-ctx (assoc ctx
+                               :dais/stack new-stack)
+            leave-fn (:leave interceptor)
+            new-context (if (fn? leave-fn)
+                          (try
+                            (leave-fn partial-ctx)
+                            (catch :default e
+                              (assoc (dissoc partial-ctx :dais/queue)
+                                     :error e)))
+                          partial-ctx)]
+
+        (if (:error new-context)
+          (handle-error new-context)
+          (recur new-context))))))
+
+(defn handle-error [context]
+  (loop [ctx context]
+    (if (empty? (:dais/stack ctx))
+     ctx
+      (let [stack (:dais/stack ctx)
+            interceptor (peek stack)
+            old-context ctx
+            new-stack (pop stack)
+            partial-ctx (assoc ctx
+                               :dais/stack new-stack)
+            error-fn (:error interceptor)
+            new-context (if (fn? error-fn)
+                          (error-fn partial-ctx)
+                          partial-ctx)]
+
+        (if (:error new-context)
+          (recur new-context)
+          (handle-leave new-context))))))
+
+(defn ^:export execute
+  ([context]
+   {:pre [(map? context)]}
+   (let [{q :dais/queue
+          stack :dais/stack
+          terminators :dais/terminators
+          :or {stack '()
+               terminators []}} context
+         ;; Check for interop'd stack and terminators
+         terminators (get context "dais.terminators" terminators)
+         stack (get context "dais.stack" stack)]
+     (cond
+       (array? q) (handle-array-enter context)
+       (seq q) (handle-enter (assoc context
+                                    :dais/queue (if (instance? cljs.core/PersistentQueue q)
+                                                  q
+                                                  (into cljs.core/PersistentQueue.EMPTY q))
+                                    ;; Defend against stack types and interop
+                                    :dais/stack (into '() (reverse stack))
+                                    :dais/terminators terminators))
+       :else context)))
+  ([context interceptors]
+   (let [final-ctx (execute (assoc (js->clj context)
+                                   :dais/queue (into cljs.core/PersistentQueue.EMPTY
+                                                     (map interceptor interceptors))))]
+     (if (object? context)
+       (clj->js final-ctx)
+       final-ctx))))
+
+(defn ^:export hello [& args]
   "hello node - from ClojureScript")

 ;(println (main))


We no longer only rely on 'subnetPurpose' being 'internal'

--- src/exploud/asgard.clj
+++ src/exploud/asgard.clj
@@ -540,11 +540,11 @@
   (into {} (filter (fn [[k v]] (not (nil? v))) (seq map))))

 (defn replace-load-balancer-key
-  "If `:subnetPurpose` is `internal` and `:selectedLoadBalancers` is found
+  "If `:subnetPurpose` is set and `:selectedLoadBalancers` is found
    within `parameters` the key name will be switched with
    `:selectedLoadBalancersForVpcId{vpc-id}"
   [parameters environment]
-  (if (and (= "internal" (:subnetPurpose parameters))
+  (if (and (:subnetPurpose parameters)
            (:selectedLoadBalancers parameters))
     (let [vpc-id (vpc-id-for-environment environment)]
       (set/rename-keys parameters
@@ -579,11 +579,11 @@
     (get-security-group-id security-group environment region)))

 (defn replace-security-group-names
-  "If `:subnetPurpose` is `internal` and `:securityGroupNames` is found within
+  "If `:subnetPurpose` is set and `:securityGroupNames` is found within
    `parameters` the value will be checked for security group names and replaced
    with their IDs (since we can't use security group names in a VPC)."
   [parameters environment region]
-  (if (= "internal" (:subnetPurpose parameters))
+  (if (:subnetPurpose parameters)
     (if-let [security-group-names (util/list-from
                                    (:selectedSecurityGroups parameters))]
       (let [security-group-ids (map (fn [sg]


Fix generated hiccup vectors

Fix generated hiccup vectors


Resize logo in kaleidoscope

Resize logo in kaleidoscope

--- spectacles/src/spectacles/kaleidoscope.clj
+++ spectacles/src/spectacles/kaleidoscope.clj
@@ -25,9 +25,11 @@
   (q/background 0)
   (q/smooth)
   (q/frame-rate 60)
-  {:ldots (list (new_dot))
-   :rdots (list (new_dot))
-   :logo (q/load-image "resources/images/lifeinlights-logo.png")})
+  (let [image (q/load-image "resources/images/lifeinlights-logo.png")]
+    (q/resize image 150 0)
+    {:ldots (list (new_dot))
+     :rdots (list (new_dot))
+     :logo image}))

 (defn draw-dots [x y direction dots func]
   (q/push-matrix)
@@ -45,7 +47,7 @@
   (q/no-stroke)
   (q/fill 0 0 0 25)
   (q/rect 0 0 (q/width) (q/height))
-  (q/image (:logo state) (- (/ (q/width) 2) 100) (- (/ (q/height) 2) 100))
+  (q/image (:logo state) (- (/ (q/width) 2) 75) (- (/ (q/height) 2) 75))
   (draw-dots 300 300 1 (:ldots state) q/rect)
   (draw-dots (/ (q/width) 2) (/ (q/height) 2) -1 (:rdots state) q/ellipse)
   (q/fill 0 0 0 255)
@@ -79,13 +81,13 @@
     (assoc state :ldots (update-dots ldots)
                  :rdots (update-dots rdots))))

-;; (q/defsketch practice
-;;      :title "Kaleidoscope"
-;;      :size :fullscreen
-;;      :setup setup
-;;      :draw draw
-;;      :update update
-;;      :features [:keep-on-top]
-;;      :middleware [m/fun-mode m/navigation-2d])
+(q/defsketch practice
+     :title "Kaleidoscope"
+     :size [800 600]
+     :setup setup
+     :draw draw
+     :update update
+     :features [:keep-on-top]
+     :middleware [m/fun-mode m/navigation-2d])


Delete subscriptions.clj

Delete subscriptions.clj

--- bin/codestarter/views/subscriptions.clj
+++ bin/codestarter/views/subscriptions.clj
@@ -1,92 +0,0 @@
-(ns codestarter.views.subscriptions
-  (:use codestarter.views.common
-        [codestarter.views.comments :only (comments*)]
-        hiccup.core
-        hiccup.form-helpers
-        [hiccup.page-helpers :exclude (url)]
-        korma.core
-        korma.db)
-  (:require clojure.set
-            [clojure.string :as string]
-            [noir.validation :as vali])
-  (:import [com.sun.syndication.feed.synd SyndFeedImpl SyndEntryImpl SyndContentImpl]
-           [com.sun.syndication.io SyndFeedOutput]))
-
-(def keys* [:edit :application :comment :update :update_comment])
-
-(defn edit [id {:keys [params] :as request}]
-  (body* [project (select-one projects (where {:id id}))]
-         true
-         request
-         (html
-           (header project request)
-           (let [subscription (select-one subscriptions
-                                          (where {:project_id id :user_id (:id (get-user request))})
-                                          (with users))
-                 subscription (merge subscription params)]
-             (form-to [:post "."]
-                      (csrf)
-                      [:div.controls
-                       (control
-                         :subscriptions
-                         (html
-                           [:div
-                            (map #(vector
-                                    :label (check-box % (if subscription (subscription %)))
-                                    (string/replace (name %) "_" " "))
-                                 keys*)]))]
-                      (if (get-user request)
-                        (control :email
-                                 [:label.controls (check-box :email (subscription :email)) "receive notifications by email"]
-                                 :label "")
-                        (control :email (text-field :email (subscription :email))))
-                      [:hr]
-                      [:button.button "save changes"]
-                      [:button.button.secondary {:name "get"} "get rss feed"])))
-         (if (and (not (params :get)) (not (get-user request)))
-           (required params :email))
-         "Subscriptions updated."
-         (if (params :get)
-           (redirect (format "/projects/%s/rss/?%s" id
-                             (string/join "&" (map #(format "%s=%s" (name %) (params %)) (filter #(params %) keys*)))))
-           (let [params (reduce #(assoc % %2 (read-string (or (% %2) "nil"))) params keys*)
-                 user (get-user request)
-                 where-clause {:project_id id :user_id (user :id)}
-                 db-params (assoc (select-keys params keys*) :email (params :email))
-                 subscriptions? (seq (filter #(params %) keys*))]
-             (if (and subscriptions? (empty? (select subscriptions (where where-clause))))
-               (insert subscriptions (values (merge {:project_id id :user_id (:id user)} db-params)))
-               (if subscriptions?
-                 (update subscriptions (set-fields db-params) (where where-clause))
-                 (delete subscriptions (where where-clause))))
-             (redirect "")))))
-
-(defn rss [id {:keys [params] :as request}]
-  (body* [project (select-one projects (where {:id id})
-                              (with notifications
-                                (where {:type
-                                        [in (map name
-                                                 (clojure.set/intersection (set (keys params)) (set keys*)))]})
-                                (with users)
-                                (order :id :DESC)))]
-         true
-         request
-         {:headers {"Content-Type" "application/rss+xml"}
-          :body (-> (new SyndFeedOutput)
-                  (.outputString
-                    (doto (new SyndFeedImpl)
-                      (.setFeedType "rss_2.0")
-                      (.setTitle (project :name))
-                      (.setLink (format "http://localhost:3000/projects/%s/rss/" id))
-                      (.setDescription (project :description))
-                      (.setEntries
-                        (map
-                          #(doto (new SyndEntryImpl)
-                             (.setTitle (format "%s%s by %s"
-                                                (string/replace (% :type) "update_comment" "comment")
-                                                (if (% :title) (str ": " (% :title)) "") (display %)))
-                             (.setLink (str "http://localhost:3000" (% :link)))
-                             (.setPublishedDate (% :time))
-                             (.setDescription (doto (new SyndContentImpl) (.setType "text/html")
-                                                (.setValue (% :notification)))))
-                          (project :notifications))))))}))


Defonce server var.

Defonce server var.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -61,7 +61,7 @@
                    :thread (or thread-count
                                (Integer. (getenv "THREAD_COUNT" "4")))}))

-(def server (atom nil))
+(defonce server (atom nil))

 (defn defserver
   "Start a server and bind the result to a var, 'server'."


Remove unused namespaces, add some notes

--- src/io/aviso/rook.clj
+++ src/io/aviso/rook.clj
@@ -3,9 +3,7 @@
   (:require
     [clojure.tools.logging :as l]
     [compojure.core :as compojure]
-    [clout.core :as clout]
-    [clojure.walk :as walk]
-    [clojure.pprint :as pp]))
+    [clout.core :as clout]))

 (def
   DEFAULT-MAPPINGS
@@ -210,6 +208,7 @@

   The advanced version also takes a path for compojure.core/context and an optional list of sub-handlers that
   will be invoked BEFORE rook-handler."
+  ;; I'm thinking that handlers is wrong; the handlers should actually be middleware.
   ([namespace]
    (namespace-middleware rook-handler namespace))
   ([path namespace & handlers]


Because our index points to N+1 bit, increment when considering length.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -966,7 +966,7 @@

 (defn ^"[J" bm-set
   [^"[J" bm idx]
-  (let [size (max (count bm) (bm-longs idx))
+  (let [size (max (count bm) (bm-longs (inc idx)))
         nbm (Arrays/copyOf bm ^Long size)
         w (quot idx bits-per-long)
         o (mod idx bits-per-long)
@@ -978,7 +978,7 @@

 (defn ^Long bm-get
   [^"[J" bm idx]
-  (when (<= (bm-longs idx) (count bm))
+  (when (<= (bm-longs (inc idx)) (count bm))
     (let [w (quot idx bits-per-long)
           o (mod idx bits-per-long)
           m (bit-set 0 o)