Work on indexing code.

Work on indexing code.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -119,26 +119,26 @@

 ;; ## Read Functions

-(defn- assign-keys
-  "Assigns record keys to the children of this node which they would belong
-  to. Returns a sequence of vectors containing the child index and a sequence
-  of record keys, only including children which had keys assigned."
-  [index record-keys]
+(defn- assign-records
+  "Assigns records to the children of this node which they would belong
+  to. Returns a sequence of vectors containing each child link and a collection
+  of the record tuples, if any."
+  [index records]
   (loop [assignments []
          children (::children index)
          split-keys (::keys index)
-         pending-keys (sort (set record-keys))]
-    (if (seq pending-keys)
+         pending (sort-by first records)]
+    (if (seq pending)
       (if (seq split-keys)
         ; Take next batch of keys.
         (let [split (first split-keys)
-              [in after] (split-with #(key/before? % split) pending-keys)
-              assignments' (if (seq in)
-                             (conj assignments [(first children) in])
-                             assignments)]
-          (recur assignments' (next children) (next split-keys) after))
+              [in after] (split-with #(key/before? (first %) split) pending)]
+          (recur (conj assignments [(first children) (not-empty in)])
+                 (next children)
+                 (next split-keys)
+                 after))
         ; No more splits, emit one final group with remaining keys.
-        (conj assignments [(first children) pending-keys]))
+        (conj assignments [(first children) pending]))
       ; No more record keys to assign.
       assignments)))

@@ -189,10 +189,11 @@
     data-type
       (mapcat
         (fn read-child
-          [[child-link child-keys]]
-          (let [child (graph/get-link! store node child-link)]
-            (read-batch store child fields child-keys)))
-        (assign-keys node record-keys))
+          [[child-link record-keys]]
+          (when (seq record-keys)
+            (let [child (graph/get-link! store node child-link)]
+              (read-batch store child fields (map first record-keys)))))
+        (assign-records node (map vector record-keys)))

     part/data-type
       (part/read-batch store node fields record-keys)
@@ -234,160 +235,65 @@

 ;; ## Update Functions

-(defn- group-changes
-  "Divide up a sorted sequence of changes into a lazy sequence of tuples of
-  the first key in the subtree, the child link, and the associated changes, if
-  any."
-  [child-keys child-links changes]
-  (lazy-seq
-    (when (seq child-links)
-      (if (seq changes)
-        (let [next-key (first child-keys)
-              [group more-changes]
-                (if next-key
-                  (split-with #(key/before? (first %) next-key) changes)
-                  [changes nil])]
-          (cons
-            [(first child-links) (seq group)]
-            (group-changes (next child-keys)
-                           (next child-links)
-                           more-changes)))
-        ; No more changes
-        (map vector child-keys)))))
-
-
-(defn- redistribute-children
-  "... accumulates child nodes and outputs valid nodes as necessary. Input
-  values should be a vector of `[first-key link-or-candidate]`."
-  [store limit count-children merge-nodes]
-  (let [half-full (int (Math/ceil (/ limit 2)))
-        valid? #(or (mdag/link? %) (<= half-full (count-children %) limit))]
-    (fn [xf]
-      (fn
-        ([]
-         [(xf) nil nil])
-        ([[result prev curr]]
-         (cond
-           ; Current node is first in sequence.
-           (nil? prev)
-             (if curr
-               ; Output only child node.
-               (xf (xf (unreduced result) curr))
-               ; No further children to process.
-               (xf result))
-
-           ; Two valid children, output directly.
-           (valid? curr)
-             (-> (unreduced result)
-                 (xf prev)
-                 (xf curr)
-                 (xf))
-
-           ; Final child is underflowing, merge with prev.
-           :else
-             (reduce
-               xf
-               (unreduced result)
-               (merge-nodes
-                 (if (mdag/link? prev)
-                   (graph/get-link! store prev)
-                   prev)
-                 curr))))
-        ([[result prev curr] [first-key child]]
-         ; case [prev curr] input
-         ; [nil nil]
-         ; Input becomes current node unless it's an overflow, in which case it
-         ; is split into multiple conforming nodes.
-         ; TODO: might be more optimal to keep an overflowing node in curr,
-         ; but would require changes to flush above.
-         ;
-         ; [nil link]
-         ; - link => [link link]
-         ; - underflow => [link underflow]
-         ; - candidate => [link candidate]
-         ; - overflow => split nodes, output all but last two candidates
-         ;
-         ; [nil underflow]
-         ; - link => load link, merge with underflowing node
-         ; - underflow => merge with current
-         ; - candidate => redistribute with current
-         ; - overflow => redistribute with current
-         ;
-         ; [nil candidate]
-         ; - link
-         ; - underflow
-         ; - candidate
-         ; - overflow
-         ;
-         ; [link link]
-         ; - link
-         ; - underflow
-         ; - candidate
-         ; - overflow
-         ;
-         ; [link underflow]
-         ; - link
-         ; - underflow
-         ; - candidate
-         ; - overflow
-         ,,,)))))
-
-
-(defn- update-index-node
-  [store params carry [node-link changes]]
-  (if (seq changes)
-    (let [index (graph/get-link! store node-link)
-          child-changes (group-changes
-                          (::keys index)
-                          (::children index)
-                          changes)]
-      (if (= 1 (::height index))
-        ; Update children as partitions.
-        (let [children (part/update-partitions! store params child-changes)]
-          ; if carry is a virtual tablet, merge with children
-          ; if carry is a partition, add it to the front (or back?) of changes list
-          ; otherwise, not valid to have a carry here
-          (prn :update-index-partitions children)
-          (if (sequential? children)
-            (if (= 1 (count children))
-              ; Single partition to carry up the tree.
-              (first children)
-              (let [child-keys (into [] (comp (drop 1) (map ::record/first-key)) children)
-                    child-links (into [] (map #(mdag/link "part" (meta %))) children)
-                    record-count (reduce + 0 (map ::record/count children))]
-                (assoc index
-                       ::keys child-keys
-                       ::children child-links
-                       ::record/count record-count
-                       ::record/first-key (::record/first-key (first children))
-                       ::record/last-key (::record/last-key (peek children)))))
-            ; Virtual tablet, return for carrying.
-            children))
-        ; Update child index nodes.
-        (let [; if carry is an index subtree and the height is one less than
-              ; ours, adopt it as a child with no changes. Otherwise, carry it
-              ; into the update for the relevant child.
-              children (mapv #(update-index-node store params nil %) child-changes)
-              ; TODO: redistribute children
-              child-keys (into [] (comp (drop 1) (map ::record/first-key)) children)
-              record-count (reduce + 0 (map ::record/count children))]
-          (prn :update-index-children children)
-          (assoc index
-                 ::keys child-keys
-                 ::children children
-                 ::record/count record-count
-                 ::record/first-key (::record/first-key (first children))
-                 ::record/last-key (::record/last-key (peek children))))))
-    ; No changes, return unchanged node.
-    (graph/get-link! store node-link)))
-
-
-(defn- relink-children
-  "Rewrite a vector of childen into numbered links."
+(defn- numbered-child-links
+  "Write a vector of childen into numbered links."
   [children]
   (into []
         (map-indexed #(mdag/link (format "%03d" %1) %2))
         children))
+
+
+(defn- index-children
+  "Aggregates index node values from a sequence of child data."
+  [children]
+  (let [ckeys (into [] (map ::record/first-key) (rest children))
+        links (numbered-child-links children)
+        record-count (reduce + 0 (map ::record/count children))]
+    {::keys ckeys
+     ::children links
+     ::record/count record-count
+     ::record/first-key (::record/first-key (first children))
+     ::record/last-key (::record/last-key (last children))}))
+
+
+(defn- update-index-children!
+  "Apply changes to a sequence of intermediate index nodes and redistribute the
+  results to create a new sequence of valid indexes. Each input tuple should
+  have the form `[index changes]`, and `carry` may be a forward-carried index
+  subtree or partition that is **not** a direct descendant of the parent node.
+
+  Returns a sequence of updated and valid (but unpersisted) index nodes, or a
+  direct map of node data to carry forward."
+  [store params carry inputs]
+  ,,,)
+
+
+(defn- update-index-node
+  [store params carry [index changes]]
+  (if (seq changes)
+    (let [child-changes (map (juxt #(graph/get-link! store index (first %)) second)
+                             (assign-records index changes))
+          children (if (= 1 (::height index))
+                     ; Update children as partitions.
+                     (part/update-partitions! store params carry child-changes)
+                     ; Update child index nodes.
+                     (if (and (= data-type (:data/type carry))
+                              (= (dec (::height index)) (::height carry)))
+                       ; Adopt the carried index subtree by prepending it to the results.
+                       (update-index-children! store params nil (cons [carry nil] child-changes))
+                       ; No carry, or carry is not a direct child.
+                       (update-index-children! store params carry child-changes)))]
+      (if (sequential? children)
+        (if (= 1 (count children))
+          ; Orphaned child, return directly for carrying.
+          (first children)
+          ; Construct index node from partitions.
+          ; FIXME: needs to break into multiple nodes on overflow
+          [(merge index (index-children children))])
+        ; Carried node, return for further carrying.
+        children))
+    ; No changes, return unchanged node.
+    [index]))

 (defn update-tree
@@ -422,7 +328,7 @@
                   node
                   (->> (::children node)
                        (map store!)
-                       (relink-children)
+                       (numbered-child-links)
                        (assoc node ::children)
                        (mdag/store-node! store nil)
                        (::node/data))))]


Remove comment (since the previous commit proves it's not needed)

--- src/snergly/animation.cljs
+++ src/snergly/animation.cljs
@@ -48,9 +48,6 @@
   (let [prev-distances (:distances maze)
         goal (if longest? (:max-coord prev-distances) [end-row end-col])]
     (protocols/report-status ui (str "Plotting path (" (inc (:max prev-distances)) " cells long) …"))
-    ;; Figure out if it's necessary, and if so, figure out how to add the
-    ;; dedupe/only-changed transducer from algs/seq-channel onto the sequence
-    ;; of distances before associng onto the maze.
     (map #(assoc maze :path {:distances %
                              :color-family :red})
          (algs/path-seq maze prev-distances goal))))


Fixes escaping issue

Fixes escaping issue

--- src/onyx/plugin/sql.clj
+++ src/onyx/plugin/sql.clj
@@ -18,7 +18,9 @@
            [java.sql Connection]
            [java.io ByteArrayInputStream]
            [org.postgresql.jdbc PgConnection]
-           [org.postgresql.copy CopyManager]))
+           [org.postgresql.copy CopyManager]
+           [org.postgresql.util PGobject]
+           ))

 (defn create-pool [spec]
   {:datasource
@@ -135,9 +137,21 @@
 (defn- coerce-copy-row
   "Coerces a row map object into a format that's understood by the PostgreSQL COPY TEXT format."
   [cols row]
-  (let [xform-null (fn [x]
+  (let [xform-escape (fn [x]
+                       (cond
+                         (string? x)
+                         (str/escape x {\\ "\\\\"})
+
+                         (= (type x) PGobject)
+                         (str/escape (.toString (cast PGobject x)) {\\ "\\\\"})
+
+                         :esle
+                         x))
+        xform-null (fn [x]
                      (if (nil? x) "\\N" x))
+
         xform (comp xform-null
+                    xform-escape
                     jdbc/sql-value
                     #(% row))]
         (str (str/join "\t" (map xform cols)))))


require validation fns and update new entity fns

--- src/navigator.clj
+++ src/navigator.clj
@@ -7,7 +7,8 @@
             [navigator.schema :as schema]
             [hatch]
             [navigator.templates :as templates]
-            [navigator.data :as data]))
+            [navigator.data :as data]
+            [navigator.validation :refer :all]))

 ;; front end

@@ -70,24 +71,43 @@
 ;; queue functions

 (defn task-in [db-conn message]
-  (tx-entity! db-conn :task (merge {:task/id-sk (str (get-in message [:header :entity-id :task-id]))}
-                                   (hatch/slam-all (get-in message [:payload :entity]) :task))))
+  (let [task (merge {:task/id-sk (str (get-in message [:header :entity-id :task-id]))}
+                                   (hatch/slam-all (get-in message [:payload :entity]) :task))]
+    (if (valid? validate-task-in task)
+      (tx-entity! db-conn :task task)
+      false)))

 (defn comp-in [db-conn message]
-  (tx-entity! db-conn :comp (merge {:comp/id-sk (str (get-in message [:header :entity-id :comp-id]))}
-                                    (hatch/slam-all (get-in message [:payload :entity]) :comp))))
+  (let [comp (merge {:comp/id-sk (str (get-in message [:header :entity-id :comp-id]))}
+                                    (hatch/slam-all (get-in message [:payload :entity]) :comp))]
+    (if (valid? validate-comp-in comp)
+      (tx-entity! db-conn :comp comp)
+      false)))

 (defn comp-tag-in [db-conn message]
-  (tx-entity! db-conn :comp-tag (hatch/slam-all (get-in message [:payload :entity]) :comp-tag)))
+  (let [comp-tag (hatch/slam-all (get-in message [:payload :entity]) :comp-tag)]
+    (if (valid? validate-comp-tag-in comp-tag)
+      (tx-entity! db-conn :comp-tag comp-tag)
+      false)))

 (defn perf-asmt-in [db-conn message]
-  (tx-entity! db-conn :perf-asmt (merge {:perf-asmt/id-sk (str (get-in message [:header :entity-id :perf-asmt-id]))}
-                                         (hatch/slam-all (get-in message [:paylod :entity]) :perf-asmt))))
+  (let [perf-asmt (merge {:perf-asmt/id-sk (str (get-in message [:header :entity-id :perf-asmt-id]))}
+                                         (hatch/slam-all (get-in message [:paylod :entity]) :perf-asmt))]
+    (if (valid? validate-perf-asmt-in perf-asmt)
+      (tx-entity! db-conn :perf-asmt perf-asmt)
+      false)))
+
 (defn user2comp-in [db-conn message]
-  (tx-entity! db-conn :user2comp (hatch/slam-all (get-in message [:payload :entity]) :user2comp)))
+  (let [user2comp (hatch/slam-all (get-in message [:payload :entity]) :user2comp)]
+    (if (valid? validate-user2comp-in user2comp)
+      (tx-entity! db-conn :user2comp user2comp)
+      false)))

 (defn user2perf-asmt-in [db-conn message]
-  (tx-entity! db-conn :user2perf-asmt (hatch/slam-all (get-in message [:payload :entity]) :user2perf-asmt)))
+  (let [user2perf-asmt (hatch/slam-all (get-in message [:payload :entity]) :user2perf-asmt)]
+    (if (valid? validate-user2perf-asmt-in user2perf-asmt)
+      (tx-entity! db-conn :user2perf-asmt user2perf-asmt)
+      false)))

 (comment


tidy up speech ns: make non-public vars private and add docstring

--- src/overtone/speech.clj
+++ src/overtone/speech.clj
@@ -6,9 +6,9 @@
     [overtone.helpers.system :only (get-os)]
     [overtone.helpers.lib :only (uuid)]))

