fix grouping typo

fix grouping typo

--- src/babel/korma.clj
+++ src/babel/korma.clj
@@ -20,9 +20,8 @@
                       true
                       (do
                         (log/warn
-                         (str "DATABASE_URL not set in your environment: defaulting to:" default)
-                         default)))]
-
+                         (str "DATABASE_URL not set in your environment: defaulting to:" default))
+                        default))]
     ;; this constructs the actual database connection which is used throughout the code base.
     (postgres
      ;; thanks to Jeroen van Dijk via http://stackoverflow.com/a/14625874


add :infl to (defn spec-info)

add :infl to (defn spec-info)

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -55,6 +55,8 @@
       {:agr agr})
     (if-let [def (get-in spec [:synsem :sem :spec :def])]
       {:def def})
+    (if-let [infl (get-in spec [:synsem :infl])]
+      {:infl infl})
     (if-let [pronoun (get-in spec [:synsem :pronoun])]
       {:pronoun pronoun})
     ;; :synsem/:sem/:mod is sometimes used with nil explicitly, so need to have a special test for it


work on case-insensitive switch

work on case-insensitive switch

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -1,8 +1,5 @@
-;; TODO add a debug toggle and some related verbose prints?
-;; TODO maybe print log message / committer info (could use awt/swing popup)?
-;; TODO pass all '--' options (e.g. --username) to svn?
-;; TODO add command-line switch for case insensitivity!
 ;; TODO make get-revpairs non-recursive?
+;; TODO make diffrevpairs non-recursive?

 (ns revdiff.core
   (:gen-class)
@@ -53,14 +50,14 @@
 ;; (if any) is present on a changed line in that pair. If no filter term is
 ;; given, diff all changed files from all revision pairs.

-(defn diffrevpairs [object filt revpairs show]
+(defn diffrevpairs [object filt revpairs show insens]
   (when (seq revpairs)
     (let [r1 (first revpairs)
           r2 (first (rest revpairs))
-          mf (matching-files r1 r2 object filt show)]
+          mf (matching-files r1 r2 object filt show insens)]
       (println (str "Checking: r" r1 " vs r" r2))
       (doseq [filename mf] (svndiff r1 r2 filename object show))
-      (diffrevpairs object filt (rest (rest revpairs)) show))))
+      (diffrevpairs object filt (rest (rest revpairs)) show insens))))

 ;; Try to explain why this has failed.

@@ -109,8 +106,10 @@
 ;; vector of the names of files where the filter term appears on a changed line.
 ;; If no filter term is given, a changed file automatically matches.

-(defn matching-files [r1 r2 object filt show]
-  (let [blocks (rest (split (:out (diff r1 r2 object show)) #"^Index: |\nIndex: "))]
+(defn matching-files [r1 r2 object filt show insens]
+  (let [raw (:out (diff r1 r2 object show))
+        blocks (rest (split raw #"^Index: |\nIndex: "))
+        filt (if insens (str "(?i)" filt) filt)]
     (remove nil?
             (into []
                   (for [block blocks]
@@ -166,6 +165,7 @@
   (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
         object (first arguments)
         filt (or (second arguments) ".*")
+        insens (:case-insensitive options)
         optsd (:diff-opts options)
         optsl (:log-opts options)
         show (:show-cmds options)]
@@ -174,5 +174,5 @@
       (usage summary 1)
       (let [revlist (get-revlist optsl show object)
             revpairs (get-revpairs revlist object)]
-        (diffrevpairs object filt revpairs show)
+        (diffrevpairs object filt revpairs show insens)
         (shutdown-agents)))))


add --show-cmds

add --show-cmds

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -10,13 +10,19 @@
   (:require [clojure.tools.cli :as cli])
   (:use [clojure.xml :only [parse]])
   (:use [clojure.java.shell :only [sh]])
-  (:use [clojure.string :only [split split-lines trim]]))
+  (:use [clojure.string :only [join split split-lines trim]]))

-(declare matching-files log svndiff uri? vpaths)
+(declare matching-files log squeeze svndiff uri? vpaths)

-;; Suppress svn user prompts.
+;; defs

 (def shhh "--non-interactive")
+
+(def show-cmd #(println (str "Command: " (squeeze (join " " %)))))
+
+(def squeeze #(clojure.string/replace % #"\s\s+" " "))
+
+;; defns

 ;; Strip peg revision, if present.

@@ -29,27 +35,32 @@
   [["-h" "--help" "Show usage information"]
    ["-i" "--case-insensitive" "Treat regexp as case-insensitive"]
    ["-d" "--diff-opts options" "Quoted list of options to pass to svn diff"]
-   ["-l" "--log-opts options" "Quoted list of options to pass to svn log"]])
+   ["-l" "--log-opts options" "Quoted list of options to pass to svn log"]
+   ["-s" "--show-cmds" "Show the svn commands taht are issued"]])

 ;; A string containing the output of "diff" on the two svn revision of object.

-(defn diff [r1 r2 object]
+(defn diff [r1 r2 object show]
   (let [object (baseobject object)
-        v (vpaths r1 r2 object object)]
-    (sh "svn" "diff" "--diff-cmd" "diff" "-x" "-u0" shhh (first v) (second v))))
+        v (vpaths r1 r2 object object)
+        o1 (first v)
+        o2 (second v)
+        cmd-components ["svn" "diff" "--diff-cmd" "diff" "-x" "-u0" shhh o1 o2]]
+    (if show (show-cmd cmd-components))
+    (apply sh cmd-components)))

 ;; Given a list of revision pairs, diff those for which the given filter term
 ;; (if any) is present on a changed line in that pair. If no filter term is
 ;; given, diff all changed files from all revision pairs.

-(defn diffrevpairs [object filt revpairs]
+(defn diffrevpairs [object filt revpairs show]
   (when (seq revpairs)
     (let [r1 (first revpairs)
           r2 (first (rest revpairs))
-          mf (matching-files r1 r2 object filt)]
+          mf (matching-files r1 r2 object filt show)]
       (println (str "Checking: r" r1 " vs r" r2))
-      (doseq [filename mf] (svndiff r1 r2 filename object))
-      (diffrevpairs object filt (rest (rest revpairs))))))
+      (doseq [filename mf] (svndiff r1 r2 filename object show))
+      (diffrevpairs object filt (rest (rest revpairs)) show))))

 ;; Try to explain why this has failed.

@@ -62,10 +73,10 @@
 ;; Return a newest-first sequence of revision numbers in which the object
 ;; changed.

-(defn get-revlist [opts object]
-  (let [logstream (java.io.ByteArrayInputStream. (.getBytes (log opts object)))]
+(defn get-revlist [opts show object]
+  (let [x (java.io.ByteArrayInputStream. (.getBytes (log opts show object)))]
     (for [e (try
-              (xml-seq (parse logstream))
+              (xml-seq (parse x))
               (catch Exception e (errmsg)))
           :when (seq (:attrs e))]
     (:revision (:attrs e)))))
@@ -81,12 +92,15 @@
 ;; Return a string containing the xml-formatted svn log for the requested
 ;; object.

-(defn log [opts object]
-  (print "Fetching log... ")
-  (flush)
-  (let [log (:out (sh "svn" "log" opts shhh "--xml" object))]
-    (println)
-    log))
+(defn log [opts show object]
+  (let [cmd-components (if opts ["svn" "log" shhh "--xml" opts object]
+                                ["svn" "log" shhh "--xml"      object])]
+    (if show (show-cmd cmd-components))
+    (print "Fetching log... ")
+    (flush)
+    (let [result (:out (apply sh cmd-components))]
+      (println)
+      result)))

 ;; Obtain a diff from svn for the given object between the specified revisions.
 ;; Break each diff into blocks (delineated by the text "Index: "), where each
@@ -95,8 +109,8 @@
 ;; vector of the names of files where the filter term appears on a changed line.
 ;; If no filter term is given, a changed file automatically matches.

-(defn matching-files [r1 r2 object filt]
-  (let [blocks (rest (split (:out (diff r1 r2 object)) #"^Index: |\nIndex: "))]
+(defn matching-files [r1 r2 object filt show]
+  (let [blocks (rest (split (:out (diff r1 r2 object show)) #"^Index: |\nIndex: "))]
     (remove nil?
             (into []
                   (for [block blocks]
@@ -111,14 +125,16 @@

 ;; NEED NEW COMMENT HERE

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

 ;; Is path a uri? If it contains :// assume it is.

@@ -151,10 +167,12 @@
         object (first arguments)
         filt (or (second arguments) ".*")
         optsd (:diff-opts options)
-        optsl (:log-opts options)]
+        optsl (:log-opts options)
+        show (:show-cmds options)]
     (if (:help options) (usage summary 0))
     (if (not object)
       (usage summary 1)
-      (let [revpairs (get-revpairs (get-revlist optsl object) object)]
-        (diffrevpairs object filt revpairs)
+      (let [revlist (get-revlist optsl show object)
+            revpairs (get-revpairs revlist object)]
+        (diffrevpairs object filt revpairs show)
         (shutdown-agents)))))


Add minimum time between printed frames to ConsoleDisplayer

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -4,7 +4,8 @@
             [com.stuartsierra.component :as component])
   (:gen-class))

-; Let's start by implementing rendering a vec of layers on one static set of LEDs
+(defn now []
+  (System/currentTimeMillis))

 (def black {:r 0 :g 0 :b 0})
 (def white {:r 1 :g 1 :b 1})
@@ -61,13 +62,16 @@
               (recur))
           (println "Shutting down displayer"))))))

+;; The minimum time between frames printed by ConsoleDisplayer
+(def console-display-interval 500)

-(defrecord ConsoleDisplayer [frame-chan prev-frame]
+(defrecord ConsoleDisplayer [frame-chan previous]
   component/Lifecycle
   (start [displayer]
     (let [displayer (-> displayer
                         (assoc :frame-chan (chan))
-                        (assoc :prev-frame (atom nil)))]
+                        (assoc :previous (atom {:frame nil
+                                                :time (- (now) console-display-interval)})))]
       (start-displayer displayer)
       displayer))

@@ -76,15 +80,17 @@
     displayer)

   Displayer
-  (display [{:keys [prev-frame]} frame]
-    (when (not= frame @prev-frame)
-      (reset! prev-frame frame)
-      (println frame))))
+  (display [{:keys [previous]} frame]
+    (let [{prev-frame :frame prev-time :time} @previous]
+      (when (and (>= (now) (+ prev-time console-display-interval))
+                 (not= frame prev-frame))
+        (reset! previous {:frame frame :time (now)})
+        (println frame)))))

 (defn get-env-updates [env]
   (-> env
-      (assoc :time (System/currentTimeMillis))))
+      (assoc :time (now))))

 (defn render-step [{:keys [env model] :as state}]
   (let [{:keys [layers]} model


Display employment-component

Display employment-component

--- app/src/cljs/app/app.cljs
+++ app/src/cljs/app/app.cljs
@@ -14,7 +14,8 @@
     [:nav.mdl-navigation
      [:a.mdl-navigation__link {:href "#contact"} "Contact"]
      [:a.mdl-navigation__link {:href "#about"} "About"]
-     [:a.mdl-navigation__link {:href "#projects"} "Projects"]]]
+     [:a.mdl-navigation__link {:href "#projects"} "Projects"]
+     [:a.mdl-navigation__link {:href "#emploment"} "Employment"]]]
    [:main.mdl-layout__content
     [:div.page-content
      content]]])
@@ -29,7 +30,9 @@
      [comps/about-component
       [:p (:profile resume)]]
      [comps/projects-component
-      (:projects resume)]]]])
+      (:projects resume)]
+     [comps/employment-component
+      (:employment resume)]]]])


Properly split very long lines

Properly split very long lines

