Clean up paredit-widget a bit

Clean up paredit-widget a bit

--- src/clojure/paredit_widget/core.clj
+++ src/clojure/paredit_widget/core.clj
@@ -28,61 +28,59 @@
                                       (.getSelectionStart widget))})))

 (defn insert-result [w pe]
-  (dorun (map #(if (= 0 (:length %))
+  (dorun
+    (map #(if (= 0 (:length %))
             (.insert w (:text %) (:offset %))
             (.replaceRange w (:text %) (:offset %) (+ (:length %) (:offset %))))
-          (:modifs pe)))
+         (:modifs pe)))
   (.setCaretPosition w (:offset pe))
-  (if (< 0 (:length pe))
-    (do
-      (.setSelectionStart w (:offset pe))
-      (.setSelectionEnd w (+ (:offset pe) (:length pe))))))
+  (when (< 0 (:length pe))
+    (.setSelectionStart w (:offset pe))
+    (.setSelectionEnd w (+ (:offset pe) (:length pe)))))

 (def os-x-charmap
   {"‚" ")" ;;close and round newline
-  "Æ" "\"" ;; meta double quote
-  "…" ";"  ;; paredit-commit-dwim
-  "∂" "d"  ;;paredit-forward-kill-word
-  "·" "(" ;; paredit-wrap-round
-  "ß" "s" ;;paredit splice
-  "®" "r" ;; raise expr
-  "Í" "S" ;; split
-  "Ô" "J" ;;join
-  })
+   "Æ" "\"" ;; meta double quote
+   "…" ";"  ;; paredit-commit-dwim
+   "∂" "d"  ;;paredit-forward-kill-word
+   "·" "(" ;; paredit-wrap-round
+   "ß" "s" ;;paredit splice
+   "®" "r" ;; raise expr
+   "Í" "S" ;; split
+   "Ô" "J" ;;join
+   })

 (def keymap
-  {
-  [nil "(" ] :paredit-open-round
-  [nil ")" ] :paredit-close-round
-  [nil "[" ] :paredit-open-square
-  [nil "]" ] :paredit-close-square
-  [nil "{" ] :paredit-open-curly
-  [nil "}" ] :paredit-close-curly
-  [nil "\b"] :paredit-backward-delete
-  [nil  "\t"] :paredit-indent-line
-  ["M" ")"] :paredit-close-round-and-newline
-  [nil "\""] :paredit-doublequote
-  [nil "DEL"] :paredit-forward-delete
-  ; ["C" "K"] :paredit-kill not implemented in paredit.clj
-  ["M" "("] :paredit-wrap-round
-  ["M" "s"] :paredit-splice-sexp
-  ["M" "r"] :paredit-raise-sexp
-  ["C" "0"] :paredit-forward-slurp-sexp
-  ["C" "9"] :paredit-backward-slurp-sexp
-  ["C" "Close Bracket"] :paredit-forward-barf-sexp
-  ["C" "Open Bracket"] :paredit-backward-barf-sexp
-  [nil "\n"] :paredit-newline
-  ["M" "S"] :paredit-split-sexp
-  ["M" "J"] :paredit-join-sexps
-  ["M" "Right"] :paredit-expand-right
-  ["M" "Left"] :paredit-expand-left
-   })
+  {[nil "("] :paredit-open-round
+   [nil ")"] :paredit-close-round
+   [nil "["] :paredit-open-square
+   [nil "]"] :paredit-close-square
+   [nil "{"] :paredit-open-curly
+   [nil "}"] :paredit-close-curly
+   [nil "\b"] :paredit-backward-delete
+   [nil "\t"] :paredit-indent-line
+   ["M" ")"] :paredit-close-round-and-newline
+   [nil "\""] :paredit-doublequote
+   [nil "DEL"] :paredit-forward-delete
+   ; ["C" "K"] :paredit-kill not implemented in paredit.clj
+   ["M" "("] :paredit-wrap-round
+   ["M" "s"] :paredit-splice-sexp
+   ["M" "r"] :paredit-raise-sexp
+   ["C" "0"] :paredit-forward-slurp-sexp
+   ["C" "9"] :paredit-backward-slurp-sexp
+   ["C" "Close Bracket"] :paredit-forward-barf-sexp
+   ["C" "Open Bracket"] :paredit-backward-barf-sexp
+   [nil "\n"] :paredit-newline
+   ["M" "S"] :paredit-split-sexp
+   ["M" "J"] :paredit-join-sexps
+   ["M" "Right"] :paredit-expand-right
+   ["M" "Left"] :paredit-expand-left})

 (defn exec-paredit [k w buffer]
   (when-let [cmd (keymap k)]
-    (if *debug* (println [cmd k]))
+    (when *debug* (println [cmd k]))
     (let [result (exec-command cmd w buffer)]
-      (if *debug* (println [cmd result]))
+      (when *debug* (println [cmd result]))
       (insert-result w result))
     cmd))

@@ -93,24 +91,24 @@
   (let [key-code (.getKeyCode event)
         key-char (.getKeyChar event)
         key-text (java.awt.event.KeyEvent/getKeyText key-code)]
-    (if *debug* (println  [event key-code key-char key-text]))
+    (when *debug* (println  [event key-code key-char key-text]))
     [(cond
       (.isAltDown event) "M"
       (.isControlDown event) "C"
-      true nil)
-     (if (.isControlDown event)
+      :else nil)
+     (cond
+       (or (.isControlDown event)
+           (get #{"Left" "Right"} key-text))
        key-text
-       (if (#{"Left" "Right"} key-text)
-         key-text
-         (str key-char)))]))
+       :else (str key-char))]))

 (defn key-event-handler [w buffer]
   (reify java.awt.event.KeyListener
     (keyReleased [this e] nil)
     (keyTyped [this e]
-      (if (#{"(" ")" "[" "]" "{" "}" "\""}
-           (str (.getKeyChar e) ))
-           (.consume e)))
+      (when (get #{"(" ")" "[" "]" "{" "}" "\""}
+                 (str (.getKeyChar e)))
+        (.consume e)))
     (keyPressed [this e]
       (let [k (convert-key-event e)
             p (exec-paredit k w buffer)]
@@ -121,7 +119,7 @@
     (inputMethodTextChanged [this e]
       (let [k (convert-input-method-event e)
             p (exec-paredit k w buffer)]
-        (if p (.consume e))))))
+        (when p (.consume e))))))

 (defn get-toggle-fn [w]
   (let [buffer (atom (paredit.parser/edit-buffer nil 0 -1 (s/value w)))


Mostly finished prettifying

Mostly finished prettifying

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -77,7 +77,7 @@
          (take show-info-size (map #(str \" % \") string-seq)) ))

 (defn make-clue
-  "Returns a clue string given the target word and a vec of guessed letters. The
+  "Returns a clue string given the target word and a set of guessed letters. The
   clue is a string the length of the target word consisting of either letters
   (for correctly guessed letters) or hyphens (for incorrect guesses)."
   [tgt-word guessed-chars]
@@ -99,7 +99,7 @@
         patt-str   (str/join
                      (for [clue-ch clue-str]
                        (if (= clue-ch \-) not-guessed-class clue-ch) ))
-    ] patt-str ))
+  ] patt-str ))

 (defn filter-words
   "Filter words retaining only those that are possible matches given the current
@@ -107,8 +107,8 @@
   [clue guessed-chars words]
   (let [patt-str      (clue-to-regex clue guessed-chars)
         re-patt       (re-pattern patt-str)  ; cache the pattern object for all words
-        keep-words    (filter #(re-find re-patt %) words ) ]
-    keep-words ))
+        keep-words    (filter #(re-find re-patt %) words )
+  ] keep-words ))

 (defn make-guess
   "Choose the most common letter. Same idea as building a Huffman code."
@@ -128,16 +128,13 @@
                     (frequencies (str/join words)) )
     avail-chars   (set/difference all-letters guessed-chars)
     best-char     (apply max-key #(get char-freqs % -1) avail-chars)
-  ]
-    best-char
-  ))
+  ] best-char ))

 (defn do-tests []
   ; Test regex stuff
   (assert (= (complement-char-class #{})         "."      ))
   (assert (= (complement-char-class #{\a \b})    "[^ab]"  ))
   (let [words           ["abcd" "xbcd" "xxcd" "xxxd"]
-        letters         [\a \b \c \d]
         guessed-chars   #{\b \s}
         clue-str        "-b--"
         not-char-class  (complement-char-class    guessed-chars)
@@ -161,12 +158,11 @@

 (defonce test-results (do-tests) )

-(defn play-hangman
+(defn play-hangman-internal
   "Plays the hangman game for the supplied word.  Returns the number of letter
   guesses required to find a unique match in the master words list."
   [tgt-word]
-  (let [word-list (words-by-length (count tgt-word)) ; words of correct length
-    ]
+  (let [ word-list (words-by-length (count tgt-word)) ]
     (loop [ guessed-chars   #{}
             clue            (make-clue tgt-word guessed-chars) ]
       (log-extra)
@@ -193,15 +189,13 @@
   []
   (time
     (doseq [ tgt-word (sort (keys baseline-scores)) ]
-      (let [base-score          (baseline-scores tgt-word)
-            num-letter-guesses  (play-hangman tgt-word) ]
+      (let [ num-letter-guesses  (play-hangman-internal tgt-word) ]
         (log-msg (str   "word:  " (format "%-15s"  tgt-word)
                    "  guesses:  " (format   "%2s"  num-letter-guesses)
-                  "  baseline:  " (format   "%2s"  base-score) )))))
-)
+                  "  baseline:  " (format   "%2s"  (baseline-scores tgt-word)) ))))))

 (defn statusString
-  "Return the game status as a string."
+  "Return the HangmanGame status as a string."
   [hangmanGame]
   (cond
     (HangmanUtils/isGameWon      hangmanGame ) "game-won     "
@@ -209,12 +203,14 @@
     (HangmanUtils/isKeepGuessing hangmanGame ) "keep-guessing" ))

 (defn get-game-guessed-chars
-  "Get a Clojure set of chars that have been guessed so far in the game."
+  "Returns a Clojure set of chars that have been guessed so far in the
+  HangmanGame."
   [hangmanGame]
   ; NOTE:  str/lower-case expects and returns a string. Hence we must use (apply
   ; str ...) on the java HashSet returned by hangmanGame.getAllGuessedLetters()
   ; in order to generate a single (possibly zero-length) string before calling
-  ; str/lower-case.  Since set expects a collection, it is used without "apply".
+  ; str/lower-case.  Since set expects a collection, it is used instead of
+  ; (apply hash-set ...).
   (let [guessed-chars  (->> (.getAllGuessedLetters hangmanGame)
                             (apply str )
                             (str/lower-case )
@@ -227,7 +223,7 @@
   (str/lower-case (.getGuessedSoFar hangmanGame)) )

 (defn new-strategy
-  "Return a GuessingStrategy object instance."
+  "Returns a GuessingStrategy object instance."
   []
   (reify
     GuessingStrategy
@@ -250,9 +246,8 @@
     (let [ guess (.nextGuess strategy hangmanGame) ]
       (log-extra "Clue:"    (format "%-20s" (getGameClue hangmanGame))
                "  Status:"  (statusString hangmanGame) "  Guess:" guess )
-      (.makeGuess guess hangmanGame)
-    )
-  )
+      (.makeGuess guess hangmanGame) ))
+
   (let [score (.currentScore hangmanGame)]
     (log-extra "Clue:"    (format "%-20s" (getGameClue hangmanGame))
              "  Status:"  (statusString hangmanGame) "  Score:" score )
@@ -273,20 +268,17 @@
           (doseq [word words]
             (let [strategy      (new-strategy)
                   hangmanGame   (HangmanGame. word max-wrong-guesses)
-                  score         (play-hangman-java hangmanGame strategy)
-            ]
+                  score         (play-hangman-java hangmanGame strategy) ]
               (log-msg "Word:"      (format "%-20s" word)
                        "Status:"    (format "%-20s" (getGameClue hangmanGame))
-                                      (statusString hangmanGame)
-                       "Score:"     (format "%3d" score) )
+                       (statusString hangmanGame) "Score:"     (format "%3d" score) )
               (swap! cumScore + score)
             ))
           (log-msg)
           (log-msg "Average score:  "
             (format "%6.2f" (/ (double @cumScore) (count words) )) )
           (log-msg)
-        ))))
-)
+        )))))

 (defn -main [& args]
   (apply main args) )


