Call me graph

Call me graph

--- src/com/wsscode/pathom/connect/planner.cljc
+++ src/com/wsscode/pathom/connect/planner.cljc
@@ -40,7 +40,7 @@
 (p.misc/spec-doc ::index-syms "An index from resolver symbol to a set of execution nodes where its used.")
 (p.misc/spec-doc ::node-id "ID for a execution node in the planner graph.")
 (p.misc/spec-doc ::nodes "The nodes index.")
-(p.misc/spec-doc ::previous-out "Graph before modifications, this is used to restore previous graph when some path ends up being unreachable.")
+(p.misc/spec-doc ::previous-graph "Graph before modifications, this is used to restore previous graph when some path ends up being unreachable.")
 (p.misc/spec-doc ::provides "An IO-MAP description of what will be provided once the node and its dependencies finishing running.")
 (p.misc/spec-doc ::requires "An IO-MAP description of what is required from this execution node to returns.")
 (p.misc/spec-doc ::root "A node-id that defines the root in the planner graph.")
@@ -69,7 +69,7 @@

 (declare compute-run-graph* compute-root-and)

-(defn base-out []
+(defn base-graph []
   {::nodes             {}
    ::index-syms        {}
    ::unreachable-syms  #{}
@@ -83,11 +83,11 @@
   (swap! id-counter inc))

 (defn get-node
-  [out node-id]
-  (get-in out [::nodes node-id]))
-
-(defn get-root-node [{::keys [root] :as out}]
-  (get-node out root))
+  [graph node-id]
+  (get-in graph [::nodes node-id]))
+
+(defn get-root-node [{::keys [root] :as graph}]
+  (get-node graph root))

 (defn node-kind [node]
   (cond
@@ -108,25 +108,25 @@
   (get-in index-resolvers [sym :com.wsscode.pathom.connect/dynamic-resolver?]))

 (defn attribute-provided?
-  "Check if the given attr is provided by the out root."
-  [{::keys [root] :as out} attr]
-  (and root (contains? (::provides (get-root-node out)) attr)))
+  "Check if the given attr is provided by the graph root."
+  [{::keys [root] :as graph} attr]
+  (and root (contains? (::provides (get-root-node graph)) attr)))

 (defn all-attributes-provided?
   "Check if all attrs are provided at the root."
-  [out attrs]
-  (every? #(attribute-provided? out %) attrs))
+  [graph attrs]
+  (every? #(attribute-provided? graph %) attrs))

 (defn add-unreachable-attr
   "Add attribute to unreachable list"
-  [out attr]
-  (update out ::unreachable-attrs conj attr))
+  [graph attr]
+  (update graph ::unreachable-attrs conj attr))

 (defn optimize-merge?
-  "Check if node and out point to same run-next."
-  [out {::keys [node-id]}]
-  (let [root-next (get-in out [::nodes (::root out) ::run-next])
-        node-next (get-in out [::nodes node-id ::run-next])]
+  "Check if node and graph point to same run-next."
+  [graph {::keys [node-id]}]
+  (let [root-next (get-in graph [::nodes (::root graph) ::run-next])
+        node-next (get-in graph [::nodes node-id ::run-next])]
     (and root-next (= root-next node-next))))

 (defn resolver-provides
@@ -153,27 +153,27 @@
 (defn find-dynamic-node-to-merge
   "Given some branch node, tries to find a node with a dynamic resolver that's the
   same sym as the node in node-id."
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {::keys [branch-type]
     :as    env}
    {::keys [node-id]}]
-  (let [node     (get-in out [::nodes node-id])
+  (let [node     (get-in graph [::nodes node-id])
         node-sym (pc-sym node)]
     (if (dynamic-resolver? env node-sym)
-      (some #(if (= node-sym (get-in out [::nodes % pc-sym])) %)
-        (get-in out [::nodes root branch-type])))))
+      (some #(if (= node-sym (get-in graph [::nodes % pc-sym])) %)
+        (get-in graph [::nodes root branch-type])))))

 (defn simplify-branch
   "If you pass a branch node with a single branch item, it removes the branch node
   from the graph and puts that single item on its place."
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {::keys [branch-type] :as env}]
-  (let [{::keys [run-next] :as root-node} (get-root-node out)
+  (let [{::keys [run-next] :as root-node} (get-root-node graph)
         items (get root-node branch-type)]
     (if (= 1 (count items))
       (let [item-node-id (first items)
-            item-node    (get-node out item-node-id)]
-        (-> out
+            item-node    (get-node graph item-node-id)]
+        (-> graph
             (update ::nodes dissoc root)
             (update-in [::nodes item-node-id] dissoc ::after-node)
             (cond->
@@ -183,57 +183,57 @@
                     (compute-root-and (assoc <> ::root run-next) env {::node-id (::run-next item-node)})
                     (assoc-in <> [::nodes item-node-id ::run-next] (::root <>)))))
             (assoc ::root item-node-id)))
-      out)))
+      graph)))

 (defn propagate-provides
   "This function is used to propagate back new provides after extending a node."
-  [out {::keys [node-id]}]
-  (loop [out     out
+  [graph {::keys [node-id]}]
+  (loop [graph   graph
          node-id node-id
          visited #{}]
     (if (contains? visited node-id)
       (do
         ; TODO double check if need this detection here once unreachable is properly implemented
         (println "Cycle detected" visited node-id)
-        out)
-      (let [{::keys [after-node provides]} (get-in out [::nodes node-id])]
+        graph)
+      (let [{::keys [after-node provides]} (get-in graph [::nodes node-id])]
         (if after-node
           (recur
-            (update-in out [::nodes after-node ::provides] merge-io (or provides {}))
+            (update-in graph [::nodes after-node ::provides] merge-io (or provides {}))
             after-node
             (conj visited node-id))
-          out)))))
+          graph)))))

 (defn remove-node
   "Remove a node from the graph. In case of resolver nodes it also removes them
   from the ::index-syms."
-  [out {::keys [node-id]}]
-  (let [node (get-node out node-id)]
-    (-> out
+  [graph {::keys [node-id]}]
+  (let [node (get-node graph node-id)]
+    (-> graph
         (update-in [::index-syms (pc-sym node)] disj node-id)
         (update ::nodes dissoc node-id))))

 (defn merge-node-requires
   "Merge requires from node into target-node-id."
-  [out target-node-id {::keys [requires]}]
-  (update-in out [::nodes target-node-id ::requires] merge-io requires))
+  [graph target-node-id {::keys [requires]}]
+  (update-in graph [::nodes target-node-id ::requires] merge-io requires))

 (defn merge-node-provides
   "Merge provides from node into target-node-id."
-  [out target-node-id {::keys [provides]}]
-  (update-in out [::nodes target-node-id ::provides] merge-io provides))
+  [graph target-node-id {::keys [provides]}]
+  (update-in graph [::nodes target-node-id ::provides] merge-io provides))

 (defn collapse-dynamic-nodes
   "Collapses new-node into collapse-node-id. This function is intended to be used
   to merge two dynamic nodes. When this happens, the requires and provides of both
   nodes will get merged, new-node is gonna be removed from the graph and new provides
   get propagated back."
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    env
    current-node-id
    next-node-id]
-  (let [{::keys [after-node input] :as node} (get-node out current-node-id)]
-    (-> out
+  (let [{::keys [after-node input] :as node} (get-node graph current-node-id)]
+    (-> graph
         (merge-node-requires next-node-id node)
         (merge-node-provides next-node-id node)
         (assoc-in [::nodes next-node-id ::input] input)
@@ -249,41 +249,41 @@
         (propagate-provides {::node-id next-node-id})
         (simplify-branch env))))

-(defn collapse-dynamic-chain [out node-id dyn-resolver]
-  (loop [{::keys [dynamic-nodes-visited] :as out} out
-         {::keys [run-next node-id]} (get-node out node-id)
-         {sym pc-sym :as next-node} (get-node out run-next)]
-    (let [out (update out ::dynamic-nodes-visited conj node-id)]
+(defn collapse-dynamic-chain [graph node-id dyn-resolver]
+  (loop [{::keys [dynamic-nodes-visited] :as graph} graph
+         {::keys [run-next node-id]} (get-node graph node-id)
+         {sym pc-sym :as next-node} (get-node graph run-next)]
+    (let [graph (update graph ::dynamic-nodes-visited conj node-id)]
       (if (and (not (contains? dynamic-nodes-visited node-id))
                (= sym dyn-resolver))
         (recur
-          (collapse-dynamic-nodes out {} node-id run-next)
+          (collapse-dynamic-nodes graph {} node-id run-next)
           next-node
-          (get-node out (::run-next next-node)))
-        out))))
-
-(defn collapse-all-dynamic-nodes [out]
+          (get-node graph (::run-next next-node)))
+        graph))))
+
+(defn collapse-all-dynamic-nodes [graph]
   (-> (reduce
-        (fn [out dyn-resolver]
+        (fn [graph dyn-resolver]
           (reduce
-            (fn [out node-id] (collapse-dynamic-chain out node-id dyn-resolver))
-            out
-            (get-in out [::index-syms dyn-resolver])))
-        (assoc out ::dynamic-nodes-visited #{})
-        (::dynamic-resolvers out))
-      (dissoc out ::dynamic-nodes-visited)))
+            (fn [graph node-id] (collapse-dynamic-chain graph node-id dyn-resolver))
+            graph
+            (get-in graph [::index-syms dyn-resolver])))
+        (assoc graph ::dynamic-nodes-visited #{})
+        (::dynamic-resolvers graph))
+      (dissoc graph ::dynamic-nodes-visited)))

 (defn add-branch-node
   "Given a branch node is the root, this function will add the new node as part
   of that branch node. If the node is a repeating dynamic node it will cause the new node
   to be collapsed into the already existent dynamic node."
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {::keys [branch-type] :as env}
    {::keys [node-id]}]
