Update db fixture to use new config, add missing require

--- test/braid/test/fixtures/db.clj
+++ test/braid/test/fixtures/db.clj
@@ -3,13 +3,14 @@
    [braid.core.modules :as modules]
    [braid.base.conf :as conf]
    [braid.core.server.db :as db]
+   [datomic.api]
    [mount.core :as mount]))

 (defn drop-db [t]
   (modules/init! modules/default)
   (-> (mount/only #{#'conf/config #'db/conn})
-      (mount/swap {#'conf/config
-                   {:db-url "datomic:mem://chat-test"}})
+      (mount/with-args {:port 0
+                        :db-url "datomic:mem://chat-test"})
       (mount/start))
   (t)
   (datomic.api/delete-database (conf/config :db-url))


Give event registrations an id

Give event registrations an id

Fixes #2

--- src/bukkure/events.clj
+++ src/bukkure/events.clj
@@ -16,16 +16,32 @@
     (do
       (if (:msg response) (plr/send-msg e (:msg response))))))

+(defrecord IdListener
+  [id]
+  org.bukkit.event.Listener)
+
 (defn register-event
   "Registers an event to a plugin

-  example eventnames: player.player-quit for player.PlayerQuit"
-  [plugin eventname f & [priority-key]]
+  example eventnames: player.player-quit for player.PlayerQuit
+
+  id: A unique id for this event. Allows redefining this event."
+  [plugin eventname f {:keys [priority-key id] :as opts}]
   (let [eventclass (resolve (symbol (util/package-classname "org.bukkit.event" (str eventname "-event"))))]
+    (when id
+      (doseq [listener
+              (->> (org.bukkit.event.HandlerList/getRegisteredListeners plugin)
+                   (map (memfn getListener))
+                   (filter #(and
+                              (instance? IdListener %)
+                              (= id (:id %)))))]
+        (org.bukkit.event.HandlerList/unregisterAll listener)))
     (.registerEvent
       (bk/plugin-manager)
       eventclass
-      (proxy [org.bukkit.event.Listener] [])
+      (if id
+        (map->IdListener {:id id})
+        (proxy [org.bukkit.event.Listener] []))
       (get priorities (or priority-key :normal))
       (proxy [org.bukkit.plugin.EventExecutor] []
         (execute [l e] (handle-event f e)))


Remove bytes ns because is not not used.

--- src/bytebuf/bytes.cljx
+++ src/bytebuf/bytes.cljx
@@ -1,50 +0,0 @@
-(ns bytebuf.bytes
-  #+clj
-  (:import java.util.Arrays
-           java.security.SecureRandom))
-
-#+clj
-(defn random-bytes
-  "Generate a byte array of scpecified length with random
-  bytes taken from secure random number generator.
-  This method should be used for generate a random
-  iv/salt or arbitrary length."
-  ([^long numbytes]
-   (random-bytes numbytes (SecureRandom.)))
-  ([^long numbytes ^SecureRandom sr]
-   (let [buffer (byte-array numbytes)]
-     (.nextBytes sr buffer)
-     buffer)))
-
-#+clj
-(defn slice
-  "Given a byte array, get a copy of it. If offset
-  and limit is provided, a slice will be returned."
-  [^bytes input ^long offset ^long limit]
-  (Arrays/copyOfRange input offset limit))
-
-#+clj
-(defn equals?
-  "Check if two byte arrays are equals."
-  [^bytes a ^bytes b]
-  (Arrays/equals a b))
-
-#+clj
-(defn zeropad!
-  "Add zero byte padding to the given byte array
-  to the remaining bytes after specified data length."
-  [^bytes input ^long datalength]
-  (Arrays/fill input datalength (count input) (byte 0)))
-
-(defn zeropad-count
-  "Given a byte array, returns a number of bytes
-  allocated with zero padding (zero byte)."
-  [input]
-  (let [mark (byte 0)]
-    (reduce (fn [sum index]
-              (let [value (aget input index)]
-                (if (= value mark)
-                  (inc sum)
-                  (reduced sum))))
-            0
-            (reverse (range (count input))))))


fix comment

fix comment

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -116,15 +116,19 @@
                           filename (trim (first all-lines))]
                       (if (some matching-line-in? changes) filename)))))))

-;; NEED NEW COMMENT HERE
+;; If the object under investigation is a uri, and if it already ends with the
+;; given filename (e.g. when the object names a file) as the absolute pathname.
+;; Otherwise (e.g. when the object names a directory), append the filename to
+;; the object to form the absolute pathname. If the object is a filesystem name,
+;; just use the filename. Construct versioned pathnames and svn diff them.

 (defn svndiff [r1 r2 filename object show]
   (let [object (baseobject object)
-        r (re-pattern (str "^.*/" filename "$"))
-        p (if (uri? object)
-            (if (re-matches r object) object (str object "/" filename))
+        re (re-pattern (str "^.*/" filename "$"))
+        abs-path (if (uri? object)
+            (if (re-matches re object) object (str object "/" filename))
             filename)
-        v (vpaths r1 r2 p object)
+        v (vpaths r1 r2 abs-path object)
         cmd-components ["svn" "diff" (first v) (second v)]]
     (if show (show-cmd cmd-components))
     (apply sh cmd-components)))


Select task.

Select task.

--- src/onyx/log/commands/volunteer_for_task.clj
+++ src/onyx/log/commands/volunteer_for_task.clj
@@ -34,6 +34,33 @@
          (sort-by :n)
          (first)
          :task)))
+
+(defn highest-pct-task [replica job tasks]
+  (->> tasks
+       (sort-by #(get-in replica [:task-percentages job %]))
+       (reverse)
+       (first)))
+
+(defn task-needing-pct-peers [replica job tasks]
+  (let [allocations (get-in replica [:allocations job])
+        total-allocated (apply concat (vals allocations))]
+    (reduce
+     (fn [_ t]
+       (let [pct (get-in replica [:task-percentages job t])
+             allocated (get allocations t)
+             required (int (Math/floor (* total-allocated (* 0.01 pct))))]
+         (when (< (count allocated) required)
+           (reduced t))))
+     nil
+     tasks)))
+
+(defmethod select-task :onyx.task-scheduler/percentage
+  [replica job]
+  (let [candidates (->> (get-in replica [:tasks job])
+                        (incomplete-tasks replica job)
+                        (common/active-tasks-only replica))]
+    (or (task-needing-pct-peers replica job candidates)
+        (highest-pct-task replica job candidates))))

 (defmethod select-task :default
   [replica job]


clearing meta

clearing meta

--- src/celestial/jobs.clj
+++ src/celestial/jobs.clj
@@ -75,11 +75,3 @@
       (debug "shutting down" k w)
       (mq/stop w))))

-(defn queue-metadata "Returns given queue's current metadata."
-  [qname]
-  {:backoff?  (wcar (car/get      (mq/qkey qname "backoff?")))
-   :id-circle (wcar (car/lrange   (mq/qkey qname "id-circle") 0 -1))
-   :messsages (wcar (car/hgetall* (mq/qkey qname "messages")))
-   :recently-done (wcar (car/smembers (mq/qkey qname "recently-done")))
-   :locks     (wcar (car/hgetall* (mq/qkey qname "locks")))})
-


Add prechew data functions

Add prechew data functions

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -152,5 +152,38 @@
                               (load-csv-file table (str dir "/" file) columns))))
           (apply await agents))))))

