Rough Go-ification of the emitters

Rough Go-ification of the emitters

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -371,18 +371,18 @@
 (defmethod emit* :case*
   [{:keys [v tests thens default env]}]
   (when (= (:context env) :expr)
-    (emitln "(function(){"))
+    (emitln "(func(){"))
   (let [gs (gensym "caseval__")]
     (when (= :expr (:context env))
-      (emitln "var " gs ";"))
-    (emitln "switch (" v ") {")
+      (emitln "var " gs ""))
+    (emitln "switch " v " {")
     (doseq [[ts then] (partition 2 (interleave tests thens))]
       (doseq [test ts]
         (emitln "case " test ":"))
       (if (= :expr (:context env))
         (emitln gs "=" then)
         (emitln then))
-      (emitln "break;"))
+      (emitln "break"))
     (when default
       (emitln "default:")
       (if (= :expr (:context env))
@@ -390,7 +390,7 @@
         (emitln default)))
     (emitln "}")
     (when (= :expr (:context env))
-      (emitln "return " gs ";})()"))))
+      (emitln "return " gs "})()"))))

 (defmethod emit* :throw
   [{:keys [throw env]}]
@@ -423,7 +423,7 @@
       ;; NOTE: JavaScriptCore does not like this under advanced compilation
       ;; this change was primarily for REPL interactions - David
       ;(emits " = (typeof " mname " != 'undefined') ? " mname " : undefined")
-      (when-not (= :expr (:context env)) (emitln ";"))
+      (when-not (= :expr (:context env)) (emitln))
       (when export
         (emitln "goog.exportSymbol('" (munge export) "', " mname ");")))))

@@ -431,35 +431,35 @@
   [{:keys [name params env]}]
   (let [arglist (gensym "arglist__")
         delegate-name (str (munge name) "__delegate")]
-    (emitln "(function (" arglist "){")
+    (emitln "(func (" arglist "){")
     (doseq [[i param] (map-indexed vector (drop-last 2 params))]
       (emits "var ")
       (emit param)
       (emits " = cljs.core.first(")
       (emitln arglist ");")
-      (emitln arglist " = cljs.core.next(" arglist ");"))
+      (emitln arglist " = cljs.core.next(" arglist ")"))
     (if (< 1 (count params))
       (do
         (emits "var ")
         (emit (last (butlast params)))
-        (emitln " = cljs.core.first(" arglist ");")
+        (emitln " = cljs.core.first(" arglist ")")
         (emits "var ")
         (emit (last params))
-        (emitln " = cljs.core.rest(" arglist ");")
+        (emitln " = cljs.core.rest(" arglist ")")
         (emits "return " delegate-name "(")
         (doseq [param params]
           (emit param)
           (when-not (= param (last params)) (emits ",")))
-        (emitln ");"))
+        (emitln ")"))
       (do
         (emits "var ")
         (emit (last params))
-        (emitln " = cljs.core.seq(" arglist ");")
+        (emitln " = cljs.core.seq(" arglist ")")
         (emits "return " delegate-name "(")
         (doseq [param params]
           (emit param)
           (when-not (= param (last params)) (emits ",")))
-        (emitln ");")))
+        (emitln ")")))
     (emits "})")))

 (defn emit-fn-params [params]
@@ -472,15 +472,15 @@
 (defn emit-fn-method
   [{:keys [type name variadic params expr env recurs max-fixed-arity]}]
   (emit-wrap env
-    (emits "(function " (munge name) "(")
+    (emits "(func " (munge name) "(")
     (emit-fn-params params)
     (emits "){")
     (when type
-      (emitln "var self__ = this;"))
-    (when recurs (emitln "while(true){"))
+      (emitln "var self__ = this"))
+    (when recurs (emitln "for {"))
     (emits expr)
     (when recurs
-      (emitln "break;")
+      (emitln "break")
       (emitln "}"))
     (emits "})")))

@@ -490,47 +490,47 @@
              (let [name (or name (gensym))
                    mname (munge name)
                    delegate-name (str mname "__delegate")]
-               (emitln "(function() { ")
-               (emits "var " delegate-name " = function (")
+               (emitln "(func() { ")
+               (emits "var " delegate-name " = func (")
                (doseq [param params]
                  (emit param)
                  (when-not (= param (last params)) (emits ",")))
                (emits "){")
-               (when recurs (emitln "while(true){"))
+               (when recurs (emitln "for {"))
                (emits expr)
                (when recurs
-                 (emitln "break;")
+                 (emitln "break")
                  (emitln "}"))
-               (emitln "};")
-
-               (emitln "var " mname " = function (" (comma-sep
-                                                      (if variadic
-                                                        (concat (butlast params) ['var_args])
-                                                        params)) "){")
+               (emitln "}")
+
+               (emitln "var " mname " = func (" (comma-sep
+                                                 (if variadic
+                                                   (concat (butlast params) ['var_args])
+                                                   params)) "){")
                (when type
-                 (emitln "var self__ = this;"))
+                 (emitln "var self__ = this"))
                (when variadic
                  (emits "var ")
                  (emit (last params))
-                 (emits " = null;")
-                 (emitln "if (arguments.length > " (dec (count params)) ") {")
+                 (emits " = nil")
+                 (emitln "if (len(arguments) > " (dec (count params)) ") {")
                  (emits "  ")
                  (emit (last params))
-                 (emits " = cljs.core.array_seq(Array.prototype.slice.call(arguments, " (dec (count params)) "),0);")
+                 (emits " = cljs.core.array_seq(arguments[: " (dec (count params)) "],0);")
                  (emitln "} "))
-               (emits "return " delegate-name ".call(this,")
+               (emits "return " delegate-name "(this,")
                (doseq [param params]
                  (emit param)
                  (when-not (= param (last params)) (emits ",")))
-               (emits ");")
-               (emitln "};")
-
-               (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
+               (emits ")")
+               (emitln "}")
+
+               (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity)
                (emits mname ".cljs$lang$applyTo = ")
                (emit-apply-to (assoc f :name name))
-               (emitln ";")
-               (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name ";")
-               (emitln "return " mname ";")
+               (emitln)
+               (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name)
+               (emitln "return " mname)
                (emitln "})()"))))

 (defmethod emit* :fn
@@ -544,7 +544,7 @@
       (when loop-locals
         (when (= :return (:context env))
             (emits "return "))
-        (emitln "((function (" (comma-sep (map munge loop-locals)) "){")
+        (emitln "((func (" (comma-sep (map munge loop-locals)) "){")
         (when-not (= :return (:context env))
             (emits "return ")))
       (if (= 1 (count methods))
@@ -563,49 +563,49 @@
               ms (sort-by #(-> % second :params count) (seq mmap))]
           (when (= :return (:context env))
             (emits "return "))
-          (emitln "(function() {")
-          (emitln "var " mname " = null;")
+          (emitln "(func() {")
+          (emitln "var " mname " = nil;")
           (doseq [[n meth] ms]
             (emits "var " n " = ")
             (if (:variadic meth)
               (emit-variadic-fn-method meth)
               (emit-fn-method meth))
-            (emitln ";"))
-            (emitln mname " = function(" (comma-sep (if variadic
-                                                      (concat (butlast maxparams) ['var_args])
-                                                      maxparams)) "){")
+            (emitln))
+            (emitln mname " = func(" (comma-sep (if variadic
+                                                  (concat (butlast maxparams) ['var_args])
+                                                  maxparams)) "){")
           (when variadic
             (emits "var ")
             (emit (last maxparams))
-            (emitln " = var_args;"))
-          (emitln "switch(arguments.length){")
+            (emitln " = var_args"))
+          (emitln "switch(len(arguments)){")
           (doseq [[n meth] ms]
             (if (:variadic meth)
               (do (emitln "default:")
                   (emitln "return " n ".cljs$core$IFn$_invoke$arity$variadic("
                           (comma-sep (butlast maxparams))
                           (when (> (count maxparams) 1) ", ")
-                          "cljs.core.array_seq(arguments, " max-fixed-arity "));"))
+                          "cljs.core.array_seq(arguments, " max-fixed-arity "))"))
               (let [pcnt (count (:params meth))]
                 (emitln "case " pcnt ":")
-                (emitln "return " n ".call(this" (if (zero? pcnt) nil
-                                                     (list "," (comma-sep (take pcnt maxparams)))) ");"))))
+                (emitln "return " n "(this" (if (zero? pcnt) nil
+                                                (list "," (comma-sep (take pcnt maxparams)))) ")"))))
           (emitln "}")
-          (emitln "panic(js.Error{'Invalid arity: ' + arguments.length});")
-          (emitln "};")
+          (emitln "panic(js.Error{'Invalid arity: ' + len(arguments)})")
+          (emitln "}")
           (when variadic
-            (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
-            (emitln mname ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs$lang$applyTo;"))
+            (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity)
+            (emitln mname ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs$lang$applyTo"))
           (when has-name?
             (doseq [[n meth] ms]
               (let [c (count (:params meth))]
                 (if (:variadic meth)
-                  (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " n ".cljs$core$IFn$_invoke$arity$variadic;")
-                  (emitln mname ".cljs$core$IFn$_invoke$arity$" c " = " n ";")))))
-          (emitln "return " mname ";")
+                  (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " n ".cljs$core$IFn$_invoke$arity$variadic")
+                  (emitln mname ".cljs$core$IFn$_invoke$arity$" c " = " n)))))
+          (emitln "return " mname)
           (emitln "})()")))
       (when loop-locals
-        (emitln ";})(" (comma-sep loop-locals) "))")))))
+        (emitln "})(" (comma-sep loop-locals) "))")))))

 (defmethod emit* :do
   [{:keys [statements ret env]}]
@@ -634,7 +634,7 @@
 (defn emit-let
   [{:keys [bindings expr env]} is-loop]
   (let [context (:context env)]
-    (when (= :expr context) (emits "(function (){"))
+    (when (= :expr context) (emits "(func (){"))
     (binding [*lexical-renames* (into *lexical-renames*
                                       (when (= :statement context)
                                         (map #(vector (System/identityHashCode %)
@@ -643,11 +643,11 @@
       (doseq [{:keys [init] :as binding} bindings]
         (emits "var ")
         (emit binding) ; Binding will be treated as a var
-        (emits " = " init ";"))
-      (when is-loop (emitln "while(true){"))
+        (emits " = " init))
+      (when is-loop (emitln "for {"))
       (emits expr)
       (when is-loop
-        (emitln "break;")
+        (emitln "break")
         (emitln "}")))
     (when (= :expr context) (emits "})()"))))

@@ -663,18 +663,18 @@
         params (:params frame)]
     (emitln "{")
     (dotimes [i (count exprs)]
-      (emitln "var " (temps i) " = " (exprs i) ";"))
+      (emitln "var " (temps i) " = " (exprs i)))
     (dotimes [i (count exprs)]
-      (emitln (munge (params i)) " = " (temps i) ";"))
-    (emitln "continue;")
+      (emitln (munge (params i)) " = " (temps i)))
+    (emitln "continue")
     (emitln "}")))

 (defmethod emit* :letfn
   [{:keys [bindings expr env]}]
   (let [context (:context env)]
-    (when (= :expr context) (emits "(function (){"))
+    (when (= :expr context) (emits "(func (){"))
     (doseq [{:keys [init] :as binding} bindings]
-      (emitln "var " (munge binding) " = " init ";"))
+      (emitln "var " (munge binding) " = " init))
     (emits expr)
     (when (= :expr context) (emits "})()"))))

@@ -744,7 +744,7 @@
        proto?
        (let [pimpl (str (munge (protocol-prefix protocol))
                         (munge (name (:name info))) "$arity$" (count args))]
-         (emits (first args) "." pimpl "(" (comma-sep (cons "null" (rest args))) ")"))
+         (emits (first args) "." pimpl "(" (comma-sep (cons "nil" (rest args))) ")"))

        keyword?
        (emits f ".cljs$core$IFn$_invoke$arity$" (count args) "(" (comma-sep args) ")")