-  (let [node (get-node out node-id)]
-    (if-let [collapse-node-id (find-dynamic-node-to-merge out env node)]
-      (collapse-dynamic-nodes out env node-id collapse-node-id)
-      (-> out
+  (let [node (get-node graph node-id)]
+    (if-let [collapse-node-id (find-dynamic-node-to-merge graph env node)]
+      (collapse-dynamic-nodes graph env node-id collapse-node-id)
+      (-> graph
           (update-in [::nodes root branch-type] conj node-id)
           (merge-node-provides root node)
           (update-in [::nodes node-id] assoc ::after-node root)
@@ -291,20 +291,20 @@
             (= branch-type ::run-and)
             (merge-node-requires root node)

-            (optimize-merge? out node)
+            (optimize-merge? graph node)
             (-> (update-in [::nodes node-id] dissoc ::run-next)
                 (update-in [::nodes node-id] reset-provides env)))
           (simplify-branch env)))))

 (defn create-branch-node
-  [{::keys [root] :as out} env node branch-node]
-  (let [root-next      (get-in out [::nodes root ::run-next])
-        optimize-next? (optimize-merge? out node)
+  [{::keys [root] :as graph} env node branch-node]
+  (let [root-next      (get-in graph [::nodes root ::run-next])
+        optimize-next? (optimize-merge? graph node)
         branch-node    (cond-> branch-node
                          optimize-next?
                          (assoc ::run-next root-next))
         branch-node-id (::node-id branch-node)]
-    (-> out
+    (-> graph
         (assoc-in [::nodes branch-node-id] branch-node)
         (update-in [::nodes root] assoc ::after-node branch-node-id)
         (cond-> optimize-next?
@@ -315,51 +315,51 @@
         (add-branch-node env node))))

 (defn compute-root-branch
-  [out
+  [graph
    {::keys [branch-type] :as env}
    {::keys [node-id]}
    branch-node-factory]
   (if node-id
-    (let [root-node (get-root-node out)
-          next-node (get-node out node-id)]
+    (let [root-node (get-root-node graph)
+          next-node (get-node graph node-id)]
       (cond
         (not root-node)
-        (assoc out ::root node-id)
+        (assoc graph ::root node-id)

         (get next-node branch-type)
-        (add-branch-node (assoc out ::root node-id) env root-node)
+        (add-branch-node (assoc graph ::root node-id) env root-node)

         (get root-node branch-type)
-        (add-branch-node out env next-node)
+        (add-branch-node graph env next-node)

         :else
-        (create-branch-node out env next-node (branch-node-factory))))
-    out))
+        (create-branch-node graph env next-node (branch-node-factory))))
+    graph))

 (defn compute-root-or
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {:com.wsscode.pathom.connect/keys [attribute] :as env}
    node]
   (if (= root (::node-id node))
-    out
-    (compute-root-branch out (assoc env ::branch-type ::run-or) node
+    graph
+    (compute-root-branch graph (assoc env ::branch-type ::run-or) node
       (fn []
         {::node-id  (next-node-id env)
          ::requires {attribute {}}
-         ::provides (-> out get-root-node ::provides)
-         ::run-or   [(::root out)]}))))
+         ::provides (-> graph get-root-node ::provides)
+         ::run-or   [(::root graph)]}))))

 (defn compute-root-and
-  [{::keys [root] :as out} env node]
+  [{::keys [root] :as graph} env node]
   (if (= root (::node-id node))
-    out
-    (compute-root-branch out (assoc env ::branch-type ::run-and) node
+    graph
+    (compute-root-branch graph (assoc env ::branch-type ::run-and) node
       (fn []
-        (let [{::keys [requires provides]} (get-root-node out)]
+        (let [{::keys [requires provides]} (get-root-node graph)]
           {::node-id  (next-node-id env)
            ::requires requires
            ::provides provides
-           ::run-and  [(::root out)]})))))
+           ::run-and  [(::root graph)]})))))

 (def dynamic-base-provider-sym `run-graph-base-provider)

@@ -387,7 +387,7 @@
   [{ast :edn-query-language.ast/node
     :as env}]
   (let [sub-graph (compute-run-graph*
-                    (base-out)
+                    (base-graph)
                     (-> (base-env)
                         (merge (select-keys env [:com.wsscode.pathom.connect/index-resolvers
                                                  :com.wsscode.pathom.connect/index-oir]))
@@ -397,7 +397,7 @@

 (defn create-resolver-node
   "Create a new node representative to run a given resolver."
-  [out
+  [graph
    {::keys                           [run-next provides input source-sym]
     :com.wsscode.pathom.connect/keys [attribute sym]
     ast                              :edn-query-language.ast/node
@@ -407,7 +407,7 @@
                        {attribute (compute-nested-requires env)}
                        {attribute {}})
         sym-provides (or (resolver-provides env) requires)
-        next-node    (get-node out run-next)]
+        next-node    (get-node graph run-next)]
     (if (and false (dynamic-resolver? env sym)
              (= sym (pc-sym next-node)))
       (-> next-node
@@ -432,32 +432,32 @@
   have a run-next, it will be set for the one informed by the env. In case
   there is already something to run next the node, a wrap AND branch node will be
   inserted containing the previous node and the new one."
-  [out
+  [graph
    {::keys [run-next run-next-trail] :as env}
    extend-node-id]
   (if (or (not run-next)
           (contains? run-next-trail extend-node-id))
-    out
-    (let [node      (get-in out [::nodes extend-node-id])
-          new-out   (compute-root-and
-                      (assoc out ::root (::run-next node))
+    graph
+    (let [node      (get-in graph [::nodes extend-node-id])
+          new-graph (compute-root-and
+                      (assoc graph ::root (::run-next node))
                       env
                       {::node-id run-next})
-          next-node (or (get-in new-out [::nodes run-next])
-                        (get-in out [::nodes run-next]))]
-      (-> out
+          next-node (or (get-in new-graph [::nodes run-next])
+                        (get-in graph [::nodes run-next]))]
+      (-> graph
           (assoc
-            ::nodes (::nodes new-out)
-            ::index-syms (::index-syms new-out))
-          (assoc-in [::nodes extend-node-id ::run-next] (::root new-out))
-          (assoc-in [::nodes (::root new-out) ::after-node] extend-node-id)
+            ::nodes (::nodes new-graph)
+            ::index-syms (::index-syms new-graph))
+          (assoc-in [::nodes extend-node-id ::run-next] (::root new-graph))
+          (assoc-in [::nodes (::root new-graph) ::after-node] extend-node-id)
           (merge-node-provides extend-node-id next-node)
           (propagate-provides node)
           (update ::extended-nodes p.misc/sconj extend-node-id)))))

-(defn include-node [out env {::keys [node-id] :as node}]
+(defn include-node [graph env {::keys [node-id] :as node}]
   (let [sym (pc-sym node)]
-    (-> out
+    (-> graph
         (assoc-in [::nodes node-id] node)
         (cond->
           sym
@@ -466,9 +466,9 @@
           (and sym (dynamic-resolver? env sym))
           (update ::dynamic-resolvers p.misc/sconj sym)))))

-(defn merge-nodes-provides [out nodes]
+(defn merge-nodes-provides [graph nodes]
   (transduce
-    (keep #(get-in out [::nodes % ::provides]))
+    (keep #(get-in graph [::nodes % ::provides]))
     merge-io
     {}
     nodes))
@@ -478,16 +478,16 @@
       (::run-and node)))

 (defn collect-syms
-  ([out env node] (collect-syms out env node #{}))
-  ([out
+  ([graph env node] (collect-syms graph env node #{}))
+  ([graph
     env
     {::keys [node-id]} syms]
-   (let [node (get-in out [::nodes node-id])]
+   (let [node (get-in graph [::nodes node-id])]
      (if-let [sym (pc-sym node)]
        (if (dynamic-resolver? env sym)
          syms
          (conj syms sym))
-       (into syms (mapcat #(collect-syms out env {::node-id %}) (node-branches node)))))))
+       (into syms (mapcat #(collect-syms graph env {::node-id %}) (node-branches node)))))))

 (defn all-attribute-resolvers
   [{:com.wsscode.pathom.connect/keys [index-oir]}
@@ -497,50 +497,50 @@
     #{}))

 (defn mark-node-unreachable
-  [previous-out
-   out
+  [previous-graph
+   graph
    {::keys [unreachable-syms
             unreachable-attrs]}
    env]
-  (let [syms (into unreachable-syms (collect-syms out env (get-root-node out)))
-        syms (into (::unreachable-syms previous-out) syms)]
-    (cond-> (assoc previous-out
+  (let [syms (into unreachable-syms (collect-syms graph env (get-root-node graph)))
+        syms (into (::unreachable-syms previous-graph) syms)]
+    (cond-> (assoc previous-graph
               ::unreachable-syms syms
               ::unreachable-attrs unreachable-attrs)
       (set/subset? (all-attribute-resolvers env (pc-attr env)) syms)
       (update ::unreachable-attrs conj (pc-attr env)))))

-(defn compute-missing-chain [out {::keys [previous-out] :as env} missing]
+(defn compute-missing-chain [graph {::keys [previous-graph] :as env} missing]
   (if (seq missing)
-    (let [root-node (get-root-node out)
-
-          {::keys [extended-nodes] :as graph}
+    (let [root-node (get-root-node graph)
+
+          {::keys [extended-nodes] :as graph'}
           (compute-run-graph*
-            (dissoc out ::root)
+            (dissoc graph ::root)
             (-> env
                 (dissoc pc-attr)
-                (update ::run-next-trail p.misc/sconj (::root out))
+                (update ::run-next-trail p.misc/sconj (::root graph))
                 (update ::attr-deps-trail p.misc/sconj (pc-attr env))
                 (assoc ast-node (eql/query->ast (vec missing))
-                  ::run-next (::root out)
+                  ::run-next (::root graph)
                   ::provides (::provides root-node))))]

-      (let [all-provides  (merge-nodes-provides graph extended-nodes)
+      (let [all-provides  (merge-nodes-provides graph' extended-nodes)
             still-missing (remove all-provides missing)]
         (if (or (and
-                  (::root graph)
-                  (all-attributes-provided? graph missing))
+                  (::root graph')
+                  (all-attributes-provided? graph' missing))
                 (not (seq still-missing)))
-          graph
-          (let [{::keys [unreachable-syms] :as out'} (mark-node-unreachable previous-out out graph env)
+          graph'
+          (let [{::keys [unreachable-syms] :as out'} (mark-node-unreachable previous-graph graph graph' env)
                 unreachable-attrs (filter #(set/subset? (all-attribute-resolvers env %) unreachable-syms) still-missing)]
             (update out' ::unreachable-attrs into unreachable-attrs)))))
-    out))
+    graph))

 (defn get-resolver-extension-node-id
-  [{::keys [index-syms] :as out} env]
+  [{::keys [index-syms] :as graph} env]
   (let [resolver (pc-sym env)]
-    (and (contains? (::index-syms out) resolver)
+    (and (contains? (::index-syms graph) resolver)
          (not (dynamic-resolver? env resolver))
          (first (get index-syms resolver)))))

@@ -554,47 +554,47 @@
         sym)))

 (defn compute-resolver-graph
-  [{::keys [unreachable-syms] :as out}
+  [{::keys [unreachable-syms] :as graph}
    {::keys [run-next]
     :as    env}
    resolver]
   (let [resolver' (runner-node-sym env resolver)]
     (if (contains? unreachable-syms resolver')
-      out
+      graph
       (let [env (assoc env pc-sym resolver' ::source-sym resolver)]
-        (if-let [sym-node-id (get-resolver-extension-node-id out env)]
-          (-> (extend-node-run-next out env sym-node-id)
+        (if-let [sym-node-id (get-resolver-extension-node-id graph env)]
+          (-> (extend-node-run-next graph env sym-node-id)
               (update-in [::nodes sym-node-id ::requires] merge-io {(pc-attr env) {}})
               (update-in [::nodes sym-node-id ::provides] merge-io {(pc-attr env) {}}))
-          (let [node (create-resolver-node out env)]
-            (-> out
+          (let [node (create-resolver-node graph env)]
+            (-> graph
                 (include-node env node)
                 (cond-> (and run-next (not= run-next (::node-id node)))
                         (assoc-in [::nodes run-next ::after-node] (::node-id node)))
                 (compute-root-or env node))))))))

 (defn compute-input-resolvers-graph
-  [out
+  [graph
    {::keys [available-data]
     :as    env}
    inputs resolvers]
   (let [missing (into #{} (remove #(contains? available-data %)) inputs)
         env     (assoc env ::input (into {} (map #(hash-map % {})) inputs))]
     (if (contains? inputs (pc-attr env))
-      out
-      (as-> out <>
-        (dissoc out ::root)
+      graph
+      (as-> graph <>
+        (dissoc graph ::root)
         ; resolvers loop
         (reduce
-          (fn [out resolver] (compute-resolver-graph out env resolver))
+          (fn [graph resolver] (compute-resolver-graph graph env resolver))
           <>
           resolvers)

         (if (::root <>)
           (-> <>
-              (compute-missing-chain (assoc env ::previous-out out) missing)
-              (compute-root-or env {::node-id (::root out)}))
-          (assoc <> ::root (::root out)))))))
+              (compute-missing-chain (assoc env ::previous-graph graph) missing)
+              (compute-root-or env {::node-id (::root graph)}))
+          (assoc <> ::root (::root graph)))))))

 (defn prepare-ast
   "Prepare AST from query. This will lift placeholder nodes, convert
@@ -610,42 +610,42 @@
                   children))))))

 (defn find-latest-providing-node
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {:com.wsscode.pathom.connect/keys [attribute]}]
   (loop [node-id root]
-    (let [next-node-id (-> (get-node out node-id) ::run-next)]
+    (let [next-node-id (-> (get-node graph node-id) ::run-next)]
       (cond
         (not next-node-id)
         node-id

-        (not (contains? (get-in out [::nodes next-node-id ::provides]) attribute))
+        (not (contains? (get-in graph [::nodes next-node-id ::provides]) attribute))
         node-id

         :else
         (recur next-node-id)))))

 (defn compute-attribute-graph*
-  [{::keys [root] :as out}
+  [{::keys [root] :as graph}
    {:com.wsscode.pathom.connect/keys [index-oir attribute]
     ::keys                           [skip-attr-provided?]
     :as                              env}]
-  (if (and skip-attr-provided? (attribute-provided? out attribute))
-    (update-in out [::nodes root ::requires] merge-io {attribute {}})
-    (let [new-out
-          (as-> out <>
+  (if (and skip-attr-provided? (attribute-provided? graph attribute))
+    (update-in graph [::nodes root ::requires] merge-io {attribute {}})
+    (let [new-graph
+          (as-> graph <>
             (dissoc <> ::root)
             (reduce-kv
-              (fn [out inputs resolvers]
-                (compute-input-resolvers-graph out env inputs resolvers))
+              (fn [graph inputs resolvers]
+                (compute-input-resolvers-graph graph env inputs resolvers))
               <>
               (get index-oir attribute)))]
-      (if (::root new-out)
-        (compute-root-and new-out env {::node-id root})
-        (assoc new-out ::root root)))))
+      (if (::root new-graph)
+        (compute-root-and new-graph env {::node-id root})
+        (assoc new-graph ::root root)))))

 (defn compute-attribute-graph
   "Compute the run graph for a given attribute."
-  [{::keys [unreachable-attrs] :as out}
+  [{::keys [unreachable-attrs] :as graph}
    {::keys                           [available-data attr-deps-trail]
     :com.wsscode.pathom.connect/keys [index-oir]
     {attr :key}                      :edn-query-language.ast/node
@@ -655,13 +655,13 @@
       (or (contains? available-data attr)
           (contains? unreachable-attrs attr)
           (contains? attr-deps-trail attr))
-      out
+      graph

       (contains? index-oir attr)
-      (compute-attribute-graph* out env)
+      (compute-attribute-graph* graph env)

       :else
-      (add-unreachable-attr out attr))))
+      (add-unreachable-attr graph attr))))

 (defn compute-run-graph*
   "Generates a run plan for a given environment, the environment should contain the
@@ -669,15 +669,15 @@
   one level of an AST, the AST must be provided via the key :edn-query-language.ast/node.

        (compute-run-graph (assoc indexes :edn-query-language.ast/node ...))"
-  ([out env]
+  ([graph env]
    (reduce
-     (fn [out ast] (compute-attribute-graph out
+     (fn [graph ast] (compute-attribute-graph graph
                      (assoc env :edn-query-language.ast/node ast)))
-     out
+     graph
      (remove (comp eql/ident? :key) (:children (ast-node env)))))

   ([env]
-   (compute-run-graph* (base-out)
+   (compute-run-graph* (base-graph)
      (merge
        (base-env)
        env))))
@@ -688,12 +688,12 @@
   one level of an AST, the AST must be provided via the key :edn-query-language.ast/node.

        (compute-run-graph (assoc indexes :edn-query-language.ast/node ...))"
-  ([out env]
-   (-> (compute-run-graph* (merge (base-out) out) (merge (base-env) env))
+  ([graph env]
+   (-> (compute-run-graph* (merge (base-graph) graph) (merge (base-env) env))
        collapse-all-dynamic-nodes))

   ([env]
-   (compute-run-graph (base-out)
+   (compute-run-graph (base-graph)
      (merge
        (base-env)
        env))))


cleaned view code

cleaned view code

--- examples/todomvc/src/app/view.cljs
+++ examples/todomvc/src/app/view.cljs
@@ -1,15 +1,7 @@
 (ns app.view
   (:require [reagent.core :as r]))

-(defn -enter-key?
-  [e]
-  (= (.-keyCode e) 13))
-
-(defn -escape-key?
-  [e]
-  (= (.-keyCode e) 27))
-
-(defn -view-header
+(defn -header
   [field dispatch]
   [:header.header
    [:h1 "todos"]
@@ -18,7 +10,10 @@
                      :on-change   #(dispatch [:on-update-field (.. % -target -value)])
                      :on-key-down #(when (-enter-key? %) (dispatch :on-add))}]])

-(defn -view-todo-input
+(defn -enter-key? [e] (= (.-keyCode e) 13))
+(defn -escape-key? [e] (= (.-keyCode e) 27))
+
+(defn -todo-input
   "Note that |editing?| is passed only to trigger :component-did-update to set focus on the state change."
   [_id _title _editing? _dispatch]
   (r/create-class {:reagent-render
@@ -41,39 +36,36 @@
                    (fn [this]
                      (.focus (r/dom-node this)))}))

-(defn -view-todo
+(defn -todo
   [{:keys [id title editing? completed?] :as _todo} dispatch]
   [:li {:class (cond editing? "editing" completed? "completed")}
    [:div.view
     [:input.toggle {:type      "checkbox"
                     :checked   completed?
                     :on-change #(dispatch [:on-toggle id])}]
-
     [:label {:on-double-click #(dispatch [:on-start-editing id])} title]
-
     [:button.destroy {:on-click #(dispatch [:on-remove id])}]]

-   [-view-todo-input id title editing? dispatch]])
+   [-todo-input id title editing? dispatch]])

-(defn -view-todo-list
+(defn -todo-list
   [todos all-completed? dispatch]
   [:section.main
    [:input.toggle-all {:type      "checkbox"
                        :checked   all-completed?
                        :on-change #(dispatch :on-toggle-all)}]
    [:label {:for "toggle-all"} "Mark all as complete"]
-
    [:ul.todo-list
     (for [todo todos]
       ^{:key (:id todo)}
-      [-view-todo todo dispatch])]])
+      [-todo todo dispatch])]])

-(defn -view-footer
+(defn -footer
   [active-count has-completed-todos? visibility visibility-spec dispatch]
   [:footer.footer
    [:span.todo-count
-    [:strong active-count] (str " " (if (= active-count 1) "item" "items")
-                                " left")]
+    [:strong active-count] " " (if (= active-count 1) "item" "items") " left"]
+
    [:ul.filters
     (for [{:keys [key title href]} visibility-spec]
       ^{:key key}
@@ -82,7 +74,7 @@
              :class (if (= visibility key) "selected")}
             title]])]

-   (if has-completed-todos?
+   (when has-completed-todos?
      [:button.clear-completed {:on-click #(dispatch :on-clear-completed)} "Clear completed"])])

 (defn view
@@ -90,9 +82,9 @@
     :as   _view-model}
    dispatch]
   [:section.todoapp
-   [-view-header @field dispatch]
+   [-header @field dispatch]

    (when @has-todos?
      [:div
-      [-view-todo-list @todos @all-completed? dispatch]
-      [-view-footer @active-count @has-completed-todos? @visibility @visibility-spec dispatch]])])+      [-todo-list @todos @all-completed? dispatch]
+      [-footer @active-count @has-completed-todos? @visibility @visibility-spec dispatch]])])


DJSON-18 Tests for printing indented json

Signed-off-by: Alex Miller <99328387f8334f68433c424d2dfd83062f62754b@cognitect.com>


Make the tests pass

Make the tests pass

--- src/caesium/magicnonce/secretbox.clj
+++ src/caesium/magicnonce/secretbox.clj
@@ -13,7 +13,8 @@
   resistance, use [[secretbox-rnd]]. The other functions are fairly
   limited use."
   (:require [caesium.crypto.secretbox :as s]
-            [caesium.randombytes :as r])
+            [caesium.randombytes :as r]
+            [caesium.crypto.generichash :as g])
   (:import [java.nio ByteBuffer]))

 (defn secretbox-pfx
@@ -66,6 +67,9 @@
   [msg key]
   (secretbox-pfx msg (random-nonce!) key))

+(def ^:private synthetic-personal
+  (.getBytes "sodium autononce"))
+
 (defn ^:private synthetic-nonce
   "Creates a synthetic nonce from the given plaintext.

@@ -73,7 +77,10 @@
   no visible side effects: the same plaintext will always generate the
   same byte array. However, note that the returned nonce will be a
   mutable byte array."
-  [plaintext])
+  [key plaintext]
+  (g/blake2b plaintext {:size s/noncebytes
+                        :key key
+                        :personal synthetic-personal}))

 (defn secretbox-det
   "secretbox, with deterministic nonce.


Use (non-lazy) vectors to avoid stack overflow

--- src/clj/cglossa/data_import/core.clj
+++ src/clj/cglossa/data_import/core.clj
@@ -51,23 +51,24 @@
   Since each tid represents a corpus text, this amounts to connecting the metadata
   values to their respective texts."
   (let [tid-tx-map (first value-tx-maps)]
-    ; tx-maps is a sequence of maps, one for each non-first column
-    ; (i.e., non-tid category)
-    (loop [tx-maps (rest value-tx-maps)
+    ; tx-maps is a vector of maps, one for each non-first column
+    ; (i.e., non-tid category). Converts to vectors to avoid stack
+    ; overflows due to lazy sequences when the number of rows is large.
+    (loop [tx-maps (vec (rest value-tx-maps))
            rows value-rows]
       (let [row (first rows)
             [tid & other-cat-values] row
             tid-id (-> tid-tx-map (get tid) :db/id)
-            tx-maps (map (fn [value value-tx-map]
-                           (update-in value-tx-map
-                                      [value :metadata-value/tids]
-                                      conj tid-id))
-                         other-cat-values
-                         tx-maps)
+            tm (mapv (fn [value value-tx-map]
+                       (update-in value-tx-map
+                                  [value :metadata-value/tids]
+                                  conj tid-id))
+                     other-cat-values
+                     tx-maps)
             rest-rows (rest rows)]
         (if (seq rest-rows)
-          (recur tx-maps rest-rows)
-          (mapcat vals (conj tx-maps tid-tx-map)))))))
+          (recur tm rest-rows)
+          (mapcat vals (conj tm tid-tx-map)))))))

 (defn import-corpora []
   (tsv->tx-data (str data-path "/corpora.tsv") :corpus))


replace cell log

replace cell log

--- src/clj/neb/durability/serv/logs.clj
+++ src/clj/neb/durability/serv/logs.clj
@@ -1,6 +1,6 @@
 (ns neb.durability.serv.logs
   (:require [neb.durability.serv.file-reader :refer [read-bytes]]
-            [neb.core :refer [new-cell-by-raw* delete-cell*]]
+            [neb.core :refer [new-cell-by-raw* delete-cell* replace-cell*]]
             [clojure.java.io :as io])
   (:import (com.google.common.primitives Ints Longs)
            (java.io OutputStream)
@@ -24,7 +24,7 @@
   (let [reader (io/input-stream log-path)]
     (while (> (.available reader) 0)
       (let [act (byte (.read reader))
-            has-body? (zero? act)
+            has-body? (pos? act)
             timestamp (read-long reader)
             cell-id (UUID. (read-long reader) (read-long reader))
             body-read? (when has-body? (atom false))
@@ -43,4 +43,5 @@
       (when (> timestamp trunk-timestamp)
         (case act
           0 (new-cell-by-raw* cell-id (read-body))
-          1 (delete-cell* cell-id))))))+          1 (replace-cell* cell-id (read-body))
+          -1 (delete-cell* cell-id))))))


ENH: chapter 5, part 2: sequence abstraction

--- src/clj_prj03/ch5_core_functions.clj
+++ src/clj_prj03/ch5_core_functions.clj
@@ -23,3 +23,179 @@
 ;; casting can be done with (into)
 (into {} (map (fn [[key val]] [key (inc val)])
   {:max 30 :min 10}))
+
+  ; ----------------------------------
+  ; Part 2: Sequence Abstraction
+  ; ----------------------------------
+
+  ; Objects may be treated as a seq:
+
+  (map identity {:name "Bill Compton" :occupation "Dead mopey guy"})
+  (seq {:name "Bill Compton" :occupation "Dead mopey guy"})
+  ;; -> both return a seq (list of vectors)
+
+  ; map function
+  (map inc [1 2 3])
+
+  (map str ["a" "b" "c"] ["A" "B" "C"])
+  ;; equivalent to:
+  (list (str "a" "A") (str "b" "B") (str "c" "C"))
+
+  (def human-consumption [8.1 7.3 6.6 5.0])
+  (def critter-consumption [0.0 0.2 0.3 1.1])
+  (defn unify-diet-data
+    [human critter]
+    {:human human
+     :critter critter})
+
+  (map unify-diet-data human-consumption critter-consumption)
+
+  ;; you can also pass a collection of functions to map
+  (def sum #(reduce + %))
+  (def avg #(/ (sum %) (count %)))
+  (defn stats
+    [numbers]
+    (map #(% numbers) [sum count avg]))
+
+  (stats [3 4 10])
+  (stats [80 1 44 13 6])
+
+
+  ; reduce function
+  (reduce (fn [new-map [key val]]
+             (assoc new-map key (inc val)))
+          {}
+          {:max 30 :min 10})
+
+  (reduce (fn [new-map [key val]]
+            (if (> val 4)
+               (assoc new-map key val)
+                new-map))
+    {}
+    {:human 4.1
+     :critter 3.9})
+
+  ; take, drop, take-while, drop-while
+  (take 3 [1 2 3 4 5 6 7 8 9 10])  ; [1 2 3]
+  (drop 3 [1 2 3 4 5 6 7 8 9 10])  ; [4 5 6 7 8 9 10]
+
+  (def food-journal
+    [{:month 1 :day 1 :human 5.3 :critter 2.3}
+     {:month 1 :day 2 :human 5.1 :critter 2.0}
+     {:month 2 :day 1 :human 4.9 :critter 2.1}
+     {:month 2 :day 2 :human 5.0 :critter 2.5}
+     {:month 3 :day 1 :human 4.2 :critter 3.3}
+     {:month 3 :day 2 :human 4.0 :critter 3.8}
+     {:month 4 :day 1 :human 3.7 :critter 3.9}
+     {:month 4 :day 2 :human 3.7 :critter 3.6}])
+
+  (take-while #(< (:month %) 3) food-journal)
+  (drop-while #(< (:month %) 3) food-journal)
+  (take-while #(< (:month %) 4)
+              (drop-while #(< (:month %) 2) food-journal))
+
+  ; filter, some
+
+  (filter #(< (:human %) 5) food-journal)  ; goes through all
+  (some #(> (:critter %) 5) food-journal)
+  (some #(> (:critter %) 3) food-journal)
+  ; checks if a condition holds for any element in the sequence
+
+  (some #(and (> (:critter %) 3) %) food-journal)
+
+  ; sort
+  (sort [3 1 2])
+  (sort-by count ["aaa" "c" "bb"])
+
+  ; concat
+  (concat [1 2] [3 4])
+
+  ; 2.3 Lazy seqs
+  (def vampire-database
+    {0 {:makes-blood-puns? false, :has-pulse? true :name "McFishwich"}
+     1 {:makes-blood-puns? false, :has-pulse? true :name "McMackson"}
+     2 {:makes-blood-puns? true, :has-pulse? false :name "Damon Salvatore"}
+     3 {:makes-blood-puns? true, :has-pulse? true :name "Mickey Mouse"}})
+
+  (defn vampire-related-details
+    [ssn]
+    (Thread/sleep 1000)
+    (get vampire-database ssn))
+
+  (defn vampire?
+    [record]
+    (and (:makes-blood-puns? record)
+         (not (:has-pulse? record))))
+
+  (defn identify-vampire
+    [ssn]
+    (first (filter vampire?
+      (map vampire-related-details ssn))))
+
+  ;; clojure clusters in groups of 32
+  ;; so this takes 32 seconds, not 3 seconds
+  (time (identify-vampire (range 0 1000000)))
+
+
+  (def identities
+    [{:alias "Batman" :real "Bruce Wayne"}
+     {:alias "Spiderman" :real "Peter Parker"}
+     {:alias "Santa" :real "Your mom"}
+     {:alias "Easter Bunny" :real "Your dad"}
+     {:alias "alias 5", :real "real 5"}
+     {:alias "alias 6", :real "real 6"}
+     {:alias "alias 7", :real "real 7"}
+     {:alias "alias 8", :real "real 8"}
+     {:alias "alias 9", :real "real 9"}
+     {:alias "alias 10", :real "real 10"}
+     {:alias "alias 11", :real "real 11"}
+     {:alias "alias 12", :real "real 12"}
+     {:alias "alias 13", :real "real 13"}
+     {:alias "alias 14", :real "real 14"}
+     {:alias "alias 15", :real "real 15"}
+     {:alias "alias 16", :real "real 16"}
+     {:alias "alias 17", :real "real 17"}
+     {:alias "alias 18", :real "real 18"}
+     {:alias "alias 19", :real "real 19"}
+     {:alias "alias 20", :real "real 20"}
+     {:alias "alias 21", :real "real 21"}
+     {:alias "alias 22", :real "real 22"}
+     {:alias "alias 23", :real "real 23"}
+     {:alias "alias 24", :real "real 24"}
+     {:alias "alias 25", :real "real 25"}
+     {:alias "alias 26", :real "real 26"}
+     {:alias "alias 27", :real "real 27"}
+     {:alias "alias 28", :real "real 28"}
+     {:alias "alias 29", :real "real 29"}
+     {:alias "alias 30", :real "real 30"}
+     {:alias "alias 31", :real "real 31"}
+     {:alias "alias 32", :real "real 32"}
+     {:alias "alias 33", :real "real 33"}
+     {:alias "alias 34", :real "real 34"}])
+
+  (defn snitch
+    "Announce real identity to the world"
+    [identity]
+    (println (:real identity))
+    (:real identity))
+
+  (def revealed-identities (map snitch identities))
+  (first revealed-identities)
+
+;; doesn't print real 33 and real 34
+
+;; lazy value is also cached:
+(first revealed-identities) ;; doesn't reprint whole sequence
+
+(doall revealed-identities)
+
+; Infinite sequences
+(concat (take 8 (repeat "na")) ["Batman!"])
+(take 3 (repeatedly (fn [] (rand-int 10))))
+
+(defn even-numbers
+  ([] (even-numbers 0))
+  ([n] (cons n (lazy-seq (even-numbers (+ n 2))))))
+(take 10 (even-numbers))
+
+(cons 0 '(2 4 6))


Correct current-locations subscription fnil

Moving to one input signal makes it not wrapped in a vector anymore...

--- src/cljs/comic_reader/ui/reader.cljs
+++ src/cljs/comic_reader/ui/reader.cljs
@@ -180,7 +180,7 @@
     (re-frame/reg-sub
      :current-locations
      :<- [:partitioned-locations]
-     (fn current-locations-sub [[partitioned-locations] _]
+     (fn current-locations-sub [partitioned-locations _]
        (current-locations partitioned-locations)))))

 (defn- location-id [location]


fixing port

fixing port

--- src-clj/cljs_workspace/server.clj
+++ src-clj/cljs_workspace/server.clj
@@ -23,7 +23,7 @@

 (defn start-server []
   (when server (stop-server))
-  (reset! server (http/run-server #'all-routes {:port 8080})))
+  (reset! server (http/run-server #'all-routes {:port 9081})))

 (comment
   (star-server)


Add clj->vim transformation for nil

Add clj->vim transformation for nil

--- src/main/clojure/vimclojure/util.clj
+++ src/main/clojure/vimclojure/util.clj
@@ -232,6 +232,10 @@
   [thing]
   (str thing))

+(defmethod clj->vim nil
+  [_]
+  0)
+
 (defn safe-var-get
   [the-var]
   (when (.isBound the-var)


small styling tweak for readability.

small styling tweak for readability.


Don't need byte-streams in store tests.

Don't need byte-streams in store tests.

--- src/blocks/store/tests.clj
+++ src/blocks/store/tests.clj
@@ -2,11 +2,10 @@
   "Suite of tests to verify that a given block store implementation conforms to
   the spec."
   (:require
-    [alphabase.bytes :refer [random-bytes]]
+    [alphabase.bytes :refer [bytes= random-bytes]]
     [alphabase.hex :as hex]
     [blocks.core :as block]
     [blocks.summary :as sum]
-    [byte-streams :as bytes :refer [bytes=]]
     [clojure.java.io :as io]
     [clojure.test :refer :all]
     [clojure.test.check :as check]
@@ -318,7 +317,7 @@
   (check
     [this model result]
     (if-let [block (get model id)]
-      (is (bytes= (.toBuffer ^PersistentBytes @block) result))
+      (is (bytes= (.toByteArray ^PersistentBytes @block) result))
       (is (nil? result)))))


Add not monadic version functions to compact ns.

--- src/buddy/sign/compact.clj
+++ src/buddy/sign/compact.clj
@@ -113,3 +113,15 @@
     (if (verify-signature candidate signature key alg)
       (either/right (nippy/thaw input {:v1-compatibility? false}))
       (either/left "Invalid signature."))))
+
+(defn sign
+  "Not monadic version of encode."
+  [& args]
+  (either/from-either (apply encode args)))
+
+(defn unsign
+  "Not monadic version of decode."
+  [& args]
+  (let [result (apply decode args)]
+    (when (either/right? result)
+      (either/from-either result))))


Clean ns decl

Clean ns decl

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -1,13 +1,13 @@
 (ns catalog.layout.fop
   (:require [catalog.layout.common :as layout :refer [wrap]]
+            [clj-time.core :as time.core]
             [clojure
              [set :as set]
              [string :as string]
              [walk :as walk]]
             [clojure.data.xml :as xml]
             [clojure.java.io :as io]
-            [endophile.core :as endophile]
-            [clj-time.core :as time.core])
+            [endophile.core :as endophile])
   (:import java.io.StringReader
            javax.xml.transform.sax.SAXResult
            javax.xml.transform.stream.StreamSource


Put phone and fax number inside a table

Put phone and fax number inside a table

to align them nicely

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -554,8 +554,16 @@
              [:fo:block "Blinde, Seh- und Lesebehinderte"]
              [:fo:block "Grubenstrasse 12"]
              [:fo:block "CH-8045 Zürich"]
-             [:fo:block "Fon +41 43 333 32 32"]
-             [:fo:block "Fax +41 43 333 32 33"]
+             [:fo:table {:table-layout "fixed" :width"100%"}
+              [:fo:table-column {:column-width "12mm"}]
+              [:fo:table-column {:column-width "proportional-column-width(1)"}]
+              [:fo:table-body {:start-indent "0mm" :end-indent "0mm"}
+               [:fo:table-row
+                [:fo:table-cell [:fo:block "Fon"]]
+                [:fo:table-cell [:fo:block "+41 43 333 32 32"]]]
+               [:fo:table-row
+                [:fo:table-cell [:fo:block "Fax"]]
+                [:fo:table-cell [:fo:block "+41 43 333 32 33"]]]]]
              [:fo:block
               (external-link "http://www.sbs.ch" "www.sbs.ch" "Link zur SBS Website")]
              (block {:space-before "1em"} "Abonnement, Ausleihe und Verkauf: "


Fix the validation of ludo CatalogItems

Fix the validation of ludo CatalogItems

--- src/catalog/validation.clj
+++ src/catalog/validation.clj
@@ -8,6 +8,9 @@

 (def Genre
   (apply s/enum (vals vubis/genre-raw-to-genre)))
+
+(def LudoGenre
+  (apply s/enum (vals vubis/genre-raw-to-ludo-genre)))

 (def SubGenre
   (apply s/enum (vals vubis/genre-raw-to-subgenre)))
@@ -122,7 +125,7 @@
  Spiel CatalogItem [:ludo]
  {:source-publisher s/Str
   :source-date s/Inst
-  :genre (s/eq :spiel)
+  :genre LudoGenre
   :genre-text s/Str
   (s/optional-key :accompanying-material) s/Str
   :game-description s/Str})


make adding threads preserve new message

--- src/chat/client/store.cljs
+++ src/chat/client/store.cljs
@@ -208,7 +208,7 @@
                              msg)))))

 (defn add-threads! [threads]
-  (transact! [:threads] #(merge % (key-by-id threads))))
+  (transact! [:threads] #(merge-with merge % (key-by-id threads))))

 (defn add-open-thread! [thread]
   ; TODO move notifications logic out of here
@@ -217,7 +217,7 @@
     (set! (.-title js/document)
           (str "Chat (" (get-in @app-state [:notifications :unread-count]) ")")))

-  (transact! [:threads (thread :id)] (constantly thread))
+  (transact! [:threads (thread :id)] #(merge % thread))
   (transact! [:user :open-thread-ids] #(conj % (thread :id))))

 (defn hide-thread! [thread-id]
@@ -238,17 +238,17 @@
 ; channels page

 (defn set-channel-results! [threads]
-  (transact! [:threads] #(merge % (key-by-id threads)))
+  (transact! [:threads] #(merge-with merge % (key-by-id threads)))
   (transact! [:page :thread-ids] (constantly (map :id threads))))

 (defn add-channel-results! [threads]
-  (transact! [:threads] #(merge % (key-by-id threads)))
+  (transact! [:threads] #(merge-with merge % (key-by-id threads)))
   (transact! [:page :thread-ids] #(concat % (map :id threads))))

 ; search threads

 (defn set-search-results! [{:keys [threads thread-ids]}]
-  (transact! [:threads] #(merge % (key-by-id threads)))
+  (transact! [:threads] #(merge-with merge % (key-by-id threads)))
   (transact! [:page :thread-ids] (constantly thread-ids)))

 (defn set-search-query! [query]


move leanpixel-specific stuff to profiles

--- src/chat/server/invite.clj
+++ src/chat/server/invite.clj
@@ -83,21 +83,21 @@
   [invite]
   (let [accept-link (make-invite-link invite)]
     {:text (str (invite :inviter-email) " has invited to join the " (invite :group-name)
-                " group on chat.leanpixel.com.\n\n"
+                " group on " (env :site-url) ".\n\n"
                 "Go to " accept-link " to accept.")
      :html (str ""
                 (invite :inviter-email) " has invited to join the " (invite :group-name)
-                " group on chat.leanpixel.com."
+                " group on " (env :site-url) "."
                 "
"
                 "Click here to accept."
                 "")}))

 (defn send-invite
   [invite]
-  (http/post "https://api.mailgun.net/v3/chat.leanpixel.com/messages"
+  (http/post "https://api.mailgun.net/v3/" (env :mailgun-domain) "/messages"
              {:basic-auth ["api" (env :mailgun-password)]
               :form-params (merge {:to (invite :invitee-email)
-                                   :from "noreply@chat.leanpixel.com"
+                                   :from (str "noreply@" (env :mailgun-domain))
                                    :subject "Join the conversation"}
                                   (invite-message invite))}))

@@ -146,7 +146,7 @@
               ; TODO
               (last (string/split (f :filename) #"\.")))
         avatar-filename (str (java.util.UUID/randomUUID) "." ext)]
-    (s3/put-object creds "chat.leanpixel.com" (str "avatars/" avatar-filename) (f :tempfile)
+    (s3/put-object creds (env :aws-domain) (str "avatars/" avatar-filename) (f :tempfile)
                    {:content-type (f :content-type)})
-    (s3/update-object-acl creds "chat.leanpixel.com" (str "avatars/" avatar-filename) (s3/grant :all-users :read))
-    (str "https://s3.amazonaws.com/chat.leanpixel.com/avatars/" avatar-filename)))
+    (s3/update-object-acl creds (env :aws-domain) (str "avatars/" avatar-filename) (s3/grant :all-users :read))
+    (str "https://s3.amazonaws.com/" (env :aws-domain) "/avatars/" avatar-filename)))


implement Vikram 1.0

implement Vikram 1.0

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -775,6 +775,12 @@
                 {:label "Trace 4 - End the run"
                  :trace {:base 4 :msg "end the run" :effect (effect (end-run))}}]}

+   "Vikram 1.0"
+   {:abilities [{:msg "prevent the Runner from using programs for the remainder of this run"}
+                {:label "Trace 4 - Do 1 brain damage"
+                 :trace {:base 4 :msg "do 1 brain damage"
+                         :effect (effect (damage :brain 1 {:card card}))}}]}
+
    "Viktor 1.0"
    {:abilities [{:msg "do 1 brain damage" :effect (effect (damage :brain 1 {:card card}))} end-the-run]}


Add installed-byname helper function and update in-play?

This function will look up whether a card with the given name is
currently installed. This is useful for checking if cards like Gene
Conditioning Shoppe are installed, as they are not targets during card
events or abilities.

in-play? used almost the same logic, so modfy it to avoid duplication.

--- src/clj/game/core-misc.clj
+++ src/clj/game/core-misc.clj
@@ -70,7 +70,12 @@
     (let [servers (->> (:corp @state) :servers seq flatten)]
       (concat (mapcat :content servers) (mapcat :ices servers)))))

+(defn installed-byname
+  "Returns a truthy card map if a card matching title is installed"
+  [state side title]
+  (some #(when (= (:title %) title) %) (all-installed state side)))
+
 (defn in-play?
   "Returns a truthy card map if the given card is in play (installed)."
   [state card]
-  (some #(= (:title %) (:title card)) (all-installed state (:side card))))
+  (installed-byname state (to-keyword (:side card)) (:title card)))


prefer `when` to `if` when there's no else branch

--- src/clj/shale/sessions.clj
+++ src/clj/shale/sessions.clj
@@ -284,7 +284,7 @@
                                             :go-to-url :current-url})
                               (if-not (nil? new-tags)
                                 {:tags new-tags}))]
-      (if (or (not go-to-url)
+      (when (or (not go-to-url)
               (session-go-to-url-or-destroy-session id go-to-url))
         (save-session-diff-to-redis pool id session-diff)))
     (view-model pool id)))
@@ -436,17 +436,17 @@
       (let [force-create (and (contains? arg :create)
                               (not (contains? arg :require)))
             candidate (or
-                        (if (not force-create)
-                          (->> (view-models pool)
-                               (filter
-                                 (fn [session-model]
-                                   (matches-requirement
-                                     session-model
-                                     (:require arg))))
-                               first))
-                        (let [create (or (:create arg)
-                                         (require->create (:require arg)))]
-                          (create-session pool create)))]
+                       (when (not force-create)
+                         (->> (view-models pool)
+                              (filter
+                               (fn [session-model]
+                                 (matches-requirement
+                                  session-model
+                                  (:require arg))))
+                              first))
+                       (let [create (or (:create arg)
+                                        (require->create (:require arg)))]
+                         (create-session pool create)))]
         (if-let [modifications (:modify arg)]
           (modify-session pool
                           (:id candidate)
@@ -537,11 +537,11 @@
 (s/defn ^:always-validate model->view-model :- (s/maybe SessionView)
   [pool  :- SessionPool
    model :- (s/maybe redis/SessionInRedis)]
-  (if-let [base (some->> model
-                         (merge view-model-defaults))]
+  (when-let [base (some->> model
+                           (merge view-model-defaults))]
     (let [node (nodes/view-model (:node-pool pool)
                                  (:node-id model))
-          prox (if-let [prox-id (:proxy-id model)]
+          prox (when-let [prox-id (:proxy-id model)]
                  (proxies/view-model (:proxy-pool pool) prox-id))]
       (-> base
           (dissoc :node-id :proxy-id)


Fetching repodoc from GH and merging it to tree works!

--- src/cljs/repodoc/core.cljs
+++ src/cljs/repodoc/core.cljs
@@ -84,6 +84,38 @@
             :query (fn [key]
                  (get @cdb key))}))

+(defn get-annotation-for-path
+  [repodoc path]
+  (first (filter #(if (= (:path %) path) true)
+                 repodoc)))
+
+(defn merge-repodoc
+  [repodoc]
+  (updatedb [:data]
+            (vec (map (fn [item]
+                     (let [ann (get-annotation-for-path repodoc (get item "path"))]
+                       (if ann
+                         (merge item ann)
+                         item)))
+                 (querydb [:data])))))
+
+(defn parse-repodoc
+  [repodoc]
+  (let [doc (cljs.reader/read-string (js/atob (get repodoc "content")))]
+    (merge-repodoc
+      (map (fn [ann]
+             (-> ann
+               (assoc "mtime" (new js/Date (:mtime ann)))
+               (assoc "path" (:path ann))
+               (assoc "title" (:title ann))))
+           doc))))
+
+(defn get-repodoc
+  [tree]
+  (let [repodoc-meta (first (filter #(if (= (get % "path") "root.repodoc") true) tree))]
+    (request {:url (get repodoc-meta "url")}
+             (fn [repodoc] (parse-repodoc repodoc)))))
+
 (defn get-repository-tree
   [username repository sha]
   (request {:url (str "https://api.github.com/repos/"
@@ -92,7 +124,8 @@
            (fn [data]
              (updatedb [:repository] repository)
              (updatedb [:username] username)
-             (updatedb [:data] (get data "tree")))))
+             (updatedb [:data] (get data "tree"))
+             (get-repodoc (get data "tree")))))

 (defn get-repository-data
   [username repository]
@@ -177,7 +210,7 @@
   (if (and (get item "mtime" false) (opened? pos))
     (let [mtime (get item "mtime")]
       (nm "div.pure-u-1-1.pure-u-sm-1"
-          ["Modification time:" (format_time (new js/Date mtime) DATEFORMAT)]))))
+          ["Modification time: " (format_time (new js/Date mtime) DATEFORMAT)]))))

 (defn node
   "Renders one node from tree with indentation"


add parse stubs for protocols and types

add parse stubs for protocols and types

--- src/cljs_api_gen/parse.clj
+++ src/cljs_api_gen/parse.clj
@@ -144,6 +144,14 @@
      :signature signatures
      :type "function"}))

+(defn parse-defprotocol
+  [form]
+  )
+
+(defn parse-deftype
+  [form]
+  )
+
 (defmulti parse-form*
   (fn [form]
     (cond
@@ -170,6 +178,14 @@
            (not (:private (nth form 3 nil))))
       "defcurried"

+      (and (= 'defprotocol (first form))
+           (not (:private (meta (second form)))))
+      "defprotocol"
+
+      (and (= 'deftype (first form))
+           (not (:private (meta (second form)))))
+      "deftype"
+
       :else nil)))

 (defmethod parse-form* "var"
@@ -191,6 +207,14 @@
 (defmethod parse-form* "defcurried"
   [form]
   (parse-defcurried form))
+
+(defmethod parse-form* "defprotocol"
+  [form]
+  (parse-defprotocol form))
+
+(defmethod parse-form* "deftype"
+  [form]
+  (parse-deftype form))

 (defmethod parse-form* nil
   [form]


sort type members in ref table (close #63)

--- src/cljs_api_gen/write.clj
+++ src/cljs_api_gen/write.clj
@@ -336,19 +336,24 @@
       (nil? bi) -1
       :else (compare ai bi))))

-(def type-order
-  {"type" 1
-   "protocol" 2})
-
-(defn compare-item
-  [a b]
-  (let [ai (get type-order (:type a))
-        bi (get type-order (:type b))]
-    (cond
-      (and (nil? ai) (nil? bi)) (compare (:name a) (:name b))
-      (nil? ai) -1
-      (nil? bi) 1
-      :else (compare [ai (:name a)] [bi (:name b)]))))
+(defn sort-items
+  [items]
+  (let [main (->> items
+               (remove #(#{"type" "protocol"} (:type %)))
+               (remove :parent-type)
+               (sort-by :name))
+        protocols (->> items
+                       (filter #(= "protocol" (:type %)))
+                       (sort-by :name))
+        types (->> items
+                   (filter #(= "type" (:type %)))
+                   (sort-by :name))
+        members (->> items
+                     (filter :parent-type)
+                     (group-by :parent-type)
+                     (mapmap #(sort-by :name %)))
+        types+ (mapcat #(cons % (members (:name %))) types)]
+    (concat main protocols types+)))

 (defn readme-api-symbols
   [result api-type]
@@ -361,8 +366,9 @@
                      :clj-symbol (make-clj-ref item)
                      :name (:name item)
                      :type (:type item)
+                     :parent-type (:parent-type item)
                      :history (map history-change-shield (:history item))})
-        transform-syms #(sort-by identity compare-item (map make-item %))
+        transform-syms #(sort-items (map make-item %))
         ns-symbols (->> (vals all)
                         (group-by :ns)
                         (mapmap transform-syms)


removed BANGs from get-bin and get-edn; they aren't stateful operations

--- src/clojure/ronin/core.clj
+++ src/clojure/ronin/core.clj
@@ -81,12 +81,12 @@
                          :directory-tree
                          :plain-text}

-        db-type (do (println "checking DB type")
-                  (assert (not (nil? (get db-specs (:type specs))))
+        db-type (do ;(println "checking DB type")
+                    (assert (not (nil? (get db-specs (:type specs))))
                             ":type needs to be found in db-specs")
                     (:type specs))

-        db-file (do (println "checking db file")
+        db-file (do ;(println "checking db file")
                     (if (some needs-filename [(:type specs)])
                       (do (assert (string? (:filename specs))
                                   ":filename needs to be a string")
@@ -95,7 +95,7 @@
                           (str (:filename specs) (get db-specs db-type)))
                       (get db-specs db-type)))

-        tuned-db-file (do (println "checking tuning")
+        tuned-db-file (do; (println "checking tuning")
                           (if (and (map? (:tuning specs))
                                    (not (empty? (:tuning specs))))
                             (->> (:tuning specs)
@@ -104,7 +104,7 @@
                                  (str db-file "#"))
                             db-file))

-        db-modes (do (println "checking modes")
+        db-modes (do ;(println "checking modes")
                      (assert (vector? modes)
                              "modes must be a vector")
                      (assert (->> (map #(get open-options %) modes)
@@ -114,7 +114,7 @@
                      (->> (map #(get open-options %) modes)
                           (apply bit-or 0)))]

-    (println "done checking stuff")
+    ;(println "done checking stuff")
     (.open db tuned-db-file db-modes)
     db))

@@ -205,14 +205,14 @@
   (add-bin! db (.getBytes key)
             (bytes (.getBytes (edn-str value)))))

-(defn get-bin!
+(defn get-bin
   "Gets binary data from an open DB using a binary key.

 Returns a byte array on success, 'nil' if it errors."
   [^DB db ^bytes key]
   (.get db key))

-(defn get-edn!
+(defn get-edn
   "Gets parsed Clojure data from an open DB using a string key.

 Returns Clojure on success, 'nil' if it errors."


Tweaked parameters. The robot develops a working tactic now!

--- src/clojure_robby/core.clj
+++ src/clojure_robby/core.clj
@@ -8,7 +8,7 @@
 (def individual-count 30); The amount of individuals to operate on.

 (def map-size 20) ; Size of the map used for robot simulation.
-(def gold-prob 20) ; Probability in 100 that a tile contains gold.
+(def gold-prob 50) ; Probability in 100 that a tile contains gold.
 (def simul-steps 100) ; Steps to allow the robot to make in a simulation.
 (def tiles [\w \p \g]) ; Tiles that populate the map: wall, path, and gold.
 (def actions [\u \d \l \r \p \x]) ; Actions the robot can take: up, down, left, right, pick up, move random.
@@ -16,8 +16,9 @@
 (def multipliers (map (fn [n] (** (count tiles) n)) (range 5))) ; Used to calculate genes to use.
 (def dir-vects ['(0 -1) '(0 1) '(-1 0) '(1 0) '(0 0)]) ; Direction vectors, corresponding to the 5 actions.

-(def mutation-prob 4) ; Probability in 100 that a gene will mutate.
-(def action-penalty 5) ; How many points robot loses when hitting the wall or picking up when it shouldn't.
+(def mutation-prob 1) ; Probability in 100 that a gene will mutate.
+(def wall-penalty 5) ; How many points robot loses when hitting the wall
+(def pick-up-penalty 1) ; How many points the robot loses when pickin up on an empty spot.
 (def gold-value 10) ; How many points picking up gold is worth.

@@ -87,7 +88,7 @@
                   (fn [the-pos]
                     (if (not= \w (get-tile current-map the-pos))
                       [current-map the-pos score]
-                      [current-map pos (- score action-penalty)]))]
+                      [current-map pos (- score wall-penalty)]))]
             ;(print pos)
             (case action
               (\l \r \u \d)
@@ -99,7 +100,7 @@
               \p
               (if (= \g (get-tile current-map pos))
                 [(set-tile current-map pos \p) pos (+ score gold-value)]
-                [current-map pos (- score action-penalty)]))))
+                [current-map pos (- score pick-up-penalty)]))))
         iteration (iterate make-step [the-map [1 1] 0])
         [_ final-pos final-score] (nth iteration simul-steps)]
     final-score))


Accept keyword parameters.

Accept keyword parameters.

--- src/afterglow/effects/channel.clj
+++ src/afterglow/effects/channel.clj
@@ -184,8 +184,8 @@
   wisely, avoiding this pitfall."
   [effect-name function level fixtures & {:keys [htp?]}]
   {:pre [(some? *show*) (some? effect-name) (some? function) (sequential? fixtures)]}
-  (params/validate-param-type level Number)
-  (let [function (keyword function)
+  (let [level (params/bind-keyword-param level Number 50)
+        function (keyword function)
         heads (find-heads-with-function function fixtures)
         f (if htp?
             ;; We need to resolve any dynamic parameters at this point so we can apply the


[skip ci] Tweak test-all messages

[skip ci] Tweak test-all messages

--- build.boot
+++ build.boot
@@ -186,17 +186,17 @@
   []
   (comp (with-pass-thru _ (println "======= Testing clj"))
         (test :platform     :clj)
-        (with-pass-thru _ (println "======= Testing cljs browser"))
+        (with-pass-thru _ (println "======= Testing cljs | browser"))
         (test :platform     :cljs
               :target       :browser)
-        (with-pass-thru _ (println "======= Testing cljs browser advanced"))
+        (with-pass-thru _ (println "======= Testing cljs | browser | advanced"))
         (test :platform     :cljs
               :target       :browser
               :opt          :advanced)
-        (with-pass-thru _ (println "======= Testing cljs node"))
+        (with-pass-thru _ (println "======= Testing cljs | node"))
         (test :platform     :cljs
               :target       :nodejs)
-        (with-pass-thru _ (println "======= Testing cljs node self-hosted"))
+        (with-pass-thru _ (println "======= Testing cljs | node | self-hosted"))
         (test :platform     :cljs
               :target       :nodejs
               :self-hosted? true)))


Begin 1.0.1-SNAPSHOT development

Begin 1.0.1-SNAPSHOT development

--- build.boot
+++ build.boot
@@ -21,7 +21,7 @@
   '[adzerk.boot-reload            :refer [reload]]
   '[pandeiro.boot-http            :refer [serve]])

-(def +version+ "1.0.0")
+(def +version+ "1.0.1-SNAPSHOT")

 (bootlaces! +version+)


output gh-pages release to target folder

--- build.boot
+++ build.boot
@@ -78,4 +78,4 @@
   (comp
     (doc)
     (release-devcards)
-    (target :dir #{"dist"})))
+    (target)))


excluding testing dependencies

excluding testing dependencies


Fix markdown task options

Fix markdown task options

--- build.boot
+++ build.boot
@@ -46,7 +46,7 @@
   []
   (comp (sass)
         (global-metadata)
-        (markdown :options {:extensions {:smarts true :extanchorlinks true}})
+        (markdown :md-exts {:smarts true :extanchorlinks true})
         (header-links)
         (permalink)
         (print-meta)


Added cider task back to build.boot

Added cider task back to build.boot

NOTE: requires cider to be defined in profile.boot per
  https://github.com/boot-clj/boot/wiki/Cider-REPL
  https://cider.readthedocs.io/en/latest/installation/

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

--- build.boot
+++ build.boot
@@ -185,6 +185,7 @@
   "Cider boot params task"
   []
   (comp
-    ; What does this task do and it is really required? FIXME/TODO
-    ;(cider)
+    (cider) ;; defined in profile.boot
+    ;; FFI https://github.com/boot-clj/boot/wiki/Cider-REPL
+    ;;     https://cider.readthedocs.io/en/latest/installation/
     (cljs-dev)))


added normal laplace to core load

added normal laplace to core load

--- src/distributions/core.clj
+++ src/distributions/core.clj
@@ -16,6 +16,7 @@
 (load "truncated")
 (load "location-scale")
 (load "t-distribution")
+(load "normal-laplace")

 (comment
 (gg4clj/render [[:<- :g (gg4clj/data-frame g-dat)]


Added profile.

Added profile.

--- src/dmml_lab_site/data.clj
+++ src/dmml_lab_site/data.clj
@@ -38,10 +38,6 @@
                               :name "Matt Revelle"
                               :interests ["probabilistic models" "unsupervised learning" "dynamic networks" "social networks"]
                               :img "matt_revelle.jpg"}
-                             {:homepage "#"
-                              :name "David Etter"
-                              :interests nil
-                              :img "grey_square.jpg"}
                              {:homepage "http://mason.gmu.edu/~rkhade/"
                               :name "Rohan Khade"
                               :interests ["association rule mining" "contrast set mining" "time series data" "mixed data"]
@@ -70,7 +66,11 @@
                              {:homepage "http://mason.gmu.edu/~dmisra2/"
                               :name "Debdipto Misra"
                               :interests ["computer vision" "spatio-temporal signature detection" "biomedical image processing" "prosthetic control"]
-                              :img "deb_misra.jpg"}]
+                              :img "deb_misra.jpg"}
+                             {:homepage "#"
+                              :name "David Etter"
+                              :interests ["multimedia retrieval" "learning to rank" "semi-supervised learning"]
+                              :img "david_etter.jpg"}]
                             (map add-interests?))))

 (def ms-students (sort-by (comp last-name :name)


Couple tests for Nasir's ability

Couple tests for Nasir's ability

--- src/clj/test/cards-identities.clj
+++ src/clj/test/cards-identities.clj
@@ -27,4 +27,40 @@
     (is (= 4 (:credit (get-runner))))
     (play-from-hand state :runner "Magnum Opus")
     (is (= 1 (count (get-in @state [:runner :rig :program]))))
-    (is (= 0 (:credit (get-runner))))))+    (is (= 0 (:credit (get-runner))))))
+
+(deftest nasir-ability-basic
+  "Nasir Ability - Basic"
+  (do-game
+    (new-game
+      (default-corp [(qty "Ice Wall" 3)])
+      (make-deck "Nasir Meidan: Cyber Explorer" []))
+    (play-from-hand state :corp "Ice Wall" "HQ")
+    (take-credits state :corp)
+
+    (core/click-run state :runner {:server "HQ"})
+    (let [iwall (get-in @state [:corp :servers :hq :ices 0])
+          nasir (get-in @state [:runner :identity])]
+      (core/rez state :corp iwall)
+      (is (= 5 (:credit (get-runner))))
+      (card-ability state :runner nasir 0)
+      (is (= 1 (:credit (get-runner)))))))
+
+(deftest nasir-ability-xanadu
+  "Nasir Ability - Xanadu"
+  (do-game
+    (new-game
+      (default-corp [(qty "Ice Wall" 1)])
+      (make-deck "Nasir Meidan: Cyber Explorer" [(qty "Xanadu" 1)]))
+    (play-from-hand state :corp "Ice Wall" "HQ")
+    (take-credits state :corp)
+
+    (swap! state assoc-in [:runner :credit] 6)
+    (play-from-hand state :runner "Xanadu")
+    (core/click-run state :runner {:server "HQ"})
+    (let [iwall (get-in @state [:corp :servers :hq :ices 0])
+          nasir (get-in @state [:runner :identity])]
+      (core/rez state :corp iwall)
+      (is (= 3 (:credit (get-runner))))
+      (card-ability state :runner nasir 0)
+      (is (= 2 (:credit (get-runner)))))))


Inline short math functions

Inline short math functions

--- src/cljc/mikron/runtime/math.cljc
+++ src/cljc/mikron/runtime/math.cljc
@@ -7,6 +7,7 @@

 (defn rand
   "Returns a random double value."
+  #?(:clj {:inline (fn [] `(unchecked-double (Math/random)))})
   ^double []
   (unchecked-double
     #?(:clj  (Math/random)
@@ -14,24 +15,28 @@

 (defn pow
   "Raises `x` to `y`."
+  #?(:clj {:inline (fn [x y] `(Math/pow ~x ~y))})
   ^double [^double x ^double y]
   #?(:clj  (Math/pow x y)
      :cljs (.pow js/Math x y)))

 (defn floor
   "Returns the floor of `x`."
+  #?(:clj {:inline (fn [x] `(Math/floor ~x))})
   ^double [^double x]
   #?(:clj  (Math/floor x)
      :cljs (.floor js/Math x)))

 (defn abs
   "Returns the absolute value of `x`."
+  #?(:clj {:inline (fn [x] `(Math/abs ~x))})
   ^double [^double x]
   #?(:clj  (Math/abs x)
      :cljs (.abs js/Math x)))

 (defn round
   "Rounds `x`."
+  #?(:clj {:inline (fn [x] `(Math/round ~x))})
   ^long [^double x]
   #?(:clj  (Math/round x)
      :cljs (.round js/Math x)))