--- src/text_justification/model.cljs
+++ src/text_justification/model.cljs
@@ -33,15 +33,18 @@
   [max-len word-raw]
   (let [word (gstring/trim word-raw) len (count word)]
     (cond
-      (<= max-len 0) word
-      (zero? len) invisible-char
-      (<= len max-len) word
-      :else [(.substring word 0 max-len) (str " -" (prepare-word max-len (.substring word max-len)))]
-    )))
-; (println "norm:" (prepare-word 3 "abc"))
-; (println "trim:" (prepare-word 3 "  abc  "))
-; (println "long:" (prepare-word 2 "abc"))
-; (println "test:" (prepare-word 11 "aaabbbccc111"))
+      (<= max-len 0) [word]
+      (zero? len) [invisible-char]
+      (<= len max-len) [word]
+      :else (concat
+          [(.substring word 0 max-len)]
+          (prepare-word max-len (str " -" (.substring word max-len)))) )))
+; (defn prepare-word-test [str]
+  ; (let [res (prepare-word 11 str)]
+    ; (println "test(" (count res) ")" res)))
+; (prepare-word-test "aaabbbccc111")
+; (prepare-word-test "aaabbbccc111aaabbbccc111")
+; (prepare-word-test "aaabbbccc111aaabbbccc111aaabbbccc111")

 (defn- badness
   "given line and page width and returns measurement how `pretty` the line is"
@@ -87,8 +90,10 @@
   (doseq [paragraph (prepare-text text separate-paragraphs)]
     ; (println "PARAGRAPH:" paragraph)
     (let [words-raw (.split paragraph #" ")
-          words (vec (flatten (map #(prepare-word page-width %) words-raw)))]
-        ; (println "words:" words)
-        (update-state (second (text-justification-inner words page-width) ))
+          words (vec (flatten (map #(prepare-word page-width %) words-raw)))
+          [_ justified-line] (text-justification-inner words page-width)]
+        ; (.log js/console "words" (count words) ":" words)
+        ; (.log js/console "state" (count justified-line) ":" justified-line)
+        (update-state justified-line)
       )
   ))


offer-acker.

offer-acker.

--- src/onyx/log/commands/volunteer_for_task.clj
+++ src/onyx/log/commands/volunteer_for_task.clj
@@ -62,6 +62,17 @@
        (common/alive-jobs replica)
        (common/jobs-with-available-tasks replica)))

+(defn offer-acker [replica job args]
+  (let [peers (count (apply concat (vals (get-in replica [:allocations job]))))
+        ackers (count (get-in replica [:ackers job]))
+        pct (get-in replica [:acker-percentage job])
+        current-pct (int (Math/ceil (* 10 (double (/ ackers peers)))))]
+    (if (< current-pct pct)
+      (-> replica
+          (update-in [:ackers job] conj (:id args))
+          (update-in [:ackers job] vec))
+      replica)))
+
 (defmethod select-job :onyx.job-scheduler/greedy
   [{:keys [args]} replica]
   (let [job (first (universally-executable-jobs replica))]
@@ -71,7 +82,8 @@
             (common/remove-peers args)
             (update-in [:allocations job task] conj (:id args))
             (update-in [:allocations job task] vec)
-            (assoc-in [:peer-state (:id args)] :warming-up)))
+            (assoc-in [:peer-state (:id args)] :warming-up)
+            (offer-acker job args)))
       replica)))

 (defmethod select-job :onyx.job-scheduler/round-robin
@@ -86,7 +98,8 @@
               (common/remove-peers args)
               (update-in [:allocations job task] conj (:id args))
               (update-in [:allocations job task] vec)
-              (assoc-in [:peer-state (:id args)] :warming-up)))
+              (assoc-in [:peer-state (:id args)] :warming-up)
+              (offer-acker job args)))
         replica))
     replica))

@@ -109,7 +122,8 @@
             (common/remove-peers args)
             (update-in [:allocations job task] conj (:id args))
             (update-in [:allocations job task] vec)