@@ -761,8 +761,8 @@
        :else
        (if (and ana/*cljs-static-fns* (= (:op f) :var))
          (let [fprop (str ".cljs$core$IFn$_invoke$arity$" (count args))]
-           (emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : " f ".call(" (comma-sep (cons "null" args)) "))"))
-         (emits f ".call(" (comma-sep (cons "null" args)) ")"))))))
+           (emits "(func() { if " f fprop " { return " f fprop "(" (comma-sep args) ") } else { return " f ".(" (comma-sep (cons "null" args)) ")}})()"))
+         (emits f ".(" (comma-sep (cons "null" args)) ")"))))))

 (defmethod emit* :new
   [{:keys [ctor args env]}]
@@ -794,11 +794,12 @@
     (emitln "/**")
     (emitln "* @constructor")
     (emitln "*/")
-    (emitln (munge t) " = (function (" (comma-sep fields) "){")
+    (emitln (munge t) " = (func (" (comma-sep fields) "){")
+    (emitln "var this = new(" t ")")
     (doseq [fld fields]
-      (emitln "this." fld " = " fld ";"))
+      (emitln "this." fld " = " fld))
     (doseq [[pno pmask] pmasks]
-      (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
+      (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask))
     (emitln "})")))

 (defmethod emit* :defrecord*
@@ -812,21 +813,22 @@
     (emitln "* @param {*=} __meta ")
     (emitln "* @param {*=} __extmap")
     (emitln "*/")
-    (emitln (munge t) " = (function (" (comma-sep fields) "){")
+    (emitln (munge t) " = (func (" (comma-sep fields) "){")
+    (emitln "var this = new(" t ")")
     (doseq [fld fields]
       (emitln "this." fld " = " fld ";"))
     (doseq [[pno pmask] pmasks]
-      (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
-    (emitln "if(arguments.length>" (- (count fields) 2) "){")
-    (emitln "this.__meta = __meta;")
-    (emitln "this.__extmap = __extmap;")
+      (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask))
+    (emitln "if(len(arguments)>" (- (count fields) 2) "){")
+    (emitln "this.__meta = __meta")
+    (emitln "this.__extmap = __extmap")
     (emitln "} else {")
     (emits "this.__meta=")
     (emit-constant nil)
-    (emitln ";")
+    (emitln)
     (emits "this.__extmap=")
     (emit-constant nil)
-    (emitln ";")
+    (emitln)
     (emitln "}")
     (emitln "})")))


Use multimethod to dispatch current-page routing

--- src/cljs/gtfve/core.cljs
+++ src/cljs/gtfve/core.cljs
@@ -35,18 +35,29 @@
   [:div [:h2 "About gtfve"]
    [:div [:a {:href "#/"} "go to the home page"]]])

-(defn current-page []
-  [:div [(session/get :current-page)]])
+(defmulti page #(:current-page (deref %)))
+
+(defmethod page nil [state]
+  [home-page state])
+
+(defmethod page :home [state]
+  [home-page state])
+
+(defmethod page :about [state]
+  [about-page])
+
+(defn current-page [state]
+  [:div [page state]])

 ;; -------------------------
 ;; Routes
 (secretary/set-config! :prefix "#")

 (secretary/defroute "/" []
-  (session/put! :current-page #'home-page))
+  (session/put! :current-page :home))

 (secretary/defroute "/about" []
-  (session/put! :current-page #'about-page))
+  (session/put! :current-page :about))

 ;; -------------------------
 ;; History
@@ -63,4 +74,4 @@
 ;; Initialize app
 (defn init! []
   (hook-browser-navigation!)
-  (reagent/render [current-page] (.getElementById js/document "app")))
+  (reagent/render [current-page session/state] (.getElementById js/document "app")))


Fix order in docs

Fix order in docs

--- src/clojure/neko/doc.clj
+++ src/clojure/neko/doc.clj
@@ -15,6 +15,11 @@
   (:require [neko.ui.traits :as traits]
             [neko.ui.mapping :as mapping])
   (:use [clojure.string :only [join]]))
+
+(defn- get-trait-doc [trait]
+  (when-let [doc (get-in (meta #'traits/transform-attributes)
+                            [:trait-doc trait])]
+    (str trait " - " doc)))

 (defn get-element-doc
   [el-type el-mapping verbose?]
@@ -36,11 +41,6 @@
                (format "Special values: %s\n"
                        (pr-str values))))))