@@ -52,6 +57,7 @@

 (defn from
   "Creates a new long value."
+  #?(:clj {:inline (fn [x] x)})
   (^long [^long x]
    #?(:clj  x
       :cljs (.fromNumber goog.math.Long x)))
@@ -80,60 +86,70 @@

 (defn to
   "Converts a number `x` to a long."
+  #?(:clj {:inline (fn [x] x)})
   ^long [^long x]
   #?(:clj  x
      :cljs (.toNumber x)))

 (defn zero?
   "Returns `true` if a long `x` is zero, `false` otherwise."
+  #?(:clj {:inline (fn [x] `(== 0 ~x))})
   [^long x]
   #?(:clj  (== 0 x)
      :cljs (.isZero x)))

 (defn and
   "Performs the bitwise AND operation on two longs `x` and `y`."
+  #?(:clj {:inline (fn [x y] `(bit-and ~x ~y))})
   ^long [^long x ^long y]
   #?(:clj  (bit-and x y)
      :cljs (.and x y)))

 (defn or
   "Performs the bitwise OR operation on two longs `x` and `y`."
+  #?(:clj {:inline (fn [x y] `(bit-or ~x ~y))})
   ^long [^long x ^long y]
   #?(:clj  (bit-or x y)
      :cljs (.or x y)))

 (defn xor
   "Performs the bitwise XOR operation on two longs `x` and `y`."
+  #?(:clj {:inline (fn [x y] `(bit-xor ~x ~y))})
   ^long [^long x ^long y]
   #?(:clj  (bit-xor x y)
      :cljs (.xor x y)))

 (defn not
   "Performs the bitwise NOT operation on a long `x`."
+  #?(:clj {:inline (fn [x] `(bit-not ~x))})
   ^long [^long x]
   #?(:clj  (bit-not x)
      :cljs (.not x)))

 (defn negate
   "Negates a long `x`."
+  #?(:clj {:inline (fn [x] `(unchecked-negate ~x))})
   ^long [^long x]
-  #?(:clj  (- x)
+  #?(:clj  (unchecked-negate x)
      :cljs (.negate x)))

 (defn shift-left
   "Arithmetically shifts the bits of a long `x` to the left by `n`."
+  #?(:clj {:inline (fn [x n] `(bit-shift-left ~x ~n))})
   ^long [^long x ^long n]
   #?(:clj  (bit-shift-left x n)
      :cljs (.shiftLeft x n)))

 (defn shift-right
   "Arithmetically shifts the bits of a long `x` to the right by `n`."
+  #?(:clj {:inline (fn [x n] `(bit-shift-right ~x ~n))})
   ^long [^long x ^long n]
   #?(:clj  (bit-shift-right x n)
      :cljs (.shiftRight x n)))

 (defn unsigned-shift-right
   "Logically shifts the bits of a long `x` to the right by `n`."
+  #?(:clj {:inline (fn [x n] `(unsigned-bit-shift-right ~x ~n))})
   ^long [^long x ^long n]
   #?(:clj  (unsigned-bit-shift-right x n)
      :cljs (.shiftRightUnsigned x n)))


