in (parse), remember original input for diagnostic logging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -122,35 +122,37 @@
    In the latter case, the tokens will be produced by splitting a string in
    some language-dependent. If the input is a string, then use a
    language-independent tokenizer to turn the string into a sequence of tokens."
-  ([input model]
-   (log/info (str "parsing input: '" input "'"))
-   (cond (string? input)
-         (parse (filter #(not (empty? %)) (string/split input tokenizer)) model)
+  ([input model & [original-input]]
+   (let [original-input (if original-input original-input input)]
+     (log/info (str "parsing input: '" input "'"))
+     (cond (string? input)
+           (parse (filter #(not (empty? %)) (string/split input tokenizer)) model original-input)

-         (or (seq? input) (vector? input))
-         ;; assume input is a list of tokens.
-         (let [tokens input
-               token-count (count tokens)
-               token-count-range (range 0 token-count)
-               input-map (zipmap (map (fn [i] [i (+ i 1)])
-                                      token-count-range)
-                                 (map (fn [i] [(nth tokens i)])
-                                      token-count-range))]
-           (log/debug (str "input map:" input-map))
-           (let [all-parses
-                 (parses input-map token-count model
-                         (span-map token-count))
-                 result
-                 {:token-count token-count
-                  :complete-parses
-                  (filter map? (get all-parses
-                                    [0 token-count]))
-                  :all-parses all-parses}]
-             (if (empty? (:complete-parses result))
-               (log/warn (str "could not parse: " input))
-               (log/info (str "successfully parsed input: " input "")))
-             (:complete-parses result)))
+           (or (seq? input) (vector? input))
+           ;; assume input is a list of tokens.
+           (let [tokens input
+                 token-count (count tokens)
+                 token-count-range (range 0 token-count)
+                 input-map (zipmap (map (fn [i] [i (+ i 1)])
+                                        token-count-range)
+                                   (map (fn [i] [(nth tokens i)])
+                                        token-count-range))]
+             (log/debug (str "input map:" input-map))
+             (let [all-parses
+                   (parses input-map token-count model
+                           (span-map token-count))
+                   result
+                   {:token-count token-count
+                    :complete-parses
+                    (filter map? (get all-parses
+                                      [0 token-count]))
+                    :all-parses all-parses}]
+               (if (empty? (:complete-parses result))
+                 (log/warn (str "could not parse: '" original-input "'"))
+                 (log/info (str "successfully parsed input: '" original-input "'")))
+               (:complete-parses result)))

-         true
-         (throw (Exception. "Don't know how to parse input of type: " (type input))))))
+           true
+           (throw (Exception. "Don't know how to parse input of type: " (type input)))))))
+


disable truncation for debugging

disable truncation for debugging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -189,7 +189,7 @@
                                                         (truncate parent [[:comp]
                                                                           [:head]]
                                                                   model)))
-                                                  trees))]
+                                                     trees))]
                                        (if (not (empty? trees))
                                          (log/trace (str "parse/parses: trees: "
                                                          (string/join ","
@@ -201,7 +201,7 @@
                                        (log/trace (str " right: "
                                                        (string/join ","
                                                                     (map #(morph-ps %) right-signs))))
-                                       (if parse-with-truncate truncated-trees trees)))
+                                       (if (and false parse-with-truncate) truncated-trees trees)))
                                    ;; TODO: explain why we can use (first) here for the left- and right-strings.
                                    ;; Throw an exception if (> 1 (count left-strings)) or (> 1 (count right-strings))
                                    [(string/join " " [(first left-strings) (first right-strings)])]))


Fix timeout wrong params.

Fix timeout wrong params.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -204,7 +204,7 @@
    (.timeout ob ms))
   ([^number ms ^observable other ^observable ob]
    {:pre [(number? ms)]}
-   (.timeout ob other ms)))
+   (.timeout ob ms other)))

 (defn delay
   "Time shifts the observable sequence by dueTime. The relative


Make set-event-listener to accept handler functions

And simplify listen and listen-and-print-data functions in the process.

--- src/clj_dde/core.clj
+++ src/clj_dde/core.clj
@@ -8,34 +8,25 @@
 ;; implement the DDEClientEventListener interface

 (defn set-event-listener
-  [conv]
+  [conv & {:keys [on-disconnect on-item-changed]
+           :or {on-disconnect (fn [_])
+                on-item-changed (fn [_ _ _ _])}}]
   (doto conv
     (.setEventListener
       (reify DDEClientEventListener
-        (onItemChanged [this topic item data]
-          (prn (str "Item Changed: " topic  " , " item  " , " data )))
-        (onDisconnect [this]
-          (prn (str "onDisconnect() called.")))))))
+        (onItemChanged [this topic item data] (on-item-changed this topic item data))
+        (onDisconnect  [this] (on-disconnect this))))))

 (defn listen
   [conv]
-  (doto conv
-    (.setEventListener
-      (reify DDEClientEventListener
-        (onItemChanged [this _ _ data]
-          (data))
-        (onDisconnect [this]
-          (prn (str "onDisconnect() called.")))))))
+  (set-event-listener conv
+                      :on-disconnect (fn [_] (prn (str "onDisconnect() called.")))))

 (defn listen-and-print-data
   [conv]
-  (doto conv
-    (.setEventListener
-      (reify DDEClientEventListener
-        (onItemChanged [this _ _ data]
-          (prn (str data)))
-        (onDisconnect [this]
-          (prn (str "onDisconnect() called.")))))))
+  (set-event-listener conv
+                      :on-item-changed (fn [_ _ _ data] (prn (str data)))
+                      :on-disconnect   (fn [_] (prn (str "onDisconnect() called.")))))

 ;; instantiate a DDEClientConversation


Use proper functions

Use proper functions

--- src/cljam/io/wig.clj
+++ src/cljam/io/wig.clj
@@ -94,10 +94,10 @@
                    (let [{:keys [chrom span]
                           :or {span 1}} (->> fields rest fields->map)
                          span (as-long span)
-                         track (into track [{:format :variable-step}
-                                            {:chr chrom}
-                                            {:span span}
-                                            {:step nil}])]
+                         track (assoc track :format :variable-step
+                                            :chr chrom
+                                            :span span
+                                            :step nil)]
                      (deserialize (rest lines) nil track))

                    ; declaration line of fixedStep
@@ -107,10 +107,10 @@
                          step (as-long step)
                          pre-start (- (as-long start) step)
                          span (as-long span)
-                         track (into track [{:format :fixed-step}
-                                            {:chr chrom}
-                                            {:span span}
-                                            {:step step}])]
+                         track (assoc track :format :fixed-step
+                                            :chr chrom
+                                            :span span
+                                            :step step)]
                      (deserialize (rest lines) pre-start track))

                    ; data line
@@ -161,55 +161,49 @@
                   (or (= format :fixed-step)
                       (= format :variable-step))))
               wigs)]}