-(defn- get-trait-doc [trait]
-  (when-let [doc (get-in (meta #'traits/transform-attributes)
-                            [:trait-doc trait])]
-    (str trait " - " doc)))
-
 (get-element-doc :button (get @@#'mapping/keyword-mapping :button) true)

 (defn describe


view for creating background objects

view for creating background objects

--- src/runner/dom.cljs
+++ src/runner/dom.cljs
@@ -35,8 +35,8 @@

 (def physics-to-pixel 80)

-(def screen-width (fn [_] js/window.innerWidth))
-(def screen-height (fn [_] js/window.innerHeight))
+(def screen-width (fn [] js/window.innerWidth))
+(def screen-height (fn [] js/window.innerHeight))

 ;; player view
@@ -69,16 +69,43 @@
   "construct a style string from a js array. e.g position = #js [0, 9.8]"
   [player]
   (clj->js (merge {:position "absolute"
-                  :background-color "orange"}
-                 (ps-size (:radius player))
-                 (ps-position (:x player) (:y player) (:radius player)))))
-
+                   :background-color "orange"}
+                  (ps-size (:radius player))
+                  (ps-position (:x player) (:y player) (:radius player)))))

 (defn player-view [player owner]
   (reify
     om/IRender
     (render [_]
             (dom/div #js {:style (player-style player)} "player"))))
+
+
+;; background elements
+;; ----------------------------------------------------------------------------
+
+(defn square-collection
+  "create data that's used for generating background squares relative to player position"
+  [x y]
+  [{:x 0 :y 10} {:x 20 :y 200} {:x 40 :y 400} {:x 60 :y 100} {:x 300 :y 300}
+   {:x 40 :y 10} {:x 50 :y 20}])
+
+(defn square-position [squarex squarey playerx playery]
+  {:left (- squarex (* physics-to-pixel playerx))
+   :bottom squarey})
+
+(defn square-element [square playerx playery]
+  (dom/div #js {:style (clj->js (merge {:position "absolute"
+                                        :background-color "red"
+                                        :width 50
+                                        :height 50}
+                                       (square-position (:x square) (:y square) playerx playery)))} nil))
+
+(defn background-view [player owner]
+  (reify
+    om/IRender
+    (render [_]
+            (apply dom/div #js {:className "fullscreen"}
+                   (map #(square-element % (:x player) (:y player)) (square-collection 1 2))))))

 ;; game view/wrapper
@@ -89,8 +116,7 @@
     om/IRender
     (render [_]
             (dom/div nil
+                     (om/build background-view (:player state))
                      (om/build player-coordinates (:player state))
                      (om/build player-view (:player state))))))

-
-


Generalize set values of implicit sets

Generalize set values of implicit sets

--- src/angelic/hierarchy/state_set.clj
+++ src/angelic/hierarchy/state_set.clj
@@ -10,14 +10,39 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Implicit Set Protocol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defprotocol ImplicitStateSet
+;; Protocol used to represent both state sets, and value sets.
+;; State sets are like states, where the values implement PSet.
+;; Should also implement proper equality
+(defprotocol PSet
   (empty?    [s] "Is this set empty")
-;  (singleton-val [s v] "Return single possible value for far, or nil if not singleton")
   (singleton [s] "Return the singleton element making up this set, or nil if cardinality != 1.")
   (some-element [s] "Return an arbitrary element of this set, or throw if empty. ")
   (explicit-set [s] "Return an explicit outcome set. ")
-  (constrain [ss constraint] "Apply a constraint."))
-
+  (constrain [ss constraint] "Apply a constraint.")
+  (as-constraint [ss] "Return a constraint view.")
+  (subset? [s1 s2] "Is this set a (possibly improper) subset of the other?"))
+
+;; Allow Clojure sets to be used as value sets.
+(extend-type clojure.lang.IPersistentSet
+  PSet
+  (empty? [s] (clojure.core/empty? s))
+  (singleton [s] (util/singleton s))
+  (some-element [s]
+    (assert (not (clojure.core/empty? s)))
+    (first s))
+  (explicit-set [s] s)
+  (constrain [s constraint]
+    (assert (set? constraint))
+    (clojure.set/intersection s constraint))
+  (as-constraint [s] s)
+  (subset? [s1 s2] (util/subset? s1 s2)))
+
+
+(defn assert-pset! [x]
+  nil #_ (assert (satisfies? PSet x)))
+
+(defn proper-subset? [s1 s2]
+  (and (subset? s1 s2) (not (= s1 s2))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Factored Implicit Sets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -32,8 +57,6 @@
 ;; for now, we can just require that these be unconditional.
 ;; If we add unions, etc later, worry about details.
 ;; TODO: constraint is not the same as set-vars ?  ???
-
-;(def no-effect ::no-effect)

 (declare make-logging-factored-state-set)

@@ -72,44 +95,53 @@
    (meta [this] meta)
    (withMeta [this new-meta] (LoggingFactoredStateSet. init context puts ooc new-meta))

-  ImplicitStateSet
-   (empty? [ss] #_(println "AAA" init) (some clojure.core/empty? (vals init)))
-   (singleton [ss]
-     (when (every? util/singleton? (vals init))
-       (extract-logging-state ss (util/map-vals util/safe-singleton init))))
+  PSet
+   (empty? [ss]  (some empty? (vals init)))
+   (singleton [ss]
+     (let [vals-seq (map singleton (util/unchunk (vals init)))]
+       (when (every? identity vals-seq)
+         (extract-logging-state ss (zipmap (keys init) vals-seq)))))
    (some-element [ss]
-     (assert (not (empty? ss)))
-     (extract-logging-state ss (util/map-vals first init)))
+     (extract-logging-state ss (util/map-vals some-element init)))
    (explicit-set [ss]
-     (let [kvs (seq init)
-           ks  (map key kvs)
-           vss (map val kvs)]
+     (let [ks  (keys init)
+           vss (map explicit-set (vals init))]
        (set (for [vs (apply cartesian-product vss)] (extract-logging-state ss (zipmap ks vs))))))
    (constrain    [ss constraint]
-;    (util/assert-is (every? context (keys constraint)))
      (state/set-vars ss
-     (for [[var vals] constraint
-           :let [cur-vals (state/get-var ss var)
-                 isect    (clojure.set/intersection vals cur-vals)]
-           :when (not (= (count isect) (count cur-vals)))]
-       (do #_ (util/assert-is (contains? context var)) ;; TODO: can't actually assert this without stronger conditions on what must be reported in precondition contexts, unfortunately.  I.e., how to do it may not depend on initial value, but operation may still constrain it ?!
-           [var isect]))))
+      (for [[var vals] constraint
+            :let [cur-vals (state/get-var ss var)
+                  isect    (constrain cur-vals vals)]
+            :when (not (= (count isect) (count cur-vals)))]
+        [var isect])))
+  ;   (util/assert-is (contains? context var)) ;; TODO: can't actually assert this without stronger conditions on what must be reported in precondition contexts, unfortunately.  I.e., how to do it may not depend on initial value, but operation may still constrain it ?!
+   ;; Note difficulties: must capture all of context (even unset parts), plus set parts of non-context.
+   ;; If too large, can mess up SA.
+   (as-constraint [ss]
+      (util/map-vals as-constraint (into (state/extract-context ss (state/current-context ss)) (state/ooc-effects ss))))
+   (subset? [ss1 ss2]
+     (let [m1 (state/as-map ss1)
+           m2 (state/as-map ss2)
+           ks (util/keyset m1)]
+       (assert (= ks (util/keyset m2)))
+       (every? #(subset? (m1 %) (m2 %)) ks)))
+

   state/FactoredState
    (get-var [ss var]
      (let [x (state/get-var init var)]
-       (util/assert-is (set? x) "%s" [var])
+       (assert-pset! x)
        x))

    (set-var [ss var val]
-       (util/assert-is (set? val) "%s" [var])
+       (assert-pset! val)
        (LoggingFactoredStateSet. (state/set-var init var val) ; init
                               context
                               (assoc puts var val)
                               (if (.contains context var) ooc (assoc ooc var val))
                               {}))
    (set-vars [ss vv-pairs]
-       (doseq [[var val] vv-pairs] (util/assert-is (set? val) "%s" [var]))
+       (doseq [[var val] vv-pairs] (assert-pset! val))
        (LoggingFactoredStateSet. (state/set-vars init vv-pairs)
                               context
                               (into puts vv-pairs)
@@ -157,33 +189,13 @@
          (meta (first lfss))))))

 (defn vars-known? [ss vars]
-  (every? #(util/singleton? (state/get-var ss %)) vars))
-
-(defn get-known-var [ss var] (util/safe-singleton (state/get-var ss var)))
+  (every? #(singleton (state/get-var ss %)) vars))
+
+(defn get-known-var [ss var] (util/make-safe (singleton (state/get-var ss var))))

 (defn ss-str [ss] "LFSS" (print-str (dissoc (state/as-map ss) :const)))
 (defmethod print-method LoggingFactoredStateSet [ss o] (print-method (ss-str ss) o))

-(defn proper-subset? [ss1 ss2]
-  (let [m1 (state/as-map ss1)
-        m2 (state/as-map ss2)
-        ks (util/keyset m1)]
-    (assert (= ks (util/keyset m2)))
-    (and (every? #(util/subset? (m1 %) (m2 %)) ks)
-         (some   #(util/proper-subset? (m1 % ) (m2 %)) ks))
-    #_ (or
-
-        (println (filter #(not (clojure.set/subset? (nth % 1) (nth % 2))) (map #(vector % (m1 %) (m2 %)) ks))
-                 (filter   #(util/proper-subset? (m1 % ) (m2 %)) ks)
-                 ))))
-
-;; TODO: can we do tis better?
-;; Note difficulties: must capture all of context (even unset parts), plus set parts of non-context.
-;; Must not be too large to mess up SA.
-(defn as-constraint [ss]#_ (println (state/extract-effects ss) (state/current-context ss))
-  (into (state/extract-context ss (state/current-context ss)) (state/ooc-effects ss))
-#_  (state/as-map ss)
- #_  (state/extract-effects ss))


Fixed completions fn

Fixed completions fn

--- src/re_complete/app.cljs
+++ src/re_complete/app.cljs
@@ -4,9 +4,11 @@

 (defn case-sensitivity [case-sensitive? dictionary-item input]
-  (if case-sensitive?
-    (string/starts-with? dictionary-item input)
-    (string/starts-with? (string/lower-case dictionary-item) (string/lower-case input))))
+  (if (= input "")
+    nil
+    (if case-sensitive?
+      (string/starts-with? dictionary-item input)
+      (string/starts-with? (string/lower-case dictionary-item) (string/lower-case input)))))

 (defn items-to-complete
   "List of the items to autocomplete by given input and list of the all items"
@@ -33,23 +35,21 @@
       ""
       current-word-item)))

-(defn completions
-  "Autocomplete options for word"
-  [input dictionary options]
-  (let [last-string (last (string/split input #" "))
-        trim-chars (:trim-chars options)
-        sort-fn (:sort-fn options)
-        case-sensitive? (:case-sensitive? options)
-        complete-items (items-to-complete case-sensitive? dictionary last-string)]
-    (vec
-     (if trim-chars
-       (if (= (first last-string) (re-find (utils/str-to-pattern trim-chars) (str (first last-string))))
-         (->> 1
-              (subs last-string)
-              (items-to-complete case-sensitive? dictionary)
-              (sort-by sort-fn))
-         (sort-by sort-fn complete-items))
-       (sort-fn complete-items)))))
+(defn opening-excluded-chars [word excluded-chars]
+  (if ((set (map #(= (first word) %) excluded-chars)) true)
+    (opening-excluded-chars (apply str (rest word)) excluded-chars)
+    word))
+
+(defn closing-excluded-chars [word excluded-chars]
+  (if ((set (map #(= (last word) %) excluded-chars)) true)
+    (closing-excluded-chars (apply str (butlast word)) excluded-chars)
+    word))
+
+(defn completions [word dictionary {:keys [trim-chars sort-fn case-sensitive?]}]
+  (let [new-text (-> word
+                     (opening-excluded-chars trim-chars)
+                     (closing-excluded-chars trim-chars))]
+    (sort-by sort-fn (items-to-complete case-sensitive? dictionary new-text))))

 (defn words-to-index
   "Words to change index"
@@ -82,11 +82,11 @@
   [index-in-word word word-to-complete trim-chars]
   (let [partitioned-by-trimmed-chars (vec (utils/partition-by-regexp word trim-chars))
         index-of-part-to-complete (-> index-in-word
-                                          inc
-                                          (take word)
-                                          (utils/partition-by-regexp trim-chars)
-                                          count
-                                          dec)]
+                                      inc
+                                      (take word)
+                                      (utils/partition-by-regexp trim-chars)
+                                      count
+                                      dec)]
     (->> (update-in partitioned-by-trimmed-chars [index-of-part-to-complete]
                     #(str word-to-complete))
          (string/join ""))))
@@ -96,7 +96,7 @@
   [index trim-chars text word-to-complete]
   (->> (update-in (string/split text #" ") [(index-of-word index text)]
                   #(complete-word-with-trimmed-chars (index-in-word index text)
-                                                         %
-                                                         word-to-complete
-                                                         trim-chars))
+                                                     %
+                                                     word-to-complete
+                                                     trim-chars))
        (string/join " ")))


Refactor code

Refactor code

--- src/spectrace/trace.cljc
+++ src/spectrace/trace.cljc
@@ -43,8 +43,8 @@
                      " must have its own spec definition"))
         (step* (assoc state :spec spec') succ fail)))))

-(defn- with-cont [succ fail f]
-  (if-let [ret (f)]
+(defn- with-cont [succ fail ret]
+  (if ret
     (succ ret fail)
     (fail)))

@@ -62,12 +62,11 @@

 (defn- step-by-key [{:keys [spec path val in]} succ fail & {:keys [val-fn]}]
   (with-cont succ fail
-    (fn []
-      (let [[segment & path] path, [key & in] in]
-        (when-let [spec' (some #(and (= (:key %) segment) (:pred %))
-                               (:args spec))]
-          {:spec spec' :path path :in in
-           :val (cond-> val val-fn #(val-fn % key))})))))
+    (let [[segment & path] path, [key & in] in]
+      (when-let [spec' (some #(and (= (:key %) segment) (:pred %))
+                             (:args spec))]
+        {:spec spec' :path path :in in
+         :val (cond-> val val-fn #(val-fn % key))}))))

 (defmethod step* `s/or [state succ fail]
   (step-by-key state succ fail))


move to released versions of systems-toolbox

--- iwaswhere-web/project.clj
+++ iwaswhere-web/project.clj
@@ -20,9 +20,9 @@
                  [com.drewnoakes/metadata-extractor "2.8.1"]
                  [ubergraph "0.2.2"]
                  [camel-snake-kebab "0.4.0"]
-                 [matthiasn/systems-toolbox "0.6.1-SNAPSHOT"]
-                 [matthiasn/systems-toolbox-ui "0.6.1-SNAPSHOT"]
-                 [matthiasn/systems-toolbox-sente "0.6.1-SNAPSHOT"]
+                 [matthiasn/systems-toolbox "0.6.1-alpha1"]
+                 [matthiasn/systems-toolbox-ui "0.6.1-alpha1"]
+                 [matthiasn/systems-toolbox-sente "0.6.1-alpha1"]
                  [alandipert/storage-atom "2.0.1"]]

   :source-paths ["src/cljc" "src/clj/"]


database: store data inside a :data key inside a table, making room for other metadata about a table

--- src/subrosa/database.clj
+++ src/subrosa/database.clj
@@ -11,9 +11,9 @@

 (defn get*
   ([db table]
-     (vals (get-in db [table :id])))
+     (vals (get-in db [table :data :id])))
   ([db table column value]
-     (get-in db [table column value])))
+     (get-in db [table :data column value])))

 (defn get
   ([table]
@@ -22,10 +22,11 @@
      (get* @db table column value)))

 (defn delete* [db table m]
-  (assoc db table (reduce (fn [a [k v]]
-                            (update-in a [k] dissoc v))
-                          (db table)
-                          m)))
+  (update-in db [table] assoc
+             :data (reduce (fn [a [k v]]
+                             (update-in a [k] dissoc v))
+                           (get-in db [table :data])
+                           m)))

 (defn delete [table id]
   (dosync
@@ -33,10 +34,11 @@
      (alter db delete* table m))))

 (defn put* [db table m]
-  (assoc db table (reduce (fn [a [k v]]
-                            (update-in a [k] assoc v m))
-                          (db table)
-                          m)))
+  (update-in db [table] assoc
+             :data (reduce (fn [a [k v]]
+                             (update-in a [k] assoc v m))
+                           (get-in db [table :data])
+                           m)))

 (defn put [table m]
   (dosync


Fills in gen-phrase-classifier and defines create-dataset.

--- src/cadence/pattern_recognition.clj
+++ src/cadence/pattern_recognition.clj
@@ -30,8 +30,14 @@
   [] (sess/get :training-cadences #{}))

 (defn gen-phrase-classifier
-  "Creates an SVM classifier from the given data."
-  []
+  "Creates a trained SVM classifier using the given dataset."
+  [training-data]
+  (classifier-train (make-classifier :support-vector-machine :smo)
+                    training-data))
+
+(defn create-dataset
+  "Creates a dataset from the two sequences of bad and cadences."
+  [bad-cadences good-cadences]
   ; TODO Implement
   nil)


attach date

attach date

--- src/tamaki/post/post.clj
+++ src/tamaki/post/post.clj
@@ -4,7 +4,8 @@
             [tamaki.lwml.lwml :as lwml]
             [net.cgrand.enlive-html :as ehtml]
             [clojure.java.io :as io])
-  (:import (java.io StringReader)))
+  (:import (java.io StringReader)
+           (java.text SimpleDateFormat)))

 (defn- post-seq
   "Returns the post files."
@@ -20,14 +21,20 @@

 (defn- normalize-path [path] (string/replace path #"[/]+" "/"))

+(def ^:private date-formatter (new SimpleDateFormat "yyyy-MM-dd"))
+
 (defn- compile-posts [site-root post-prefix dest post-dir compiler-map]
   (letfn [(convert-filename [ml-filename] (string/replace ml-filename
                                                           #"(\d{4})-(\d{1,2})-(\d{1,2})-(.+)\.[^\.]+$"
                                                           "$1/$2/$3/$4.html"))
           (build-suffix [post-prefix basename]
-            (normalize-path (str post-prefix "/" (convert-filename basename))))]
+            (normalize-path (str post-prefix "/" (convert-filename basename))))
+          (extract-date [text-includes-date]
+            (let [maybe-date (first (re-seq #"\d{4}-\d?\d-\d?\d" text-includes-date))]
+              (if (some? maybe-date) (.parse date-formatter maybe-date))))]
     (let [postfiles (-> post-dir io/file post-seq)
-          compiled (filter #(some? %) (map #(lwml/compile-lwmlfile (fs/absolute %) compiler-map) postfiles))
+          compiled (map #(assoc % :date (-> % :src fs/base-name extract-date))
+                        (filter #(some? %) (map #(lwml/compile-lwmlfile (fs/absolute %) compiler-map) postfiles)))
           neighbors (chain-urls (map #(normalize-path
                                         (str site-root "/" (build-suffix post-prefix (fs/base-name (:src %)))))
                                      compiled))]


adding enough code to make the test pass for li's again

--- src/watney/core.clj
+++ src/watney/core.clj
@@ -19,6 +19,7 @@
                 :h2 (str "## " (first (:content node)))
                 :h3 (str "### " (first (:content node)))
                 :h4 (str "#### " (first (:content node)))
+                :li (str "* " (first (:content node)))
                 (convert-entity (:content node)))))
        (remove empty?)
        (str/join "\n")))


Adjust color-harness spectrums.

Adjust color-harness spectrums.

--- test/org/playasophy/wonderdome/util/color_test.clj
+++ test/org/playasophy/wonderdome/util/color_test.clj
@@ -11,6 +11,7 @@
   []
   (quil/frame-rate 5)
   (quil/text-font (quil/create-font "Courier" 18 true))
+  ;(quil/blend-mode :blend)
   (quil/background 0)
   (quil/stroke 0))

@@ -69,8 +70,8 @@
       (quil/text "HSV Spectrum" 0 0)
       (let [width 480, height 100]
         (quil/fill 0)
-        (quil/stroke (color/gray 0.5))
-        (quil/rect 0 10 width height)
+        (quil/stroke (color/gray 0.75))
+        (quil/rect -1 9 (inc width) (inc height))
         (doseq [x (range 0 width)
                 y (range 0 height)]
           (quil/stroke (color/hsv (/ x width) 1 (- 1 (/ y height))))
@@ -82,8 +83,8 @@
       (quil/text "HSL Spectrum" 0 0)
       (let [width 480, height 100]
         (quil/fill 0)
-        (quil/stroke (color/gray 0.5))
-        (quil/rect 0 10 width height)
+        (quil/stroke (color/gray 0.75))
+        (quil/rect -1 9 (inc width) (inc height))
         (doseq [x (range 0 width)
                 y (range 0 height)]
           (quil/stroke (color/hsl (/ x width) 1 (- 1 (/ y height))))


Added new functions and refactoring

Added new functions and refactoring

--- src/clj_jenkins_api/jenkins_api.clj
+++ src/clj_jenkins_api/jenkins_api.clj
@@ -22,13 +22,14 @@
     (.println System/out (apply str (interpose \space args))))

 (defn encode-spaces
+    "Encode spaces in URL into its codes."
     [url]
     (clojure.string/replace url " " "%20"))

 (defn job-name->url
     "Transform job name (that can contain spaces) to the URL part."
     [jenkins-url job-name]
-    (str jenkins-url "job/" (encode-spaces job-name " " "%20")))
+    (str jenkins-url "job/" (encode-spaces job-name)))

 (defn update-jenkins-url
     "Updates URL to Jenkins (API) by adding basic authorization string if provided."


Reset the comic-imgs anytime the reader is reactivated

--- src/cljs/comic_reader/handlers.cljs
+++ src/cljs/comic_reader/handlers.cljs
@@ -31,7 +31,8 @@
      (assoc db
             :page page
             :site site
-            :location location)))
+            :location location
+            :comic-imgs [])))

   (rf/register-handler
    :site-list
@@ -53,7 +54,6 @@
    :next-image
    (fn [db [_ img-tag]]
      (api/get-img-tag (:site db) (first (:url-list db)))
-     (let [db (update-in db [:url-list] rest)]
-      (if (vector? (:comic-imgs db))
-        (update-in db [:comic-imgs] conj img-tag)
-        (assoc db :comic-imgs [img-tag]))))))
+     (-> db
+         (update-in [:url-list] rest)
+         (update-in [:comic-imgs] conj img-tag)))))


started work on force generators

started work on force generators

--- src/cljs/defender_cljs/physics.cljs
+++ src/cljs/defender_cljs/physics.cljs
@@ -22,3 +22,14 @@
         position (a/set-position! actor new-position)

         ]))
+
+;;force generators
+
+;;Damping generator, which damps the velocity.
+(def damped-actors (atom []))
+(defn apply-damping-generator
+  "Takes an actor, and applies damping to the velocity"
+  [actor damping]
+  (let [velocity (a/get-velocity actor)]
+    (a/set-velocity! actor (map (partial * damping) velocity))))
+


deckbuilder code reorganisation

deckbuilder code reorganisation

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -51,20 +51,7 @@
   (let [deck (om/get-state owner :deck)]
     (go (let [response (<! (POST "/data/decks/delete" deck :json))]))
     (om/transact! cursor :decks (fn [ds] (vec (remove #(= deck %) ds))))
-    (om/set-state! owner :deck {})))
-
-(defn decklist-view [{:keys [name identity cards]} owner]
-  (om/component
-   (sab/html
-    [:div
-     [:h3.deckname name]
-     [:h4 identity]
-     [:div.cards
-      (for [card cards]
-        [:p (:qty card) " "
-         (if-let [name (get-in card [:card :title])]
-           [:a {:href ""} name]
-           (:card card))])]])))
+    (om/set-state! owner :deck (first (:decks @cursor)))))

 (defn deck-builder [{:keys [decks] :as cursor} owner]
   (reify
@@ -74,7 +61,7 @@
        :card-search ""
        :quantity 1
        :deck-edit ""
-       :deck {}})
+       :deck nil})

     om/IRenderState
     (render-state [this state]
@@ -89,22 +76,30 @@
            [:div.deck-collection
             (if (empty? decks)
               [:h4 "You have no deck"]
-              (for [deck decks]
+              (for [deck (:decks cursor)]
                 [:div.block-link {:class (when (= (:deck state) deck) "active")
                                   :on-click #(om/set-state! owner :deck deck)}
                  [:h4 (:name deck)]
                  [:p (:identity deck)]]))]]

           [:div.decklist
-           (when-not (empty? (:deck state))
-             (if (:edit state)
-               [:span
-                [:button {:on-click #(end-edit owner)} "Cancel"]
-                [:button {:on-click #(save-deck owner)} "Save"]]
-               [:span
-                [:button {:on-click #(handle-delete cursor owner)} "Delete"]
-                [:button {:on-click #(edit-deck owner)} "Edit"]]))
-           (om/build decklist-view (:deck state))]
+           (when-let [deck (:deck state)]
+             [:div
+              (if (:edit state)
+                [:span
+                 [:button {:on-click #(end-edit owner)} "Cancel"]
+                 [:button {:on-click #(save-deck owner)} "Save"]]
+                [:span
+                 [:button {:on-click #(handle-delete cursor owner)} "Delete"]
+                 [:button {:on-click #(edit-deck owner)} "Edit"]])
+              [:h3.deckname (:name deck)]
+              [:h4 (:identity deck)]
+              [:div.cards
+               (for [card (:cards deck)]
+                 [:p (:qty card) " "
+                  (if-let [name (get-in card [:card :title])]
+                    [:a {:href ""} name]
+                    (:card card))])]])]

           [:div.deckedit
            [:div


More Crypto code

More Crypto code

--- src/clojure_fabric/crypto_suite.clj
+++ src/clojure_fabric/crypto_suite.clj
@@ -1,13 +1,16 @@
 (ns clojure-fabric.crypto-suite
   (:import [org.bouncycastle.crypto.generators ECKeyPairGenerator]
            [org.bouncycastle.jce ECNamedCurveTable]
-           [org.bouncycastle.jce.spec ECNamedCurveParameterSpec]
+           [org.bouncycastle.jce.spec ECNamedCurveParameterSpec ECParameterSpec ECNamedCurveSpec]
            [org.bouncycastle.jce.provider BouncyCastleProvider]
-           [org.bouncycastle.jcajce.provider.asymmetric.ec KeyPairGeneratorSpi$ECDSA]
-           [java.security KeyPairGenerator SecureRandom]))
+           [org.bouncycastle.jcajce.provider.asymmetric.ec KeyPairGeneratorSpi$ECDSA
+            BCECPrivateKey BCECPublicKey]
+           [java.security KeyPairGenerator SecureRandom Security])
+  (:refer-clojure :exclude [hash]))

-(defonce ecdsa-parameter-specs {:secp256r1 (ECNamedCurveTable/getParameterSpec "secp256r1")
-                                :secp384r1 (ECNamedCurveTable/getParameterSpec "secp384r1")})
+;; Add provider!
+(Security/addProvider (BouncyCastleProvider.))
+
 ;;;generate_key
 (defn generate-key
   "Generate a key based on the options. The utput can be a private key or a public key in an
@@ -24,7 +27,35 @@
         param-specs (-> ephemeral name ECNamedCurveTable/getParameterSpec)]
     (.initialize generator param-specs (SecureRandom.))
     (.generateKeyPair generator)))
+;; (generate-key :ECDSA :secp256r1)

+
+(defprotocol IKey
+  (algorithm [this])
+  (curve-spec [this])
+  (curve-params [this]))
+
+(defn- %curve-params [params]
+  ;; (.multiply g (biginteger 100000000000000000000))
+  ;;
+  (zipmap [:curve :g :h :n]
+          ((juxt #(.getCurve ^ECParameterSpec %) #(.getG ^ECParameterSpec %) #(.getH ^ECParameterSpec %)
+                 #(.getN ^ECParameterSpec %))
+           params)))
+
+(extend-type BCECPrivateKey
+  IKey
+  (algorithm [this] (-> this .getAlgorithm keyword))
+  (curve-spec [this] (keyword (.getName ^ECNamedCurveSpec (.getParams this))))
+  (curve-params [this] (-> this .getParameters %curve-params)))
+
+(extend-type BCECPublicKey
+  IKey
+  (algorithm [this] (-> this .getAlgorithm keyword))
+  (curve-spec [this] (keyword (.getName ^ECNamedCurveSpec (.getParams this))))
+  (curve-params [this] (-> this .getParameters %curve-params)))
+
+;;; http://www.bouncycastle.org/wiki/display/JA1/Elliptic+Curve+Key+Pair+Generation+and+Key+Factories
 ;;;deriveKey
 (defn derive-key
   "Derives a key from k using opts.
@@ -33,11 +64,20 @@
         opts (Object)
   Returns
         (Key) derived key"
-  [k {:keys [algorithm ephemeral] :as opt}]
+  [k {:keys [ephemeral] :as opt}]
+  ;; From JS SDK doc
   ;; Derives the new private key from the source public key using the parameters passed in the opts.
   ;; This operation is needed for deriving private keys corresponding to the Transaction
   ;; Certificates.
+
+  ;; From Go SDK
+  ;;
+  ;;1.
   )
+
+
+
+

 ;;; importKey
 (defn import-key


Genome instructions manipulate genomes as vectors.

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -27,8 +27,8 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take (inc index) genome)
-                                (drop index genome))
+             (push-item (into (subvec genome 0 (inc index))
+                              (subvec genome index))
                         :genome)))
       state)))

@@ -43,13 +43,13 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (list (random-plush-instruction-map
-                                        @global-atom-generators
-                                        {:epigenetic-markers @global-epigenetic-markers
-                                         :close-parens-probabilities @global-close-parens-probabilities
-                                         :silent-instruction-probability @global-silent-instruction-probability}))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (random-plush-instruction-map
+                            @global-atom-generators
+                            {:epigenetic-markers @global-epigenetic-markers
+                             :close-parens-probabilities @global-close-parens-probabilities
+                             :silent-instruction-probability @global-silent-instruction-probability}))
                         :genome)))
       state)))

@@ -64,8 +64,8 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (drop (inc index) genome))
+             (push-item (into (subvec genome 0 index)
+                              (subvec genome (inc index)))
                         :genome)))
       state)))

@@ -80,8 +80,8 @@
             distance (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (drop distance genome)
-                                (take distance genome))
+             (push-item (into (subvec genome distance)
+                              (subvec genome 0 distance))
                         :genome)))
       state)))

@@ -99,9 +99,9 @@
             index (mod (stack-ref :integer 0 state) (count source))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (seq (assoc (vec destination)
-                                    (min index (count destination))
-                                    (nth source index)))
+             (push-item (assoc (vec destination)
+                          (min index (count destination))
+                          (nth source index))
                         :genome)))
       state)))

@@ -123,14 +123,14 @@
         (->> (pop-item :integer state)
           (pop-item :integer)
           (pop-item :genome)
-          (push-item (seq (loop [i low-index
-                                 result (vec destination)]
-                            (if (> i high-index)
-                              result
-                              (recur (inc i)
-                                     (assoc result
-                                            (min i (count destination))
-                                            (nth source i))))))
+          (push-item (loop [i low-index
+                            result destination]
+                       (if (> i high-index)
+                         result
+                         (recur (inc i)
+                                (assoc result
+                                  (min i (count destination))
+                                  (nth source i)))))
                      :genome)))
       state)))

@@ -145,10 +145,10 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (let [g (nth genome index)]
-                                  (list (assoc g :silent (not (:silent g)))))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (let [g (nth genome index)]
+                            (assoc g :silent (not (:silent g)))))
                         :genome)))
       state)))

@@ -163,10 +163,10 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (let [g (nth genome index)]
-                                  (list (assoc g :silent true)))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (let [g (nth genome index)]
+                            (assoc g :silent true)))
                         :genome)))
       state)))

@@ -181,10 +181,10 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (let [g (nth genome index)]
-                                  (list (assoc g :silent false)))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (let [g (nth genome index)]
+                            (assoc g :silent false)))
                         :genome)))
       state)))

@@ -199,10 +199,10 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (let [g (nth genome index)]
-                                  (list (assoc g :close (inc (:close g)))))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (let [g (nth genome index)]
+                            (assoc g :close (inc (:close g)))))
                         :genome)))
       state)))

@@ -217,10 +217,10 @@
             index (mod (stack-ref :integer 0 state) (count genome))]
         (->> (pop-item :integer state)
              (pop-item :genome)
-             (push-item (concat (take index genome)
-                                (let [g (nth genome index)]
-                                  (list (assoc g :close (max 0 (dec (:close g))))))
-                                (drop (inc index) genome))
+             (push-item (assoc genome
+                          index
+                          (let [g (nth genome index)]
+                            (assoc g :close (max 0 (dec (:close g))))))
                         :genome)))
       state)))

@@ -228,19 +228,19 @@
   genome_new
   ^{:stack-types [:genome]}
   (fn [state]
-    (push-item () :genome state)))
+    (push-item [] :genome state)))

 (define-registered
   genome_parent1
   ^{:stack-types [:genome]}
   (fn [state]
-    (push-item (:parent1-genome state) :genome state)))
+    (push-item (vec (:parent1-genome state)) :genome state)))

 (define-registered
   genome_parent2
   ^{:stack-types [:genome]}
   (fn [state]
-    (push-item (:parent2-genome state) :genome state)))
+    (push-item (vec (:parent2-genome state)) :genome state)))

 (define-registered
   autoconstructive_integer_rand


Allow t-sweet to run in isolation.

Allow t-sweet to run in isolation.

--- test/midje/t_sweet.clj
+++ test/midje/t_sweet.clj
@@ -1,7 +1,8 @@
 (ns midje.t-sweet
   (:use midje.sweet
         midje.util
-        midje.test-util))
+        midje.test-util)
+  (:require midje.internal-ideas.t-fakes))

 (fact "all of Midje's public, API-facing vars have docstrings"
   (map str (remove (comp :doc meta) (vals (ns-publics 'midje.sweet)))) => []


load new config

load new config

--- src/shuppet/core.clj
+++ src/shuppet/core.clj
@@ -2,8 +2,10 @@
   (:require [clojure.string :refer [lower-case]]
             [clojure.data.json :refer [json-str]]
             [shuppet.util :refer :all]
-            [shuppet.git :as git]
-            [shuppet.securitygroups :refer :all]
+            [shuppet
+             [git :as git]
+             [securitygroups :refer [ensure-sg]]
+             [elb :refer [ensure-elb]]]
             [clj-http.client :as client]
             [environ.core :refer [env]]))

@@ -52,34 +54,34 @@
     (slurp file-name)))

-(defn execute-string
-  [default-vars clojure-string]
+(defn- execute-string
+  [clojure-string name environment]
   (let [ns (-> (java.util.UUID/randomUUID) (str) (symbol) (create-ns))]
-    (try
-      (binding [*ns* ns
-                default-config default-vars]
-        (clojure.core/refer 'clojure.core)
-        (refer 'clojure.data.json)
-        (refer 'shuppet.core)
-        (refer 'shuppet.util)
-        (refer 'shuppet.securitygroups)
-        (eval (load-string clojure-string)))
-      (finally (remove-ns (symbol (ns-name ns)))))))
-
-(defn- get-default-config
-  [app-name env print-json defaults]
-  (merge defaults {:Application (lower-case app-name)
-                   :Environment (keyword (lower-case env))
-                   :PrintJson print-json}))
+    (binding [*ns* ns]
+      (clojure.core/refer 'clojure.core)
+      (refer 'clojure.data.json)
+      (refer 'shuppet.core)
+      (refer 'shuppet.util)
+      (refer 'shuppet.securitygroups)
+      (def app-name name)
+      (def environment (keyword environment))
+      (let [config (load-string clojure-string)]
+        (remove-ns (symbol (ns-name ns)))
+        config))))

 (defn configure
-  ([app-name env print-json]
-     (let [defaults (execute-string nil (contents (FromGit. env)))]
-       (execute-string (get-default-config app-name
-                                           env
-                                           print-json
-                                           defaults)
-                       (contents (FromGit. app-name))))))
+  ([env app-name print-json]
+     (let [defaults (contents (FromGit.
+                               env))
+           config (contents (FromGit.
+                             app-name))
+           config (execute-string (str defaults "\n" config) app-name env)
+           ]
+       (if print-json
+         (json-str config)
+         (do
+           (ensure-sg (:sg config))
+           (ensure-elb (:elb config)))))))

 (defn update
   [env]


Can add version to the policy statement now.

--- src/shuppet/util.clj
+++ src/shuppet/util.clj
@@ -160,9 +160,10 @@
   (if (string? item) [item] (vec item)))

 (defn- create-policy-statement
-  ([sid effect principal action resource conditions]
+  ([version sid effect principal action resource conditions]
      (let [effect (if (empty? effect) "Allow" effect)]
-       (without-nils {:Effect effect
+       (without-nils {:Version version
+                      :Effect effect
                       :Sid sid
                       :Principal principal
                       :Action (to-vec action)
@@ -188,14 +189,14 @@

 (defn create-policy
   "http://docs.aws.amazon.com/IAM/latest/UserGuide/PoliciesOverview.html"
-  ([sid effect principal action resource conditions]
-     {:Statement [(create-policy-statement sid effect principal action resource conditions)]})
+  ([version sid effect principal action resource conditions]
+     {:Statement [(create-policy-statement version sid effect principal action resource conditions)]})
   ([sid action resource]
-     (create-policy sid nil nil action resource nil))
+     (create-policy nil sid nil nil action resource nil))
   ([action resource]
      (create-policy nil action resource))
-  ([{:keys [Sid Effect Principal Action Resource Conditions]}]
-     (create-policy Sid Effect Principal Action Resource Conditions)))
+  ([{:keys [Version Sid Effect Principal Action Resource Conditions]}]
+     (create-policy Version Sid Effect Principal Action Resource Conditions)))

 (defn- create-grant
   [display-name permission keyword value]


Run benchmark at the end

Run benchmark at the end

--- test/sablono/test.cljs
+++ test/sablono/test.cljs
@@ -6,8 +6,8 @@
             [sablono.normalize-test]
             [sablono.util-test]))

-(doo-tests 'sablono.benchmark
-           'sablono.core-test
+(doo-tests 'sablono.core-test
            'sablono.interpreter-test
            'sablono.normalize-test
-           'sablono.util-test)
+           'sablono.util-test
+           'sablono.benchmark)


bring in new font utils

bring in new font utils

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -5,6 +5,7 @@
               [infinitelives.utils.events :as events]
               [infinitelives.utils.console :refer [log]]
               [infinitelives.pixi.texture :as texture]
+              [infinitelives.pixi.font :as font]
               [infinitelives.utils.math :as math]
               ;[splash.macros :refer-macros [ignore]]
               [cljs.core.async :refer [<!]])


Removed println, but still getting weird results

--- test/forma/trends/stretch_test.clj
+++ test/forma/trends/stretch_test.clj
@@ -10,6 +10,7 @@
     (shift-periods-target-res "32" "16" (:start-idx ts) (:end-idx ts)) => [736 739]))

 (fact
+  "Expect to see values repeated the correct number of days given a monthly dataset (e.g. 31 for January, 28 for non-leap year February."
   (expand-to-days 384 [1 2 3] 384 1 "32" 0) => [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3])

 (fact
@@ -19,11 +20,8 @@
     (ts-expander "32" "16" ts) => output))

 (fact
-  "Expand a longer timeseries - in this case one year of NDVI"
-  (let [p32 12 ;; number of periods, 32-day res
-        p16 22 ;; expected number of periods, 16-day res
-        ts (schema/timeseries-value 360 (take p32 data/ndvi))
-        out-ts (ts-expander "32" "16" ts)]
-    (println (date/period->datetime "16" (:start-idx out-ts)))
-    (println (date/period->datetime "16" (:end-idx out-ts)))
-    (count (:series out-ts)) => p16))+  "Expanding a year-long monthly timeseries (12 periods) should yield a year's worth of 16-day periods (23)."
+  (let [periods-32 12 ;; number of periods, 32-day res
+        periods-16 23 ;; expected number of periods, 16-day res
+        ts (schema/timeseries-value 360 (take periods-32 data/ndvi))]
+    (count (:series (ts-expander "32" "16" ts))) => periods-16))


Add more docstrings to connect

Add more docstrings to connect

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -150,6 +150,12 @@
     ia ib))

 (defn add
+  "Low level function to add resolvers to the index. This function adds the resolver
+  configuration to the index set, adds the resolver to the ::pc/index-resolvers, add
+  the output to input index in the ::pc/index-oir and the reverse index for auto-complete
+  to the index ::pc/index-io.
+
+  This is a low level function, for adding to your index prefer using `pc/register`."
   ([indexes sym] (add indexes sym {}))
   ([indexes sym sym-data]
    (let [{::keys [input output] :as sym-data} (merge {::sym   sym
@@ -195,7 +201,18 @@
   2. a mutation map
   3. a sequence with items

-  The sequence version can have nested sequences, they will be recursively add."
+  The sequence version can have nested sequences, they will be recursively add.
+
+  Examples of possible usages:
+
+      (-> {} ; blank index
+          (pc/register one-resolver) ; single resolver
+          (pc/register one-mutation) ; single mutation
+          (pc/register [one-resolver one-mutation]) ; sequence of resolvers/mutations
+          (pc/register [[resolver1 resolver2] [resolver3 mutation]]) ; nested sequences
+          (pc/register [[resolver1 resolver2] resolver-out [resolver3 mutation]]) ; all mixed
+          )
+  "
   [indexes item-or-items]
   (if (sequential? item-or-items)
     (reduce
@@ -226,8 +243,10 @@
                       1)
                     1)))))

-(defn pick-resolver [{::keys [indexes dependency-track]
-                      :as    env}]
+(defn pick-resolver
+  "DEPRECATED"
+  [{::keys [indexes dependency-track]
+    :as    env}]
   (let [k (-> env :ast :key)
         e (p/entity env)]
     (if-let [attr-resolvers (get-in indexes [::index-oir k])]
@@ -257,7 +276,9 @@
 (s/fdef pick-resolver
   :args (s/cat :env (s/keys :req [::indexes] :opt [::dependency-track])))

-(defn async-pick-resolver [{::keys [indexes dependency-track] :as env}]
+(defn async-pick-resolver
+  "DEPRECATED"
+  [{::keys [indexes dependency-track] :as env}]
   (go-catch
     (let [k (-> env :ast :key)
           e (p/entity env)]
@@ -1149,10 +1170,12 @@
     (assert mutate (str "Can't find mutate fn for " sym))
     (mutate env entity)))

-(defn mutate [{::keys [indexes mutate-dispatch mutation-join-globals]
-               :keys  [query]
-               :or    {mutation-join-globals []}
-               :as    env} sym' input]
+(defn mutate
+  "Sync mutate function to integrate connect mutations to pathom parser."
+  [{::keys [indexes mutate-dispatch mutation-join-globals]
+    :keys  [query]
+    :or    {mutation-join-globals []}
+    :as    env} sym' input]
   (if-let [{::keys [sym]} (get-in indexes [::mutations sym'])]
     (let [env (assoc-in env [:ast :key] sym)]
       {:action #(let [res (mutate-dispatch (assoc env ::source-mutation sym') input)]
@@ -1162,10 +1185,12 @@
                     res))})
     (throw (ex-info "Mutation not found" {:mutation sym'}))))

-(defn mutate-async [{::keys [indexes mutate-dispatch mutation-join-globals]
-                     :keys  [query]
-                     :or    {mutation-join-globals []}
-                     :as    env} sym' input]
+(defn mutate-async
+  "Async mutate function to integrate connect mutations to pathom parser."
+  [{::keys [indexes mutate-dispatch mutation-join-globals]
+    :keys  [query]
+    :or    {mutation-join-globals []}
+    :as    env} sym' input]
   (if-let [{::keys [sym]} (get-in indexes [::mutations sym'])]
     (let [env (assoc-in env [:ast :key] sym)]
       {:action #(go-catch


Hotfix. def -> defn

Hotfix. def -> defn

--- src/word_keeper/auth.clj
+++ src/word_keeper/auth.clj
@@ -16,5 +16,5 @@

 (def twitter-auth-uri (oauth/user-approval-uri consumer (:oauth_token request-token)))

-(def authorize [verifier]
+(defn authorize [verifier]
   (oauth/access-token consumer request-token verifier))


adjust opus2b for publication

adjust opus2b for publication


Moving the example along

Moving the example along

--- src/trammel/core.clj
+++ src/trammel/core.clj
@@ -23,7 +23,7 @@
   `(HOC. (vec '~argspec) nil))

 (comment
-  (_ even? number? => number?)
+  (_ even? number? => number?)
 )

 ;; # base functions and macros
@@ -86,6 +86,7 @@
    (->> (build-pre-post-map cnstr)
         (manip-map (partial funcify '[%]) [:post])
         (manip-map (partial funcify args) [:pre]))])
+

 (defn- build-contract
   "Expects a seq representing an arity-based expectation of the form:
@@ -126,6 +127,10 @@
           (catch AssertionError post#
             (throw (AssertionError. (str "Post-condition failure in " ~n "! " (.getMessage post#))))))))))

+(comment
+  (build-contract 'hof (build-constraints-map '[n] (:argspec (_ even? number? => number?))))
+)
+
 (defmacro contract
   "The base contract form returning a higher-order function that can then be partially
    applied to an existing function to 'apply' a contract.  Take for example a simple


added dependency on SlipStreamDbBinding-jar

--- ssclj/jar/build.boot
+++ ssclj/jar/build.boot
@@ -26,9 +26,9 @@

                    [aleph]
                    [cheshire] ;; newer version needed for ring-json
-                   [compojure]
-                   [clj-stacktrace]
-                   [clj-time]
+                   [compojure]
+                   [clj-stacktrace]
+                   [clj-time]
                    [environ]
                    [instaparse]
                    [log4j]
@@ -42,8 +42,8 @@
                    [org.clojure/tools.cli]
                    [org.clojure/tools.logging]
                    [org.clojure/tools.namespace]
-                   [org.elasticsearch/elasticsearch]
-                   [org.slf4j/slf4j-log4j12]
+                   [org.elasticsearch/elasticsearch]
+                   [org.slf4j/slf4j-log4j12]
                    [potemkin]
                    [prismatic/schema]
                    [ring/ring-core]
@@ -51,6 +51,7 @@
                    [superstring]

                    [com.sixsq.slipstream/auth]
+                   [com.sixsq.slipstream/SlipStreamDbBinding-jar]

                    ;; needed for migration scripts
                    [korma]


~(defn vocab-entry-to-lexeme): simplify

~(defn vocab-entry-to-lexeme): simplify

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -476,13 +476,13 @@
 (defn vocab-entry-to-lexeme [vocab-entry]
   ;; TODO: destructure input argument.
   {(:target vocab-entry)
-   [(merge-with merge
-                {:synsem {:sem {:pred (keyword (:source vocab-entry))}
-                          :cat :noun
-                          :agr {:gender (cond (= "o" (:ends_with vocab-entry))
-                                              :masc
-                                              (= "a" (:ends_with vocab-entry))
-                                              :fem
-                                              true
-                                              :top)}}})]})
-
+   [{:synsem {:sem {:pred (keyword (:source vocab-entry))}
+              :cat :noun
+              :agr {:gender (cond (= "o" (:ends_with vocab-entry))
+                                  :masc
+                                  (= "a" (:ends_with vocab-entry))
+                                  :fem
+                                  true
+                                  :top)}}}]})
+
+


Implement import of group structure

Implement import of group structure

--- adressverzeichnis/clj-migrate/migrate.clj
+++ adressverzeichnis/clj-migrate/migrate.clj
@@ -6,7 +6,8 @@
    [clojure.pprint :as pprint]
    [clojure.string :as str]
    [clojure.set :as set]
-   [clojure.java.io :as io])
+   [clojure.java.io :as io]
+   [flatland.ordered.map :refer [ordered-map]])
   (:import java.util.Date))

 (deps/add-deps
@@ -20,12 +21,16 @@

 (def path-to-csv (first *command-line-args*))

+(defn remove-empty-or-nil-fields [m]
+  (into {} (remove (comp str/blank? second)) m))
+
 (defn csv-data->maps [csv-data]
-  (map zipmap
+  (map remove-empty-or-nil-fields
+    (map zipmap
        (->> (first csv-data) ;; First row is the header
             (map keyword) ;; Drop if you want string keys instead
             repeat)
-       (rest csv-data)))
+       (rest csv-data))))

 (def old
   (csv-data->maps
@@ -139,14 +144,13 @@
       (update :todestag parse-date)
       (update :nrw #(Boolean/parseBoolean %))
       (update :nicht_abdrucken #(Boolean/parseBoolean %))
-      (update :stand #(get stand-map % ""))))
+      (update :stand #(get stand-map % nil))))

 (defmulti format-value type)
 (defmethod format-value String [value]
   (str "'" value "'"))
 (defmethod format-value Boolean [value] value)
 (defmethod format-value nil [_] "NULL")
-#_(defmethod format-value :default [value] (str "ERROR: " value))

 (defn adress-sql [address old-id]
   (let [fields (keys address)
@@ -208,10 +212,11 @@
       ""])))

 (defn ordensgruppe-typ [ordensgruppe]
-  (cond
-    (str/includes? ordensgruppe "Konvent") "Konvent"
-    (str/includes? ordensgruppe "Aufbaukollegium") "Aufbaukollegium"
-    (str/includes? ordensgruppe "Kollegium") "Kollegium"))
+  (and ordensgruppe
+    (cond
+      (str/includes? ordensgruppe "Konvent") "Konvent"
+      (str/includes? ordensgruppe "Aufbaukollegium") "Aufbaukollegium"
+      (str/includes? ordensgruppe "Kollegium") "Kollegium")))

 (defn ordensgruppe-types-sql [ordensgruppe-types]
   (->
@@ -243,25 +248,89 @@
    (values (for [gemeinschaft älterengemeinschaften
                  :when (not (str/blank? gemeinschaft))]
              {:name gemeinschaft}))))
-
+
+
+(defn unmittelbar?
+  ([{:keys [Übergeordnetegruppe Gruppe]}]
+   (= Übergeordnetegruppe Gruppe))
+  ([gruppierung gruppierungen]
+   (or (unmittelbar? gruppierung)
+      (not (contains? (set (map :Gruppe gruppierungen))
+                      (:Übergeordnetegruppe gruppierung))))))
+
+(def gruppen-indexer (map #(vector (:Gruppe %) %)))
+
+(defn topo-sort [gruppierungen]
+  (let [unmittelbare-gruppen (filter #(unmittelbar? % gruppierungen) gruppierungen)]
+    (loop [index (into (ordered-map) gruppen-indexer unmittelbare-gruppen)
+           undecided (remove (set unmittelbare-gruppen) gruppierungen)]
+      (if (empty? undecided)
+        (vals index)
+        (let [parents-in-index (filter #(contains? index (:Übergeordnetegruppe %)) undecided)]
+          (recur (into index gruppen-indexer parents-in-index)
+                 (remove (set parents-in-index) undecided)))))))
+
+(def gruppen-typen
+  #{"Gilde" "Horte" "Trupp"
+    "Aufbauhag" "Aufbaustamm"
+    "Hag" "Stamm"
+    "Mädelschaft" "Jungenschaft"
+    "Ring"
+    "Gau"})
+
+(defn gruppen-typ [gruppierung]
+  (when-let [gruppe (:Gruppe gruppierung)]
+    (let [[typ _] (str/split gruppe #"\s")]
+      (gruppen-typen typ))))
+
+(defn gruppierungs-typ-sql []
+  (-> (insert-into :public.adressverzeichnis_gruppierungstyp)
+      (values (for [typ gruppen-typen]
+                {:name typ}))))
+
+(defn gruppe-sql [gruppe]
+  {:name (:Gruppe gruppe)
+   :obergruppe_id
+   (when-not (unmittelbar? gruppe)
+     (-> (select :id)
+         (from :public.adressverzeichnis_gruppierung)
+         (where [:= :name (:Übergeordnetegruppe gruppe)])))
+   :typ_id
+   (when-let [typ (gruppen-typ gruppe)]
+     (-> (select :id)
+         (from :public.adressverzeichnis_gruppierungstyp)
+         (where [:= :name typ])))})
+
+(defn gruppierungen-sql [gruppierungen]
+  (let [unmittelbare (filter unmittelbar? gruppierungen)]
+    (cons (-> (insert-into :public.adressverzeichnis_gruppierung)
+              (values (map gruppe-sql unmittelbare)))
+          (for [gruppe (remove unmittelbar? gruppierungen)]
+            (->
+             (insert-into :public.adressverzeichnis_gruppierung)
+             (values [(gruppe-sql gruppe)]))))))

 (defn format-sql [sql-map]
   (-> sql-map
    (update :values (fn [values] (map #(assoc % :veraendert "now", :erstellt "now") values)))
    on-conflict do-nothing ; do-update-set
-   (sql/format {:inline true, :checking :strict})
+   (sql/format {:inline true, :checking :strict, :pretty true})
    (first)
    (str ";")))

 (print
-  (let [persons (map parse-person old)]
+  (let [persons (map parse-person old)
+        gruppierungen (disj (into #{} (map #(select-keys % #{:Übergeordnetegruppe :Gruppe})) persons) {})]
       (str "BEGIN;\n"
         (str/join "\n"
           (concat
             (map format-sql
-              (let [ordensgruppen (into #{} (map #(select-keys % #{:Ordensgruppe :Älterengemeinschaft})) persons)]
-                [(älterengemeinschaften-sql (set (map :Älterengemeinschaft ordensgruppen)))
-                 (ordensgruppe-types-sql (disj (set (map ordensgruppe-typ (map :Ordensgruppe ordensgruppen))) nil))
-                 (ordensgruppen-sql ordensgruppen)]))
-            (map person-sql persons)))
+              (concat
+                [(gruppierungs-typ-sql)]
+                (gruppierungen-sql (topo-sort gruppierungen))
+                (let [ordensgruppen (into #{} (map #(select-keys % #{:Ordensgruppe :Älterengemeinschaft})) persons)]
+                  [(älterengemeinschaften-sql (set (map :Älterengemeinschaft ordensgruppen)))
+                   (ordensgruppe-types-sql (disj (set (map ordensgruppe-typ (map :Ordensgruppe ordensgruppen))) nil))
+                   (ordensgruppen-sql ordensgruppen)])))
+            #_(map person-sql persons)))
         "\nCOMMIT;")))


remove duplicate word in Doppelganger message

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -158,7 +158,7 @@
                :prompt "Use Doppelgänger to run again?" :player :runner
                :yes-ability {:prompt "Choose a server"
                              :choices (req servers)
-                             :msg (msg "to make a run on " target)
+                             :msg (msg "make a run on " target)
                              :effect (effect (update! (dissoc card :dopp-active)) (run target))}}}}}

    "Dorm Computer"


fix :choices filter in Hemorrhage

fix :choices filter in Hemorrhage

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -207,7 +207,7 @@
                  :effect (req (resolve-ability
                                 state :corp
                                 {:prompt "Choose a card to trash"
-                                 :choices (req (filter #(:hand corp)))
+                                 :choices (req (filter #(= (:side %) "Corp") (:hand corp)))
                                  :effect (effect (trash target))}
                                card nil))}]}


add pending endorsement routes

add pending endorsement routes

--- src/clj/salava/badge/routes.clj
+++ src/clj/salava/badge/routes.clj
@@ -299,13 +299,21 @@
                    (ok (b/toggle-show-evidence! ctx user_badge_id evidenceid show_evidence (:id current-user))))

              (POST "/endorsement/:user-badge-id" []
-                   :return {:status (s/enum "success" "error")}
+                   :return {:id s/Int :status (s/enum "success" "error")}
                    :path-params [user-badge-id :- Long]
                    :body-params [content :- s/Str]
                    :summary "Endorse user badge"
                    :auth-rules access/authenticated
                    :current-user current-user
                    (ok (e/endorse! ctx user-badge-id (:id current-user) content)))
+
+             (GET "/user/endorsement/:user-badge-id" []
+                  :return schemas/UserEndorsement
+                  :path-params [user-badge-id :- Long]
+                  :summary "Get user badge endorsements"
+                  :auth-rules access/authenticated
+                  :current-user current-user
+                  (ok (e/user-badge-endorsements ctx user-badge-id)))

              (DELETE "/endorsement/:user-badge-id/:endorsement-id" []
                      :return {:status (s/enum "success" "error")}
@@ -325,4 +333,12 @@
                    :auth-rules access/authenticated
                    :current-user current-user
                    (ok (e/update-status! ctx (:id current-user) user-badge-id endorsement-id status))
-                   ))))
+                   )
+
+             (GET "/user/pending_endorsement" []
+                  :auth-rules access/authenticated
+                  :summary "Get pending badge endorsments"
+                  :current-user current-user
+                  (ok (e/received-pending-endorsements ctx (:id current-user)))
+                  )
+             )))


add dummy teams

add dummy teams

--- src/cljs/bracketology/core.cljs
+++ src/cljs/bracketology/core.cljs
@@ -12,14 +12,21 @@
                                       ["aaa"
                                        "bbb"
                                        "ccc"
-                                       "ddd"]]}))
+                                       "ddd"]
+                                      ["xxx"
+                                       "yyy"
+                                       "zzz"
+                                       "qqq"]
+                                      ["xxx"
+                                       "yyy"
+                                       "zzz"
+                                       "qqq"]]}))

 (defn bracket
   [teams]
-  (println teams)
-  [:ul
+  [:ul.col-sm-6
    (for [team teams]
      [:li.team team])])

@@ -29,8 +36,7 @@
   [:div.container
    [:h1 "Bracket"]
    (for [b (:brackets @app)]
-     [bracket b])
-   ])
+     [bracket b])])

 (defn main []


allow to add sub aggregation for parsets

--- src/cljs/searchbot/parsets.cljs
+++ src/cljs/searchbot/parsets.cljs
@@ -8,42 +8,42 @@
             [searchbot.input.labels :as labels]))

 (defn- build-parsets-agg
-  [terms]
+  [terms sub-aggs]
   (reduce (fn [agg-query a-term]
             {:aggs {(keyword a-term) (merge {:terms {:field a-term}} agg-query)}})
-          {} terms))
+          {:aggs sub-aggs} terms))

-(defn- walk-buckets [de-buck bucket prefix steps]
-  (map #(de-buck % de-buck prefix (first steps) (rest steps))
+(defn- walk-buckets [de-buck bucket prefix steps value-path]
+  (map #(de-buck % de-buck prefix (first steps) (rest steps) value-path)
            (get-in bucket [(first steps) :buckets])))

-(defn- <-buckets [bucket de-buck prefix current-step steps]
+(defn- <-buckets [bucket de-buck prefix current-step steps value-path]
   (if (= 0 (count steps))
-    (merge prefix {current-step (:key bucket) :value (:doc_count bucket)})
+    (merge prefix {current-step (:key bucket) :value (get-in bucket value-path)})
     (let [prefix (merge prefix {current-step (:key bucket)})]
-      (walk-buckets <-buckets bucket prefix steps))))
+      (walk-buckets <-buckets bucket prefix steps value-path))))

-(defn- agg->parsets [agg-result all-steps]
-  (vec (flatten (walk-buckets <-buckets agg-result {} all-steps))))
+(defn- agg->parsets [agg-result all-steps value-path]
+  (vec (flatten (walk-buckets <-buckets agg-result {} all-steps value-path))))

 (defn- new-svg [graph-id w h]
   (-> js/d3 (.select graph-id) (.append "svg") (.attr "width" w) (.attr "height" h)))

 (defn- ->query
-  [{:keys [agg-terms default-filter]}]
-  (let [agg-query (build-parsets-agg (reverse agg-terms))
+  [{:keys [agg-terms sub-aggs default-filter]}]
+  (let [agg-query (build-parsets-agg (reverse agg-terms) sub-aggs)
         agg-query (filtered-agg {:body agg-query
                                  :filter default-filter})]
     agg-query))

 (defn- do-parsets-agg
   [owner]
-  (let [{:keys [continue? comm url get-agg-terms make-agg-query]} (om/get-state owner)
+  (let [{:keys [continue? comm url get-agg-terms make-agg-query value-path]} (om/get-state owner)
         {es-settings :es-settings} (om/get-shared owner)]
     (when continue?
       (go (.log js/console "# running parsets aggregation:" (pr-str (get-agg-terms)))
           (let [{agg-result :aggregations} (<! (es-agg (or url (:url-agg (es-settings))) (make-agg-query)))]
-            (>! comm (agg->parsets agg-result (get-agg-terms))))))))
+            (>! comm (agg->parsets agg-result (get-agg-terms) value-path)))))))

 (defn- update-agg-terms-with-label
   [owner label-string]
@@ -64,7 +64,7 @@
       (.dimensions (clj->js (map name (get-parsets-agg))))
       (.value (fn [d i] (. d -value)))))

-(defcomponent parsets [cursor owner {:keys [agg url height] :or {height 600} :as opts}]
+(defcomponent parsets [cursor owner {:keys [agg value-path url height] :or {height 600 value-path ["doc_count"]} :as opts}]
   (init-state [_]
               {:continue? true
                :comm (chan)
@@ -72,7 +72,9 @@
                :parsets-agg (map keyword (:terms agg))
                :get-agg-terms #(:parsets-agg (om/get-state owner))
                :make-agg-query #(->query {:agg-terms ((:get-agg-terms (om/get-state owner)))
+                                          :sub-aggs (:sub agg)
                                           :default-filter (get-in (:es-settings (om/get-shared owner)) [:default :filter])})
+               :value-path (apply vector (map keyword value-path))
                :svg nil})
   (will-mount [_]
               (do-parsets-agg owner))


Format xAxis labels nicer, demonstrate use of this.

--- src/cljs/weather_demo/core.cljs
+++ src/cljs/weather_demo/core.cljs
@@ -75,6 +75,20 @@
 (defn dt->date [dt]
   (js/Date. (* dt 1000)))

+;; function timeFormatter() {
+;;   var input = this;
+;;   return input['value'].toLocaleTimeString(navigator.language, {
+;;     hour: '2-digit',
+;;     minute: '2-digit'
+;;   });
+;; }
+(defn time-formatter []
+  (this-as input
+    (.toLocaleTimeString
+      (aget input "value")
+      js/navigator.language
+      (clj->js {:hour "2-digit" :minute "2-digit"}))))
+
 (defn forecast-config [forecast]
   (let [city-name (-> forecast :city :name)
         entries (take 10 (-> forecast :list))
@@ -83,10 +97,12 @@
         snow (map (comp :3h :snow) entries)
         prcp (map (fnil + 0 0) rain snow)
         temp (map (comp :temp :main) entries)]
-    {:chart {:type "column"}
+    {:chart {:type "column"
+             :marginLeft 20}
      :title {:text (str "Weather forecast for " city-name)}
      :xAxis {:type "datetime"
-             :categories time}
+             :categories time
+             :labels {:formatter time-formatter}}
      :yAxis [
        {:labels {:format "{value}°C"
                  :style {:color "blue"}}


Refactored hmac module.

Refactored hmac module.

--- src/clojure/buddy/core/hmac.clj
+++ src/clojure/buddy/core/hmac.clj
@@ -18,72 +18,129 @@
             [buddy.core.util :refer [concat-byte-arrays]]
             [buddy.core.hash :refer [make-sha512]]
             [clojure.java.io :as io])
-  (:import (javax.crypto Mac)
-           (javax.crypto.spec SecretKeySpec)
-           (java.security MessageDigest)))
+  (:import javax.crypto.Mac
+           javax.crypto.spec.SecretKeySpec
+           java.security.MessageDigest
+           java.util.Arrays))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Low level private function with all logic for make
+;; hmac for distinct types.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- make-hmac-for-plain-data
+  [^bytes data, pkey, ^String algorithm]
+  (let [bkey (->byte-array pkey)
+        sks  (SecretKeySpec. bkey algorithm)
+        mac  (Mac/getInstance algorithm)]
+    (.init mac sks)
+    (.doFinal mac data)))
+
+(defn- verify-hmac-for-plain-data
+  [^bytes data, ^bytes signature, pkey, ^String algorithm]
+  (let [sig (make-hmac-for-plain-data data pkey algorithm)]
+    (Arrays/equals sig signature)))
+
+(defn- make-hmac-for-stream
+  [^java.io.InputStream stream, pkey, ^String algorithm]
+  (let [bkey (->byte-array pkey)
+        sks  (SecretKeySpec. bkey algorithm)
+        bfr  (byte-array 5120)
+        mac  (Mac/getInstance algorithm)]
+    (.init mac sks)
+    (loop []
+      (let [readed (.read stream bfr 0 5120)]
+        (when-not (= readed -1)
+          (.update mac bfr 0 readed)
+          (recur))))
+    (.doFinal mac)))
+
+(defn- verify-hmac-for-stream
+  [^java.io.InputStream stream, ^bytes signature, pkey, ^String algorithm]
+  (let [sig (make-hmac-for-stream stream pkey algorithm)]
+    (Arrays/equals sig signature)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Low level public interface. Works with bytes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defprotocol HMac
-  "Defined unified protocol for calculate a
-keyed-hash message for a concrete type. It comes
-with default implementations for bytes, String,
+  "Unified protocol for calculate a keyed-hash message.
+It comes with default implementations for bytes, String,
 InputStream, File, URL and URI."
-  (make-hmac [data key algorithm] "Low level interface for make HMAC"))
+  (make-hmac [data key algorithm] "Calculate hmac for data using key and algorithm.")
+  (verify-hmac [data signature key algorithm] "Verify hmac for data using key and algorithm."))

 (extend-protocol HMac
   (Class/forName "[B")
-  (make-hmac [data key algorithm]
-    (let [bkey (->byte-array key)
-          sks  (SecretKeySpec. bkey algorithm)
-          mac  (Mac/getInstance algorithm)]
-      (.init mac sks)
-      (.doFinal mac data)))
+  (make-hmac [^bytes data ^String key ^String algorithm]
+    (make-hmac-for-plain-data data key algorithm))
+  (verify-hmac [^bytes data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-plain-data data signature key algorithm))

-  String
-  (make-hmac [data key algorithm]
-    (make-hmac (->byte-array data) key algorithm))
+  java.lang.String
+  (make-hmac [^String data ^String key ^String algorithm]
+    (make-hmac-for-plain-data (->byte-array data) key algorithm))
+  (verify-hmac [^String data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-plain-data (->byte-array data) signature key algorithm))

   java.io.InputStream
-  (make-hmac [data key algorithm]
-    (let [bkey (->byte-array key)
-          sks  (SecretKeySpec. bkey algorithm)
-          bfr  (byte-array 5120)
-          mac  (Mac/getInstance algorithm)]
-      (.init mac sks)
-      (loop []
-        (let [readed (.read data bfr 0 5120)]
-          (when-not (= readed -1)
-            (.update mac bfr 0 readed)
-            (recur))))
-      (.doFinal mac)))
+  (make-hmac [^java.io.InputStream data ^String key ^String algorithm]
+    (make-hmac-for-stream data key algorithm))
+  (verify-hmac [^java.io.InputStream data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-stream data signature key algorithm))

   java.io.File
-  (make-hmac [data key algorithm]
-    (make-hmac (io/input-stream data) key algorithm))
+  (make-hmac [^java.io.File data ^String key ^String algorithm]
+    (make-hmac-for-stream (io/input-stream data) key algorithm))
+  (verify-hmac [^java.io.File data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-stream data signature key algorithm))

   java.net.URL
-  (make-hmac [data key algorithm]
-    (make-hmac (io/input-stream data) key algorithm))
+  (make-hmac [^java.net.URL data ^String key ^String algorithm]
+    (make-hmac-for-stream (io/input-stream data) key algorithm))
+  (verify-hmac [^java.net.URL data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-stream data signature key algorithm))

   java.net.URI
-  (make-hmac [data key algorithm]
-    (make-hmac (io/input-stream data) key algorithm)))
+  (make-hmac [^java.net.URI data ^String key ^String algorithm]
+    (make-hmac-for-stream (io/input-stream data) key algorithm))
+  (verify-hmac [^java.net.URI data ^bytes signature ^String key ^String algorithm]
+    (verify-hmac-for-stream data signature key algorithm)))

 (defn make-salted-hmac
   "Generic function that implement salted variant
 of keyed-hash message authentication code (hmac).
 This is a low level function and always return bytes."
-  [data key salt algorithm]
+  [data ^String key salt ^String algorithm]
   (let [key (concat-byte-arrays (->byte-array key)
                                 (->byte-array salt))]
     (make-hmac data (make-sha512 key) algorithm)))
+
+(defn verify-salted-hmac
+  [data ^bytes signature ^String key salt ^String algorithm]
+  (let [key (concat-byte-arrays (->byte-array key)
+                                (->byte-array salt))]
+    (verify-hmac data signature (make-sha512 key) algorithm)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; High level interface. Works with strings.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn hmac
   "Generic function that exposes a high level
 interface for keyed-hash message authentication
 code algorithm."
-  [data, key, ^String algorithm]
+  [data ^String key ^String algorithm]
   (-> (make-hmac data key algorithm)
       (bytes->hex)))
+
+(defn hmac-verify
+  "Generic function that exposes a high level
+interface for keyed-hash message authentication
+code verification algorithm."
+  [data ^String signature ^String key ^String algorithm]
+  (verify-hmac data (hex->bytes signature) key algorithm))

 (defn salted-hmac
   "Generic function that exposes a high level
@@ -93,12 +150,29 @@
   (-> (make-salted-hmac data key salt algorithm)
       (bytes->hex)))

-;; Alias for hmac + sha-2 hash algorithms
+(defn salted-hmac-verify
+  "Generic function that exposes a high level
+interface for salted variant of keyed-hash message
+authentication code verification algorithm."
+  [data ^String signature ^String key ^String salt ^String algorithm]
+  (verify-salted-hmac data signature (hex->bytes signature) key algorithm))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Most used aliases
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Alias for hmac + sha2 hash algorithms
 (def hmac-sha256 #(hmac %1 %2 "HmacSHA256"))
 (def hmac-sha384 #(hmac %1 %2 "HmacSHA384"))
 (def hmac-sha512 #(hmac %1 %2 "HmacSHA512"))
+(def hmac-sha256-verify #(hmac-verify %1 %2 %3 "HmacSHA256"))
+(def hmac-sha384-verify #(hmac-verify %1 %2 %3 "HmacSHA384"))
+(def hmac-sha512-verify #(hmac-verify %1 %2 %3 "HmacSHA512"))

-;; Alias for salted hmac + sha-2 hash algorithms
+;; Alias for salted hmac + sha2 hash algorithms
 (def salted-hmac-sha256 #(salted-hmac %1 %2 %3 "HmacSHA256"))
 (def salted-hmac-sha384 #(salted-hmac %1 %2 %3 "HmacSHA384"))
 (def salted-hmac-sha512 #(salted-hmac %1 %2 %3 "HmacSHA512"))
+(def salted-hmac-sha256-verify #(salted-hmac-verify %1 %2 %3 %4 "HmacSHA256"))
+(def salted-hmac-sha384-verify #(salted-hmac-verify %1 %2 %3 %4 "HmacSHA384"))
+(def salted-hmac-sha512-verify #(salted-hmac-verify %1 %2 %3 %4 "HmacSHA512"))


add functions used by data frames, and checks

--- src/clojure/flambo/function.clj
+++ src/clojure/flambo/function.clj
@@ -42,13 +42,23 @@
        (def ~(mk-sym "%s-init" clazz) -init)
        (defn ~(mk-sym "%s-call" clazz)
          [~(vary-meta 'this assoc :tag new-class-sym) & ~'xs]
+         (if-not ~'this
+           (throw (ex-info "Nil this func instance" {})))
+         (if-not ~'xs
+           (throw (ex-info "Nil xs args" {})))
          (let [fn-or-serfn# (.state ~'this)
+               _# (if-not fn-or-serfn#
+                    (throw (ex-info "Nil fn-or-serfn state")))
                f# (if (instance? array-of-bytes-type fn-or-serfn#)
                     (binding [sfn/*deserialize* kryo/deserialize]
                       (deserialize-fn fn-or-serfn#))
                     fn-or-serfn#)]
+           (if-not f#
+             (throw (ex-info "Nil func or serialize func")))
            (apply f# ~'xs)))
        (defn ~wrapper-name [f#]
+         (if-not f#
+           (throw (ex-info "Nil func or serialize func wrapper")))
          (new ~new-class-sym
               (if (serfn? f#)
                 (binding [sfn/*serialize* kryo/serialize]
@@ -65,3 +75,6 @@
 (gen-function PairFunction pair-function)
 (gen-function DoubleFunction double-function)
 (gen-function DoubleFlatMapFunction double-flat-map-function)
+(gen-function MapFunction map-function)
+(gen-function ReduceFunction reduce-function)
+(gen-function FilterFunction filter-function)


[#12318] Bottom sheet doesn't close when opening gallery and camera to set profile picture on iOS

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/profile/user/edit_picture.cljs
+++ src/status_im/ui/screens/profile/user/edit_picture.cljs
@@ -13,11 +13,13 @@
                 :height               crop-size})

 (defn pick-pic []
+  (re-frame/dispatch [:bottom-sheet/hide])
   (react/show-image-picker
    #(re-frame/dispatch [::multiaccounts/save-profile-picture (.-path ^js %) 0 0 crop-size crop-size])
    crop-opts))

 (defn take-pic []
+  (re-frame/dispatch [:bottom-sheet/hide])
   (react/show-image-picker-camera
    #(re-frame/dispatch [::multiaccounts/save-profile-picture (.-path ^js %) 0 0 crop-size crop-size])
    crop-opts))


Log message when failed to generate attribute

--- src/com/wsscode/pathom/gen.cljc
+++ src/com/wsscode/pathom/gen.cljc
@@ -24,7 +24,9 @@
         (p/join env))
       (try
         (gen/generate (s/gen k))
-        (catch #?(:clj Throwable :cljs :default) _ nil)))))
+        (catch #?(:clj Throwable :cljs :default) _
+          (print (str "Failed to generate attribute " k "\n"))
+          nil)))))

 (s/def spec-gen-reader ::p/reader-fn)


Refactor.

Refactor.

--- src/datascript/core.cljs
+++ src/datascript/core.cljs
@@ -5,7 +5,7 @@
 (defprotocol ISearch
   (-search [data pattern callback])
   (add-record [data e a v])
-  (slice-it [data index search callback]))
+  (from-index [data index search callback]))

 (defrecord DB [eav aev ave]
   Object
@@ -15,13 +15,13 @@
   ISearch
   (-search [db [e a v] callback]
     (case-tree [e a (some? v)] [
-      (slice-it db "eav" [e a v] callback)           ;; e a v
-      (slice-it db "eav" [e a nil] callback)         ;; e a _
-      (slice-it db "eav" [e nil nil] (fn [data]
+      (from-index db "eav" [e a v] callback)         ;; e a v
+      (from-index db "eav" [e a nil] callback)       ;; e a _
+      (from-index db "eav" [e nil nil] (fn [data]
         (callback (filter #(= v (.-v %)) data))))    ;; e _ v
-      (slice-it db "eav" [e nil nil] callback)       ;; e _ _
-      (slice-it db "ave" [a v nil] callback)         ;; _ a v
-      (slice-it db "ave" [a nil nil] callback)       ;; _ a _
+      (from-index db "eav" [e nil nil] callback)     ;; e _ _
+      (from-index db "ave" [a v nil] callback)       ;; _ a v
+      (from-index db "ave" [a nil nil] callback)     ;; _ a _
       (callback (filter #(= v (.-v %)) eav))         ;; _ _ v
       (callback "eav")]))                            ;; _ _ _
   (add-record [_ e a v]
@@ -29,7 +29,7 @@
       (assoc eav (mapv str [e a v]) (to-array [e a v]))
       (assoc aev (mapv str [a e v]) (to-array [e a v]))
       (assoc ave (mapv str [a v e]) (to-array [e a v]))))
-  (slice-it [db index search callback]
+  (from-index [db index search callback]
     (callback (let [search-start search
                     search-stop  (mapv #(if (nil? %) "\uffff" %) search)
                     index        ((keyword index) db)]


improved distillery.tasks/trace-block with better time output

--- src/distillery/tasks.clj
+++ src/distillery/tasks.clj
@@ -31,8 +31,10 @@
   [msg & body]
   `(do
      (trace-message (str "BEGIN " ~msg "..."))
-     (let [result# (time (do ~@body))]
-       (trace-message (str "END   " ~msg))
+     (let [start# (System/nanoTime)
+           result# (do ~@body)
+           end# (/ (- (System/nanoTime) start#) 1000000.0)]
+       (trace-message (str "END   " ~msg " after " end# " msecs"))
        result#)))


(PDB-5059) Add a helper for command processing options

Extract this to a helper, like `shared-globals` because initial sync
will need to select the same options map that command processing uses in
order for initial sync to provide the correct settings to
`process-command!`.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -481,10 +481,11 @@
                "replace catalog inputs" exec-replace-catalog-inputs)]
     (exec cmd start db conn-status)))

+;; Used in testing and by initial sync
 (defn process-command!
-  ;; only used by testing...
   "Takes a command object and processes it to completion. Dispatch is
-   based on the command's name and version information"
+   based on the command's name and version information. Should be given
+   the options-config returned by select-command-processing-config"
   [command db options-config]
   (when-not (:delete? command)
     (let [start (now)]
@@ -864,6 +865,14 @@
            :response-chan-for-pub response-chan-for-pub
            :response-pub response-pub)))

+(defn select-command-processing-config
+  [config]
+  (-> config
+      :database
+      (select-keys [:facts-blocklist
+                    :facts-blocklist-type
+                    :resource-events-ttl])))
+
 (defn start-command-service
   [context config {:keys [dlo] :as globals} request-shutdown]
   (if (or (not globals) ;; Check that puppetdb service actually started (TK-487)
@@ -890,11 +899,7 @@
                                              scf-write-dbs
                                              response-chan
                                              (:stats context)
-                                             (-> config
-                                                 :database
-                                                 (select-keys [:facts-blocklist
-                                                               :facts-blocklist-type
-                                                               :resource-events-ttl]))
+                                             (select-command-processing-config config)
                                              maybe-send-cmd-event!
                                              shutdown-for-ex)]
       (when broadcast-pool