Change file perms

Change file perms


Fix cljs compilation warning and clean up comments

It seems a function needed to be defined earlier to prevent an
"undeclared Var" warning.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -306,6 +306,22 @@

 (defn remote-list [remotes]
   (->> remotes (map #(remote->name (first %))) (sort-by #(remote->num (first %)))))
+
+(defn card-counter-type [card]
+  (let [counter-type (:counter-type card)]
+    ;; Determine the appropriate type of counter for styling, falling back to
+    ;; power counters when no other type can be inferred.
+    (cond
+      ;; If an installed card contains an annotation, use it.
+      (and (:installed card)
+           (not (nil? counter-type)))
+        counter-type
+      (= "Agenda" (:type card)) "Agenda"
+      ;; Assume uninstalled cards with counters are hosted on Personal
+      ;; Workshop.
+      (not (:installed card)) "Power"
+      (> (.indexOf (:subtype card) "Virus") -1) "Virus"
+      :else "Power")))

 (defn card-img
   "Build an image of the card (is always face-up). Only shows the zoomed card image, does not do any interaction."
@@ -398,23 +414,6 @@
        (when (pos? (count hosted))
          [:div.hosted
           (om/build-all card-view hosted {:key :cid})])]))))
-
-(defn card-counter-type [card]
-  (let [counter-type (:counter-type card)]
-    ;; Determine the appropriate type of counter
-    ;; for styling, falling back to a default grey
-    ;; counter when no type is known.
-    (cond
-      (and (:installed card)
-           (not (nil? counter-type))) counter-type
-      ;; Scored agendas with counters are not :installed.
-      (= "Agenda" (:type card)) "Agenda"
-      ;; Assume uninstalled cards with counters are hosted on Personal Workshop.
-      (not (:installed card)) "Power"
-      ;; Assume uninstalled cards with counters are hosted on Personal Workshop.
-      (> (.indexOf (:subtype card) "Virus") -1) "Virus"
-      ;; Power counters are the assumed default type of counter.
-      :else "Power")))

 (defn drop-area [side server hmap]
   (merge hmap {:on-drop #(handle-drop % server)


enable card preview for card prompt

enable card preview for card prompt

Like Executive Boot Camp or other tutors etc.

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -168,9 +168,11 @@

 (def create-span (memoize create-span-impl))

-(defn add-image-codes [text]
+(defn add-image-codes-impl [text]
   (reduce #(.replace %1 (js/RegExp. (str "\\b" (:title %2) "\\b") "g") (str "[" (:title %2) "~"(:code %2) "]")) text (prepared-cards)))

+(def add-image-codes (memoize add-image-codes-impl))
+
 (defn get-message-parts-impl [text]
   (let [with-image-codes (add-image-codes (if (nil? text) "" text))]
       (.split with-image-codes (js/RegExp. "(\\[[^\\]]*])" "g"))))
@@ -598,7 +600,8 @@
                 (om/build rfg-view {:cards (:current opponent) :name "Current"})
                 (om/build rfg-view {:cards (:current me) :name "Current"})]

-               [:div.button-pane
+               [:div.button-pane { :on-mouse-over #(if-let [code (get-card-code %1)] (put! zoom-channel {:code code}))
+                                   :on-mouse-out #(if-let [code (get-card-code %1)] (put! zoom-channel false))}
                 (when-not (:keep me)
                   [:div.panel.blue-shade
                    [:h4 "Keep hand?"]
@@ -637,7 +640,8 @@
                            (if (string? c)
                              [:button {:on-click #(send-command "choice" {:choice c})}
                                        (for [item (get-message-parts c)] (create-span item))]
-                             [:button {:on-click #(send-command "choice" {:card @c})} (:title c)]))))]
+                              (let [[title code] (extract-card-info (add-image-codes (:title c)))]
+                                [:button {:on-click #(send-command "choice" {:card @c}) :title code} title])))))]
                     (if run
                       (let [s (:server run)
                             kw (keyword (first s))


Cleanup

Cleanup

--- src/rdf_path_examples/clustering.clj
+++ src/rdf_path_examples/clustering.clj
@@ -50,8 +50,9 @@
                             ; Otherwise select the members with the minimum total distance to the others
                             (apply min-key (partial total-distance members) members)))
         recluster (fn [clusters]
-                    (let [initial-clusters (into {} (map (comp #(vector % #{}) find-new-medoid)
-                                                         clusters))]
+                    (let [initial-clusters (into {}
+                                                 (map (comp (juxt identity hash-set) find-new-medoid)
+                                                      clusters))]
                       (reduce assign-to-cluster initial-clusters paths)))]
     (loop [clusters (reduce assign-to-cluster initial-clusters paths)
            iterations 0]


Improved error handling for websocket connections.

Some types of errors would result in dangling closed connections, and a
race condition (ztellman and I think?) in the close process led to
instrumentation throwing during the connection close process. These
changes may improve those behaviors.

Conflicts:
	src/riemann/transport/websockets.clj

--- src/riemann/transport/websockets.clj
+++ src/riemann/transport/websockets.clj
@@ -71,6 +71,7 @@
                                    ; latency
                                    (let [t1 (System/nanoTime)]
                                      (run-pipeline
+                                       {:error-handler (fn [_] (close ch))}
                                        (enqueue ch (event-to-json event))
                                        ; When the write completes, measure
                                        ; latency
@@ -167,15 +168,25 @@
 (defn ws-handler [core stats]
   "Returns a function which is called with new websocket connections.
   Responsible for routing requests to the appropriate handler."
-  (fn [ch req]
-    (info "Websocket connection from" (:remote-addr req)
-          (:uri req)
-          (:query-string req))
-
-    ; Stats
-    (when (:websocket? req)
-      (swap! (:conns stats) inc)
-      (on-closed ch #(swap! (:conns stats) dec)))
+  (fn handle [ch req]
+    (try
+      (info "Websocket connection from" (:remote-addr req)
+            (:uri req)
+            (:query-string req))
+
+      ; Stats
+      (when (:websocket? req)
+        (swap! (:conns stats) inc)
+        (on-closed ch #(swap! (:conns stats) dec)))
+
+      ; Route request
+      (condp re-matches (:uri req)
+        #"/events/?"       (put-events-handler @core stats ch req)
+        #"/index/?"        (ws-index-handler @core stats ch req)
+        #"/pubsub/[^/]+/?" (ws-pubsub-handler @core stats ch req)
+        (do
+          (info "Unknown URI " (:uri req) ", closing")
+          (close ch)))

     ; Route request
     (condp re-matches (:uri req)
@@ -184,7 +195,9 @@
       #"/pubsub/[^/]+/?" (ws-pubsub-handler @core stats ch req)
       (do
         (info "Unknown URI " (:uri req) ", closing")
-        (close ch)))))
+        (close ch)))
+      (catch Throwable t
+        (warn t "ws-handler caught; closing websocket connection.")))))

 (defrecord WebsocketServer [host port core server stats]
   ServiceEquiv


Long delays on dispatch are gone.  So no need to use dispatch-sync.

--- examples/simple/src/simpleexample/core.cljs
+++ examples/simple/src/simpleexample/core.cljs
@@ -93,7 +93,7 @@
          "Time color: "
          [:input {:type "text"
                   :value @time-color
-                  :on-change #(dispatch-sync
+                  :on-change #(dispatch
                                [:time-color (-> % .-target .-value)])}]])))

 (defn simple-example


Expanded model to generate data structure for hierarchical navigation from taxonomy.xml - added generic walk & trasform zipper fn to carry changes to the zipper forward through a walk - added utility function to pull together the necessary pieces to create nested lists, and to add list nodes to the taxonomy structure - added utility function to prune non-html nodes from the transformed taxonomy structure

--- src/lonelyplanet/model.clj
+++ src/lonelyplanet/model.clj
@@ -59,4 +59,31 @@
     {:destinations (for [destination destinations]
                      (let [destination-id (-> destination :attrs :atlas_id)]
                        (assoc destination :meta (dest-metas (Integer. ^String destination-id)))))
-     :dest-metas dest-metas}))+     :dest-metas dest-metas}))
+
+(defn walk&transform-zipper
+  "Walk a zipper, mutating with f & walking the returned, mutated version"
+  [loc f]
+  (if (z/end? loc)
+    loc
+    (recur (z/next (f loc)) f)))
+
+(defn to-html-list
+  "Convert a taxonomy node loc to a html list. When it encounters a :node element, change the :tag of the element to
+  :ul, and add a child :li node containing a :a node with a :href attribute to the destination"
+  [loc]
+  (let [link-text (-> loc z/children first :content)
+        link (-> loc z/node (get-in [:attrs :geo_id]))
+        link (str link ".html")]
+    (-> (z/edit loc assoc :tag :ul)
+        (z/append-child (x/->Element :li {} (x/->Element :a {:href link} link-text))))))
+
+(defn transform-taxonomy-nodes
+  "Transform a taxonomy zipper from the xml tag-based structure to an enlive-html tag-based structure suitable
+  for rendering to HTML by enlive. Assumes it's operating from a root node tag, not the root <taxonomies> tag."
+  [loc]
+  (if (= (-> loc z/node :tag) :node) (to-html-list loc) loc))
+
+(defn prune-taxonomy-nodes
+  [loc]
+  (if (#{:ul :li} (-> loc z/node :tag)) loc (z/remove loc)))


need to pass opts to analyze, e -> cause for consistency

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -246,10 +246,10 @@
                         (ana/error ana-env
                           (ana/error-message :undeclared-ns
                             {:ns-sym dep :js-provide (name dep)})))))))
-             (catch :default e
+             (catch :default cause
                (cb (wrap-error
                      (ana/error ana-env
-                       (str "Could not analyze dep " dep)))))))
+                       (str "Could not analyze dep " dep) cause))))))
          (cb {:value nil}))))))

 (defn load-macros [bound-vars k macros reload reloads opts cb]
@@ -358,7 +358,7 @@
                               (:context opts) (assoc :context (:context opts))
                               (:def-emits-var opts) (assoc :def-emits-var true))
                        res  (try
-                              {:value (ana/analyze aenv form)}
+                              {:value (ana/analyze aenv form nil opts)}
                               (catch :default cause
                                 (wrap-error
                                   (ana/error aenv
@@ -517,7 +517,7 @@
                               (:context opts) (assoc :context (:context opts))
                               (:def-emits-var opts) (assoc :def-emits-var true))
                        ast  (try
-                              (ana/analyze aenv form)
+                              (ana/analyze aenv form nil opts)
                               (catch :default cause
                                 (wrap-error
                                   (ana/error aenv
@@ -609,8 +609,8 @@
                               (:context opts) (assoc :context (:context opts))
                               (:def-emits-var opts) (assoc :def-emits-var true))
                        res  (try
-                              {:value (ana/analyze aenv form)}
-                              (catch :deafult cause
+                              {:value (ana/analyze aenv form nil opts)}
+                              (catch :default cause
                                 (wrap-error
                                   (ana/error aenv
                                     (str "Could not eval " name) cause))))]


Tidy up

Tidy up

--- src/kixi/datastore/web_server.clj
+++ src/kixi/datastore/web_server.clj
@@ -144,24 +144,10 @@
   (= "application/octet-stream"
      (get-in part [:headers "content-type"])))

-(defn file-size-part?
-  [part]
-  (= "file-size"
-     (get-in part [:content-disposition :params "name"])))
-
-(defn last-file-size
-  [state]
-  (last (:sizes state)))
-
 (defn add-part
   [part state]
-  (let [added (update state :parts (fnil conj [])
-                      (yada.multipart/map->DefaultPart part))]
-    (if (file-size-part? part)
-      (let [^Long size (part->long part)]
-        (update added :sizes (fnil conj [])
-                size))
-      added)))
+  (update state :parts (fnil conj [])
+          (yada.multipart/map->DefaultPart part)))

 (defn payload-size
   [{:keys [bytes body-offset] :as piece-or-part}]
@@ -232,7 +218,7 @@
     (consume-part [this state part]
       (if (file-part? part)
         (let [id (uuid)
-              complete-chan-r (flush-tiny-file! filestore id part (last-file-size state))]
+              complete-chan-r (flush-tiny-file! filestore id part (file-size state))]
           (-> part
               (assoc :id id
                      :count 1


Remove redundant *1.

Remove redundant *1.

--- src/klangmeister/instruments.cljs
+++ src/klangmeister/instruments.cljs
@@ -31,7 +31,7 @@
                          gain (doto (.-gain gainNode)
                                 (.setValueAtTime 0 start)
                                 (.linearRampToValueAtTime (* 0.05 proportion) mid)
-                                (.linearRampToValueAtTime 0 (+ mid (* proportion 1))))]
+                                (.linearRampToValueAtTime 0 (+ mid proportion)))]
                      (doto (.createOscillator context)
                        (.connect gainNode)
                        (-> .-frequency .-value (set! (* n freq)))


Bullets now actively accelerate and experience drag.

--- Clojure/clojuroids.clj
+++ Clojure/clojuroids.clj
@@ -9,12 +9,15 @@
 )

 (def acceleration 100.0)
-(def efficiency 0.7)
 (def angular-acceleration 10.0)
+
+(def player-efficiency 0.7)
+(def bullet-efficiency 0.5)
+(def bullet-acceleration 200)
+
 (def width 640)
 (def height 480)
 (def fire-delay 0.3)
-(def bullet-velocity 100)

 (defn do-mod [coll func v]
     (dosync (alter coll (fn [x] (apply func [x v])))))
@@ -105,14 +108,16 @@
 (defn myrand [min max]
     (+ min (rand (- max min))))

-(defn step-thing [thing time-step eff]
-    (assoc thing
-        :x (mod (+ (:x thing) (* (:xv thing) time-step)) width)
-        :y (mod (+ (:y thing) (* (:yv thing) time-step)) height)
-        :a (mod (+ (:a thing) (* (:av thing) time-step)) (* Math/PI 2.0))
-        :xv (* (:xv thing) eff)
-        :yv (* (:yv thing) eff)
-        :av (* (:av thing) eff)))
+(defn step-thing [thing time-step]
+    (let [eff (Math/pow (:eff thing) time-step)]
+        (assoc thing
+            :xv (+ (* (:xv thing) eff) (* time-step (:acc thing) (Math/cos (:a thing))))
+            :yv (+ (* (:yv thing) eff) (* time-step (:acc thing) (Math/sin (:a thing))))
+            :av (* (:av thing) eff)
+
+            :x (mod (+ (:x thing) (* (:xv thing) time-step)) width)
+            :y (mod (+ (:y thing) (* (:yv thing) time-step)) height)
+            :a (mod (+ (:a thing) (* (:av thing) time-step)) (* Math/PI 2.0)))))

 (defn rotate [x y a] [
     (+ (* (Math/cos a) x) (* (Math/sin a) y))
@@ -150,6 +155,8 @@
             :a 0.0
             :av (rand)
             :radii (take 10 (repeatedly #(myrand 5 30)))
+            :eff 1.0
+            :acc 0.0
         }]
     (assoc a
         :poly (asteroid-shape (:radii a)))))
@@ -157,20 +164,25 @@
 (defn default-state [] {
     :time (now)
     :time-step 0.0
-    :player { :x 100.0 :y 100.0 :xv 0.0 :yv 0.0 :a 0.0 :av 0.0 }
+    :player {
+        :x 100.0
+        :y 100.0
+        :xv 0.0
+        :yv 0.0
+        :a 0.0
+        :av 0.0
+        :acc 0.0
+        :eff player-efficiency }
     :next-fire-time (now)
     :asteroids (take 10 (repeatedly generate-asteroid))
+    :sparkles []
 } )

 (defn player-step [player time-step keys-pressed]
     (let [
         player
-            (if
-                (contains? keys-pressed KeyEvent/VK_UP)
-                (assoc player
-                    :xv (+ (:xv player) (* time-step acceleration (Math/cos (:a player))))
-                    :yv (+ (:yv player) (* time-step acceleration (Math/sin (:a player)))))
-                player)
+            (assoc player
+                :acc (if (contains? keys-pressed KeyEvent/VK_UP) acceleration 0.0))
         player
             (if
                 (contains? keys-pressed KeyEvent/VK_LEFT)
@@ -183,25 +195,17 @@
                 (assoc player
                     :av (+ (:av player) (* time-step angular-acceleration)))
                 player)
-        eff
-            (Math/pow efficiency time-step)
-
-        player
-            (step-thing player time-step eff)
+
+        player
+            (step-thing player time-step)
         ]
     player))

-(defn asteroid-step [asteroid time-step]
-    (step-thing asteroid time-step 1.0))
-
 (defn new-bullet [player]
     (assoc player
-        :xv (+ (:xv player) (* (Math/cos (:a player)) bullet-velocity))
-        :yv (+ (:yv player) (* (Math/sin (:a player)) bullet-velocity))
+        :eff bullet-efficiency
+        :acc bullet-acceleration
 ))
-
-(defn bullet-step [bullet time-step]
-    (step-thing bullet time-step 1.0))

 (defn game-step [state keys-pressed]
     (let [
@@ -213,14 +217,14 @@
                 :time new-time
                 :time-step time-step
                 :player (player-step (:player state) time-step keys-pressed)
-                :asteroids (map (fn [a] (asteroid-step a time-step)) (:asteroids state))
+                :asteroids (doall (map (fn [a] (step-thing a time-step)) (:asteroids state)))
                 :bullets
-                    (map (fn [b] (bullet-step b time-step))
+                    (doall (map (fn [b] (step-thing b time-step))
                         (concat
                             (if spawn-new-bullet
                                 [(new-bullet (:player state))]
                                 [])
-                        (:bullets state)))
+                        (:bullets state))))
                 :next-fire-time
                     (if spawn-new-bullet
                         (+ new-time fire-delay)
@@ -256,11 +260,14 @@
                         (actionPerformed [this event] (.repaint result))))
                 (.start))

-            (future (loop []
-                (do
-                    (Thread/sleep 1)
-                    (dosync (alter game-state (fn [state] (game-step state (deref keys-pressed)))))
-                    (recur))))
+            (future
+                (try
+                    (loop []
+                        (do
+                            (Thread/sleep 1)
+                            (dosync (alter game-state (fn [state] (game-step state (deref keys-pressed)))))
+                            (recur)))
+                    (catch Exception e (.printStackTrace e))))

             result)))


Don't use basic (is ..) data structure checks for existence

Let the qualitative tests handle telling you that.

--- test/govuk/blinken_test.clj
+++ test/govuk/blinken_test.clj
@@ -17,11 +17,9 @@
           groups (:groups config)]
       (is (= (count groups) 2))
       (let [group-another (groups "another")]
-        (is group-another)
         (is (= (:name group-another) "another"))
         (is (= (count (:environments group-another)) 1)))
       (let [group-govuk (groups "govuk")]
-        (is group-govuk)
         (is (= (:name group-govuk) "GOV.UK"))
         (let [prod ((:environments group-govuk) "prod")]
           (is (= (:name prod) "Production"))


RR: fix tests

RR: fix tests

--- test/hatti/shared_test.cljs
+++ test/hatti/shared_test.cljs
@@ -35,6 +35,7 @@
 (def big-thin-data   (data-gen 1 100))
 (def small-fat-data  (data-gen 100 10))
 (def big-fat-data    (data-gen 100 100))
+(def media-url (str @base-uri "files"))

 ;; TESTS

@@ -90,14 +91,14 @@
             revised-record (first integrated-data)]
         (is (= (-> revised-record (get "historic_photo") :download_url)
                (url
-                base-uri
-                "files/287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg")))
+                media-url
+                "287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg")))
         (is (=
              (-> revised-record (get "historic_photo") :small_download_url)
              (url
-              base-uri
+               media-url
               (str
-               "files/287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg"
+               "287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg"
                "&suffix=small"))))))
     (testing "data with no images doesn't get touched"
       (let [form [{:type "string" :name "historic_photo"
@@ -133,11 +134,11 @@
          (= (-> revised-record (get "repeat") first (get "repeat/photo1")
                 :download_url)
             (url
-             base-uri
-             "files/287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg")))
+             media-url
+             "287632?filename=prabhasp/attachments/Bhkt36_hist2.jpg")))
         (is
          (= (-> revised-record (get "repeat") first (get "repeat/photo2")
                 :download_url)
             (url
-             base-uri
-             "files/287633?filename=prabhasp/attachments/Bhkt36_hist.jpg")))))))
+             media-url
+             "287633?filename=prabhasp/attachments/Bhkt36_hist.jpg")))))))