Reuse the existing `timestamp` function for DLO files

--- src/com/puppetlabs/cmdb/command.clj
+++ src/com/puppetlabs/cmdb/command.clj
@@ -306,9 +306,7 @@
         contents (string/join "\n\n" [msg metadata])
         checksum (pl-utils/utf8-string->sha1 contents)
         subdir   (string/replace command " " "-")
-        basename (format "%s-%s"
-                         (unparse (formatters :basic-date-time) (now))
-                         checksum)
+        basename (format "%s-%s" (pl-utils/timestamp) checksum)
         filename (file dir subdir basename)]
     (make-parents filename)
     (spit filename contents)))


idk how to use externs

idk how to use externs

--- src/critter_simulator/behavior.cljs
+++ src/critter_simulator/behavior.cljs
@@ -64,7 +64,7 @@
             (critter/set-destination c -10 collision-area)
           :else c)))

-(def clamp (-> js/goog .-math .-clamp))
+(defn clamp [val' min' max'] (min max' (max min' val')))

 (defn boundaries [c {:keys [width height]}]
   (critter/set-destination


tweak error message

tweak error message

--- src/gamma_driver/impl/variable.cljs
+++ src/gamma_driver/impl/variable.cljs
@@ -23,10 +23,10 @@
              (str "Invalid input variable: "
                   attribute
                   " for program"
-                  (if-let [id (pr-str (:id program))]
-                    (str " " id ".")
+                  (if-let [id (:id program)]
+                    (str " " (pr-str id) ".")
                     ".")
-                  ". Valid inputs: " (:inputs program)))))
+                  " Valid inputs: " (:inputs program)))))
   (let [location (attribute-location gl program attribute)
         {:keys [size type normalized? stride offset]}
         ((or (:layout input) default-layout) attribute)]
@@ -55,10 +55,10 @@
              (str "Invalid input variable: "
                   uniform
                   " for program"
-                  (if-let [id (pr-str (:id program))]
-                    (str " " id ".")
+                  (if-let [id (:id program)]
+                    (str " " (pr-str id) ".")
                     ".")
-                  ". Valid inputs: " (:inputs program)))))
+                  " Valid inputs: " (:inputs program)))))
   (let [location (uniform-location gl program uniform)
         type (:type uniform)
         data (:data input)]
@@ -89,10 +89,10 @@
              (str "Invalid input variable: "
                   uniform
                   " for program"
-                  (if-let [id (pr-str (:id program))]
-                    (str " " id ".")
+                  (if-let [id (:id program)]
+                    (str " " (pr-str id) ".")
                     ".")
-                  ". Valid inputs: " (:inputs program)))))
+                  " Valid inputs: " (:inputs program)))))
   (let [location (uniform-location gl program uniform)
         id       (:texture-id texture)
         target   (:target texture)]


fix bad code gen picked up by Closure type checking

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -349,7 +349,7 @@
         (emits "new cljs.core.PersistentArrayMap(null, " (count keys) ", ["
           (comma-sep (interleave keys vals))
           "], null)")
-        (emits "new cljs.core.PersistentArrayMap.fromArray(["
+        (emits "cljs.core.PersistentArrayMap.fromArray(["
           (comma-sep (interleave keys vals))
           "], true, false)"))


Shortening string code

Shortening string code

--- src/main/clojure/unjumbler/core.clj
+++ src/main/clojure/unjumbler/core.clj
@@ -1,11 +1,12 @@
 (ns unjumbler.core
-  (:require [clojure.math.combinatorics :as combo]))
+  (:require [clojure.math.combinatorics :as combo]
+            [clojure.string :as str]))

 (defn findwords
   [& words]
   (map (fn [word]
          (filter #(unjumbler.WordChecker/check %)
                  (map #(apply str %)
-                      (combo/permutations (seq (clojure.string/lower-case word))))))
+                      (combo/permutations (seq (str/lower-case word))))))
        words)
   )


etcd: work on empty nodes

etcd: work on empty nodes