-            (assoc-in [:peer-state (:id args)] :warming-up)))
+            (assoc-in [:peer-state (:id args)] :warming-up)
+            (offer-acker job args)))
       replica)))

 (defmethod select-job :default


Improve docstrings for blend-rgb and blend-hsv.

--- src/org/playasophy/wonderdome/util/color.clj
+++ src/org/playasophy/wonderdome/util/color.clj
@@ -100,8 +100,8 @@
 ;;;;; COLOR GRADIENTS ;;;;;

 (defn blend-rgb
-  "Generates a color which is composed of linearly interpolated red, green, and
-  blue channels between two colors."
+  "Blends two colors by linearly interpolating their red, green, and blue
+  channels by a certain proportion."
   [p x y]
   {:pre [(<= 0.0 p 1.0)]}
   (let [xc (rgb-components x)
@@ -114,10 +114,10 @@

 (defn blend-hsv
-  "Generates a color which is composed of linearly interpolated hue,
-  saturation, and value channels between two colors. This direction the hue is
-  interpolated may be controlled with an optional mode argument. Mode may be
-  :closest, :pos, or :neg. The default is :closest."
+  "Blends two colors by linearly interpolating their hue, saturation, and value
+  channels by a certain proportion. The direction the hue is interpolated may
+  be controlled with an optional mode argument. Mode may be :closest, :pos, or
+  :neg. The default is :closest."
   ([p x y]
    (blend-hsv :closest p x y))
   ([mode p x y]


replace curly apostrophes

replace curly apostrophes

--- src/pc/views/blog/blue_ocean_made_of_ink.clj
+++ src/pc/views/blog/blue_ocean_made_of_ink.clj
@@ -9,13 +9,13 @@
     [:article
      [:p "Following our unexpected "
          [:a {:href "/blog/product-hunt-wake-up-call"} "Product Hunt launch"]
-         ", we’ve been receiving a lot of feedback.
-         When it’s positive I’m inspired, and when it’s critical I’m motivated.
-         We’ve even received encouragement from founders of more popular prototyping tools.
+         ", we've been receiving a lot of feedback.
+         When it's positive I'm inspired, and when it's critical I'm motivated.
+         We've even received encouragement from founders of more popular prototyping tools.
          This type of praise often brings up the question, \"Aren't they competition?\""]]

     [:article
-     [:blockquote "Our true competition is not the small trickle of non-Tesla electric cars being produced, but rather the enormous flood of gasoline cars pouring out of the world’s factories every day."]]
+     [:blockquote "Our true competition is not the small trickle of non-Tesla electric cars being produced, but rather the enormous flood of gasoline cars pouring out of the world's factories every day."]]

     [:article
      [:p "Elon Musk wrote that on "
@@ -26,7 +26,7 @@

     [:article
      [:h3 "How do we compete with paper?"]
-     [:p "I don’t handwrite letters, I won't pay bills with checks, and I never unfold maps to get around.
+     [:p "I don't handwrite letters, I won't pay bills with checks, and I never unfold maps to get around.
          So why is pen and paper still so ingrained in the prototyping process?
          In my experience prototyping designs on paper is often based on a desire for more discipline—and this is where Precursor will compete.
          The inherent discipline with pen and paper makes it simple, efficient, and accessible."]]
@@ -43,10 +43,10 @@
     [:article
      [:h3 "Efficiency—almost there."]
      [:p "This could be pen and paper's greatest strength.
-         I’ve always returned to paper after finding that other prototyping tools are too slow.
-         By contrast, I've been using Precursor in my normal workflow for months and I can’t remember when I last reached for a pen.
-         I save time that’s better spent polishing designs in production.
-         I’m close to eliminating pen and paper from my own process entirely."]]
+         I've always returned to paper after finding that other prototyping tools are too slow.
+         By contrast, I've been using Precursor in my normal workflow for months and I can't remember when I last reached for a pen.
+         I save time that's better spent polishing designs in production.
+         I'm close to eliminating pen and paper from my own process entirely."]]

     [:article
      [:h3 "Accessibility—done."]


[Fixes: #11545] Don't update browser if nil

Fixes: #11545
Fixes: #11544

The two issues were caused by the same bug, essentially if
`navigation-state-changed` event was fired (it's debounced) when the tab
had been closed, the browser would be updated with a `nil` id, causing
all sort of issues as it had not history etc.

This commit ensures that no changes are made if the browser is nil.

Signed-off-by: Churikova Tetiana <df59d4ef10565572befc1f25db27f19bd387b29a@gmail.com>

--- src/status_im/browser/core.cljs
+++ src/status_im/browser/core.cljs
@@ -189,12 +189,13 @@
   [cofx browser url]
   (let [history-index (:history-index browser)
         history       (:history browser)]
-    (let [new-history (conj (subvec history 0 (inc history-index)) url)
-          new-index   (dec (count new-history))]
-      (update-browser cofx
-                      (assoc browser
-                             :history new-history
-                             :history-index new-index)))))
+    (when history
+      (let [new-history (conj (subvec history 0 (inc history-index)) url)
+            new-index   (dec (count new-history))]
+        (update-browser cofx
+                        (assoc browser
+                               :history new-history
+                               :history-index new-index))))))

 (defmulti storage-gateway :namespace)

@@ -251,7 +252,7 @@
   (let [browser (get-current-browser (:db cofx))
         options (get-in cofx [:db :browser/options])
         current-url (:url options)]
-    (when (and (not (string/blank? url)) (not= "about:blank" url) (not= current-url url) (not= (str current-url "/") url))
+    (when (and browser (not (string/blank? url)) (not= "about:blank" url) (not= current-url url) (not= (str current-url "/") url))
       (let [resolved-ens (first (filter (fn [v]
                                           (not= (.indexOf ^js url (second v)) -1))
                                         (:resolved-ens options)))
@@ -266,7 +267,7 @@
 (fx/defn update-browser-name
   [cofx title]
   (let [browser (get-current-browser (:db cofx))]
-    (when (and (not (:dapp? browser)) title (not (string/blank? title)))
+    (when (and browser (not (:dapp? browser)) title (not (string/blank? title)))
       (update-browser cofx (assoc browser :name title)))))

 (fx/defn navigation-state-changed
@@ -515,4 +516,4 @@
   {:events [:browser.ui/open-empty-tab]}
   [cofx]
   (debounce/clear :browser/navigation-state-changed)
-  (navigation/navigate-to-cofx cofx :empty-tab nil))+  (navigation/navigate-to-cofx cofx :empty-tab nil))


numbers label clickable

numbers label clickable

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -266,8 +266,9 @@
                     #js {:className "move-count"}
                     (str (inc tick) \/ move-count))

-                  (dom/label nil "show numbers?")
+                  (dom/label #js {:htmlFor "show-nums"} "show numbers?")
                   (dom/input #js {
+                    :id       "show-nums"
                     :type     "checkbox"
                     :checked  show-nums
                     :onChange #(om/update! app :show-nums (not show-nums))})


take all candidate lexemes, not just first

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -90,7 +90,7 @@
                               (if (= false (get-in parent [:head :phrasal] false))
                                 (let [candidate-lexemes (get-lex parent :head index spec)]
                                   (over/overh parent
-                                              (map copy (take 1 (lazy-shuffle candidate-lexemes)))))))
+                                              (map copy (lazy-shuffle candidate-lexemes))))))
                             parents))
               phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
               (if (< depth max-total-depth)


Add appropriate warning to binding ns

Add appropriate warning to binding ns

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -1,5 +1,9 @@
 (ns caesium.binding
-  "Bindings to libsodium, using jnr-ffi."
+  "**DANGER** These are the low-level bindings to libsodium, using
+  jnr-ffi. They are probably not what you want; instead, please look at
+  the [[caesium.crypto.box]], [[caesium.crypto.secretbox]],
+  [[caesium.crypto.generichash]], [[caesium.crypto.sign]]  et cetera,
+  namespaces."
   (:require [clojure.string :as s])
   (:import [jnr.ffi LibraryLoader]
            [jnr.ffi.annotations In Out Pinned LongLong]


(PDB-4839) Remove schema public from partition lookup

We don't prefix tables with their schema in any other query with its
schema, so we just assume that the PuppetDB tables (if you have tables
of the same name in a different schema) show up first in your schema
`search_path`. Omitting the prefix means we'll look for partitions of
the first 'reports' or 'resource_events' tables that we find on that
path.

--- src/puppetlabs/puppetdb/scf/partitioning.clj
+++ src/puppetlabs/puppetdb/scf/partitioning.clj
@@ -13,14 +13,13 @@
 (defn get-partition-names
   "Return all partition names given the parent table name"
   [table]
-  (let [inhparent (str "public." table)]
     (->> ["SELECT inhrelid::regclass AS child
             FROM pg_catalog.pg_inherits
             WHERE inhparent = ?::regclass;"
-          inhparent]
+          table]
          jdbc/query-to-vec
          (map :child)
-         (map #(.toString %)))))
+         (map str)))

 (defn get-temporal-partitions
   "Returns a vector of {:table full-table-name :part partition-key}


simplify square component should update test

--- src/chessground/ui.cljs
+++ src/chessground/ui.cljs
@@ -86,16 +86,16 @@
      :shouldComponentUpdate
      (fn [next-props _]
        (this-as this
-                (or (not (== (-> this .-props (aget "selected")) (aget next-props "selected")))
-                    (not (== (-> this .-props (aget "move-dest")) (aget next-props "move-dest")))
-                    (not (== (-> this .-props (aget "premove-dest")) (aget next-props "premove-dest")))
-                    (not (== (-> this .-props (aget "check")) (aget next-props "check")))
-                    (not (== (-> this .-props (aget "last-move")) (aget next-props "last-move")))
-                    (not (== (-> this .-props (aget "current-premove")) (aget next-props "current-premove")))
-                    (not (== (-> this .-props (aget "orientation")) (aget next-props "orientation")))
-                    (not (== (-> this .-props (aget "hover")) (aget next-props "hover")))
-                    (not (== (piece-hash (-> this .-props (aget "piece")))
-                             (piece-hash (aget next-props "piece")))))))
+                (not (and (== (-> this .-props (aget "selected")) (aget next-props "selected"))
+                          (== (-> this .-props (aget "move-dest")) (aget next-props "move-dest"))
+                          (== (-> this .-props (aget "premove-dest")) (aget next-props "premove-dest"))
+                          (== (-> this .-props (aget "check")) (aget next-props "check"))
+                          (== (-> this .-props (aget "last-move")) (aget next-props "last-move"))
+                          (== (-> this .-props (aget "current-premove")) (aget next-props "current-premove"))
+                          (== (-> this .-props (aget "orientation")) (aget next-props "orientation"))
+                          (== (-> this .-props (aget "hover")) (aget next-props "hover"))
+                          (== (piece-hash (-> this .-props (aget "piece")))
+                              (piece-hash (aget next-props "piece")))))))
      :componentDidMount
      (fn []
        (this-as this


fix cljs-1198

fix cljs-1198


KTO-235: Poistettu deprekoitu include_type_name

--- clj-elasticsearch/src/clj_elasticsearch/elastic_connect.clj
+++ clj-elasticsearch/src/clj_elasticsearch/elastic_connect.clj
@@ -30,7 +30,7 @@
   ([index settings mappings]
    (let [json (cond-> {:settings settings}
                       (seq (keys mappings)) (merge {:mappings mappings}))]
-     (elastic-put (elastic-url index) json {:include_type_name false})))
+     (elastic-put (elastic-url index) json)))
   ([index settings]
    (create-index index settings nil)))


Add a test for secretbox-nmr with explicit nonce

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -152,3 +152,11 @@

     (let [scheme (fn [ptext] (ms/secretbox-nmr ptext st/secret-key))]
       (is (not (repeated-keystream? scheme))))))
+
+(deftest secretbox-nmr-with-explicit-nonce-test
+  (let [ctext (ms/secretbox-nmr st/ptext (byte-array 24) st/secret-key)]
+    (is-valid-magicnonce-ctext? ctext))
+
+  (let [scheme (fn [ptext]
+                 (ms/secretbox-nmr ptext (byte-array 24) st/secret-key))]
+    (is (not (repeated-keystream? scheme)))))


Improve synth nonce tests

Improve synth nonce tests

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -4,7 +4,8 @@
             [caesium.crypto.secretbox-test :as st]
             [clojure.test :refer [deftest is]]
             [caesium.randombytes :as r]
-            [caesium.util :as u]))
+            [caesium.util :as u]
+            [caesium.crypto.generichash :as g]))

 (deftest xor-test
   (let [one (byte-array [1 0 1])
@@ -88,12 +89,21 @@
       (is (= (range s/noncebytes) (take s/noncebytes c1) (take s/noncebytes c2))))))

 (deftest synthetic-nonce-test
-  (is (= (alength ^bytes (#'ms/synthetic-nonce (byte-array (range 10))))
-         (s/noncebytes)))
-  (is (= (#'ms/synthetic-nonce (byte-array (range 10)))
-         (#'ms/synthetic-nonce (byte-array (range 10)))))
-  (is (not= (#'ms/synthetic-nonce (byte-array (range 10)))
-            (#'ms/synthetic-nonce (byte-array (range 11))))))
+  (is (= (alength ^bytes @#'ms/synthetic-personal)
+         g/blake2b-personalbytes))
+  (let [k1 (byte-array (reverse (range 32)))
+        k2 (byte-array (reverse (range 32 64)))
+        sn #'ms/synthetic-nonce
+        m1 (byte-array (range 10))
+        m2 (byte-array (range 10 20))]
+    (is (= s/noncebytes
+           (alength ^bytes (sn k1 m1))
+           (alength ^bytes (sn k1 m2))
+           (alength ^bytes (sn k2 m1))
+           (alength ^bytes (sn k2 m2))))
+    (is (u/array-eq (sn k1 m1) (sn k1 m1)))
+    (is (not (u/array-eq (sn k1 m1) (sn k1 m2))))
+    (is (not (u/array-eq (sn k1 m1) (sn k2 m1))))))

 (defn repeated-keystream?
   "Does given scheme repeat the keystream when applied to given


Simplified implementation of add-icons and introduced remove-icons

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/gui/util.clj
+++ src/conexp/gui/util.clj
@@ -10,14 +10,14 @@
   (:import [javax.swing JFrame JMenuBar JMenu JMenuItem Box JToolBar JPanel
 	                JButton ImageIcon JSeparator JTabbedPane JSplitPane
 	                JLabel JTextArea JScrollPane SwingUtilities BorderFactory
-	                AbstractButton]
+	                AbstractButton SwingConstants]
 	   [javax.imageio ImageIO]
 	   [java.awt GridLayout BorderLayout Dimension Image Font Color
 	             Graphics Graphics2D BasicStroke FlowLayout]
 	   [java.awt.event KeyEvent ActionListener MouseAdapter MouseEvent]
 	   [java.io File])
   (:use [conexp.base :only (defvar first-non-nil)]
-	[clojure.contrib.seq :only (indexed)]
+	[clojure.contrib.seq :only (indexed partition-by)]
 	clojure.contrib.swing-utils))

@@ -99,8 +99,9 @@
       menu)))

 (defn add-menus
-  "Adds the additional menus to the frame in front of the first Box.Filler
-  found in the menu-bar of frame."
+  "Adds the menus (specified as hash-maps) to the frame in front of
+  the first Box.Filler found in the menu-bar of frame. Returns the
+  menus added."
   [frame menus]
   (let [our-menus (map #(hash-map->menu frame %) menus)]
     (do-swing-and-wait
@@ -114,7 +115,7 @@
     our-menus))

 (defn remove-menus
-  "Removes given menus from menu-bar of frame."
+  "Removes given menus (as Java objects) from menu-bar of frame."
   [frame menus]
   (do-swing-and-wait
    (let [menu-bar (get-menubar frame),
@@ -140,7 +141,7 @@
   [frame]
   (get-component frame #(= (class %) JToolBar)))

-(defvar *default-icon* (get-resource "images/default.jpg")
+(defvar *default-icon-image* (get-resource "images/default.jpg")
   "Default icon image used when no other image is found.")
 (defvar *icon-size* 17
   "Default icon size.")
@@ -148,38 +149,62 @@
 (defn- make-icon
   "Converts hash representing an icon to an actual JButton."
   [frame icon-hash]
-  (let [button (JButton.)]
-    (doto button
-      (.setName (:name icon-hash))
-      (add-handler frame (:handler icon-hash))
-      (.setToolTipText (:name icon-hash)))
-    (let [icon (:icon icon-hash)
-	  image (-> (ImageIO/read (if (and icon (.exists (File. icon)))
-				    (File. icon)
-				    *default-icon*))
-		    (.getScaledInstance *icon-size*
-					*icon-size*
-					Image/SCALE_SMOOTH))]
+  (if (empty? icon-hash)
+    (javax.swing.JToolBar$Separator.)
+    (let [button (JButton.)]
+      (doto button
+	(.setName (:name icon-hash))
+	(add-handler frame (:handler icon-hash))
+	(.setToolTipText (:name icon-hash)))
+      (let [icon (:icon icon-hash)
+	    image (-> (ImageIO/read (if (and icon (.exists (File. icon)))
+				      (File. icon)
+				      *default-icon-image*))
+		      (.getScaledInstance *icon-size*
+					  *icon-size*
+					  Image/SCALE_SMOOTH))]
 	(.setIcon button (ImageIcon. image)))
-    button))
-
-(defn- add-to-toolbar
-  "Adds given icons to toolbar of given frame."
-  [frame toolbar icons]
-  (doseq [icon icons]
-    (cond
-      (empty? icon)
-      (.addSeparator toolbar)
-      :else
-      (.add toolbar (make-icon frame icon))))
-  toolbar)
+      button)))
+
+(defn- collapse-separators
+  "Given a sequence of Java objects returns a sequence of the same
+  objects where adjacent Separators are collapsed into one."
+  [objects]
+  (let [partitioned-objects (partition-by class objects)]
+    (apply concat (map #(if (instance? javax.swing.JSeparator (first %))
+			  (list (first %))
+			  %)
+		       partitioned-objects))))

 (defn add-icons
-  "Adds icons to toolbar of frame."
+  "Adds icons (sepcified as hash-maps) to toolbar of frame, returning
+  added icons."
   [frame icons]
-  (do-swing
-   (add-to-toolbar frame (get-toolbar frame) icons)
-   (.validate frame)))
+  (let [our-icons (map #(make-icon frame %) icons)]
+    (do-swing-and-wait
+     (let [toolbar (get-toolbar frame),
+	   new-icons (collapse-separators (concat (.getComponents toolbar)
+						  our-icons))]
+       (.removeAll toolbar)
+       (doseq [icon new-icons]
+	 (.add toolbar icon))
+       (.validate frame)))
+    our-icons))
+
+(defn remove-icons
+  "Removes icons (as Java objects) from toolbar of frame. The
+  resulting toolbar in frame will have no two equal icons side by
+  side."
+  [frame icons]
+  (do-swing-and-wait
+   (let [toolbar (get-toolbar frame),
+	 rem-icons (collapse-separators (remove (set icons) (seq (.getComponents toolbar))))]
+     (.removeAll toolbar)
+     (doseq [icon rem-icons]
+       (.add toolbar icon))
+     (.validate frame))))
+
+;; toolbar shortcut variables for convenience

 (defvar | {}
   "Separator for icons in toolbars used in add-icons.")


update docs

update docs


reads from model

reads from model

--- src/ops_layout/core.clj
+++ src/ops_layout/core.clj
@@ -4,8 +4,14 @@
             [hiccup.core :as h]
             [org.httpkit.server :as hk]))

+(def boxes ["/1" "/2"])
+
+(defn draw-box [url]
+  (h/html [:iframe {:src url}]))
+
 (defroutes app
-  (GET "/" [] (h/html [:h1 "Hello, Fatass!"]))
+  (GET "/:number" [number] (h/html [:h1 {:class "number"} number]))
+  (GET "/" []  (map draw-box boxes))
   (route/not-found (h/html [:h1 "Dumbass"])))

 (defonce server (atom nil))


Some cleanup and comments

Some cleanup and comments

--- src/deltalog/mr.clj
+++ src/deltalog/mr.clj
@@ -11,15 +11,18 @@

 (defn make-fields [& fields] (Fields. (into-array fields)))

-(def source-scheme (TextLine. (make-fields "line")))
-(def in-tap (Hfs. source-scheme "example/input.json"))
+; This creates a tap that will read a text file line-by-line.
+; The resultant field will be named "line".
+(def in-tap (Hfs. (TextLine. (make-fields "line")) "example/input.json"))
+
+; This creates a JSON parser that will extract the "name" and "email"
+; from a JSON object. The resultant fields will be named "name" and "email".
+(def splitter (JSONSplitter. (make-fields "name" "email") (into-array ["name" "email"])))
+
 (def out-tap (Hfs. (TextLine.) "example/output" true))

-(def splitter (JSONSplitter. (make-fields "name" "email") (into-array ["name" "email"])))
+(defn -main []
+  (let [parent-pipe (Pipe. "json_split")
+        splitter-pipe (Each. parent-pipe splitter)]

-(defn -main []
-  (let [pipe1 (Pipe. "json_flatten")
-        pipe2 (Each. pipe1 (make-fields "line") splitter (make-fields "name" "email"))
-        flow-connector (HadoopFlowConnector.)]
-
-  (.complete (.connect flow-connector in-tap out-tap pipe2))))
+    (.complete (.connect (HadoopFlowConnector.) in-tap out-tap splitter-pipe))))


Add draft GET /documents/:id route

Add draft GET /documents/:id route

--- src/datemo/routes.clj
+++ src/datemo/routes.clj
@@ -40,6 +40,10 @@
 (defn edn->clj [edn]
   (edn/read-string {:readers *data-readers*} (prn-str edn)))

+(defn get-doc [eid]
+  (let [doc-tx (d/pull (d/db conn) '[*] eid)
+        doc-html (tx->html doc-tx)]))
+
 (defn post-doc [doc-string]
  (let [tx (-> (html->tx doc-string) (add-tempid) (edn->clj))
        [eid db-after] (save-arb-tx tx)


(PE-30068) Log certnames that are revoked

Previously, when a cert was revoked the certname was not logged. This
caused problems keeping track of what certnames were revoked. Prior to
the bulk API existing, customers had been largely able to review
revocation activity based on puppetserver-access.log. This new logging
effectively restores prior log functionality.

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -1339,9 +1339,10 @@
         new-crl (utils/revoke-multiple original-crl ca-private-key
                                        ca-public-key serials)]
     (write-crl new-crl cacrl)
-    (log/debug (if (= 1 serial-count)
-                 (i18n/trs "Revoked 1 certificate.")
-                 (i18n/trs "Revoked {0} certificates." serial-count)))))
+    (log/info (i18n/trsn "Revoked 1 certificate: {1}"
+                         "Revoked {0} certificates: {1}"
+                         serial-count
+                         (str/join ", " subjects)))))

 (schema/defn ^:always-validate set-certificate-status!
   "Sign or revoke the certificate for the given subject."


(PE-3868) validate-master! takes single arg

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -351,30 +351,32 @@
     * match the hostname specified in the HTTP request (the `subject` parameter)
     * not contain any non-printable characters or slashes
     * not contain the wildcard character (*)"
-  [hostname :- schema/Str
-   subject :- schema/Str]
-  (when-not (= hostname subject)
-    (sling/throw+
-      {:type    :hostname-mismatch
-       :message (str "Instance name \"" subject
-                     "\" does not match requested key \"" hostname "\"")}))
-
-  (when (contains-uppercase? hostname)
-    (sling/throw+
-      {:type    :invalid-subject-name
-       :message "Certificate names must be lower case."}))
-
-  (when-not (re-matches #"\A[ -.0-~]+\Z" subject)
-    (sling/throw+
-      {:type    :invalid-subject-name
-       :message "Subject contains unprintable or non-ASCII characters"}))
-
-  (when (.contains subject "*")
-    (sling/throw+
-      {:type    :invalid-subject-name
-       :message (format
-                  "Subject contains a wildcard, which is not allowed: %s"
-                  subject)})))
+  ([hostname :- schema/Str]
+   (validate-subject! hostname hostname))
+  ([hostname :- schema/Str
+    subject :- schema/Str]
+   (when-not (= hostname subject)
+     (sling/throw+
+       {:type    :hostname-mismatch
+        :message (str "Instance name \"" subject
+                      "\" does not match requested key \"" hostname "\"")}))
+
+   (when (contains-uppercase? hostname)
+     (sling/throw+
+       {:type    :invalid-subject-name
+        :message "Certificate names must be lower case."}))
+
+   (when-not (re-matches #"\A[ -.0-~]+\Z" subject)
+     (sling/throw+
+       {:type    :invalid-subject-name
+        :message "Subject contains unprintable or non-ASCII characters"}))
+
+   (when (.contains subject "*")
+     (sling/throw+
+       {:type    :invalid-subject-name
+        :message (format
+                   "Subject contains a wildcard, which is not allowed: %s"
+                   subject)}))))

 (schema/defn allowed-extension?
   "A predicate that answers if an extension is allowed or not.
@@ -456,7 +458,7 @@
                            :digital-signature} true)
                        (utils/subject-key-identifier
                          master-public-key false)]]
-    (validate-subject! master-certname master-certname)
+    (validate-subject! master-certname)
     (when alt-names-ext
           (validate-dns-alt-names! alt-names-ext))
     (when csr-attr-exts


Removed port trying to investigate not starting on heroku

--- src/findash/web.clj
+++ src/findash/web.clj
@@ -82,4 +82,4 @@
 (defn start
   [port create-new-data-sub-fn]
   (socket/init! create-new-data-sub-fn)
-  (httpkit/run-server app {:port port}))
+  (httpkit/run-server app))


avoid calling lightning-bolt twice

avoid calling lightning-bolt twice

--- src/babel/forest.clj
+++ src/babel/forest.clj
@@ -116,10 +116,10 @@
         debug (if (not (empty? candidate-parents))
                 (log/debug (str "candidate-parents: " (string/join "," (map #(get-in % [:rule])
                                                                             candidate-parents)))))]
-
-
+    ;; TODO: remove or parameterize this hard-coded value.
     (if (> depth 5)
       (throw (Exception. (str "DEPTH IS GREATER THAN 5; HOW DID YOU END UP IN THIS TERRIBLE SITUATION? LOOK AT THE STACK. I'M OUTTA HERE."))))
+
     (if (seq candidate-parents)
       (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
             (mapcat (fn [parent]
@@ -148,30 +148,18 @@
                     candidate-parents)

             ;; TODO: throw exception if (get-in parent [:head]) is null.
-
-            phrasal-children-candidates
+            phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
+            ;; recursively call lightning-bolt with (+ 1 depth).
             (if (< depth maxdepth)
-              (lightning-bolt grammar lexicon
-                              (get-in parent [:head])
-                              (+ 1 depth)
-                              index parent morph)
-              (log/debug (str "not trying to add phrases as child because depth is greater than maxdepth:" maxdepth)))
-
-            debug (if (empty? phrasal-children-candidates)
-                    (log/warn (str "no phrasal-children-candidates: candidates were:"
-                                   (string/join ","
-                                                (map #(get-in % [:rule]) candidate-parents)))))
-
-             phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
-             ;; recursively call lightning-bolt with (+ 1 depth).
-             (if (< depth maxdepth)
-               (mapcat (fn [parent]
+              (mapcat (fn [parent]
                         (log/debug (str "calling over/overh with parent: " (get-in parent [:rule])))
                         (let [phrasal-children
                               (lightning-bolt grammar lexicon
                                               (get-in parent [:head])
                                               (+ 1 depth)
-                                              index parent morph)]
+                                              index parent morph)
+                              phrasal-children phrasal-children
+                              ]
                           (log/debug (str "calling overh with parent: [" (get-in parent [:rule]) "]" "'" (morph parent) "'"
                                           " and children: "
                                           (if phrasal-children
@@ -183,6 +171,11 @@
                                                        "'" (wrapped-morph morph child) "'"
                                                        ))
                                                 phrasal-children))))
+                          (if (empty? phrasal-children)
+                            (let [message (str "no phrasal children for for parent: " (morph parent) "(rule=" (get-in parent [:rule]) ")" )]
+                              (log/warn message)
+                              (if false (throw (Exception. message)))))
+
                           (over/overh parent phrasal-children morph)))
                        candidate-parents))]
         (if (= (rand-int 2) 0)


do not save serialized expressions or lexemes: should improve write-performance to DB

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -165,8 +165,8 @@
     (exec-raw [(let [insert
                      (str "INSERT INTO " table
                           "(surface, structure, spec, "
-                          " serialized, language, model)"
-                          " VALUES (?,?::jsonb,?::jsonb,?,?,?)")]
+                          " language, model)"
+                          " VALUES (?,?::jsonb,?::jsonb,?,?)")]
                  (log/trace (str "INSERT IS : " insert))
                  insert)
                [surface
@@ -178,7 +178,6 @@
                     (dissoc :dag_unify.core/serialized)
                     strip-refs
                     json/write-str)
-                (-> expression serialize vec str)
                 language model-name]])
     (catch Exception e
       (log/error (str "SQL error: " (.printStackTrace (.getNextException(.getSQLException e))))))))
@@ -191,11 +190,10 @@
       (throw (Exception. message)))
     ;; else, lexeme is valid for insertion
     (exec-raw [(str "INSERT INTO lexeme
-                                 (canonical, structure, serialized, language)
-                          VALUES (?,?::jsonb,?,?)")
+                                 (canonical, structure, language)
+                          VALUES (?,?::jsonb,?)")
                [canonical
-                (json/write-str (strip-refs lexeme))
-                (-> lexeme serialize vec str)
+                (json/write-str (dissoc (strip-refs lexeme) :dag_unify.core/serialized))
                 language]])))

 ;; TODO: change all calls to populate-with-language to set source-language if needed


Add sample loader

Add sample loader

--- src/webcv/api.cljs
+++ src/webcv/api.cljs
@@ -10,6 +10,7 @@
             [webcv.envelope :as envelope]
             [webcv.metronome :as metronome]
             [webcv.sequencer :as sequencer]
+            [webcv.sampler :as sampler]
             [webcv.ctx-ctrls :as ctrls]
             [webcv.components :as components]))

@@ -50,19 +51,42 @@
 (def metro metronome/metro)
 (def sequencer sequencer/sequencer)

+(def sampler sampler/sampler)
+
 (def audio-ctx-ctrl ctrls/audio-controls)
 (def midi-ctx-ctrl ctrls/midi-controls)

 (def slider components/slider)

+(defn make-renderer [actx-atom mctx-atom buffer-cache-atom]
+  (fn [synthdef]
+    (let [ctx (merge @actx-atom @mctx-atom {::sampler/buffer-cache @buffer-cache-atom})]
+      (make-synth ctx synthdef))))
+
+(defn sample-loader [actx buffer-cache]
+  (let [filename (ratom "")]
+    (fn []
+      [:div
+       [:input {:on-change (partial reset! filename)}]
+       [:button
+        {:on-click (fn []
+                     (let [fn @filename]
+                       (sampler/load-sample @actx fn #(swap! buffer-cache assoc fn %))))}
+        "load"]
+       [:ul
+        (for [[name buffer] @buffer-cache]
+          [:li name])]])))
+
 (def init-forms
   ["(defonce audio-ctx (ratom nil))"
    "(defonce midi-ctx (ratom nil))"
-   "(defn render [synthdef]"
-   "  (make-synth (merge @audio-ctx @midi-ctx) synthdef))"
+   "(defonce buffer-cache (ratom {}))"
+   "(def render (make-renderer audio-ctx midi-ctx buffer-cache))"
+   ""
    "[:div"
    "  [audio-ctx-ctrl audio-ctx]"
-   "  [midi-ctx-ctrl midi-ctx]]"])
+   "  [midi-ctx-ctrl midi-ctx]"
+   "  [sample-loader audio-ctx buffer-cache]]"])

 (def init-text
   (string/join "\n" init-forms))


Some decoding stuff

Some decoding stuff

--- src/icecap/rest.clj
+++ src/icecap/rest.clj
@@ -1,6 +1,7 @@
 (ns icecap.rest
   "The REST API for icecap."
   (:require [compojure.core :refer [defroutes context GET POST DELETE]]
+            [icecap.codec :refer [safebase64-decode]]
             [prone.middleware :refer [wrap-exceptions]]
             [ring.middleware.defaults :refer [wrap-defaults api-defaults secure-api-defaults]]
             [ring.middleware.format :refer [wrap-restful-format]]
@@ -9,9 +10,10 @@
 (defroutes routes
   (context "/v0/caps" []
            (POST "/" [] "POST")
-           (context "/:cap-id" [cap-id]
-                    (GET "/" [] "GET")
-                    (DELETE "/" [] "DELETE"))))
+           (context "/:enc-cap-id" [enc-cap-id]
+                    (let [cap-id (safebase64-decode enc-cap-id)]
+                      (GET "/" [] "GET")
+                      (DELETE "/" [] "DELETE")))))

 (defn ^:private wrap-components
   "Adds some components to each request map."


Don't accidentally load the JS emitter

Don't accidentally load the JS emitter

--- src/cljs/go/core.clj
+++ src/cljs/go/core.clj
@@ -37,7 +37,7 @@
                             if-some when-some])
   (:require clojure.walk
             clojure.set
-            cljs.compiler
+            cljs.go.compiler
             [cljs.env :as env]))

 (alias 'core 'clojure.core)


Update link to config params doc

Update link to config params doc

--- modules/reitit-swagger-ui/src/reitit/swagger_ui.cljc
+++ modules/reitit-swagger-ui/src/reitit/swagger_ui.cljc
@@ -14,7 +14,7 @@
      | :path            | optional path to mount the handler to. Works only if mounted outside of a router.
      | :config          | parameters passed to swaggger-ui as-is.

-     See https://github.com/swagger-api/swagger-ui/tree/2.x#parameters
+     See https://github.com/swagger-api/swagger-ui/blob/master/docs/usage/configuration.md
      for all available :config options

      Examples:


(SERVER-882) Refactor valid-static-file-path-test to avoid doseq

This test previously used a doseq, which can be difficult to debug. This
commit refactors the test to instead build up a map to compare to a
known-good map, which should be easier to debug.

--- test/unit/puppetlabs/services/master/master_core_test.clj
+++ test/unit/puppetlabs/services/master/master_core_test.clj
@@ -199,27 +199,47 @@
                        "bogus"}])})))))))

 (deftest valid-static-file-path-test
-    (let [valid-paths ["modules/foo/files/bar.txt"
-                       "modules/foo/files/bar/"
-                       "modules/foo/files/bar/baz.txt"
-                       "environments/production/modules/foo/files/bar.txt"
-                       "environments/production/modules/foo/files/..conf..d../..bar..txt.."
-                       "environments/test/modules/foo/files/bar/baz.txt"
-                       "environments/dev/modules/foo/files/path/to/file/something.txt"]
-          invalid-paths ["modules/foo/manifests/bar.pp"
-                         "manifests/site.pp"
-                         "environments/foo/bar/files"
-                         "environments/../manifests/files/site.pp"
-                         "environments/../modules/foo/lib/puppet/parser/functions/site.rb"
-                         "environments/production/files/~/.bash_profile"
-                         "environments/../modules/foo/files/site.pp"
-                         "environments/production/modules/foo/files/../../../../../../site.pp"]]
-      (testing "valid requests return true"
-        (doseq [path valid-paths]
-          (is (not (nil? (valid-static-file-path? path))))))
-      (testing "invalid requests return false"
-        (doseq [path invalid-paths]
-          (is (nil? (valid-static-file-path? path)))))))
+  (let [expected-path-results {:valid #{"modules/foo/files/bar.txt"
+                                        "modules/foo/files/bar/"
+                                        "modules/foo/files/bar/baz.txt"
+                                        "environments/production/modules/foo/files/bar.txt"
+                                        "environments/production/modules/foo/files/..conf..d../..bar..txt.."
+                                        "environments/test/modules/foo/files/bar/baz.txt"
+                                        "environments/dev/modules/foo/files/path/to/file/something.txt"}
+                               :invalid #{"modules/foo/manifests/bar.pp"
+                                          "manifests/site.pp"
+                                          "environments/foo/bar/files"
+                                          "environments/../manifests/files/site.pp"
+                                          "environments/../modules/foo/lib/puppet/parser/functions/site.rb"
+                                          "environments/production/files/~/.bash_profile"
+                                          "environments/../modules/foo/files/site.pp"
+                                          "environments/production/modules/foo/files/../../../../../../site.pp"}}
+        paths ["modules/foo/files/bar.txt"
+               "modules/foo/files/bar/"
+               "modules/foo/files/bar/baz.txt"
+               "environments/production/modules/foo/files/bar.txt"
+               "environments/production/modules/foo/files/..conf..d../..bar..txt.."
+               "environments/test/modules/foo/files/bar/baz.txt"
+               "environments/dev/modules/foo/files/path/to/file/something.txt"
+               "modules/foo/manifests/bar.pp"
+               "manifests/site.pp"
+               "environments/foo/bar/files"
+               "environments/../manifests/files/site.pp"
+               "environments/../modules/foo/lib/puppet/parser/functions/site.rb"
+               "environments/production/files/~/.bash_profile"
+               "environments/../modules/foo/files/site.pp"
+               "environments/production/modules/foo/files/../../../../../../site.pp"]
+        actual-results (loop
+         [results {:valid #{}
+                   :invalid #{}}
+          remaining-paths paths]
+          (if-let [cur-path (first remaining-paths)]
+            (if (valid-static-file-path? cur-path)
+              (recur (assoc results :valid (conj (:valid results) cur-path)) (rest remaining-paths))
+              (recur (assoc results :invalid (conj (:invalid results) cur-path)) (rest remaining-paths)))
+            results))]
+    (testing "Only files in 'modules/*/files/**' or 'environments/*/modules/*/files/**' are valid"
+      (is (= actual-results expected-path-results)))))

 (deftest file-bucket-file-content-type-test
   (testing (str "The 'Content-Type' header on incoming /file_bucket_file requests "


add scroll to function to nag's bkg

add scroll to function to nag's bkg

--- frontend/components/landing_b.cljs
+++ frontend/components/landing_b.cljs
@@ -23,9 +23,11 @@
 (defn mount-header-logo-scroll [owner]
   (let [logo (om/get-node owner "center-logo")
         cta (om/get-node owner "cta")
+        nav-bkg (om/get-node owner "nav-bkg")
         scroll-callback #(do
                            (om/set-state! owner [:header-logo-visible] (neg? (.-bottom (.getBoundingClientRect logo))))
-                           (om/set-state! owner [:header-cta-visible] (neg? (.-bottom (.getBoundingClientRect cta)))))]
+                           (om/set-state! owner [:header-cta-visible] (neg? (.-bottom (.getBoundingClientRect cta))))
+                           (om/set-state! owner [:header-bkg-visible] (< (.-bottom (.getBoundingClientRect nav-bkg)) 70)))]
     (om/set-state! owner [:browser-resize-key]
                    (goog.events/listen
                     (sel1 (om/get-shared owner [:target]) ".app-main")
@@ -39,6 +41,7 @@
     (init-state [_]
       {:header-logo-visible false
        :header-cta-visible false
+       :header-bkg-visible false
        :scroll-ch (chan (sliding-buffer 1))})
     om/IRenderState
     (render-state [_ state]
@@ -47,12 +50,13 @@
         (html [:div.home.page
                [:nav.home-nav {:class (concat
                                        (when (:header-logo-visible state) ["logo-visible"])
-                                       (when (:header-cta-visible state) ["cta-visible"]))}
+                                       (when (:header-cta-visible state) ["cta-visible"])
+                                       (when (:header-bkg-visible state) ["bkg-visible"]))}
                 [:a.promo "What is Continuous Integration?"]
                 [:a.login "Log In"]
                 (om/build drawings/logo-circleci app)
                 [:a.action "Sign Up Free"]]
-               [:section.home-prolog
+               [:section.home-prolog {:ref "nav-bkg"}
                 [:a.home-action {:role "button"
                                  :ref "cta"}
                  "Sign Up Free"]


Dedupe API calls

Dedupe API calls

--- test-cljs/frontend/test_send.cljs
+++ test-cljs/frontend/test_send.cljs
@@ -360,6 +360,17 @@
    (fn [context ast]
      (resolve* (assoc context :user/name (:user/name (:params ast))) User (:children ast)))})

+(defn memoize-cb [f]
+  (let [mem (atom {})]
+    (fn [& args]
+      (let [mem-args (butlast args)
+            cb (last args)]
+        (if-let [e (find @mem mem-args)]
+          (cb (val e))
+          (apply f (concat mem-args
+                           [#(do
+                               (swap! mem assoc mem-args %)
+                               (cb %))])))))))

 (deftest new-thing-works
   (async done
@@ -370,9 +381,10 @@
                                               :user/favorite-fellow-user-name "jburnford"}
                    {:user/name "jburnford"} {:user/favorite-color :color/red
                                              :user/favorite-number 7}}
-            c (resolve {:apis {:get-user (fn [params cb]
-                                           (swap! api-calls conj [:get-user params])
-                                           (cb (get users params)))}}
+            c (resolve {:apis {:get-user (memoize-cb
+                                          (fn [params cb]
+                                            (swap! api-calls conj [:get-user params])
+                                            (cb (get users params))))}}
                        Root '[{(:root/user {:user/name "nipponfarm"})
                                [:user/name
                                 :user/favorite-color
@@ -390,9 +402,6 @@
                [(<! c)
                 (<! c)]))
         (is (= [[:get-user {:user/name "nipponfarm"}]
-                [:get-user {:user/name "nipponfarm"}]
-                [:get-user {:user/name "nipponfarm"}]
-                [:get-user {:user/name "jburnford"}]
-                [:get-user {:user/name "jburnford"}]])
-            @api-calls)
+                [:get-user {:user/name "jburnford"}]]
+               @api-calls))
         (done)))))