-  (letfn [(same-track? [first-wig wig]
-            (and (= (-> :track :format first-wig) (-> :track :format wig))
-                 (= (- (:end first-wig) (:start first-wig))
-                    (- (:end wig) (:start wig)))))
-          (serialize [wigs]
-            (lazy-seq
-             (when-first [wig wigs]
-               (let [[track rest-wigs] (split-with (partial same-track? wig)
-                                                   wigs)
-                     track (case (-> track first :track :format)
-                             :variable-step
-                             (let [{:keys [chr start end]} (first track)
-                                   span (inc (- end start))
-                                   track-line (-> track :track :line)
-                                   declaration-line (->> (cond-> ["variableStep"
-                                                                  (str "chrom=" chr)]
-                                                           (not= span 1)
-                                                           (conj (str "span=" span)))
-                                                         (cstr/join \space))
-                                   data-lines (->> track
-                                                   (map (fn [{:keys [start value]}]
-                                                          (cstr/join \space
-                                                                     [start value])))
-                                                   (cstr/join \newline))]
-                               (cstr/join \newline
-                                          (cond-> [declaration-line data-lines]
-                                            track-line (cons track-line))))
-
-                             :fixed-step
-                             (let [{:keys [chr start end]} (first track)
-                                   step (- (-> track second :start) start)
-                                   span (inc (- end start))
-                                   track-line (-> track :track :line)
-                                   declaration-line (->> (cond-> ["fixedStep"
-                                                                  (str "chrom=" chr)
-                                                                  (str "start=" start)]
-                                                           (not= step 1)
-                                                           (conj (str "step=" step))
-
-                                                           (not= span 1)
-                                                           (conj (str "span=" span)))
-                                                         (cstr/join \space))
-                                   data-lines (->> track
-                                                   (map (fn [{:keys [value]}] value))
-                                                   (cstr/join \newline))]
-                               (cstr/join \newline
-                                          (cond-> [declaration-line data-lines]
-                                            track-line (cons track-line)))))]
-                 (cons track (serialize rest-wigs))))))]
+  (letfn [(serialize [wigs]
+            (->> wigs
+                 (sequence
+                  (comp
+                   (partition-by (juxt (comp :format :track)
+                                       #(- (:end %) (:start %))))
+                   (map
+                    (fn [[{{:keys [line format span step]} :track
+                           chr :chr
+                           start :start
+                           end :end} :as xs]]
+                      (case format
+                        :variable-step
+                        (let [declaration-line (->> (cond-> ["variableStep"
+                                                             (str "chrom=" chr)]
+                                                      (not= span 1)
+                                                      (conj (str "span=" span)))
+                                                    (cstr/join \space))
+                              data-lines (->> xs
+                                              (map (fn [{:keys [start value]}]
+                                                     (cstr/join \space
+                                                                [start value])))
+                                              (cstr/join \newline))]
+                          (cstr/join \newline
+                                     (cond->> [declaration-line data-lines]
+                                       line (cons line))))
+
+                        :fixed-step
+                        (let [declaration-line (->> (cond-> ["fixedStep"
+                                                             (str "chrom=" chr)
+                                                             (str "start=" start)]
+                                                      (not= step 1)
+                                                      (conj (str "step=" step))
+
+                                                      (not= span 1)
+                                                      (conj (str "span=" span)))
+                                                    (cstr/join \space))
+                              data-lines (->> xs
+                                              (map (fn [{:keys [value]}] value))
+                                              (cstr/join \newline))]
+                          (cstr/join \newline
+                                     (cond->> [declaration-line data-lines]
+                                       line (cons line)))))))))))]
     (serialize wigs)))

 (defn read-fields
@@ -229,5 +223,4 @@
     (->> xs
          serialize-wigs
          (interpose \newline)
-         (map #(.write w (str %)))
-         dorun)))
+         (run! #(.write w (str %))))))


Added uniform-crossover and two-point-crossover to default genetic-operator-probabilities.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -86,6 +86,8 @@
                                            [:alternation :uniform-mutation] 0.2
                                            :uniform-close-mutation 0.0
                                            :uniform-silence-mutation 0.0
+                                           :uniform-crossover 0.0
+                                           :two-point-crossover 0.0
                                            ; A hill-climbing version of uniform-silence-mutation:
                                            [:make-next-operator-revertable :uniform-silence-mutation] 0.0
                                            :autoconstruction 0.0


add future tense to round-trip parsing tests

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -60,7 +60,6 @@
   (let [result (parse "io parlo")]
     (is (not (empty? result)))
     (is (= "io parlo") (fo (first result)))))
-

 (deftest round-trip-1
   (let [expr (generate {:synsem {:subcat '()
@@ -99,16 +98,23 @@
                            (take do-this-many expressions)))))))))

 (deftest roundtrip-small-grammar
-  (let [do-this-many 200]
+  (let [do-this-many 20]
     (is (empty?
          (filter #(not (nil? %))
                  (let [expressions
-                       (take do-this-many
-                             (repeatedly
-                              #(generate {:synsem {:cat :verb
-                                                   :sem {:tense :present}
-                                                   :subcat '()}}
-                                         small)))]
+                       (concat
+                        (take do-this-many
+                              (repeatedly
+                               #(generate {:synsem {:cat :verb
+                                                    :sem {:tense :present}
+                                                    :subcat '()}}
+                                          small)))
+                        (take do-this-many
+                              (repeatedly
+                               #(generate {:synsem {:cat :verb
+                                                    :sem {:tense :future}
+                                                    :subcat '()}}
+                                          small))))]
                    (pmap (fn [expr]
                            (if (empty? (parse (fo expr) small))
                              (do


allow pluggable prioritization

allow pluggable prioritization

--- src/bolth.clj
+++ src/bolth.clj
@@ -154,7 +154,7 @@
      (if (#{:error :fail} (:result-type previous-result)) (:runtime previous-result))
      (:runtime previous-result)]))

-(defn prioritize-tests [tests]
+(defn smart-prioritize-tests [tests]
   (if-let [results @state/*previous-test-run*]
     (let [mapped-results (into {} (map (fn [[k v]] [(str k) v]) results))
           prioritized
@@ -174,14 +174,12 @@
 (defn default-pharrallelism []
   (.. Runtime getRuntime availableProcessors))

-(defn run-tests
-  ([ns-re] (run-tests ns-re (default-pharrallelism)))
-  ([ns-re pharrallelism]
-   (-> (gather-tests ns-re)
-     deref
-     prioritize-tests
-     pour-tests-to-queue
-     (run-gathered-tests pharrallelism))))
+(defn run-tests [ns-re pharrallelism prioritizer]
+  (-> (gather-tests ns-re)
+    deref
+    prioritizer
+    pour-tests-to-queue
+    (run-gathered-tests pharrallelism)))

 ;; clojure.test monkey punching
 (defmethod clojure.test/assert-expr '= [msg [_ a & more]]
@@ -348,6 +346,23 @@
       (System/exit 1)
       (System/exit 0))))

+(defn options->prioritizer [options]
+  (cond
+    (and (nil? (:prioritizer options)) (nil? (:priority options)))
+    smart-prioritize-tests
+
+    (:prioritizer options)
+    (:prioritizer options)
+
+    (= (:priority options) :agony)
+    smart-prioritize-tests
+
+    (= (:priority options) :random)
+    shuffle
+
+    (= (:priority options) :gathered)
+    identity))
+
 (defn validate-options [options]
   (assert (and (number? (:slow-test-count options 10)) (pos? (:slow-test-count options 10))) (str ":slow-test-count should be a positive number, but was: " (pr-str (:slow-test-count options 10))))
   (assert (and (number? (:warn-on-slow-test-limit-ms options 1000)) (pos? (:warn-on-slow-test-limit-ms options 1000))) (str ":warn-on-slow-test-limit-ms should be a positive number, but was: " (pr-str (:warn-on-slow-test-limit-ms options 1000))))
@@ -407,6 +422,26 @@
   :colored-printing : an boolean (defaults to true)

   sets if bolth will print results with color or not. Defaults to true.
+
+  :priority : an keyword, one of :agony, :random, :gathered (defaults to :agony)
+
+  sets how bolth will order test runs. This interacts with parallelism in an interesting way; whilst the
+  priority does set which tests get to start first, it doesn't dictate the order they finish in.
+  Available options:
+    :agony  : attempts to run tests in an order that gives the quickest feedback. Starts with any new tests,
+              moving on to the fastest failing test, moving on to slower failing tests, then the fastest
+              passing test moving on to the slowest passing test. If there was no previous test run recorded,
+              this is the same as :gathered
+
+    :random : runs tests in a random order (literally just calls `clojure.core/shuffle` on the tests
+
+    :gathered : runs tests in the order they were found by crawling namespaces
+
+  :prioritizer : an function (defaults to nil)
+
+  lets you pass a custom function to determine which order the tests are run in. Takes a seq
+  of [var test-f fixture-each-f fixture-once-f], and returns them in whatever order you like.
+  Note that this takes priority over passing :priority.

   ## Returned value

@@ -451,7 +486,7 @@
        (clear-screen options)
        (let [f (start-flusher (:flush-interval options 10))
              t0 (System/nanoTime)
-             test-run (run-tests ns-re (:parallelism options (default-pharrallelism)))
+             test-run (run-tests ns-re (:parallelism options (default-pharrallelism)) (options->prioritizer options))
              t1 (System/nanoTime)
              results {:test-run test-run
                       :test-runner-state (if *test-runner-state* @*test-runner-state*)


Added *max-output-lines* variable

Added *max-output-lines* variable

--- src/control/core.clj
+++ src/control/core.clj
@@ -8,6 +8,7 @@
 (defvar  *debug* false)
 (defvar-  *enable-logging* true)
 (defvar-  *runtime* (Runtime/getRuntime))
+(defvar- *max-output-lines* 1000)
 (defvar- bash-reset "\033[0m")
 (defvar- bash-bold "\033[1m")
 (defvar- bash-redbold "\033[1;31m")
@@ -41,11 +42,11 @@
     (send-off pagent
               (fn [exec-process]
                 (assoc exec-process :stdout (str (:stdout exec-process)
-                                                 (join "\r\n" (doall (line-seq in)))))))
+                                                 (join "\r\n" (take *max-output-lines*  (line-seq in)))))))
     (send-off pagent
               (fn [exec-process]
                 (assoc exec-process :stderr (str (:stderr exec-process)
-                                                 (join "\r\n" (doall (line-seq err)))))))
+                                                 (join "\r\n" (take *max-output-lines* (line-seq err)))))))
     pagent))

 (defn- await-process [pagent]


Fix playlist slider css

Fix playlist slider css

--- src/css/sbsk/css.clj
+++ src/css/sbsk/css.clj
@@ -216,7 +216,7 @@
      :width (percent 100)
      :height (percent 100)
      :pointer-events :none}]]
-  [:.video-slider
+  [:.video-slider :.playlist-slider
    {:overflow :hidden}]
   [:.noscroll
    {:overflow-y :hidden}])


Add macros to simplify TaggedValue extension.

This handles most of the boilerplate of defining a tag symbol and value
rendition.

--- src/vault/data.clj
+++ src/vault/data.clj
@@ -59,7 +59,6 @@
   (edn-value [this] "Return the EDN value to follow the tag."))

-
 ;; SERIALIZATION FUNCTIONS

 (defn edn-str
@@ -72,10 +71,40 @@
 (defmacro defprint-method
   "Defines a print-method for the given class which writes out the EDN
   serialization from `edn-str`."
-  [c]
-  `(defmethod print-method ~c
+  [t]
+  `(defmethod print-method ~t
      [v# ^java.io.Writer w#]
        (.write w# (edn-str v#))))
+
+
+
+;; EXTENSION FUNCTIONS
+
+(defmacro extend-tagged-value
+  "Extends the TaggedValue protocol with implementations which return the
+  given symbol as the tag and use the body to calculate the value. The symbol
+  'this' is bound to the data. This macro also defines a print-method which
+  delegates to edn-str."
+  [t tag & body]
+  `(do
+     (extend-type ~t
+       TaggedValue
+       (edn-tag [~'this] (quote ~tag))
+       (edn-value [~'this]
+         ~@(if (and (= 1 (count body)) (symbol? (first body)))
+             (list (list (first body) 'this))
+             body)))
+     (defprint-method ~t)))
+
+
+(defmacro extend-tagged-str
+  [c tag]
+  `(extend-tagged-value ~c ~tag str))
+
+
+(defmacro extend-tagged-map
+  [c tag]
+  `(extend-tagged-value ~c ~tag (into {} (seq ~'this))))

@@ -92,32 +121,20 @@
     (.format date-format date)))

-(extend-type Date
-  TaggedValue
-  (edn-tag [this] 'inst)
-  (edn-value [this] (format-utc this)))
+(extend-tagged-value Date inst format-utc)

 ; #uuid - Universally-unique identifier string.
-
-(extend-type UUID
-  TaggedValue
-  (edn-tag [this] 'uuid)
-  (edn-value [this] (str this)))
+(extend-tagged-str UUID uuid)

 ;; EXPANDED EDN TAG SUPPORT

 ; #bin - Binary data in the form of byte arrays.
-
-(extend-type (Class/forName "[B")
-  TaggedValue
-  (edn-tag [this] 'bin)
-  (edn-value [this] (->> this b64/encode (map char) (apply str))))
-
-
-(defprint-method (Class/forName "[B"))
+(extend-tagged-value
+  (Class/forName "[B") bin
+  (->> this b64/encode (map char) (apply str)))

 (defn read-bin
@@ -128,14 +145,7 @@

 ; #uri - Universal Resource Identifier string.
-
-(extend-type URI
-  TaggedValue
-  (edn-tag [this] 'uri)
-  (edn-value [this] (str this)))
-
-
-(defprint-method URI)
+(extend-tagged-str URI uri)

 (defn read-uri


syntax, update headings

syntax, update headings

--- src/cards.clj
+++ src/cards.clj
@@ -538,6 +538,7 @@
       "Emerald Drake" "Laughing Sister" "Nightmare" "Ysera Awakens"])) %)
   }
 }
+; Epics
 {
   :id 180
   :name "Adrenaline Rush"
@@ -987,6 +988,7 @@
   :class :warlock
   :spell (destroy-minions)
 }
+; Rares
 {
   :id 597
   :name "Abomination"
@@ -1054,7 +1056,7 @@
   :minion {
     :attack 4
     :health 5
-    :cant-attack
+    :properties [:cant-attack]
   }
 }
 {
@@ -1522,7 +1524,5 @@
   :overload 2
   :spell (target [:character] (damage-target 5))
 }
-; Epics
-; Rares
 ; Commons
 ])


add bai read test (wip)

add bai read test (wip)

--- test/cljam/t_bam.clj
+++ test/cljam/t_bam.clj
@@ -41,5 +41,6 @@
           ;; generate incomplete bam file on the fly
           (bam/spit f test-sam-incomplete-alignments)
           (bai/create-index f (str f ".bai"))) => anything
-        ;; TODO: must check .bai files
+        (with-open [r (bam/reader (str temp-dir "/test.incomplete.bam"))]
+          (io/read-alignments r {:chr "ref" :start 0 :end 1000})) =future=> (filter #(= "ref" (:rname %)) (:alignments test-sam-sorted-by-pos))
         ))


factor out parseplz

factor out parseplz

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -9,6 +9,7 @@
    [clojure.tools.cli :refer [parse-opts summarize]]
    [degasolv.pkgsys.apt :as apt-pkg]
    [degasolv.pkgsys.core :as degasolv-pkg]
+   [degasolv.pkgsys.subproc :as subproc-pkg]
    [degasolv.resolver :as r :refer :all]
    [degasolv.util :refer :all]
    [me.raynes.fs :as fs]
@@ -16,6 +17,13 @@
    [serovers.core :as vers]
    [tupelo.core :as t])
   (:gen-class))
+
+(as-> (all-ns) it
+  (map #(.toString %) it)
+  (filter #(re-find #"^degasolv\.pkgsys\.[A-Za-z0-9-_]+" %) it)
+  (map #(symbol %) it)
+  (map #(do [% (ns-publics %)]) it)
+  (into (hash-map) it))

 (defn aggregator
   [index-strat cmp]
@@ -48,7 +56,20 @@
   {"apt" {:genrepo apt-pkg/slurp-apt-repo
              :version-comparison "debian"}
    "degasolv" {:genrepo degasolv-pkg/slurp-degasolv-repo
-               :version-comparison "maven"}})
+               :version-comparison "maven"}
+   "subproc" {:genrepo subproc-pkg/slurp-subproc-repo
+              :version-comparison "maven"
+              :cli
+              [
+               ["-x" "--subproc-exe PATH"
+                "Path to the executable to call to get package data"
+                :validate [#(and
+                             (fs/exists? %)
+                             (fs/executable? %))
+                           "Must be an executable file which exists on the file system."]
+                :required true]
+               ]
+              }})

 (defn- generate-repo-index-cli!
   [options arguments]
@@ -319,212 +340,249 @@
    :search-strat "breadth-first"
    })

-(def subcommand-cli
-  {"display-config"
+(def available-option-packs
+  {
+   "multi-version-mode"
    {
-    :description "Print the effective combined configuration (and arguments) of all the given config files."
-    :function display-config!
+    :conflict-strat "inclusive"
+    :resolve-strat "fast"
+    :alternatives false
     }
-   "generate-card"
+    "firstfound-version-mode"
    {
-    :description "Generate dscard file based on arguments given"
-    :function generate-card!
-    :required-arguments {:id ["-i" "--id"]
-                         :version ["-v" "--version"]
-                         :location ["-l" "--location"]}
-    :cli [
-          ["-C" "--card-file FILE"
-           "The name of the card file"
-           :default nil
-           :default-desc (str (:card-file subcommand-option-defaults))
-           :validate [#(not (empty? %))
-                      "Out file must not be empty."]]
-          ["-i" "--id ID"
-           "ID (name) of the package"
-           :validate [#(not (empty? %))
-                      "ID must be a non-empty string."]
-           :required true]
-          ["-l" "--location LOCATION"
-           "URL or filepath of the package"
-           :validate [#(not (empty? %))
-                      "Location must be a non-empty string."]
-           :required true]
-          ["-m" "--meta K=V"
-           "Add additional metadata"
-           :validate [#(re-matches #"^[^=]+=[^=].*$" %)
-                      "Metadata must be presented as <key>=<value> pair."]
-           :id :meta
-           :assoc-fn
-           (fn [m k v]
-             (let [[_ rk rv] (re-find #"^([^=]+)=([^=].*)$" v)]
-               (update-in m [k] #(assoc % (keyword rk) rv))))]
-          ["-r" "--requirement REQ"
-           "List requirement **"
-           :validate [#(re-matches r/str-requirement-regex %)
-                      "Requirement must look like one of these: `!a`, `a`, `a|b`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]
-           :id :requirements
-           :assoc-fn
-           (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-v" "--version VERSION"
-           "Version of the package"
-           :validate [#(re-matches r/version-regex %)
-                      "Sorry, given argument doesn't look like a version."]
-           :required true]
-          ]}
-   "generate-repo-index"
-   {:description "Generate repository index based on degasolv package cards"
-    :function generate-repo-index-cli!
-    :cli [["-a" "--add-to INDEX"
-           "Add to repo index INDEX"]
-          ["-d" "--search-directory DIR" "Find degasolv cards here"
-           :default nil
-           :default-desc (str (:search-directory subcommand-option-defaults))
-           :validate [#(and
-                        (fs/directory? %)
-                        (fs/exists? %))
-                      "Must be a directory which exists on the file system."]]
-          ["-I" "--index-file FILE"
-           "The name of the repo file"
-           :default nil
-           :default-desc (str (:index-file subcommand-option-defaults))]
-          ["-V" "--version-comparison CMP"
-           "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
-           :default nil
-           :default-desc "maven"
-           :validate [#(some #{%} (keys version-comparators))
-                      "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]]}
-
-   "resolve-locations"
-   {:description "Print the locations of the packages which will resolve all given dependencies."
-    :function resolve-locations!
-    :required-arguments {:repositories ["-R" "--repository"]
-                         :requirements ["-r" "--requirement"]}
-    :cli [
-          ["-a" "--enable-alternatives" "Consider all alternatives (default)"
-           :assoc-fn (fn [m k v] (assoc m :alternatives true))]
-          ["-A" "--disable-alternatives" "Consider only first alternatives"
-           :assoc-fn (fn [m k v] (assoc m :alternatives false))]
-          ["-e" "--search-strat STRAT"
-           "May be 'breadth-first' or 'depth-first'."
-           :default nil
-           :default-desc (str (:search-strat subcommand-option-defaults))
-           :validate [#(or (= "breadth-first" %)
-                           (= "depth-first" %))
-                      "Search strategy must either be 'breadth-first' or 'depth-first'."]]
-          ["-g" "--enable-error-format" "Enable output format for errors"
-           :assoc-fn (fn [m k v] (assoc m :error-format true))]
-          ["-G" "--disable-error-format" "Disable output format for errors (default)"
-           :assoc-fn (fn [m k v] (assoc m :error-format false))]
-          ["-f" "--conflict-strat STRAT"
-           "May be 'exclusive', 'inclusive' or 'prioritized'."
-           :default nil
-           :default-desc (str (:conflict-strat subcommand-option-defaults))
-           :validate [#(or (= "exclusive" %)
-                           (= "inclusive" %)
-                           (= "prioritized" %))
-                      "Conflict strategy must either be 'exclusive', 'inclusive', or 'prioritized'."]]
-          ["-o" "--output-format FORMAT" "May be 'plain', 'edn' or 'json'"
-           :default nil
-           :default-desc (str (:output-format subcommand-option-defaults))
-           :validate [#(or (= "plain" %)
-                           (= "json" %)
-                           (= "edn" %))
-                      "Output format may be either be 'plain', 'edn' or 'json'"]]
-          ["-p" "--present-package PKG"
-           "Hard present package. **"
-           :id :present-packages
-           :validate
-           [#(re-matches r/str-frozen-package-regex %)
-            "Package must be specified as `<pkgname>==<pkgversion>`"]
-           :assoc-fn
-           (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-r" "--requirement REQ"
-           "Resolve req. **"
-           :id :requirements
-           :validate
-           [#(re-matches r/str-requirement-regex %)
-            "Requirement must look like one of these: `!a`, `a`, `a|b`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]
-           :assoc-fn
-           (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-R" "--repository INDEX"
-           "Search INDEX for packages. **"
-           :id :repositories
-           :assoc-fn
-           (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-s" "--resolve-strat STRAT"
-           "May be 'fast' or 'thorough'."
-           :default nil
-           :default-desc (str (:resolve-strat subcommand-option-defaults))
-           :validate [#(or (= "thorough" %) (= "fast" %))
-                      "Resolve strategy must either be 'thorough' or 'fast'."]]
-
-          ["-S" "--index-strat STRAT"
-           "May be 'priority' or 'global'."
-           :default nil
-           :default-desc (str (:index-strat subcommand-option-defaults))
-           :validate [#(or (= "priority" %) (= "global" %))
-                      "Strategy must either be 'priority' or 'global'."]]
-          ["-t" "--package-system SYS"
-           "May be 'degasolv' or 'apt'."
-           :default nil
-           :default-desc (str (:package-system subcommand-option-defaults))
-           :validate [#(or (= "degasolv" %) (= "apt" %))
-                      "Package system must be either 'degasolv' or 'apt'."]]
-          ["-V" "--version-comparison CMP"
-           "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
-           :default nil
-           :default-desc "maven"
-           :validate [#(some #{%} (keys version-comparators))
-                      "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
-          ]}
-   "query-repo"
-   {:description "Query repository for a particular package"
-    :function query-repo!
-    :required-arguments {:repositories ["-R" "--repository"]
-                         :query ["-q" "--query"]}
-    :cli [
-          ["-g" "--enable-error-format" "Enable output format for errors"
-           :assoc-fn (fn [m k v] (assoc m :error-format true))]
-          ["-G" "--disable-error-format" "Disable output format for errors (default)"
-           :assoc-fn (fn [m k v] (assoc m :error-format false))]
-          ["-o" "--output-format FORMAT" "May be 'plain', 'edn' or 'json'"
-           :default nil
-           :default-desc (str (:output-format subcommand-option-defaults))
-           :validate [#(or (= "plain" %)
-                           (= "json" %)
-                           (= "edn" %))
-                      "Output format may be either be 'plain', 'edn' or 'json'"]]
-          ["-q" "--query QUERY"
-           "Display packages matching query string."
-           :validate [#(and (re-matches r/str-requirement-regex %)
-                            (let [strreq (string-to-requirement %)]
-                              (and (= (count strreq) 1)
-                                   (= (:status (get strreq 0)) :present))))
-                      "Query must look like one of these: `a`, `a`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]]
-          ["-R" "--repository INDEX"
-           "Search INDEX for packages. **"
-           :id :repositories
-           :assoc-fn
-           (fn [m k v] (update-in m [k] #(conj % v)))]
-          ["-S" "--index-strat STRAT"
-           "May be 'priority' or 'global'."
-           :default nil
-           :default-desc (str (:index-strat subcommand-option-defaults))
-           :validate [#(or (= "priority" %) (= "global" %))
-                      "Strategy must either be 'priority' or 'global'."]]
-          ["-t" "--package-system SYS"
-           "May be 'degasolv' or 'apt'."
-           :default nil
-           :default-desc (str (:package-system subcommand-option-defaults))
-           :validate [#(or (= "degasolv" %) (= "apt" %))
-                      "Package system must be either 'degasolv' or 'apt'."]]
-          ["-V" "--version-comparison CMP"
-           "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
-           :default nil
-           :default-desc "maven"
-           :validate [#(some #{%} (keys version-comparators))
-                      "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
-          ]
+    :conflict-strat "prioritized"
+    :resolve-strat "fast"
+    :alternatives false
+    }
+  })
+
+(def cli-spec
+  {
+   :description "Degasolv: You love me."
+   :cli
+   [["-c" "--config-file FILE" "Config file location **"
+     :id :config-files
+     :default []
+     :default-desc "./degasolv.edn"
+     :assoc-fn
+     (fn [m k v] (update-in m [k] #(conj % v)))]
+    ["-k" "--option-pack PACK" "Specify option pack **"
+     :id :option-packs
+     :default []
+     :default-desc ""
+     :validate [#(get available-option-packs %)
+                (str
+                 "Must be one of: "
+                 (string/join "," (keys available-option-packs)))]
+     :assoc-fn
+     (fn [m k v] (update-in m [k] #(conj % v)))]]
+   :subcommands
+   {"display-config"
+    {
+     :description "Print the effective combined configuration (and arguments) of all the given config files."
+     :function display-config!
+     }
+    "generate-card"
+    {
+     :description "Generate dscard file based on arguments given"
+     :function generate-card!
+     :required-arguments {:id ["-i" "--id"]
+                          :version ["-v" "--version"]
+                          :location ["-l" "--location"]}
+     :cli [
+           ["-C" "--card-file FILE"
+            "The name of the card file"
+            :default nil
+            :default-desc (str (:card-file subcommand-option-defaults))
+            :validate [#(not (empty? %))
+                       "Out file must not be empty."]]
+           ["-i" "--id ID"
+            "ID (name) of the package"
+            :validate [#(not (empty? %))
+                       "ID must be a non-empty string."]
+            :required true]
+           ["-l" "--location LOCATION"
+            "URL or filepath of the package"
+            :validate [#(not (empty? %))
+                       "Location must be a non-empty string."]
+            :required true]
+           ["-m" "--meta K=V"
+            "Add additional metadata"
+            :validate [#(re-matches #"^[^=]+=[^=].*$" %)
+                       "Metadata must be presented as <key>=<value> pair."]
+            :id :meta
+            :assoc-fn
+            (fn [m k v]
+              (let [[_ rk rv] (re-find #"^([^=]+)=([^=].*)$" v)]
+                (update-in m [k] #(assoc % (keyword rk) rv))))]
+           ["-r" "--requirement REQ"
+            "List requirement **"
+            :validate [#(re-matches r/str-requirement-regex %)
+                       "Requirement must look like one of these: `!a`, `a`, `a|b`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]
+            :id :requirements
+            :assoc-fn
+            (fn [m k v] (update-in m [k] #(conj % v)))]
+           ["-v" "--version VERSION"
+            "Version of the package"
+            :validate [#(re-matches r/version-regex %)
+                       "Sorry, given argument doesn't look like a version."]
+            :required true]
+           ]}
+    "generate-repo-index"
+    {:description "Generate repository index based on degasolv package cards"
+     :function generate-repo-index-cli!
+     :cli [["-a" "--add-to INDEX"
+            "Add to repo index INDEX"]
+           ["-d" "--search-directory DIR" "Find degasolv cards here"
+            :default nil
+            :default-desc (str (:search-directory subcommand-option-defaults))
+            :validate [#(and
+                         (fs/directory? %)
+                         (fs/exists? %))
+                       "Must be a directory which exists on the file system."]]
+           ["-I" "--index-file FILE"
+            "The name of the repo file"
+            :default nil
+            :default-desc (str (:index-file subcommand-option-defaults))]
+           ["-V" "--version-comparison CMP"
+            "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
+            :default nil
+            :default-desc "maven"
+            :validate [#(some #{%} (keys version-comparators))
+                       "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]]}
+
+    "resolve-locations"
+    {:description "Print the locations of the packages which will resolve all given dependencies."
+     :function resolve-locations!
+     :required-arguments {:repositories ["-R" "--repository"]
+                          :requirements ["-r" "--requirement"]}
+     :cli [
+           ["-a" "--enable-alternatives" "Consider all alternatives (default)"
+            :assoc-fn (fn [m k v] (assoc m :alternatives true))]
+           ["-A" "--disable-alternatives" "Consider only first alternatives"
+            :assoc-fn (fn [m k v] (assoc m :alternatives false))]
+           ["-e" "--search-strat STRAT"
+            "May be 'breadth-first' or 'depth-first'."
+            :default nil
+            :default-desc (str (:search-strat subcommand-option-defaults))
+            :validate [#(or (= "breadth-first" %)
+                            (= "depth-first" %))
+                       "Search strategy must either be 'breadth-first' or 'depth-first'."]]
+           ["-g" "--enable-error-format" "Enable output format for errors"
+            :assoc-fn (fn [m k v] (assoc m :error-format true))]
+           ["-G" "--disable-error-format" "Disable output format for errors (default)"
+            :assoc-fn (fn [m k v] (assoc m :error-format false))]
+           ["-f" "--conflict-strat STRAT"
+            "May be 'exclusive', 'inclusive' or 'prioritized'."
+            :default nil
+            :default-desc (str (:conflict-strat subcommand-option-defaults))
+            :validate [#(or (= "exclusive" %)
+                            (= "inclusive" %)
+                            (= "prioritized" %))
+                       "Conflict strategy must either be 'exclusive', 'inclusive', or 'prioritized'."]]
+           ["-o" "--output-format FORMAT" "May be 'plain', 'edn' or 'json'"
+            :default nil
+            :default-desc (str (:output-format subcommand-option-defaults))
+            :validate [#(or (= "plain" %)
+                            (= "json" %)
+                            (= "edn" %))
+                       "Output format may be either be 'plain', 'edn' or 'json'"]]
+           ["-p" "--present-package PKG"
+            "Hard present package. **"
+            :id :present-packages
+            :validate
+            [#(re-matches r/str-frozen-package-regex %)
+             "Package must be specified as `<pkgname>==<pkgversion>`"]
+            :assoc-fn
+            (fn [m k v] (update-in m [k] #(conj % v)))]
+           ["-r" "--requirement REQ"
+            "Resolve req. **"
+            :id :requirements
+            :validate
+            [#(re-matches r/str-requirement-regex %)
+             "Requirement must look like one of these: `!a`, `a`, `a|b`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]
+            :assoc-fn
+            (fn [m k v] (update-in m [k] #(conj % v)))]
+           ["-R" "--repository INDEX"
+            "Search INDEX for packages. **"
+            :id :repositories
+            :assoc-fn
+            (fn [m k v] (update-in m [k] #(conj % v)))]
+           ["-s" "--resolve-strat STRAT"
+            "May be 'fast' or 'thorough'."
+            :default nil
+            :default-desc (str (:resolve-strat subcommand-option-defaults))
+            :validate [#(or (= "thorough" %) (= "fast" %))
+                       "Resolve strategy must either be 'thorough' or 'fast'."]]
+
+           ["-S" "--index-strat STRAT"
+            "May be 'priority' or 'global'."
+            :default nil
+            :default-desc (str (:index-strat subcommand-option-defaults))
+            :validate [#(or (= "priority" %) (= "global" %))
+                       "Strategy must either be 'priority' or 'global'."]]
+           ["-t" "--package-system SYS"
+            "May be 'degasolv' or 'apt'."
+            :default nil
+            :default-desc (str (:package-system subcommand-option-defaults))
+            :validate [#(or (= "degasolv" %) (= "apt" %))
+                       "Package system must be either 'degasolv' or 'apt'."]]
+           ["-V" "--version-comparison CMP"
+            "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
+            :default nil
+            :default-desc "maven"
+            :validate [#(some #{%} (keys version-comparators))
+                       "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
+           ]}
+    "query-repo"
+    {:description "Query repository for a particular package"
+     :function query-repo!
+     :required-arguments {:repositories ["-R" "--repository"]
+                          :query ["-q" "--query"]}
+     :cli [
+           ["-g" "--enable-error-format" "Enable output format for errors"
+            :assoc-fn (fn [m k v] (assoc m :error-format true))]
+           ["-G" "--disable-error-format" "Disable output format for errors (default)"
+            :assoc-fn (fn [m k v] (assoc m :error-format false))]
+           ["-o" "--output-format FORMAT" "May be 'plain', 'edn' or 'json'"
+            :default nil
+            :default-desc (str (:output-format subcommand-option-defaults))
+            :validate [#(or (= "plain" %)
+                            (= "json" %)
+                            (= "edn" %))
+                       "Output format may be either be 'plain', 'edn' or 'json'"]]
+           ["-q" "--query QUERY"
+            "Display packages matching query string."
+            :validate [#(and (re-matches r/str-requirement-regex %)
+                             (let [strreq (string-to-requirement %)]
+                               (and (= (count strreq) 1)
+                                    (= (:status (get strreq 0)) :present))))
+                       "Query must look like one of these: `a`, `a`, a>2.0,<=3.0,!=2.5;>4.0,<=5.0`"]]
+           ["-R" "--repository INDEX"
+            "Search INDEX for packages. **"
+            :id :repositories
+            :assoc-fn
+            (fn [m k v] (update-in m [k] #(conj % v)))]
+           ["-S" "--index-strat STRAT"
+            "May be 'priority' or 'global'."
+            :default nil
+            :default-desc (str (:index-strat subcommand-option-defaults))
+            :validate [#(or (= "priority" %) (= "global" %))
+                       "Strategy must either be 'priority' or 'global'."]]
+           ["-t" "--package-system SYS"
+            "May be 'degasolv' or 'apt'."
+            :default nil
+            :default-desc (str (:package-system subcommand-option-defaults))
+            :validate [#(or (= "degasolv" %) (= "apt" %))
+                       "Package system must be either 'degasolv' or 'apt'."]]
+           ["-V" "--version-comparison CMP"
+            "May be 'debian', 'maven', 'naive', 'python', 'rpm', 'rubygem', or 'semver'."
+            :default nil
+            :default-desc "maven"
+            :validate [#(some #{%} (keys version-comparators))
+                       "Version comparison must be 'debian', 'maven', 'naive', 'python', 'rubygem', or 'semver'."]]
+           ]
+     }
     }
    }
   )
@@ -549,17 +607,21 @@
                ""
                ""))

-(defn usage [options-summary & {:keys [sub-command]}]
+(defn usage [command-name options-summary & {:keys [sub-command]}]
   (let [display-command (if sub-command
                           sub-command
                           "<command>")]
-    (->> [(str "Usage: degasolv <options> "
-               display-command
-               " <"
-               display-command
-               "-options>")
+    (->> [(str "Usage: "
+               command-name
+               " <options> "
+               (when sub-command
+                 (str
+                  sub-command
+                  " <"
+                  sub-command
+                  "-options>")))
           ""
-          "Options are shown below. Default values are marked as <DEFAULT> and"
+          "Options are shown below. Default values are listed with the"
           "  descriptions. Options marked with `**` may be"
           "  used more than once."
           ""
@@ -611,46 +673,7 @@
            "` key in the config file,")
       (str "  or use `" small-arg "` or `" large-arg "` at the command line.")])))

-(def available-option-packs
-  {
-   "multi-version-mode"
-   {
-    :conflict-strat "inclusive"
-    :resolve-strat "fast"
-    :alternatives false
-    }
-    "firstfound-version-mode"
-   {
-    :conflict-strat "prioritized"
-    :resolve-strat "fast"
-    :alternatives false
-    }
-  })
-
-(def cli-options
-  [["-c" "--config-file FILE" "Config file location **"
-    :id :config-files
-    :default []
-    :default-desc "./degasolv.edn"
-    :assoc-fn
-    (fn [m k v] (update-in m [k] #(conj % v)))]
-   ["-k" "--option-pack PACK" "Specify option pack **"
-    :id :option-packs
-    :default []
-    :default-desc ""
-    :validate [#(get available-option-packs %)
-               (str
-                "Must be one of: "
-                (string/join "," (keys available-option-packs)))]
-    :assoc-fn
-    (fn [m k v] (update-in m [k] #(conj % v)))]])
-
-(defn- deep-merge [a b]
-  (merge-with (fn [x y]
-                (cond (map? y) (deep-merge x y)
-                      (vector? y) (conj x y)
-                      :else y))
-              a b))
+

 (defn get-config [configs]
   (try
@@ -671,39 +694,57 @@
                             configs)))))
       (hash-map))))

-(defn -main [& args]
+(defn- parseplz!
+  [command args command-spec]
   (let [{:keys [options arguments errors summary]}
         (parse-opts args (concat
-                          cli-options
+                          (:cli command-spec)
                           [["-h" "--help" "Print this help page"]])
                     :in-order true)]
     (cond
       (or
         (:help options)
-        (empty? arguments))
+        (and
+         (empty? arguments)
+         (:subcommands command-spec)))
       (exit 0
-            (str (usage summary)
-                 (if (:required-arguments cli-options)
+            (str (usage command summary)
+                 (if (:required-arguments command-spec)
                    (str
                      "\n\n"
                      (required-args-msg
-                       (:required-arguments cli-options))
+                       (:required-arguments command-spec))
                      "\n\n")
                    "\n\n")
-                 (command-list (keys subcommand-cli))
-                 "\n\n"))
+                 (if (:subcommands command-spec)
+                   (str
+                    (command-list (keys (:subcommands command-spec)))
+                    "\n\n")
+                   "")))
       errors
       (exit 1
             (string/join
              \newline
              [(error-msg errors)
               ""
-              (usage summary)
-              ""
-              (command-list (keys subcommand-cli))
-              ""])))
+              (usage command summary)
+              (if (:subcommands command-spec)
+                (string/join
+                 \newline
+                 [
+                 ""
+                 (command-list (keys (:subcommands command-spec)))
+                 ""])
+                "")])))
+    {:options options
+     :arguments arguments}))
+
+(defn -main [& args]
+  (let [{:keys [options arguments]}
+        (parseplz! "degasolv" args cli-spec)]
     (let [global-options options
           subcommand (first arguments)
+          subcommand-cli (:subcommands cli-spec)
           subcmd-cli (if (not (= subcommand "display-config"))
                        (get subcommand-cli subcommand)
                        ; this grabs all other options as part of display-config
@@ -723,31 +764,8 @@
                                it))]
       (when (nil? subcmd-cli)
         (exit 1 (error-msg [(str "Unknown command: " subcommand)])))
-      (let [{:keys [options arguments errors summary]}
-            (parse-opts arguments (concat
-                                   (:cli subcmd-cli)
-                                   [["-h" "--help" "Print this help page"]]))]
-        (cond
-          (:help options)
-          (exit 0
-                (str (usage
-                      summary
-                      :sub-command
-                      subcommand)
-                     (if (:required-arguments subcmd-cli)
-                       (str
-                        "\n\n"
-                        (required-args-msg
-                         (:required-arguments subcmd-cli)
-                         :sub-command subcommand)
-                        "\n\n")
-                       "\n\n")))
-          errors (exit 1 (string/join
-                          \newline
-                          [(error-msg errors :sub-command subcommand)
-                           ""
-                           (usage summary :sub-command subcommand)
-                           ""])))
+      (let [{:keys [options arguments]}
+            (parseplz! subcommand (rest arguments) (get subcommand-cli subcommand))]
         (let [config-files
               (if (empty? (:config-files global-options))
                 [(fs/file (fs/expand-home "./degasolv.edn"))]


(PUP-8127) Update matcher for parse errors in environment cache tests

Update assertion for new error format introduced in
puppet@f31193ee68666c18d336a56532500b9f86b1627c

--- test/integration/puppetlabs/services/master/environment_classes_int_test.clj
+++ test/integration/puppetlabs/services/master/environment_classes_int_test.clj
@@ -264,9 +264,9 @@
                                "error" (str "This Name has no effect. A value "
                                             "was produced and then forgotten ("
                                             "one or more preceding expressions "
-                                            "may have the wrong form) at "
+                                            "may have the wrong form) (file: "
                                             borked-file
-                                            ":1:1")}
+                                            ", line: 1, column: 1)")}
                               {"path" foo-file,
                                "classes" [{
                                            "name" "foo"


Start 2.3.8-SNAPSHOT

Start 2.3.8-SNAPSHOT

--- build.boot
+++ build.boot
@@ -22,7 +22,7 @@
 (task-options!
   sift {:include #{#"\.jar$"}}
   pom {:project 'nightcode
-       :version "2.3.7"}
+       :version "2.3.8-SNAPSHOT"}
   aot {:namespace '#{nightcode.core
                      nightcode.lein}}
   jar {:main 'nightcode.core


formatting

formatting

--- build.boot
+++ build.boot
@@ -11,8 +11,6 @@
 (deftask dev []
   (comp
    (watch)
-   (cljs :optimizations    :none
-         :source-map       true
-         :compiler-options {:cache-analysis true})
+   (cljs :optimizations :none, :source-map true)
    (serve :dir "target", :port 8080)))


Add regex pattern for future use

Add regex pattern for future use

--- build.boot
+++ build.boot
@@ -2,6 +2,7 @@
  :source-paths #{"src/java" "src/clj" "test" "build.boot"}
  :resource-paths #{"resources"}
  :format-paths #{"src/clj" "build.boot" "test"}
+ ;:format-regex #"\.clj[sx]?$"
  :dependencies '[[adzerk/boot-test "1.1.0" :scope "test"]
                  [org.clojure/clojure "1.8.0"]
                  [commons-io "2.4"]


Add cljs-src as hard coded folder for the source files

--- build.boot
+++ build.boot
@@ -156,7 +156,8 @@
   (comp (with-pre-wrap [fs]
           (boot.util/info "Pack source files...\n")
           fs)
-        (pack-source :deps (into #{} pack-source-deps)
+        (pack-source :to-dir "cljs-src"
+                     :deps (into #{} pack-source-deps)
                      :exclusions '#{org.clojure/clojure
                                     org.mozilla/rhino})))


Fixed 8th case.

Fixed 8th case.

--- src/forumdb/core.clj
+++ src/forumdb/core.clj
@@ -82,7 +82,7 @@

     (def topType (. (. @database getTypeSystem) getTop))
     (def userThreadRelType (HGQuery$hg/assertAtom @database (HGRelType. "user-thread" (into-array HGHandle [topType topType]))))
-    (def userPostRelType (HGQuery$hg/assertAtom @database (HGRelType. "user-post" (into-array HGHandle [topType topType]))))
+    ;(def userPostRelType (HGQuery$hg/assertAtom @database (HGRelType. "user-post" (into-array HGHandle [topType topType]))))

     (if (= database-exists 0)
       (do
@@ -141,7 +141,7 @@
               (def postHandle (. @database add post))

               (HGQuery$hg/addUnique @database (HGRel. (into-array HGHandle [userHandle threadHandle])) userThreadRelType (HGQuery$hg/link (into-array HGHandle [userHandle threadHandle])))
-              (. @database add (HGRel. (into-array HGHandle [userHandle postHandle])) userPostRelType)
+              (. @database add (HGValueLink. false (into-array HGHandle [userHandle postHandle])))
               (. @database add (HGValueLink. (. (. post getCreateTime) getMillis) (into-array HGHandle [threadHandle postHandle])))

               (def saveTime (+ saveTime (- (System/currentTimeMillis) saveStart)))
@@ -149,6 +149,18 @@

             )
           )
+
+        (let [saveStart (System/currentTimeMillis)]
+          (def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
+          (def threadFirstPostLinks (map (fn [threadHandle] (reduce (fn [currentFirstThreadPostLink threadPostLink] (if (< (. (. @database get currentFirstThreadPostLink) getValue) (. (. @database get threadPostLink) getValue)) currentFirstThreadPostLink threadPostLink)) (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Long) (HGQuery$hg/incident threadHandle)])))) ) threadHandles))
+          (def threadFirstPosts (map (fn [threadFirstPostLink] (HGQuery$hg/findOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Post) (HGQuery$hg/target threadFirstPostLink)])))) threadFirstPostLinks))
+          (def postUserLinks (map (fn [threadFirstPost] (HGQuery$hg/getOne @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Boolean) (HGQuery$hg/incident threadFirstPost)])))) threadFirstPosts))
+          (doseq [postUserLink postUserLinks]
+            (. postUserLink setValue true)
+            (. @database update postUserLink)
+          )
+          (def saveTime (+ saveTime (- (System/currentTimeMillis) saveStart)))
+        )

         (def stop (System/currentTimeMillis))
         (println (string/join " " ["Data parsed and saved in" (String/valueOf (/ (- stop start) 1000.0)) "seconds"]))
@@ -214,12 +226,8 @@
     (let [operationStart (System/currentTimeMillis)]
       (do
         (println "użytkownik komentujący największą liczbę innych użytkowników")
-        ;(def threadHandles (HGQuery$hg/findAll @database (HGQuery$hg/type ForumThread)))
-        ;(def threadFirstPosts (map (fn [threadHandle] (reduce (fn [currentFirstThreadPostLink threadPostLink] (if (< (. currentFirstThreadPostLink getValue) (. threadPostLink getValue)) currentFirstThreadPostLink threadPostLink)) (HGQuery$hg/getAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type Long) (HGQuery$hg/incident threadHandle)])))) ) threadHandles))
         (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/type User)))
-        (def postsCount (map (fn [userHandle] (HGQuery$hg/count @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userPostRelType)])))) userHandles))
-        ;(def usersPosts (map (fn [userPostsLinks] (map (fn [userPostsLink] (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/target userPostsLink) (HGQuery$hg/type Post)])))) userPostsLinks)) usersPostsLinks))
-        ;(def postsCount (map (fn [userPosts] (count (filter (fn [userPost] (not (some #(= userPost %) threadFirstPosts))) userPosts))) usersPosts))
+        (def postsCount (map (fn [userHandle] (count (filter (fn [userPostLink] (= false (. userPostLink getValue))) (HGQuery$hg/getAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type Boolean)])))))) userHandles))
         (def mostActiveUser (reduce (fn [x y] (if (> (last x) (last y)) x y)) (map vector userHandles postsCount)))
         (println (. (. @database get (first mostActiveUser)) getLogin) (last mostActiveUser))
         (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
@@ -243,7 +251,7 @@
         (println "liczba postów wysłanych przez użytkowników z miasta na literę 'K'")
         (def userHandles (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/type User) (AtomPartRegExPredicate. (into-array String ["city"]) (Pattern/compile "^K.*" Pattern/MULTILINE))]))))
         ;(def userHandles (filter (fn [userHandle] (. (. (. @database get userHandle) getCity) startsWith "K")) (HGQuery$hg/findAll @database (HGQuery$hg/type User))))
-        (println (apply + (map (fn [userHandle] (. (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type userPostRelType)]))) size)) userHandles)))
+        (println (apply + (map (fn [userHandle] (. (HGQuery$hg/findAll @database (HGQuery$hg/and (into-array HGQueryCondition [(HGQuery$hg/incident userHandle) (HGQuery$hg/type Boolean)]))) size)) userHandles)))
         (println (string/join " " ["Operation took" (String/valueOf (/ (- (System/currentTimeMillis) operationStart) 1000.0)) "seconds"]))
         (println)
         )


debugger: revert resetting next ids as it can cause infinite loop later

--- examples/_common/middleware/devtools.cljs
+++ examples/_common/middleware/devtools.cljs
@@ -262,9 +262,7 @@
            ::clear
            (-> model
                (assoc-in [::debugger :signal-events] (list))
-               (assoc-in [::debugger :action-events] (list))
-               (assoc-in [::debugger :next-signal-id] 0)
-               (assoc-in [::debugger :next-action-id] 0))
+               (assoc-in [::debugger :action-events] (list)))

            ::toggle-visibility
            (update-in model [::debugger :visible?] not)


update copy

update copy

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -22,13 +22,13 @@
 (def templates {"ruby" {:language "Ruby"
                         :headline "CircleCI makes Continous Integration and Deployment for Ruby projects a breeze."
                         :logo-path "/img/outer/languages/ruby-logo.svg"
-                        :features [{:feature "CircleCI uses RVM to provide support for a wide variety of Ruby versions and gems. It is also trivial to add any packages or frameworks that are not installed on our machines by default, allowing you to effortlessly customize your test enviroment.  CircleCI also supports Test::Unit, RSpec, Cucumber, Spinach, Jasmine, Konacha, and just about any other testing framework you use for your Ruby project."
+                        :features [{:feature "CircleCI provides support for a wide variety of Ruby versions and gems, including Ruby on Rails. It is also trivial to add any packages or frameworks that are not installed on our machines by default, allowing you to effortlessly customize your test enviroment.  CircleCI also supports Test::Unit, RSpec, Cucumber, Spinach, Jasmine, Konacha, and just about any other testing framework you use for your Ruby project."
                                     :title "Built For Ruby"
                                     :icon "/img/outer/languages/gear-icon.svg"}
-                                   {:feature "Circle manages all your database requirements for your, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB. You can also add custom database commands via your circle.yml."
+                                   {:feature "Circle manages all your database requirements for you, such as running your rake commands for creating, loading, and migrating your database. We have pre-installed more than a dozen databases and queues, including PostgreSQL, MySQL, and MongoDB as well as frameworks such as DataMapper, Mongoid, ActiveRecord. You can also add custom database commands via your circle.yml."
                                     :title "Database Management"
                                     :icon "/img/outer/languages/file-icon.svg"}
-                                   {:feature "For the majority of Ruby projects no configuration is required; you just run your builds on CircleCI and it works! CircleCI will automatically infer your test commands if you're using Test::Unit, RSpec, Cucumber, Spinach, Jasmine, or Konacha."
+                                   {:feature "For the majority of Ruby projects no configuration is required; you just run your builds on CircleCI and it works! CircleCI will automatically infer your test commands if you're using Test::Unit, RSpec, Cucumber, Spinach, Jasmine, or Konacha. Parallel builds can also be set up automatically for your Ruby projects to keep build times down."
                                     :title "Inference That Just Works"
                                     :icon "/img/outer/languages/book-icon.svg"}]
                         :docs-link "/docs/language-ruby-on-rails"


added some template functions

added some template functions

--- src/k_means/core.clj
+++ src/k_means/core.clj
@@ -9,22 +9,52 @@
       (< k 1) c
       :else (recur l (dec k) (conj c (rand-nth l))))))

+(defn still-moving?
+  "Predicate to test if the centroids have not reached equlibrium"
+  [c]
+  true)
+
+(defn mean
+  "Retrieve the mean value of a list"
+  [l]
+  (/ (reduce + l) (count l)))
+
+(defn mean-vector-centroid
+  "Calculates the mean for a given centroid"
+  [c l]
+  c)
 ; (defn centroid)

 (defn distance
   "Implements euclidian distance between two vectors"
   ([[p1 p2] [q1 q2]]
     (Math/sqrt (+ (Math/pow (- q1 q2) 2) (Math/pow (- p1 p2) 2)))))
-    ; (->> (map - c1 c2) (map #(* % %)) (reduce +)))))
+    ; (->> (map - c1 c2) (map #(* % %)) (reduce +))))) ; This is a better implementation for when this gets parallelised

-; (defn group)
+(defn min-vector
+  "Chooses the smallest vector in a set of vectors"
+  [l]
+  (map distance l))
+
+(defn group
+  "Group each vector based on the distance from each centroid"
+  ([l c g]
+    (cond
+      (empty? l) g
+      :else
+        (recur (rest l) c ())))

 (defn k-means
-  "Perform the actual k-means "
+  "Perform the actual k-means"
   ([l k]
-    (k-means l k (choose-initial-centroids l k)))
-  ([l k c]
-    (println c)))
+    (k-means l k (choose-initial-centroids l k) (make-array Float/TYPE k)))
+  ([l k c g]
+    (cond
+      (< (count g) (count l)) ; Add in new data to the clusters
+        (recur (rest l) k (mean-centroids c) (cluster g)))
+      (still-moving? c) ; Keep shifting centroids until equilibrium
+        (recur nil k (mean-centroids c) (cluster g))
+      :else g))

 (defn -main
   "Main function for k-means"


added blank comments for type constants

added blank comments for type constants

--- src/karras/sugar.clj
+++ src/karras/sugar.clj
@@ -21,6 +21,7 @@
 ;; THE SOFTWARE.

 (ns karras.sugar
+  (:use [clojure.contrib.def :only [defvar]])
   (:import [java.util Calendar]))

 (defn compound-index
@@ -31,24 +32,24 @@
 (defn asc  "Sugar for order by and index." [k] {k 1})
 (defn desc "Sugar for order by and index." [k] {k -1})

-(def double-type           1)
-(def string-type           2)
-(def object-type           3)
-(def array-type            4)
-(def binary-type           5)
-(def object-id-type        7)
-(def boolean-type          8)
-(def date-type             9)
-(def null-type            10)
-(def regex-type           11)
-(def js-code-type         13)
-(def symbol-type          14)
-(def js-scoped-code-type  15)
-(def int32-type           16)
-(def timestamp-type       17)
-(def int64-type           18)
-(def min-key-type        255)
-(def max-key-type        127)
+(defvar double-type           1 "")
+(defvar string-type           2 "")
+(defvar object-type           3 "")
+(defvar array-type            4 "")
+(defvar binary-type           5 "")
+(defvar object-id-type        7 "")
+(defvar boolean-type          8 "")
+(defvar date-type             9 "")
+(defvar null-type            10 "")
+(defvar regex-type           11 "")
+(defvar js-code-type         13 "")
+(defvar symbol-type          14 "")
+(defvar js-scoped-code-type  15 "")
+(defvar int32-type           16 "")
+(defvar timestamp-type       17 "")
+(defvar int64-type           18 "")
+(defvar min-key-type        255 "")
+(defvar max-key-type        127 "")

 (defn where
   "Sugar to create a where document. Example:


Only get visited distances onces per iteration

--- src/kevin/search.clj
+++ src/kevin/search.clj
@@ -38,11 +38,10 @@
          distances {0 q}
          i 1]
     (if (< i up-to) ; Has anyone really been far even?
-      (let [next-q (set (flatten (for [node q
+      (let [visited (vals distances)
+            next-q (set (flatten (for [node q
                                        neighbor (neighbor-fn node)
-                                       :when (not-any? (fn [coll]
-                                                         (contains? coll neighbor))
-                                                       (vals distances))]
+                                       :when (not-any? #(contains? % neighbor) visited)]
                                    neighbor)))]
         (recur next-q (assoc distances i next-q) (inc i)))
       distances)))


Try to intelligently grab forms out of messages

--- src/lazubot/core.clj
+++ src/lazubot/core.clj
@@ -30,13 +30,41 @@
                                  (get-in message [:message :subject])
                                  parsed-reply))))

+(defn extract-forms
+  "Return a seq of suspected Clojure forms from a message."
+  [content]
+  (loop [input content
+         current-form ""
+         forms (vector)
+         inside-escape? false
+         inside-quote? false
+         depth 0]
+    (let [current-char (first input)]
+      (case current-char
+        nil forms
+        \( (recur (rest input) (str (if (zero? depth) "" current-form) current-char) forms
+                  inside-escape? inside-quote? (inc depth))
+        \) (when (and (not inside-escape?) (not inside-quote?))
+             (if (= depth 1)
+               (recur (rest input) "" (conj forms (str current-form current-char))
+                      inside-escape? inside-quote? (dec depth))
+               (recur (rest input) (str current-form current-char) forms
+                      inside-escape? inside-quote? (max 0 (dec depth)))))
+        \" (recur (rest input) (str current-form current-char) forms
+                  false (if inside-escape? inside-quote? (not inside-quote?)) depth)
+        \\ (recur (rest input) (str current-form current-char) forms
+                  (not inside-escape?) inside-quote? depth)
+        (recur (rest input) (str current-form current-char) forms
+               false inside-quote? depth)))))
+
 (defn process-message [message]
   (when (and (= "message" (:type message))
              (not= (get-in message [:message :sender_email])
                    (get-in conn [:opts :username])))
-    (let [content (get-in message [:message :content])]
-      (when (= (first "(") (first content))
-        (respond message (sb (read-string content)))))))
+    (let [content (get-in message [:message :content])
+          forms (extract-forms content)
+          reply (interpose "\n" (map #(str "=> " (sb (read-string %))) forms))]
+      (respond message (apply str reply)))))

 (defn -main []
   (ensure-subscriptions)


updates

updates

--- fonclojure/src/com/matija/forclojure.clj
+++ fonclojure/src/com/matija/forclojure.clj
@@ -19,3 +19,10 @@
                                str))]
     (= (sum-str-nums (subs str_int 0 (/ n 2)))
        (sum-str-nums (subs str_int (Math/ceil (/ n 2)))))))
+
+
+(defn prime-numbers67
+  [n]
+  (let [prime-number? (fn [num]
+                        (every? #(= false %) (map #(= (mod num %) 0) (range 2 num))))]
+    (drop 2 (take (+ n 2) (filter prime-number? (range))))))


trailing-output only takes the converters-state

--- frontend/models/action.cljs
+++ frontend/models/action.cljs
@@ -38,6 +38,6 @@
     (format-output action (dec (count output)))
     action))

-(defn trailing-output [action]
-  (str (get-in action [:converters-state :out :trailing_out])
-       (get-in action [:converters-state :err :trailing_out])))
+(defn trailing-output [converters-state]
+  (str (get-in converters-state [:out :trailing_out])
+       (get-in converters-state [:err :trailing_out])))


this conflicted with the app object

this conflicted with the app object

--- src/lt/objs/app.cljs
+++ src/lt/objs/app.cljs
@@ -8,7 +8,7 @@
   (:require-macros [lt.macros :refer [behavior]]))

 (def remote (js/require "remote"))
-(def app (.require remote "app"))
+(def atom-app (.require remote "app"))
 (def ipc (js/require "ipc"))
 (def win (.getCurrentWindow remote))
 (def frame (js/require "web-frame"))


Generate pretty json

Generate pretty json

--- src/markiki/core.clj
+++ src/markiki/core.clj
@@ -84,7 +84,7 @@
   "Given a OS path it will explore the folder tree and write a json in path/out/"
   [path]
   (spit (str path "/out/markiki.json")
-        (generate-string (flatten (parse-tree (str path "/src") "")))))
+        (generate-string (flatten (parse-tree (str path "/src") "")) {:pretty true})))

 (defn generate-index
   "Writes the index.html in out/"


OS isn't require in AWS

OS isn't require in AWS

--- src/aws/validations.clj
+++ src/aws/validations.clj
@@ -8,8 +8,7 @@

 (defvalidatorset machine-entity
   :hostname [v/required cv/str?]
-  :user [v/required cv/str?]
-  :os [v/required cv/keyword?])
+  :user [v/required cv/str?])

 (defvalidatorset aws-entity
   :instance-type [v/required cv/str?]


cleanup whitespace

cleanup whitespace

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -88,7 +88,6 @@
                :paths paths
                :comps (map #(comp-path-to-complements bolt % model depth max-depth) paths)})))

-
      ;; 4. Create the cartesian product of all the possibile complements at all paths within each bolt.
      (mapcat (fn [{bolt :bolt comps :comps paths :paths}]
                ;; TODO: further flatten this into the overall ->> pipeline
@@ -97,7 +96,6 @@
                        :paths paths
                        :trellis each-path-through-trellis})
                     (lazy-seq (apply combo/cartesian-product comps)))))
-
      ;; 5. ...
      (map (fn [{bolt :bolt paths :paths trellis :trellis}]
             (cons bolt


use assoc, not merge

use assoc, not merge

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -159,9 +159,9 @@
     (let [path (first comp-paths)
           comps (filter not-fail? (comp-path-to-complements bolt path model depth max-depth))]
       (if (not (empty? comps))
-        (merge
-         {path comps}
-         (comp-paths-to-complements bolt (rest comp-paths) model depth max-depth))
+        (assoc
+         (comp-paths-to-complements bolt (rest comp-paths) model depth max-depth)
+         path comps)
         {path []}))))

 ;; TODO: lightning-bolts should use this.


fun transactional memory time

fun transactional memory time

--- src/badger/badgerer.clj
+++ src/badger/badgerer.clj
@@ -43,4 +43,4 @@
       (ref-set dest-file (prefix-path result-filename))
       (ref-set should-write true))
     (Thread/sleep 1000)
-    (result-filename)))
+    result-filename))


[#1441] Define spec conform function in akvo.util

Convenient function for getting data details validation in a ex-info

To be used in all environments

--- backend/src/akvo/lumen/util.clj
+++ backend/src/akvo/lumen/util.clj
@@ -1,6 +1,7 @@
 (ns akvo.lumen.util
   (:require [clojure.string :as str]
             [clojure.java.io :as io]
+            [clojure.spec.alpha :as s]
             [org.akvo.resumed :as resumed]))

 (defn squuid
@@ -68,3 +69,12 @@
 (defn valid-type? [s]
   (#{"text" "number" "date" "geopoint"} s))

+
+(defn conform
+  ([s d adapter]
+   (conform s (adapter d))
+   d)
+  ([s d]
+   (when-not (s/valid? s d) (throw (ex-info (str s " spec problem!") {:message (s/explain-str s d)
+                                                                      :data d})))
+   d))


Fixed pre-condition of time-input.

Fixed pre-condition of time-input.

--- src/re_com/time.cljs
+++ src/re_com/time.cljs
@@ -145,20 +145,17 @@
 (defn time-input
   "I return the markup for an input box which will accept and validate times.
   Parameters - refer time-input-args above."
-  [& {:keys [model on-change class style] :as args
+  [& {:keys [model minimum maximum on-change class style] :as args
       :or   {minimum 0 maximum 2359}}]

-  {:pre [(superset? time-input-args (keys args))]}
+  {:pre [(and (superset? time-input-args (keys args))
+              (validate-arg-times (deref-or-value model) minimum maximum))]}

   (let [deref-model (deref-or-value model)
         text-model (reagent/atom (time->text deref-model))
         previous-model (reagent/atom deref-model)]

     (fn [& {:keys [model minimum maximum disabled hide-border show-icon] :as passthrough-args}]
-
-      {:pre [(and (superset? time-input-args (keys passthrough-args))
-                  (validate-arg-times deref-model minimum maximum))]}
-
       (let [style (merge (when hide-border {:border "none"})
                          style)
             new-val (deref-or-value model)


update dirac version

update dirac version

--- ui/project.clj
+++ ui/project.clj
@@ -53,7 +53,7 @@
   :figwheel {:server-port 3000
              :css-dirs ["resources/public/css"]}

-  :profiles {:dev {:dependencies [[binaryage/dirac "1.2.2"
+  :profiles {:dev {:dependencies [[binaryage/dirac "1.2.3"
                                    :exclusions [org.clojure/tools.reader]]
                                   [binaryage/devtools "0.9.2"]
                                   [figwheel-sidecar "0.5.9"]


Don't pull in Clojure 1.2 with tools.nrepl anymore

--- boot/core/src/boot/repl.clj
+++ boot/core/src/boot/repl.clj
@@ -1,7 +1,7 @@
 (ns boot.repl)

 (def ^:dynamic *default-dependencies*
-  (atom '[[org.clojure/tools.nrepl "0.2.6"]]))
+  (atom '[[org.clojure/tools.nrepl "0.2.6" :exclusions [[org.clojure/clojure]]]]))

 (def ^:dynamic *default-middleware*
   (atom ['boot.from.io.aviso.nrepl/pretty-middleware]))


total-tweets-indexed function

total-tweets-indexed function

--- Clojure-Websockets/MainApp/src/clj/birdwatch/persistence/persistence.clj
+++ Clojure-Websockets/MainApp/src/clj/birdwatch/persistence/persistence.clj
@@ -62,6 +62,13 @@
     (when-not res (put-fn [:log/info [:persistence-cmp "missing tweet:" (:id_str req)]]))
     (put-fn [:tweet/missing-tweet {:tweet (strip-source res) :uid (:uid req)}])))

+(defn total-tweets-indexed
+  [app put-fn]
+  (let [conf (:conf app)
+        conn (:conn app)
+        cnt (esd/count conn (:es-index conf) "tweet")]
+    (put-fn [:stats/total-tweet-count (format "%,15d" (:count cnt))])))
+
 (defn in-handler
   "Handle incoming messages: process / add to application state."
   [app put-fn msg]


Break out project org, name, branch

Break out project org, name, branch

--- src/runbld/build.clj
+++ src/runbld/build.clj
@@ -9,6 +9,19 @@
           (date/yyyymmdd-hhmmss)
           (make-rand-uuid)))

+(defn split-jenkins-name [s]
+  (let [[_ org project branch] (re-find #"^([^,]+),([^,]+),([^,]+)$" s)]
+    {:org org
+     :project project
+     :branch branch}))
+
+(defn inherited-build-info [opts]
+  (if (get-in opts [:env "JENKINS_HOME"])
+    (split-jenkins-name (get-in opts [:env "JOB_NAME"]))))
+
 (defn wrap-build-meta [proc]
   (fn [opts]
-    (proc (assoc opts :id (make-id)))))
+    (proc (assoc opts
+                 :build (merge
+                         {:id (make-id)}
+                         (inherited-build-info opts))))))


updated depencies, conflicts resolved

updated depencies, conflicts resolved

--- Clojure-Websockets/TwitterClient/project.clj
+++ Clojure-Websockets/TwitterClient/project.clj
@@ -4,14 +4,15 @@
   :url "https://github.com/matthiasn/Birdwatch"
   :license {:name "GNU General Public License" :url "http://www.gnu.org/licenses/gpl-3.0.en.html"}
   :dependencies [[org.clojure/clojure "1.8.0-RC3"]
-                 [twitter-api "0.7.8"]
+                 [clj-http "2.0.0"]
+                 [twitter-api "0.7.8" :exclusions [org.clojure/data.json]]
                  [clojurewerkz/elastisch "2.2.0-beta4"]
                  [org.clojure/tools.logging "0.3.1"]
-                 [matthiasn/systems-toolbox "0.3.14"]
+                 [matthiasn/systems-toolbox "0.3.15"]
                  [ch.qos.logback/logback-classic "1.1.3"]
                  [clj-time "0.11.0"]
                  [clj-pid "0.1.2"]
-                 [com.taoensso/carmine "2.12.1"]
+                 [com.taoensso/carmine "2.12.1" :exclusions [org.clojure/tools.reader]]
                  [metrics-clojure "2.6.0"]]
   :source-paths ["src/clj/"]
   :main ^:skip-aot birdwatch-tc.main


Fix fix fix

Fix fix fix

--- src/clj_simple_chart/ssb/petroskattdiagrammonthly.clj
+++ src/clj_simple_chart/ssb/petroskattdiagrammonthly.clj
@@ -20,7 +20,7 @@
 (def ordinaer (keyword "Ordinær skatt på utvinning av petroleum"))
 (def saerskatt (keyword "Særskatt på utvinning av petroleum"))

-(def oil-date-to-usd brentoilprice/brent-12-mma-dato-to-nok)
+(def oil-date-to-nok brentoilprice/brent-12-mma-dato-to-nok)

 (defn six-months-ago [s]
   {:pre [(string? s)]}
@@ -30,15 +30,25 @@
         six-m-ago (.minusMonths (YearMonth/of year month) 6)]
     (format "%04d-%02d" (.getYear six-m-ago) (.getMonthValue six-m-ago))))

+(defn six-months-future [s]
+  {:pre [(string? s)]}
+  (let [parts (string/split s #"-0?")
+        year (read-string (first parts))
+        month (read-string (last parts))
+        six-m-future (.plusMonths (YearMonth/of year month) 6)]
+    (format "%04d-%02d" (.getYear six-m-future) (.getMonthValue six-m-future))))
+
 (def data (->> petroskatt/twelve-mms-mrd
                (mapv #(assoc % :year (read-string (subs (:dato %) 0 4))))
                (mapv #(assoc % :sum (+ (get % ordinaer) (get % saerskatt))))
-               (mapv #(assoc % :oilprice (get oil-date-to-usd (six-months-ago (:dato %)) ::none)))
-               #_(filter #(>= (:year %) 2010))))
+               (mapv #(assoc % :oilprice (get oil-date-to-nok (six-months-ago (:dato %)) ::none)))))

 (test/is (= 0 (count (filter #(= ::none (:oilprice %)) data))))

-(def x-domain (map :dato data))
+(def x-domain (vec (sort (distinct (flatten [(map :dato data)
+                                             #_(->> data
+                                                    (mapv :dato)
+                                                    (mapv six-months-future))])))))

 (def svg-width 900)
 (def svg-height 500)
@@ -122,7 +132,7 @@
                 :dx                 (- svg-width marg)
                 :text-anchor        "end" :font-size 14}))

-(def x-ticks (filter #(.endsWith % "-01") (map :dato data)))
+(def x-ticks (filter #(.endsWith % "-01") x-domain))
 (def end-of-year-data (filter #(.endsWith (:dato %) "-12") data))

 (def xx {:type          :ordinal
@@ -191,12 +201,13 @@
     [:g (bars (mapv make-rect data))]
     (line/line {:x         (:x c)
                 :y         (:y2 c)
-                :p         :dato
-                :h         :oilprice
                 :path      {:stroke-width 3 :stroke oil-fill}
                 :dot       (fn [{:keys [p]}] (.endsWith p "-12"))
                 :dot-style {:fill oil-fill :r 3.5 :stroke "black" :stroke-width 2}}
-               data)
+               (->> x-domain
+                    (mapv (fn [dato]
+                            {:p dato
+                             :h (get oil-date-to-nok (six-months-ago dato))}))))
     [:g (map make-txt end-of-year-data)]
     #_detail
     (axis/render-axis (:x c))]


Add more assignments

Add more assignments

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -304,14 +304,102 @@
        (sort-by #(get select-order (first %)))
        (map second)
        (reduce (fn [builder statement]
-                 (println builder statement)
                  (statement builder))
                (QueryBuilder/insertInto (name table-name)))
        (.toString)))

-;; Update update(String table)
-;; Update update(String keyspace, String table)
-;; Update update(TableMetadata table)
+;;
+;; Update Query
+;;
+
+(defn- set-column-
+  [^String column-name column-value]
+  (QueryBuilder/set column-name column-value))
+
+(defn increment
+  []
+  (fn [column-name]
+    (QueryBuilder/incr column-name)))
+
+(defn increment-by
+  [by-value]
+  (fn [column-name]
+    (QueryBuilder/incr column-name by-value)))
+
+(defn decrement
+  []
+  (fn [column-name]
+    (QueryBuilder/decr column-name)))
+
+(defn decrement-by
+  [by-value]
+  (fn [column-name]
+    (QueryBuilder/decr column-name by-value)))
+
+(defn prepend
+  [value]
+  (fn [column-name]
+    (QueryBuilder/prepend column-name value)))
+
+(defn prepend-all
+  [values]
+  (fn [column-name]
+    (QueryBuilder/prependAll column-name values)))
+
+(defn append
+  [value]
+  (fn [column-name]
+    (QueryBuilder/append column-name value)))
+
+(defn append-all
+  [values]
+  (fn [column-name]
+    (QueryBuilder/appendAll column-name values)))
+
+(defn discard
+  [value]
+  (fn [column-name]
+    (QueryBuilder/discard column-name value)))
+
+(defn discard-all
+  [values]
+  (fn [column-name]
+    (QueryBuilder/discardAll column-name values)))
+
+(defn set-idx
+  [idx value]
+  (fn [column-name]
+    (QueryBuilder/setIdx column-name idx value)))
+
+(defn add-tail
+  [value]
+  (fn [column-name]
+    (QueryBuilder/add column-name value)))
+
+(defn add-all-tail
+  [values]
+  (fn [column-name]
+    (QueryBuilder/addAll column-name values)))
+
+(defn remove-tail
+  [value]
+  (fn [column-name]
+    (QueryBuilder/remove column-name value)))
+
+(defn remove-all-tail
+  [column-name]
+  (fn [values]
+    (QueryBuilder/removeAll column-name values)))
+
+(defn put-value
+  [key value]
+  (fn [column-name]
+    (QueryBuilder/put column-name key value)))
+
+(defn put-values
+  [values]
+  (fn [column-name]
+    (QueryBuilder/putAll column-name values)))
 ;; Delete.Builder delete(String... columns)
 ;; Delete.Selection delete()
 ;; Batch batch(RegularStatement... statements)


More tweaks

More tweaks

--- src/alfresco_technical_validation/indexer.clj
+++ src/alfresco_technical_validation/indexer.clj
@@ -28,7 +28,7 @@

 (defn- build-file-type-index
   [files file-type file-regex]
-  { file-type (filter #(and (.isFile ^java.io.File %) re-matches file-regex (.getName ^java.io.File %)) files) })
+  { file-type (filter #(and (.isFile ^java.io.File %) (re-matches file-regex (.getName ^java.io.File %))) files) })

 (defn- build-file-types-index
   [files]


Use keywords for sorting

Use keywords for sorting

--- src-cljs/index/start.cljs
+++ src-cljs/index/start.cljs
@@ -53,14 +53,14 @@
    :size (fn [items asc]
            (sort-by
              (if (true? asc)
-               #(:size %)
+               :size
                #(- (:size %)))
              items))

    :modified (fn [items asc]
                (sort-by
                  (if (true? asc)
-                   #(:modified %)
+                   :modified
                    #(- (:modified %)))
                  items))
    })


Added error handling to share command.

Added error handling to share command.

--- src/clj/mx/roads/forgotten/blog/cli/share.clj
+++ src/clj/mx/roads/forgotten/blog/cli/share.clj
@@ -34,14 +34,18 @@
     $ frmx share email help
   ```"
   [[cmd & [post-file-kw & args]]]
-  (let [post-file (name post-file-kw)]
-    (log/debug "Got cmd:" cmd)
-    (log/debug "Got post-file:" post-file)
-    (log/debug "Got args:" args)
-    (case cmd
-      :subscribers (email-delivery/send-new-post-message post-file)
-      :twitter (twitter/send-new-post-message post-file)
-      ; :google+ ()
-      :all (do (email-delivery/send-new-post-message post-file)
-               (twitter/send-new-post-message post-file))
-      (docs/print-docstring #'run))))
+  (if (and (not= cmd :help) (nil? post-file-kw))
+    (do
+      (log/error "You need to provide a filename.")
+      (run [:help]))
+    (let [post-file (name (or post-file-kw :help))]
+      (log/debug "Got cmd:" cmd)
+      (log/debug "Got post-file:" post-file)
+      (log/debug "Got args:" args)
+      (case cmd
+        :subscribers (email-delivery/send-new-post-message post-file)
+        :twitter (twitter/send-new-post-message post-file)
+        ; :google+ ()
+        :all (do (email-delivery/send-new-post-message post-file)
+                 (twitter/send-new-post-message post-file))
+        (docs/print-docstring #'run)))))


STORM-2126: fix NPE due to race condition in compute-new-sched-assignments/read-all-supervisor-details

--- storm-core/src/clj/org/apache/storm/daemon/nimbus.clj
+++ storm-core/src/clj/org/apache/storm/daemon/nimbus.clj
@@ -448,26 +448,6 @@
                   [[id info]]))
               supervisor-ids)))))

-(defn- all-scheduling-slots
-  [nimbus topologies missing-assignment-topologies]
-  (let [storm-cluster-state (:storm-cluster-state nimbus)
-        ^INimbus inimbus (:inimbus nimbus)
-
-        supervisor-infos (all-supervisor-info storm-cluster-state nil)
-
-        supervisor-details (dofor [[id info] supervisor-infos]
-                             (SupervisorDetails. id (:meta info) (:resources-map info)))
-
-        ret (.allSlotsAvailableForScheduling inimbus
-                     supervisor-details
-                     topologies
-                     (set missing-assignment-topologies)
-                     )
-        ]
-    (dofor [^WorkerSlot slot ret]
-      [(.getNodeId slot) (.getPort slot)]
-      )))
-
 (defn- get-version-for-key [key nimbus-host-port-info conf]
   (let [version (KeySequenceNumber. key nimbus-host-port-info)]
     (.getKeySequenceNumber version conf)))
@@ -712,27 +692,35 @@
                                                    {})))]]
              {tid (SchedulerAssignmentImpl. tid executor->slot)})))

-(defn- read-all-supervisor-details [nimbus all-scheduling-slots supervisor->dead-ports]
+(defn- read-all-supervisor-details
+  [nimbus supervisor->dead-ports topologies missing-assignment-topologies]
   "return a map: {supervisor-id SupervisorDetails}"
   (let [storm-cluster-state (:storm-cluster-state nimbus)
         supervisor-infos (all-supervisor-info storm-cluster-state)
-        nonexistent-supervisor-slots (apply dissoc all-scheduling-slots (keys supervisor-infos))
-        all-supervisor-details (into {} (for [[sid supervisor-info] supervisor-infos
-                                              :let [hostname (:hostname supervisor-info)
-                                                    scheduler-meta (:scheduler-meta supervisor-info)
-                                                    dead-ports (supervisor->dead-ports sid)
-                                                    ;; hide the dead-ports from the all-ports
-                                                    ;; these dead-ports can be reused in next round of assignments
-                                                    all-ports (-> (get all-scheduling-slots sid)
-                                                                  (set/difference dead-ports)
-                                                                  ((fn [ports] (map int ports))))
-                                                    supervisor-details (SupervisorDetails. sid hostname scheduler-meta all-ports (:resources-map supervisor-info))]]
-                                          {sid supervisor-details}))]
-    (merge all-supervisor-details
-           (into {}
-              (for [[sid ports] nonexistent-supervisor-slots]
-                [sid (SupervisorDetails. sid nil ports)]))
-           )))
+        supervisor-details (for [[id info] supervisor-infos]
+                             (SupervisorDetails. id (:meta info) (:resources-map info)))
+        ;; Note that allSlotsAvailableForScheduling
+        ;; only uses the supervisor-details. The rest of the arguments
+        ;; are there to satisfy the INimbus interface.
+        all-scheduling-slots (->> (.allSlotsAvailableForScheduling
+                                    (:inimbus nimbus)
+                                    supervisor-details
+                                    topologies
+                                    (set missing-assignment-topologies))
+                                  (map (fn [s] {(.getNodeId s) #{(.getPort s)}}))
+                                  (apply merge-with set/union))]
+    (into {} (for [[sid supervisor-info] supervisor-infos
+                   :let [hostname (:hostname supervisor-info)
+                         scheduler-meta (:scheduler-meta supervisor-info)
+                         dead-ports (supervisor->dead-ports sid)
+                         ;; hide the dead-ports from the all-ports
+                         ;; these dead-ports can be reused in next round of assignments
+                         all-ports (-> (get all-scheduling-slots sid)
+                                       (set/difference dead-ports)
+                                       (as-> ports (map int ports)))
+                         supervisor-details (SupervisorDetails. sid hostname scheduler-meta all-ports (:resources-map supervisor-info))]]
+               {sid supervisor-details}))))
+

 ;TODO: when translating this function, you should replace the map-val with a proper for loop HERE
 (defn- compute-topology->executor->node+port [scheduler-assignments]
@@ -842,11 +830,11 @@
                                                                   (get t)
                                                                   num-used-workers )
                                                               (-> topologies (.getById t) .getNumWorkers)))))))
-        all-scheduling-slots (->> (all-scheduling-slots nimbus topologies missing-assignment-topologies)
-                                  (map (fn [[node-id port]] {node-id #{port}}))
-                                  (apply merge-with set/union))
-
-        supervisors (read-all-supervisor-details nimbus all-scheduling-slots supervisor->dead-ports)
+
+        supervisors (read-all-supervisor-details nimbus
+                                                 supervisor->dead-ports
+                                                 topologies
+                                                 missing-assignment-topologies)
         cluster (Cluster. (:inimbus nimbus) supervisors topology->scheduler-assignment conf)]

     ;; set the status map with existing topology statuses


Add math3 kurtosis

Add math3 kurtosis

--- src/clj/clojurewerkz/statistiker/statistics.clj
+++ src/clj/clojurewerkz/statistiker/statistics.clj
@@ -121,3 +121,8 @@
          n)
         (pow sigma 2))
        3)))
+
+(defn kurtosis-math3
+  "Slow (and memory consuming but correct) way to claculate Kurtosis"
+  [data]
+  (.getKurtosis (DescriptiveStatistics. (double-array data))))


network internal flag to form

network internal flag to form

--- src/cljs/swarmpit/component/network/create.cljs
+++ src/cljs/swarmpit/component/network/create.cljs
@@ -11,6 +11,9 @@
 (enable-console-print!)

 (def cursor [:page :network :form])
+
+(def form-internal-style
+  {:marginTop "14px"})

 (defn- form-name [value]
   (comp/form-comp
@@ -41,6 +44,15 @@
          :value       "bridge"
          :primaryText "bridge"}))))

+(defn- form-internal [value]
+  (comp/form-comp
+    "IS PRIVATE"
+    (comp/checkbox
+      {:checked value
+       :style   form-internal-style
+       :onCheck (fn [_ v]
+                  (state/update-value [:internal] v cursor))})))
+
 (defn- create-network-handler
   []
   (ajax/POST "/networks"
@@ -62,7 +74,8 @@

 (rum/defc form < rum/reactive []
   (let [{:keys [name
-                driver]} (state/react cursor)]
+                driver
+                internal]} (state/react cursor)]
     [:div
      [:div.form-panel
       [:div.form-panel-right
@@ -73,12 +86,14 @@
             :onTouchTap create-network-handler}))]]
      [:div.form-edit
       (form-name name)
-      (form-driver driver)]]))
+      (form-driver driver)
+      (form-internal internal)]]))

 (defn- init-state
   []
   (state/set-value {:networkName ""
-                    :driver      nil} cursor))
+                    :driver      "overlay"
+                    :internal    false} cursor))

 (defn mount!
   []