--- src/merlion/etcd.clj
+++ src/merlion/etcd.clj
@@ -22,8 +22,10 @@
     (get node "value")))

 (defn map-from-etcd-response [prefix response-body]
-  (value-from-etcd-node prefix
-                        (get (json/decode response-body) "node")))
+  (let [j (json/decode response-body)]
+    (if-let [node (get j "node")]
+      (value-from-etcd-node prefix node)
+      (with-meta {} {:error j}))))

 (deftest map-from-etcd-response-test
   (let [body (slurp "test/fixtures/etcd-response.json")
@@ -33,8 +35,10 @@
     (is (= (-> m :auth :google :client-id)
            "608620955125-9plvti1kpi8vjacjo3ssmei9m43r1qo9.apps.googleusercontent.com"))))

-(def get-http (comp slurp :body deref http/get))
-(def put-http (comp slurp :body deref http/put))
+(def get-http
+  (comp slurp :body deref #(http/get % {:throw-exceptions false})))
+(def put-http
+  (comp slurp :body deref #(http/get % {:throw-exceptions false})))
 (def etcd-endpoint "http://localhost:2379/v2/keys")

 (defn get-prefix [prefix]


Remove dependency on goog.dom

Remove dependency on goog.dom

By using js/document.getElementById instead of goog.dom/getElement


another bit of cleanup

another bit of cleanup

--- src/main/untangled/ui/elements.cljc
+++ src/main/untangled/ui/elements.cljc
@@ -506,18 +506,15 @@
     (dom/progress (clj->js attrs))))

 (defn ui-radio
-  "Render a radio (not the label). Props is a normal clj(s) map with React/HTML attributes plus:
+  "Render a HTML radio (without the label). Props is a normal clj(s) map with React/HTML attributes plus:

   `:className` - additional class stylings to apply to the top level of the checkbox
-  `:id` - Name of the checkbox
-  "
-  [{:keys [id style] :or {id ""} :as attrs}]
-  (let [user-classes (get attrs :className "")
-        classes      (cond-> (str user-classes " c-radio "))
-        attrs        (cond-> attrs
-                       :always (assoc :type "radio")
-                       :always (assoc :className classes)
-                       :always (assoc :id (name id)))]
+  "
+  [{:keys [className id] :as props}]
+  (let [classes (str className " c-radio ")
+        attrs   (assoc props :type "radio"
+                             :className classes
+                             :id id)]
     (dom/span nil
       (dom/input (clj->js attrs))
       (dom/label #js {:htmlFor id} \u00A0))))


Use absolute URL for learning about circleci.com

--- src-cljs/frontend/components/errors.cljs
+++ src-cljs/frontend/components/errors.cljs
@@ -39,7 +39,7 @@
              [:h3 "You may have been logged out. "]
              [:p.error-message
               "Learn more about "
-              [:a {:href "/"} "CircleCI"]
+              [:a {:href "https://circleci.com/"} "CircleCI"]
               " , "
               [:a {:href "https://circleci.com/mobile/osx/"} "CircleCI for OS X"]
               ", or "


Remove opt-in / opt-out banners

Remove opt-in / opt-out banners

--- src-cljs/frontend/components/opt_in.cljs
+++ src-cljs/frontend/components/opt_in.cljs
@@ -6,33 +6,6 @@
             [frontend.async :refer [raise!]]
             [frontend.components.forms :refer [managed-button]])
   (:require-macros [frontend.utils :refer [html]]))
-
-(defn ui-v2-opt-in-banner [{} owner]
-  (reify
-    om/IDisplayName (display-name [_] "UI V2 Opt In")
-    om/IRender
-    (render [_]
-      (html
-       [:div.ui-v2-opt-in {}
-        [:div.ui-v2-opt-in-wrapper
-         [:div
-          [:span "CircleCI is getting a new look. "]]
-         [:div.opt-in-right
-          [:button {:on-click #(raise! owner [:try-ui-v2-clicked])} "Try our new look"]]]]))))
-
-(defn ui-v2-opt-out-ui [{} owner]
-  (reify
-    om/IDisplayName (display-name [_] "UI V2 Opt In")
-    om/IRender
-    (render [_]
-      (html
-       [:div.ui-v2-opt-out {}
-        (managed-button [:button {:on-click #(raise! owner [:disable-ui-v2-clicked])} "Back to old look"])
-        [:a {:href "mailto:beta@circleci.com?subject=New Look"
-             :target "_blank"
-             :on-click #(raise! owner [:ui-v2-beta-feedback])}
-         "Beta Feedback"]
-        ]))))

 (defn ios-reminder-banner []
   (reify


[#1113] Using template1 as template for new tenant databases

--- backend/src/akvo/lumen/admin/add_tenant.clj
+++ backend/src/akvo/lumen/admin/add_tenant.clj
@@ -118,7 +118,7 @@
     (util/exec! db-uri
                 (str "CREATE DATABASE %1$s "
                      "WITH OWNER = %1$s "
-                     "TEMPLATE = template0 "
+                     "TEMPLATE = template1 "
                      "ENCODING = 'UTF8' "
                      "LC_COLLATE = 'en_US.UTF-8' "
                      "LC_CTYPE = 'en_US.UTF-8';")


dat_contribution: transforming payload data for easier manipulation

--- functions/src/wort/core.clj
+++ functions/src/wort/core.clj
@@ -2,6 +2,13 @@
   (:gen-class
    :methods [^:static [handler [String] String]]))

+(require '[clojure.string :as str])
+
 (defn -handler
   [s]
   (str "Wort " s " ツ"))
+
+(defn get_key_as_list
+  [payload key]
+  (str/split (get payload key) #"\s|[\.\,\!\?]")
+)


Update schema.clj

Update schema.clj


Correct paths for polling intervals

Correct paths for polling intervals

--- src/polismath/components/config.clj
+++ src/polismath/components/config.clj
@@ -75,9 +75,9 @@
                                 :doc "The hostname for sending messages to graphite"}
    :export-expiry-days         {:path [:export :expiry-days] :parse ->long
                                 :doc "The number of days before a mongo record representing a data exports gets removed"}
-   :vote-polling-interval      {:parse ->long :path [:storm :spouts :votes :polling-interval]
+   :vote-polling-interval      {:parse ->long :path [:poller :votes :polling-interval]
                                 :doc "The polling interval for votes, in milliseconds"}
-   :mod-polling-interval       {:parse ->long :path [:storm :spouts :moderation :polling-interval]
+   :mod-polling-interval       {:parse ->long :path [:poller :moderation :polling-interval]
                                 :doc "The polling interval for moderation, in milliseconds"}
    :initial-polling-timestamp  {:parse ->long :path [:poller :initial-polling-timestamp]
                                 :doc "The initial vote and mod polling timestamp (only load convs with votes later than this)"}


(PDB-3096) log elapsed time with command processing

Change command processing logging to include elapsed ms. This will be
useful to support for correlating slow processing to specific nodes.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -71,7 +71,7 @@
             [schema.core :as s]
             [puppetlabs.puppetdb.config :as conf]
             [puppetlabs.puppetdb.time :refer [to-timestamp]]
-            [clj-time.core :as time :refer [now]]
+            [clj-time.core :as time :refer [now interval in-millis]]
             [clj-time.format :as fmt-time]
             [clojure.set :as set]
             [clojure.core.async :as async]
@@ -266,42 +266,45 @@
 ;; Catalog replacement

 (defn replace-catalog*
-  [{:keys [certname version id received payload]} db]
+  [{:keys [certname version id received payload]} start-time db]
   (let [{producer-timestamp :producer_timestamp :as catalog} payload]
     (jdbc/with-transacted-connection' db :repeatable-read
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/replace-catalog! catalog received))
-    (log/info (trs "[{0}-{1}] ''{2}'' command processed for {3}"
+    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
                    (str id)
                    (str (tcoerce/to-long received))
+                   (in-millis (interval start-time (now)))
                    (command-names :replace-catalog)
                    certname))))

-(defn replace-catalog [{:keys [payload received version] :as command} db]
+(defn replace-catalog [{:keys [payload received version] :as command} start-time db]
   (let [validated-payload (upon-error-throw-fatality
                            (cat/parse-catalog payload version received))]
     (-> command
         (assoc :payload validated-payload)
-        (replace-catalog* db))))
+        (replace-catalog* start-time db))))

 ;; Fact replacement

 (defn replace-facts*
-  [{:keys [payload id received] :as command} db]
+  [{:keys [payload id received] :as command} start-time db]
   (let [{:keys [certname values] :as fact-data} payload
         producer-timestamp (:producer_timestamp fact-data)]
     (jdbc/with-transacted-connection' db :repeatable-read
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/replace-facts! fact-data))
-    (log/info (trs "[{0}-{1}] ''{2}'' command processed for {3}"
+    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
                    (str id)
                    (str (tcoerce/to-long received))
+                   (in-millis (interval start-time (now)))
                    (command-names :replace-facts)
                    certname))))

-(defn replace-facts [{:keys [payload version received] :as command} db]
+(defn replace-facts [{:keys [payload version received] :as command} start-time db]
   (replace-facts* (upon-error-throw-fatality
-                   (assoc command :payload (fact/normalize-facts version received payload)))
+                    (assoc command :payload (fact/normalize-facts version received payload)))
+                  start-time
                   db))

 ;; Node deactivation
@@ -316,44 +319,46 @@
       deactivate-node-wire-v2->wire-3))

 (defn deactivate-node*
-  [{:keys [id received payload]} db]
+  [{:keys [id received payload]} start-time db]
   (let [certname (:certname payload)
         producer-timestamp (to-timestamp (:producer_timestamp payload (now)))]
     (jdbc/with-transacted-connection db
       (when-not (scf-storage/certname-exists? certname)
         (scf-storage/add-certname! certname))
       (scf-storage/deactivate-node! certname producer-timestamp))
-    (log/info (trs "[{0}-{1}] ''{2}'' command processed for {3}"
+    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
                    (str id)
                    (str (tcoerce/to-long received))
+                   (in-millis (interval start-time (now)))
                    (command-names :deactivate-node)
                    certname))))

-(defn deactivate-node [{:keys [payload version] :as command} db]
+(defn deactivate-node [{:keys [payload version] :as command} start-time db]
   (-> command
       (assoc :payload (case version
                         1 (deactivate-node-wire-v1->wire-3 payload)
                         2 (deactivate-node-wire-v2->wire-3 payload)
                         payload))
-      (deactivate-node* db)))
+      (deactivate-node* start-time db)))

 ;; Report submission

 (defn store-report*
-  [{:keys [payload id received]} db]
+  [{:keys [payload id received]} start-time db]
   (let [{:keys [certname puppet_version] :as report} payload
         producer-timestamp (to-timestamp (:producer_timestamp payload (now)))]
     (jdbc/with-transacted-connection db
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/add-report! report received))
-    (log/info (trs "[{0}-{1}] ''{2}'' puppet v{3} command processed for {4}"
+    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' puppet v{4} command processed for {5}"
                    (str id)
                    (str (tcoerce/to-long received))
+                   (in-millis (interval start-time (now)))
                    (command-names :store-report)
                    puppet_version
                    certname))))

-(defn store-report [{:keys [payload version received] :as command} db]
+(defn store-report [{:keys [payload version received] :as command} start-time db]
   (let [validated-payload (upon-error-throw-fatality
                            (s/validate report/report-wireformat-schema
                                        (case version
@@ -365,7 +370,7 @@
                                          payload)))]
     (-> command
         (assoc :payload validated-payload)
-        (store-report* db))))
+        (store-report* start-time db))))

 ;; ## Command processors

@@ -382,14 +387,15 @@

 (defn process-command!
   "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"
   [{command-name :command version :version delete? :delete? :as command} db]
   (when-not delete?
-    (condp supported-command-version? [command-name version]
-      "replace catalog" (replace-catalog command db)
-      "replace facts" (replace-facts command db)
-      "store report" (store-report command db)
-      "deactivate node" (deactivate-node command db))))
+    (let [start (now)]
+      (condp supported-command-version? [command-name version]
+        "replace catalog" (replace-catalog command start db)
+        "replace facts" (replace-facts command start db)
+        "store report" (store-report command start db)
+        "deactivate node" (deactivate-node command start db)))))

 (defn warn-deprecated
   "Logs a deprecation warning message for the given `command` and `version`"


fix printing type symbol as event name

fix printing type symbol as event name

--- src/status_im/ui/screens/events.cljs
+++ src/status_im/ui/screens/events.cljs
@@ -297,7 +297,7 @@
   (fn [_ _]
     {::get-fcm-token-fx nil}))

-(defn handle-jail-signal [{:keys[chat_id data]}]
+(defn handle-jail-signal [{:keys [chat_id data]}]
   (let [{:keys [event data]} (types/json->clj data)]
     (case event
       "local-storage" (dispatch [:set-local-storage {:chat-id chat_id
@@ -310,7 +310,7 @@
                          ;; TODO(janherich): figure out and fix chat_id from event
                          (dispatch [:command-handler! (:chat-id orig-params) orig-params
                                     {:result {:returned (dissoc data :origParams)}}]))
-      (log/debug "Unknown jail signal " type))))
+      (log/debug "Unknown jail signal " event))))

 (register-handler-fx
   :signal-event


Allow change of activity if no judge is set

--- src/tango/cljs/adjudicator/core.cljs
+++ src/tango/cljs/adjudicator/core.cljs
@@ -465,7 +465,7 @@
                            ;(log act)
                            ;(log adjs)
                            (log should-judge?)
-                           (when should-judge?
+                           (when (or should-judge? (= nil current-adj))
                              (om/transact! reconciler
                                            `[(app/select-activity
                                                {:activity ~(:app/selected-activity edn-result)})


First half-done attempt at fixed asplan hierarhcy.

--- src/angelic/search/action_set/asplan.clj
+++ src/angelic/search/action_set/asplan.clj
@@ -122,8 +122,8 @@
                    (for [v precond-vars] [(action-var v) nil])))
      0)))

+
 ;; TODO: should fail if I own parent, it has right value, but an action. (right now, we assert)...
-
 ;; Try to make an action that greedily fires the action scheduled on effect-var,
 ;; effectively representing a composition of set-parent and fire-action actions.
 ;; Note that this avoids some (unnecessary) branching on children of parent vars.
@@ -463,4 +463,278 @@
 ; (let [e (force (nth ipc2-logistics 3)) ] #_ (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e)))))))

-; (doseq [[alg sp]  [[make-asplan-env asplan-solution-pair-name] [angelic.search.action-set.asplan-broken/make-asplan-env angelic.search.action-set.asplan-broken/asplan-solution-pair-name]] ] (println (time (run-counted #(sp (uniform-cost-search (alg (make-random-infinite-taxi-sas2 3 3 3 3))))))))+ ; (doseq [[alg sp]  [[make-asplan-env asplan-solution-pair-name] [angelic.search.action-set.asplan-broken/make-asplan-env angelic.search.action-set.asplan-broken/asplan-solution-pair-name]] ] (println (time (run-counted #(sp (uniform-cost-search (alg (make-random-infinite-taxi-sas2 3 3 3 3))))))))
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;; First attempt: "Skip" hierarchy ;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; OK, now we need a hierarchy.    Problems:
+ ; some of the primitives as-implemented don't play well with state abstraction.
+ ; want all derived knowledge to be represented explicitly ?
+
+; Now an abstract subproblem should be, either:
+ ; (1) achieve a particular precondition of some active action, or
+ ; (2) achieve some precondition of some active action.
+ ; (3) achieve some active action
+
+
+(declare precond-deadlocked?)
+(defn action-deadlocked? [s var]
+  (when-let [a (state/get-var s (action-var var))]
+    (when-not (= a :frozen)
+      (some #(precond-deadlocked? s % var) (remove #{var} (keys (:precond-map a)))))))
+
+(defn precond-deadlocked? [s precond e-var]
+  (or (and (not (state/get-var s (free-var precond)))
+           (not (state/get-var s (parent-var precond e-var))))
+      (action-deadlocked? s precond)))
+
+(defn precond-deadlocked-ooc? [s precond e-var child-var-map context]
+  (or (and (not (state/get-var s (free-var precond)))
+           (not (state/get-var s (parent-var precond e-var)))
+           (not (contains? context (current-child s child-var-map precond))))
+      (when-let [a (state/get-var s (action-var precond))]
+        (when-not (= a :frozen)
+          (some #(precond-deadlocked-ooc? s % precond child-var-map context)
+                (remove #{precond} (keys (:precond-map a))))))))
+
+
+;; TODO: can we use the restricted child map like this, or must we do something smarter?
+(defn deadlocked-h?
+  "Take the graph from var-ordering-edges, and return the sources in the same component
+   as the goal variable, which are ripe for action.  Returns nil if there are any cycles
+   in the graph, since this indicates a deadlock (at least some actions cannot fire)."
+  [s child-map edge-rule]
+  (let [edges (var-ordering-edges s child-map edge-rule)]
+    (not (graphs/dag? edges))))
+
+
+(declare make-fire-action-hla)
+
+(defn make-achieve-precondition-hla [hierarchy var dst-val]
+  (let [name [:achieve-precondition var dst-val]
+        av   (action-var var)
+        pc   (util/safe-get-in hierarchy [:precondition-context-map var])
+;        pc   (:full-context hierarchy)
+        ]
+    (reify
+      env/Action
+       (action-name [a] name)
+       (primitive?  [a] false)
+      env/ContextualAction
+       (precondition-context [a s] pc)
+      hierarchy/HighLevelAction
+       (immediate-refinements- [this s]
+         (cond (= (state/get-var s var) dst-val)
+                 (do ;(print "!S") (flush)
+                   (assert (not (when-let [a (state/get-var s av)] (not (= a :frozen))))) [[]])
+               (state/get-var s av)
+                 (if (action-deadlocked? s var)
+                     (do ;(print "!D")
+                       [[]])
+                   (do ;(print "!A")
+                       [[(make-fire-action-hla hierarchy var (state/get-var s av)) this]]))
+               :else
+                 (let [p-val (state/get-var s var)
+                       dtg   (util/safe-get-in hierarchy [:dtgs var p-val])]
+                   ;(print "!C")
+                   (for [n-val ((:acyclic-succ-fn hierarchy) var p-val dst-val), a (dtg n-val)]
+                     [(make-add-action-action a) this]))))
+       (cycle-level-           [a s] nil))))
+
+
+
+; Like above, but tests actinos rather than asserting..
+(defn make-greedy-fire-action-h [s effect-var]
+  (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
+        (->> effect-var action-var (state/get-var s))
+        precond-vars (keys (dissoc precond-map effect-var))
+        [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)]
+    (when (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars)
+      (let [a (env-util/make-factored-primitive
+             [::Fire name]
+             (into precond-map
+                   (concat [[(action-var effect-var) factored-primitive]]
+                           (for [v free-pv]   [(free-var v)              true])
+                           (for [v unfree-pv] [(parent-var v effect-var) true])
+                           (for [v precond-vars] [(action-var v) (state/get-var s (action-var v))])))
+             (into effect-map
+                   (concat [[(action-var effect-var) nil]]
+                           (for [v unfree-pv] [(free-var v)              true])
+                           (for [v unfree-pv] [(parent-var v effect-var) false])
+                           (for [v precond-vars] [(action-var v) nil])))
+             0)]
+        (when (env/applicable? a s) a)))))
+
+
+(defn make-fire-action-hla  [hierarchy effect-var a]
+  (let [name          [:fire-action effect-var]
+        reduced-pm    (dissoc (:precond-map a) effect-var)
+        ancestor-vars (util/safe-get-in hierarchy [:ancestor-var-map effect-var])
+        child-var-map (:child-var-map hierarchy)
+        context-cvm   (util/map-vals
+                       #(filter ancestor-vars  %)
+                       (select-keys child-var-map ancestor-vars))
+        pc (into #{(action-var effect-var)}
+                 (apply concat
+                        (for [v (distinct (apply concat (for [p (keys reduced-pm)] (util/safe-get-in hierarchy [:ancestor-var-map p]))))]
+                          (concat
+                           [v (free-var v) (action-var v)]
+                           (for [c (child-var-map v) :when (ancestor-vars c)] (parent-var v c))))))]
+;    (println "FA" name pc "\n" (clojure.set/difference (:full-context hierarchy) pc))
+  (reify
+    env/Action
+      (action-name [a] name)
+      (primitive?  [a] false)
+    env/ContextualAction
+      (precondition-context [a s] pc) ;; perhaps can do better?
+    hierarchy/HighLevelAction
+    (immediate-refinements- [this s]
+;                            (println (state/as-map s))
+;        (Thread/sleep 10)
+        (assert (= (state/get-var s (action-var effect-var)) a))
+        (let [na-tuples         (for [nav   ancestor-vars
+                                      :when (not #(state/get-var s (action-var %)))
+                                      :let  [child (current-child s child-var-map nav)]
+                                      :when (and child (ancestor-vars child) (not (state/get-var s (action-var child))))]
+                                  [nav child])]
+         (util/cond-let [x]
+          ;; Greedy -- all preconditions satisfied and not assigned elsewhere
+          (make-greedy-fire-action-h s effect-var)
+          (do (print "g") (flush)
+              [[x]])
+
+          ;; Real deadlock - fail (for SA, must restrict context...)
+          (deadlocked? s context-cvm [])
+            (do (print "d") (flush)
+               nil)
+
+          ;; Deadlocked by something out-of-context -- exit  (note -- need to check for goal means
+            ; we should catch these issues earlier..
+          (some #(precond-deadlocked-ooc? s % effect-var child-var-map ancestor-vars) (keys reduced-pm))
+            (do (print "x") (flush)
+                (when-not (= effect-var sas/goal-var-name) [[]]))
+
+          ;; Active precondition -- assigned, needs its value changed, not deadlock
+          ;; TODO: order
+          (util/find-first #(and (state/get-var s (parent-var % effect-var))
+                                 (not (= (state/get-var s %) (reduced-pm %)))
+                                 (not (precond-deadlocked? s % effect-var)))
+                           (keys reduced-pm))
+            (do (print "a" (if (state/get-var s (action-var x)) "o" "n")) (flush)
+             [[(make-achieve-precondition-hla hierarchy x (reduced-pm x)) this]])
+
+          ;; Inactive precondition -- needs to be assigned.
+          (util/find-first #(and (state/get-var s (free-var %))
+                                 (not (= (state/get-var s %) (reduced-pm %))))
+                           (keys reduced-pm))
+            (do (print "i") (flush)
+             (for [a (activation-actions child-var-map x)]
+               [a this]))
+
+          ;; Active top-down var -- add actions
+          (util/find-first #(not (state/get-var s (free-var %))) (map second na-tuples))
+            (do (println "A!");(print "a") (flush)
+             (for [as (vals (util/safe-get-in (:dtgs hierarchy) [x (state/get-var s x)])), a as]
+               [(make-add-action-action a) this]))
+
+          ;; Inactive top-down var -- activate it
+          (first (map second na-tuples))
+            (do (println "I!"); (flush)
+             (for [a (activation-actions child-var-map x)]
+               [a this]))
+
+          ;; Nothing to do here -- return upwards, or fail if goal-var
+          :else
+            (do (print "f") (flush)
+              (when (and (= effect-var sas/goal-var-name) (not (deadlocked? s child-var-map  nil)))
+                (def *bs* s))
+              (when-not (= effect-var sas/goal-var-name) [[]])))))
+       (cycle-level-           [a s] nil))))
+
+(comment ; old, broken PC
+  (for [p (keys reduced-pm)]
+                             (cons (free-var p)
+                                   (cons (parent-var p effect-var)
+                                         (util/safe-get-in hierarchy [:fire-action-pc-map p])))))
+;(def *bs* nil)
+
+ ; include ancestor vars, action vars, free vars, in-pointing 'rents
+(defn make-asplan-skip-henv [sas-problem]
+  (let [env    (make-asplan-env sas-problem)
+        cg     (:causal-graph env)
+        cvm    (:child-var-map env)
+        av-map (:ancestor-var-map env)
+        pc-map (into {}
+                 (for [[k as] av-map]
+                   [k
+                    (into as
+                     (concat
+                      (for [v as] (free-var v))
+                      (for [v as] (action-var v))
+                      (for [v as, c (cvm v), :when (as c)] (parent-var v c))))]))
+        fa-map (into {}
+                 (for [[k as] av-map]
+                   [k
+                    (into as
+                     (concat
+                      (for [v as] (free-var v))
+                      (for [v as] (action-var v))
+                      (for [v as, c (cvm v)] (parent-var v c))))]))
+        ]
+ ;    (println "\n" av-map "\n\n" pc-map)
+    (hierarchy-util/make-simple-hierarchical-env
+     env
+     [(make-fire-action-hla
+       {:type                     ::ASPlanSkipHierarchy
+        :full-context             (state/current-context (env/initial-state env))
+        :dtgs                     (:dtgs env)
+        :child-var-map            cvm
+        :ancestor-var-map         av-map
+        :acyclic-succ-fn          (:acyclic-succ-fn env)
+        :precondition-context-map pc-map
+        :fire-action-pc-map       fa-map}
+       sas/goal-var-name
+       (state/get-var (env/initial-state env) (action-var sas/goal-var-name)))])))
+
+
+(defn asplan-skip-solution-name [sol]
+  (map second (filter #(= (first %) ::GreedyFire) (map env/action-name sol))))
+
+(defn asplan-skip-solution-pair-name [[sol rew]]
+  [(asplan-skip-solution-name sol) rew])
+
+
+
+;; TODO: faster & early deadlock detection.
+;; TODO: detect "out-of-context" deadlock, fail immediately.
+;; TODO: precond ordering when we activate (handled by activation-actions?)
+
+;; (use 'angelic.search.explicit.hierarchical)
+
+;; TODO: (let [e (make-random-infinite-taxi-sas2 3 2 5 2)] (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e))))))  (println (debug 0 (time (run-counted #(asplan-skip-solution-pair-name (dsh-ucs-inverted (make-asplan-skip-henv e)))))))) gives bad results; replacing inverted iwht regular fixes it ... ?
+
+;; minimal exmaple:
+;; (let [i 25] (let [e (make-random-infinite-taxi-sas2 3 1 2 i)] #_ (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e))))))  (println (debug 0 (time (run-counted #(asplan-skip-solution-pair-name (dsh-ucs-inverted (make-asplan-skip-henv e)))))))))
+
+;  (let [e (make-random-infinite-taxi-sas2 1 2 1 2)] (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e))))))  (println (debug 0 (time (run-counted #(asplan-skip-solution-pair-name (dsh-ucs-inverted (make-asplan-skip-henv e))))))))
+
+; (let [e (make-random-infinite-taxi-sas2 1 2 1 2)] (interactive-hierarchical-search (make-asplan-skip-henv e)))
+
+; (let [e (make-random-infinite-taxi-sas2 2 2 2 2)] (interactive-hierarchical-search (make-asplan-skip-henv e)))
+
+; (let [e (force (nth ipc2-logistics 0))] (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e))))))  (println (debug 0 (time (run-counted #(asplan-skip-solution-pair-name (dsh-ucs-inverted (make-asplan-skip-henv e))))))))
+
+
+
+;(let [e (make-random-infinite-taxi-sas2 5 5 5 1) ] #_ (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e))))))   (println (debug 0 (time (run-counted #(asplan-skip-solution-pair-name (dsh-ucs-inverted (make-asplan-skip-henv e))))))))
+
+
+


Add more error catching and reporting for commands - blunt, still needs spec

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -151,25 +151,47 @@
   #_(infof "ReqMap %s" reqmap)
   (binding [*ns* (find-ns 'aerobio.server)]
     (let [params (reqmap :params)
+          {:keys [user cmd action rep compfile eid]} params
+          eid (if (str/ends-with? eid "/") (austr/butlast 1 eid) eid)
+          eid (if (str/starts-with? eid "/") (austr/drop 1 eid) eid)
           user-agent (get-in reqmap [:headers "user-agent"])
           reqtype (get-in reqmap [:headers "reqtype"])]
       (if (= reqtype "cmdline")
-        (let [{:keys [user cmd action rep compfile eid]} params
-              _ (when (not (cmn/get-exp eid)) (cmn/set-exp eid))
-              exp (cmn/get-exp-info eid :exp)
-              work-item (if action action cmd)
-              tempnm (str (name exp) "-" work-item "-job-template")
-              template (get-jobinfo tempnm)
-              result (actions/action cmd eid params get-toolinfo template)]
-          (swap! dbg (fn[M] (assoc M eid result)))
-          (infof "%s : %s" cmd result)
-          (json/json-str
-           {:args args
-            :params params
-            :template tempnm
-            :recipient user
-            :user-agent user-agent
-            :reqtype reqtype}))
+        (try
+          (let [_ (when (not (cmn/get-exp eid)) (cmn/set-exp eid))
+                exp (cmn/get-exp-info eid :exp)
+                work-item (if action action cmd)
+                tempnm (str (name exp) "-" work-item "-job-template")
+                template (get-jobinfo tempnm)
+                result (actions/action cmd eid params get-toolinfo template)]
+            (aerial.utils.misc/sleep 250)
+            (swap! dbg (fn[M] (assoc M eid result)))
+            (infof "%s : %s" cmd result)
+            (json/json-str
+             {:params params
+              :result (str result)
+              :template tempnm
+              :recipient user}))
+          (catch Error e
+            (let [estg (format "Error %s" (or (.getMessage e) e))]
+              (errorf "%s: %s - Assert: %s" eid cmd estg)
+              (json/json-str
+             {:args args
+              :params params
+              :result estg
+              :recipient user
+              :user-agent user-agent
+              :reqtype reqtype})))
+          (catch Exception e
+            (let [emsg (or (.getMessage e) e)]
+              (errorf "%s: %s, Exception on Job launch: %s" eid cmd emsg)
+              (json/json-str
+               {:args args
+                :params params
+                :result (format "Exception: %s" emsg)
+                :recipient user
+                :user-agent user-agent
+                :reqtype reqtype}))))
         (hiccup/html
          [:h1 "HI from HTSeq command route"]
          [:hr]


Changed max-error in median to 1

Changed max-error in median to 1

--- src/clojush/problems/software/median.clj
+++ src/clojush/problems/software/median.clj
@@ -161,5 +161,5 @@
    :print-behavioral-diversity true
    :report-simplifications 0
    :final-report-simplifications 5000
-   :max-error 1000
+   ;:max-error 1
    })


Reimplemented grain-size functions and removed :nonzero-reproductive-difference-from-parent.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -83,35 +83,26 @@
        :reproductive-similarity-to-parent
        (if (:dummy parent1)
          1
-         (- 1 (#(- (max %1 %2) (min %1 %2))
-                (sequence-similarity (:genome parent1) genome)
-                (sequence-similarity
-                  (:genome parent1)
-                  (produce-child-genome-by-autoconstruction
-                    genome (:genome parent1) (:genome parent2) false argmap)))))
+         (sequence-similarity
+           genome
+           (produce-child-genome-by-autoconstruction
+             genome
+             (:genome parent1)
+             (:genome parent2)
+             false
+             argmap)))
        ;
        :reproductive-difference-from-parent
        (if (:dummy parent1)
          1
-         (#(- (max %1 %2) (min %1 %2))
-           (sequence-similarity (:genome parent1) genome)
-           (sequence-similarity
-             (:genome parent1)
-             (produce-child-genome-by-autoconstruction
-               genome (:genome parent1) (:genome parent2) false argmap))))
-       ;
-       :nonzero-reproductive-difference-from-parent
-       (if (:dummy parent1)
-         1
-         (let [diff (#(- (max %1 %2) (min %1 %2))
-                      (sequence-similarity (:genome parent1) genome)
-                      (sequence-similarity
-                        (:genome parent1)
-                        (produce-child-genome-by-autoconstruction
-                          genome (:genome parent1) (:genome parent2) false argmap)))]
-           (if (zero? diff)
-             1
-             diff)))))))
+         (- 1 (sequence-similarity
+                genome
+                (produce-child-genome-by-autoconstruction
+                  genome
+                  (:genome parent1)
+                  (:genome parent2)
+                  false
+                  argmap))))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; reproduction


Improved generality of balancing for linear genetic operators.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -3,7 +3,9 @@
         [clojush.random]
         [clojush.globals]
         [clojush.individual]
-        [clojush.node-selection]))
+        [clojush.node-selection])
+  (:require [clojure.walk :as walk]
+            [clojure.string :as string]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; genetic operators
@@ -191,3 +193,233 @@
     :ancestors (if maintain-ancestors
                  (cons (:program ind) (:ancestors ind))
                  (:ancestors ind))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; linear operators
+
+(defn remove-empties
+  "Removes empty sequences from tree t."
+  [t]
+  (walk/postwalk
+    (fn [node] (if (seq? node)
+                 (remove #(and (seq? %) (empty? %)) node)
+                 node))
+    t))
+
+(defn list-to-open-close-sequence
+  [lst]
+  (if (seq? lst)
+    (flatten (walk/postwalk #(if (seq? %) (list :open % :close) %) lst))
+    lst))
+
+; (list-to-open-close-sequence '(1 2 (a b (c) ((d)) e)))
+
+(defn open-close-sequence-to-list
+  [sequence]
+  (let [s (str sequence)
+        l (read-string (string/replace (string/replace s ":open" " ( ") ":close" " ) "))]
+    ;; there'll be an extra ( ) around l, which we keep if the number of read things is >1
+    (if (= (count l) 1)
+      (first l)
+      l)))
+
+;(open-close-sequence-to-list '(:open 1 2 :open a b :open c :close :open :open d :close :close e :close :close))
+;(open-close-sequence-to-list '(:open 1 :close :open 2 :close))
+;(open-close-sequence-to-list '(:open :open 1 :close :open 2 :close :close))
+
+(defn insert-somewhere
+  [thing lst]
+  (let [after-how-many (lrand-int (inc (count lst)))]
+    (concat (take after-how-many lst)
+            (list thing)
+            (drop after-how-many lst))))
+
+(defn delete-somewhere
+  [thing lst]
+  (let [locations (->> lst
+                    (map vector (iterate inc 0))
+                    (filter #(= (second %) thing))
+                    (map first))
+        location (lrand-nth locations)]
+    (concat (take location lst)
+            (drop (inc location) lst))))
+
+;(delete-somewhere :right '(0 :right 1 2 :right))
+
+(defn left-balance
+  [s left right]
+  (loop [processed ()
+         to-process s
+         extra-lefts 0]
+    (cond
+      ;; done
+      (empty? to-process)
+      processed
+      ;; see a left -- keep track of number unmatched
+      (= (first to-process) left)
+      (recur (concat processed (list (first to-process)))
+             (rest to-process)
+             (inc extra-lefts))
+      ;; see a right -- may require fixes
+      (= (first to-process) right)
+      (if (zero? extra-lefts)
+        ;; must fix
+        (if (< (lrand) 0.5)
+          ;; half the time delete a right (possibly this one) and continue
+          (recur ()
+                 (concat (delete-somewhere right (concat processed (list right)))
+                         (rest to-process))
+                 0)
+          ;; other half, add a left somewhere
+          (recur () (concat (insert-somewhere left processed) to-process) 0))
+        ;; don't have to fix, keep going with adjusted extras
+        (recur (concat processed (list (first to-process)))
+               (rest to-process)
+               (dec extra-lefts)))
+      ;; anything else -- just keep going
+      :else
+      (recur (concat processed (list (first to-process)))
+             (rest to-process)
+             extra-lefts))))
+
+(defn balance
+  [open-close-sequence]
+  ;(println "balancing:" open-close-sequence)
+  (-> open-close-sequence
+    (left-balance :open :close)
+    (reverse)
+    (left-balance :close :open)
+    (reverse)))
+
+;(let [s '(:open 1 2 :open a b :open c :close :open :open d :close :close e :close :close)]
+;  (println s)
+;  (println (balance s)))
+;
+;(let [s '(:open 1 2 :open :open a b :open c :close :open :open d :close :close e :close :close)]
+;  (println s)
+;  (println (balance s)))
+;
+;(let [s '(:open :open :close)]
+;  (println s)
+;  (println (balance s)))
+;
+;(let [s '(:close :close)]
+;  (println s)
+;  (println (balance s)))
+;
+;(let [s '(:close :open)]
+;  (println s)
+;  (println (balance s)))
+
+;(defn linearly-mutate-program
+;  [p rate atom-generators]
+;  (if (seq? p)
+;    (remove-empties
+;      (open-close-sequence-to-list
+;        (balance
+;          (map #(if (< (lrand) rate)
+;                  (let [element (lrand-nth (concat atom-generators
+;                                                   [:open :close]))]
+;                    (if (fn? element)
+;                      (element)
+;                      element))
+;                  %)
+;               (list-to-open-close-sequence p)))))
+;    p))
+
+; (let [p '(a b (c d) (e f ((g))) h)]
+;   (println p)
+;   (linearly-mutate-program p 0.1 [1 2 3]))
+
+;(defn linearly-mutate
+;  "Returns a linearly mutated version of the given individual."
+;  [ind max-points rate atom-generators]
+;  (let [new-program (linearly-mutate-program (:program ind) rate atom-generators)]
+;    (if (> (count-points new-program) max-points)
+;      ind
+;      (make-individual :program new-program :history (:history ind)
+;                       :ancestors (if maintain-ancestors
+;                                    (cons (:program ind) (:ancestors ind))
+;                                    (:ancestors ind))))))
+
+;(defn break-up
+;  [s num-parts]
+;  (let [break-points (sort (take (dec num-parts)
+;                                 (lshuffle (map inc (range (dec (count s)))))))
+;        offsets (loop [remaining-break-points (map #(- % (first break-points))
+;                                                   (rest break-points))
+;                       result (list (first break-points))]
+;                  (if (empty? remaining-break-points)
+;                    result
+;                    (recur (map #(- % (first remaining-break-points))
+;                                (rest remaining-break-points))
+;                           (concat result (list (first remaining-break-points))))))]
+;    (loop [remaining-offsets (rest offsets)
+;           remaining-sequence (drop (first offsets) s)
+;           result (list (take (first offsets) s))]
+;      (if (empty? remaining-offsets)
+;        (concat result (list remaining-sequence))
+;        (recur (rest remaining-offsets)
+;               (drop (first remaining-offsets) remaining-sequence)
+;               (concat result (list (take (first remaining-offsets) remaining-sequence))))))))
+
+; (break-up '(a b c d e) 3)
+
+;(defn linearly-crossover-programs
+;  [p1 p2 switch-probability]
+;  (if (or (not (seq? p1))
+;          (not (seq? p2)))
+;    p1 ;; can't do if either program isn't a list
+;    (let [p1-linear (list-to-open-close-sequence p1)
+;          p2-linear (list-to-open-close-sequence p2)
+;          num-segments (min (count p1-linear) (count p2-linear))
+;          p1-segments (break-up p1-linear num-segments)
+;          p2-segments (break-up p2-linear num-segments)]
+;      (loop [p1-remaining p1-segments
+;             p2-remaining p2-segments
+;             use-p1 (lrand-nth [true false])
+;             result ()]
+;        (if (empty? p1-remaining)
+;          (remove-empties (open-close-sequence-to-list (balance result)))
+;          (recur (rest p1-remaining)
+;                 (rest p2-remaining)
+;                 (if (< (lrand) switch-probability) (not use-p1) use-p1)
+;                 (concat result (first (if use-p1 p1-remaining p2-remaining)))))))))
+
+;(let [p1 '(a (b c) (d ((e)) f))
+;      p2 '((1 2 3) 4 ((5)) 6)]
+;  (println p1)
+;  (println p2)
+;  (println (linearly-crossover-programs p1 p2 0.1)))
+
+;(defn linearly-crossover
+;  "Returns the result of a linear crossover of parent1 and parent2."
+;  [parent1 parent2 max-points switch-probability]
+;  (let [new-program (linearly-crossover-programs (:program parent1)
+;                                                 (:program parent2)
+;                                                 switch-probability)]
+;    (if (> (count-points new-program) max-points)
+;      parent1
+;      (make-individual :program new-program :history (:history parent1)
+;                       :ancestors (if maintain-ancestors
+;                                    (cons (:program parent1) (:ancestors parent1))
+;                                    (:ancestors parent1))))))
+
+;(defn linearly-cross-mutate
+;  "Returns the result of a linear crossover of parent1 and parent2."
+;  [parent1 parent2 max-points switch-probability rate atom-generators]
+;  (let [new-program (linearly-mutate-program
+;                      (linearly-crossover-programs (:program parent1)
+;                                                   (:program parent2)
+;                                                   switch-probability)
+;                      rate
+;                      atom-generators)]
+;    (if (> (count-points new-program) max-points)
+;      parent1
+;      (make-individual :program new-program :history (:history parent1)
+;                       :ancestors (if maintain-ancestors
+;                                    (cons (:program parent1) (:ancestors parent1))
+;                                    (:ancestors parent1))))))
+
+
+


Reify instead of proxy

Reify instead of proxy

--- src/clj_http/core2.clj
+++ src/clj_http/core2.clj
@@ -52,9 +52,9 @@

 (defn get-redirect-strategy [redirect-strategy]
   (case redirect-strategy
-    :none (proxy [RedirectStrategy] []
-            (getRedirect [request response context] nil)
-            (isRedirected [request response context] false))
+    :none (reify RedirectStrategy
+            (getRedirect [this request response context] nil)
+            (isRedirected [this request response context] false))
     :default (DefaultRedirectStrategy/INSTANCE)
     :lax (LaxRedirectStrategy.)
     nil (DefaultRedirectStrategy/INSTANCE)


Initial rendering of bodies

Initial rendering of bodies

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -3,9 +3,10 @@
 (def MAX_COLLECTION_ELEMENTS 10)
 (def MAX_MAP_ELEMENTS 5)
 (def MAX_SET_ELEMENTS 7)
+(def ABBREVIATION "…")
+(def INDEX_SEPARATOR ":")

-(declare header-template)
-(declare container-member-template)
+(declare inlined-value-template)

 ; dirty
 (defn cljs-value? [value]
@@ -17,7 +18,7 @@
   (not (cljs-value? value)))

 (defn template [tag style & more]
-  (let [arr #js [tag #js {"style" style}]]
+  (let [arr #js [tag (if (empty? style) #js {} #js {"style" style})]]
     (doseq [o more]
       (.push arr o))
     arr))
@@ -31,98 +32,131 @@
 (defn spacer [& _] " ")

 (defn nil-template [_]
-  (template "span" "color: #808080" "nil"))
+  (template "span" "color:#808080" "nil"))

-(defn keyword-template [v]
-  (template "span" "color: #881391" (str ":" (name v))))
+(defn keyword-template [value]
+  (template "span" "color:#881391" (str ":" (name value))))

-(defn symbol-template [v]
-  (template "span" "color: #881391" (str v)))
+(defn symbol-template [value]
+  (template "span" "color:#881391" (str value)))

-(defn number-template [v]
-  (if (integer? v)
-    (template "span" "color: #1C00CF" v)
-    (template "span" "color: #1C88CF" v)))
+(defn number-template [value]
+  (if (integer? value)
+    (template "span" "color:#1C00CF" value)
+    (template "span" "color:#1C88CF" value)))

-(defn fn-template [v]
-  (template "span" "color: #f00" (reference v) "fn"))
+(defn index-template [value]
+  (template "span" "color:#881391" value INDEX_SEPARATOR))

-(defn string-template [v]
-  (template "span" "color: #C41A16" (str "\"" v "\"")))
+; TODO: abbreviate long strings
+(defn string-template [value]
+  (template "span" "color:#C41A16" (str "\"" value "\"")))

-(defn header-collection-template [v]
+(defn fn-template [value]
+  (template "span" "color:#f00" (reference value) "fn"))
+
+; TODO: convert to idiomatic clojure code
+(defn header-collection-template [value]
   (let [arr (template "span" "" "[")]
-    (doseq [x (take MAX_COLLECTION_ELEMENTS v)]
-      (.push arr (container-member-template x) (spacer x)))
+    (doseq [x (take MAX_COLLECTION_ELEMENTS value)]
+      (.push arr (inlined-value-template x) (spacer x)))
     (.pop arr)
-    (if (> (count v) MAX_COLLECTION_ELEMENTS)
-      (.push arr "…"))
+    (if (> (count value) MAX_COLLECTION_ELEMENTS)
+      (.push arr ABBREVIATION))
     (.push arr "]")
     arr))

-(defn header-map-template [m]
+(defn header-map-template [value]
   (let [arr (template "span" "" "{")
-        v (seq m)]
+        v (seq value)]
     (doseq [[k v] (take MAX_MAP_ELEMENTS v)]
       (.push arr
-             (container-member-template k) (spacer k)
-             (container-member-template v) (spacer v)))
+             (inlined-value-template k) (spacer k)
+             (inlined-value-template v) (spacer v)))
     (.pop arr)
     (if (> (count v) MAX_MAP_ELEMENTS)
-      (.push arr "…"))
+      (.push arr ABBREVIATION))
     (.push arr "}")
     arr))

-(defn header-set-template [v]
+(defn header-set-template [value]
   (let [arr (template "span" "" "#{")]
-    (doseq [x (take MAX_SET_ELEMENTS v)]
-      (.push arr (container-member-template x) (spacer x)))
+    (doseq [x (take MAX_SET_ELEMENTS value)]
+      (.push arr (inlined-value-template x) (spacer x)))
     (.pop arr)
-    (if (> (count v) MAX_SET_ELEMENTS)
-      (.push arr "…"))
+    (if (> (count value) MAX_SET_ELEMENTS)
+      (.push arr ABBREVIATION))
     (.push arr "}")
     arr))

-(defn generic-template [v]
-  (template "span" "" ">" (reference v) "<"))
+(defn generic-template [value]
+  (template "span" "" ">" (reference value) "<"))

-(defn atomic-template [x]
+(defn atomic-template [value]
   (cond
-    (nil? x) (nil-template x)
-    (string? x) (string-template x)
-    (number? x) (number-template x)
-    (keyword? x) (keyword-template x)
-    (symbol? x) (symbol-template x)
-    (fn? x) (fn-template x)
+    (nil? value) (nil-template value)
+    (string? value) (string-template value)
+    (number? value) (number-template value)
+    (keyword? value) (keyword-template value)
+    (symbol? value) (symbol-template value)
+    (fn? value) (fn-template value)
     ))

-(defn container-template [x]
+(defn header-container-template [value]
   (cond
-    (map? x) (header-map-template x)
-    (set? x) (header-set-template x)
-    (coll? x) (header-collection-template x)
+    (map? value) (header-map-template value)
+    (set? value) (header-set-template value)
+    (coll? value) (header-collection-template value)
     ))

-(defn container-member-template [x]
-  (or (atomic-template x)
-      (generic-template x)))
+(defn inlined-value-template [value]
+  (or (atomic-template value)
+      (generic-template value)))

-(defn header-template [x]
-  (or (atomic-template x)
-      (container-template x)
-      (pr-str x)))
+(defn header-template [value]
+  (or (atomic-template value)
+      (header-container-template value)
+      (pr-str value)))

 (defn build-header [value]
-  (template "span" "background-color: #efe" (header-template value)))
+  (template "span" "background-color:#efe" (header-template value)))
+
+(defn body-line-template [index value]
+  (template "li" "margin-left:12px" (index-template index) (spacer) (inlined-value-template value)))
+
+(defn body-line-templates [value]
+  (let [arr #js []]
+    (loop [data (seq value) ; TODO: limit max number of lines here?
+           index 0]
+      (if (empty? data)
+        arr
+        (do
+          (.push arr (body-line-template index (first data)))
+          (recur (rest data) (inc index)))))))
+
+(defn build-body [value]
+  (.concat (template "ol" "list-style-type:none; padding-left:0px; margin-top:0px; margin-bottom:0px; margin-left:12px")
+           (body-line-templates value)))
+
+(defn abbreviated-helper [value]
+  (if (coll? value)
+    (some #(abbreviated-helper %) value)
+    (= ABBREVIATION value)))
+
+(defn abbreviated? [template]
+  (abbreviated-helper (js->clj template)))

 (defn header-hook [value]
   (if (cljs-value? value)
     (build-header value)))

 (defn has-body-hook [value]
-  false)
+  (if (cljs-value? value)
+    (abbreviated? (build-header value))))

-(defn body-hook [value])
+(defn body-hook [value]
+  (if (cljs-value? value)
+    (build-body value)))

 (def cljs-formatter
   (js-obj


google font loading is now WAY improved

google font loading is now WAY improved

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -34,18 +34,7 @@
                ;(log "frame")
                ((:render-fn canvas)))))

-(defonce fonts
-  [
-   (font/install-google-font-stylesheet! "http://fonts.googleapis.com/css?family=Indie+Flower")
-   (font/install-google-font-dom-anchor! "Indie Flower")
-   ])
-
-(defn on-js-reload []
-  ;; optionally touch your app-state to force rerendering depending on
-  ;; your application
-  ;; (swap! app-state update-in [:__figwheel_counter] inc)
-)
-
+(defonce load-fonts (font/google ["Indie Flower"]))

 (def num-stars 250)
 (def stars-set (sort-by


Adds support for repositories being maps, adds :username, :password options to the repository map.


fix ns

fix ns

--- test/dynamodb_expression/grammar.clj
+++ test/dynamodb_expression/grammar.clj
@@ -1,4 +1,4 @@
-(ns dynamodb-expression.grammar
+(ns dynamodb-expression.grammar-test
   (:require [instaparse.core :as insta]
             [clojure.test :refer :all]
             [dynamodb-expression.core :as dx]))


test just one filter

test just one filter

--- test/gh_waiting_room/github_test.clj
+++ test/gh_waiting_room/github_test.clj
@@ -35,18 +35,20 @@
     (create-comment :issues [(assoc valid-issue :type "pull request")]
                     :body-expects #(re-find #"^Thanks for your pull" %))))

-(def valid-gh-issue {:repository {:full_name "cldwalker/faceplant"
-                               :name "faceplant"
-                               :owner {:login "cldwalker"}}
-                  :user {:login "call_me_faceplant"}
-                  ;; https://github.com/cldwalker/faceplant/pull/27
-                  :pull_request {:html_url nil :diff_url nil :patch_url nil}
-                  :html_url "https://github.com/cldwalker/faceplant/issues/27"
-                  :number 27
-                  :comments 0
-                  :created_at "2013-04-12T21:05:28Z"
-                  :title "So I faceplanted"
-                  :body "And I really didn't like it."})
+(def valid-gh-issue
+  {:repository {:full_name "cldwalker/faceplant"
+                :name "faceplant"
+                :owner {:login "cldwalker"}}
+   :user {:login "call_me_faceplant"}
+   ;; https://github.com/cldwalker/faceplant/pull/27
+   :pull_request {:html_url nil :diff_url nil :patch_url nil}
+   :html_url "https://github.com/cldwalker/faceplant/issues/27"
+   :number 27
+   :comments 0
+   :labels []
+   :created_at "2013-04-12T21:05:28Z"
+   :title "So I faceplanted"
+   :body "And I really didn't like it."})

 (deftest ->issue-test
   (testing "it converts issue map correctly"
@@ -77,6 +79,26 @@
     (is (= (:desc (->issue (assoc valid-gh-issue :body (str (apply str (repeat 98 "A")) " BBBB"))))
            (str (apply str (repeat 98 "A")) " ...")))))

+(defn issue-with-name-and-private
+  [name private]
+  (-> valid-gh-issue
+      (update-in [:repository :private] (constantly private))
+      (update-in [:repository :name] (constantly name))))
+
+(defn viewable-issues
+  [db]
+  (with-redefs [gh-waiting-room.config/gh-user (constantly "cldwalker")]
+    (github/viewable-issues db)))
+
+(deftest issue-filter-test
+  (testing "public and unspecified :private issues come through"
+    (is (= (->> {:issues [(issue-with-name-and-private "faceplant-public" false)
+                       valid-gh-issue
+                       (issue-with-name-and-private "faceplant-private" true)]}
+             viewable-issues
+             (map :name))
+        ["faceplant-public" "faceplant"]))))
+
 #_(deftest viewable-issues-test
   (testing "filters out issues with labels by default")
   (testing "filters out issues with specific labels when $GITHUB_HIDE_LABELS set")


♻ Deduplicate test data

♻ Deduplicate test data

--- test/territory_bro/db_admin_test.clj
+++ test/territory_bro/db_admin_test.clj
@@ -15,22 +15,36 @@
   (testing "congregation created"
     (let [cong-id (UUID. 0 1)
           user-id (UUID. 0 2)
-          events [{:event/type :congregation.event/congregation-created
-                   :event/version 1
-                   :congregation/id cong-id
-                   :congregation/name "Cong1 Name"
-                   :congregation/schema-name "cong1_schema"}]
+          cong-created-event {:event/type :congregation.event/congregation-created
+                              :event/version 1
+                              :congregation/id cong-id
+                              :congregation/name "Cong1 Name"
+                              :congregation/schema-name "cong1_schema"}
+          user-created-event {:event/type :congregation.event/gis-user-created
+                              :event/version 1
+                              :congregation/id cong-id
+                              :user/id user-id
+                              :gis-user/username "username123"
+                              :gis-user/password "password123"}
+          user-present-event {:event/type :db-admin.event/gis-user-is-present
+                              :event/version 1
+                              :event/transient? true
+                              :congregation/id cong-id
+                              :user/id user-id
+                              :gis-user/username "username123"}
+          user-deleted-event {:event/type :congregation.event/gis-user-deleted
+                              :event/version 1
+                              :congregation/id cong-id
+                              :user/id user-id
+                              :gis-user/username "username123"}
+
+          events [cong-created-event]
           expected {::db-admin/congregations {cong-id {:congregation/schema-name "cong1_schema"}}
                     ::db-admin/pending-tenants #{{:congregation/schema-name "cong1_schema"}}}]
       (is (= expected (apply-events events)))

       (testing "> GIS user created"
-        (let [events (conj events {:event/type :congregation.event/gis-user-created
-                                   :event/version 1
-                                   :congregation/id cong-id
-                                   :user/id user-id
-                                   :gis-user/username "username123"
-                                   :gis-user/password "password123"})
+        (let [events (conj events user-created-event)
               expected (merge expected
                               {::db-admin/pending-gis-users
                                {[cong-id user-id] {::db-admin/desired-state :present
@@ -40,22 +54,12 @@
           (is (= expected (apply-events events)))

           (testing "> GIS user is present"
-            (let [events (conj events {:event/type :db-admin.event/gis-user-is-present
-                                       :event/version 1
-                                       :event/transient? true
-                                       :congregation/id cong-id
-                                       :user/id user-id
-                                       :gis-user/username "username123"})
-                  expected (merge expected
-                                  {::db-admin/pending-gis-users {}})]
+            (let [events (conj events user-present-event)
+                  expected (merge expected {::db-admin/pending-gis-users {}})]
               (is (= expected (apply-events events)))))

           (testing "> GIS user deleted"
-            (let [events (conj events {:event/type :congregation.event/gis-user-deleted
-                                       :event/version 1
-                                       :congregation/id cong-id
-                                       :user/id user-id
-                                       :gis-user/username "username123"})
+            (let [events (conj events user-deleted-event)
                   expected (merge expected
                                   {::db-admin/pending-gis-users
                                    {[cong-id user-id] {::db-admin/desired-state :absent
@@ -64,10 +68,6 @@
               (is (= expected (apply-events events)))

               (testing "> GIS user is present"
-                (let [events (conj events {:event/type :db-admin.event/gis-user-is-present
-                                           :event/version 1
-                                           :event/transient? true
-                                           :congregation/id cong-id
-                                           :user/id user-id
-                                           :gis-user/username "username123"})]
-                  (is (= expected (apply-events events))))))))))))
+                (let [events (conj events user-present-event)]
+                  (is (= expected (apply-events events))
+                      "no change"))))))))))


commented out all hansen functions that will be revisited later for speed

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -4,6 +4,7 @@
         [cascalog.api]
         [clojure.math.numeric-tower :only (sqrt floor abs expt)]
         [forma.trends.filter])
+  (:import [org.jblas FloatMatrix MatrixFunctions Solve DoubleMatrix])
   (:require [forma.utils :as utils]
             [incanter.core :as i]
             [incanter.stats :as s]
@@ -36,13 +37,13 @@
       (map second (map (s/linear-model ts X) [:coefs :t-tests]))
       (catch IllegalArgumentException e))))

-(defn linear-residuals [y X] (:residuals (s/linear-model y X)))
-
-(defn expt-residuals
-  "returns a list of residuals from the linear regression of `y` on
-  `X`, raised to `power`"
-  [power residuals]
-  (i/pow residuals power))
+;; (defn linear-residuals [y X] (:residuals (s/linear-model y X)))
+
+;; (defn expt-residuals
+;;   "returns a list of residuals from the linear regression of `y` on
+;;   `X`, raised to `power`"
+;;   [power residuals]
+;;   (map #(expt % power) residuals))

 ;; (def X (i/matrix (utils/idx ndvi)))
 ;; (def y (i/matrix ndvi))
@@ -52,46 +53,76 @@
 ;; after: (time (dotimes [_ 100] (dorun (expt-residuals y X 2))))
 ;; "Elapsed time: 320.351 msecs"

-(defn first-order-conditions
-  "returns a matrix with residual weighted cofactors (incl. constant
-  vector) and deviations from mean; corresponds to first-order
-  conditions $f_t$ in the following reference: Hansen, B. (1992)
-  Testing for Parameter Instability in Linear Models, Journal for
-  Policy Modeling, 14(4), pp. 517-533"
-  [y]
-  (let [ones (i/matrix (repeat (count y) 1))
-        X (i/matrix (utils/idx y))
-        resid (linear-residuals y X)
-        sq-resid (i/matrix (expt-residuals 2 resid))
-        mu (s/mean sq-resid)]
-    (i/bind-columns (i/mult resid X)
-                    (i/mult resid ones)
-                    (i/minus sq-resid mu))))
-
-    ;; (vector (map * resid X)
-            ;; (map * resid (repeat (count y) 1))
-            ;; (map #(- % (utils/average sq-resid)) sq-resid))
+;; (defn first-order-conditions
+;;   "returns a matrix with residual weighted cofactors (incl. constant
+;;   vector) and deviations from mean; corresponds to first-order
+;;   conditions $f_t$ in the following reference: Hansen, B. (1992)
+;;   Testing for Parameter Instability in Linear Models, Journal for
+;;   Policy Modeling, 14(4), pp. 517-533"
+;;   [coll]
+;;   {:pre [(i/matrix? coll)]}
+;;   (let [n (count coll)
+;;         X (i/matrix (range n))
+;;         resid (linear-residuals coll X)
+;;         sq-resid (expt-residuals 2 resid)
+;;         mu (utils/average sq-resid)]
+;;     (i/bind-rows (map * resid X)
+;;                     (map * resid (repeat n 1))
+;;                     (map #(- % mu) sq-resid))))
+
+
+
+;; (defn foc-mat [coll]
+;;   (let [foc (first-order-conditions coll)]
+;;     ))

 ;; (count (last (first-order-conditions ndvi))) => 271
 ;; (count (first (first-order-conditions ndvi))) => 271
 ;; (first (last (first-order-conditions ndvi))) => -1352787.304306197
 ;; (time (dotimes [_ 100] (dorun (first-order-conditions y))))
 ;; => "Elapsed time: 639.449 msecs"
-;; after: (time (dotimes [_ 100] (dorun (first-order-conditions y))))
-;; => "Elapsed time: 253.278 msecs"
-
-
-;; (defn outer-product2 [coll] (i/matrix (flatten (map #(scale % coll) coll))))
-(defn hansen-mats
-  "returns the matrices of element-wise sums of (1) the first-order
-  conditions, and (2) the cumulative first-order conditions.  This is
-  only an intermediate step in the calculation of the Hansen (1992)
-  test for parameter instability in linear models."
-  [y & x]
-  (let [foc (apply first-order-conditions y x)
-        foccum (map i/cumulative-sum foc)]
-    [(element-sum (map outer-product (transpose foc)))
-     (element-sum (map outer-product (transpose foccum)))]))
+;; after: (time (dotimes [_ 100] (dorun (first-order-conditions
+;; (i/matrix y)))))
+;; => "Elapsed time: 248.278 msecs"
+
+
+;; (defn outer-product2 [coll] (flatten (map #(utils/scale % coll) coll)))
+
+;; (defn hansen-mats
+;;   "returns the matrices of element-wise sums of (1) the first-order
+;;   conditions, and (2) the cumulative first-order conditions.  This is
+;;   only an intermediate step in the calculation of the Hansen (1992)
+;;   test for parameter instability in linear models."
+;;   [coll]
+;;   (let [foc (first-order-conditions coll)
+;;         foccum (map i/cumulative-sum foc)]
+;;     (vec [
+;;           (element-sum (map outer-product (transpose foc)))
+;;           (element-sum (map outer-product (transpose foccum)))])))
+
+
+;; (defn hansen-stat
+;;   "returns the Hansen (1992) test statistic; number of first-order
+;;   conditions `num-foc` accounts for the demeaned residuals, intercept,
+;;   and time-step introduced by `first-order-conditions`"
+;;   [coll]
+;;   (let [hmat      (hansen-mats coll)
+;;         foc       (first hmat)
+;;         cumul-foc (second hmat)]
+;;     (print (count cumul-foc))))
+
+    ;; (i/trace
+    ;;  (i/mmult
+    ;;   (i/solve (i/mult foc (count coll)))
+    ;;   cumul-foc))
+
+;; (last (last (hansen-mats (i/matrix y))))
+;; 4.0864006033466618E17
+
+
+;; (hansen-stat (i/matrix ndvi))
+;; 0.9113170920764445
+

 ;; (defn hansen-stat
 ;;   "returns the Hansen (1992) test statistic; number of first-order
@@ -109,7 +140,7 @@
   "returns the Hansen (1992) test statistic; number of first-order
   conditions `num-foc`accounts for the demeaned residuals, intercept,
   and time-step introduced by `first-order-conditions`"
-  [y & x]
+  [y]
   1)

 (defn lengthening-ts


Less blurb for ac results

Less blurb for ac results

--- src/cljs/clojuredocs/widgets.cljs
+++ src/cljs/clojuredocs/widgets.cljs
@@ -217,7 +217,7 @@
       #_(dom/i {:class "fa fa-exclamation"})
       (dom/a {:href (var-url func)}
         name " (" ns ")"))
-    (dom/p (ellipsis 225 doc))))
+    (dom/p (ellipsis 100 doc))))

 (defmethod ac-entry :macro [{:keys [name ns doc type]}]
   (dom/div {:class "ac-entry"}


Show blank card when nothing is selected

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -614,6 +614,7 @@
                  (swap! editors dissoc path)
                  (swap! editors assoc path editor-map))
                path)
+             (when path :file-browser-card)
              :default-card)
          (s/show-card! editor-pane))
     ; update tabs
@@ -628,7 +629,8 @@
   "Returns the pane with the editors."
   []
   (s/card-panel :id :editor-pane
-                :items [[(file-browser/create-card) :default-card]]))
+                :items [["" :default-card]
+                        [(file-browser/create-card) :file-browser-card]]))

 ; watchers


Fix typo

Fix typo

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -208,7 +208,7 @@
                                     :undo-button undo-file
                                     :redo-button redo-file
                                     :find-field focus-on-find
-                                    :font-enc-button increase-font-size
+                                    :font-inc-button increase-font-size
                                     :font-dec-button decrease-font-size})
         shortcuts/create-hints
         (update-buttons text-area))


Signature generation, encoding, and decoding.

--- src/vault/crypto.clj
+++ src/vault/crypto.clj
@@ -3,18 +3,26 @@
             [clojure.string :as string])
   (:import
     (java.security Security)
-    (org.bouncycastle.jce.provider BouncyCastleProvider)
-    (org.bouncycastle.openpgp PGPUtil
-                              PGPPublicKey
-                              PGPPublicKeyRingCollection
-                              PGPSecretKey
-                              PGPSecretKeyRingCollection
-                              PGPSignature
-                              PGPSignatureGenerator
-                              )))
+    (org.bouncycastle.jce.provider
+      BouncyCastleProvider)
+    (org.bouncycastle.openpgp
+      PGPObjectFactory
+      PGPPublicKey
+      PGPPublicKeyRingCollection
+      PGPSecretKey
+      PGPSecretKeyRingCollection
+      PGPSignature
+      PGPSignatureGenerator
+      PGPSignatureList
+      PGPUtil)
+    (org.bouncycastle.openpgp.operator.bc
+      BcPGPContentSignerBuilder
+      BcPGPContentVerifierBuilderProvider
+      BcPGPDigestCalculatorProvider
+      BcPBESecretKeyDecryptorBuilder)))

-; Install the BouncyCastle security provider.
+; Install the BouncyCastle security provider. TODO: is this necessary?
 (Security/addProvider (new BouncyCastleProvider))

@@ -90,18 +98,33 @@
         (.getSecretKey (key-id id)))))

+(defn- extract-private-key
+  [secret-key passphrase]
+  (.extractPrivateKey secret-key
+    (-> (BcPGPDigestCalculatorProvider.)
+        (BcPBESecretKeyDecryptorBuilder.)
+        (.build (.toCharArray passphrase)))))
+
+
+(defn- build-signature-generator
+  [hash-algorithm-code key-algorithm-code]
+  (PGPSignatureGenerator.
+   (BcPGPContentSignerBuilder.
+     key-algorithm-code
+     hash-algorithm-code)))
+
+
 (defn- generate-signature
   [data-source
    hash-algorithm-code
    key-algorithm-code
    private-key]
-  (let [generator (PGPSignatureGenerator.
-                    key-algorithm-code
+  (let [generator (build-signature-generator
                     hash-algorithm-code
-                    security-provider)]
+                    key-algorithm-code)]
     (.init generator PGPSignature/BINARY_DOCUMENT private-key)
     (with-open [data (io/input-stream data-source)]
-      (let [buffer (byte-array 256)]
+      (let [buffer (byte-array 1024)]
         (loop [n (.read data buffer)]
           (when (> n 0)
             (.update generator buffer 0 n)
@@ -111,15 +134,28 @@

 (defn sign
   [data-source secret-key passphrase]
-  (let [private-key (.extractPrivateKey
-                      secret-key
-                      passphrase
-                      security-provider)]
-    (generate-signature
-      data-source
-      (hash-algorithms *hash-algorithm*)
-      (key-algorithm-code secret-key)
-      private-key)))
+  (generate-signature
+    data-source
+    (hash-algorithms *hash-algorithm*)
+    (key-algorithm-code secret-key)
+    (extract-private-key secret-key passphrase)))
+
+
+(defn encode-signature
+  [sig]
+  (.getEncoded sig))
+
+
+(defn decode-signature
+  [data]
+  (with-open [data-stream (PGPUtil/getDecoderStream
+                            (io/input-stream data))]
+    (let [sig-list (.nextObject (PGPObjectFactory. data-stream))]
+      (when-not (instance? PGPSignatureList sig-list)
+        (throw (IllegalArgumentException.
+                 (str "Data did not contain a PGPSignatureList: " sig-list))))
+      (when-not (.isEmpty sig-list)
+        (.get sig-list 0)))))

 (defn print-key-info


Delete commented-out debugging cruft

Delete commented-out debugging cruft

--- src/com/frereth/server/system.clj
+++ src/com/frereth/server/system.clj
@@ -46,10 +46,6 @@
                       :cljeromq.common/zmq-protocol :tcp}}})

 (defn structure []
-  (comment (throw (ex-info "Start with previous check-in commit comment"
-                           {:why "Lots of possibilities"
-                            :also "Don't forget to uncomment the commented-out pieces below"})))
-  (log/warn "Check out the TODO exception commented out just above here")
   ;; Note that this is overly simplified.
   ;; It would be crazy to mix the auth and action servers in the same process.
   ;; Q: Would it?
@@ -70,8 +66,6 @@
     ;; :done component-dsl.done-manager/ctor
     ;; This is probably pretty important, if only to get logging configured
     ;; :logger com.frereth.server.logging/ctor
-    ;; TODO: Restore those when I'm done debugging this
-    ;; For auth
     :principal-manager com.frereth.server.connection-manager/new-directory})

 (defn dependencies []
@@ -85,44 +79,6 @@
 (defn initialize-description []
   #:component-dsl.system{:structure (structure)
                          :dependencies (dependencies)})
-
-(comment
-  ;; This isn't working predictably.
-  ;; Q: Why not?
-  ;; A: Well, this part seems fine
-  (comment (cpt-dsl/split-nested-definers (structure)))
-  ;; As does this
-  (comment (cpt-dsl/build (initialize-description) (defaults)))
-  ;; At first glance, so does this.
-  ;; Except that it looks like it isn't finding the nested component constructors
-  (comment (cpt-dsl/pre-process (assoc (initialize-description)
-                                       :component-dsl.system/options (defaults)))
-           )
-  (comment (let [true-tops (->> (initialize-description)
-                                :component-dsl.system/structure
-                                (filter (comp symbol? second))
-                                (into {}))]
-             true-tops))
-  (comment (let [nested-ctord (->> (initialize-description)
-                                   :component-dsl.system/structure
-                                   (filter (comp symbol? second))
-                                   (into {})
-                                   cpt-dsl/split-nested-definers
-                                   :component-dsl.system/definers
-                                   (cpt-dsl/call-nested-ctors (defaults)))]
-             nested-ctord))
-  (let [de-nested (->> (initialize-description)
-                       :component-dsl.system/structure
-                       (filter (comp symbol? second))
-                       (into {})
-                       cpt-dsl/split-nested-definers
-                       :component-dsl.system/definers
-                       (cpt-dsl/call-nested-ctors (defaults))
-                       (reduce cpt-dsl/de-nest-component-ctors
-                               #:component-dsl.system{:structure tops
-                                                      :dependencies dependencies}))
-        ]
-             nested-ctord))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


GM: [WIP] Added tests for disabled tabs

GM: [WIP] Added tests for disabled tabs

--- test/hatti/views/dataview_test.cljs
+++ test/hatti/views/dataview_test.cljs
@@ -1,18 +1,16 @@
 (ns hatti.views.dataview-test
-  (:require-macros [cljs.test :refer (is deftest testing)])
+  (:require-macros [cljs.test :refer (is deftest testing)]
+                   [dommy.macros :refer [sel1]])
   (:require [cljs.test :as t]
+            [dommy.core :as dommy]
             [hatti.shared :as shared]
-            [hatti.test-utils :refer [format]]))
-
-(defn data-gen [ncol nrow]
-  (let [rf (fn [max] (format "%02d" (inc (rand-int max))))]
-    (for [i (range nrow)]
-      (apply merge {"_id" i
-                    "_rank" (inc i)
-                    "_submission_time" (str "2012-" (rf 12) "-" (rf 28))}
-             (for [j (range ncol)] {(str "hello" j) (str "goodbye" j)})))))
-
-(def big-thin-data (data-gen 1 100))
+            [hatti.views :refer [tabbed-dataview]]
+            [hatti.test-utils :refer [big-thin-data
+                                      data-gen
+                                      format
+                                      new-container!
+                                      thin-form]]
+            [om.core :as om :include-macros true]))

 ;; INITIAL STATE TESTS
 (deftest initial-state
@@ -31,3 +29,24 @@
                       (dget "_submission_time" data-100))]
         (is (= (sort test-dates) (conj (take 2 test-dates) (last test-dates))))
         (is (= s100 (sort s100)))))))
+
+
+;;TABBED DATAVIEW TESTS
+(defn- tabbed-dataview-container
+  [app-state]
+  (let [c (new-container!)
+        _ (om/root tabbed-dataview
+                   app-state
+                   {:shared {:flat-form thin-form
+                             :project-id "1"
+                             :project-name "Project"
+                             :dataset-id "2"
+                             :username "user"
+                             :view-type :default}
+                    :target c})]
+    c))
+
+(deftest tabbed-dataview-tests
+  (let [tabbed-view (tabbed-dataview-container shared/app-state)]
+    (testing "All tabs are rendered when none is disabled"
+      (is (re-find #"inactive" (dommy/html (sel1 tabbed-view)))))))


Support foreign-parsers on connect-async-parser sugar helper

--- src/com/wsscode/pathom/sugar.cljc
+++ src/com/wsscode/pathom/sugar.cljc
@@ -1,8 +1,20 @@
 (ns com.wsscode.pathom.sugar
   "This namespace contains easy ways to setup common configurations for Pathom parsers"
-  (:require [com.wsscode.pathom.core :as p]
+  (:require [clojure.spec.alpha :as s]
+            [com.fulcrologic.guardrails.core :refer [>def >defn >fdef => | <- ?]]
             [com.wsscode.pathom.connect :as pc]
-            [com.wsscode.pathom.connect.foreign :as pcf]))
+            [com.wsscode.pathom.connect.foreign :as pcf]
+            [com.wsscode.pathom.core :as p]))
+
+(>def ::connect-reader "Connect reader to be used" fn?)
+
+(>def ::plugins
+  "Fn that takes plugin vector and return a modified version to be used as the plugins for the parser"
+  fn?)
+
+(>def ::foreign-parsers
+  "Collection of parsers to be injected as foreign parsers."
+  (s/coll-of fn?))

 (defn connect-serial-parser
   "Create a standard connect parser using the serial parser.
@@ -33,7 +45,7 @@
   in responses. The most common usage of this one is in ClojureScript land, where
   most of the IO needs to be async."
   ([register] (connect-async-parser {} register))
-  ([{::keys [connect-reader plugins]} register]
+  ([{::keys [connect-reader foreign-parsers plugins]} register]
    (p/async-parser
      {::p/env     {::p/reader               [p/map-reader
                                              (or connect-reader pc/async-reader2)
@@ -42,6 +54,9 @@
                    ::p/placeholder-prefixes #{">"}}
       ::p/mutate  pc/mutate-async
       ::p/plugins (cond-> [(pc/connect-plugin {::pc/register register})
+                           (if foreign-parsers
+                             (pcf/foreign-parser-plugin {::pcf/parsers foreign-parsers})
+                             {})
                            p/error-handler-plugin
                            p/trace-plugin]
                     plugins plugins)})))


Review comment: style nits.

Review comment: style nits.

--- src/common/datomish/transact.cljc
+++ src/common/datomish/transact.cljc
@@ -350,19 +350,16 @@
   :entities - not :db/add, or no id-literals."
   {:pre [(sequential? entity)]}
   (let [[op e a v] entity
-        e?         (id-literal? e)
-        a?         (id-literal? a)
         v?         (id-literal? v)]
-    (cond
-      (not= (first entity) :db/add) ;; TODO: verify no id-literals appear.
-      :entities
-
-      a?
+    (when (id-literal? a)
       (raise "id-literal attributes are not yet supported: " entity
              {:error  :transact/no-id-literal-attributes
-              :entity entity })
-
-      e?
+              :entity entity }))
+    (cond
+      (not= op :db/add) ;; TODO: verify no id-literals appear.
+      :entities
+
+      (id-literal? e)
       (if (unique-identity? a)
         (if v?
           :upserts-ev
@@ -383,7 +380,7 @@
   Returns a map of id-literals to integer entids, with keys only those id-literals that mapped to
   existing entities."
   (go-pair
-    (if (seq upserts-e)
+    (when (seq upserts-e)
       (let [->id-av (fn [[op id-literal a v]] [id-literal [a v]])
             ;; Like {[id-literal [[:a1 :v1] [:a2 :v2] ...]] ...}.
             id->avs (util/group-by-kv ->id-av upserts-e)


Trying out things.

Trying out things.


Alignment

Alignment

--- test/maestro/messages/data_test.clj
+++ test/maestro/messages/data_test.clj
@@ -117,8 +117,8 @@

 (fact "that getting Tyrant application properties works"
       (get-tyrant-application-properties {:parameters {:application "application"
-                                                          :environment "environment"
-                                                          :new-state {:hash "hash"}}})
+                                                       :environment "environment"
+                                                       :new-state {:hash "hash"}}})
       => {:status :success
           :parameters {:application "application"
                        :environment "environment"
@@ -137,16 +137,16 @@

 (fact "that an error while getting Tyrant deployment params is an error"
       (get-tyrant-deployment-params {:parameters {:application "application"
-                                                     :environment "environment"
-                                                     :new-state {:hash "hash"}}})
+                                                  :environment "environment"
+                                                  :new-state {:hash "hash"}}})
       => (contains {:status :error})
       (provided
        (tyr/deployment-params "environment" "application" "hash") =throws=> (ex-info "Busted" {})))

 (fact "that getting Tyrant deployment params adds in defaults where a value hasn't been specified"
       (get-in (get-tyrant-deployment-params {:parameters {:application "application"
-                                                             :environment "environment"
-                                                             :new-state {:hash "hash"}}}) [:parameters :new-state :tyranitar :deployment-params])
+                                                          :environment "environment"
+                                                          :new-state {:hash "hash"}}}) [:parameters :new-state :tyranitar :deployment-params])
       => (contains {:default-cooldown 10
                     :desired-capacity 23})
       (provided
@@ -163,8 +163,8 @@

 (fact "that getting no Tyrant launch data is an error"
       (get-tyrant-launch-data {:parameters {:application "application"
-                                               :environment "environment"
-                                               :new-state {:hash "hash"}}})
+                                            :environment "environment"
+                                            :new-state {:hash "hash"}}})
       => (contains {:status :error})
       (provided
        (tyr/launch-data "environment" "application" "hash") => nil))
@@ -175,16 +175,16 @@

 (fact "that an error while getting Tyrant launch data is an error"
       (get-tyrant-launch-data {:parameters {:application "application"
-                                               :environment "environment"
-                                               :new-state {:hash "hash"}}})
+                                            :environment "environment"
+                                            :new-state {:hash "hash"}}})
       => (contains {:status :error})
       (provided
        (tyr/launch-data "environment" "application" "hash") =throws=> (ex-info "Busted" {})))

 (fact "that getting Tyrant launch data works"
       (get-tyrant-launch-data {:parameters {:application "application"
-                                               :environment "environment"
-                                               :new-state {:hash "hash"}}})
+                                            :environment "environment"
+                                            :new-state {:hash "hash"}}})
       => {:status :success
           :parameters {:application "application"
                        :environment "environment"