Clean code

Clean code

Delete unused collision detection

--- src/mrunner/core.cljs
+++ src/mrunner/core.cljs
@@ -91,18 +91,6 @@
     (update state :obstacles
             (fn [obstacles]
               (filter #(> (:pos-x %) (- pos-x (:width %))) obstacles)))))
-
-(defn in-segment? [x p0 p1]
-  (and (<= x p1) (<= p0 x)))
-
-(defn in-square? [x0 y0 x y w h]
-  (and (in-segment? x0 x (+ x w))
-       (in-segment? y0 y (+ y h))))
-
-(defn square-intersect?-bad [x0 y0 w0 h0
-                         x1 y1 w1 h1]
-  (or (in-square? x0 y0 x1 y1 w1 h1)
-      (in-square? x1 y1 x0 y0 w0 h0)))

 (defn square-intersect? [x0 y0 w0 h0
                          x1 y1 w1 h1]


fixing one messed up merge

fixing one messed up merge

--- test/lcmap/clownfish/specifications_test.clj
+++ test/lcmap/clownfish/specifications_test.clj
@@ -1,60 +1,252 @@
 (ns lcmap.clownfish.specifications-test
   "Tests from the end user's view"
-  (:require [clojure.java.io :as io]
+  (:require [clj-time.core :as time]
+            [clj-time.coerce :as tc]
+            [clojure.java.io :as io]
             [clojure.test :refer :all]
             [clojure.tools.logging :as log]
             [cheshire.core :as json]
+            [langohr.basic :as lb]
             ;; have to require server to include server state
             ;; otherwise it will never be started
+            [lcmap.clownfish.configuration :refer [config]]
+            [lcmap.clownfish.event :as event :refer [amqp-channel]]
             [lcmap.clownfish.server :as server]
             [lcmap.clownfish.shared :refer [with-system req]]))

+(def json-header {"Accept" "application/json"
+                  "Content-Type" "application/json"})
+
+;; low level clients for resources
+(defn upsert-algorithm
+  [http-host {:keys [algorithm enabled inputs_url_template] :as all}]
+  (req :put (str http-host "/algorithm/" algorithm)
+       :body (json/encode all)
+       :headers json-header))
+
+(defn get-algorithm
+  [http-host algorithm]
+  (req :get (str http-host "/algorithm/" algorithm)))
+
+(defn get-algorithms
+  [http-host]
+  (req :get (str http-host "/algorithms")))
+
+(defn get-results
+  "Retrieves results/tickets from lcmap-changes"
+  [http-host {:keys [algorithm x y]}]
+  (log/spy :trace (req :get (str http-host "/results/" algorithm "/" x "/" y))))
+
+;; test code
 (deftest changes-health-resource
   (with-system
     (testing "health check"
-      (let [resp (log/spy (req :get (str http-host "/health")
-                               :headers {"Accept" "*/*"}))]
+      (let [resp (log/spy :trace (req :get (str http-host "/health")
+                                      :headers {"Accept" "*/*"}))]
         (is (= 200 (:status resp)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test algorithm(s) resource ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (deftest algorithms
   (with-system
     (testing "no algorithms defined"
-      (let [resp (log/spy (req :get (str http-host "/algorithms")
-                               :headers {"Accept" "application/json"}))
+      (let [resp (log/spy :trace (req :get (str http-host "/algorithms")
+                                      :headers {"Accept" "application/json"}))
             body (json/decode (:body resp))]
         (is (= 200 (:status resp)))
         (is (= 0 (count body)))
         (is (coll? body))))

-    (testing "add algorithm - bad input_url_template"
-      (let [body    {:enabled true
-                     :blah-inputs_url_template "http://host:port/context"}
-            headers {"Accept" "application/json"
-                     "Content-Type" "application/json"}
-            resp (req :put (str http-host "/algorithm/bad-input-url")
-                      :body (json/encode body)
-                      :headers headers)]
-        ()))
-
-    (testing "add good algorithms"
-      (let [resp (req :get (str http-host "/algorithms"))]
-        ()))
-
-    (testing "update algorithm"
-      (let [resp (req :get (str http-host "/algorithms"))]
-        ()))
+    (testing "add algorithm - bad bodies"
+        (doseq [body [{:enabled true :bad-inputs_url_template "http://host"}
+                      {:not-enabled true :inputs_url_template "http://host"}
+                      {:enabled "string" :inputs_url_template "http://host"}]]
+            (let [response (req :put (str http-host "/algorithm/bad")
+                                :body (json/encode body)
+                                :headers json-header)
+                  status (:status response)]
+                (is (= 403 status)))))
+
+    (testing "add good algorithm"
+      (let [body   {:algorithm "good"
+                    :enabled false
+                    :inputs_url_template "http://host"}
+            resp   (upsert-algorithm http-host body)]
+          (is (= 202 (:status resp)))))
+
+    (testing "update algorithm")
+    (let [body {:algorithm "good"
+                :enabled true
+                :inputs_url_template "http://anotherhost"}
+          resp (upsert-algorithm http-host body)]
+        (is (= 202 (:status resp))))

     (testing "get algorithm"
-      (let [resp (req :get (str http-host "/algorithm/test-alg-1"))]
-        ()))
+      (let [resp     (get-algorithm http-host "good")
+            expected {:algorithm "good"
+                      :enabled true
+                      :inputs_url_template "http://anotherhost"}]
+        (is (= 200 (:status resp)))
+        (is (= (json/decode (:body resp) true) expected))))

     (testing "get algorithms"
-      (let [resp (req :get (str http-host "/algorithms"))]
-        ()))))
+      (let [resp   (get-algorithms http-host)
+            expected [{:algorithm "good"
+                       :enabled true
+                       :inputs_url_template "http://anotherhost"}]]
+       (is (= 200 (:status resp)))
+       (is (= (json/decode (:body resp) true) expected))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test results resource ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def timestamp-regex  "\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}(\\.\\d{3})?Z")
+(def test-url-template "http://host/{{algorithm}}/{{x}}/{{y}}/{{now}}")
+
+(defn test-url-regex
+  "build regex for expected url"
+  [ticket]
+  (str "http://host/" (:algorithm ticket)
+       "/" (:x ticket)
+       "/" (:y ticket)
+       "/" timestamp-regex))
+
+(def ignored-keys [:tile_update_requested :tile_update_began :tile_update_ended
+                   :inputs_url :result_produced])
+
+(defn results-ok?
+  "Compares two results (or tickets) minus inputs_url, tile_update_requested and
+   result_produced which are non-deterministic due to timestamp information"
+  [expected actual]
+  (= (log/spy :trace (apply dissoc expected ignored-keys))
+     (log/spy :trace (apply dissoc actual ignored-keys))))
+
+(defn inputs-url-ok?
+  "Determine if inputs_url conforms to expected structure after having
+   been populated with template values by lcmap-changes"
+  [ticket]
+  (re-matches (re-pattern (test-url-regex ticket)) (:inputs_url ticket)))
+
+(defn date-timestamp?
+  "Determines if a val is a datetimestamp that conforms to expected structure"
+  [ts]
+  (re-matches (re-pattern timestamp-regex) ts))

 (deftest results
   (with-system
-    (testing "run non-existent algorithm")
-    (testing "schedule existing algorithm")
-    (testing "schedule same algorithm, get ticket")
-    (testing "retrieve algorithm results once available")))
+    ;; put a good alg in the system
+    (upsert-algorithm http-host {:algorithm "test-alg"
+                                 :enabled true
+                                 :inputs_url_template test-url-template})
+
+    (testing "schedule non-existent algorithm"
+      (let [body {:algorithm "does-not-exist" :x 123 :y 456}
+            resp (get-results http-host body)]
+        ;; should return unprocessable entity, HTTP 422
+        (is (= 422 (:status resp)))))
+
+    (testing "schedule existing algorithm, no results exist"
+      (let [body       {:algorithm "test-alg" :x 123 :y 456}
+            resp       (get-results http-host body)
+            ticket     (json/decode (:body resp) true)
+            expected   {:tile_x -585
+                        :tile_y 2805
+                        :x 123
+                        :y 456
+                        :tile_update_requested "{{now}} can't be determined"
+                        :algorithm "test-alg"
+                        :inputs_url "{{now}} can't be determined"
+                        :refresh false
+                        :algorithm-available true
+                        :source-data-available true}]
+        (is (= 202 (:status resp)))
+        (is (date-timestamp? (:tile_update_requested ticket)))
+        (is (inputs-url-ok? ticket))
+        (is (results-ok? expected ticket))))
+
+    (testing "schedule same algorithm, get ticket"
+      (let [body     {:algorithm "test-alg" :x 123 :y 456}
+            resp     (get-results http-host body)
+            ticket   (json/decode (:body resp) true)
+            expected {:tile_x -585
+                      :tile_y 2805
+                      :x 123
+                      :y 456
+                      :result_ok nil
+                      :algorithm "test-alg"
+                      :inputs_url "{{now}} can't be determined"
+                      :refresh false
+                      :algorithm-available true
+                      :inputs_md5 nil
+                      :source-data-available true
+                      :result nil
+                      :tile_update_requested "{{now}} can't be determined"
+                      :tile_update_began nil
+                      :tile_update_ended nil
+                      :result_produced nil
+                      :result_md5 nil}]
+        (is (= 202 (:status resp)))
+        (is (date-timestamp? (:tile_update_requested ticket)))
+        (is (inputs-url-ok? ticket))
+        (is (results-ok? expected ticket))))
+
+    (testing "consume ticket from rabbitmq, send change-detection-response"
+      (let [[metadata payload] (lb/get amqp-channel "unit.lcmap.changes.worker")
+            body (event/decode-message metadata payload)
+            expected {:tile_x -585
+                      :tile_y 2805
+                      :algorithm "test-alg"
+                      :x 123
+                      :y 456
+                      :tile_update_requested "{{now}} can't be determined"
+                      :inputs_url "{{now}} can't be determined"}]
+        (is (date-timestamp? (:tile_update_requested body)))
+        (is (inputs-url-ok? body))
+        (is (results-ok? expected body))
+        ;; send response to server exchange to mock up results.  The
+        ;; change results should wind up in the db
+        (lb/publish amqp-channel
+                    "unit.lcmap.changes.worker"
+                    "change-detection-result"
+                    (->> {:inputs_md5 (digest/md5 "dummy inputs")
+                          :result "some test results"
+                          :result_md5 (digest/md5 "some test results")
+                          :result_produced (tc/to-string (time/now))
+                          :result_ok true}
+                         (merge body)
+                         (json/encode))
+                    {:content-type "application/json" :persistent true})
+        ;; sleep this for just a bit so the server has time to consume and
+        ;; persist the message we just sent.
+        (Thread/sleep 5)))
+
+    (testing "retrieve algorithm results once available"
+      (let [body     {:algorithm "test-alg" :x 123 :y 456}
+            resp     (get-results http-host body)
+            result   (json/decode (:body resp) true)
+            expected {:tile_x -585
+                      :tile_y 2805
+                      :algorithm "test-alg"
+                      :x 123
+                      :y 456
+                      :refresh false
+                      :tile_update_requested "{{now}} can't be determined"
+                      :tile_update_began "{{now}} can't be determined"
+                      :tile_update_ended "{{now}} can't be determined"
+                      :inputs_url "{{now}} can't be determined"
+                      :inputs_md5 (digest/md5 "dummy inputs")
+                      :result "some test results"
+                      :result_md5 (digest/md5 "some test results")
+                      :result_produced "{{now}} can't be determined"
+                      :result_ok true}]
+        (is (= 200 (:status resp)))
+        (is (date-timestamp? (:tile_update_requested result)))
+        (is (date-timestamp? (:result_produced result)))
+        (is (results-ok? expected result))
+        (is (= (set (keys expected))
+               (set (keys result))))))
+
+    (testing "reschedule algorithm when results already exist")))


Wrong var name

Wrong var name

--- test/onyx/log/round_robin_multi_job_test.clj
+++ test/onyx/log/round_robin_multi_job_test.clj
@@ -10,11 +10,11 @@

 (def config (read-string (slurp (clojure.java.io/resource "test-config.edn"))))

-(def env-config (assoc (:env-config config) :onyx/id id))
+(def env-config (assoc (:env-config config) :onyx/id onyx-id))

 (def peer-config
   (assoc (:peer-config config)
-    :onyx/id id
+    :onyx/id onyx-id
     :onyx.peer/job-scheduler :onyx.job-scheduler/round-robin))

 (def env (onyx.api/start-env env-config))


(PDB-908) Improve debugging info of in-process launched PDB

This patch dynamically creates a temp logback and temp log file that an
in-process launched PuppetDB instances uses. Previously when an error
occurred in that Jetty instance, it was difficult to determine the
problem. Sometimes errors were lost, others were difficult to sort
through since it wrote to the same System.err that the test thread was
running in. This patch writes all in-process PuppetDB log information to
an actually file, which is scraped and dumped into the test thread's
console, make it much easier to diagnose errors

--- test/puppetlabs/puppetdb/testutils/jetty.clj
+++ test/puppetlabs/puppetdb/testutils/jetty.clj
@@ -1,5 +1,5 @@
 (ns puppetlabs.puppetdb.testutils.jetty
-  (:require [puppetlabs.puppetdb.testutils :refer [temp-dir]]
+  (:require [puppetlabs.puppetdb.testutils :refer [temp-dir temp-file]]
             [puppetlabs.puppetdb.fixtures :as fixt]
             [puppetlabs.trapperkeeper.app :as tka]
             [puppetlabs.trapperkeeper.testutils.bootstrap :as tkbs]
@@ -12,14 +12,35 @@
             [puppetlabs.puppetdb.utils :as utils]
             [clj-http.client :as client]
             [puppetlabs.puppetdb.config :as conf]
-            [clj-http.util :refer [url-encode]]))
+            [clj-http.util :refer [url-encode]]
+            [clj-http.client :as client]
+            [clojure.string :as str]
+            [fs.core :as fs]))

 ;; See utils.clj for more information about base-urls.
 (def ^:dynamic *base-url* nil) ; Will not have a :version.

+(defn log-config
+  "Returns a logback.xml string with the specified `log-file` and `log-level`."
+  [log-file log-level]
+  (str "<configuration>
+
+  <appender name=\"FILE\" class=\"ch.qos.logback.core.FileAppender\">
+    <file>" log-file "</file>
+    <append>true</append>
+    <encoder>
+      <pattern>%-4relative [%thread] %-5level %logger{35} - %msg%n</pattern>
+    </encoder>
+  </appender>
+
+  <root level=\"" log-level "\">
+    <appender-ref ref=\"FILE\" />
+  </root>
+</configuration>"))
+
 (defn create-config
   "Creates a default config, populated with a temporary vardir and
-   a fresh hypersql instance"
+  a fresh hypersql instance"
   []
   {:nrepl {}
    :global {:vardir (temp-dir)}
@@ -29,10 +50,19 @@
    :web-router-service {:puppetlabs.puppetdb.cli.services/puppetdb-service ""
                         :puppetlabs.puppetdb.metrics/metrics-service "/metrics"}})

+(defn assoc-logging-config
+  "Adds a dynamically created logback.xml with a test log. The
+  generated log file name is returned for printing to the console."
+  [config]
+  (let [logback-file (fs/absolute-path (temp-file "logback" ".xml"))
+        log-file (fs/absolute-path (temp-file "jett-test" ".log"))]
+    (spit logback-file (log-config log-file "ERROR"))
+    [log-file (assoc-in config [:global :logging-config] logback-file)]))
+
 (defn current-port
   "Given a trapperkeeper server, return the port of the running jetty instance.
-   Note there can be more than one port (i.e. SSL + non-SSL connector). This only
-   returns the first one."
+  Note there can be more than one port (i.e. SSL + non-SSL connector). This only
+  returns the first one."
   [server]
   (-> @(tka/app-context server)
       (get-in [:WebserverService :jetty9-servers :default :server])
@@ -44,22 +74,33 @@

 (defn puppetdb-instance
   "Stands up a puppetdb instance with `config`, tears down once `f` returns.
-   Adjusts *server* and *base-url* to refer to the instance."
+  `services` is a seq of additional services that should be started in addition
+  to the core PuppetDB services. Binds *server* and *base-url* to refer to
+  the instance."
   ([f] (puppetdb-instance (create-config) f))
-  ([config f]
-   (let [config (conf/adjust-tk-config config)
+  ([config f] (puppetdb-instance config [] f))
+  ([config services f]
+   (let [[log-file config] (-> config conf/adjust-tk-config assoc-logging-config)
          prefix (get-in config
                         [:web-router-service
                          :puppetlabs.puppetdb.cli.services/puppetdb-service])]
-     (tkbs/with-app-with-config server
-       [jetty9-service puppetdb-service message-listener-service command-service webrouting-service metrics-service]
-       config
-       (binding [*server* server
-                 *base-url* (merge {:protocol "http"
-                                    :host "localhost"
-                                    :port (current-port server)}
-                                   (when prefix {:prefix prefix}))]
-         (f))))))
+     (try
+       (tkbs/with-app-with-config server
+         (concat [jetty9-service puppetdb-service message-listener-service command-service webrouting-service metrics-service]
+                 services)
+         config
+         (binding [*server* server
+                   *base-url* (merge {:protocol "http"
+                                      :host "localhost"
+                                      :port (current-port server)}
+                                     (when prefix {:prefix prefix}))]
+           (f)))
+       (finally
+         (let [log-contents (slurp log-file)]
+           (when-not (str/blank? log-contents)
+             (utils/println-err "-------Begin PuppetDB Instance Log--------------------\n"
+                                log-contents
+                                "\n-------End PuppetDB Instance Log----------------------"))))))))

 (defmacro with-puppetdb-instance
   "Convenience macro to launch a puppetdb instance"


Remove pandect (no longer used)

Remove pandect (no longer used)

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -1,6 +1,5 @@
 (ns naughtmq.core
   (:require [taoensso.timbre :as log]
-            [pandect.core :as p]
             [clojure.java.io :as io])
   (:import [naughtmq PrivateLoader]
            [org.zeromq EmbeddedLibraryTools]


Add a plan

Add a plan


rm unused vars

rm unused vars

--- src/mantra/osc.cljs
+++ src/mantra/osc.cljs
@@ -29,7 +29,7 @@

    Similarly, you can supply your own chronoid clock as :clock, otherwise
    Mantra will create one for you."
-  [& {:keys [type freq gain context clock] :as osc-map}]
+  [& {:keys [type context clock] :as osc-map}]
   (let [type    (name (or type :sine))
         context (or context @s/*audio-context* (s/create-audio-context))]
     (if-not (contains? #{"sine" "square" "sawtooth" "triangle"} type)


Deprecation message for checkers in predicate arglists.

--- src/midje/fakes.clj
+++ src/midje/fakes.clj
@@ -4,10 +4,11 @@
   (:use [clojure.contrib.seq-utils :only [find-first]]
         clojure.test
         clojure.contrib.error-kit
-        [midje.util report file-position form-utils]
+        [midje.util report file-position form-utils exceptions]
+        [midje.checkers.defining :only [checker?]]
         [midje.checkers.util :only [captured-exception]]
         [midje.checkers.chatty :only [chatty-checker-falsehood? chatty-checker?]]
-        [midje.checkers.extended-equality :only [extended-= extended-list-=]])
+        [midje.checkers.extended-equality :only [extended-= extended-list-= extended-fn?]])
   (:require [clojure.zip :as zip]))

@@ -98,5 +99,18 @@
 (defn arg-matcher-maker [expected]
   "Based on an expected value, generates a function that returns true if the
    actual value matches it."
+  (when (and (extended-fn? expected)
+             (not (checker? expected))
+             (not (and (string? (:name (meta expected)))
+                       (re-find #"^\(exactly " (:name (meta expected))))))
+    (println "-----")
+    (println "-- WARNING: In this version, prerequisite arguments that are functions are")
+    (println "-- considered checkers. In the near future, they'll be considered ordinary")
+    (println "-- values. If you want them to be checkers, you need to declare them as")
+    (println "-- such. <link to doc>")
+    (println "-- The function argument I'm objecting to is:")
+    (println "--    " (attractively-stringified-form expected))
+    (println "--     in" (nth (without-clojure-strings (stacktrace-as-strings (Throwable.))) 12))
+    (println "-----"))
   (fn [actual] (extended-= actual expected)))


delete html require

delete html require

--- src/misaki/core.clj
+++ src/misaki/core.clj
@@ -6,7 +6,6 @@
     [hiccup.core :only [html]]
     [hiccup.page-helpers :only [html5 xhtml html4]])
   (:require
-    html
     conv
     [clojure.string :as str]
     [clojure.java.io :as io])


add thrush and comp-take

add thrush and comp-take

--- src/useful.clj
+++ src/useful.clj
@@ -251,6 +251,22 @@
     (if ks
       (assoc m k (apply update-in! (get m k) ks f args))
       (assoc m k (apply f (get m k) args)))))
+
+(defn thrush
+  "Takes the first argument and applies the remaining arguments to it as functions from left to right.
+   This tiny implementation was written by Chris Houser. http://blog.fogus.me/2010/09/28/thrush-in-clojure-redux"
+  [& args]
+  (reduce #(%2 %1) args))
+
+(defn comp-take
+  "Like comp, but the first n args are passed to every function. The rightmost fn is
+   applied to all arguments. Each fn is then applied left-to-right to the first n args
+   followed by the result of the previous function."
+  [n & fns]
+  (fn [& args]
+    (let [[head tail] (split-at n args)
+          f (apply comp (map #(apply partial % head) fns))]
+      (apply f tail))))

 (defn into-map
   "Convert a list of heterogeneous args into a map. Args can be alternating keys and values,


Dedup guests by party

Dedup guests by party

--- src/app/core.cljs
+++ src/app/core.cljs
@@ -177,33 +177,6 @@
             :name "New York Loft Hostel"
             :notes "249 Varet St., Brooklyn ($)"}])]]))

-(defn rsvp-search-view [{:keys [name results error] :as data} owner]
-  (reify om/IRender
-    (render [_]
-      (html
-       [:main
-        [:h2 "RSVP"]
-        [:form {:id "rsvpsearch"
-                :onSubmit #(do (.preventDefault %)
-                               (go (if (>= (count name) 3)
-                                     (do (om/update! data :error nil)
-                                         (let [guests (<! (search-guests name))]
-                                           (om/update! data :results guests)
-                                           (when (= 1 (count guests))
-                                             (select-party! owner (get-in guests [0 :party])))))
-                                     (om/update! data :error "Search query is too short!"))))}
-         [:label {:for "guestsearch"} "Enter the name on your invitation:"]
-         [:input {:type "text"
-                  :name "guestseearch"
-                  :class "guestsearch"
-                  :placeholder "e.g. Barack and Michelle Obama"
-                  :value name
-                  :ref "name"
-                  :onChange #(om/update! data :name (.-value (om/get-node owner "name")))}]
-         (when (some? error) [:div {:class "error"} error])
-         [:button {:type "submit"}
-          "Find RSVP"]]]))))
-
 (defn send-rsvps! [{:keys [party guests] :as selection} {:keys [contact food-preferences infos sent] :as response}]
   (go (try (let [[result response-or-error] (<! (parse/save Response {:party (let [p (Party.)]
                                                                                (set! (.-id p)
@@ -227,6 +200,39 @@
            [:success]
            (catch :default e
              [:error e]))))
+
+(defn unique-parties [guests]
+  (->> guests
+       (group-by #(get-in % [:party :id]))
+       (mapv (fn [[_ v]] (first v)))))
+
+(defn rsvp-search-view [{:keys [name results error] :as data} owner]
+  (reify om/IRender
+    (render [_]
+      (html
+       [:main
+        [:h2 "RSVP"]
+        [:form {:id "rsvpsearch"
+                :onSubmit #(do (.preventDefault %)
+                               (go (if (>= (count name) 3)
+                                     (do (om/update! data :error nil)
+                                         (let [guests (<! (search-guests name))
+                                               unique-guests (unique-parties guests)]
+                                           (om/update! data :results guests)
+                                           (when (= 1 (count unique-guests))
+                                             (select-party! owner (get-in unique-guests [0 :party])))))
+                                     (om/update! data :error "Search query is too short!"))))}
+         [:label {:for "guestsearch"} "Enter the name on your invitation:"]
+         [:input {:type "text"
+                  :name "guestseearch"
+                  :class "guestsearch"
+                  :placeholder "e.g. Barack and Michelle Obama"
+                  :value name
+                  :ref "name"
+                  :onChange #(om/update! data :name (.-value (om/get-node owner "name")))}]
+         (when (some? error) [:div {:class "error"} error])
+         [:button {:type "submit"}
+          "Find RSVP"]]]))))

 (defn validate-response [{:keys [guests] :as selection} {:keys [infos] :as response}]
   (when (some (fn [{:keys [id] :as guest}]
@@ -316,9 +322,7 @@
                          [:button
                           {:onClick #(select-party! owner party)}
                           "Select"]])
-                      (->> results
-                           (group-by #(get-in % [:party :id]))
-                           (map (fn [[_ v]] (first v)))))]
+                      (unique-parties results))]
         [:p "Can't find your RSVP? "
          [:a {:onClick #(do (.preventDefault %)
                             (reset-search! owner)
@@ -331,7 +335,6 @@
     [:main
      [:h1 "Thank you!"]
      (let [{:keys [guests] :as selection} (om/observe owner (selection))]
-       [:pre (with-out-str (pp/pprint @selection))]
        [:ul
         (map (fn [{:keys [id name] :as guest}]
                [:li (str name
@@ -347,18 +350,25 @@
   (reify
     om/IRender
     (render [_]
-      (let [{:keys [party] :as selection} (om/observe owner (selection))
-            {:keys [infos sent] :as response} (om/observe owner (response))]
-        (cond (true? sent)            (om/build rsvp-confirmation-view response)
-              (party-selected? owner) (om/build rsvp-card-view selection)
-              (seq results)           (om/build rsvp-multiple-results-view data)
-              :else                   (html [:main
-                                             [:h2 (str "Oops! No results found for '" name "'")]
-                                             [:p "Can't find your RSVP? "
-                                              [:a {:onClick #(do (.preventDefault %)
-                                                                 (reset-search! owner)
-                                                                 (reset-selection! owner))}
-                                               "Search again"]]]))))))
+      (html
+       (let [{:keys [party] :as selection} (om/observe owner (selection))
+             {:keys [infos sent] :as response} (om/observe owner (response))]
+         (cond (true? sent)
+               (om/build rsvp-confirmation-view response)
+
+               (party-selected? owner)
+               (om/build rsvp-card-view selection)
+
+               (seq? results)
+               (om/build rsvp-multiple-results-view data)
+
+               :else (html [:main
+                            [:h2 (str "Oops! No results found for '" name "'")]
+                            [:p "Can't find your RSVP? "
+                             [:a {:onClick #(do (.preventDefault %)
+                                                (reset-search! owner)
+                                                (reset-selection! owner))}
+                              "Search again"]]])))))))

 (defn rsvp-view [{:keys [results] :as data} owner]
   (reify om/IRender


BUG: max-collection-size not set everywhere; BUG: tagspace possibly overflowing; BUG: :snapshot stack DEFINITELY overflowing (counts at 17million items)

--- test/acceptance/push_prison.clj
+++ test/acceptance/push_prison.clj
@@ -12,7 +12,7 @@

 (defn overloaded-interpreter
   [prisoner]
-  (-> (make-everything-interpreter :config {:step-limit 20000 :lenient true}
+  (-> (make-everything-interpreter :config {:step-limit 20000 :lenient true :max-collection-size 138072}
                                    :bindings (:bindings prisoner)
                                    :program (:program prisoner))
       reset-interpreter))


add tests

add tests

--- test/cljs/fatlip/core_test.cljs
+++ test/cljs/fatlip/core_test.cljs
@@ -1,5 +1,5 @@
 (ns fatlip.core-test
-  (:require-macros [cemerick.cljs.test :refer (is deftest)])
+  (:require-macros [cemerick.cljs.test :refer (is deftest are testing)])
   (:require [cemerick.cljs.test :as test]
             [fatlip.core :as f]))

@@ -150,6 +150,175 @@
         "Measures are set correctly")))

+(deftest test-order-next-layer
+  (let [l-node-1 (f/Node. :0-0 0 [:a :b :c])
+        l-node-2 (f/Node. :0-1 0 [:d])
+        l-node-3 (f/Node. :0-2 0 [:e])
+        nl-node-1 (f/Node. :1-0 1 [:c])
+        nl-node-2 (f/Node. :1-1 1 [:b :e])
+        nl-node-3 (f/Node. :1-2 1 [:a])
+        nl-node-4 (f/Node. :1-3 1 [:d])
+        nl-node-5 (f/Node. :1-4 1 [:f :g])
+        l-seg-1 (f/SegmentContainer. [(f/Edge. "whatever" "somewhere else" [:x])])
+        l-seg-2 (f/SegmentContainer. [(f/Edge. "sup" "elsewhere" [:y])
+                                      (f/Edge. "unclear" nl-node-5 [:f :g])])
+        edge-1 (f/Edge. nl-node-1 l-node-1 [:c])
+        edge-2 (f/Edge. nl-node-2 l-node-1 [:b])
+        edge-3 (f/Edge. nl-node-2 l-node-3 [:e])
+        edge-4 (f/Edge. nl-node-3 l-node-1 [:a])
+        edge-5 (f/Edge. nl-node-4 l-node-2 [:d])
+        layer (-> (f/Layer. 0 0 [l-node-1 l-node-2 l-node-3])
+                  (assoc :positions {l-node-1 0
+                                     l-seg-1 1
+                                     l-node-2 2
+                                     l-seg-2 3
+                                     l-node-3 5}
+                         :minus-ps [l-node-1 l-seg-1 l-node-2 l-seg-2 l-node-3]))
+        next-layer (-> (f/Layer. 1 0 [])
+                       (assoc :non-qs [nl-node-1 nl-node-2 nl-node-3 nl-node-4]
+                              :measures {nl-node-1 0
+                                         nl-node-2 2.5
+                                         nl-node-3 0
+                                         nl-node-4 2}))
+        graph {:preds {nl-node-1 #{edge-1}
+                       nl-node-2 #{edge-2 edge-3}
+                       nl-node-3 #{edge-4}
+                       nl-node-4 #{edge-5}}}]
+    (is (= (f/order-next-layer layer next-layer)
+           (assoc next-layer :minus-qs [nl-node-1 nl-node-3 l-seg-1 nl-node-4 nl-node-2 l-seg-2]))
+        "Nodes and segment containers are merged correctly")))
+
+
+(deftest test-add-qs
+  (let [node-1 (f/Node. :0-0 0 [:a :b :c])
+        node-2 (f/Node. :0-1 0 [:d])
+        node-3 (f/Node. :0-2 0 [:e])
+        seg-1 (f/SegmentContainer. [(f/Edge. "whatever" "somewhere else" [:x])])
+        seg-2 (f/SegmentContainer. [(f/Edge. "sup" "elsewhere" [:y])
+                                    (f/Edge. "unclear" node-2 [:f :g])
+                                    (f/Edge. "doesn't" "matter" [:m])])
+        layer (-> (f/Layer. 0 0 [node-1 node-2 node-3])
+                  (assoc :qs #{node-2}
+                         :minus-qs [node-1 seg-1 node-3 seg-2]))]
+    (is (= (f/add-qs layer)
+           (assoc layer :ordered [node-1 seg-1 node-3
+                                  (f/SegmentContainer. [(f/Edge. "sup" "elsewhere" [:y])])
+                                  node-2
+                                  (f/SegmentContainer. [(f/Edge. "doesn't" "matter" [:m])])]))
+        "Q nodes are placed correctly, splitting the segment containers they were in")))
+
+
+(deftest test-sorted-edge-order
+  (let [node-1 (f/Node. :0-0 0 [:a :d :e])
+        node-2 (f/Node. :0-1 0 [:c :g])
+        nl-node-1 (f/Node. :1-0 1 [:a :c])
+        nl-node-2 (f/Node. :1-1 1 [:d :g])
+        nl-node-3 (f/Node. :1-1 1 [:e])
+        seg (f/SegmentContainer. [(f/Edge. "mmm" "hmm" [:b :f])])
+        ordered [node-1 seg node-2]
+        next-ordered [nl-node-1 seg nl-node-2 nl-node-3]
+        edge-1 (f/Edge. node-1 nl-node-1 [:a])
+        edge-2 (f/Edge. node-1 nl-node-2 [:d])
+        edge-3 (f/Edge. node-1 nl-node-3 [:e])
+        edge-4 (f/Edge. seg seg [:b :f])
+        edge-5 (f/Edge. node-2 nl-node-1 [:c])
+        edge-6 (f/Edge. node-2 nl-node-2 [:g])
+        edges {node-1 #{edge-1 edge-2 edge-3}
+               node-2 #{edge-5 edge-6}}]
+    (is (= (f/sorted-edge-order ordered next-ordered edges)
+           [[0 edge-1] [2 edge-2] [3 edge-3] [1 edge-4] [0 edge-5] [2 edge-6]])
+        (str "Edges between two orderings are sorted by position in "
+             "layer and then position in next layer"))))
+
+
+(deftest test-next-power-of-2
+  (testing "Finding the next highest power of 2"
+    (is (= (f/next-power-of-2 3) 4))
+    (is (= (f/next-power-of-2 4) 8))
+    (is (= (f/next-power-of-2 17) 32))
+    (is (= (f/next-power-of-2 4094) 4096))))
+
+
+(deftest test-single-edge-super-crossings
+  ;; add edge that crosses segment x
+  ;; add edge that doesn't cross segment x
+  ;; add segment that crosses edge
+  (let [graph {:marked #{}}
+        fedge (f/Edge. (f/Node. :0-3 0 [:b])
+                       (f/Node. :1-3 1 [:b])
+                       [:b])
+        edge (assoc fedge :forward-edge fedge)
+        seg (f/SegmentContainer. [(f/Edge. "mmm" "hmm" [:b :h])])
+        sedge (f/Edge. seg seg [:b :h])
+        crossed-edge (f/Edge. (f/Node. :0-2 0 [:f])
+                              (f/Node. :1-2 1 [:f])
+                              [:f])
+        tree [(f/AccumulatorNode. 2
+                                  #{(f/Edge. (f/Node. :0-0 0 [:a :d :e])
+                                             (f/Node. :1-0 1 [:a :d :e])
+                                             [:a :d :e])
+                                    (f/Edge. (f/Node. :0-1 0 [:c :g])
+                                             (f/Node. :1-1 1 [:c :g])
+                                             [:c :g])}
+                                  false)
+              (f/AccumulatorNode. 1 #{} true)
+              (f/AccumulatorNode. 1
+                                  #{crossed-edge}
+                                  false)]]
+    (is (= (f/single-edge-super-crossings graph tree 3 edge)
+           [(update-in graph [:marked] conj fedge) tree 3])
+        "Correctly sum up and mark an edge that crosses a segment")
+    (is (= (f/single-edge-super-crossings graph tree 5 edge)
+           [graph
+            (-> tree
+                (update-in [0 :node-edges] conj fedge)
+                (update-in [0 :weight] inc))
+            1])
+        "Correctly sum up and don't mark and edge that crosses a segment")
+    (is (= (f/single-edge-super-crossings graph tree 5 sedge)
+           [(update-in graph [:marked] conj crossed-edge)
+            (-> tree
+                (assoc-in [0 :is-seg-c] true)
+                (update-in [0 :weight] + 2))
+            2])
+        "Correctly sum up crossings and markings when adding a segment")))
+
+
+(deftest test-count-super-crossings
+  (let [l-node-1 (f/Node. :0-0 0 [:a :b :c])
+        l-node-2 (f/Node. :0-1 0 [:d])
+        l-node-3 (f/Node. :0-2 0 [:e])
+        nl-node-1 (f/Node. :1-0 1 [:c])
+        nl-node-2 (f/Node. :1-1 1 [:b :e])
+        nl-node-3 (f/Node. :1-2 1 [:a])
+        nl-node-4 (f/Node. :1-3 1 [:d])
+        nl-node-5 (f/Node. :1-4 1 [:f :g])
+        l-seg-1 (f/SegmentContainer. [(f/Edge. "whatever" "somewhere else" [:x])])
+        l-seg-2 (f/SegmentContainer. [(f/Edge. "sup" "elsewhere" [:y])
+                                      (f/Edge. "unclear" nl-node-5 [:f :g])])
+        fedge-1 (f/Edge. nl-node-1 l-node-1 [:c])
+        fedge-2 (f/Edge. nl-node-2 l-node-1 [:b])
+        fedge-3 (f/Edge. nl-node-2 l-node-3 [:e])
+        fedge-4 (f/Edge. nl-node-3 l-node-1 [:a])
+        fedge-5 (f/Edge. nl-node-4 l-node-2 [:d])
+        edge-1 (assoc fedge-1 :forward-edge fedge-1)
+        edge-2 (assoc fedge-2 :forward-edge fedge-2)
+        edge-3 (assoc fedge-3 :forward-edge fedge-3)
+        edge-4 (assoc fedge-4 :forward-edge fedge-4)
+        edge-5 (assoc fedge-5 :forward-edge fedge-5)
+        layer (-> (f/Layer. 0 0 [l-node-1 l-node-2 l-node-3])
+                  (assoc :minus-ps [l-node-1 l-seg-1 l-node-2 l-seg-2 l-node-3]))
+        next-layer (-> (f/Layer. 1 0 [])
+                       (assoc :minus-qs [nl-node-1 nl-node-3 l-seg-1 nl-node-4 nl-node-2 l-seg-2]))
+        graph {:preds {nl-node-1 #{edge-1}
+                       nl-node-2 #{edge-2 edge-3}
+                       nl-node-3 #{edge-4}
+                       nl-node-4 #{edge-5}}}]
+    (is (= (f/count-super-crossings graph layer next-layer)
+           [(assoc graph :marked #{fedge-2 fedge-3}) 5])
+        "Super crossings are counted correctly")))
+
+
 (deftest test-single-edge-sub-crossings
   (let [tree [2 1 1]]
     (is (= (f/single-edge-sub-crossings tree 3) [[2 1 1] 3])