adding more tests

adding more tests

--- test/passport/core_test.clj
+++ test/passport/core_test.clj
@@ -1,23 +1,14 @@
 (ns passport.core-test
   (:require [clojure.test :refer :all]
             [passport.core :refer :all]
-            [clj-http.fake :refer [with-fake-routes]]))
+            [clj-http.fake :refer [with-fake-routes-in-isolation]]))

-(def ^:const ^:private base-url "https://api.opencnam.com/v2/phone/")
-(def ^:const ^:private error-text-400 "Invalid phone number")
-(def ^:const ^:private error-text-401 "Incorrect/invalid Professional Tier credentials")
-(def ^:const ^:private error-text-402 "Insufficient funds for Professional Tier query")
-(def ^:const ^:private error-text-403 "Hourly limit for hobbyist tier exceeded")
-(def ^:const ^:private error-text-404 "No CNAM information available for phone number")
-(def ^:const ^:private error-text-generic "Something went wrong. Please check response status")
-(def found-url (str base-url "+16502530000"))
-(def not-found-url (str base-url "+16502530001"))
-(def bogus-phone-url (str base-url "bogus"))
+(def route-regex #"https://api\.opencnam\.com/v2/phone/.*")

 (deftest phone-found
   (testing "request for a phone in the CNAM db"
-    (with-fake-routes
-      {found-url
+    (with-fake-routes-in-isolation
+      {route-regex
       (fn [_] {:status 200 :headers {} :body "{\n  \"price\": 0, \n  \"uri\": \"/v2/phone/%2B16502530000\",
         \n  \"created\": \"2012-10-12T06:53:05.1    94858\",
         \n  \"number\": \"+16502530000\", \n  \"updated\": \"2014-02-20T18:59:27.279412\", \n  \"name\": \"GOOGLE INC\"\n}"})}
@@ -27,27 +18,45 @@

 (deftest phone-invalid
   (testing "request for a phone number that is in an invalid form"
-    (with-fake-routes
-      {bogus-phone-url
-      (fn [_] {:status 400 :error error-text-400})}
+    (with-fake-routes-in-isolation
+      {route-regex
+      (fn [_] {:status 400 :headers {} :body ""})}

       (is (:error (caller-id "bogus")))
       (is (= (:status (caller-id "bogus")) 400)))))

 (deftest phone-not-found
   (testing "request for a phone number not in the CNAM db"
-    (with-fake-routes
-      {not-found-url
-      (fn [_] {:status 401 :error error-text-401})}
+    (with-fake-routes-in-isolation
+      {route-regex
+      (fn [_] {:status 404 :headers {} :body ""})}

       (is (:error (caller-id "+16502530001")))
       (is (= (:status (caller-id "+16502530001")) 404)))))

 (deftest invalid-credentials
   (testing "specifying invalid Professional Tier credentials"
-    (with-fake-routes
-      {found-url
-      (fn [_] {:status 404 :error error-text-404})}
+    (with-fake-routes-in-isolation
+      {route-regex
+      (fn [_] {:status 401 :headers {} :body ""})}

       (is (:error (caller-id "+16502530001" "test" "test")))
       (is (= (:status (caller-id "+16502530001" "test" "test")) 401)))))
+
+(deftest insufficient-funds
+  (testing "insufficient funds in account for Professional Tier query"
+    (with-fake-routes-in-isolation
+      {route-regex
+      (fn [_] {:status 402 :headers {} :body ""})}
+
+      (is (:error (caller-id "+16502530000")))
+      (is (= (:status (caller-id "+16502530000")) 402)))))
+
+(deftest hourly-limit-exceeded
+  (testing "insufficient funds in account for Professional Tier query"
+    (with-fake-routes-in-isolation
+      {route-regex
+      (fn [_] {:status 403 :headers {} :body ""})}
+
+      (is (:error (caller-id "+16502530000")))
+      (is (= (:status (caller-id "+16502530000")) 403)))))


test/riemann/xymon_test.clj: events->combo unit test

--- test/riemann/xymon_test.clj
+++ test/riemann/xymon_test.clj
@@ -74,6 +74,19 @@
     (doseq [[event line] pairs]
       (is (= line (event->disable event))))))

+(deftest ^:xymon-combo events->combo-test
+  (let [formatter #(str % "_s")
+        long-message (clojure.string/join (repeat 2048 "o"))
+        long-message_s (str long-message "_s")
+        pairs [[["foo"] ["foo_s"]]
+               [["foo" "bar" "asdf"]
+                ["combo\nfoo_s\n\nbar_s\n\nasdf_s\n\n"]]
+               [[long-message long-message]
+                [long-message_s long-message_s]]]]
+    (doseq [[events result] pairs]
+      (is (= result
+             (events->combo formatter events))))))
+
 (deftest ^:xymon ^:integration xymon-test
          (let [k (xymon nil)]
            (k {:host "riemann.local"