+(defn- prechew-dimension
+  [dataset slice dimension metrics]
+  (let [group-id {dimension (str "$" (name dimension))}
+        agg-types [:sum :min :max]
+        aggs (for [agg agg-types
+                   metric metrics]
+               {(str (name agg) "_" (name metric))
+                {(str "$" (name agg)) (str "$" (name metric))}})
+        group (apply merge {:_id group-id :count {"$sum" 1}} aggs)
+        project {dimension (str "$_id." (name dimension))
+                 :count "$count"}
+        project-aggs (for [agg agg-types
+                           metric metrics]
+                       {(str (name agg) "_" (name metric))
+                        (str "$" (name agg) "_" (name metric))})
+        project (apply merge project project-aggs)
+        aggregation [{"$group" group} {"$project" project}]
+        query-result (get-aggregation dataset slice aggregation)]
+    query-result))
+
+(defn- prechew-slice
+  [dataset metadata slice]
+  (let [slicedef (get-in metadata [:slices slice])
+        dimensions (:dimensions slicedef)
+        metrics (:metrics slicedef)]
+    (map #(prechew-dimension dataset slice % metrics) dimensions)))
+
+(defn prechew-dataset
+  [dataset]
+  (let [metadata (get-metadata dataset)
+        slices (keys (:slices metadata))]
+    (doall (map #(prechew-slice dataset metadata %) slices))))
+
 ; (ensure-mongo-connection)
 ; (with-out-str (time (load-dataset "county_taxes")))


Add github ribbon

Add github ribbon

--- src-cljs/acha.cljs
+++ src-cljs/acha.cljs
@@ -83,6 +83,11 @@
 (r/defc header [index?]
   (s/html
     [:.header
+      [:a {:href "https://github.com/someteam/acha"}
+        [:img {:style {:position "absolute" :top 0 :right 0 :border 0}
+               :src "https://camo.githubusercontent.com/365986a132ccd6a44c23a9169022c0b5c890c387/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f7265645f6161303030302e706e67"
+               :alt "Fork me on GitHub"
+               :data-canonical-src "https://s3.amazonaws.com/github/ribbons/forkme_right_red_aa0000.png" }]]
       (conj
         (if index?
           [:div.logo {:title "Acha-acha"}]


Add direct link to the Git repo on the profile page

Signed-off-by: Nikita Prokopov <e30bd02d040ee3ea6d38e934b5d58a2670e6022d@gmail.com>

--- src-cljs/acha.cljs
+++ src-cljs/acha.cljs
@@ -216,12 +216,14 @@
 (r/defc repo-profile [repo aches]
   (s/html
     [:.rp.pane
-      [:.rp__name (repo-name (:repo/url repo))
-        [:.id (:db/id repo)]
-        (repo-status repo)]
-      [:.rp__url  (:repo/url repo)]
+      (let [repo-url (:repo/url repo)]
+        (list
+         [:.rp__name (repo-name repo-url)
+          [:.id (:db/id repo)]
+          (repo-status repo)]
+         [:a.rp__url {:href repo-url} repo-url]))
       (when-let [reason (:repo/reason repo)]
-        (list
+        (list
           [:.rp__reason reason]
           [:button.rp__delete {:on-click (fn [_] (delete-repo (:db/id repo))) }]))
       [:.rp__hr]


Extract status from request

Extract status from request

--- src/clj_http/core2.clj
+++ src/clj_http/core2.clj
@@ -16,7 +16,7 @@
            (org.apache.http.conn.ssl BrowserCompatHostnameVerifier
                                      SSLConnectionSocketFactory SSLContexts)
            (org.apache.http.conn.socket PlainConnectionSocketFactory)
-           (org.apache.http.impl.client HttpClients)
+           (org.apache.http.impl.client BasicCredentialsProvider HttpClients)
            (org.apache.http.impl.conn PoolingHttpClientConnectionManager)))

 (defn http-route []
@@ -50,17 +50,23 @@
 (defn http-context []
   (HttpClientContext/create))

+(defn credentials-provider []
+  (BasicCredentialsProvider.))
+
 (defn request [{:keys [cookie-store] :as req}]
   (let [conn-mgr (pooling-conn-mgr)
         client (http-client conn-mgr)
         context (http-context)
         get-req (http-get)
         response (.execute client get-req context)
-        entity (.getEntity response)]
+        entity (.getEntity response)
+        status (.getStatusLine response)]
+    (when cookie-store
+      (.setCookieStore context cookie-store))
     ;; TODO response, conn-mgr, and client needs to be closed
     {:body (.getContent entity)
      :length (.getContentLength entity)
      :chunked? (.isChunked entity)
      :repeatable? (.isRepeatable entity)
      :streaming? (.isStreaming entity)
-     :status 200}))
+     :status (.getStatusCode status)}))


removes unused stuff

removes unused stuff

--- src/cljs/moon/dom.cljs
+++ src/cljs/moon/dom.cljs
@@ -18,11 +18,3 @@
 (defn html [el]
   (. el -innerHTML))

-(defn toggle [btn]
-  (let [v (keyword (clojure.string/lower-case (html btn)))]
-    (set-html! btn (if (= :start v) "Stop" "Start"))
-    v))
-
-(defn update-status [id sofar]
-  (set-html! (by-id id) (str sofar))
-  sofar)


Update core.cljc

Update core.cljc

--- src/compound/core.cljc
+++ src/compound/core.cljc
@@ -5,8 +5,8 @@

 (defmulti secondary-index-def->behaviour :compound.secondary-index/type)

-(def secondary-index-def->behaviour-memoized (memoize secondary-index-def->behaviour)
-  )
+(def secondary-index-def->behaviour-memoized (memoize secondary-index-def->behaviour))
+
 (defn secondary-indexes-by-id [compound]
   (get compound :compound/secondary-indexes-by-id))


make basic font

make basic font

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -33,6 +33,9 @@
                ;(log "frame")
                ((:render-fn canvas)))))

+(defonce fonts
+  [(font/install-google-font-stylesheet! "http://fonts.googleapis.com/css?family=Indie+Flower")])
+
 (defn on-js-reload []
   ;; optionally touch your app-state to force rerendering depending on
   ;; your application
@@ -50,6 +53,11 @@
                           :z (+ depth (rand))
                           :depth depth})) (range num-stars))))

+(defonce font-inconsolata (font/make-tiled-font "Indie Flower" 100 10))
+(defonce dummy-text (font/make-text "100 10px Indie Flower"
+                                    "DUMMY"
+                                    :weight 100
+                                    :fill "#ffffff"))
 (defn main []
   (go
     (<! (resources/load-resources


Adding constrainted vars and atoms

Adding constrainted vars and atoms

--- src/trammel/core.clj
+++ src/trammel/core.clj
@@ -13,9 +13,9 @@

 (ns trammel.core
   "The core contracts programming functions and macros for Trammel."
-  (:use [trammel.funcify :only (funcify)])
-  (:use trammel.factors)
-  (:use trammel.utils)
+  (:use [trammel.funcify :only (funcify)]
+        [trammel.factors]
+        [trammel.utils])
   (:require [fogus.thneed.utils :as fogus]))

 ;; HOF support
@@ -291,7 +291,50 @@
               (~ctor-name ~@fields))))
        ~name)))

+(defmacro defconstrainedvar
+  [name init inv-description invariants]
+  `(do
+     (def ~name ~init)
+     (set-validator! (var ~name) (partial (contract ~(symbol (str "chk-" name))
+                                            ~inv-description
+                                            [~name]
+                                            ~invariants)
+                                          (fn [x#] true)))))
+
+(defmacro constrained-atom
+  [init inv-description invariants]
+  `(do
+     (let [r# (atom ~init)]
+       (set-validator! r# (partial (contract ~(symbol (str "chk-atom" ))
+                                     ~inv-description
+                                     [the-atom#]
+                                     ~invariants)
+                                   (fn [x#] true)))
+       r#)))
+
+
 (comment
+  (def a (constrained-atom 0
+           "only numbers allowed"
+           [number?]))
+
+  @a
+
+  (swap! a str)
+  (compare-and-set! a 0 "a")
+
+  (defconstrainedvar ^:dynamic foo 0
+    "only numbers allowed in Var foo"
+    [number?])
+
+  (macroexpand '(defconstrainedvar ^:dynamic foo 0
+    "only numbers allowed"
+    [number?]))
+
+  (var-set (var foo) 42)
+
+  (binding [foo :a] [foo])
+
   (use 'trammel.factors)

   (defconstrainedfn leap-year?


add docstring

add docstring

--- src/useful/utils.clj
+++ src/useful/utils.clj
@@ -80,7 +80,10 @@

         :else right))

-(defn pop-if [stack pred? & [default]]
+(defn pop-if
+  "Pop item off the given stack if (pred? item) returns true, returning both the item and the
+  modified stack. If (pred? item) is false, return nil or the optional default value."
+  [stack pred? & [default]]
   (let [[peek pop] (if (instance? clojure.lang.IPersistentStack stack)
                      [peek pop]
                      [first rest])


Fixed NPE that occurs when multipart form text parameter is nil

--- ring-core/src/ring/middleware/multipart_params.clj
+++ ring-core/src/ring/middleware/multipart_params.clj
@@ -49,7 +49,7 @@
       (assoc-param param-map
         (.getFieldName item)
         (if (.isFormField item)
-          (.getString item)
+          (if (.get item) (.getString item))
           (file-map item))))
     {}
     (.parseRequest


Removed commented out code.

Removed commented out code.

--- src/vertigo/core.clj
+++ src/vertigo/core.clj
@@ -5,25 +5,6 @@
             [vertigo.batch :as batch]
             [appengine-magic.core :as ae])
   (:use     [compojure.core]))
-
-;(defrecord Movie [id
-;                 title
-;                 theatre
-;                 genres
-;                 image])
-;
-;(defn retrieve-all-distinct-event-ids-for-stored-shows []
-;  (distinct (map
-;              :event-id
-;              (flatten
-;                (for [{shows :shows-by-genre}
-;                        (apply-on-whole-week retrieve-shows-by-date)]
-;                  (vals shows))))))
-;
-;(defn retrieve-all-events-for-stored-shows []
-;  (map
-;    retrieve-event
-;    (retrieve-all-distinct-event-ids-for-stored-shows)))

 (defroutes handler
   (GET "/movies" []


fixed socket io

fixed socket io

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -4,7 +4,8 @@

 (defonce room-id (.getAttribute (. js/document (getElementById "roomid")) "data"))
 (defonce room (str "room:" room-id))
-(defonce socket (js/io "http://localhost:3001"))
+;(defonce socket (js/io (str "[" (.getAttribute (. js/document (getElementById "address")) "data") "]" ":3001")))
+(defonce socket (js/io))
 (defonce app-state (atom {:users []
                           :messages []}))


Work in progress to fix top level choose

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

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -294,32 +294,42 @@
                              henpt-irks (:irks henpt)
                              caller_ (get-in ir henpt-irks)
                              caller-pclass (first henpt-irks)]
-                         (dbg-println :trace "RPC name" name "method-arg"
-                                      method-arg "pclass-arg" pclass-arg)
+                         (dbg-println :trace "RPC name" name
+                           "method-arg" method-arg
+                           "pclass-arg" pclass-arg
+                           ;; "caller_" caller_
+                           "henpt-irks" henpt-irks
+                           "IR pclass :args" (get-in ir [pclass :args]))
                          (or method-arg pclass-arg
                              (if (= (:type caller_) :plant-fn-field)
                                (get-in ir [caller-pclass :fields (:field caller_) :initial]))
                              (if (= name 'this)
-                               ;;Use the ancestry-path to resolve the pclass of the caller
-                               (let [[_ parent-subtask_ parent-hem parent-henpt] ancestry-path
-                                     parent-hem-pclass (get-in parent-hem [:irks 0])
-                                     _ (dbg-println :debug "RPC Recursing on ancestry-path"
-                                         (mapv #(list (:uid %) (or (:label %) (:name %)))
-                                           ancestry-path))
-                                     _ (dbg-println :debug "parent-hem-pclass" parent-hem-pclass)
-                                     pc_ (resolve-plant-class
-                                           ir parent-hem-pclass pargs parent-henpt parent-subtask_)
-
-                                     ]
-                                 ;; (dbg-println :debug "RPC this"
-                                 ;;              (with-out-str (pprint ancestry-path)))
-                                 ;; (dbg-println :debug "RPC parent-hem"
-                                 ;;              (with-out-str (pprint parent-hem))
-                                 ;;              "\nparent-henpt"
-                                 ;;              (with-out-str (pprint parent-henpt)))
-                                 _ (dbg-println :debug "RPC Recursion result" pc_)
-                                 pc_
-                                 ))
+                               (if (and (not henpt-irks)
+                                     (empty? (get-in ir [pclass :args])))
+                                 ;; here we assume we need to initialize this
+                                 ;; zero argument plant
+                                 {:type :pclass-ctor,
+                                  :pclass pclass,
+                                  :args []}
+                                 ;; else use the ancestry-path to
+                                 ;; resolve the pclass of the caller
+                                 (let [[_ parent-subtask_ parent-hem parent-henpt] ancestry-path
+                                       parent-hem-pclass (get-in parent-hem [:irks 0])
+                                       _ (dbg-println :debug "RPC Recursing on ancestry-path"
+                                           (mapv #(list (:uid %) (or (:label %) (:name %)))
+                                             ancestry-path))
+                                       _ (dbg-println :debug "parent-hem-pclass" parent-hem-pclass)
+                                       pc_ (resolve-plant-class
+                                             ir parent-hem-pclass pargs parent-henpt parent-subtask_)]
+                                   ;; (dbg-println :debug "RPC this"
+                                   ;;              (with-out-str (pprint ancestry-path)))
+                                   ;; (dbg-println :debug "RPC parent-hem"
+                                   ;;              (with-out-str (pprint parent-hem))
+                                   ;;              "\nparent-henpt"
+                                   ;;              (with-out-str (pprint parent-henpt)))
+                                   _ (dbg-println :debug "RPC Recursion result" pc_)
+                                   pc_
+                                   )))
                              {:error :unresolved-pclass-ctor}))

                        (= type :delay)
@@ -1224,7 +1234,10 @@
           (if mname ;; else (dbg-println :debug "no more methods")
             (let [{:keys [temporal-constraints args primitive display-name body]} method]
               (dbg-println :info "  METHOD" mname "PRIMITIVE" primitive "ARGS" args)
-              (if (and (not primitive) body)
+              (when (and (not primitive) body)
+                (if (and (= 1 (count body)) (= :choose (get-in body [0 :type])))
+                  (dbg-println :info "  TOP LEVEL CHOOSE!")
+                  )
                 (make-htn-methods ir pargs true pclass-name mname display-name args body))
               )))))))

@@ -1574,8 +1587,21 @@
                      :irks)
              :incidence-set #{}
              :edges #{})
-        end (tpn/tpn-state {})
-        begin (tpn/tpn-state {:end-node (:uid end)})]
+        _ (dbg-println :debug "ERT" ert
+            "\nTASK-EXPANSIONS (" (count task-expansions)
+            ") = "
+            ;; (with-out-str (pprint task-expansions)
+            (mapv :label task-expansions)
+            )
+        top-level-choose? (> (count task-expansions) 1)
+        end ((if top-level-choose?
+               tpn/tpn-c-end
+               tpn/tpn-state)
+             {})
+        begin ((if top-level-choose?
+                 tpn/tpn-c-begin
+                 tpn/tpn-state)
+               {:end-node (:uid end)})]
     (update-htn-plan-map! ert)
     (update-htn-plan-map! net)
     (swap! *htn-plan-map* assoc :network (:uid net)) ;; ENTRY POINT
@@ -1816,7 +1842,8 @@
                                             :nonprimitive-task nonprimitive-task
                                             :subtasks subtasks
                                             :subtask-constraints subtask-constraints
-                                            :irks irks-choice})]
+                                            :irks irks-choice
+                                            :order i})]
                     (recur (conj methods method) (inc i))))))

             :else


Tweak resolution and centering keyword.

Tweak resolution and centering keyword.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -397,7 +397,7 @@
         midpoint (/ (- highest lowest) 2)
         scaled (int (* 2 width (/ (- value lowest) range)))
         filler (repeat (:fader-empty special-symbols))