-(def SPEECH-DIR (:speech OVERTONE-DIRS))
+(def ^:private SPEECH-DIR (:speech OVERTONE-DIRS))

-(def VOICES
+(def ^:private VOICES
   {:agnes "Agnes"
    :kathy "Kathy"
    :princess "Princess"
@@ -39,10 +39,9 @@
    :pipe-organ "Pipe Organ"        ; awesome ;-)
    })

+(defmulti ^:private say (fn [& args] (get-os)))

-(defmulti say (fn [& args] (get-os)))
-
-(defmethod say :mac
+(defmethod ^:private say :mac
   [text {:keys [voice]
          :or {voice :vicki}
          :as options}]
@@ -52,6 +51,18 @@
     out-file))

 (defn speech-buffer
+  "Takes a string and returns an audio buffer with containing that text
+  read by one of the available voices defaulting to vicki.
+
+  (speech-buffer \"a nice cup of tea, please\" :voice :alex)
+
+  Voices to choose from are
+  :agnes, :kathy, :princess, :vicki, :victoria, :bruce, :fred, :junior,
+  :ralph, :alex, :albert, :zarvox, :trinoids, :whisper, :bahh, :boing,
+  :bubbles, :bad-news, :good-news, :deranged, :hysterical, :bells,
+  :cellos, :pipe-organ.
+
+  Currently available on OS X only."
   [text & {:as options}]
   (let [file (say text options)]
     (sample file)))


Use unison in defining the major scale to make it easier to define other scales.

--- src/overtunes/pitch.clj
+++ src/overtunes/pitch.clj
@@ -1,10 +1,11 @@
 (ns overtunes.pitch
   (:use
     [clojure.set :only [difference]]
-    [overtone.live :exclude [scale octave sharp flat sixth]]
+    [overtone.live :exclude [scale octave sharp flat sixth unison]]
     [overtone.inst.sampled-piano :only [sampled-piano]]))

 ; Basic intervals
+(def unison 0)
 (def semitone 1)
 (def tone (* semitone 2))
 (def octave (* 12 semitone))
@@ -46,13 +47,13 @@
 ; but they aren't needed at present.
 (defn scale
   "Define a scale as a cumulative sum of intervals."
-  ([] '(0))
+  ([] [])
   ([interval & intervals]
-   (cons 0 (map #(+ interval %) (apply scale intervals)))))
+   (cons interval (map #(+ interval %) (apply scale intervals)))))

 (def major-scale (zipmap
                    [:i :ii :iii :iv :v :vi :vii :viii]
-                   (scale tone tone semitone tone tone tone semitone)))
+                   (scale unison tone tone semitone tone tone tone semitone)))

 ; Name notes
 (defall [C D E F G A B]


RS | Refactoring routes.clj requires

RS | Refactoring routes.clj requires

--- src/stonecutter/routes.clj
+++ src/stonecutter/routes.clj
@@ -1,8 +1,8 @@
 (ns stonecutter.routes
-  (:require [scenic.routes :refer [load-routes-from-file]]
-            [bidi.bidi :refer [path-for]]))
+  (:require [scenic.routes :as scenic]
+            [bidi.bidi :as bidi]))

-(def routes (load-routes-from-file "routes.txt"))
+(def routes (scenic/load-routes-from-file "routes.txt"))

 (defn path [action & params]
-  (apply path-for routes action params))
+  (apply bidi/path-for routes action params))


scope pomegranate output in boot/env

scope pomegranate output in boot/env

--- src/tailrecursion/boot.clj
+++ src/tailrecursion/boot.clj
@@ -22,8 +22,7 @@
   (atom {:boot {:dependencies #{}
                 :directories #{}
                 :repositories #{}
-                ;; stores Pomegranate output (full deps listing)
-                :installed #{}}}))
+                {:pomegranate {:installed #{}}}}}))

 (def ^:dynamic *default-repositories*
   #{"http://repo1.maven.org/maven2/"
@@ -38,7 +37,7 @@
     (swap! env (partial merge-with into)
            {:boot {:dependencies deps
                    :repositories repos
-                   :installed installed}})))
+                   {:pomegranate {:installed installed}}}})))

 (defn add [dirs]
   (when (seq dirs)


[cortex/dataset] map-sequence->dataset docstring improvement. (#70)

--- cortex/src/cortex/dataset.clj
+++ cortex/src/cortex/dataset.clj
@@ -343,13 +343,15 @@
               [item-key (map #(get % item-key) seq-of-maps)]))
        (into {})))

-
 (defn map-sequence->dataset
-  "Given sequences of maps (one of them infinite for training
-and the number of elements in an epoch construct an infinite dataset.
-Uses m/ecount to divine the shape from the first item in the infinite sequence.
-If a cross-validation sequence is not provided one will be created.  IF a holdout
-sequence is not create one with be created from the original infinite sequence."
+  "Turns an infinite training sequence of observation maps (and optionally
+  sequences of cv and holdout observation maps) into a dataset. The caller also
+  must provide the number of observations processed per epoch.
+
+  Uses m/ecount to divine a shape from the first item in the infinite sequence.
+
+  If a cross-validation sequence is not provided one will be created. If a
+  holdout sequence is not provided it will be created similarly."
   [infinite-map-seq num-epoch-elements & {:keys [cv-map-seq holdout-map-seq
                                                  use-cv-for-holdout? shutdown-fn]
                                           :or {use-cv-for-holdout? true}}]


starting to add other node types to xml parsing

--- src/rapscallion/xml.clj
+++ src/rapscallion/xml.clj
@@ -1,7 +1,8 @@
 (ns rapscallion.xml
-  (:require (clojure [xml :as xml])
-            (clojure.java [io :as io]))
-  (:use (yoodls [pipe :only [pipe pipe-map]]))
+  (:require (clojure [xml :as xml]
+                     [string :as  string])
+            (clojure.java [io :as io])
+            (yoodls [pipe :as pipe]))
   (:import [java.io Writer Reader StringReader]
            [java.util.concurrent LinkedBlockingQueue]
            [org.xml.sax Attributes InputSource]
@@ -21,9 +22,9 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Records
-
-(declare emit-element)
+;; Records for XML node types
+
+(declare emit-element emit-comment emit-cdata emit-pi)

 (defrecord Element [tag attrs content]

@@ -36,6 +37,21 @@
   (emit-xml [this out]
     (emit-element this out))
   )
+
+(defrecord Comment [^String text]
+  XMLWritable
+  (emit-xml [this out]
+    (emit-comment this out)))
+
+(defrecord CData [^String text]
+  XMLWritable
+  (emit-xml [this out]
+    (emit-cdata this out)))
+
+(defrecord PI [^String target ^String text]
+  XMLWritable
+  (emit-xml [this out]
+    (emit-pi this out)))

 (defn element
@@ -52,12 +68,14 @@
 ;;; Alias for the Element class
 (def element-type Element)

-
-
 (defn- elementize
-  "This is used to turn a tree of "
+  "This is used to turn a tree of element-like maps into a tree of
+  Element instances."
+  ;; TODO - is this still used anywhere?
   [e]
-  (if (and (map? e) (:tag e))
+  (if (and (not (element? e))
+           (map? e)
+           (:tag e))
     (Element.
      (:tag e)
      (:attrs e)
@@ -65,6 +83,7 @@
     e))

+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utilities

@@ -76,17 +95,6 @@

 (defn merge-attrs [elt new-attrs]
   (assoc elt :attrs (merge (:attrs elt) new-attrs))) ;TODO - skip nils
-
-(defn dissoc-in [m ks]
-  (let [k (last ks)
-        ks (butlast ks)]
-    (if ks
-      (if-let [mm (get-in m ks)]
-        (assoc-in m ks (dissoc mm k))
-        m)
-      (if k
-        (dissoc m k)
-        m))))

 (defn dissoc-attr [elt & attrs]
   (assoc elt :attrs (apply dissoc (:attrs elt) attrs)))
@@ -111,6 +119,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Parsing XML

+(defn parse-error [& messages]
+  (throw (RuntimeException. (apply str messages))))

 ;; swiped from data.xml:
 (defn attrs->map[^Attributes atts]
@@ -173,18 +183,18 @@

 (defprotocol AsInputSource
-  (input-source [this] "Wrap this object as an instance of org.xml.sax.InputSource"))
+  (as-input-source [this] "Wrap this object as an instance of org.xml.sax.InputSource"))

 (extend-protocol AsInputSource
   String
-  (input-source [s]
+  (as-input-source [s]
     (let [^Reader r (if (.startsWith s "<") ;; too "clever"? ... <shrug>
                       (StringReader. s)
                       (io/reader s))]
       (InputSource. r)))

   Object
-  (input-source [o]
+  (as-input-source [o]
     (InputSource. (io/reader o))))

@@ -192,9 +202,9 @@
   "Given a source of XML, returns a sequence of events, in the form of
   vectors. See xml-handler."
   [in]
-  (let [^InputSource in (input-source in)
+  (let [^InputSource in (as-input-source in)
         parser  (XMLReaderFactory/createXMLReader)
-        [put events] (pipe)
+        [put events] (pipe/pipe)
         handler (xml-handler put)]
     (.setContentHandler parser handler)
     (.setProperty parser "http://xml.org/sax/properties/lexical-handler" handler)
@@ -210,12 +220,14 @@
     events))

 ;;; Transformations of event streams
+(defn throw-if-error [[type ex :as evt]]
+  (if (= :error type)
+    (throw ex)
+    evt))
+
 (defn throw-on-error [events]
-  (map (fn [[type ex :as evt]]
-         (if (= :error type)
-           (throw ex)
-           evt))
-       events))
+  (map throw-if-error events))
+

 (defn merge-text
   "Transform the event stream so that adjacent bits of text are
@@ -233,6 +245,12 @@
          (apply concat))))

+(defn skip-whitespace [events]
+  (remove (fn [[type s :as evt]]
+            (and (= type :text)
+                 (string/blank? s)))
+          events))
+
 (defn ignore
   "Filters out events of the given types."
   [events & event-types]
@@ -241,7 +259,7 @@
     (remove ignorable? events)))

-(defn to-nodes
+(defn events->nodes
   "Returns a 2-element vector containing:
    1) A seq of sibling nodes extracted from the event stream, and
    2) A seq of the unconsumed events.
@@ -252,7 +270,7 @@
     (case type
       :start-element
       (let [[_ tag attrs] evt
-            [children events] (to-nodes events)]
+            [children events] (events->nodes events)]
         (recur events
                (conj xml (Element. tag attrs children))))

@@ -264,19 +282,29 @@

       )))

-
-
-(defn parse [in]
-  (-> in
+(defn make-tree [events]
+  (let [[[root & nodes] events] (events->nodes events)]
+    (when (seq events)
+      (parse-error "Unconsumed SAX events: " events))
+    (when nodes
+      (parse-error "Content after root element: " nodes))
+    root))
+
+(defn parse [source & [opts]]
+  (-> source
       sax-seq
       throw-on-error
       merge-text
-      (ignore :start-cdata :end-cdata)
-      (ignore :start-prefix-mapping :end-prefix-mapping)
-      (ignore :comment)
-      to-nodes
-      ffirst
+      skip-whitespace
+      (ignore
+       :processing-instruction
+       :start-cdata :end-cdata
+       :start-prefix-mapping :end-prefix-mapping
+       :comment)
+      make-tree
       ))
+
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Emitting XML
@@ -284,14 +312,19 @@
 (defn ^String xml-escape [^String s]
   (-> s
       (.replaceAll "&"  "&")
-      (.replaceAll "<"  "<")
-      ))
+      (.replaceAll "<"  "<")))

 (defn ^String xml-escape-attr [^String s]
   (-> s
       xml-escape
-      (.replaceAll "'"  "'")
-      ))
+      (.replaceAll "'"  "'")))
+
+(defn ^String xml-escape-comment [^String s]
+  ;; Comment text can't contain -->
+  (-> s
+      xml-escape
+      (.replaceAll "-->" "-->")))
+

 (defn emit-element [^Element e ^Writer out]
   (let [{:keys [tag attrs content]} e]
@@ -317,6 +350,33 @@
           (.write (name tag))
           (.write ">"))))))

+(defn emit-comment [^Comment c ^Writer out]
+  (doto out
+    (.write "<!--")
+    (.write (xml-escape-comment (.text c)))
+    (.write "-->")))
+
+(defn emit-cdata [^CData cd ^Writer out]
+  (when (.contains (.text cd) "]]>")
+    (throw (IllegalArgumentException. "Illegal end sequence in CDATA text.")))
+  (doto out
+    (.write "<![CDATA[")
+    (.write (.text cd))
+    (.write "]]>")))
+
+(defn emit-pi [^PI pi ^Writer out]
+  (let [{:keys [target text]} pi]
+    ;; TODO - validate target: http://www.w3.org/TR/REC-xml/#sec-pi
+    (when (.contains text "?>")
+      (throw (IllegalArgumentException. "Illegal end sequence in processing instruction " target)))
+    (doto out
+      (.write "<?")
+      (.write target)
+      (.write " ")
+      (.write text)
+      (.write "?>"))))
+
+
 (extend-protocol XMLWritable

   nil
@@ -336,6 +396,7 @@
     (emit-xml (str o) out))

   )
+

 (defn emit
   "Turn an element into a String of XML."


Use update-annotation

Use update-annotation

--- src/riemann/librato.clj
+++ src/riemann/librato.clj
@@ -1,7 +1,8 @@
 (ns riemann.librato
   "Forwards events to Librato Metrics."
   (:require [clojure.string :as string])
-  (:use [clj-librato.metrics :only [collate annotate connection-manager]]
+  (:use [clj-librato.metrics :only [collate annotate connection-manager
+                                    update-annotation]]
         clojure.math.numeric-tower))

 (defn safe-name
@@ -109,7 +110,7 @@
                                     [(:host event) (:service event)])
                                 a (event->annotation event)]
                             (when id
-                              (let [res (annotate
+                              (let [res (update-annotation
                                          user api-key (:name a) id
                                          {:end-time (round (:time event))}
                                          http-options)]


Clarify GC behavior of (by) streams

Clarify GC behavior of (by) streams

Namely, that there isn't any.  Per @aphyr:

> Nope, by streams are not presently GCed. Tried a bunch of strategies but it's real hard to predict when it's legal to GC a stream.

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -1496,7 +1496,7 @@
   Be aware that (by) over unbounded values can result in
   *many* substreams being created, so you wouldn't want to write
   (by metric prn): you'd get a separate prn for *every* unique metric that
-  came in."
+  came in.  Also, (by) streams are never garbage-collected."
   [fields & children]
   ; new-fork is a function which gives us a new copy of our children.
   ; table is a reference which maps (field event) to a fork (or list of


set结束

set结束

--- src/learnclojure/chapt3/core7.clj
+++ src/learnclojure/chapt3/core7.clj
@@ -16,7 +16,7 @@
 ;;没有引号会把1看成函数，1肯定不是函数，所以会报错
 ;;这个引号的副作用是，这个列表里的所有元素都不会被求值
 '(1 2 (+ 1 2))
-;;这种场景下，一般都用vector，如果真的需要用list，可以用list函数
+;;这种场景下，一般都用vector，如果真的需要用list(一般在写宏的时候)，可以用list函数
 (list 1 2 (+ 1 2))
 ;;list会把每一个参数作为列表的一个元素
 ;;用list？检查是否一个集合是否是列表
@@ -24,4 +24,56 @@

 ;;vector
 ;;vector是一种顺序数据结构，支持高效的随机访问和更改语义,类似java的arraylist
-;;它实现了associative，indexwd。，stack+;;它实现了associative，indexwd，stack
+;;除了熟悉的字面量，还可以通过vector和vec函数来创建：
+(vector 1 2 3)
+(vec (range 10))
+;;vector和list的作用类似，而vec只接收一个参数，把传入的集合转换成一个新的vector。
+
+;;谓词vector?也和list？类似，测试一个值是否是vector。
+(vector? [1 2 3])
+
+;;元组(tuple)是vector最常见的使用场景,任何你想把多个值绑在一起处理，比如从一个函数返回多个值，就可以把多个值放在vector里
+(defn euclidia-devision-1
+  "docstring"
+  [x y]
+  [(quot x y) (rem x y)])
+(euclidia-devision-1 42 8)
+;;还有一个更简洁的写法 ((juxt a b c) x) = [(a x) (b x) (c x)]
+(defn euclidia-devision-2
+  "docstring"
+  [x y]
+  ((juxt quot rem) x y))
+(euclidia-devision-2 42 8)
+
+;;这个可以和解构很好的配合
+(let [[q r] (euclidia-devision-2 68 9)]
+  (str "68/9=" q "*9+" r))
+
+;;虽然vector和tuple一样易用，但记住，它终究是不适合暴露到系统外部的数据结构。对它的使用最好保持在类库或组件的内部，而不要在公共api这么用。
+;;原因有两个：1、tuple是不能自我注解的，看到一个tuple你不知道每个值的含义时什么，必须回忆或回到tuple赋值的地方才行。
+;;2、tuple是不灵活的。要构建一个tuple，需要提供tuple所有的字段，即使tuple某个字段对于你的场景没有意义，还是要提供，而且只能向tuple尾部添加元素。
+;;map不受这种限制，所以你要用在公共API的参数或返回值上，map更合适。
+;;但在某些情况下，tuple的字段的含义是非常明确的，那用vector也是没有问题的，比如坐标，几何图形的边等。
+(def point-3d [24 64 -14])
+(def travel-legs [["LYS" "FRA"] ["FRA" "PHL"] ["PHL" "RDU"]])
+
+;;set
+;;作为一个具体类型的数据结构没什么说的，前面已经讨论过。
+;;下面的式子会报错，因为set中不能有重复的
+;#{1 2 3 3}
+;;hash-set能创建任意数量元素的无序set
+(hash-set 1 2 4 5 )
+;;可以用set函数把其他类型的集合转成set
+(set [1 3 4 5 1])
+;= #{1 4 3 5}
+;;这个函数可以用于任何可序列化的值，而且因为set本身也是函数，所以可以利用它写出很简洁的代码
+;;删除字符串中的元音字母
+(apply str (remove (set "aeiouy") "vowels are  useless"))
+;;判断是否是数字的谓词
+(defn numeric? [s] (every? (set "0123456789") s))
+(numeric? "11414")
+;=true
+(numeric? "11dad414")
+;=false
+;;也可以定义有序的set，前面已经介绍过了。


Enable program exit

Enable program exit

--- src/robip_tool/core.clj
+++ src/robip_tool/core.clj
@@ -11,7 +11,7 @@

 (defn exit [status msg]
   (println msg)
-  #(System/exit status))
+  (System/exit status))

 (defn error-msg [errors]
   (str "The following errors occurred while parsing your command:\n\n"


Add debug message for ui rendering.

Add debug message for ui rendering.

--- src/uxbox/ui.cljs
+++ src/uxbox/ui.cljs
@@ -38,6 +38,7 @@
                  :name "app"}))
 (defn init
   []
+  (println "ui/init")
   (let [app-dom (gdom/getElement "app")
         lb-dom (gdom/getElement "lightbox")]
     (rum/mount (app) app-dom)


remove comment code

remove comment code

--- src/nha/boot_uglify/minify_js.clj
+++ src/nha/boot_uglify/minify_js.clj
@@ -54,7 +54,6 @@
      (.toByteArray out))
    out))

-(.size (str->gzip "kkk"))

 (defn gzip-files
   "sources"


Updated docstring

Updated docstring

--- src/video_server/model.clj
+++ src/video_server/model.clj
@@ -60,7 +60,7 @@

 (defmacro make-record
   "Contructs a new record by extracting only the defined fields from
-  the data map. The resulting record will not have extra fields."
+  the data map. The resulting record will not have any extra fields."
   [record data]
   (let [constructor (symbol (str "map->" (name record)))
         fields      (get-record-fields (resolve record))]


Use coords in board namespace

Use coords in board namespace

--- src/tile_game/board.clj
+++ src/tile_game/board.clj
@@ -1,5 +1,5 @@
 (ns tile-game.board
-  (:require [tile-game.coordinates :refer [distance adjacent-to]]
+  (:require [tile-game.coordinates :as coords]
             [clojure.math.numeric-tower :as math]
             [clojure.set :as set]
             [clojure.string :as s]))
@@ -45,21 +45,21 @@
 (defn tile->coords [board tile]
   (index->coords board (tile->index board tile)))

-(defn adjacent-coords [board [x y]]
-  (filter (partial bounded-coords? board) (adjacent-to [x y])))
+(defn adjacent-coords [board p]
+  (filter (partial bounded-coords? board) (coords/adjacent-to p)))

 (defn- adjacent-tiles [board tile]
   (map (partial coords->tile board)
        (adjacent-coords board (tile->coords board tile))))

 (defn- adjacent? [board p1 p2]
-  (= 1 (distance (tile->coords board p1) (tile->coords board p2))))
+  (= 1 (coords/distance (tile->coords board p1) (tile->coords board p2))))

-(defn coord-add [board [x y] [dx dy]]
-  (let [coords [(+ x dx) (+ y dy)]]
+(defn coord-add [board start delta]
+  (let [coords (coords/add start delta)]
     (if (bounded-coords? board coords)
       coords
-      [x y])))
+      start)))

 (defn slide [board arg]
   (let [tile (if (contains? dir-delta arg)


Fix datemark calculation not taking into account local time

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/utils/datetime.cljs
+++ src/status_im/utils/datetime.cljs
@@ -1,6 +1,6 @@
 (ns status-im.utils.datetime
   (:require [re-frame.core :as re-frame]
-            [cljs-time.core :as t :refer [date-time plus days hours before?]]
+            [cljs-time.core :as t :refer [date-time plus minus days hours before?]]
             [cljs-time.coerce :refer [from-long to-long from-date]]
             [cljs-time.format :refer [formatters
                                       formatter
@@ -80,7 +80,7 @@
 (defn- to-str [ms old-fmt-fn yesterday-fmt-fn today-fmt-fn]
   (let [date (from-long ms)
         local (plus date time-zone-offset) ; this is wrong, it uses the current timezone offset, regardless of DST
-        today (t/today-at-midnight)
+        today (minus (t/today-at-midnight) time-zone-offset)
         yesterday (plus today (days -1))]
     (cond
       (before? date yesterday) (old-fmt-fn local)


Korjattu bye pairingien luvussa

Korjattu bye pairingien luvussa

--- mtg-pairings-wer/src/mtg_pairings/db_reader.clj
+++ mtg-pairings-wer/src/mtg_pairings/db_reader.clj
@@ -5,6 +5,7 @@
   (db/open-db filename))

 (defn tournaments
+  "Returns a list of tournaments in the database"
   [db]
   (->> (db/table db "Tournament")
     db/rows
@@ -16,6 +17,7 @@
    :dci-numbers []})

 (defn dcinumbers-for-players
+  "Returns a list of DCI numbers for a list of players"
   [db players]
   (let [person-table (db/table db "Person")]
     (for [player players
@@ -23,6 +25,7 @@
       (:PrimaryDciNumber person))))

 (defn teams
+  "Returns a list of teams in the tournament with the given id number."
   [db tournament-id]
   (let [team-table (db/table db "Team")
         teamplayer-table (db/table db "TeamPlayers")]
@@ -37,7 +40,7 @@
   (if (= 2 (count team-ids))
     (let [pair (map all-teams team-ids)]
       [pair (reverse pair)])
-    [(all-teams (:TeamId (first team-ids))) bye]))
+    [[(all-teams (first team-ids)) bye]]))

 (defn pairings-for-round
   [db round-id all-teams]


fix test

fix test

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -222,9 +222,9 @@
     (is (= "io mi chiamo Luisa" (morph result)))))

 (deftest parse-io-parlo
-  (let [result (:parses (first (parse "io parlo")))]
+  (let [result (-> "io parlo" parse first :parses)]
     (is (not (empty? result)))
-    (is (= "io parlo") (morph (first (:parses (first result)))))))
+    (is (= "io parlo" (-> result first morph)))))

 (deftest round-trip-1
   (let [expr (italiano/generate {:synsem {:subcat []


Resolver mappings can be keyed by sets

Resolver mappings can be keyed by sets

--- test-cljs/frontend/test_send.cljs
+++ test-cljs/frontend/test_send.cljs
@@ -308,11 +308,20 @@
                      (map #(vector (:key %1) %2)
                           children vals)))
              (map (fn [ast]
-                    (let [result ((get mapping (:key ast)) context ast)
-                          promise (if (read-port? result)
-                                    result
-                                    (doto (async/promise-chan) (put! result)))]
-                      promise))
+                    (if (contains? mapping (:key ast))
+                      (let [result ((get mapping (:key ast)) context ast)
+                            promise (if (read-port? result)
+                                      result
+                                      (doto (async/promise-chan) (put! result)))]
+                        promise)
+
+                      (if-let [[keys resolver] (first (filter #(contains? (key %) (:key ast)) mapping))]
+                        (let [result (resolver context ast)
+                              promise (if (read-port? result)
+                                        result
+                                        (doto (async/promise-chan) (put! result)))]
+                          (async/map #(get % (:key ast)) [promise]))
+                        (throw "Unknown key"))))
                   children)))

@@ -325,20 +334,12 @@
    (fn [context ast]
      (:user/name context))

-   :user/favorite-color
+   #{:user/favorite-color :user/favorite-number}
    (fn [context ast]
      (let [c (async/promise-chan)
            get-user (get-in context [:apis :get-user])]
        (get-user {:user/name (:user/name context)}
-                 #(put! c (:user/favorite-color %)))
-       c))
-
-   :user/favorite-number
-   (fn [context ast]
-     (let [c (async/promise-chan)
-           get-user (get-in context [:apis :get-user])]
-       (get-user {:user/name (:user/name context)}
-                 #(put! c (:user/favorite-number %)))
+                 #(put! c %))
        c))

    :user/favorite-fellow-user


PLD: remove extra line

PLD: remove extra line

--- test/hatti/views/photos_test.cljs
+++ test/hatti/views/photos_test.cljs
@@ -78,7 +78,6 @@
       (is (= (assoc datum :attachments [:url1 :url2])
              (extract-images datum photos-column))))))

-
 (deftest full-url-from-active-image-gets-url
   (let [img (.createElement js/document "img")
         container (new-container! "active-image")


Remove version chec

Remove version chec

--- test/obb_rules_api/index_test.clj
+++ test/obb_rules_api/index_test.clj
@@ -9,9 +9,8 @@
     (let [response (app (request :get "/"))]
       (is (= (:status response) 200))
       (let [result (json/read-str (:body response))]
-        (is (= "obb-rules-api" (result "name")))
-        (is (= "1.1.0" (result "version"))))))
+        (is (= "obb-rules-api" (result "name")))))))

  (testing "not-found route"
     (let [response (app (request :get "/invalid"))]
-      (is (= (:status response) 404)))))
+      (is (= (:status response) 404))))


Some edge-case tests for future safety

Some edge-case tests for future safety

--- test/structural_typing/f_type.clj
+++ test/structural_typing/f_type.clj
@@ -71,4 +71,19 @@
  [:tag] [(exactly even)]}
 ")))

-
+
+(fact "degenerate cases"
+  (fact "a predicate list can be empty"
+    (let [repo (-> type/empty-type-repo
+                   (type/named :A {:a []}))]
+      (type/checked repo :A {})
+      (type/checked repo :A {:a 1})))
+
+  (fact "a whole type map can be empty"
+    (let [repo (-> type/empty-type-repo
+                   (type/named :A {}))]
+      (type/checked repo :A {})
+      (type/checked repo :A {:a 1}))))
+
+
+


Create a scalar tensor

Create a scalar tensor

--- test/tensorflow_clj/core_test.clj
+++ test/tensorflow_clj/core_test.clj
@@ -2,6 +2,7 @@
   (:require [clojure.test :refer :all]
             [tensorflow-clj.core :refer :all]))

-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))
+(deftest scalar-tensor
+  (testing "Scalar tensor creation"
+    (let [t (org.tensorflow.Tensor/create 123.0)]
+      (is (= org.tensorflow.DataType/DOUBLE (.dataType t))))))


(PDB-3457) Fix sensitive-params test's pg_dump authorization

Postgres command line tools like pg_dump require that credentials be
provided via the console or a PGPASSFILE, so create a temporary file
containing the pdb_test credentials and point PGPASSFILE to it in
pg_dump's environment.

--- test/puppetlabs/puppetdb/integration/sensitive_params.clj
+++ test/puppetlabs/puppetdb/integration/sensitive_params.clj
@@ -1,32 +1,50 @@
 (ns puppetlabs.puppetdb.integration.sensitive-params
   (:require
    [clojure.java.shell :refer [sh]]
+   [clojure.java.io :refer [writer]]
+   [clojure.pprint :refer [pprint]]
    [clojure.string :as str]
    [clojure.test :refer :all]
    [puppetlabs.puppetdb.integration.fixtures :as int])
   (:import
-   [java.net URI]))
+   [java.net URI]
+   [java.nio.file Files]
+   [java.nio.file.attribute PosixFilePermission PosixFilePermissions]))

 (defn pg-dump
-  "Returns the content of pg as a string via pg_dump."
+  "Returns the content of pg as a string via pg_dump or nil on failure."
   [pg]
-  (let [db-config (:db-config pg)
-        db-uri (URI. (:subname db-config))
-        result (sh "pg_dump"
-                   "--username" (:user db-config)
-                   "--host" (.getHost db-uri)
-                   "--port" (str (.getPort db-uri))
-                   "--dbname" (subs (.getPath db-uri) 1)
-                   "--data-only"
-                   "--no-owner"
-                   "--encoding" "utf-8"
-                   "--format" "plain"
-                   :out-enc "utf-8")]
-    (when-not (zero? (:exit result))
-      (is (= 0 (:exit result)))
-      (binding [*out* *err*]
-        (print (:err result))))
-    (:out result)))
+  (let [{:keys [user password subname]} (:db-config pg)
+        attrs (into-array [(-> "rw-------"
+                               PosixFilePermissions/fromString
+                               PosixFilePermissions/asFileAttribute)])
+        pgpass (Files/createTempFile "tmp-pg-dump-passfile" "" attrs)]
+    (try
+      (spit (.toFile pgpass)
+            (str
+             "# hostname:port:database:username:password\n"
+             "*:*:*:" user ":" password "\n"))
+      (let [db-uri (URI. subname)
+            cmd ["pg_dump"
+                 "--username" user
+                 "--host" (.getHost db-uri)
+                 "--port" (str (.getPort db-uri))
+                 "--dbname" (subs (.getPath db-uri) 1)
+                 "--data-only"
+                 "--no-owner"
+                 "--encoding" "utf-8"
+                 "--format" "plain"
+                 :out-enc "utf-8"
+                 :env (merge {} (System/getenv) {"PGPASSFILE" (str pgpass)})]
+            result (apply sh cmd)]
+        (when-not (zero? (:exit result))
+          (is (= 0 (:exit result)))
+          (binding [*out* *err*]
+            (pprint cmd)
+            (pprint result)))
+        (:out result))
+      (finally
+        (Files/deleteIfExists pgpass)))))

 (deftest ^:integration sensitive-parameter-redaction
   (with-open [pg (int/setup-postgres)


prolly don't want to check in the test stuff <3

--- src/metabase/driver/mongo.clj
+++ src/metabase/driver/mongo.clj
@@ -12,10 +12,6 @@
                     [query :as mq])
             [metabase.driver :as driver]
             (metabase.driver [interface :refer :all])))
-
-(def test-db (delay (sel :one Database :id 67)))
-(def test-table {:name "zips"
-                 :db test-db})

 (declare driver)


registered-instructions is now a set.

registered-instructions is now a set.

--- src/clojush.clj
+++ src/clojush.clj
@@ -379,7 +379,7 @@
 ;"Elapsed time: 52389.016 msecs"
 ;"Elapsed time: 54706.127 msecs"

-(def registered-instructions (atom ()))
+(def registered-instructions (atom #{}))

 (defn register-instruction
   "Add the provided name to the global list of registered instructions."
@@ -390,8 +390,7 @@

 (defmacro define-registered
   [instruction definition]
-  `(do (when-not (contains? instruction-table '~instruction)
-	 (register-instruction '~instruction))
+  `(do (register-instruction '~instruction)
        (swap! instruction-table assoc '~instruction ~definition)))

 (defn state-pretty-print


Adaptation to Clojure 1.7

Adaptation to Clojure 1.7

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/usage/daily_summary_launcher.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/usage/daily_summary_launcher.clj
@@ -1,9 +1,7 @@
 (ns com.sixsq.slipstream.ssclj.usage.daily-summary-launcher
 	(:require
-    [clojure.tools.cli                                  :refer [parse-opts]]
+    [clojure.tools.cli                                  :as cli]
     [clj-time.core                                      :as t]
-    [com.sixsq.slipstream.ssclj.usage.record-keeper     :as rc]
-    [com.sixsq.slipstream.ssclj.usage.summary           :as s]
     [com.sixsq.slipstream.ssclj.usage.utils             :as u]
     [com.sixsq.slipstream.ssclj.resources.common.utils  :as cu]
     [com.sixsq.slipstream.ssclj.usage.launcher          :as l])
@@ -23,7 +21,7 @@

 (defn -main
   [& args]
-  (let [{:keys [options arguments errors summary] :as all} (parse-opts args cli-options)
+  (let [{:keys [options arguments errors summary] :as all} (cli/parse-opts args cli-options)
         start (date-or-yesterday options)
         end   (-> start
                   u/to-time


worker/parser fns don't reach out to global config

...but some of their called functions still do.

--- src/cu/core.clj
+++ src/cu/core.clj
@@ -44,7 +44,7 @@
   "Process a queue item from the worker queue. Runs script, stores output.
   Currently outputs to both a big log and separate job logs.
   TODO: Remove big log."
-  [message]
+  [workspaces-path big-log-key message]
   (println "--------------------------------------")
   (println "run-job-from-message")
   (let [{uuid     :uuid
@@ -53,11 +53,9 @@
          git-ref  :ref
          script   :script}  (read-body message)

-        workspace-path      (join "/" [(global-config/config :workspaces-path)
-                                       job-name
-                                       "workspace"])
+        workspace-path      (join "/" [workspaces-path job-name "workspace"])

-        existing-log        (io/get-key (global-config/config :log-key))
+        existing-big-log    (io/get-key big-log-key)

         repo                (git/fresh-clone git-url workspace-path git-ref)
         build               (runner/run! workspace-path script)
@@ -66,8 +64,7 @@
     (println "for" job-name)
     (io/put (results/log-key uuid job-name (build :exit))
             (build :out))
-    (io/put (global-config/config :log-key)
-            (str existing-log (build :out)))
+    (io/put big-log-key (str existing-big-log (build :out)))
     (build :out)))

 (defn- upstream-all-passed?
@@ -119,7 +116,9 @@
     (dorun
       (map (sqs/deleting-consumer client
                                   (runner/decide-whether-to
-                                    run-job-from-message
+                                    (partial run-job-from-message
+                                             (config :workspaces-path)
+                                             (config :log-key))
                                     upstream-all-passed?))
            (filter no-pending-upstream-jobs?
                    (sqs/polling-receive client q


Use validate-enough-peers! clojure.test validation

--- src/leiningen/new/onyx_app/test/onyx_app/jobs/sample_job_test.clj
+++ src/leiningen/new/onyx_app/test/onyx_app/jobs/sample_job_test.clj
@@ -1,7 +1,7 @@
 (ns {{app-name}}.jobs.sample-job-test
     (:require [clojure.test :refer [deftest is]]
               [onyx api
-              [test-helper :refer [feedback-exception! load-config with-test-env]]]
+              [test-helper :refer [feedback-exception! validate-enough-peers! load-config with-test-env]]]
               [{{app-name}}.jobs.sample-submit-job :refer [build-job]]
               [{{app-name}}.lifecycles.sample-lifecycle :refer [get-core-async-channels]]
               {{#metrics?}}[onyx.lifecycle.metrics.metrics]{{/metrics?}}
@@ -22,6 +22,7 @@
     (with-test-env [test-env [5 env-config peer-config]]
       (let [job (build-job :dev)
             {:keys [write-lines]} (get-core-async-channels job)
+            _ (validate-enough-peers! test-env job)
             {:keys [job-id]} (onyx.api/submit-job peer-config job)]
         (feedback-exception! peer-config job-id)
         (let [results (take-segments! write-lines)]


CMR-1913: Removed an is in a test which was added for debugging

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -274,7 +274,7 @@
       (util/are2 [request-json expected-response-json]
                  (let [response (vp/translate-granule-entries
                                   (json/generate-string request-json))]
-                   (is (= expected-response-json (json/parse-string (:body response) true))))
+                   (= expected-response-json (json/parse-string (:body response) true)))

                  "Input with no virtual granules should return the original response"
                  [non-virtual-granule1 non-virtual-granule2]


local state in timeseries chart contained in let-binding

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/charts/ts_chart.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/charts/ts_chart.cljs
@@ -4,9 +4,6 @@
             [birdwatch.stats.timeseries :as ts]
             [reagent.core :as r :refer [atom]]
             [cljs.core.async :as async :refer [chan sub timeout sliding-buffer]]))
-
-(def bars-atom (atom []))
-(def label (atom {}))

 (def ts-elem (util/by-id "timeseries1"))
 (def ts-w (aget ts-elem "offsetWidth"))
@@ -15,7 +12,7 @@
 (defn bar
   "Renders a vertical bar. Enables showing a label when the mouse is
    positioned above the bar."
-  [x y h w idx]
+  [x y h w idx label]
   [:rect {:x x :y (- y h) :fill "steelblue" :width w :height h
           :on-mouse-enter #(reset! label {:idx idx})
           :on-mouse-leave #(reset! label {})}])
@@ -23,16 +20,16 @@
 (defn barchart
   "Renders a bar chart, making use of the bar function above. Returns
    entire SVG element."
-  [indexed mx cnt w]
+  [indexed mx cnt w label]
   (let [gap (/ (/ ts-w 20) cnt)]
     [:svg {:width ts-w :height ts-h}
      [:g
       (for [[idx [k v]] indexed]
-        ^{:key k} [bar (* idx w) ts-h (* (/ v mx) ts-h) (- w gap) idx])]]))
+        ^{:key k} [bar (* idx w) ts-h (* (/ v mx) ts-h) (- w gap) idx label])]]))

 (defn labels
-  "Renders a label for a bar chart. Makes use of Rickshaw's CSS."
-  [bars mx cnt w]
+  "Renders a label for a bar chart. Makes use of Rickshaws CSS."
+  [bars mx cnt w label]
   (when-not (empty? @label)
     (let [idx (:idx @label)
           [k v] (get bars idx)
@@ -47,26 +44,27 @@
   "Renders time series chart consisting of SVG for the bars and a label.
    Appearance is similar to the Rickshaw timeseries chart, which this
    component replaced, except for the CSS."
-  []
+  [bars-atom label]
   (let [bars @bars-atom
         indexed (vec (map-indexed vector bars))
         mx (apply max (map (fn [[k v]] v) bars))
         cnt (count bars)
         w (/ ts-w cnt)]
     [:div.rickshaw_graph
-     [barchart indexed mx cnt w]
-     [labels bars mx cnt w]]))
+     [barchart indexed mx cnt w label]
+     [labels bars mx cnt w label]]))

 (defn mount-ts-chart
   "Mount timeseries chart and subscribe to specified pub for state changes.
    The wait time until re-render is specified in the configuration map."
   [state-pub {:keys [every-ms]}]
-  (r/render-component [ts-chart] ts-elem)
-  (let [state-chan (chan (sliding-buffer 1))]
+  (let [state-chan (chan (sliding-buffer 1))
+        bars (atom [])
+        label (atom {})]
     (go-loop []
              (let [[_ state] (<! state-chan)]
-               (reset! bars-atom (ts/ts-data state))
+               (reset! bars (ts/ts-data state))
                (<! (timeout every-ms))
                (recur)))
+    (r/render-component [ts-chart bars label] ts-elem)
     (sub state-pub :app-state state-chan)))
-


added warnings to metadata retrieval.

added warnings to metadata retrieval.

--- src/ancient_clj/repository.clj
+++ src/ancient_clj/repository.clj
@@ -5,7 +5,7 @@
             [ancient-clj.repository.http]
             [ancient-clj.repository.local]
             [ancient-clj.repository.s3p]
-            [ancient-clj.verbose :refer [verbose]]
+            [ancient-clj.verbose :refer [verbose warn]]
             [clojure.data.xml :as xml :only [parse-str]]
             [version-clj.core :as v]))

@@ -40,53 +40,61 @@

 ;; ## Access Functions

-(defn retrieve-metadata-xml!
-  "Retrieve the version metadata XML file as a String searching the given
+(defn- retrieve-single-metadata-xml!
+  [repo group-id artifact-id]
+  (try
+    (r/retrieve-metadata-xml! repo group-id artifact-id)
+    (catch java.io.FileNotFoundException _ nil)
+    (catch javax.net.ssl.SSLException ex
+      (warn "An SSL error occured when retrieving '" group-id "/" artifact-id "':\n"
+            (.getMessage ex)))
+    (catch Exception ex
+      (warn "An unexpected error occured when retrieving '" group-id "/" artifact-id "':\n"
+            (.getMessage ex)))))
+
+(defn retrieve-metadata-xml!
+  "Retrieve the version metadata XML file as a String searching the given
    repositories. The first found result will be returned."
-  ([group-id artifact-id]
+  ([group-id artifact-id]
    (retrieve-metadata-xml! *repositories* group-id artifact-id))
   ([repos group-id artifact-id]
    (loop [repos repos]
      (when (seq repos)
-       (or
-         (try
-           (r/retrieve-metadata-xml! (first repos) group-id artifact-id)
-           (catch Exception _ nil))
+       (or
+         (retrieve-single-metadata-xml! (first repos) group-id artifact-id)
          (recur (rest repos)))))))

 (defn retrieve-versions!
-  "Retrieve a seq of version pairs (`[version-string version-seq]`) for the given artifact
-   from the given repositories. The following calls are possible (using an optional
+  "Retrieve a seq of version pairs (`[version-string version-seq]`) for the given artifact
+   from the given repositories. The following calls are possible (using an optional
    settings map):
-
+
      (retrieve-versions! [r1 r2] group artifact)
      (retrieve-versions! {:aggressive? true} [r1 r2] group artifact)
-
+
    The second call will not stop after the first metadata match. By default, the keys
    `:snapshots?` and `:qualified` of the settings map are set to `true`."
   ([artifact-id] (retrieve-versions! nil *repositories* artifact-id artifact-id))
   ([group-id artifact-id]
    (retrieve-versions! nil *repositories* group-id artifact-id))
   ([repos group-id artifact-id]
-   (retrieve-versions!
+   (retrieve-versions!
      (if (map? repos) repos nil)
      (if (map? repos) *repositories* repos)
      group-id artifact-id))
   ([{:keys [aggressive? snapshots? qualified?] :as settings} repos group-id artifact-id]
    (let [aggressive? (:aggressive? settings true)
          snapshots? (:snapshots? settings true)
-         qualified? (:qualified? settings true)]
+         qualified? (:qualified? settings true)]
      (->>
        (loop [repos repos
               versions nil]
          (if-not (seq repos)
            versions
            (let [[repo & rst] repos]
-             (if-let [repo-versions (when-let [mta (try
-                                                     (r/retrieve-metadata-xml! repo group-id artifact-id)
-                                                     (catch Exception _ nil))]
+             (if-let [repo-versions (when-let [mta (retrieve-single-metadata-xml! repo group-id artifact-id)]
                                       (when (string? mta)
-                                        (for [t (try
+                                        (for [t (try
                                                   (xml-seq (xml/parse-str mta))
                                                   (catch Exception e
                                                     (verbose "Could not read XML: " (.getMessage e))))
@@ -118,6 +126,6 @@
       (last))))

 (def retrieve-latest-version-string!
-  "Retrieve the latest version's version string. Arguments are the same as for
+  "Retrieve the latest version's version string. Arguments are the same as for
    `retrieve-latest-version!`."
   (comp first retrieve-latest-version!))


namespace string operations

namespace string operations

--- src/atom_finder/classifier.clj
+++ src/atom_finder/classifier.clj
@@ -2,7 +2,7 @@
   (:require [atom-finder.util :refer :all]
             [schema.core :as s]
             [clojure.pprint :refer [pprint]]
-            [clojure.string :refer :all]
+            [clojure.string :as str]
             )
   (:import
    [org.eclipse.cdt.core.dom.ast IASTNode
@@ -20,8 +20,8 @@
        clojure.java.io/file
        file-seq
        (map (memfn getName))
-       (filter #(ends-with? % ".clj"))
-       (map #(replace % #"\.clj$" ""))
+       (filter #(str/ends-with? % ".clj"))
+       (map #(str/replace % #"\.clj$" ""))
        (map (partial str "classifier/"))
        ))


CMR-6645: Fixed run-all-tests in local dev env.

--- indexer-app/int-test/cmr/indexer/test/services/index_fields.clj
+++ indexer-app/int-test/cmr/indexer/test/services/index_fields.clj
@@ -21,7 +21,7 @@
 (def test-config
   "Return the configuration for elasticsearch"
   {:host "localhost"
-   :port 9213
+   :port 9210
    :admin-token (str "Basic " (b64/encode (.getBytes "password")))})

 (def context (atom nil))
@@ -100,14 +100,11 @@
 (defn server-setup
   "Fixture that starts an instance of elastic in the JVM runs the tests and then shuts it down."
   [f]
-  (let [http-port (:port test-config)
-        server (lifecycle/start (elastic-server/create-server http-port) nil)]
+  (let [http-port (:port test-config)]
     (reset! context {:system {:db {:config test-config
                                    :conn (esr/connect (str "http://localhost:" http-port))}}})
     (try
-      (f)
-      (finally
-        (lifecycle/stop server nil)))))
+      (f))))

 (defn index-setup
   "Fixture that creates an index and drops it."


add {:slash false} to all non-slash rules

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -348,6 +348,7 @@
                 unmodified
                 root-is-head
                 {:rule "sentence-nonphrasal-head"
+                 :slash false
                  :synsem {:cat :verb}
                  :head {:phrasal false
                         :slash false
@@ -357,17 +358,20 @@
                 root-is-head-root
                 {:head {:phrasal true
                         :slash false}
+                 :slash false
                  :rule "sentence-phrasal-head"
                  :synsem {:cat :verb}})

    (unify-check h21
                 root-is-head
                 {:rule "transitive-vp-nonphrasal-head"
+                 :slash false
                  :synsem {:aux false
                           :cat :verb}})
    (unify-check h21
                 root-is-head-root
                 {:rule "transitive-vp-phrasal-head"
+                 :slash false
                  :head {:phrasal true}
                  :synsem {:aux false
                           :cat :verb}})


+burn

+burn

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -402,6 +402,10 @@
                      :sem {:pred :bring}}
           :english {:past "brought"}}

+   "burn" {:synsem {:cat :verb
+                    :sem {:pred :burn}}
+           :english {:past "burnt"}}
+
    "buy" {:synsem {:cat :verb
                    :sem {:pred :comprare}}
           :english {:past "bought"


+sigh (noun)

+sigh (noun)

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1623,8 +1623,11 @@
                     :sem {:pred :show
                           :past-participle "shown"}}}

-   "sigh" {:synsem {:cat :verb
-                :sem {:pred :sigh}}}
+   "sigh" [{:synsem {:cat :verb
+                     :sem {:pred :sigh}
+                     :subcat {:2 {:sem {:pred :sigh}}}}}
+           {:synsem {:cat :noun
+                     :sem {:pred :sigh}}}]

    "sing" {:synsem {:cat :verb
                     :sem {:pred :sing}}


only get the 10 most recent messages

only get the 10 most recent messages

--- src/braid/server/db/thread.clj
+++ src/braid/server/db/thread.clj
@@ -162,7 +162,10 @@
        (into ()
              (comp (filter (comp (partial user-can-see-thread? conn user-id) :id))
                    (map (comp db->thread first))
-                   (map #(thread-add-last-open-at conn % user-id))))))
+                   (map #(thread-add-last-open-at conn % user-id))))
+       (sort-by (fn [t] (apply max (map :created-at (t :messages))))
+                #(compare %2 %1))
+       (take 10)))

 (defn subscribed-thread-ids-for-user
   [conn user-id]


Updated sample static data to match GADM v.2 for IDN, fixing tests


Show Filmkategorie in Hörfilm Gesamtkatalog

--- src/clj/catalog/layout/fop.clj
+++ src/clj/catalog/layout/fop.clj
@@ -928,7 +928,7 @@
         [:fo:flow {:flow-name "xsl-region-body"}
          (cover-page [title "Filme mit Audiodeskription"] year)
          (toc subitems [fmt] 1 {:heading? true})
-         (mapcat #(genre-sexp (get subitems %) fmt % 1 {:show-genre? false}) (keys subitems))])]]))
+         (mapcat #(genre-sexp (get subitems %) fmt % 1 {}) (keys subitems))])]]))

 (defmethod document-sexp :ludo
   [items fmt year _ _ _ {:keys [description]}]


removed in-range?

removed in-range?

--- src/clj/forma/matrix/utils.clj
+++ src/clj/forma/matrix/utils.clj
@@ -31,12 +31,6 @@
   (concat (take idx coll) (list val) (drop (inc idx) coll)))

 (defn average
-  "average of a list"
+  "average of a list"
   [lst]
   (float (/ (reduce + lst) (count lst))))
-
-;; predicate invoked by (above-x? 10)
-
-(defn in-range?
-  [smap val]
-  (cond (and (>= val (first smap)) (<= val (last smap))) val))


code-style: use zero instead of = 0

code-style: use zero instead of = 0

--- src/clj/lambdacd/steps/git.clj
+++ src/clj/lambdacd/steps/git.clj
@@ -89,7 +89,7 @@
         repo-location (:cwd checkout-result)
         checkout-exit-code (:exit checkout-result)]
     (utils/with-temp repo-location
-      (if (= 0 checkout-exit-code)
+      (if (zero? checkout-exit-code)
         (let [execute-steps-result (core/execute-steps steps (assoc args :cwd repo-location) ctx
                                                        :unify-status-fn status/successful-when-all-successful
                                                        :is-killed (:is-killed ctx))


no form

no form

--- src/clj/sc_demo_page/demo.cljc
+++ src/clj/sc_demo_page/demo.cljc
@@ -79,25 +79,6 @@
   (fn [ctx]
     (update-db ctx dissoc key)))

-(defn field []
-  {:type   :xor
-   :init   :static
-   :states {:static {}
-            :active {}}})
-
-(def my-form
-  {:type        :and
-   :states      {:first-name (field)
-                 :last-name  (field)
-                 :email      (field)}
-   :transitions [#_(goto-substate' :focus :first-name [:page :betting :page :page/home :form :first-name :active])
-                 {:event :focus
-                  :internal true
-                  :target [:page :betting :page :page/home :form :first-name :active]}
-                 #_(goto-substate' :focus :last-name [:page :betting :page :page/home :form :last-name :active])
-                 #_(goto-substate' :focus :email [:page :betting :page :page/home :form :email :active])
-                 ]})
-
 (def home-page
   {:type   :and
    :enter  [(ctx-log "Entering home page")
@@ -105,7 +86,7 @@
                                )]
    :exit   [(dissoc-db-value :home-page)
             (ctx-log "Leaving home page")]
-   :states {:form my-form
+   :states {
             :tabs {:init        :top-5
                    :type        :xor
                    :history     :shallow


Making some code a bit more concise.

Making some code a bit more concise.

--- src/clj_ns_browser/browser.clj
+++ src/clj_ns_browser/browser.clj
@@ -174,43 +174,30 @@
   "Special-Forms"
   ])

-(def vars-cbx-value-fn-map {"Aliases"  #(symbols-of-ns-coll
-                                         :aliases ns-aliases %1 %2 %3)
-                            "Classes - all"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-imports %1 %2 %3)
-                            "Vars - all"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns %1 %2 %3)
-                            "All"      #(symbols-of-ns-coll
-                                         :ns-map-subset ns-map %1 %2 %3)
-                            "Classes - deftype"      #(symbols-of-ns-coll
-                                         :ns-map-subset ns-map-deftype %1 %2 %3)
-                            "Classes - defrecord"    #(symbols-of-ns-coll
-                                         :ns-map-subset ns-map-defrecord %1 %2 %3)
-                            "Vars - public"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-publics %1 %2 %3)
-                            "Vars - macro"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-macro %1 %2 %3)
-                            "Vars - defn"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-defn %1 %2 %3)
-                            "Vars - protocol"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-protocol %1 %2 %3)
-                            "Vars - protocol-fn"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-protocol-fn %1 %2 %3)
-                            "Vars - multimethod"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-var-multimethod %1 %2 %3)
-                            "Vars - dynamic"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-var-dynamic %1 %2 %3)
-                            "Vars - traced"  #(symbols-of-ns-coll
-                                         :ns-map-subset ns-interns-var-traced %1 %2 %3)
-                            "Vars - private" #(symbols-of-ns-coll
-                                         :ns-map-subset ns-privates %1 %2 %3)
-                            "Refers - all"   #(symbols-of-ns-coll
-                                         :ns-map-subset ns-refers %1 %2 %3)
-                            "Refers w/o core"   #(symbols-of-ns-coll
-                                         :ns-map-subset ns-refers-wo-core %1 %2 %3)
-                            "Special-Forms" #(symbols-of-ns-coll
-                                              :special-forms ns-special-forms %1 %2 %3)
-                            })
+(defn sonc [ns-action f]
+  (fn [ns-coll display-fqn? search-places]
+    (symbols-of-ns-coll ns-action f ns-coll display-fqn? search-places)))
+
+(def vars-cbx-value-fn-map
+  {"Aliases"             (sonc :aliases ns-aliases)
+   "Classes - all"       (sonc :ns-map-subset ns-imports)
+   "Vars - all"          (sonc :ns-map-subset ns-interns)
+   "All"                 (sonc :ns-map-subset ns-map)
+   "Classes - deftype"   (sonc :ns-map-subset ns-map-deftype)
+   "Classes - defrecord" (sonc :ns-map-subset ns-map-defrecord)
+   "Vars - public"       (sonc :ns-map-subset ns-publics)
+   "Vars - macro"        (sonc :ns-map-subset ns-interns-macro)
+   "Vars - defn"         (sonc :ns-map-subset ns-interns-defn)
+   "Vars - protocol"     (sonc :ns-map-subset ns-interns-protocol)
+   "Vars - protocol-fn"  (sonc :ns-map-subset ns-interns-protocol-fn)
+   "Vars - multimethod"  (sonc :ns-map-subset ns-interns-var-multimethod)
+   "Vars - dynamic"      (sonc :ns-map-subset ns-interns-var-dynamic)
+   "Vars - traced"       (sonc :ns-map-subset ns-interns-var-traced)
+   "Vars - private"      (sonc :ns-map-subset ns-privates)
+   "Refers - all"        (sonc :ns-map-subset ns-refers)
+   "Refers w/o core"     (sonc :ns-map-subset ns-refers-wo-core)
+   "Special-Forms"       (sonc :special-forms ns-special-forms)
+   })

 (def doc-lb-value-list ["Doc" "Source" "Examples"


Remove debug statements. #183

Remove debug statements. #183

--- src/cljs/clojuredocs/ajax.cljs
+++ src/cljs/clojuredocs/ajax.cljs
@@ -67,8 +67,6 @@
                          (-> headers
                              (get "Content-Type"))
                          "")
-        _ (.log js/console (str "AJAX CONTENT TYPE " (pr-str content-type)))
-        _ (.log js/console (str "HEADERS " (pr-str headers)))
         body (condp #(re-find %1 %2) content-type
                #"application/json" (-> body
                                        json-parse


Refactor movement-component into sub-components

--- src/cljs/movement/session.cljs
+++ src/cljs/movement/session.cljs
@@ -76,23 +76,17 @@
           (session/assoc-in! [:movement-session :parts] new-parts)))
       (session/assoc-in! [:movement-session :parts part-number] new-part))))

-(defn remove-session [event]
-  (.preventDefault event)
+(defn remove-session [e]
   (session/remove! :movement-session))

 (defn reset-session [e]
-  (session/put! :movement-session {:title "ABC" :parts [[]] :activity "Styrketrening"}))
+  (session/put! :movement-session {:title "ABC" :parts [[]]}))

 (defn generate-session [e]
-  (.preventDefault e)
   (let [n (inc (rand-int 8))
         movements (vec (take n (shuffle (data/all-movements-english))))
-        new-session {:title "ABC" :parts [movements] :activity "Styrketrening"}]
+        new-session {:title "ABC" :parts [movements]}]
     (session/put! :movement-session new-session)))
-
-(defn create-session-from-activity [event activity]
-  (.preventDefault event)
-  (session/put! :movement-session {:parts [[]] :activity activity}))

 (defn update-movement [{:keys [id m parts part-number pos]}]
   (let [rep-input (-> (.getElementById js/document (str "rep-input" id)) .-value int)
@@ -112,114 +106,94 @@
    [:div.pure-u {:style {:color "#9999cc" :font-size "100%" :text-align 'center}} data]
    [:span.pure-u {:style {:padding-top 10}} name]])

+(defn m-title [{:keys [name]}]
+  [:div.pure-g
+    [:div.pure-u-1 {:style {:display 'flex :text-align 'center}}
+      [:h3.title {:style {:margin 'auto}} name]]])
+
+(defn m-image [{:keys [name image]}]
+  [:div.pure-u-1
+    [:img.graphic {:src (str "http://s3.amazonaws.com/mumrik-movement-images/" image)
+                  :title name :alt name}]])
+
+(defn m-spec [{:keys [weight rep distance duration rest]}]
+  [:div.pure-g
+    [:div.pure-u-1
+      [:div.pure-g
+       [:div.pure-u-1
+        (if (pos? weight)
+          (r-component {:data weight :name "kg"})
+          [:div.pure-g {:style {:opacity 0.0}}
+           [:div.pure-u {:style {:font-size "200%"}} 0]])]]
+      [:div.pure-g
+       [:div.pure-u-1
+        (when (pos? rep) (r-component {:data rep :name "reps"}))
+        (when (pos? distance) (r-component {:data distance :name "m"}))
+        (when (pos? duration) (r-component {:data duration :name "s"}))]]
+      [:div.pure-g
+       [:div.pure-u-1
+        (when (pos? rest) (r-component {:data rest :name "s pause"}))]]]])
+
+#_(defn m-adjust [{:keys [id rep distance duration weight rest] parts pos}]
+  [:div.pure-g
+   [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+    [:label "Reps"]
+    [:input {:style {:margin-left 3 :width 75}
+             :id    (str "rep-input" id) :type "number" :defaultValue rep :min 0}]]
+   [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+    [:label "Distance"]
+    [:input {:style {:margin-left 3 :margin-right 3 :width 75}
+             :id    (str "distance-input" id) :type "number" :defaultValue distance :min 0}]
+    [:span "m"]]
+   [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+    [:label "Time"]
+    [:input {:style {:margin-left 3 :margin-right 3 :width 75}
+             :id    (str "duration-input" id) :type "number" :defaultValue duration :min 0}]
+    [:span "sec"]]
+   [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+    [:label "Weight"]
+    [:input {:style {:margin-left 3 :width 75}
+             :id    (str "weight-input" id) :type "number" :defaultValue weight :min 0 :step 0.5}]]
+   [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
+    [:label "Rest"]
+    [:input {:style {:margin-left 3 :margin-right 3 :width 75}
+             :id    (str "rest-input" id) :type "number" :defaultValue rest :min 0}]
+    [:span "sec"]]
+   [:a.pure-u-1-3.pure-button.pure-button-primary {
+       :style {:margin "5px 5px 5px 5px"}
+       :onClick #(update-movement {:id id :m m :parts parts :part-number part-number :pos pos})
+     } "Update"]])
+
+(defn m-adjust [m kw part-number text]
+  [:a.pure-u {:style {:margin "5px 5px 5px 5px"
+                      :opacity 0.6}
+              :onClick #(if (= kw :remove)
+                          (remove-movement % m part-number)
+                          (replace-movement % {:kw kw :movement m :part-number part-number}))}
+    text])
+
 (defn movement-component
   [{:keys [id name image slot-category measurement previous next
            rep set performed-sets distance duration weight rest] :as m}
    part-number]
   (let [parts (session/get-in [:movement-session :parts])
         pos (positions #{m} (get parts part-number))
-        expand (atom false)]
+        expand (atom true)]
     (fn []
       [:div.pure-g.movement {:id id}
-       [:div.pure-u-1
-        [:div.pure-g {:style {:cursor 'pointer}}
-         [:div.pure-u-1-5 {:onClick    (fn [e] (.preventDefault e) (reset! expand (not @expand)))}
-          [:img.graphic {:src   (str "http://s3.amazonaws.com/mumrik-movement-images/" image)
-                         :title name :alt name}]]
-         [:div.pure-u-2-5 {:onClick    (fn [e] (.preventDefault e) (reset! expand (not @expand)))
-                           :style      {:display 'flex :text-align 'center}}
-          [:h3.title {:style {:margin 'auto}} name]]
-         [:div.pure-u-1-5 {:onClick    (fn [e] (.preventDefault e) (reset! expand (not @expand)))}
-
-          [:div.pure-g
-           [:div.pure-u-1
-            (if (pos? weight)
-              (r-component {:data weight :name "kg"})
-              [:div.pure-g {:style {:opacity 0.0}}
-               [:div.pure-u {:style {:font-size "200%"}} 0]])]]
-          [:div.pure-g
-           [:div.pure-u-1
-            (when (pos? rep) (r-component {:data rep :name "reps"}))
-            (when (pos? distance) (r-component {:data distance :name "m"}))
-            (when (pos? duration) (r-component {:data duration :name "s"}))]]
-          [:div.pure-g
-           [:div.pure-u-1
-            (when (pos? rest) (r-component {:data rest :name "s pause"}))]]]
-
-         [:div.pure-u-1-5.set-area {:onClick    #(inc-set-completed % m part-number)}
-          [:div.pure-g
-           [:div.pure-u-1
-            [:i.fa.fa-minus
-             {:onClick    #(dec-set-completed % m part-number)
-              :style      {:opacity    (when-not performed-sets 0)
-                           :color      (when performed-sets 'red)
-                           :margin-top 5 :margin-right 5
-                           :float      'right}}]]]
-          (if set
-            [:div.pure-g {:style {:display 'flex}}
-             [:div.pure-u {:style {:margin 'auto :margin-top 10 :opacity 0.05 :font-size "100%"}} set]]
-            [:div.pure-g {:style {:display 'flex}}
-             [:div.pure-u {:style {:margin 'auto :margin-top 10 :opacity 0 :font-size "100%"}} 1]])
-          (when performed-sets
-            [:div.pure-g
-             [:div.pure-u-1 [:h1.center {:style {:color 'red :margin-top -70 :font-size "150%"}} performed-sets]
-              ]])
-          (when (or performed-sets (> set 0))
-            [:div.pure-g
-             [:div.pure-u-1 [:div.center {:style {:margin-top (if performed-sets -24 -6)
-                                                  :opacity    0.15}} "set"]]])]]
-
-        (when @expand
-          [:div
-           [:div.pure-g
-            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
-             [:label "Repetisjoner"]
-             [:input {:style {:margin-left 3 :width 75}
-                      :id    (str "rep-input" id) :type "number" :defaultValue rep :min 0}]]
-            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
-             [:label "Avstand"]
-             [:input {:style {:margin-left 3 :margin-right 3 :width 75}
-                      :id    (str "distance-input" id) :type "number" :defaultValue distance :min 0}]
-             [:span "m"]]
-            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
-             [:label "Tid"]
-             [:input {:style {:margin-left 3 :margin-right 3 :width 75}
-                      :id    (str "duration-input" id) :type "number" :defaultValue duration :min 0}]
-             [:span "sek"]]
-            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
-             [:label "Vekt"]
-             [:input {:style {:margin-left 3 :width 75}
-                      :id    (str "weight-input" id) :type "number" :defaultValue weight :min 0 :step 0.5}]]
-            [:div.pure-u {:style {:margin "5px 5px 5px 5px"}}
-             [:label "Hvile"]
-             [:input {:style {:margin-left 3 :margin-right 3 :width 75}
-                      :id    (str "rest-input" id) :type "number" :defaultValue rest :min 0}]
-             [:span "sek"]]
-            [:a.pure-u-1-3.pure-button.pure-button-primary {
-                :style {:margin "5px 5px 5px 5px"}
-                :onClick #(update-movement {:id id :m m :parts parts :part-number part-number :pos pos})
-              } "Oppdater"]]
-           [:div.pure-g
-            [:a.pure-u.pure-button {:style   {:margin "5px 5px 5px 5px"}
-                                    :onClick #(remove-movement % m part-number)
-                                    :title   "Fjern øvelse"}
-             [:i.fa.fa-remove {:style {:color "#CC9999" :opacity 0.8}}]
-             "Fjern øvelse"]
-            [:a.pure-u.pure-button {
-                :style      {:margin "5px 5px 5px 5px"} :title "Bytt øvelse"
-                :onClick    #(replace-movement % {:kw :swap :movement m :part-number part-number})
-              }
-              [:i.fa.fa-random {:style {:color "#99cc99" :opacity 0.8}}] "Bytt ut øvelse"]
-            (when previous
-              [:a.pure-u.pure-button {:style {:margin "5px 5px 5px 5px"}
-                                      :onClick #(replace-movement % {:kw :previous :movement m :part-number part-number})
-                                      :title "Bytt med enklere"}
-               [:i.fa.fa-arrow-down {:style {:color "#99cc99" :opacity 0.8}}] "Bytt med enklere"])
-            (when next
-              [:a.pure-u.pure-button {:style {:margin "5px 5px 5px 5px"}
-                                      :onClick #(replace-movement % {:kw :next :movement m :part-number part-number})}
-               [:i.fa.fa-arrow-up {:style {:color "#99cc99" :opacity 0.8}}]
-               "Bytt med vanskeligere"])]])]])))
+        [:div.pure-u-2-3
+          [:div.pure-g
+            [m-title m]]
+          [:div.pure-g
+            [m-spec m]]
+          [:div.pure-g
+            [m-adjust m :remove part-number "Remove"]
+            [m-adjust m :swap part-number "Swap"]
+            (when previous [m-adjust m :previous part-number "Easier"])
+            (when next [m-adjust m :next part-number "Harder"])]]
+        [:div.pure-u-1-3
+          [:div.pure-g
+            [m-image m]]]])))

 (defn all-movements [e show-search-input?]
   (.preventDefault e)


Editable notes! So painless

Editable notes! So painless

--- src/cljs/retrobard/client.cljs
+++ src/cljs/retrobard/client.cljs
@@ -54,7 +54,9 @@
   (delete-note [column-id id state]
                (update-in state [column-id :notes] dissoc id))
   (new-vote [id column-id note-id state]
-            (update-in state [column-id :notes note-id :votes] conj id)))
+            (update-in state [column-id :notes note-id :votes] conj id))
+  (edit-note [id column-id new-text state]
+             (assoc-in state [column-id :notes id :text] new-text)))

 (defn apply-actions [actions initial-state]
   (reduce (fn [state action]
@@ -163,6 +165,46 @@
                          :className "new-environment"}
                     "New Environment")))))

+
+(defn display [show]
+  (if show
+    #js {}
+    #js {:display "none"}))
+
+(defn handle-change [e data edit-key owner]
+  (om/transact! data edit-key (fn [_] (.. e -target -value))))
+
+(defn end-edit [text owner cb]
+  (om/set-state! owner :editing false)
+  (cb text))
+
+
+(defn editable [data owner {:keys [edit-key on-edit] :as opts}]
+  (reify
+    om/IInitState
+    (init-state [_]
+      {:editing false})
+    om/IRenderState
+    (render-state [_ {:keys [editing]}]
+      (let [text (get data edit-key)]
+        (dom/span nil
+                (dom/span #js {:style (display (not editing))
+                               :onClick (fn [el] (om/set-state! owner :editing true))}
+                          text)
+                (dom/input
+                 #js {:style (display editing)
+                      :value text
+                      :onChange #(handle-change % data edit-key owner)
+                      :onKeyPress #(when (== (.-keyCode %) 13)
+                                     (end-edit text owner on-edit))
+                      :onBlur (fn [e]
+                                (when (om/get-state owner :editing)
+                                  (end-edit text owner on-edit)))})
+                (dom/button
+                 #js {:style (display (not editing))
+                      :onClick #(om/set-state! owner :editing true)}
+                 "Edit"))))))
+
 (defn note-view [app owner]
   (reify
     om/IRender
@@ -170,7 +212,9 @@
       (let [{:keys [connection column-id note]} app
             [id note] note]
         (dom/div #js {:className "note"}
-                 (:text note) " "
+                 (om/build editable note
+                           {:opts {:edit-key :text
+                                   :on-edit (partial edit-note connection id column-id)}})
                  (count (:votes note)) " votes!"
                  (om/build create-vote-button {:connection connection
                                                :column-id column-id


add an helper to get the full list of scopes in a comment (#730)

--- src/ctia/auth/capabilities.clj
+++ src/ctia/auth/capabilities.clj
@@ -1,7 +1,8 @@
 (ns ctia.auth.capabilities
   (:require
    [ctia.entity.entities :refer [entities]]
-   [clojure.set :as set]))
+   [clojure.set :as set]
+   [clojure.string :as string]))

 (def all-entities
   (set (conj (keys entities) :verdict)))
@@ -45,10 +46,41 @@
    misc-capabilities
    all-entity-capabilities))

+
 (def all-capabilities-no-casebook
   (set/union
    misc-capabilities
    all-entity-no-casebook-capabilities))
+
+
+(comment
+
+  ;; A nice to have feature to help provide a list of meaningful scopes in the
+  ;; documentation
+  ;; It shouldn't be part of the real code so let's keep it in a comment.
+  ;;
+  ;; Typically it was used to provide the full list of scopes here:
+  ;;
+  ;; https://github.com/threatgrid/iroh-ui/issues/492#issuecomment-402153118
+
+  (defn cap-to-scope
+    [k]
+    (let [[loc p] (string/split (name k) #"-" 2)
+          suff (if (#{"list" "search" "read"} loc)
+                 ":read"
+                 ":write")
+          n (if (= "list" loc)
+              (subs p 0 (dec (count p)))
+              p)]
+      (if n
+        (str "private-intel/" n suff)
+        (str "private-intel/" loc))))
+
+  (sort (set/union
+         #{"casebook:read" "casebook:write"}
+         (set (map cap-to-scope all-capabilities-no-casebook))))
+
+  )

 (def default-capabilities
   {:user


New functions verbose-show-configuration? and include-jenkins-reply?

--- src/emender_jenkins/config.clj
+++ src/emender_jenkins/config.clj
@@ -86,3 +86,13 @@
     [request]
     (-> request :configuration :config :pretty-print))

+(defn verbose-show-configuration?
+    "Read the verbose-show-configuration settings."
+    [request]
+    (-> request :configuration :config :verbose-show-configuration))
+
+(defn include-jenkins-reply?
+    "Read the include-jenkins-reply settings."
+    [request]
+    (-> request :configuration :config :include-jenkins-reply))
+


Fix draft board assembling.

Fix draft board assembling.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -68,7 +68,7 @@
     (assemble-board org-slug board entries ctx)))

   ;; Recursion to finish up both kinds of boards
-  ([org-slug :guard string? board :guard map? entry-reps :guard seq? ctx]
+  ([org-slug :guard string? board :guard map? entry-reps :guard coll? ctx]
   (let [slug (:slug board)
         authors (:authors board)
         author-reps (map #(board-rep/render-author-for-collection org-slug slug % (:access-level ctx)) authors)


Too much whitespace in log statement

Too much whitespace in log statement

--- src/onyx/state/bookkeeper.clj
+++ src/onyx/state/bookkeeper.clj
@@ -46,7 +46,7 @@
                                                   (.setLedgerDirNames (into-array String [ledger-dir]))
                                                   (.setAllowLoopback true))
                                     server (BookieServer. server-conf)]
-                                (info "Starting BookKeeper server on port " port)
+                                (info "Starting BookKeeper server on port" port)
                                 (.start server)
                                 {:server server
                                  :port port


Provide default content-type, even for blank accept headers.

--- src/lcmap/aardvark/landsat.clj
+++ src/lcmap/aardvark/landsat.clj
@@ -149,9 +149,9 @@
       (update :body json/encode)
       (assoc-in [:headers "Content-Type"] "application/json")))

-(def supported-types (accept "text/html" to-html
+(def supported-types (accept :default to-json
                              "application/json" to-json
-                             "*/*" to-json))
+                             "text/html" to-html))

 (defn respond-with
   ""


Added cljx-nrepl-middleware

Added cljx-nrepl-middleware

--- src/leiningen/new/chestnut.clj
+++ src/leiningen/new/chestnut.clj
@@ -48,6 +48,14 @@
   (cond-> []
           (cljx? opts) (conj cljx-plugin)))

+(defn project-nrepl-middleware [opts]
+  (cond-> []
+          (cljx? opts) (conj "cljx.repl-middleware/wrap-cljx")))
+
+(defn middle-wares [list]
+  (fn []
+    (join "" (map #(str "\n" (apply str (repeat 53 " ")) %) list))))
+
 (defn template-data [name opts]
   {:full-name name
    :name (project-name name)
@@ -58,6 +66,7 @@
    :core-cljs-requires (dep-list 12 (core-cljs-requires opts))
    :project-clj-deps (dep-list 17 (project-clj-deps opts))
    :project-dev-plugins (dep-list 29 (project-plugins opts))
+   :nrepl-middleware (middle-wares (project-nrepl-middleware opts))
    :server-command (if (http-kit? opts) "run-server" "run-jetty")
    :compojure-handler (if (site-middleware? opts) "site" "api")
    :not-om-tools? (fn [block] (if (om-tools? opts) "" block))


select result when wrapping with parentheses

--- src/lt/plugins/auto_paren.cljs
+++ src/lt/plugins/auto_paren.cljs
@@ -35,7 +35,7 @@
                        (fn []
                          (let [current-selection (editor/selection this)]
                            (if-not (= current-selection "")
-                             (editor/replace-selection this (str ch current-selection (pairs ch)))
+                             (editor/replace-selection this (str ch current-selection (pairs ch)) :around)
                              (if (re-seq word-char (get-char this 1))
                                (editor/insert-at-cursor this ch)
                                (do


fix tests

fix tests

--- test/babel/test/parse.cljc
+++ test/babel/test/parse.cljc
@@ -51,7 +51,12 @@
   (is (= 2 (count (toks "je suis" lookup)))))

 (deftest toks-test2
-  (is (= 2 (count (nth (toks "je suis" lookup) 0)))))
+  ;;  (toks2 (string/split "je suis" tokenizer) 2) => (["je suis"] ["je" "suis"])
+  (is (or (= 1 (count (nth (toks "je suis" lookup) 0)))
+          (= 1 (count (nth (toks "je suis" lookup) 1))))))
+

 (deftest toks-test3
-  (is (= 2 (count (nth (toks "je suis" lookup) 1)))))
+  (is (or (= 2 (count (nth (toks "je suis" lookup) 0)))
+          (= 2 (count (nth (toks "je suis" lookup) 1))))))
+


(SERVER-1704) Log error when flush times out

--- src/clj/puppetlabs/services/puppet_admin/puppet_admin_core.clj
+++ src/clj/puppetlabs/services/puppet_admin/puppet_admin_core.clj
@@ -10,7 +10,8 @@
             [puppetlabs.puppetserver.ring.middleware.params :as pl-ring-params]
             [puppetlabs.i18n.core :as i18n]
             [slingshot.slingshot :as sling]
-            [ring.util.response :as rr]))
+            [ring.util.response :as rr]
+            [clojure.tools.logging :as log]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -58,6 +59,7 @@
     {:status 204}
     ; If a lock timeout occurs return a 503 Service Unavailable
     (catch [:kind :puppetlabs.services.jruby-pool-manager.impl.jruby-agents/jruby-lock-timeout] e
+      (log/error (:msg e))
       (-> (rr/response (:msg e))
           (rr/status 503)
           (rr/content-type "text/plain")))))


started making ui

started making ui

--- mtg-pairings-wer/src/mtg_pairings/core.clj
+++ mtg-pairings-wer/src/mtg_pairings/core.clj
@@ -1,6 +1,41 @@
 (ns mtg-pairings.core
-  (:gen-class))
+  (:gen-class)
+  (:use seesaw.core)
+  (:use seesaw.chooser))

-(defn -main
-  []
-  )+(native!)
+
+
+(def database-location (text "Insert database location here."))
+
+(def server-address  (text "Insert server address here."))
+
+(defn select-file []
+  (text! database-location
+         (choose-file :success-fn (fn [fc file] (.getAbsolutePath file)))))
+
+(def database-button (button :text "..."
+                       :listen [:action #(select-file)]))
+
+
+
+(defn main-window []
+  (frame
+    :on-close :dispose
+    :title "MTG pairings database sniffer"
+    :size [300 :by 300]
+    :content (grid-panel
+               :columns 3
+               :border "Settings"
+               :vgap 5
+               :hgap 5
+               :items ["Database file" database-location database-button
+                       "Server address" server-address])
+               ))
+
+
+(defn -main []
+ (invoke-later
+   (-> (main-window)
+     pack!
+     show!)))


Add a `code` element.

Add a `code` element.

--- src/main/clojure/ssblog/md.clj
+++ src/main/clojure/ssblog/md.clj
@@ -122,6 +122,15 @@
        :table table
        :title title
        :footer footer})))
+
+(defn preprocess-code
+  [id [element body]]
+  (when-let [match (re-find #"(?s)([\d\.]+) \[([^\]]+)\] \[([\w ]+)\] \[([\w ]+)\]" body)]
+    (let [[_ number code title footer] match]
+      {:element element
+       :number number
+       :code code
+       :title title
        :footer footer})))

 (defn preprocess-special-element
@@ -130,6 +139,7 @@
       "eq" (preprocess-equation id element-and-body)
       "fig" (preprocess-figure id element-and-body)
       "table" (preprocess-table id element-and-body)
+      "code" (preprocess-code id element-and-body)
       nil))

 (defn preprocess-special-elements


Make meter test more resilient.

Make meter test more resilient.

--- test/blocks/meter_test.clj
+++ test/blocks/meter_test.clj
@@ -74,10 +74,17 @@
       @(s/put! stream :x)
       @(s/put! stream :x)
       (Thread/sleep 30)
-      (is (= [{:type ::meter/list-stream
-               :label "TestStore"
-               :value 2}]
-             @events))
+      (is (or (= [{:type ::meter/list-stream
+                   :label "TestStore"
+                   :value 2}]
+                 @events)
+              (= [{:type ::meter/list-stream
+                   :label "TestStore"
+                   :value 1}
+                  {:type ::meter/list-stream
+                   :label "TestStore"
+                   :value 1}]
+                 @events)))
       (reset! events [])
       @(s/put! stream :x)
       (s/close! stream)


Fix test broken in merge.

Fix test broken in merge.

--- test/minijava/test_x86.clj
+++ test/minijava/test_x86.clj
@@ -1,33 +1,32 @@
 (ns minijava.test-x86
   (:use clojure.test
         (minijava label x86)))
-
+
 (deftest tests-uni-no-formals
   (let [frame (new-x86 0 [])
         vars  (for [i (range 4)] (allocLocal frame (str i) (= (mod i 2) 0)))]
     (is (zero? (count (formals frame))) "No formals allocated")
     (is (apply distinct? vars) "Locals are unique")))
-
+
 (deftest tests-uni-several-formals
   (let [frame   (new-x86 0 ["obj" "arg1" "arg2" "arg3"])
         formals (formals frame)
         locals  (for [i (range 4)] (allocLocal frame (str i) true))
         vars    (concat formals locals)]
-    (is (= (count escapes) (count formals)))
+    (is (= 4 (count formals)))
     (is (apply distinct? vars) "Formals and locals are unique")))
-
+
 (deftest tests-spacing-of-formals
-
   (let [frame   (new-x86 0 ["obj" "arg1" "arg2"])
         spacing (map :offset (formals frame))]
     (is (= [8, 12, 16] spacing) "Formals are properly spaced")))
-
+
 (deftest tests-spacing-of-locals
   (let [frame   (new-x86 0 [])
         locals  (for [i (range 3)] (allocLocal frame (str i) true))
         spacing (map :offset locals)]
     (is (= [-4, -8, -12] spacing) "Locals are properly spaced")))
-
+
 (deftest tests-location-of-fp-and-rv
   (let [frame (new-x86 0 ["obj"])]
     (is (= (InFrame 4) (rv frame)) "Return address correct")
@@ -35,12 +34,12 @@
     (is (= 0 (fp frame)) "Frame pointer correct w/o alloc")
     (allocLocal frame "temp" true)
     (is (= -4 (fp frame)) "Frame pointer correct w/ alloc")))
-
+
 (deftest tests-lookup-of-formal
   (let [frame (new-x86 0 ["obj" "arg1"])]
     (is (= (obj frame) (lookup frame "obj")) "Object lookup correct")
     (is (= (InFrame 12) (lookup frame "arg1")) "Argument lookup correct")))
-
+
 (deftest tests-lookup-of-local
   (let [frame (new-x86 0 ["obj"])
         local (allocLocal frame "hello" true)]


(TK-476) Handle bad requests to the RBAC server

Deny access to requests when the token is expired, revoked, or the RBAC
server is not available.

--- src/puppetlabs/trapperkeeper/authorization/ring_middleware.clj
+++ src/puppetlabs/trapperkeeper/authorization/ring_middleware.clj
@@ -239,8 +239,18 @@
    token->subject :- (schema/maybe IFn)]
   (if token->subject
     (if-let [token (get-in request [:headers "x-authentication"])]
-      (assoc request :rbac-subject (token->subject token))
-      request)
+      (sling/try+
+        (assoc request :rbac-subject (token->subject token))
+        (catch [:kind :puppetlabs.rbac/token-revoked] {:keys [msg]}
+          (log/error "Failure validating RBAC token:" msg)
+          request)
+        (catch [:kind :puppetlabs.rbac/token-expired] {:keys [msg]}
+          (log/error "Failure validating RBAC token:" msg)
+          request)
+        (catch [:kind :puppetlabs.rbac-client/connection-failure] {:keys [msg]}
+          (log/error "Failure validating RBAC token:" msg)
+          request))
+        request)
     request))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;