-        centered (< (math/abs (- (- value lowest) midpoint)) (/ range 200))
+        centered (< (math/abs (- (- value lowest) midpoint)) (/ range 256))
         marker ((if (and centered (odd? width))
                   :fader-center
                   (if (even? scaled) :fader-left :fader-right))
@@ -1319,7 +1319,7 @@
   (let [value (find-cue-variable-value controller cue v)
         low (min value (:min v))  ; In case user set "out of bounds".
         high (max value (:max v))
-        gauge (if (:pan v)
+        gauge (if (:centered v)
                 (make-pan-gauge value :lowest low :highest high :width width)
                 (make-gauge value :lowest low :highest high :width width))]
     (write-display-text controller 0 (+ offset (* cell 17)) gauge)))


Remove reflection in Jetty adapter

Remove reflection in Jetty adapter

--- ring-jetty-adapter/src/ring/adapter/jetty.clj
+++ ring-jetty-adapter/src/ring/adapter/jetty.clj
@@ -29,7 +29,7 @@

 (defn- ^AbstractHandler async-proxy-handler [handler]
   (proxy [AbstractHandler] []
-    (handle [_ ^Request base-request request ^HttpServletResponse response]
+    (handle [_ ^Request base-request ^HttpServletRequest request ^HttpServletResponse response]
       (let [^AsyncContext context (.startAsync request)]
         (handler
          (servlet/build-request-map request)
@@ -40,7 +40,7 @@
            (.complete context)))
         (.setHandled base-request true)))))

-(defn- ^ServerConnector server-connector [server & factories]
+(defn- ^ServerConnector server-connector [^Server server & factories]
   (ServerConnector. server (into-array ConnectionFactory factories)))

 (defn- ^HttpConfiguration http-config [options]


(PDB-908) Fix race condition with until-consumed startup

Somehow ActiveMQ was up, the ActiveMQ MBeans were up, PuppetDB was
up (along with the discarded message MBean) but the MBean we use to ge
metadata about the queue was not yet up. This patch now checks for all
three things to be up before until-consumed proceeds.

--- test/puppetlabs/puppetdb/testutils/jetty.clj
+++ test/puppetlabs/puppetdb/testutils/jetty.clj
@@ -112,13 +112,22 @@

 (def max-attempts 50)

+(defn command-mbean-name
+  "The full mbean name of the MQ destination used for commands"
+  [base-url]
+  (str "org.apache.activemq:BrokerName="
+       (url-encode (:host base-url))
+       ",Type=Queue,Destination="
+       mq-endpoint))
+
 (defn mq-mbeans-found?
   "Returns true if the ActiveMQ mbeans and the discarded command
   mbeans are found in `mbean-map`"
   [mbean-map]
   (let [mbean-names (map utils/kwd->str (keys mbean-map))]
     (and (some #(.startsWith % "org.apache.activemq") mbean-names)
-         (some #(.startsWith % "puppetlabs.puppetdb.command") mbean-names))))
+         (some #(.startsWith % "puppetlabs.puppetdb.command") mbean-names)
+         (some #(.startsWith % (command-mbean-name *base-url*)) mbean-names))))

 (defn metrics-up?
   "Returns true if the metrics endpoint (and associated jmx beans) are
@@ -161,10 +170,8 @@
   ;; for queue metrics fails, this check ensures it's started
   (let [base-metrics-url (assoc *base-url* :prefix "/metrics" :version :v1)]
     (-> (str (utils/base-url->str base-metrics-url)
-             "/mbeans/org.apache.activemq:BrokerName="
-             (url-encode (:host base-metrics-url))
-             ",Type=Queue,Destination="
-             mq-endpoint)
+             "/mbeans/"
+             (command-mbean-name base-metrics-url))
         (client/get {:as :json})
         :body)))


working on deep trace

working on deep trace

--- src/com/billpiel/mem_tracer/util/other.clj
+++ src/com/billpiel/mem_tracer/util/other.clj
@@ -225,20 +225,32 @@
              [])
          noob)))

-(defn swap-in-path-syms
-  [form & [path]]
+(defn swap-in-path-syms*
+  [form func & [path]]
   (cond
     (special-operator? form) form
     (coll? form)  (back-into form
-                             (doall (map-indexed #(swap-in-path-syms %2
-                                                                     (conj (or (not-empty path)
-                                                                               [])
-                                                                           %))
+                             (doall (map-indexed #(swap-in-path-syms* %2
+                                                                      func
+                                                                      (conj (or (not-empty path)
+                                                                                [])
+                                                                            %))
                                                  form)))
-    :else (symbol (apply str
-                         "$"
-                         (clojure.string/join "-"
-                                              path)))))
+    :else (func (symbol (apply str
+                               "$"
+                               (clojure.string/join "-"
+                                                    path)))
+                form
+                path)))
+
+(defn swap-in-path-syms
+  ([form func]
+   (swap-in-path-syms* form
+                       func))
+  ([form]
+   (swap-in-path-syms* form
+                       #(first %&))))
+

 (defn deep-zipmap-no-colls
        [a b]
@@ -265,8 +277,8 @@
 (defn get-path->form-maps
   [src]
   (let [sx-seq (->> src
-                    (tree-seq list? seq)
-                    (filter list?))
+                    (tree-seq coll? seq)
+                    (filter coll?))
         pair-fn (fn [form]
                   (interleave (seq  form)
                               (repeat form)))]
@@ -295,8 +307,8 @@
     (let [xls (->> src
                    clojure.walk/macroexpand-all
                    swap-in-path-syms
-                   (tree-seq list? seq)
-                   (remove list?))
+                   (tree-seq coll? seq)
+                   )
           xloc->oloc (deep-zipmap (-> src clojure.walk/macroexpand-all swap-in-path-syms)
                                   (-> src swap-in-path-syms clojure.walk/macroexpand-all))
           oloc->xloc (clojure.set/map-invert xloc->oloc)


(PDB-130) Fixes a nasty traceback exposed when users run import from command line with an invalid filename. A friendly message is now printed instead.

--- src/com/puppetlabs/puppetdb/cli/import.clj
+++ src/com/puppetlabs/puppetdb/cli/import.clj
@@ -1,6 +1,6 @@
 ;; ## Import utility
 ;;
-;; This is a command-line tool for importing data into PuppetDB.  It expects
+;; This is a command-line tool for importing data into PuppetDB. It expects
 ;; as input a tarball generated by the PuppetDB `export` command-line tool.

 (ns com.puppetlabs.puppetdb.cli.import
@@ -22,13 +22,23 @@

 (def cli-description "Import PuppetDB catalog data from a backup file")

+(defn check-import
+  "Checks for the existence of a file. If filename exists, does nothing.
+  If filename does not exist print a message and execute f"
+  [filename f]
+  (if (fs/exists? filename)
+    true
+    (do
+      (println (format "Import from %s failed. File not found." filename))
+      (f))))
+
 (defn parse-metadata
   "Parses the export metadata file to determine, e.g., what versions of the
   commands should be used during import."
   [tarball]
-  {:pre  [(fs/exists? tarball)]
-   :post [(map? %)
+  {:post [(map? %)
           (contains? % :command-versions)]}
+  (check-import tarball #(System/exit 0))
   (let [metadata-path (.getPath (io/file export-root-dir export-metadata-file-name))]
     (with-open [tar-reader (archive/tarball-reader tarball)]
       (when-not (archive/find-entry tar-reader metadata-path)
@@ -105,7 +115,7 @@
     (when (re-find (re-pattern catalog-pattern) path)
       (println (format "Importing catalog from archive entry '%s'" path))
       ;; NOTE: these submissions are async and we have no guarantee that they
-      ;;   will succeed.  We might want to add something at the end of the import
+      ;;   will succeed. We might want to add something at the end of the import
       ;;   that polls puppetdb until the command queue is empty, then does a
       ;;   query to the /nodes endpoint and shows the set difference between
       ;;   the list of nodes that we submitted and the output of that query


Clean fulcro network parser

Clean fulcro network parser

--- src/com/wsscode/pathom/fulcro/network.cljs
+++ src/com/wsscode/pathom/fulcro/network.cljs
@@ -116,18 +116,9 @@
     (->> (filter #(garray/equals (gobj/get % "path") js-path) graphql-errors)
          (p/join-seq env))))

-(def parser (fp/parser {:read p/pathom-read :mutate mutation}))
-
-(defn parse [env tx]
-  (parser
-    (merge {::p/js-key-transform js-name
-            ::p/reader           [pa/js-obj-reader gql-ident-reader]}
-           env)
-    tx))
-
-(def parser'
+(def parser
   (p/parser {::p/plugins [(p/env-plugin {::p/js-key-transform js-name
-                                         ::p/reader           [pa/js-obj-reader gql-ident-reader]})
+                                         ::p/reader           [gql-ident-reader pa/js-obj-reader]})
                           pa/async-plugin]
              :mutate     mutation}))

@@ -183,7 +174,7 @@
           data   (gobj/get json "data")]
       (-> (gql-process-env {::p/entity       data
                             ::graphql-errors errors})
-          (parser' q) <?
+          (parser q) <?
           (cond-> errors (assoc ::graphql-errors (js->clj errors :keywordize-keys true)))
           (lift-tempids)))))


add update-http-request to graphql-network

--- src/com/wsscode/pathom/fulcro/network.cljs
+++ src/com/wsscode/pathom/fulcro/network.cljs
@@ -190,7 +190,7 @@
 (defn graphql-network
       ([url]
         (graphql-network url {}))
-      ([url options]
+      ([url {update-http-request ::update-http-request}]
         (fn-network
           (fn [this edn ok error]
               (go
@@ -200,12 +200,12 @@
                                 (p/elide-ast-nodes #{::pp/profile})
                                 p/ast->query)
                         query (pg/query->graphql edn {::pg/js-name (comp pg/camel-case name)})
-                        response (<? (fetch/request-async (merge
-                                                            {::http/url         url
-                                                             ::http/method      ::http/post
-                                                             ::http/as          ::http/json
-                                                             ::http/form-params {:query query}}
-                                                            options)))
+                        response (<? (fetch/request-async
+                                       (cond-> {::http/url         url
+                                                ::http/method      ::http/post
+                                                ::http/as          ::http/json
+                                                ::http/form-params {:query query}}
+                                               update-http-request update-http-request)))
                         {:keys [data errors]} (::http/body response)]
                        (ok (graphql-response-parser {::p/entity data} edn)))
                   (catch :default e


more ibm wierdness

more ibm wierdness

--- dada-core/src/test/clojure/org/dada/core/test_clojure.clj
+++ dada-core/src/test/clojure/org/dada/core/test_clojure.clj
@@ -85,10 +85,11 @@
       (is (faster 1000000000 (.v r) (aget a 0))))))

 ;; no it's not autoboxing slowing down the int-array test - array access is slower than record access - by a factor of 10
-(deftest record-vs-object-array-access
-  (let [^Value r (Value. 0)
-	^objects a (object-array [0])]
-    (is (faster 1000000000 (.v r) (aget a 0)))))
+(if (not (ibm?))
+  (deftest record-vs-object-array-access
+    (let [^Value r (Value. 0)
+	  ^objects a (object-array [0])]
+      (is (faster 1000000000 (.v r) (aget a 0))))))

 (defrecord Foo (^int a))
 (defrecord Bar (^Integer a))


allow injection of initial rhs map, so e.g. sorted map can be used

--- dada2-core/src/test/clojure/org/dada2/test_join_model.clj
+++ dada2-core/src/test/clojure/org/dada2/test_join_model.clj
@@ -85,7 +85,10 @@

 (defn- rhses-get [rhs-indeces lhs-fk-keys lhs]
   "return a lazy seq of seqs of rhses for a given seq of fk-key functions"
-  (map (fn [[_ rhs-index] lhs-fk-key] (vals (rhs-index (lhs-fk-key lhs)))) rhs-indeces lhs-fk-keys))
+  (map (fn [[_ rhs-index] lhs-fk-key] (vals
+                                       ;; TODO - following get should be lookup-fn
+                                       (get rhs-index (lhs-fk-key lhs))
+                                       )) rhs-indeces lhs-fk-keys))

 (defn- rhs-assoc [rhs-indeces i rhs-pk-key fk rhs]
   "associate a new rhs with indeces"
@@ -279,19 +282,23 @@
 ;;; attempt to [re]join it to the lhs and vice versa.
 (defn- join-views [join-fn join-pk [lhs-model lhs-pk-key lhs-fk-keys joined-model] & rhses]
   (let [rhs-count (count rhses)
-	indeces (atom [(lhs-init rhs-count) (rhs-init rhs-count) (join-init rhs-count)])]
+        ;; need 2 pass initialisation
+	indeces (atom [(lhs-init rhs-count)
+                       (mapv (fn [[_ _ _ state]] [{}(or state {})]) rhses) ;; (rhs-init rhs-count)
+                       (join-init rhs-count)])]
     ;; view lhs
     (log2 :info (str " lhs: " lhs-model ", " lhs-fk-keys))
     (attach lhs-model (lhs-view indeces lhs-pk-key lhs-fk-keys join-fn join-pk joined-model))
     ;; view rhses
     (doall
-     (map
-     (fn [[rhs-model rhs-pk-key rhs-fk-key] i]
-       (log2 :info (str " rhs: " rhs-model ", " i ", " rhs-fk-key))
-       ;; view rhs model
-       (attach rhs-model (rhs-view indeces i rhs-pk-key rhs-fk-key lhs-fk-keys join-fn join-pk joined-model))    )
-     rhses
-     (range)))
+     (mapv
+      (fn [[rhs-model rhs-pk-key rhs-fk-key rhs-initial-state] i]
+        (log2 :info (str " rhs: " rhs-model ", " i ", " rhs-fk-key))
+        ;; view rhs model
+        (attach rhs-model (rhs-view indeces i rhs-pk-key rhs-fk-key lhs-fk-keys join-fn join-pk joined-model))
+        [{} (or rhs-initial-state {})])
+      rhses
+      (range)))
     indeces))

 (deftype JoinModel [^String name ^Atom state ^Atom views]


Fix bug with .atEndOfMonth()

Fix bug with .atEndOfMonth()

--- src/java_time/data.clj
+++ src/java_time/data.clj
@@ -68,7 +68,7 @@

         {`p/nav (fn [_ k v]
                   (case k
-                    :instant (-> (.atEndOfMonth ym)
+                    :instant (-> (.atDay ym 1)
                                  (.atStartOfDay)
                                  (.toInstant (or (zone-offset v) @system-offset)))
                     :format (.format (dt-formatter (or v "yyyy-MM")) ym)


unify zone conversion costs

unify zone conversion costs

--- src/java_time/zone.clj
+++ src/java_time/zone.clj
@@ -207,7 +207,7 @@
 (conversion! CharSequence ZonedDateTime
   (fn [^CharSequence s]
     (ZonedDateTime/parse s))
-  3)
+  2)

 (conversion! CharSequence OffsetDateTime
   (fn [^CharSequence s]
@@ -217,17 +217,17 @@
 (conversion! CharSequence OffsetTime
   (fn [^CharSequence s]
     (OffsetTime/parse s))
- 2)
+  2)

 (conversion! ZoneOffset OffsetDateTime
   (fn [^ZoneOffset zo]
-    (.withOffsetSameLocal (OffsetDateTime/now) zo))
-  4)
+    (.withOffsetSameLocal (offset-date-time) zo))
+  2)

 (conversion! ZoneOffset OffsetTime
   (fn [^ZoneOffset zo]
-    (.withOffsetSameLocal (OffsetTime/now) zo))
-  4)
+    (.withOffsetSameLocal (offset-time) zo))
+  2)

 (conversion! ZonedDateTime [Instant ZoneId]
   (fn [^ZonedDateTime zdt]


Repair the "cannot edit contact" error.

Repair the "cannot edit contact" error.

Change the code to repair the error that results in *not* being able to
edit the contact field. This change involves adding a function to handle
all changes to the contact field. This handler sets the state of the
contact field (tagged by `:text` in the app-state) to the *new* value of
the (contact) input field. Setting the app-state results in Om/React
re-rendering the input field with the changed value of the contact.
(Note that this mechanism is the same mechanism described by Martin
Fowler in, I believe, "Patterns of Enterprise Architecture," to describe
how to correctly synchronize models and views.)

--- basic/om-tut/src/om_tut/core.cljs
+++ basic/om-tut/src/om_tut/core.cljs
@@ -54,6 +54,16 @@
               (dom/span nil (display-name contact))
               (dom/button #js {:onClick (fn [e] (put! delete @contact))} "Delete")))))

+(defn handle-change [e owner state]
+  "Handle changes to the component."
+  ;; Sets the state of the :text value of app state to the specified value.
+  ;; Remember that `(.. e -target -value)` expands to `(.-value (.-target e))`; that is, it extracts the value property
+  ;; of the target property of the supplied event (e). When this handler sets the :text value of the app-state Om/React
+  ;; re-renders the view replacing the content of the (context) input field with the new value. (This mechanism seems to
+  ;; be the same mechanism described by Martin Fowler in "Patterns of Enterprise Architecture" to correctly coordinate
+  ;; changes between models and views.)
+  (om/set-state! owner :text (.. e -target -value)))
+
 (defn contacts-view [data owner]
   (reify
     om/IInitState
@@ -77,7 +87,9 @@
                       (om/build-all contact-view (:contacts data)
                                     {:init-state state}))
                (dom/div nil
-                        (dom/input #js {:type "text" :ref "new-contact" :value (:text state)})
+                        (dom/input #js {:type "text" :ref "new-contact" :value (:text state)
+                                        ;; Handle all changes to this component
+                                        :onChange #(handle-change % owner state)})
                         (dom/button #js {:onClick #(add-contact data owner)} "Add contact"))))))

 (om/root contacts-view app-state


using zipper to store paths

using zipper to store paths

--- src/levycurve/core.clj
+++ src/levycurve/core.clj
@@ -2,40 +2,61 @@
   (:gen-class
    :name levycurve.core
    (:import (java.awt.Dimension)
-            (java.lang.Math))
+            (java.lang.Math)
+            )
+   (:require '[clojure.zip :as zip])
    :extends javax.swing.JFrame
    ))
+(def ^:dynamic *path* (zip/vector-zip [[100 250] [400 250]]))
+(def ^:dynamic *matrix* (gen-matrix 45))

-(def low 0) ;Lowest coordinate(y) encountered so far, needed to decide whether to use clockwise or counterclockwise rotation
+
 (defn -main
   "Setup UI components
    Initialize Data Structure"
   [& args]
-  (println "Hello, World!"))
+  )

 (defn reset []
   (.clearRect g 0 0 500 500)
-  (def path1 [(first line)])
-  (def path2 [(second line)])
+  )
+
+(defn do-iteration []
+  (loop [node (zip/next *path*)]
+    (let [p1 (zip/node node)
+          p2 (-> node zip/right zip/node)
+          p3 (gen-coord p1 p2 *matrix*)
+          new (zip/insert-right node p3)
+          [x1 y1 x2 y2 x3 y3] (flatten [p1 p3 p2])
+          ]
+      (.drawLine g x1 y1 x2 y2)
+      (.drawLine g x2 y2 x3 y3)
+      (if (-> node zip/right zip/right)
+        (recur (-> new zip/right zip/right))
+        (def ^:dynamic *path* (zip/vector-zip (zip/root new)))
+        )
+      )
+    )
   )

-(defn do-iteration []
-  (let [draw (fn [p1 p2]
-                 (let [[x1 y1] (flatten p1)
-                       [x2 y2] (flatten p2)
-                       [x3 y3] (flatten (gen-coord p1 p2 matrix))
-                       ]
-                   (.drawLine g x1 y1 x3 y3)
-                   (.drawLine g x2 y2 x3 y3)
-                   [x3 y3]
-                   ))
-             result (pmap draw path1 path2)
-        ]
-    (def res result)
-    (def path1 (vec (concat path1 path2)))
-    (def path2 (vec (concat result result)))
-    ))
+;; (defn do-iteration []
+;;   (let [draw (fn [p1 p2]
+;;                  (let [[x1 y1] (flatten p1)
+;;                        [x2 y2] (flatten p2)
+;;                        [x3 y3] (flatten (gen-coord p1 p2 matrix))
+;;                        ]
+;;                    (.drawLine g x1 y1 x3 y3)
+;;                    (.drawLine g x2 y2 x3 y3)
+;;                    [x3 y3]
+;;                    ))
+;;              result (pmap draw path1 path2)
+;;         ]
+;;     (def res result)
+;;     (def low 0)
+;;     (def path1 (vec (concat path1 path2)))
+;;     (def path2 (vec (concat result result)))
+;;     ))

 (defn gen-matrix [theta]
   "Generates a matrix using the given rotation angle used to generate a new coordinate point
@@ -59,26 +80,16 @@
 (defn gen-coord [p1 p2 matrix]
   "Generates a new coordinate given two coordinates and a transformation matrix
    e.g. (gen-coord [100 250] [400 250] [[a b] [c d]])"
-  (let [[x1 y1 x2 y2] (flatten
-                       (cond
-                        (> (first p1) (first p2))
-                        [p2 p1]
-                        (and (= (first p1) (first p2))
-                             (< (second p1) low))
-                        [p2 p1]
-                        :else [p1 p2]
-                        ))
-        ;[x1 y1] p1
-        ;[x2 y2] p2
-        x (Math/abs (- x2 x1))
-        y (Math/abs (- y2 y1)) ; Line relative to origin (0,0)
+  (let [
+        [x1 y1] p1
+        [x2 y2] p2
+        x (- x2 x1)
+        y (- y2 y1) ; Line relative to origin (0,0)
         apply-matrix (fn [x y matrix]
                        (let [[a1 a2 a3 a4] (flatten matrix)]
                          [(+ (* x a1) (* y a2))
                           (+ (* x a3) (* y a4))]))
         [x y] (apply-matrix x y matrix)]
-
-    (def low (max low (+ y y1)))
     [(+ x x1) (+ y y1)]
     )
   )


Added the not-adder

Added the not-adder

--- src/leiningen/new/cljs_test/core_test.cljs
+++ src/leiningen/new/cljs_test/core_test.cljs
@@ -8,4 +8,4 @@
   (testing "Does the adder add?"
     (is (= 5 (core/adder 2 3))))
   (testing "and the not-adder?"
-    (is (not (= 5 (core/adder 2 3))))))
+    (is (not (= 5 (core/not-adder 2 3))))))


rename advance to tick-resolution. fixes #72

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -617,9 +617,9 @@
   #?(:clj String :cljs string)
   (clock [s] (p/clock (p/parse s))))

-(defn advance
+(defn tick-resolution
   ([clk]
-   (advance clk (new-duration 1 :seconds)))
+   (tick-resolution clk (new-duration 1 :seconds)))
   ([clk dur]
    (cljc.java-time.clock/tick clk dur)))


Default *clock* to a system clock

Default *clock* to a system clock

There is no real benefit to this being nil

Fixes #119

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -48,17 +48,13 @@

 (modify-printing-of-time-literals-if-enabled!)

-(def ^{:dynamic true} *clock* nil)
+(def ^{:dynamic true} *clock* (cljc.java-time.clock/system-default-zone))

 (defn now []
-  (if *clock*
-    (cljc.java-time.instant/now *clock*)
-    (cljc.java-time.instant/now)))
+  (cljc.java-time.instant/now *clock*))

 (defn today []
-  (if *clock*
-    (cljc.java-time.local-date/now *clock*)
-    (cljc.java-time.local-date/now)))
+  (cljc.java-time.local-date/now *clock*))

 (defn epoch []
   cljc.java-time.instant/epoch)
@@ -679,9 +675,7 @@
 ;; Clocks

 (defn current-clock []
-  (or
-    *clock*
-    (cljc.java-time.clock/system-default-zone)))
+  *clock*)

 (defprotocol IClock
   (clock [_] "Make a clock"))


Refcounting seems to work; needs tests

Refcounting seems to work; needs tests

--- src/tree/redis.clj
+++ src/tree/redis.clj
@@ -1,9 +1,71 @@
 (ns tree.redis
   (:require [clojure.pprint :as pp]
             [taoensso.carmine :as car :refer (wcar)]
+            [taoensso.nippy :as nippy]
             [tree.core :as core]
+            [clojure.string :as str]
             [clojure.core.memoize :as memo]
+            [clojure.core.cache :as cache]
             [tree.messaging :as msg]))
+
+(defn add-refs
+  [node-key children-keys]
+  ;(println "Adding refs" node-key children-keys)
+  (apply car/eval*
+         (str/join
+           \newline
+           ["local parent = ARGV[1]"
+            "for i=2,#ARGV do"
+            "  local child = ARGV[i]"
+            "  redis.call('incr', child .. ':rc')"
+            "  redis.call('rpush', parent .. ':rl', child)"
+            "end"])
+         0
+         node-key
+         children-keys))
+
+(defn drop-ref
+  [key]
+  (car/lua (str/join \newline
+                     ["local to_delete = { _:my-key }"
+                      "while next(to_delete) ~= nil do"
+                      "  local cur = table.remove(to_delete)"
+                      "  if redis.call('decr', cur .. ':rc') <= 0 then"
+                      "    local to_follow = redis.call('lrange', cur .. ':rl', 0, -1)"
+                      "    for i = 1,#to_follow do"
+                      "      table.insert(to_delete, to_follow[i])"
+                      "    end"
+                      "    redis.call('del', cur .. ':rl')"
+                      "    redis.call('del', cur .. ':rc')"
+                      "    redis.call('del', cur)"
+                      "  end"
+                      "end"
+                      ])
+           {} {:my-key key}))
+
+(let [cache (-> {}
+                (cache/lru-cache-factory :threshold 10000)
+                atom)]
+  (defn totally-fetch
+    [redis-key]
+    (let [run (delay
+                (loop [i 0]
+                  (if (= i 1000)
+                    (do (println "total fail") (System/exit 1))
+                    (let [x (wcar {} (car/get redis-key))]
+                      (if x
+                        x
+                        (do (Thread/sleep 25) (recur (inc i))))))))
+          cs (swap! cache (fn [c]
+                            (if (cache/has? c redis-key)
+                              (cache/hit c redis-key)
+                              (cache/miss c redis-key run))))
+          val (cache/lookup cs redis-key)]
+      (if val @val @run)))
+
+  (defn seed-cache!
+    [redis-key val]
+    (swap! cache cache/miss redis-key val)))

 (def totally-fetch
   (memo/lru (fn [redis-key]
@@ -16,17 +78,51 @@
                       (do (Thread/sleep 25) (recur (inc i))))))))
             :lru/threshold 400))

-(defrecord RedisAddr [last-key redis-key]
+(defn synthesize-storage-addr
+  "Given a key, returns a promise containing that key for use as a storage-addr"
+  [key]
+  (doto (promise)
+    (deliver key)))
+
+(defrecord RedisAddr [last-key redis-key storage-addr]
   core/IResolve
   (dirty? [_] false)
   (last-key [_] last-key)
   (resolve [_] (let [x (-> (totally-fetch redis-key)
-                   (assoc :storage-addr
-                          (doto (promise)
-                            (deliver redis-key))))]
+                   (assoc :storage-addr (synthesize-storage-addr redis-key)))]
                  ;(println "Deser:" x)
+                 (when (and (core/index-node? x)
+                            (some #(not (satisfies? msg/IOperation %)) (:op-buf x)))
+                   (println (str "Found a broken node, has " (count (:op-buf x)) " ops"))
+                   (println (str "The node data is " x))
+                   (println "the node's class is" (class x))
+                   (println "and it has keys" (:keys x))
+                   (println "And is it an index-node?" (core/index-node? x))
+                   (println "It came from" redis-key)
+                   (println (str "and " (:op-buf x))))
                  x
                  )))
+
+(comment
+  (:cfg (wcar {} (car/get "b89bb965-e584-45a2-9232-5b76bf47a21c")))
+  (update-in {:op-buf [1 2 3]} [:op-buf] into [4 5 6])
+  )
+
+(defn redis-addr
+  [last-key redis-key]
+  (->RedisAddr last-key redis-key (synthesize-storage-addr redis-key)))
+
+(nippy/extend-freeze RedisAddr :b-tree/redis-addr
+                     [{:keys [last-key redis-key]} data-output]
+                     (nippy/freeze-to-out! data-output last-key)
+                     (nippy/freeze-to-out! data-output redis-key))
+
+(nippy/extend-thaw :b-tree/redis-addr
+                   [data-input]
+                   (let [last-key (nippy/thaw-from-in! data-input)
+                         redis-key (nippy/thaw-from-in! data-input)]
+                     (redis-addr last-key redis-key)))
+

 (defrecord RedisBackend [#_service]
   core/IBackend
@@ -34,10 +130,22 @@
                           :deletes 0}))
   (write-node [_ node session]
     (swap! session update-in [:writes] inc)
-    (let [key (str (java.util.UUID/randomUUID))]
+    (let [key (str (java.util.UUID/randomUUID))
+          addr (redis-addr (core/last-key node) key)]
       ;(.submit service #(wcar {} (car/set key node)))
-      (wcar {} (car/set key node))
-      (->RedisAddr (core/last-key node) key)))
+      (when (some #(not (satisfies? msg/IOperation %)) (:op-buf node))
+        (println (str "Found a broken node, has " (count (:op-buf node)) " ops"))
+        (println (str "The node data is " node))
+        (println (str "and " (:op-buf node))))
+      (wcar {}
+            (car/set key node)
+            (when (core/index-node? node)
+              (add-refs key
+                        (for [child (:children node)
+                              :let [child-key @(:storage-addr child)]]
+                          child-key))))
+      (seed-cache! key node)
+      addr))
   (delete-addr [_ addr session]
     (wcar {} (car/del addr))
     (swap! session update-in :deletes inc)))
@@ -50,7 +158,7 @@
   [root-key]
   (let [last-key (core/last-key (wcar {} (car/get root-key)))] ; need last key to bootstrap
     (core/resolve
-      (->RedisAddr last-key root-key))))
+      (->RedisAddr last-key root-key (synthesize-storage-addr root-key)))))

 (comment
   (wcar {} (car/ping) (car/set "foo" "bar") (car/get "foo"))
@@ -151,3 +259,51 @@
                    (->RedisBackend)
                    ))
   )
+
+(comment
+
+(do
+  (wcar {}
+      (doseq [k ["foo" "bar" "baz" "quux"]
+              e ["" ":rc" ":rs" ":rl"]]
+        (car/del (str k e))))
+
+  (do (wcar {} (car/set "foo" 22))
+      (wcar {} (car/set "foo:rc" 1))
+      (wcar {} (car/set "bar" 33))
+      (wcar {} (car/set "baz" "onehundred"))
+      (wcar {} (car/set "quux" "teply"))
+      (wcar {} (add-refs "baz" ["quux"]))
+      (wcar {} (add-refs "foo" ["bar" "baz"])))
+  (wcar {} (drop-ref "foo")))
+  (doseq [k ["foo" "bar" "baz" "quux"]
+          e ["" ":rc" ":rs" ":rl"]]
+    (println (str k e) "=" (wcar {} ((if (= e ":rl")
+                                       #(car/lrange % 0 -1)
+                                       car/get) (str k e)))))
+  (wcar {} (drop-ref "foo"))
+
+  (wcar {} (create-refcounted "foo" 22))
+
+  (wcar {} (car/flushall))
+  (count (wcar {} (car/keys "*")))
+  (count (msg/lookup-fwd-iter (create-tree-from-root-key @(:storage-addr (:tree my-tree))) -1))
+  (count (msg/lookup-fwd-iter (create-tree-from-root-key @(:storage-addr (:tree my-tree-updated))) -1))
+  (def my-tree (core/flush-tree
+                 (time (reduce msg/insert
+                               (core/b-tree (core/->Config 17 300 (- 300 17)))
+                               (range 50000)))
+                 (->RedisBackend)
+                 ))
+  (def my-tree-updated (core/flush-tree
+                         (msg/delete (:tree my-tree) 10)
+                         (->RedisBackend)
+                         ))
+  (wcar {} (car/get (str @(:storage-addr (:tree my-tree)))))
+  (wcar {} (car/get (str @(:storage-addr (:tree my-tree-updated)))))
+  (wcar {} (car/set "foo" 10))
+  (wcar {} (car/get "foo"))
+  (wcar {} (drop-ref "foo"))
+  (wcar {} (drop-ref @(:storage-addr (:tree my-tree))))
+  (wcar {} (drop-ref @(:storage-addr (:tree my-tree-updated))))
+  )


comment out some stuff

comment out some stuff

Signed-off-by: Gregg Reynolds <d0f77bc71a9867acdcb4f62f012b858edad79160@norc.org>

--- src/migae/boot_gae.clj
+++ src/migae/boot_gae.clj
@@ -795,6 +795,7 @@
           (let [urls (into [] (for [url (:urls config)]
                                 {:path (str url)}))
                 class  (str/replace (:ns config) "-" "_")]
+            ;; (util/info (str "normalize class: " class \newline))
                 ;;ns (if (:ns config) (:ns config) (:class config)) ]
             (merge config {:urls urls
                            :class class
@@ -1683,9 +1684,14 @@
                                                 (str "Only one " filters-edn "file allowed; found "
                                                      (count filters-edn-files)))))
                      filters-edn-map (-> (boot/tmp-file filters-edn-f) slurp read-string)
+                     ;; _ (util/info (str "filters-edn-map: " filters-edn-map \newline))
+
                      filters-config-map (normalize-filter-configs filters-edn-map)
-                     filters-config-map {:filters (filter #(nil? (:class %))
-                                                            (:filters filters-config-map))}
+                     ;; _ (util/info (str "filters-config-map 1: " filters-config-map \newline))
+
+                     ;; filters-config-map {:filters (filter #(nil? (:class %))
+                     ;;                                        (:filters filters-config-map))}
+                     ;; _ (util/info (str "filters-config-map 2: " filters-config-map \newline))

                      ;; step 2: inject filters config map into master config map
                      master-config (-> boot-config-edn-map (assoc-in [:filters]
@@ -1697,10 +1703,12 @@
                                                          (boot/tmp-path boot-config-edn-f)
                                                          boot-config-edn-f))
                      ;; step 4: create filter generator
+                     ;; _ (util/info (str "filters-config-map: " filters-config-map \newline))
                      gen-filters-content (stencil/render-file "migae/boot_gae/gen-filters.mustache"
                                                                (assoc filters-config-map
                                                                       :gen-filters-ns
                                                                       gen-filters-ns))
+                     ;; _ (util/info (str "gen-filters-content: " \newline gen-filters-content \newline))
                      gen-filters-out-file (doto (io/file gen-filters-tmp-dir gen-filters-path)
                                              io/make-parents)]
                  ;; step 5: write new files


Delete unnecessary file

Delete unnecessary file

--- src/mikron/buffer.cljc
+++ src/mikron/buffer.cljc
@@ -1,648 +0,0 @@
-(ns mikron.buffer
-  "Buffer interfaces, implementations, and derived operations."
-  (:require [mikron.util :as util]
-            [mikron.util.math :as math]
-            #?(:clj [mikron.compile-util :as compile-util]))
-  #?(:clj  (:import [java.nio ByteBuffer ByteOrder])
-     :cljs (:require-macros [mikron.buffer :refer [definterface+ with-delta with-le]])))
-
-(defmacro definterface+
-  "Expands to a `definterface` call in clj, `defprotocol` call in cljs."
-  [name & ops]
-  (let [no-meta    #(with-meta % nil)
-        cljs?      (compile-util/cljs?)
-        ops        (map (fn [[op-name args doc-string]]
-                          [op-name
-                           args
-                           (vec (cons 'this (map no-meta args)))
-                           (when doc-string [doc-string])])
-                        ops)
-        inner-form `(~(if cljs? `defprotocol `definterface)
-                     ~name
-                     ~@(map (fn [[op-name args args' doc-string]]
-                              (if cljs?
-                                `(~(no-meta op-name)
-                                  ~args'
-                                  ~@doc-string)
-                                `(~(with-meta (munge op-name) (meta op-name))
-                                  ~args
-                                  ~@doc-string)))
-                            ops))]
-    (if cljs?
-      inner-form
-      `(do ~inner-form
-           ~@(map (fn [[op-name args args' doc-string]]
-                    `(defn ~(no-meta op-name)
-                       {:inline (fn ~args'
-                                  `(~'~(symbol (str "." (munge op-name)))
-                                    ~~@args'))}
-                       ~(with-meta (vec (cons (with-meta 'this {:tag name})
-                                              args))
-                                   (meta op-name))
-                       (~(symbol (str "." (munge op-name)))
-                        ~@args')))
-                  ops)))))
-
-(definterface+ BitBufferOps
-  (^long   ?bit-pos* []            "Gets the current position.")
-  (^Object !bit-pos* [^long value] "Sets the current position.")
-
-  (^long   ?bit-index* []            "Gets the current index.")
-  (^Object !bit-index* [^long value] "Sets the current index.")
-
-  (^long   ?bit-value* []            "Gets the current value at the index.")
-  (^Object !bit-value* [^long value] "Sets the current value at the index."))
-
-(deftype BitBufferImpl [^long ^:unsynchronized-mutable value
-                        ^long ^:unsynchronized-mutable index
-                        ^long ^:unsynchronized-mutable pos]
-  BitBufferOps
-  (?bit-pos* [_]
-    pos)
-  (!bit-pos* [_ value']
-    (set! pos #?(:clj value' :cljs (unchecked-long value'))))
-
-  (?bit-index* [_]
-    index)
-  (!bit-index* [_ value']
-    (set! index #?(:clj value' :cljs (unchecked-long value'))))
-
-  (?bit-value* [_]
-    value)
-  (!bit-value* [_ value']
-    (set! value #?(:clj value' :cljs (unchecked-long value')))))
-
-(definterface+ ByteBufferOps
-  (^long   ?byte* []            "Reads a byte.")
-  (^Object !byte* [^long value] "Writes a byte.")
-
-  (^long   ?short* []            "Reads a short.")
-  (^Object !short* [^long value] "Writes a short.")
-
-  (^long   ?int* []            "Reads an int.")
-  (^Object !int* [^long value] "Writes an int.")
-
-  (^long   ?long* []            "Reads a long.")
-  (^Object !long* [^long value] "Writes a long.")
-
-  (^double ?float* []              "Reads a float.")
-  (^Object !float* [^double value] "Writes a float.")
-
-  (^double ?double* []              "Reads a double.")
-  (^Object !double* [^double value] "Writes a double.")
-
-  (^bytes  ?bytes* [^long n]      "Reads a given number of bytes.")
-  (^Object !bytes* [^bytes value] "Writes a given number of bytes.")
-
-  (^bytes  ?bytes-all* [] "Reads all written bytes.")
-
-  (^long   ?pos* []          "Gets the current position.")
-  (^Object !pos* [^long pos] "Sets the current position.")
-
-  (^Object ?le* []              "Gets the current endianness.")
-  (^Object !le* [^Object value] "Sets the current endianness."))
-
-#?(:clj  ;; ByteBufferOps clj impl (nio ByteBuffer)
-   (deftype ByteBufferImplClj [^ByteBuffer buffer]
-     ByteBufferOps
-     (?byte* [_]
-       (unchecked-long (.get buffer)))
-     (!byte* [_ value]
-       (.put buffer (unchecked-byte value)))
-
-     (?short* [_]
-       (unchecked-long (.getShort buffer)))
-     (!short* [_ value]
-       (.putShort buffer (unchecked-short value)))
-
-     (?int* [_]
-       (.getInt buffer))
-     (!int* [_ value]
-       (.putInt buffer (unchecked-int value)))
-
-     (?long* [_]
-       (.getLong buffer))
-     (!long* [_ value]
-       (.putLong buffer value))
-
-     (?float* [_]
-       (double (.getFloat buffer)))
-     (!float* [_ value]
-       (.putFloat buffer (unchecked-float value)))
-
-     (?double* [_]
-       (.getDouble buffer))
-     (!double* [_ value]
-       (.putDouble buffer value))
-
-     (?bytes* [_ n]
-       (let [value (byte-array n)]
-         (.get buffer value)
-         value))
-     (!bytes* [_ value]
-       (.put buffer value))
-
-     (?bytes-all* [_]
-       (let [bytes (byte-array (.position buffer))]
-         (.position buffer (unchecked-int 0))
-         (.get buffer bytes)
-         bytes))
-
-     (?pos* [_]
-       (.position buffer))
-     (!pos* [_ value]
-       (.position buffer (unchecked-int value)))
-
-     (?le* [_]
-       (identical? ByteOrder/LITTLE_ENDIAN (.order buffer)))
-     (!le* [_ value]
-       (.order buffer (if value ByteOrder/LITTLE_ENDIAN ByteOrder/BIG_ENDIAN)))))
-
-(defmacro with-delta
-  "Executes `body` and updates the position `pos` with the delta `delta`."
-  [pos delta body]
-  (compile-util/with-gensyms [value]
-    `(let [~value ~body]
-       (set! ~pos (unchecked-add ~pos ~delta))
-       ~value)))
-
-#?(:cljs ;; ByteBufferOps cljs (buffer) impl (DataView + Int8Buffer)
-   (deftype ByteBufferImplCljsBrowser [data-view
-                                       int8-array
-                                       ^long    ^:unsynchronized-mutable pos
-                                       ^boolean ^:unsynchronized-mutable le]
-     ByteBufferOps
-     (?byte* [_]
-       (with-delta pos 1 (.getInt8 data-view pos)))
-     (!byte* [_ value]
-       (with-delta pos 1 (.setInt8 data-view pos value)))
-
-     (?short* [_]
-       (with-delta pos 2 (.getInt16 data-view pos le)))
-     (!short* [_ value]
-       (with-delta pos 2 (.setInt16 data-view pos value le)))
-
-     (?int* [_]
-       (with-delta pos 4 (.getInt32 data-view pos le)))
-     (!int* [_ value]
-       (with-delta pos 4 (.setInt32 data-view pos value le)))
-
-     (?long* [this]
-       (math/to (let [u (?int* this)
-                      v (?int* this)]
-                  (if le (math/from u v) (math/from v u)))))
-     (!long* [this value]
-       (let [value (math/from value)
-             low   (.getLowBits value)
-             high  (.getHighBits value)]
-         (if le
-           (do (!int* this low)  (!int* this high))
-           (do (!int* this high) (!int* this low)))))
-
-     (?float* [_]
-       (with-delta pos 4 (.getFloat32 data-view pos le)))
-     (!float* [_ value]
-       (with-delta pos 4 (.setFloat32 data-view pos value le)))
-
-     (?double* [_]
-       (with-delta pos 8 (.getFloat64 data-view pos le)))
-     (!double* [_ value]
-       (with-delta pos 8 (.setFloat64 data-view pos value le)))
-
-     (?bytes* [_ n]
-       (let [from pos
-             to   (unchecked-add pos n)]
-         (set! pos to)
-         (.-buffer (.slice int8-array from to))))
-     (!bytes* [_ value]
-       (do (.set int8-array (js/Int8Array. value) pos)
-           (set! pos (unchecked-add pos (.-byteLength value)))))
-
-     (?bytes-all* [_]
-       (.-buffer (.slice int8-array 0 pos)))
-
-     (?pos* [_]
-       pos)
-     (!pos* [_ value]
-       (set! pos value))
-
-     (?le* [_]
-       le)
-     (!le* [_ value]
-       (set! le value))))
-
-(defmacro with-le
-  "Executes the expressions with the endianness automatically set to `le`."
-  [le [expr & exprs]]
-  `(if ~le
-     (~(symbol (str expr "LE")) ~@exprs)
-     (~(symbol (str expr "BE")) ~@exprs)))
-
-#?(:cljs ;; ByteBufferOps cljs (node) impl (Buffer)
-   (deftype ByteBufferImplCljsNode [buffer
-                                    ^long    ^:unsynchronized-mutable pos
-                                    ^boolean ^:unsynchronized-mutable le]
-     ByteBufferOps
-     (?byte* [_]
-       (with-delta pos 1 (.readInt8 buffer pos true)))
-     (!byte* [_ value]
-       (with-delta pos 1 (.writeInt8 buffer value pos true)))
-
-     (?short* [_]
-       (with-delta pos 2 (with-le le (.readInt16 buffer pos true))))
-     (!short* [_ value]
-       (with-delta pos 2 (with-le le (.writeInt16 buffer value pos true))))
-
-     (?int* [_]
-       (with-delta pos 4 (with-le le (.readInt32 buffer pos true))))
-     (!int* [_ value]
-       (with-delta pos 4 (with-le le (.writeInt32 buffer value pos true))))
-
-     (?long* [this]
-       (math/to (let [u (?int* this)
-                      v (?int* this)]
-                  (if le (math/from u v) (math/from v u)))))
-     (!long* [this value]
-       (let [value (math/from value)
-             low   (.getLowBits value)
-             high  (.getHighBits value)]
-         (if le
-           (do (!int* this low)  (!int* this high))
-           (do (!int* this high) (!int* this low)))))
-
-     (?float* [_]
-       (with-delta pos 4 (with-le le (.readFloat buffer pos true))))
-     (!float* [_ value]
-       (with-delta pos 4 (with-le le (.writeFloat buffer value pos true))))
-
-     (?double* [_]
-       (with-delta pos 8 (with-le le (.readDouble buffer pos true))))
-     (!double* [_ value]
-       (with-delta pos 8 (with-le le (.writeDouble buffer value pos true))))
-
-     (?bytes* [_ n]
-       (let [from pos
-             to   (unchecked-add pos n)]
-         (set! pos to)
-         (.slice (.-buffer buffer) from to)))
-     (!bytes* [this value]
-       (do (.copy (.from js/Buffer value) buffer pos)
-           (set! pos (unchecked-add pos (.-byteLength value)))))
-
-     (?bytes-all* [_]
-       (.slice (.-buffer buffer) 0 pos))
-
-     (?pos* [_]
-       pos)
-     (!pos* [_ value]
-       (set! pos value))
-
-     (?le* [_]
-       le)
-     (!le* [_ value]
-       (set! le value))))
-
-(deftype Buffer [^{:tag #?(:clj `BitBufferOps  :cljs nil)} bit-buffer
-                 ^{:tag #?(:clj `ByteBufferOps :cljs nil)} byte-buffer])
-
-(defn ?byte-buffer
-  "Gets the byte buffer of `buffer`."
-  ^ByteBufferOps [^Buffer buffer]
-  (.-byte-buffer buffer))
-
-(defn ?bit-buffer
-  "Gets the bit buffer of `buffer`."
-  ^BitBufferOps [^Buffer buffer]
-  (.-bit-buffer buffer))
-
-(defn ?bit-pos
-  "Gets the bit position of `buffer`."
-  ^long [^Buffer buffer]
-  (?bit-pos* (?bit-buffer buffer)))
-
-(defn !bit-pos
-  "Sets the bit position of `buffer` to `value`."
-  [^Buffer buffer ^long value]
-  (!bit-pos* (?bit-buffer buffer) value))
-
-(defn ?bit-index
-  "Gets the bit index of `buffer`."
-  ^long [^Buffer buffer]
-  (?bit-index* (?bit-buffer buffer)))
-
-(defn !bit-index
-  "Sets the bit index of `buffer` to `value`."
-  [^Buffer buffer ^long value]
-  (!bit-index* (?bit-buffer buffer) value))
-
-(defn ?bit-value
-  "Gets the bit value of `buffer`."
-  ^long [^Buffer buffer]
-  (?bit-value* (?bit-buffer buffer)))
-
-(defn !bit-value
-  "Sets the bit value of `buffer` to `value`."
-  [^Buffer buffer ^long value]
-  (!bit-value* (?bit-buffer buffer) value))
-
-;; Public operations
-
-(defn ?byte
-  "Reads a byte from `buffer`."
-  ^long [^Buffer buffer]
-  (?byte* (?byte-buffer buffer)))
-
-(defn !byte
-  "Writes a byte `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!byte* (?byte-buffer buffer) value))
-
-(defn ?short
-  "Reads a short from `buffer`."
-  ^long [^Buffer buffer]
-  (?short* (?byte-buffer buffer)))
-
-(defn !short
-  "Writes a short `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!short* (?byte-buffer buffer) value))
-
-(defn ?int
-  "Reads an int from `buffer`."
-  ^long [^Buffer buffer]
-  (?int* (?byte-buffer buffer)))
-
-(defn !int
-  "Writes an int `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!int* (?byte-buffer buffer) value))
-
-(defn ?long
-  "Reads a long from `buffer`."
-  ^long [^Buffer buffer]
-  (?long* (?byte-buffer buffer)))
-
-(defn !long
-  "Writes a long `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!long* (?byte-buffer buffer) value))
-
-(defn ?float
-  "Reads a float from `buffer`."
-  ^double [^Buffer buffer]
-  (?float* (?byte-buffer buffer)))
-
-(defn !float
-  "Writes a float `value` to `buffer`."
-  [^Buffer buffer ^double value]
-  (!float* (?byte-buffer buffer) value))
-
-(defn ?double
-  "Reads a double from `buffer`."
-  ^double [^Buffer buffer]
-  (?double* (?byte-buffer buffer)))
-
-(defn !double
-  "Writes a double `value` to `buffer`."
-  [^Buffer buffer ^double value]
-  (!double* (?byte-buffer buffer) value))
-
-(defn ?bytes
-  "Reads `n` bytes from `buffer`."
-  [^Buffer buffer n]
-  (?bytes* (?byte-buffer buffer) n))
-
-(defn !bytes
-  "Writes some bytes `value` to `buffer`."
-  [^Buffer buffer value]
-  (!bytes* (?byte-buffer buffer) value))
-
-(defn ?bytes-all
-  "Reads all bytes from `buffer`."
-  [^Buffer buffer]
-  (?bytes-all* (?byte-buffer buffer)))
-
-(defn ?pos
-  "Gets the position of `buffer`."
-  ^long [^Buffer buffer]
-  (?pos* (?byte-buffer buffer)))
-
-(defn !pos
-  "Sets the position of `buffer`."
-  [^Buffer buffer ^long value]
-  (!pos* (?byte-buffer buffer) value))
-
-(defn ?le
-  "Gets the endianness of `buffer`."
-  [^Buffer buffer]
-  (?le* (?byte-buffer buffer)))
-
-(defn !le
-  "Sets the endianness of `buffer`."
-  [^Buffer buffer value]
-  (!le* (?byte-buffer buffer) value))
-
-;; Derived operations
-
-(defn ?ubyte
-  "Reads an unsigned byte from `buffer`."
-  ^long [^Buffer buffer]
-   (bit-and (?byte buffer) 0xFF))
-
-(defn !ubyte
-  "Writes an unsigned byte `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!byte buffer (unchecked-byte (bit-and value 0xFF))))
-
-(defn ?ushort
-  "Reads an unsigned short from `buffer`."
-  [^Buffer buffer]
-  (bit-and (?short buffer) 0xFFFF))
-
-(defn !ushort
-  "Writes an unsigned short `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!short buffer (unchecked-short (bit-and value 0xFFFF))))
-
-(defn ?uint
-  "Reads an unsigned int from `buffer`."
-  [^Buffer buffer]
-  #?(:clj  (bit-and (?int buffer) 0xFFFFFFFF)
-     :cljs (unsigned-bit-shift-right (?int buffer) 0)))
-
-(defn !uint
-  "Writes an unsigned int `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (!int buffer (unchecked-int (bit-and value 0xFFFFFFFF))))
-
-(defn !byte-at
-  "Writes a byte to the given position in `buffer`."
-  [^Buffer buffer ^long pos ^long value]
-  (let [pos' (?pos buffer)]
-    (doto buffer
-          (!pos pos)
-          (!byte value)
-          (!pos pos'))))
-
-(defn ?boolean
-  "Reads a boolean from `buffer`."
-  [^Buffer buffer]
-  (when (== 0 (rem (?bit-index buffer) 8))
-    (!bit-value buffer (?byte buffer)))
-  (let [index (?bit-index buffer)]
-    (!bit-index buffer (unchecked-inc index))
-    (not (== 0 (bit-and (?bit-value buffer)
-                        (bit-shift-left 1 (rem index 8)))))))
-
-(defn !boolean
-  "Writes a boolean `value` to `buffer`."
-  [^Buffer buffer value]
-  (when (== 0 (rem (?bit-index buffer) 8))
-    (when (pos? (?bit-index buffer))
-      (!byte-at buffer (?bit-pos buffer) (?bit-value buffer)))
-    (!bit-pos buffer (?pos buffer))
-    (!bit-value buffer 0)
-    (!pos buffer (unchecked-inc (?bit-pos buffer))))
-  (let [index (?bit-index buffer)
-        mask  (bit-shift-left 1 (rem index 8))]
-    (!bit-index buffer (unchecked-inc index))
-    (!bit-value buffer
-                (unchecked-byte (if value
-                                  (bit-or (?bit-value buffer) mask)
-                                  (bit-and (?bit-value buffer) (bit-not mask)))))))
-
-(defn ?varint
-  "Reads a varint from `buffer`."
-  ^long [^Buffer buffer]
-  (loop [value math/c0
-         shift (long 0)]
-    (if (>= shift 64)
-      (throw (ex-info "Malformed varint!"))
-      (let [byte  (math/from (?byte buffer))
-            value (-> (math/and byte math/c127)
-                      (math/shift-left shift)
-                      (math/or value))]
-        (if (math/zero? (math/and byte math/c128))
-          (math/to (math/zigzag-decode value))
-          (recur value (unchecked-add shift 7)))))))
-
-(defn !varint
-  "Writes a varint `value` to `buffer`."
-  [^Buffer buffer ^long value]
-  (loop [value (math/zigzag-encode (math/from value))]
-    (if (math/zero? (math/and value math/c-128))
-      (!byte buffer (math/to value))
-      (do (!byte buffer (-> value
-                            (math/and math/c127)
-                            (math/or math/c128)
-                            (math/to)))
-          (recur (math/unsigned-shift-right value 7))))))
-
-(defn ?binary
-  "Reads a binary value from `buffer`."
-  ^bytes [^Buffer buffer]
-  (?bytes buffer (?varint buffer)))
-
-(defn !binary
-  "Writes a binary value `value` to `buffer`."
-  [^Buffer buffer ^bytes value]
-  (doto buffer
-        (!varint #?(:clj  (alength value)
-                    :cljs (.-byteLength value)))
-        (!bytes value)))
-
-;; Higher level operations
-
-(defn !reset
-  "Resets `buffer`."
-  [^Buffer buffer]
-  (doto buffer
-    (!pos 0)
-    (!bit-pos -1)
-    (!bit-value 0)
-    (!bit-index 0)))
-
-(defn !finalize
-  "Finalizes `buffer`."
-  [^Buffer buffer]
-  (let [bit-pos (?bit-pos buffer)]
-    (when-not (== -1 bit-pos)
-      (!byte-at buffer bit-pos (?bit-value buffer)))))
-
-(definterface+ ByteBufferFactoryOps
-  (^mikron.buffer.ByteBufferOps allocate* [^long size]    "Allocates a buffer with size `size`.")
-  (^mikron.buffer.ByteBufferOps wrap*     [^bytes binary] "Wraps a binary value `binary` with a buffer."))
-
-(defn byte-buffer-factory?
-  "Returns `true` if `value` is an instance of `ByteBufferFactoryOps`, `false` otherwise."
-  [value]
-  (instance? ByteBufferFactoryOps value))
-
-#?(:clj ;; ByteBufferFactoryOps impl clj
-   (defrecord ByteBufferFactoryImplClj []
-     ByteBufferFactoryOps
-     (allocate* [_ size]
-       (ByteBufferImplClj. (.order (ByteBuffer/allocateDirect size) (ByteOrder/nativeOrder))))
-     (wrap* [_ binary]
-       (ByteBufferImplClj. (ByteBuffer/wrap binary)))))
-
-#?(:cljs ;; ByteBufferFactoryOps impl cljs (buffer)
-   (defrecord ByteBufferFactoryImplCljsBrowser []
-     ByteBufferFactoryOps
-     (allocate* [_ size]
-       (let [array-buffer (js/ArrayBuffer. size)]
-         (ByteBufferImplCljsBrowser. (js/DataView. array-buffer)
-                                     (js/Int8Array. array-buffer)
-                                     0 true)))
-     (wrap* [_ binary]
-       (ByteBufferImplCljsBrowser. (js/DataView. binary)
-                                   (js/Int8Array. binary)
-                                   0 true))))
-
-#?(:cljs ;; ByteBufferFactoryOps impl cljs (node)
-   (defrecord ByteBufferFactoryImplCljsNode []
-     ByteBufferFactoryOps
-     (allocate* [_ size]
-       (ByteBufferImplCljsNode. (.allocUnsafe js/Buffer size) 0 true))
-     (wrap* [_ binary]
-       (ByteBufferImplCljsNode. (.from js/Buffer binary) 0 true))))
-
-(def ^ByteBufferFactoryOps byte-buffer-factory
-  "The default byte buffer factory."
-  #?(:clj  (ByteBufferFactoryImplClj.)
-     :cljs (if (util/node-env?)
-             (ByteBufferFactoryImplCljsNode.)
-             (ByteBufferFactoryImplCljsBrowser.))))
-
-(defn set-byte-buffer-factory!
-  "Sets the byte buffer factory."
-  [factory]
-  {:pre [(byte-buffer-factory? factory)]}
-  #?(:clj  (alter-var-root #'byte-buffer-factory (constantly factory))
-     :cljs (set! byte-buffer-factory factory)))
-
-(defn allocate
-  "Allocates a buffer with the size `size`."
-  ^Buffer [^long size]
-  (Buffer. (BitBufferImpl. 0 0 -1)
-           (allocate* byte-buffer-factory size)))
-
-(defn wrap
-  "Wraps a binary value `binary` with a buffer."
-  ^Buffer [^bytes binary]
-  (Buffer. (BitBufferImpl. 0 0 -1)
-           (wrap* byte-buffer-factory binary)))
-
-(defn !headers
-  "Writes the headers of `buffer`."
-  [^Buffer buffer diffed?]
-  (doto buffer
-    (!reset)
-    (!boolean (?le buffer))
-    (!boolean diffed?)))
-
-(defn ?headers
-  "Reads the headers of `buffer`."
-  [^Buffer buffer]
-  (!le buffer (?boolean buffer))
-  {:diffed? (?boolean buffer)})


Normalize throughput metrics tags in the same way as 0.11.

--- src/onyx/monitoring/metrics_monitoring.clj
+++ src/onyx/monitoring/metrics_monitoring.clj
@@ -199,7 +199,7 @@
       (.update timer latency-ns TimeUnit/NANOSECONDS))))

 (defn new-read-batch [reg tag lifecycle]
-  (let [throughput (m/meter reg (into tag ["task-lifecycle" (name lifecycle) "throughput"]))
+  (let [throughput (m/meter reg (conj tag (clojure.string/join "_" ["task-lifecycle" (name lifecycle) "throughput"])))
         timer ^com.codahale.metrics.Timer (t/timer reg (into tag ["task-lifecycle" (name lifecycle)]))]
     (fn [state latency-ns]
       (let [size (count (:onyx.core/batch (task/get-event state)))]
@@ -214,7 +214,7 @@
           (:tree (:onyx.core/results (task/get-event state)))))

 (defn new-write-batch [reg tag lifecycle]
-  (let [throughput (m/meter reg (into tag ["task-lifecycle" (name lifecycle) "throughput"]))
+  (let [throughput (m/meter reg (conj tag (clojure.string/join "_" ["task-lifecycle" (name lifecycle) "throughput"])))
         timer ^com.codahale.metrics.Timer (t/timer reg (into tag ["task-lifecycle" (name lifecycle)]))
         accum (volatile! (long 0))]
     (fn [state latency-ns]


better format for duration and distance

better format for duration and distance

--- src/ontrail/weekly.clj
+++ src/ontrail/weekly.clj
@@ -1,5 +1,5 @@
 (ns ontrail.weekly
-  (:use [ontrail mongodb formats exercise]
+  (:use [ontrail mongodb formats exercise formats]
         monger.operators)
   (:require [monger.core]
             [monger.conversion]
@@ -58,28 +58,27 @@
     0))

 (defn accumulate [totals result]
-  (let [acc #(+ (get-entry totals %1) (get-entry result %2))
-        kw-all-distance (keyword "distance_Kaikki")
-        kw-all-duration (keyword "duration_Kaikki")
-        kw-sport-distance (keyword (str "distance_" (:sport result)))
-        kw-sport-duration (keyword (str "duration_" (:sport result)))]
+  (let [kw-all (keyword "Kaikki")]
     (assoc totals
-      kw-all-duration (acc kw-all-duration :duration)
-      kw-all-distance (acc kw-all-distance :distance)
-      kw-sport-distance (acc kw-sport-distance :distance)
-      kw-sport-duration (acc kw-sport-duration :duration))))
+      kw-all {:distance (+ (:distance (kw-all totals)) (get-entry result :distance))
+              :duration (+ (:duration (kw-all totals)) (get-entry result :duration))})))
+
+(defn humanize [coll]
+  (let [key (first (keys coll))
+        val (key coll)]
+    {key {:distance (to-human-distance (:distance val)) :duration (to-human-time (:duration val))}}))

 (defn weekly-sums [results]
   (if (>= (count results) 1)
-    (reduce accumulate (cons {} results))
-    {}))
+    (cons (humanize (reduce accumulate (cons {(keyword "Kaikki") {:distance 0 :duration 0}} results))) [])
+    [(keyword "Kaikki") {:distance "" :duration ""}]))

 (defn interval-as-exlist [user week-interval]
     (let [start (.getStart week-interval) end (.getEnd week-interval)
           results (interval-query user start end)]
       {:week (week-number week-interval)
        :from start
-       :sums (weekly-sums results)
+       :summary (weekly-sums results)
        :exs (map simple-result results)}))

 (defn weeks-from [date-time]


NOTE TAG PUSH - PLEASE NOTE - WHILE COERCION TESTS ARE PASSING FOR LIFECYCLES, THE CONCEPT MUST BE RETHOUGHT FOR JAVA (IE, FUNCTIONS for CALLS) BEFORE THIS CAN BE USED. THIS WILL BE REVISITED AFTER WORKFLOWS AND JOB COERCION SUCCESSFULLY IMPLEMENTED.

--- src/onyx_java/test.clj
+++ src/onyx_java/test.clj
@@ -2,7 +2,6 @@
     (:gen-class)
     (:require [onyx-java.utils.test-template :as t]
               [clojure.test :refer [deftest is]]))
-

 (def input-dir "test/resources/onyx_simple/source/")
 (def output-dir "test/resources/onyx_simple/target/")


removed debug messages

removed debug messages

--- src/untangled/client/impl/application.cljc
+++ src/untangled/client/impl/application.cljc
@@ -128,12 +128,9 @@
     (let [queue            (get send-queues remote)
           network          (get networking remote)
           response-channel (get response-channels remote)
-          send-complete    (fn []
-                             (log/info "Send complete")
-                             (go (async/>! response-channel :complete)))]
+          send-complete    (fn [] (go (async/>! response-channel :complete)))]
       (go
         (loop [payload (async/<! queue)]
-          (log/info "Payload pulled")
           (send-payload network payload send-complete)      ; async call. Calls send-complete when done
           (async/<! response-channel)                       ; block until send-complete
           (recur (async/<! queue)))))))


Add resizable corner.

Add resizable corner.

--- src/videotest/tri_cv/dynamic_size_core.clj
+++ src/videotest/tri_cv/dynamic_size_core.clj
@@ -11,7 +11,7 @@
    [java.nio ByteBuffer ByteOrder]
    [java.util ArrayList]))

-(def CAM-DEV-NUM 0)
+(def CAM-DEV-NUM 1)
 (def CAM-SIZE (cv/camera-frame-size CAM-DEV-NUM))
 (def CAM-WIDTH  (int (:width  CAM-SIZE)))
 (def CAM-HEIGHT (int (:height CAM-SIZE)))
@@ -213,4 +213,4 @@
   :on-close on-close
   :middleware [m/fun-mode])

-;; (.setResizable (.frame videotest) true)
+  (.setResizable (.frame videotest) true)


Correction: clojure.data.csv will happily produce a lazy seq of vectors

--- taxi-rides-clj/src/taxi_rides_clj/core.clj
+++ taxi-rides-clj/src/taxi_rides_clj/core.clj
@@ -149,12 +149,7 @@
   (let [company           (->> file str (re-find #"([a-z]+)[^/]+$") second)
         vendor-lookup     (if (= company "green") {1 "Creative Mobile Technologies" 2 "VeriFone"})

-      ; This is simpler but reads the whole CSV into memory at once, which caused OOMs on larger files
-      ; csv-contents      (-> in slurp csv/read-csv)
-
-      ; This version feeds lines to read-csv one by one, making the file parsing lazy
-        csv-contents      (->> in io/reader line-seq (map (comp first csv/read-csv)))
-
+        csv-contents      (->> in io/reader csv/read-csv)
         header            (->> csv-contents first (map (comp string/lower-case string/trim)))
         missing           (clojure.set/difference (-> header set) (->> col-mapping keys (filter string?) set))
         _                 (if-not (empty? missing) (throw (Exception. (str "Missing cols for " missing " at " file))))


Added more assertions into test-format-hours-3 and test-format-minutes-3 tests

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -180,7 +180,13 @@
         (are [x y] (= x y)
               "2 hours and one minute ago"   (format-hours 2 1)
               "2 hours and 2 minutes ago"    (format-hours 2 2)
-              "2 hours and 100 minutes ago"  (format-hours 2 100))))
+              "2 hours and 100 minutes ago"  (format-hours 2 100)
+              "4 hours and one minute ago"   (format-hours 4 1)
+              "4 hours and 2 minutes ago"    (format-hours 4 2)
+              "4 hours and 100 minutes ago"  (format-hours 4 100)
+              "100 hours and one minute ago"   (format-hours 100 1)
+              "100 hours and 2 minutes ago"    (format-hours 100 2)
+              "100 hours and 100 minutes ago"  (format-hours 100 100))))

 (deftest test-format-minutes-1
     "Check the function clj-calendar.format-datetime/format-minutes."
@@ -202,7 +208,13 @@
         (are [x y] (= x y)
               "2 minutes and one second ago"   (format-minutes 2 1)
               "2 minutes and 2 seconds ago"    (format-minutes 2 2)
-              "2 minutes and 100 seconds ago"  (format-minutes 2 100))))
+              "2 minutes and 100 seconds ago"  (format-minutes 2 100)
+              "4 minutes and one second ago"   (format-minutes 4 1)
+              "4 minutes and 2 seconds ago"    (format-minutes 4 2)
+              "4 minutes and 100 seconds ago"  (format-minutes 4 100)
+              "100 minutes and one second ago"   (format-minutes 100 1)
+              "100 minutes and 2 seconds ago"    (format-minutes 100 2)
+              "100 minutes and 100 seconds ago"  (format-minutes 100 100))))

 (deftest test-format-seconds-1
     "Check the function clj-calendar.format-datetime/format-seconds."


Gen test bulk functions.

Gen test bulk functions.

--- test/onyx/generative/apply_fn_gen_test.clj
+++ test/onyx/generative/apply_fn_gen_test.clj
@@ -8,11 +8,14 @@
             [onyx.peer.task-lifecycle :as t]
             [onyx.api]))

+(defn gen-segment []
+  (gen/hash-map :message (gen/map gen/any gen/any)))
+
 (deftest singe-segment-return
   (checking
    "A single returned segment attaches to its root"
    (times 30)
-   [input (gen/hash-map :message (gen/map gen/any gen/any))
+   [input (gen-segment)
     output (gen/map gen/any gen/any)]
    (let [f (fn [segment] output)
          event {:onyx.core/batch [input]}
@@ -25,7 +28,7 @@
   (checking
    "Multiple segments can be returned, attached to their root"
    (times 30)
-   [input (gen/hash-map :message (gen/map gen/any gen/any))
+   [input (gen-segment)
     output (gen/vector (gen/map gen/any gen/any))]
    (let [f (fn [segment] output)
          event {:onyx.core/batch [input]}
@@ -38,7 +41,7 @@
   (checking
    "It generalizes with a bigger batch size for single returns"
    (times 20)
-   [input (gen/vector (gen/hash-map :message (gen/not-empty (gen/map gen/uuid gen/any))))
+   [input (gen/vector (gen-segment))
     ;; Uses a UUID as the key to ensure input -> output
     ;; mapping is unique for all inputs
     output (gen/vector (gen/map gen/any gen/any)
@@ -55,7 +58,7 @@
   (checking
    "Functions can be parameterized via the event map"
    (times 30)
-   [input (gen/vector (gen/hash-map :message (gen/map gen/any gen/any)))
+   [input (gen/vector (gen-segment))
     params (gen/vector gen/any)]
    (let [f (fn [& args] {:result (or (butlast args) [])})
          event {:onyx.core/batch input :onyx.core/params params}
@@ -67,7 +70,7 @@
   (checking
    "Functions that throw exceptions pass the exception object back"
    (times 30)
-   [input (gen/vector (gen/hash-map :message (gen/map gen/any gen/any)))]
+   [input (gen/vector (gen-segment))]
    (let [f (fn [segment] (throw (ex-info "exception" {:val 42})))
          event {:onyx.core/batch input}
          rets (t/apply-fn f false event)
@@ -76,3 +79,18 @@
      (is (= input (map :root tree)))
      (is (every? #(= clojure.lang.ExceptionInfo (type %)) messages))
      (is (every? #(= {:val 42} (ex-data (:exception %))) (map ex-data messages))))))
+
+(deftest bulk-functions
+  (checking
+   "Bulk functions call the function, but always return their inputs"
+   (times 30)
+   [input (gen/not-empty (gen/vector (gen-segment)))
+    output gen/any]
+   (let [called? (atom false)
+         f (fn [segment] (reset! called? true) output)
+         event {:onyx.core/batch input}
+         rets (t/apply-fn f true event)
+         tree (:tree (t/persistent-results! (:onyx.core/results rets)))]
+     (is (= input (map :root tree)))
+     (is (= (map :message input) (map :message (mapcat :leaves tree))))
+     (is @called?))))


Error on purpose to test Sentry integration.

--- src/posthere/app.clj
+++ src/posthere/app.clj
@@ -39,6 +39,9 @@

   ; Resource requests (in development only, otherwise handled by nginx)
   (route/resources "/")
+
+  ;; Force an error for testing Sentry error reporting
+  (GET "/_/force_error" [] (/ 42 0))

   ;; Home page for development, handled by nginx in production
   (GET "/" [] (slurp "./resources/public/index"))


wrap the etag header in quotes

wrap the etag header in quotes

--- src/pc/http/routes.clj
+++ src/pc/http/routes.clj
@@ -60,7 +60,7 @@
   (let [last-modified-instant (or (doc-http/last-modified-instant db doc)
                                   (java.util.Date.))]
     {"Cache-Control" "no-cache"
-     "ETag" (md5/encode (str (pc.utils/inspect last-modified-instant)))
+     "ETag" (format "\"%s\"" (md5/encode (str (pc.utils/inspect last-modified-instant))))
      "Last-Modified" (->> last-modified-instant
                        (clj-time.coerce/from-date)
                        (clj-time.format/unparse (clj-time.format/formatters :rfc822)))}))


More consistent naming

More consistent naming

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -18,10 +18,9 @@
 (def dispatch-sync    router/dispatch-sync)

-;; XXX move certain API functions up to this core level - to get code completion and docs
-;; XXX add a clear all handlers
-;; XXX for testing purposes, and a way to snapshot re-frame instance. Then re-instate
-;; XXX on figwheel reload, should invalidate all re-frame subscriptions
+;; XXX move API functions up to this core level - to enable code completion and docs
+;; XXX for testing purposes:  a way to snapshot re-frame state, then re-instate
+;; XXX on figwheel reload, is there a way to not get the re-registration messages.

 ;; -- interceptor related
@@ -43,24 +42,24 @@
 (def on-changes  std-interceptors/on-changes)

-;; --  subscriptions: reading and writing
+;; --  subscriptions
 (def reg-sub-raw         subs/register-raw)
 (def reg-sub             subs/reg-sub)
 (def subscribe           subs/subscribe)

+(def clear-sub    (partial registrar/clear-handlers subs/kind))
+
 ;; -- effects
-(def reg-fx       fx/register)
-(def clear-fx     (partial registrar/clear-handlers fx/kind))
+(def reg-fx      fx/register)
+(def clear-fx    (partial registrar/clear-handlers fx/kind))

 ;; -- coeffects
-(def reg-cofx       cofx/register)
-(def clear-cofx     (partial registrar/clear-handlers cofx/kind))
+(def reg-cofx    cofx/register)
+(def clear-cofx (partial registrar/clear-handlers cofx/kind))
+

 ;; --  Events
-
-;; usage (clear-event! :some-id)
-(def clear-all-events!  (partial registrar/clear-handlers events/kind))    ;; XXX name with !
-
+(def clear-event (partial registrar/clear-handlers events/kind))

 (defn reg-event-db
   "Register the given `id`, typically a keyword, with the combination of


better fix for aphyr/riemann#233

better fix for aphyr/riemann#233

--- src/riemann/common.clj
+++ src/riemann/common.clj
@@ -14,6 +14,7 @@
             [clojure.java.io :as io])
   (:use [clojure.string :only [split join]]
         [riemann.time :only [unix-time]]
+        [clojure.java.shell :only [sh]]
         clojure.tools.logging
         riemann.codec
         gloss.core
@@ -31,11 +32,25 @@
      (info ~(str "Deprecated: " comment))
      ~@body))

+(defn get-hostname
+  [[age val]]
+  (if (and val (<= 60000 (- (System/currentTimeMillis) age)))
+   [age val]
+   [(System/currentTimeMillis)
+    (let [{:keys [exit out]} (sh "hostname")]
+      (if (= exit 0)
+        (.trim out)))]))
+
 ; Platform
-(defn localhost
-  "Returns the local host name."
-  []
-  (.. InetAddress getLocalHost getHostName))
+(let [cache (atom [nil nil])]
+  (defn localhost
+    "Returns the local host name."
+    []
+    (if (re-find #"^Windows" (System/getProperty "os.name"))
+      (or (System/getenv "COMPUTERNAME") "localhost")
+      (or (System/getenv "HOSTNAME")
+          (second (swap! cache get-hostname))
+          "localhost"))))

 ; Times
 (defn time-at


Recur

Recur

--- src/tictactoe/core.clj
+++ src/tictactoe/core.clj
@@ -69,7 +69,7 @@
   [board player opponent player-move opponent-move in-progress? presenter]
   (render-board presenter board)
   (if (in-progress? board)
-    (step
+    (recur
       (game-board board (player-move board) player)
       opponent
       player


Have query-pull working correctly, including check for 'pull' symbol

--- src/tupelo/datomic.clj
+++ src/tupelo/datomic.clj
@@ -250,7 +250,7 @@
         let-srcs    (vals let-map)
       ; _ (println let-srcs)
         find-vec    (grab :find args-map)
-        _ (println \newline find-vec)
+      ; _ (println \newline find-vec)
         where-vec   (grab :where args-map)
       ; _ (println where-vec)
   ]
@@ -276,15 +276,15 @@
 (defmacro query
   "Returns a TupleSet #{ [s/Any] } of query results, where each tuple is unique."
   [& args]
-  (println "query" args)
+; (println "query" args)
   `(into #{}
       (for [tuple# (query* ~@args) ]
         (into [] tuple#))))

 (defmacro query-set
   "Returns a Set #{s/Any} of query results, where each item is unique."
-  [ & args ]
-  (println "query-set" args)
+  [& args]
+; (println "query-set" args)
   `(into #{}
       (for [tuple# (query* ~@args)]
         (do
@@ -294,41 +294,32 @@

 (defn contains-pull?
   "Returns true if a sequence of symbols includes 'pull'"
-  [args]
-  (println \newline "contains-pull?" args)
-  (let [args-map    (apply hash-map args)
+  [args-vec]
+; (println \newline "contains-pull?" args-vec)
+  (let [args-map    (apply hash-map args-vec)
         find-vec    (flatten [ (grab :find args-map) ] ) ]
-    (spyxx find-vec)
-    (doseq [item find-vec]
-      (do (print " ") (pr item) ))
-    (newline)
+  ; (spyxx find-vec)
+  ; (doseq [item find-vec]
+  ;   (do (print " ") (pr item) ))
+  ; (newline)
     (any? #(= 'pull %) find-vec)))

 (defmacro query-pull
   "Returns a TupleList [Tuple] of query results, where items may be duplicated. Intended only for
    use with the Datomic Pull API"
-  [ & args ]  ; #todo add check for pull api presence, else exception
-  '(do
-      (println "query-pull" args)
-      (assert (tupelo.datomic/contains-pull? args)
-              "query-pull: Only intended for queries using the Datomic Pull API")
-      (println "query-pull: past assert")
+  [& args]  ; #todo add check for pull api presence, else exception
+; (println "query-pull" args)
+  (assert (tupelo.datomic/contains-pull? args)
+          "query-pull: Only intended for queries using the Datomic Pull API")
+; (println "query-pull: past assert")
+  `(do
       (into []
           (for [tuple# (query* ~@args)]
             (into [] tuple#)))))

-(do
-  (println "----------------------------------------------------------------------------------------")
-  (println "query-pull expand")
-  (println (macroexpand
-             '(td/query-pull  :let    [$ db-val]
-                              :find   [ (pull ?c [*]) ]
-                              :where  [ [?c :community/name] ] ))))
-
 (defmacro query-tuple
   "Returns a single Tuple [s/Any] of query results"
-  [ & args ]
-  (println "query-tuple" args)
+  [& args]
   `(let [result-set# (query* ~@args) ]
       (assert (= 1 (count result-set#))
               "query-tuple: result-set must hold only one tuple")
@@ -336,8 +327,7 @@

 (defmacro query-scalar
   "Returns a scalar query result"
-  [ & args ]
-  (println "query-scalar:" args)
+  [& args]
   `(let [tuple# (query-tuple ~@args) ] ; retrieve the single-tuple result
       (assert (= 1 (count tuple#))
               "query-scalar: result-set must be a single scalar item")