troubleshoot log4j2 change log level

troubleshoot log4j2 change log level

--- src/clojure/zensols/actioncli/log4j2.clj
+++ src/clojure/zensols/actioncli/log4j2.clj
@@ -2,29 +2,90 @@
       :author "Paul Landes"}
     zensols.actioncli.log4j2
   (:require [clojure.tools.logging :as log]
+            [clojure.tools.logging.impl :as i]
             [clojure.java.io :as io])
   (:import (org.apache.logging.log4j LogManager Level)
            (org.apache.logging.log4j.core.config Configurator
-                                                 ConfigurationSource)))
+                                                 ConfigurationSource)
+           (org.apache.logging.log4j.core.config LoggerConfig)
+           (com.zensols.log LogUtil)
+           ))

 (defn change-log-level
   "Change the Log4j2 log level.

   **level-thing** the log level as either the Level instance or a string."
   [level-thing]
-  (log/debugf "changing log level to %s" level-thing)
-  (let [ctx (LogManager/getContext false)
+  ;(log/debugf "changing log level to %s" level-thing)
+  (let [ctx (LogManager/getContext
+             ;(.getClassLoader (.getClass LogManager))
+             ;;(.getClassLoader (.getClass *ns*))
+             ;(.getClassLoader clojure.lang.RT)
+             false)
         config (.getConfiguration ctx)
-        log-config (.getLoggerConfig config LogManager/ROOT_LOGGER_NAME)
+        log-config (.getLoggerConfig config LogManager/ROOT_LOGGER_NAME
+                                     )
         loggers (concat (.values (.getLoggers config))
-                        [log-config])
+                        ;[log-config]
+                        )
         level (if (string? level-thing)
                 (Level/toLevel level-thing)
                 level-thing)]
+    (println "BEF " log-config "::" (.getName log-config) "::" (.getLevel log-config))
     (.setLevel log-config level)
+    (println "AFT " log-config "::" (.getName log-config) "::" (.getLevel log-config))
+    ;(.debug log-config "TEST")
     (doseq [logger loggers]
-      (.setLevel logger level))
-    (.updateLoggers ctx)))
+      (println "BEF " logger "::" (.getName logger))
+      (org.apache.logging.log4j.LogManager/getLogger (.getName logger))
+      (.setLevel logger level)
+      (println "AFT " logger "::" (.getName logger))
+      (org.apache.logging.log4j.LogManager/getLogger (.getName logger))
+      )
+    (println ctx)
+    ;(Configurator/setAllLevels "zensols.actioncli" (Level/toLevel "trace"))
+    (.updateLoggers ctx)
+    ))
+
+;;(LogUtil/setLevel "zensols.actioncli.log4j2" )
+;; (->> (macroexpand '(log/error "INF"))
+;;      clojure.pprint/pprint)
+
+;; (-> (i/get-logger log/*logger-factory* "zensols.actioncli.log4j2")
+;;      (.setLevel (Level/toLevel "trace")))
+
+;(enabled? (get-logger (log4j2-factory) "zensols.actioncli") :error)
+
+;(log/error "ERR")
+;(log/info "INF")
+;(log/debug "DEB--------------------------------------------------")
+;(log/trace "TRA--------------------------------------------------")
+
+;(with-open [in (io/input-stream (io/file "resources/log4j2.xml"))] (LogUtil/config in))
+;(LogUtil/setAllLevel (Level/toLevel "info"))
+
+;; (change-log-level "trace")
+
+;; (LogUtil/setLevel "zensols" (Level/toLevel "info"))
+;; (LogUtil/test)
+;(tmp)
+
+;; (org.apache.logging.log4j.LogManager/getLogger "a")
+;; (org.apache.logging.log4j.LogManager/getRootLogger)
+;; (org.apache.logging.log4j.LogManager/ROOT_LOGGER_NAME)
+;; (org.apache.logging.log4j.LogManager/getLogger "zensols.actioncli.log4j2")
+
+
+;(clojure.tools.logging.impl/find-factory)
+
+;; (.setLevel (org.apache.logging.log4j.LogManager/getLogger "zensols.actioncli")
+;;            (Level/toLevel "trace"))
+
+
+(defn- tmp []
+  (with-open [in (io/input-stream (io/file "test-resources/log4j2.xml"))]
+    (->> (ConfigurationSource. in)
+         (Configurator/initialize nil))))

 (defn configure
   "Congigure the Log4j2 system with an XML resource."


Clarify structure via cond

Clarify structure via cond

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -770,13 +770,18 @@
                    (some #{instruction}
                          '(a0 a1 a2 d0 d1 d2 d3 d4 d5 d6 d7)))))] ;; from mux problems
     (mapv (fn [instruction-map]
-            (if (input-instruction? (:instruction instruction-map))
+            (cond
+              (input-instruction? (:instruction instruction-map))
               (assoc instruction-map :instruction 'code_noop)
-              (if (= (:instruction instruction-map) 'autoconstructive_integer_rand)
-                (assoc instruction-map :instruction 'integer_rand)
-                (if (= (:instruction instruction-map) 'autoconstructive_boolean_rand)
-                  (assoc instruction-map :instruction 'boolean_rand)
-                  instruction-map))))
+              ;
+              (= (:instruction instruction-map) 'autoconstructive_integer_rand)
+              (assoc instruction-map :instruction 'integer_rand)
+              ;
+              (= (:instruction instruction-map) 'autoconstructive_boolean_rand)
+              (assoc instruction-map :instruction 'boolean_rand)
+              ;
+              :else
+              instruction-map))
          genome)))

 (defn produce-child-genome-by-autoconstruction
@@ -1189,3 +1194,4 @@
                            :ancestors ()
                            :is-random-replacement true))))))

+


Tell users they are only getting the first 4MB.


remove old file

remove old file

--- src/com/billpiel/sayid/string_output.clj
+++ src/com/billpiel/sayid/string_output.clj
@@ -1,665 +0,0 @@
-(ns com.billpiel.sayid.string-output
-  (:require [puget.printer :as puget]
-            [com.billpiel.sayid.workspace :as ws]
-            [com.billpiel.sayid.view :as v]
-            [com.billpiel.sayid.util.other :as util]
-            clojure.string))
-
-(def ^:dynamic *sayid-print-length* 15)
-(def ^:dynamic *max-chars* 10000)
-(def ^:dynamic *max-arg-lines* 15)
-(def ^:dynamic *truncate-lines-count* nil)
-(def ^:dynamic *view* (v/mk-simple-view {:args true
-                                         :return true
-                                         :children true
-                                         :throw true
-                                         :selects false}))
-
-(def pprint-str #(puget.printer/cprint-str %
-                                           {:seq-limit *sayid-print-length*
-                                            :color-scheme {
-                                        ; syntax elements
-                                                           :delimiter [:red]
-                                                           :tag       [:red]
-                                        ; primitive values
-                                                           :nil       [:white]
-                                                           :boolean   [:green]
-                                                           :number    [:cyan]
-                                                           :string    [:magenta]
-                                                           :character [:magenta]
-                                                           :keyword   [:yellow]
-                                                           :symbol    nil
-
-                                        ; special types
-                                                           :function-symbol [:cyan]
-                                                           :class-delimiter [:cyan]
-                                                           :class-name      [:cyan]}}))
-
-(def ^:dynamic *color-palette* [1 3 2 6 5])
-
-(defn apply-color-palette
-  [n]
-  (nth *color-palette*
-       (mod n (count *color-palette*))))
-
-(defn color-code
-  [& {:keys [fg bg fg* bg* bold]}]
-  (let [ansi #(conj % (+ %2 (mod %3 10)))]
-    (->> (cond-> []
-           (#{true 1} bold) (conj 1)
-           fg (ansi 30 fg)
-           bg (ansi 40 bg)
-           fg* (ansi 30 (apply-color-palette fg*))
-           bg* (ansi 40 (apply-color-palette bg*)))
-         (clojure.string/join ";")
-         (format "\33[%sm"))))
-
-(def color-code-MZ  (memoize color-code))
-
-(defn mk-lazy-color-fg*
-  [& [i]]
-  (lazy-cat [(color-code-MZ :fg* i)]
-            (mk-lazy-color-fg* (inc i))))
-
-(def lazy-color-fg* (mk-lazy-color-fg* 0))
-
-(defn mk-lazy-color-fg*-str
-  [s]
-  (interleave lazy-color-fg*
-              (repeat s)))
-
-(def lazy-color-fg*-pipes (mk-lazy-color-fg*-str "|"))
-
-(defn slinky-pipes
-  [len & {:keys [start end]}]
-  (apply str
-         (concat
-          (take (- (* 2 len) (count end)) lazy-color-fg*-pipes)
-          (if end
-            [(color-code :fg* (dec len))
-             end]
-            [])
-          [" "])))
-
-(def slinky-pipes-MZ (memoize slinky-pipes))
-
-(def reset-color-code (color-code-MZ))
-
-(defn indent
-  [depth & {:keys [end]}]
-  (slinky-pipes-MZ depth
-                :end end))
-
-(def indent-MZ indent #_ (memoize indent))
-
-(def truncate-msg (str reset-color-code
-                       "...<truncated>..."))
-
-(defn truncate-lines
-  [strs]
-  (cond
-    (nil? *truncate-lines-count*) strs
-    (> *truncate-lines-count* (count strs)) strs
-    :else (util/$- ->
-                   strs
-                   (take *truncate-lines-count* $)
-                   vec
-                   (conj truncate-msg))))
-
-(defn indent-line-breaks
-  [s depth & rest]
-  [""
-   (->> s
-        clojure.string/split-lines
-        truncate-lines
-        (mapv (fn [line] [(apply indent-MZ depth rest)
-                          line
-                          reset-color-code
-                          "\n"])))])
-
-(defn get-line-meta
-  [v & {:keys [path header?]}]
-  (util/$- some-> (or (:src-pos v)
-                      (:meta v))
-           (select-keys [:line :column :file :end-line :end-column])
-           (assoc :id (:id v)
-                  :fn-name (or (:parent-name v)
-                               (:name v))
-                  :path path
-                  :header header?)
-           (update-in [:file] #(if (string? %)
-                                 (util/get-src-file-path %)
-                                 %))
-           {:src $}))
-
-(defn name->string
-  [tree start?]
-  (let [{:keys [depth name form ns parent-name macro? xpanded-frm]} tree]
-    (if (nil? depth)
-      []
-      [(get-line-meta tree :header? true)
-       (slinky-pipes-MZ depth :end (when start? "v"))
-       (when (:throw tree)
-         [(color-code-MZ :fg 1 :bg 7)
-          "!"
-          (color-code-MZ)
-          " "])
-       (if parent-name
-         [(color-code-MZ :fg 0 :bg* (dec depth) :bold false)
-          (str (if-not (nil? form)
-                 form
-                 name))
-          (when macro?
-            [(color-code-MZ :fg* (dec depth) :bg 0 :bold false) " => " (str xpanded-frm)])
-          (color-code-MZ :fg* (dec depth) :bg 0 :bold false)
-          "  " (str parent-name)]
-         [(color-code-MZ :fg* (dec depth) :bg 0 :bold false)
-          (str name)])
-       "  "
-       (color-code-MZ :fg 7)
-       (-> tree :id str)
-       reset-color-code])))
-
-(defn remove-ansi
-  [s]
-  (let [r (re-pattern (str "\33" "\\[.*?m"))]
-    (apply str (clojure.string/split s r))))
-
-(defn count-ansi-chrs
-  [s]
-  (- (count s) (-> s remove-ansi count)))
-
-(defn buffer-string
-  [n s]
-  (util/$- ->> s
-           (concat $ (repeat " "))
-           (take (+ n
-                    (count-ansi-chrs s)))
-           (apply str)))
-
-(defn string->col-str-seq
-  [s]
-  (let [lines (clojure.string/split-lines s)
-        max (->> lines (map remove-ansi) (map count) (apply max))
-        lines' (->> lines (map (partial buffer-string max)))]
-    (concat lines' (repeat (buffer-string max "")))))
-
-(defn mk-column-str
-  [& cols]
-  (let [strs (filter string? cols)
-        lines (map clojure.string/split-lines strs)
-        max-height (->> lines
-                        (map count)
-                        (apply max)
-                        (min (or *truncate-lines-count*
-                                 Integer/MAX_VALUE)))
-        col-seqs (map #(if (string? %)
-                         (string->col-str-seq %)
-                         %)
-                      cols)]
-    (apply str (take (* (inc (count cols)) max-height)
-                     (apply interleave (concat col-seqs [(repeat "\n")]))))))
-
-(defn multi-line-indent2
-  [& {:keys [cols indent-base]}]
-  (->> cols
-       (apply mk-column-str
-              (repeat (indent-MZ indent-base)))))
-
-(def multi-line-indent2-MZ  (memoize multi-line-indent2))
-
-(defn indent-arg-map
-  [tree m]
-  (->> m
-       (map (fn [[label value]]
-              [(get-line-meta tree
-                              :path [:arg-map label])
-               (multi-line-indent2-MZ :cols [(str label " => ") (pprint-str value)]
-                                     :indent-base (:depth tree))]))
-       vec))
-
-(defn indent-map
-  [tree m]
-  (->> m
-       (map (fn [[label value]]
-              (multi-line-indent2-MZ :cols [ (str label " => ")
-                                             (pprint-str value)]
-                                    :indent-base (:depth tree)
-                                    :indent-offset  3)))
-       vec))
-
-(defn return-str
-  [tree & {pos :pos}]
-  (binding [*truncate-lines-count* 20]
-    (when (contains? tree :return)
-      (let [return (:return tree)]
-        [(get-line-meta tree
-                        :path [:return])
-         (multi-line-indent2-MZ :cols [(condp = pos
-                                         :before "returns"
-                                         :after "returned")
-                                       " => "
-                                       (pprint-str return)]
-                                :indent-base (:depth tree))]))))
-
-(defn args-map-str
-  [tree]
-  (binding [*truncate-lines-count* *max-arg-lines*]
-    (when-let [arg-map (:arg-map tree)]
-      (indent-arg-map tree arg-map))))
-
-(defn args-str
-  [tree]
-  (binding [*truncate-lines-count* *max-arg-lines*]
-    (when-let [args (:args tree)]
-      (->> args
-           (map-indexed (fn [i value]
-                          [(get-line-meta tree :path [:args i])
-                           (multi-line-indent2-MZ :cols [(pprint-str value)]
-                                                 :indent-base (:depth tree))]))
-           vec))))
-
-(defn let-binds-str
-  [tree]
-  (->> tree
-       :let-binds
-       (map-indexed (fn [i [val sym frm]]
-                      [(get-line-meta tree :path [:let-binds i 0])
-                       (multi-line-indent2-MZ :cols [(str sym)
-                                                     (str (color-code)
-                                                          " <= ")
-                                                     (pprint-str val)
-                                                     " <= "
-                                                     (pprint-str frm)]
-                                              :indent-base (:depth tree))]))
-       vec))
-
-(defn args*-str
-  [tree]
-  (let [test #(-> tree % not-empty)]
-    ((cond
-       (test :arg-map) args-map-str
-       (test :args) args-str
-       (test :let-binds) let-binds-str
-       :else (constantly ""))
-     tree)))
-
-(defn throw-str
-  [tree]
-  (when-let [thrown (:throw tree)]
-    [ (indent-MZ (:depth tree))
-      (color-code-MZ :fg 7 :bg 1 :bold true)
-      "THROW"
-      reset-color-code
-      " => "
-      (pprint-str (:cause thrown))
-      "\n"
-      (indent-line-breaks
-       (->> thrown
-            :via
-            (mapv (fn [v]
-                    (let [at (:at v)
-                          [c f l] ((juxt :class-name
-                                         :file-name
-                                         :line-number)
-                                   at)]
-                      (format "%s %s:%s" c f l))))
-            pprint-str)
-       (:depth tree))
-      "\n"]))
-
-(defn selects-str
-  [tree selects]
-  (let [sel-fn (fn [sel]
-                 (util/get-some (if (vector? sel)
-                                  sel
-                                  [sel])
-                                tree))
-        sel-map (util/apply-to-map-vals sel-fn
-                                        selects)]
-    [(get-line-meta tree)
-     (indent-map tree sel-map)]))
-
-(defmacro when-sel
-  [kw & body]
-  `(when (~kw ~'view)
-     [~@body]))
-
-(defn tree->string*
-  [tree]
-  (if (nil? tree)
-    []
-    (let [view (*view* tree)
-          trace-root? (-> tree meta :trace-root)
-          visible? (and (not trace-root?)
-                        view)
-          has-children (some-> tree
-                               :children
-                               not-empty)]
-      [(when visible?
-         [(name->string tree true) "\n"
-          (when-let [selects (:selects view)]
-            (selects-str tree selects))
-          (when-sel :args (args*-str tree))])
-       (when has-children
-         [(when-sel :return (return-str tree :pos :before))
-          (when-sel :throw (throw-str tree))
-          (mapv tree->string* (:children tree))
-          (when (not trace-root?)
-            [(name->string tree false) "\n"])
-          (when-sel :args
-                    (args*-str tree))])
-       (when visible?
-         [(when-sel :return (return-str tree :pos :after))
-          (when-sel :throw (throw-str tree))
-          (get-line-meta tree) ;; clear meta
-          (slinky-pipes-MZ (:depth tree)
-                           :end "^")])
-       reset-color-code
-       "\n"])))
-
-(defn tree->string
-  [tree]
-  (->> tree
-       tree->string*
-       flatten
-       (remove nil?)
-       (remove map?)
-       (clojure.string/join "")))
-
-
-
-(defn audit-ns->summary-view
-  [audit-ns]
-  (let [[ns-sym audit-fns] audit-ns
-        fn-count (count audit-fns)
-        traced-count (->> audit-fns
-                          (map second)
-                          (map :trace-type)
-                          (filter #{:fn :inner-fn})
-                          count)]
-    [{:src {:ns ns-sym}} (format "  %s / %s  %s\n" traced-count fn-count ns-sym)]))
-
-(defn audit-fn->view
-  [[ fn-sym {:keys [trace-type trace-selection] :as  fn-meta}]]
-  [{:src fn-meta} (format "  %s %s %s\n"
-                   (case trace-selection
-                     :fn "O"
-                     :inner-fn "I"
-                     :ns " "
-                     nil "x"
-                     :else "?")
-                   (case trace-type
-                     :fn "E"
-                     :inner-fn "E"
-                     nil "D"
-                     :else "?")
-                   fn-sym)])
-
-(defn audit-fn-group->view
-  [[ns-sym audit-fns]]
-  (concat [(format "- in ns %s\n" ns-sym)]
-          (mapcat audit-fn->view audit-fns)))
-
-(defn audit->top-view
-  [audit & [ns-sym]]
-  (concat ["Traced namespaces:\n"]
-          (mapcat audit-ns->summary-view (:ns audit))
-          ["\n\nTraced functions:\n"]
-          (mapcat audit-fn-group->view (:fn audit))))
-
-(defn audit->ns-view
-  [audit & [ns-sym]]
-  (concat [{:src {:ns ns-sym}} (format "Namespace %s\n" ns-sym)]
-          (mapcat audit-fn->view
-                  (-> audit :ns (get ns-sym)))
-          [{:src {}} "\n\nTraced functions:\n"]
-          (mapcat audit-fn->view
-                  (-> audit :fn (get ns-sym)))))
-
-
-
-
-(declare strings-agg-head)
-
-(defn map-agg-head
-  [agg [next & tail :as items]]
-  (cond (empty? items) agg
-        (map? next) #(map-agg-head (concat [next ""]
-                                           agg)
-                                   tail)
-        (string? next) #(strings-agg-head (concat [[next]] agg)
-                                          tail)
-        (nil? next) #(map-agg-head agg
-                                   tail)))
-
-(defn strings-agg-head
-  [[agg-head & agg-tail :as agg] [next & tail :as items]]
-  (cond (empty? items) (concat [(apply str agg-head)]
-                                     agg-tail)
-        (string? next) #(strings-agg-head (concat [(conj agg-head next)]
-                                                  agg-tail)
-                                          tail)
-        :else #(map-agg-head (concat [next (apply str agg-head)]
-                                     agg-tail)
-                             tail)))
-
-(defn group-meta-strings
-  [v]
-  (let [[head :as all] (util/$- ->> v
-                                (trampoline map-agg-head [])
-                                reverse
-                                (drop-while #{""}))]
-    all))
-
-
-(defn map->kvpair
-  [m]
-  (let [[[k v]] (vec m)]
-    [k v]))
-
-(defmulti merge-tags (fn [k _ _] k))
-
-(defmethod merge-tags :display
-  [_ new old]
-  (merge old new))
-
-(defmethod merge-tags :src
-  [_ new old]
-  new)
-
-(defn open-tag
-  [tag-map pos open-tags]
-  (let [[k v] (map->kvpair tag-map)
-        prev-v (k open-tags)]
-    (merge open-tags
-           {k (util/$- -> v
-                       (merge-tags k $ prev-v)
-                       (assoc :_start pos)
-                       (dissoc :_end))})))
-
-(defn close-tag
-  [kw open-tags pos]
-  (some-> open-tags
-          kw
-          (assoc-in [:_end]
-                    pos)))
-
-(defn close-all-open
-  [agg-tags open-tags pos]
-  (->> open-tags
-       keys
-       (map #(close-tag % open-tags pos))
-       (filter #(< (:_start %) (:_end %)))
-       (concat agg-tags)))
-
-(defn finalize-tags
-  [agg-tags open-tags pos]
-  (->> (close-all-open agg-tags open-tags pos)
-       (remove nil?)
-       (mapv #(vector (:_start %)
-                      (:_end %)
-                      (dissoc % :_start :_end)))))
-
-(defn do-map
-  [head open-tags agg-tags pos]
-  [(open-tag head pos open-tags)
-   (conj agg-tags (close-tag (-> head first first)
-                             open-tags
-                             pos))])
-
-(defn do-string
-  [s agg-txt pos]
-  [(conj agg-txt s)
-   (+ pos (count s))])
-
-(defn split-text-tag-coll
-  [c]
-  (loop [[head & tail] c
-         open-tags {}
-         agg-txt []
-         agg-tags []
-         pos 1]
-    (cond
-      (map? head)
-      (let [[a b] (do-map head open-tags agg-tags pos)]
-        (recur tail a agg-txt b pos))
-
-      (string? head)
-      (let [[a b] (do-string head agg-txt pos)]
-        (recur tail open-tags a agg-tags b))
-
-      (nil? head)
-      [(apply str agg-txt)
-       (finalize-tags agg-tags
-                      open-tags
-                      pos)])))
-
-(defn color-pair->fg-bg-map
-  [a b]
-  (let [a' (util/->int a)
-        b' (util/->int b)
-        ->kw (fn [v] (case (-> v (/ 10.0) Math/floor util/->int)
-                       3 :fg
-                       4 :bg))]
-    (if (every? (some-fn nil? zero?) [a' b'])
-      {:fg "--" :bg "--"}
-      (merge {}
-             (when a'
-               {(->kw a') a'})
-             (when b'
-               {(->kw b') b'})))))
-
-(def regex1  (re-pattern (str "\33" "\\[(\\d+)?(;(\\d+))?m")))
-
-(defn ansi->prop-map
-  [ansi]
-  (let [rm (re-matcher regex1
-                       ansi)]
-    (loop [[match c1 _ c2] (re-find rm)
-           agg {}]
-      (if-not (nil? match)
-        (recur (re-find rm)
-               (merge agg
-                      (color-pair->fg-bg-map c1
-                                             c2)))
-        {:text-color agg}))))
-
-(def regex2 (re-pattern (str "([^" "\33" "]*)(("  "\33" ".*?m)*)")))
-
-(defn str->ansi-pairs
-  [s]
-  (let [r regex2]
-    (loop [head []
-           tail s]
-      (let [[match txt ansi _] (re-find r tail)
-            tail' (subs tail (count match))
-            ansi' (when ansi
-                    {:display (ansi->prop-map ansi)})
-            head' (concat head (remove empty? [txt ansi']))]
-        (cond (empty? tail') head'
-              (and (empty? txt)
-                   (empty? ansi)) (concat head' [tail'])
-              :else  (recur head'
-                            tail'))))))
-
-(defn annotated->text-prop-pair
-  [a]
-  (->> a
-       flatten
-       (remove nil?)
-       group-meta-strings
-       (map #(if (string? %)
-               (str->ansi-pairs %)
-               %))
-       flatten
-       split-text-tag-coll))
-
-(defn tree->text-prop-pair
-  [tree]
-  (->> tree
-       tree->string*
-       flatten
-       (remove nil?)
-       group-meta-strings
-       (mapv #(if (string? %)
-                (str->ansi-pairs %)
-               %))
-       flatten
-       split-text-tag-coll))
-
-(defn tree->meta
-  [tree]
-  (loop [[head & tail] tree
-         pos 1
-         agg (sorted-map)]
-    (cond (nil? head) agg
-
-          (= head "\n")
-          (recur tail (inc pos) agg)
-
-          :else
-          (recur tail pos (assoc agg pos head)))))
-
-(defn tree->string+meta
-  [tree]
-  (let [flat-tree (->> tree
-                       tree->string*
-                       flatten
-                       (remove nil?))
-        tree-str (->> flat-tree
-                      (remove map?)
-                      (clojure.string/join ""))
-        tree-meta (->> flat-tree
-                       (filter #(or (map? %)
-                                    (and (string? %)
-                                         (re-find #"\n+" %))))
-                       tree->meta)]
-    {:string tree-str
-     :meta tree-meta}))
-
-(defn print-tree-unlimited
-  [tree]
-  (-> tree
-      tree->string
-      print))
-
-(defn print-tree
-  [tree]
-  (let [s (with-out-str (print-tree-unlimited tree))
-        s' (if (< *max-chars*
-                  (count s))
-             (str (subs s 0 *max-chars*)
-                  truncate-msg)
-             s)]
-    (print s')))
-
-(defn print-trees
-  [trees]
-  (doseq [t trees]
-    (print-tree t)))
-
-(defn print-trees-unlimited
-  [trees]
-  (doseq [t trees]
-    (print-tree-unlimited t)))


updating platform-vendor-matches? fn to use re-find instead of re-matches

--HG--
branch : develop

--- src/simplecl/core.clj
+++ src/simplecl/core.clj
@@ -67,7 +67,7 @@
    [re]
    (proxy [Filter] []
      (accept [^CLPlatform p]
-       (not (nil? (re-matches re (.getVendor p)))))))
+       (not (nil? (re-find re (.getVendor p)))))))

 ;; # CL state handling


Scraper can now read page numbers again

Scraper can now read page numbers again

--- src/mafia_votecount/scraper/team_liquid.clj
+++ src/mafia_votecount/scraper/team_liquid.clj
@@ -41,12 +41,7 @@
   (map #(:content %) (html/select posts [[:.forumPost]])))

 (defn- get-page-number-bar [content]
-  (-> (html/select content [:table :tr ])
-      (nth 0)
-      (get :content)
-      (nth 3)
-      (get :content)
-      ((fn [pages] (remove string? pages)))
+  (-> (html/select content [:.pagination :* ])
       ((fn [pages] (map #(first (get % :content)) pages)))))

 (defn parse-int [v]
@@ -271,8 +266,7 @@
        ;                      (is-cycle-change?))
         day-ranges (-> cycle-posts
                        (keys)
-                       ; hosts can just add some text before the night 0 message though so maybe not so important after all...?
-                       ; or the first night post could be automatically ignored? (every cycle post before the first day post basically)
+                       ; Handle case where first cycle is night
                        (#(if (= cycle-type :day)
                            (cons (dec first-index) %)
                            %))


cmd-line fill-extract with dataset version = nil

--- src/main/clojure/pdok/featured/extracts.clj
+++ src/main/clojure/pdok/featured/extracts.clj
@@ -187,7 +187,7 @@
 (defn -main [template-location dataset-name extract-type & more]
   (let [templates-with-metadata (template/templates-with-metadata dataset-name template-location)]
     (if-not (some false? (map template/add-or-update-template templates-with-metadata))
-      (println (apply fill-extract dataset-name extract-type more))
+      (println (apply fill-extract dataset-name nil extract-type more))
       (println "could not load template(s)"))))

 ;(with-open [s (file-stream ".test-files/new-features-single-collection-100000.json")] (time (last (features-from-package-stream s))))


4px gap between components

4px gap between components

--- flatguicore/src/flatgui/layout.clj
+++ flatguicore/src/flatgui/layout.clj
@@ -16,7 +16,7 @@
   (:import (java.util.regex Pattern)))

-(def gap (* (awt/px) 2))
+(def gap (* (awt/px) 4))

 (def component-min-size (m/defpoint 0.375 0.375))

@@ -340,10 +340,10 @@
   (if-let [coord-map (get-property [] :coord-map)]
     (if-let [coord ((:id component) coord-map)]
       (let [ps (get-property [] :clip-size)
-            btop (+ 0.375 (awt/px) (awt/px)) ;TODO see 0.375 - window border
-            bbtm (+ (awt/px) (awt/px))
-            bleft (+ (awt/px) (awt/px))
-            bright(+ (awt/px) (awt/px))]
+            btop (+ 0.375 gap) ;TODO see 0.375 - window border
+            bbtm gap
+            bleft gap
+            bright gap]
         (m/translation
           (d/round-granular (+ bleft gap (* (:x coord) (- (m/x ps) bleft bright))) (awt/px))
           (d/round-granular (+ btop gap (* (:y coord) (- (m/y ps) btop bbtm))) (awt/px))))
@@ -354,10 +354,10 @@
   (if-let [coord-map (get-property [] :coord-map)]
     (if-let [coord ((:id component) coord-map)]
       (let [ps (get-property [] :clip-size)
-            btop (+ 0.375 (awt/px) (awt/px)) ;TODO see 0.375 - window border
-            bbtm (+ (awt/px) (awt/px))
-            bleft (+ (awt/px) (awt/px))
-            bright(+ (awt/px) (awt/px))]
+            btop (+ 0.375 gap) ;TODO see 0.375 - window border
+            bbtm gap
+            bleft gap
+            bright gap]
         (m/defpoint
           (d/round-granular (- (* (:w coord) (- (m/x ps) bleft bright)) gap gap) (awt/px))
           (d/round-granular (- (* (:h coord) (- (m/y ps) btop bbtm)) gap gap) (awt/px))))


Add metadata for the RHS to the production schema for line number support.

--- src/main/clojure/clara/rules/schema.clj
+++ src/main/clojure/clara/rules/schema.clj
@@ -62,6 +62,7 @@
    (s/optional-key :env) {s/Keyword s/Any}
    :lhs [Condition]
    :rhs s/Any
+   (s/optional-key :rhs-meta) s/Any
    })

 (def Query


Using clojure.data.xml for :conexp output

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

--- src/main/clojure/conexp/io/contexts.clj
+++ src/main/clojure/conexp/io/contexts.clj
@@ -198,12 +198,12 @@
         attributes (vector :Attributes
                            (map (fn [[att id]]
                                   [:Attribute {:Identifier id}
-                                   [:raw! (str "\n          <Name>" att "</Name>")]])
+                                   [:Name att]])
                                 ctx-atts))
         objects (vector :Objects
                         (for [obj ctx-objs]
                           [:Object
-                           [:raw! (str "\n          <Name>" obj "</Name>")]
+                           [:Name obj]
                            (vector :Intent
                                    (for [att (object-derivation ctx #{obj})]
                                      [:HasAttribute {:AttributeIdentifier (ctx-atts att)}]))]))]
@@ -213,11 +213,11 @@

 (define-context-output-format :conexp
   [ctx file]
-  (with-out-writer file
-    (prxml [:decl! {:version "1.0"}])
-    (prxml [:ConceptualSystem
-            [:Version {:MajorNumber "1", :MinorNumber "0"}]
-            [:Contexts (ctx->xml-vector ctx 0)]])))
+  (with-open [outfile (clojure.java.io/writer file)]
+    (xml/emit (xml/sexp-as-element [:ConceptualSystem
+                                    [:Version {:MajorNumber "1", :MinorNumber "0"}]
+                                    [:Contexts (ctx->xml-vector ctx 0)]])
+              outfile)))

 ;; Galicia (.bin.xml)


Make use :azure/scriptFile metadata in :azure-app (#310)

The parameter, usually in function.json, is used as name to the JavaScript
function file.

--- src/main/shadow/build/targets/azure_app.clj
+++ src/main/shadow/build/targets/azure_app.clj
@@ -61,7 +61,7 @@
         (io/file output-dir "function.json")

         index-file
-        (io/file output-dir "index.js")]
+        (io/file output-dir (get "scriptFile" fn-data "index.js"))]

     (when (empty? fn-data)
       (throw (ex-info (format "azure fn %s did not define any azure metadata" azure-fn) {:fn-id fn-id :azure-fn azure-fn})))


hiccup for slide out user options menu

hiccup for slide out user options menu

--- frontend/components/aside.cljs
+++ frontend/components/aside.cljs
@@ -109,6 +109,24 @@
                          :repo repo}
                         {:react-key (first branch-data)})))])))))

+(defn context-menu [app owner]
+  (reify
+    om/IRender
+    (render [_]
+      (let [controls-ch (om/get-shared owner [:comms :controls])]
+        (html
+          [:div.aside-user {:class (when (get-in app state/user-options-shown-path)
+                                     "open")}
+           [:header
+            [:h5 "Your Account"]
+            [:a.close-menu
+             {:on-click #(put! controls-ch [:user-options-toggled])}
+             (common/ico :fail-light)]]
+           [:div.aside-user-options
+            [:a.aside-item {:href "/account"} "Settings"]
+            [:a.aside-item {:on-click #(utils/open-modal "#inviteForm")} "Invite a Teammate"]
+            [:a.aside-item {:href "/logout"} "Logout"]]])))))
+
 (defn activity [app owner opts]
   (reify
     om/IDisplayName (display-name [_] "Aside Activity")
@@ -121,6 +139,7 @@
             controls-ch (om/get-shared owner [:comms :controls])]
         (html
          [:nav.aside-left-nav.context
+          (om/build context-menu app)
           [:div.aside-activity.open
            [:div.wrapper
             [:header


Create the server side cache for each table

When a realtime query comes in then make sure we have a server side
cache for that table

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -662,13 +662,38 @@

-
-
-
-
-
-
-
+(defn create-record-cache-for-table  [db-table]
+  (let [table-atom (get @server-side-cached-records  db-table)
+        ]
+    (do
+      (if (nil? table-atom)
+        (swap! server-side-cached-records assoc db-table (atom {})))))
+  )
+
+
+(defn get-record [db-table id fields realtime]
+  (if realtime
+    (do
+      (create-record-cache-for-table  db-table)
+    ))
+
+  (sql-1
+   (str
+    "select "
+    (fields-to-str fields) " "
+    "from "
+    db-table " "
+    "where id = ? "
+    (cond
+     (= *database-type* "postgres" )
+     " limit 1"
+
+     (= *database-type* "oracle" )
+     ""
+     )
+
+
+    ) [id]))

@@ -685,23 +710,7 @@
       ;(println (str " !get-record-result-v2 DATA_SESSION_ID: " data-session-id))
       (println (str " !get-record-result-v2 realtime: " realtime))
   {:value
-   (sql-1
-    (str
-     "select "
-     (fields-to-str fields) " "
-     "from "
-     db-table " "
-     "where id = ? "
-     (cond
-       (= *database-type* "postgres" )
-       " limit 1"
-
-       (= *database-type* "oracle" )
-       ""
-       )
-
-
-     ) [id])})
+   (get-record  db-table id fields realtime)})


better debug logging

better debug logging

--- src/clj/backtype/storm/daemon/drpc.clj
+++ src/clj/backtype/storm/daemon/drpc.clj
@@ -50,18 +50,21 @@
         ]
     (reify DistributedRPC$Iface
       (^String execute [this ^String function ^String args]
+        (log-debug "Received DRPC request for " function " " args " at " (System/currentTimeMillis))
         (let [id (str (swap! ctr (fn [v] (mod (inc v) 1000000000))))
               ^Semaphore sem (Semaphore. 0)
               req (DRPCRequest. args id)
               ^ConcurrentLinkedQueue queue (acquire-queue request-queues function)
               ]
-          (log-debug "Received DRPC request for " function " " args " at " (System/currentTimeMillis))
           (swap! id->start assoc id (current-time-secs))
           (swap! id->sem assoc id sem)
           (.add queue req)
+          (log-debug "Waiting for DRPC result for " function " " args " at " (System/currentTimeMillis))
           (.acquire sem)
+          (log-debug "Acquired DRPC result for " function " " args " at " (System/currentTimeMillis))
           (let [result (@id->result id)]
             (cleanup id)
+            (log-debug "Returning DRPC result for " function " " args " at " (System/currentTimeMillis))
             (if (instance? DRPCExecutionException result)
               (throw result)
               result


alias

alias

--- src/cljs/infinitelives/utils/vec2.cljs
+++ src/cljs/infinitelives/utils/vec2.cljs
@@ -194,6 +194,8 @@
 (defn as-vector [v]
   [(aget v 0) (aget v 1)])

+(def get-xy as-vector)
+
 (defn get-x [v]
   (aget v 0))


Removed toying-around code

Removed toying-around code

--- src/cljs/om_pages/components/util.cljs
+++ src/cljs/om_pages/components/util.cljs
@@ -17,17 +17,3 @@
   ([component cursors] (domify-all component cursors {}))
   ([component cursors m] (map domify cursors (repeat m))))

-
-(defn check-link [cursor owner {:keys [attrs children]}]
-  (reify
-    om/IRender
-    (render [_]
-      (apply dom/a attrs "√ " children) )))
-
-(defn stuff [cursor owner]
-  (reify
-    om/IRender
-    (render [_]
-      (let [dom-check-link (domify check-link cursor)]
-        (dom-check-link #js {:href "javascript:alert('Hello world!');"}
-          "Click here!")))))


Export to pdf, removed extra ajax call

Export to pdf, removed extra ajax call

--- src/cljs/salava/badge/ui/settings.cljs
+++ src/cljs/salava/badge/ui/settings.cljs
@@ -39,10 +39,7 @@
 (defn export-to-pdf [state]
   (let [lang-option "all"
         badge-url (str "/obpv1/badge/export-to-pdf?badges[0]=" (:id @state) "&lang-option="lang-option)]
-    (ajax/GET
-      (path-for (str "/obpv1/badge/export-to-pdf"))
-      {:params {:badges (list (:id @state)) :lang-option lang-option }
-       :handler (js-navigate-to badge-url)})))
+    (js-navigate-to badge-url)))

 (defn update-settings [badge-id state]
   (ajax/GET


Gallery plugin, pagination fix

Gallery plugin, pagination fix

--- src/cljs/salava/gallery/ui/badges.cljs
+++ src/cljs/salava/gallery/ui/badges.cljs
@@ -57,7 +57,7 @@
 (defn fetch-badges [state]
   (let [{:keys [user-id country-selected badge-name recipient-name issuer-name tags order full-tags tags-badge-ids value]} @state
         ajax-message-atom (cursor state [:ajax-message])
-        page-count-atom (cursor state [:page_count])]
+        page-count-atom (cursor state [:params :page_count])]
     (reset! ajax-message-atom (t :gallery/Searchingbadges))
     (reset! page-count-atom 0)
     (ajax/GET
@@ -73,9 +73,9 @@
                     :page_count     @page-count-atom}
        :handler (fn [data]
                   (value-helper state (get-in data [:tags]))
+                  (swap! page-count-atom inc)
                   (swap! state assoc
                          :badges (:badges data)
-                         :page_count (inc (:page_count @state))
                          :badge_count (:badge_count data)))
        :finally (fn []
                   (ajax-stop ajax-message-atom))})))
@@ -83,8 +83,9 @@

 (defn get-more-badges [state]
   (let [{:keys [user-id country-selected badge-name recipient-name issuer-name
-                tags order full-tags tags-badge-ids value page_count]} @state
-        ajax-message-atom (cursor state [:ajax-message])]
+                tags order full-tags tags-badge-ids value]} @state
+        ajax-message-atom (cursor state [:ajax-message])
+        page-count-atom (cursor state [:params :page_count])]
     (ajax/GET
       (path-for (str "/obpv1/gallery/badges"))
       {:params  (:params @state)
@@ -98,9 +99,9 @@
                  :page_count     page_count}
        :handler (fn [data]
                   (value-helper state (get-in data [:tags]))
+                  (swap! page-count-atom inc)
                   (swap! state assoc
                          :badges (into (:badges @state) (:badges data))
-                         :page_count (inc (:page_count @state))
                          :badge_count (:badge_count data)))
        :finally (fn []
                   )})))
@@ -303,8 +304,8 @@
      :handler (fn [data]
                 (let [{:keys [badges badge_count]} data]
                   ;(value-helper state tags)
+                  (reset! (cursor state [:params :page_count]) 1)
                   (swap! state assoc
-                         :page_count (inc (:page_count @state))
                          :badges badges
                          :badge_count badge_count)))
      :finally (fn []


Fix copyright year on rsapss ns.

Fix copyright year on rsapss ns.

--- src/clojure/buddy/core/sign/rsapss.clj
+++ src/clojure/buddy/core/sign/rsapss.clj
@@ -1,4 +1,4 @@
-;; Copyright 2014 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2014-2015 Andrey Antukh <niwi@niwi.be>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


Improve button refreshing in file browser

--- src/clojure/nightcode/file_browser.clj
+++ src/clojure/nightcode/file_browser.clj
@@ -114,20 +114,20 @@
 (defn toggle-visible!
   [view path]
   (let [edit? @edit-mode?
-        buttons {:#up (and (not edit?)
-                           (not (contains? @ui/tree-projects path)))
-                 :#new-file (not edit?)
-                 :#edit (and (not edit?)
-                             (->> (io/file path)
-                                  .listFiles
-                                  (filter #(.isFile %))
-                                  seq))
-                 :#open (and (not edit?)
-                             (Desktop/isDesktopSupported))
-                 :#save edit?
-                 :#cancel edit?}]
-    (doseq [[id should-show?] buttons]
-      (ui/config! view id :visible? should-show?))))
+        buttons {:up (and (not edit?)
+                          (not (contains? @ui/tree-projects path)))
+                 :new-file (not edit?)
+                 :edit (and (not edit?)
+                            (->> (io/file path)
+                                 .listFiles
+                                 (filter #(.isFile %))
+                                 seq))
+                 :open-in-browser (and (not edit?)
+                                       (Desktop/isDesktopSupported))
+                 :save edit?
+                 :cancel edit?}]
+    (doseq [btn (s/select view [:#widgets :<javax.swing.JComponent>])]
+      (s/config! btn :visible? (get buttons (s/id-of btn) (not edit?))))))

 (defn get-icon-path
   [f]
@@ -176,7 +176,8 @@
   []
   (let [actions (create-actions)
         widgets (create-widgets actions)
-        widget-bar (ui/wrap-panel :items (map #(get widgets % %) *widgets*))]
+        widget-bar (ui/wrap-panel :items (map #(get widgets % %) *widgets*)
+                                  :id :widgets)]
     (doto (s/border-panel :id :file-browser
                           :north widget-bar
                           :center (s/scrollable (ui/wrap-panel :id :file-grid)))


added import

added import

--- test/selmer/benchmark.clj
+++ test/selmer/benchmark.clj
@@ -1,6 +1,7 @@
 (ns selmer.benchmark
   (:require [clojure.test :refer :all]
             [selmer.parser :refer :all]
+            [selmer.util :refer :all]
             [criterium.core :as criterium]))

 (def user (repeat 10 [{:name "test" }]))


Cleanup

Cleanup

--- src/tango/export2.clj
+++ src/tango/export2.clj
@@ -12,107 +12,8 @@
 ;; Provides useful Timbre aliases in this ns
 (log/refer-timbre)

-(defn get-zip []
-  (let [test-file
-        (slurp (str "test/tango/examples/real-example-kungsor.xml"))]
-    (zip/xml-zip
-      (clojure.xml/parse (java.io.ByteArrayInputStream. (.getBytes test-file))))))
-
-(defn get-xml []
-  (let [test-file
-        (slurp (str "test/tango/examples/real-example-kungsor.xml"))]
-    (clojure.xml/parse (java.io.ByteArrayInputStream. (.getBytes test-file)))))
-
-;(def zipper (get-zip))
-;
-;(zx/attr (first (zx/xml-> zipper :CompData)) :Place)
-;
-;(zx/xml-> zipper :Class)
-;
-;(zx/attr (first (zx/xml-> zipper :ClassList :Class)) :Name)
-;
-;(zx/xml-> zipper :ClassList :Class)
-;
-;(first (zx/xml-> zipper :ClassList :Class))
-;(xml/emit-str (xml/element :Result {:Seq 0}))
-;; Producera ett <Result> i <Results>
-
-;(def zipper (zip/xml-zip (get-xml)))
-;
-;(defn tree-edit
-;  "Take a zipper, a function that matches a pattern in the tree,
-;   and a function that edits the current location in the tree.  Examine the tree
-;   nodes in depth-first order, determine whether the matcher matches, and if so
-;   apply the editor."
-;  [zipper matcher editor]
-;  (loop [loc zipper]
-;    (if (zip/end? loc)
-;      (zip/root loc)
-;      (if-let [matcher-result (matcher loc)]
-;        (let [new-loc (zip/edit loc editor)]
-;          (if (not (= (zip/node new-loc) (zip/node loc)))
-;            (recur (zip/next new-loc))))
-;        (recur (zip/next loc))))))
-;
-;;; match predicate, all book tags
-;(defn match-book? [loc]
-;  (let [tag (:tag (zip/node loc))]
-;    ;; true if tag is of type <path>
-;    (= :Class tag)))
-;
-;(def test-names
-;  {"Hiphop Singel Guld U" "XXXXXXXXXXXXXXXXX"})
-;
-;;; edit function
-;(defn editor [node]
-;  (let [id (-> node :attrs :Name)
-;        new-content (conj
-;                      (:content node)
-;                      (xml/element :price {} "XX"               ;(get test-names id id)
-;                                   ))]
-;    (assoc-in node [:content] new-content)))
-;
-;(def edited (tree-edit zipper match-book? editor))
-;
-;edited
-;(xml/indent-str
-;  edited)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(def raw-xml (get-xml))
-
-;; TODO - kolla om results finns pa icke startade
-(let [content (get-in raw-xml [:content])
-      class-list (nth content 2)
-      class-to-fix (first (filter #(= "Hiphop Singel Brons B1" (:Name (:attrs %))) (:content class-list)))
-      class-results (first (filter #(= :Results (:tag %)) (:content class-to-fix)))
-      new-results (conj (:content class-results) {:tag     :Result
-                                                  :attrs   {:hej "Marten"}
-                                                  :content nil})]
-
-  ;new-results
-  (assoc class-results :content new-results)
-  )
-
-(def new-stuff
-  (clojure.walk/postwalk
-    (fn [form]
-      (cond
-        (= (:tag form) :Class) (if (= (:Name (:attrs form))
-                                      "Hiphop Singel Brons B1")
-                                 {:tag     :Class
-                                  :attrs   {:Name "Changed Class"}
-                                  :content nil}
-                                 form)
-        :else form))
-    raw-xml))
-
-(spit "export3.xml" (with-out-str (clojure.xml/emit new-stuff)))
-
-
-(def raw-xml-2
-  (xml/parse (java.io.FileInputStream. "test/tango/examples/real-example.xml")))
+(defn get-xml-from-file [xml-file-path]
+  (xml/parse (java.io.FileInputStream. xml-file-path)))

 (def class-results [{:class-name "Disco Freestyle B-klass J Po"
                      :result {:round "S"
@@ -129,10 +30,6 @@
                                               :marks [false false true]}]}}
                     ])

-(def a-result-array (get-in (first class-results) [:result :result-array] ))
-(def a-couple-data (first a-result-array))
-(def a-marks (:marks a-couple-data))
-
 (defn get-dance-count-from-class-node [class-node]
   (let [dance-list-node (first (filter #(= (:tag %) :DanceList) (:content class-node)))]
     (count (:content dance-list-node))))
@@ -143,7 +40,7 @@
                 :X (if mark "X" " ")
                 :D3 ""
                 :A ""
-                :B "Awesome4"}))
+                :B ""}))

 (defn make-mark-list-node [marks]
   (xml/element :MarkList
@@ -187,7 +84,7 @@
         :else form))
     class))

-(defn new-stuff-2 [class-result]
+(defn add-results-to-dp-xml [xml-data class-result]
   (clojure.walk/postwalk
     (fn [form]
       (cond
@@ -197,80 +94,15 @@
                                  ;(xml/element :Class {:Name "Changed Class"})
                                  form)
         :else form))
-    raw-xml-2))
+    xml-data))

-(def class-node
-  (xml/element :Class {}
-               (xml/element :Foo {})
-               (xml/element :DanceList {}
-                            (xml/element :Dance {})
-                            (xml/element :Dance {})
-                            (xml/element :Dance {}))
-               (xml/element :Bar {})))
+(defn smoke-test []
+  (let [in-xml (get-xml-from-file "test/tango/examples/real-example.xml")
+        out-xml (add-results-to-dp-xml in-xml (first class-results))]
+    (spit "export5.xml" (xml/emit-str out-xml))))

-(get-dance-count-from-class-node class-node)
+(smoke-test)

-
-
-(xml/parse (java.io.FileInputStream. "test/tango/examples/real-example-kungsor.xml"))
-
-(def foo (xml/emit-str (new-stuff-2 (first class-results))))
-(spit "export4.xml" foo )
-
-;(make-mark-list-node a-marks)
-;(make-couple-node a-couple-data 7 3 6)
-;(make-result-node a-result-array 1 3)
-
-;(defn sanitize [cmp]
-;  (let [index (participant-index cmp)]
-;    (clojure.walk/postwalk
-;      (fn [form]
-;        (cond
-;          ;; replace participant-number with participant id in results
-;          (:result/participant-number form) (dissoc
-;                                              (assoc form :result/participant
-;                                                          {:participant/id
-;                                                           (get index
-;                                                                (:result/participant-number form))})
-;                                              :result/participant-number)
-;
-;          ;; adjudicator id should be in map form for lookup ref.
-;          (:judging/adjudicator form) (assoc form :judging/adjudicator
-;                                                  {:adjudicator/id (:judging/adjudicator form)})
-;
-;          ;; remove nil values
-;          (map? form) (let [m (into {} (remove (comp nil? second) form))]
-;                        (when (seq m)
-;                          m))
-;
-;          :else form))
-;      cmp)))
-
-(def class-results [{:class-name "Disco Freestyle B-klass J Po"
-                     :result {:ajudicators [{:number 2}
-                                            {:number 4}
-                                            {:number 5}]
-                              :dances [{:name "X-Quick Forward"}
-                                       {:name "Quick"}]
-                              :result-array [{:dancer-number 30
-                                              :marks [true false true]}
-                                             {:dancer-number 31
-                                              :marks [true true true]}
-                                             {:dancer-number 32
-                                              :marks [false false true]}]}}
-                    {:class-name "Disco Freestyle B-klass J Fl"
-                     :result {:ajudicators [{:number 1}
-                                            {:number 2}
-                                            {:number 4}]
-                              :dances [{:name "X-Quick"}]
-                              :result-array [{:dancer-number 40
-                                              :marks [true false false]}
-                                             {:dancer-number 41
-                                              :marks [true true true]}
-                                             ]}}
-                    ])
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; API
 (defn export-results [stuff]
   (log/info (str "Export Results with " stuff)))


Employ full paranoia around JSON action parsing

--- src/ctia/task/migration/migrations.clj
+++ src/ctia/task/migration/migrations.clj
@@ -164,7 +164,13 @@
 (defn read-actions [investigation]
   (let [actions (get investigation :actions)]
     (if (string? actions)
-      (json/parse-string actions true)
+      (try
+        (let [x (json/parse-string actions true)]
+          (if (sequential? x)
+            x
+            []))
+        (catch Exception _
+          []))
       [])))

 (def empty-action-data


Bind *data-readers* when scanning files for symbols

--- src/refactor_nrepl/find/symbols_in_file.clj
+++ src/refactor_nrepl/find/symbols_in_file.clj
@@ -41,7 +41,8 @@
   ([path parsed-ns] (symbols-in-file path parsed-ns :clj))
   ([path parsed-ns dialect]
    (util/with-additional-ex-data [:file path]
-     (binding [*ns* (or (find-ns (symbol (:ns parsed-ns))) *ns*)]
+     (binding [*ns* (or (find-ns (symbol (:ns parsed-ns))) *ns*)
+               reader/*data-readers* *data-readers*]
        (let [rdr (-> path slurp core/file-content-sans-ns
                      readers/indexing-push-back-reader)
              dialect (or dialect (core/file->dialect path))


Simplify the code slightly by using tools.reader

tools.reader keeps track of columns so we don't have to calculate this
ourselves.

--- src/refactor_nrepl/find/find_macros.clj
+++ src/refactor_nrepl/find/find_macros.clj
@@ -2,13 +2,14 @@
   (:import clojure.lang.LineNumberingPushbackReader
            [java.io BufferedReader File FileReader StringReader])
   (:require [clojure.string :as str]
+            [clojure.tools.reader :as reader]
+            [refactor-nrepl.find.bindings :as bindings]
             [refactor-nrepl.ns
              [helpers :as ns-helpers]
              [ns-parser :as ns-parser]
              [tracker :as tracker]]
             [refactor-nrepl.util :as util]
-            [rewrite-clj.zip :as zip]
-            [refactor-nrepl.find.bindings :as bindings]))
+            [rewrite-clj.zip :as zip]))

 (defn- keep-lines
   "Keep the first n lines of s."
@@ -21,18 +22,20 @@
        doall
        (str/join "\n")))

-(defn- build-macro-meta [form line-end path]
-  (let [file-content (slurp path)
+(defn- build-macro-meta
+  [form path]
+  (let [{:keys [line column end-line end-column]} (meta form)
+        file-content (slurp path)
         file-ns (util/ns-from-string file-content)
-        content (keep-lines file-content line-end)
+        content (keep-lines file-content end-line)
         sexp (util/get-last-sexp content)
         macro-name (name (second form))
         col-beg (dec (.indexOf sexp macro-name))]
     {:name (str file-ns "/" macro-name)
-     :col-beg col-beg
-     :col-end (+ col-beg (.length macro-name))
-     :line-end line-end
-     :line-beg (inc (- line-end (count (str/split-lines sexp))))
+     :col-beg column
+     :col-end end-column
+     :line-beg line
+     :line-end end-line
      :file (.getAbsolutePath path)
      :match sexp}))

@@ -41,13 +44,13 @@
   (with-open [file-rdr (FileReader. path)]
     (binding [*ns* (or (ns-helpers/path->namespace path :no-error) *ns*)]
       (let [rdr (LineNumberingPushbackReader. file-rdr)]
-        (loop [macros [], form (read rdr nil :eof)]
+        (loop [macros [], form (reader/read rdr nil :eof)]
           (cond
             (= form :eof) macros
             (and (sequential? form) (= (first form) 'defmacro))
-            (recur (conj macros (build-macro-meta form (.getLineNumber rdr) path))
-                   (read rdr nil :eof))
-            :else (recur macros (read rdr nil :eof))))))))
+            (recur (conj macros (build-macro-meta form path))
+                   (reader/read rdr nil :eof))
+            :else (recur macros (reader/read rdr nil :eof))))))))

 (defn- find-macro-definitions-in-project
   "Finds all macros that are defined in the project."


Updated results

Updated results

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -139,7 +139,7 @@

 (defn test-job?
     [job-name jobs-prefix preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
-    (and (.startsWith job-name jobs-prefix)
+    (and (startsWith job-name jobs-prefix)
          (or (endsWith job-name preview-jobs-suffix)
              (endsWith job-name stage-jobs-suffix)
              (endsWith job-name prod-jobs-suffix))))


Prepare user-friendly samples #15 - get rid of :use, cleanup

--- src/flatgui/samples/forms/helloworld.clj
+++ src/flatgui/samples/forms/helloworld.clj
@@ -7,18 +7,15 @@
 ; You must not remove this notice, or any other, from this software.

 (ns helloworld
-  ;; TODO Get rid of :use
-  (:use
-        flatgui.widgets.component
-        flatgui.widgets.label
-        flatgui.widgets.window
-        flatgui.widgets.checkbox)
-  (:require flatgui.skins.flat
-            flatgui.appcontainer
+  (:require [flatgui.app]
+            [flatgui.skins.flat]
             [flatgui.util.matrix :as m]
             [flatgui.base :as fg]
-            [flatgui.comlogic :as fgc]
-            [flatgui.awt :as awt]))
+            [flatgui.awt :as awt]
+            [flatgui.widgets.window :as window]
+            [flatgui.widgets.checkbox :as checkbox]
+            [flatgui.widgets.label :as label]
+            [flatgui.widgets.panel :as panel]))

 (def nogreeting-text "Not now")

@@ -31,36 +28,33 @@

 (def hello-window
   (fg/defcomponent
-    window
+    window/window
     :hello
-    {:clip-size (fgc/defpoint 3 1.5)
-     :position-matrix (m/transtation-matrix 1 1)
+    {:clip-size (m/defpoint 3 1.5)
+     :position-matrix (m/transtation 1 1)
      :text "Hello World Example"}

     (fg/defcomponent
-      checkbox
+      checkbox/checkbox
       :say-hello
-      {:clip-size (fgc/defpoint 1.75 0.25 0)
+      {:clip-size (m/defpoint 1.75 0.25 0)
        :text "Greeting"
-       :position-matrix (m/transtation-matrix 0.125 0.75)})
+       :position-matrix (m/transtation 0.125 0.75)})

     (fg/defcomponent
-      label
+      label/label
       :greeting
       {:text nogreeting-text
-       :clip-size (fgc/defpoint 2.25 0.25 0)
-       :position-matrix (m/transtation-matrix 1.0 0.75)
+       :clip-size (m/defpoint 2.25 0.25 0)
+       :position-matrix (m/transtation 1.0 0.75)
        :evolvers {:text greeting-evolver}})))

-;;;; TODO use defcontainer marco instead
-(def hellopanel
-  (flatgui.widgets.componentbase/initialize
-    (fg/defcomponent
-      component
-      :main
-      {:clip-size (fgc/defpoint 40 23 0)
-       :background (awt/color (float (/ 9 255)) (float (/ 17 255)) (float (/ 26 255)))}
+(def root-panel
+  (fg/defcomponent
+    panel/panel
+    :main
+    {:clip-size (m/defpoint 40 23 0)
+     :background (awt/color (float (/ 9 255)) (float (/ 17 255)) (float (/ 26 255)))}
+    hello-window))

-       hello-window)))
-
-(fg/log-debug "Application GUI has been created")+(def hellopanel (flatgui.app/defroot root-panel))


Ah, so Leiningen does have a flag for turning off the new non-project .class file removal behavior.

--- src/leiningen/appengine_prepare.clj
+++ src/leiningen/appengine_prepare.clj
@@ -6,7 +6,9 @@

 (defn appengine-prepare [project]
-  (let [prj-display-name (or (:appengine-display-name project) (:name project))
+  (let [prj-application (or (:appengine-application project) (:name project))
+        prj-display-name (or (:appengine-display-name project) (:name project))
+        prj-servlet (or (:appengine-entry-servlet project) "app_servlet")
         resources-dir (File. (:resources-path project))
         lib-dir (File. (:library-path project))
         lib-dev-dir (File. lib-dir "dev")
@@ -19,7 +21,10 @@
     ;; compile all
     (let [project-with-aot (if (contains? project :aot)
                                project
-                               (assoc project :aot :all))]
+                               (assoc project
+                                 :keep-non-project-classes true
+                                 :aot [(symbol (format "%s.%s"
+                                                       (_dash prj-application) prj-servlet))]))]
       (leiningen.compile/compile project-with-aot))
     ;; delete existing content of target lib/
     (lancet/delete {:dir (.getPath target-lib-dir)})


Full test

Full test

--- test/onyx/coordinator/simulation_test.clj
+++ test/onyx/coordinator/simulation_test.clj
@@ -34,10 +34,10 @@
         (<!! offer-ch-spy)

         (testing "There is one peer"
-            (let [query '[:find ?p :where [?e :node/peer ?p]]
-                  result (d/q query (d/db (:conn log)))]
-              (is (= (count result) 1))
-              (is (= (ffirst result) peer))))))))
+          (let [query '[:find ?p :where [?e :node/peer ?p]]
+                result (d/q query (d/db (:conn log)))]
+            (is (= (count result) 1))
+            (is (= (ffirst result) peer))))))))

 (deftest peer-joins-and-dies
   (with-system
@@ -57,9 +57,9 @@
         (<!! evict-ch-spy)

         (testing "There are no peers"
-            (let [query '[:find ?p :where [?e :node/peer ?p]]
-                  result (d/q query (d/db (:conn log)))]
-              (is (zero? (count result)))))))))
+          (let [query '[:find ?p :where [?e :node/peer ?p]]
+                result (d/q query (d/db (:conn log)))]
+            (is (zero? (count result)))))))))

 (deftest error-cases
   (with-system
@@ -114,7 +114,7 @@
                      :peer/task {:db/id task-id
                                  :task/complete? true}}]]
             @(d/transact (:conn log) tx)
-
+
             (>!! (:ack-ch-head coordinator) {:path node-path})
             (let [failure (<!! failure-ch-spy)]
               (is (= (:ch failure) :ack)))))
@@ -129,7 +129,7 @@
                      :peer/task {:db/id task-id
                                  :task/complete? false}}]]
             @(d/transact (:conn log) tx)
-
+
             (>!! (:ack-ch-head coordinator) {:path node-path})
             (let [failure (<!! failure-ch-spy)]
               (is (= (:ch failure) :ack)))))))
@@ -216,6 +216,7 @@
       (let [peer-node (extensions/create sync :peer)
             in-payload-node (extensions/create sync :payload)
             inc-payload-node (extensions/create sync :payload)
+            out-payload-node (extensions/create sync :payload)
             sync-spy (chan 1)
             ack-ch-spy (chan 1)
             offer-ch-spy (chan 1)
@@ -326,7 +327,87 @@
             (let [nodes (:nodes (extensions/read-place sync inc-payload-node))]
               (is (= (clojure.set/difference (into #{} (keys nodes))
                                              #{:payload :ack :completion :status})
-                     #{})))))))
+                     #{}))))
+
+          (testing "Touching the ack node triggers the callback"
+            (let [nodes (:nodes (extensions/read-place sync inc-payload-node))]
+              (extensions/touch-place sync (:ack nodes))
+              (let [event (<!! ack-ch-spy)]
+                (= (:path event) (:ack nodes)))))
+
+          (extensions/write-place sync peer-node out-payload-node)
+          (extensions/on-change sync out-payload-node #(>!! sync-spy %))
+
+          (testing "Touching the completion node triggers the callback"
+            (let [nodes (:nodes (extensions/read-place sync inc-payload-node))]
+              (extensions/touch-place sync (:completion nodes))
+              (let [event (<!! completion-ch-spy)]
+                (= (:path event) (:completion nodes)))))
+
+          (testing "The offer channel receives the tx id of the completion"
+            (let [tx-id (<!! offer-ch-spy)
+                  db (d/as-of (d/db (:conn log)) tx-id)]
+
+              (testing "The peer's nodes have been stripped"
+                (let [query '[:find ?payload ?ack ?status ?completion :in $ ?peer-node :where
+                              [?p :peer/status :idle]
+                              [?p :node/peer ?peer-node]
+                              [?p :node/payload ?payload]
+                              [?p :node/ack ?ack]
+                              [?p :node/status ?status]
+                              [?p :node/completion ?completion]]
+                      result (d/q query db peer-node)]
+                  (is (empty? result))))))
+
+          (testing "The payload node is populated"
+            (let [event (<!! sync-spy)]
+              (is (= (:path event) out-payload-node))))
+
+          (let [db (d/db (:conn log))]
+            (testing "It receives the :out task"
+              (let [task (:task (extensions/read-place sync out-payload-node))
+                    query '[:find ?task :where [?task :task/name :out]]]
+                (is (= (:db/id task) (ffirst (d/q query db))))))
+
+            (testing "The peer is marked as :acking the task"
+              (let [query '[:find ?task :where
+                            [?peer :peer/status :acking]
+                            [?peer :peer/task ?task]
+                            [?task :task/name :out]]]
+                (is (= (count (d/q query db)) 1))))
+
+            (testing "The payload node contains the other node paths"
+              (let [nodes (:nodes (extensions/read-place sync out-payload-node))]
+                (is (= (clojure.set/difference (into #{} (keys nodes))
+                                               #{:payload :ack :completion :status})
+                       #{}))))
+
+            (testing "Touching the ack node triggers the callback"
+              (let [nodes (:nodes (extensions/read-place sync out-payload-node))]
+                (extensions/touch-place sync (:ack nodes))
+                (let [event (<!! ack-ch-spy)]
+                  (= (:path event) (:ack nodes)))))
+
+            (testing "Touching the completion node triggers the callback"
+              (let [nodes (:nodes (extensions/read-place sync out-payload-node))]
+                (extensions/touch-place sync (:completion nodes))
+                (let [event (<!! completion-ch-spy)]
+                  (= (:path event) (:completion nodes)))))
+
+            (testing "The offer channel receives the tx id of the completion"
+              (let [tx-id (<!! offer-ch-spy)
+                    db (d/as-of (d/db (:conn log)) tx-id)]
+
+                (testing "The peer's nodes have been stripped"
+                  (let [query '[:find ?payload ?ack ?status ?completion :in $ ?peer-node :where
+                                [?p :peer/status :idle]
+                                [?p :node/peer ?peer-node]
+                                [?p :node/payload ?payload]
+                                [?p :node/ack ?ack]
+                                [?p :node/status ?status]
+                                [?p :node/completion ?completion]]
+                        result (d/q query db peer-node)]
+                    (is (empty? result))))))))))
     {:eviction-delay 500000}))

 (run-tests 'onyx.coordinator.simulation-test)


Update library versions

Update library versions

--- src/leiningen/new/cljs_app/project.clj
+++ src/leiningen/new/cljs_app/project.clj
@@ -2,12 +2,12 @@
   :description "FIXME: write this!"
   :url "http://example.com/FIXME"

-  :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2227"]
-                 [com.cemerick/piggieback "0.1.3"]
-                 [weasel "0.2.0"]]
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/clojurescript "1.9.89"]
+                 [com.cemerick/piggieback "0.2.1"]
+                 [weasel "0.7.0"]]

-  :plugins [[lein-cljsbuild "1.0.3"]
+  :plugins [[lein-cljsbuild "1.1.3"]
             [lein-simpleton "1.3.0"]]

   :source-paths ["src"]
@@ -22,8 +22,8 @@
   ;; ===========================================================================

   :aliases {"server" ["trampoline" "simpleton" "8080" "file" ":from" "resources"]}
-
-  :cljsbuild {
+
+  :cljsbuild {
     :builds [{:id "{{name}}"
               :source-paths ["src"]
               :compiler {


optimize emits

optimize emits

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -169,11 +169,11 @@
   (doseq [x xs]
     (cond
      (nil? x) nil
-     (map? x) (emit x)
-     (seq? x) (apply emits x)
-     (fn? x)  (x)
+     #?(:clj (map? x) :cljs (ana/cljs-map? x)) (emit x)
+     #?(:clj (seq? x) :cljs (ana/cljs-seq? x)) (apply emits x)
+     #?(:clj (fn? x) :cljs (goog/isFunction x)) (x)
      :else (let [s (print-str x)]
-             (when *source-map-data*
+             (when-not (nil? *source-map-data*)
                (swap! *source-map-data*
                  update-in [:gen-col] #(+ % (count s))))
              (print s))))


finish CLJS-1176, remove stray .isAlive method call

--- src/main/clojure/cljs/repl/node.clj
+++ src/main/clojure/cljs/repl/node.clj
@@ -78,18 +78,21 @@
 (defn platform-path [v]
   (str "path.join.apply(null, " (seq->js-array v) ")"))

+(defn- alive? [proc]
+  (try (.exitValue proc) false (catch IllegalThreadStateException _ true)))
+
 (defn- pipe [^Process proc in ^Writer out]
   ;; we really do want system-default encoding here
   (with-open [^java.io.Reader in (-> in InputStreamReader. BufferedReader.)]
     (loop [buf (char-array 1024)]
-      (when (try (.exitValue proc) false (catch IllegalThreadStateException _ true))
+      (when (alive? proc)
         (try
           (let [len (.read in buf)]
             (when-not (neg? len)
               (.write out buf 0 len)
               (.flush out)))
           (catch IOException e
-            (when (and (.isAlive proc) (not (.contains (.getMessage e) "Stream closed")))
+            (when (and (alive? proc) (not (.contains (.getMessage e) "Stream closed")))
               (.printStackTrace e *err*))))
         (recur buf)))))


formatting

formatting

--- src/onyx_java/utils/persistence.clj
+++ src/onyx_java/utils/persistence.clj
@@ -23,9 +23,9 @@
           baseclass (help/strip-base (str (obj/get-direct-base (:ref object))))]
           (assoc {} name
               (add-key
-                  (add-key
-                      (add-key object :source spec)
-                  :class classname)
+              (add-key
+              (add-key object :source spec)
+              :class classname)
               :base baseclass)))))

 (defn create-map [class-pattern object-map specs]


Skip closed ch.

Skip closed ch.

--- src/onyx/lifecycle/metrics/riemann.clj
+++ src/onyx/lifecycle/metrics/riemann.clj
@@ -9,7 +9,7 @@
     (let [client (r/tcp-client {:host address :port port})]
       (loop []
         (try
-          (let [event (<!! ch)]
+          (when-let [event (<!! ch)]
             @(r/send-event client event))
           (catch InterruptedException e
             ;; Intentionally pass.


/query/:q hosted

/query/:q hosted

--- src/help_me_im_dumb/handler.clj
+++ src/help_me_im_dumb/handler.clj
@@ -3,13 +3,20 @@
             [compojure.route :as route]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
             [ring.adapter.jetty :as jetty]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [clojure.data.json :as json]
+            [help-me-im-dumb.query-engine :as query]))

 (defn read-template [filename]
   (io/resource filename))

+(defn boolean-query-results
+  [q]
+  (json/write-str (query/bquery->results q)))
+
 (defroutes app-routes
   (GET "/" [] (read-template "templates/index.html"))
+  (GET "/query/:q" [q] (boolean-query-results q))
   (route/not-found "Not Found"))

 (def app
@@ -19,3 +26,5 @@
   "Runs jetty server on given port"
   [port]
   (jetty/run-jetty #'app {:port port :join? false}))
+
+;; (def server (run-server 5000))


change the delete to only delete BK and publick eys

--- src/hivewing_core/beekeeper.clj
+++ src/hivewing_core/beekeeper.clj
@@ -34,8 +34,5 @@
     (do
       ; Delete their public keys
       (public-keys-delete bk-uuid)
-      ; Delete their manager records
-      (doseq [manager-uuid (hive-managers-managing bk-uuid)]
-        (hive-manager-delete manager-uuid))
       ; Delete the user!
-      (worker-config/worker-config-delete jdbc/delete! :beekeepers ["uuid = ?" bk-uuid]))))
+      (jdbc/delete! :beekeepers ["uuid = ?" bk-uuid]))))


updated to have a -main function

updated to have a -main function

--- src/http_kit_view_demo/core.clj
+++ src/http_kit_view_demo/core.clj
@@ -14,7 +14,8 @@
    [clojure.tools.logging :refer [info]]
    [http-kit-view-demo.lib.views.config :as vc]
    [views.core :refer [subscribe! unsubscribe-all!]]
-   [http-kit-view-demo.lib.websockets :refer [receive-transit!]]))
+   [http-kit-view-demo.lib.websockets :refer [receive-transit!]])
+ (:gen-class))

 (def session-store (atom {}))

@@ -69,4 +70,8 @@
 (defn start-server! []
   (reset! server (run-server (run-app) {:port 8080})))

-(defn init-views! [] (vc/init-views! vc/view-config))+(defn init-views! [] (vc/init-views! vc/view-config))
+
+(defn -main []
+  (init-views!)
+  (start-server!))


clicking transport btns doesn't pop q up and down

--- cljs/sledge/core.cljs
+++ cljs/sledge/core.cljs
@@ -180,6 +180,12 @@
     (render [this]
       (html [:audio {:ref "player"}]))))

+(defn swallowing [h]
+  (fn [e]
+    (let [r (h e)]
+      (.stopPropagation e)
+      r)))
+
 (defn minimised-queue-view [app owner]
   (reify
     om/IRender
@@ -190,9 +196,9 @@
                 :onClick #(om/transact! app [:viewing-queue?] not)
                 }
           [:span  {}
-           [:button {:onClick player-pause } ">"]
-           [:button {:onClick player-next } ">>|"]
-           [:button {:onClick player-prev } "|<<"]
+           [:button {:onClick (swallowing player-pause) } ">"]
+           [:button {:onClick (swallowing player-next) } ">>|"]
+           [:button {:onClick (swallowing player-prev) } "|<<"]
            [:span {:className "elapsed-time time"}
             (mmss (:track-offset (player-state)))]
            " / "


Cleaned dummy data.

Cleaned dummy data.

--- src/portal_clj/models/migration.clj
+++ src/portal_clj/models/migration.clj
@@ -103,10 +103,10 @@
 (defn do-dummy []
   (do
     (println "Running dummy inserts.")
-    (sql/insert! db/spec :users {:firstname "Idi"
+    (sql/insert! db/spec :users {:firstname "Some"
                                  :lastname "Admin"
                                  :username "dummy_admin"
-                                 :email "idi@admin.com"
+                                 :email "some@admin.com"
                                  :admin 1
                                  :comments 1
                                  :active 1})
@@ -137,9 +137,9 @@
                                  :slug "also-dummy-post"
                                  :active 1
                                  :restricted 0})
-    (sql/insert! db/spec :comment_authors {:name "Idi Admin" :user_id 1})
+    (sql/insert! db/spec :comment_authors {:name "Some Admin" :user_id 1})
     (sql/insert! db/spec :comments {:title "Heyoo"
-                                    :body "I'm a dummy comment, dummy!"
+                                    :body "I'm a dummy comment!"
                                     :author_id 1
                                     :post_id 1})
     (sql/insert! db/spec :tags {:name "dummy" :restricted 0})


[CS] Remove eagerly loaded values in import

--- src/vip/data_processor/db/postgres.clj
+++ src/vip/data_processor/db/postgres.clj
@@ -146,13 +146,10 @@
 (defn import-from-sqlite [{:keys [import-id db data-specs] :as ctx}]
   (doseq [ent db.util/import-entity-names]
     (let [table (get-in ctx [:tables ent])
-          vals (korma/select table)
-          vals (map #(assoc % :results_id import-id) vals)
           columns (->> data-specs
                        (filter #(= ent (:table %)))
                        first
-                       :columns)
-          vals (data-spec/coerce-rows columns vals)]
+                       :columns)]
       (bulk-import (ent import-entities)
                    (->> table
                         (db.util/select-*-lazily 100)


Added codox documentation generation support

--- clojure/project.clj
+++ clojure/project.clj
@@ -11,6 +11,8 @@
   :manifest
   {"GitHeadRev" ~(fn [x] (some-> (clojure.java.shell/sh "git" "rev-parse" "HEAD") :out .trim))}

+  :plugins [[lein-codox "0.10.2"]]
+
   :profiles {
              ;; activated automatically during uberjar
              :uberjar {:aot :all}


HDM UML refactoring prototype

HDM UML refactoring prototype

--- configuration/hdm-uml-model.clj
+++ configuration/hdm-uml-model.clj
@@ -1,118 +1,117 @@
 ;TODO add attribute cardinalities, classes | add formula indicating "key" attribute

 (class :Extension
-  (attributes
-    :LocalID
-    :Key
-    :Value))
+       (attributes
+         :LocalID
+         :Key
+         :Value))

 (class :Entity
-  (attributes
-    :ID
-    :Validity
-    :CreationTime
-    :OtherInfo
-    :Name))
+       (key-attribute :ID :URI :1 :1)
+       (attribute :Validity :UInt64 :0 :1)
+       (attribute :CreationTime :DateTime_t :0 :1)
+       (attribute :OtherInfo :String :0 :*)
+       (attribute :Name :String :0 :1))

 (class :Domain
-  (attributes
-    :WWW
-    :Description)
-  (extends :Entity))
+       (attributes
+         :WWW
+         :Description)
+       (extends :Entity))

 (class :Share
-  (attributes
-    :Description)
-  (extends :Entity))
+       (attributes
+         :Description)
+       (extends :Entity))

 (class :Service
-  (attributes
-    :StatusInfo
-    :QualityLevel
-    :Capability
-    :Type
-    :Complexity)
-  (extends :Entity))
+       (attributes
+         :StatusInfo
+         :QualityLevel
+         :Capability
+         :Type
+         :Complexity)
+       (extends :Entity))

 (class :Location
-  (attributes
-    :Latitude
-    :Longitude
-    :PostCode
-    :Country
-    :Place
-    :Address)
-  (extends :Entity))
+       (attributes
+         :Latitude
+         :Longitude
+         :PostCode
+         :Country
+         :Place
+         :Address)
+       (extends :Entity))

 (class :AdminDomain
-  (attributes
-    :Distributed
-    :Owner)
-  (extends :Domain))
+       (attributes
+         :Distributed
+         :Owner)
+       (extends :Domain))

 (class :UserDomain
-  (attributes
-    :Member
-    :UserManager
-    :Level)
-  (extends :Domain))
+       (attributes
+         :Member
+         :UserManager
+         :Level)
+       (extends :Domain))

 (class :Contact
-  (attributes
-    :Type
-    :Detail)
-  (extends :Entity))
+       (attributes
+         :Type
+         :Detail)
+       (extends :Entity))

 (class :Manager
-  (attributes
-    :ProductVersion
-    :ProductName)
-  (extends :Entity))
+       (attributes
+         :ProductVersion
+         :ProductName)
+       (extends :Entity))

 (class :Resource
-  (extends :Entity))
+       (extends :Entity))

 (class :Endpoint
-  (attributes
-    :StartTime
-    :HealthStateInfo
-    :SupportedProfile
-    :InterfaceName
-    :InterfaceVersion
-    :InterfaceExtension
-    :HealthState
-    :URL
-    :DowntimeAnnounce
-    :QualityLevel
-    :IssuerCA
-    :DowntimeStart
-    :DowntimeInfo
-    :WSDL
-    :ServingState
-    :Implementor
-    :Semantics
-    :Technology
-    :Capability
-    :ImplementationName
-    :ImplementationVersion
-    :DowntimeEnd
-    :TrustedCA)
-  (extends :Entity))
+       (attributes
+         :StartTime
+         :HealthStateInfo
+         :SupportedProfile
+         :InterfaceName
+         :InterfaceVersion
+         :InterfaceExtension
+         :HealthState
+         :URL
+         :DowntimeAnnounce
+         :QualityLevel
+         :IssuerCA
+         :DowntimeStart
+         :DowntimeInfo
+         :WSDL
+         :ServingState
+         :Implementor
+         :Semantics
+         :Technology
+         :Capability
+         :ImplementationName
+         :ImplementationVersion
+         :DowntimeEnd
+         :TrustedCA)
+       (extends :Entity))

 (class :Activity
-  (extends :Entity))
+       (extends :Entity))

 (class :Policy
-  (attributes
-    :Rule
-    :Scheme)
-  (extends :Entity))
+       (attributes
+         :Rule
+         :Scheme)
+       (extends :Entity))

 (class :AccessPolicy
-  (extends :Policy))
+       (extends :Policy))

 (class :MappingPolicy
-  (extends :Policy))
+       (extends :Policy))

 (association


Changed call to make-robot to also create motion and TTS proxies. Added defn of print-methods helper function to make it easier to explore java classes from clojure. Call to save joint limits in robot map

--- src/test/clojure/naojure/sample.clj
+++ src/test/clojure/naojure/sample.clj
@@ -2,7 +2,8 @@
   (:require [naojure.core :as nao :refer []]))

 (require '[naojure.core :as nao]
-         '[clojure.core.async :as async :refer [<! >! timeout chan alt! go]])
+         '[clojure.core.async :as async :refer [<! >! timeout chan alt! go]]
+         '[clojure.pprint :refer [pprint]])

 ;; examples of how we'd like to control NAO with clojure

@@ -11,7 +12,9 @@

 ;; update with IP address
-(def robot (nao/make-robot "192.168.0.71"))
+(def robot (nao/make-robot "192.168.0.71" 9559 [:motion :tts]))
+
+(def robot (save-joint-limits robot))

 (nao/say robot "Hello clojure")

@@ -64,3 +67,6 @@

 (def exterminate "file://somewhere in nao filesystem")
 - get exterminate sound sample
+
+(defn print-methods [o]
+  (-> o (.getClass) (.getDeclaredMethods) (pprint)))


CMR-5129 Cleanup.

CMR-5129 Cleanup.


add deep nested tests

add deep nested tests

--- test/clj_money/x_platform/util_test.clj
+++ test/clj_money/x_platform/util_test.clj
@@ -2,6 +2,7 @@
   (:require [clojure.test :refer :all]
             [clojure.pprint :refer [pprint]]
             [clojure.data :refer [diff]]
+            [clj-time.core :as t]
             [clj-money.test-helpers :refer [pprint-diff]]
             [clj-money.x-platform.util :refer :all]))

@@ -18,7 +19,10 @@
     (is (= "names[]=john&names[]=jane"
            (map->query-string {:names ["john" "jane"]}))))
   (testing "a deep nested map"
-    (is false "need to write the test")))
+    (is (= "criteria[transaction-date][]=between&criteria[transaction-date][]=2018-02-27&criteria[transaction-date][]=2018-03-02&options[sort][]=transaction-date&options[sort][]=desc&options[limit]=50"
+           (map->query-string {:criteria {:transaction-date [:between (t/local-date 2018 2 27) (t/local-date 2018 3 2)]}
+                               :options {:sort [:transaction-date :desc]
+                                         :limit 50}})))))

 (deftest create-a-map-from-a-query-string
   (testing "a single-level map"
@@ -37,4 +41,7 @@
     (is (= {:names ["john" "jane"]}
            (query-string->map "names[]=john&names[]=jane"))))
   (testing "a deep nested map"
-    (is false "need to write the test")))
+    (is (= {:criteria {:transaction-date [:between (t/local-date 2018 2 27) (t/local-date 2018 3 2)]}
+            :options {:sort [:transaction-date :desc]
+                      :limit 50}}
+           (query-string->map "criteria[transaction-date][]=between&criteria[transaction-date][]=2018-02-27&criteria[transaction-date][]=2018-03-02&options[sort][]=transaction-date&options[sort][]=desc&options[limit]=50")))))


Less tests for valid query generation

Less tests for valid query generation

--- test/com/wsscode/pathom/system_test.clj
+++ test/com/wsscode/pathom/system_test.clj
@@ -17,7 +17,7 @@
             [fulcro.client.primitives :as fp])
   (:import (clojure.lang ExceptionInfo)))

-(test/defspec generator-makes-valid-queries {:max-size 18 :num-tests 100}
+(test/defspec generator-makes-valid-queries {:max-size 18 :num-tests 50}
   (props/for-all [query (s.query/make-gen
                           {::s.query/gen-params
                            (fn [_]


Remove debugging log entry

Remove debugging log entry

--- src/onyx/lifecycles/lifecycle_invoke.clj
+++ src/onyx/lifecycles/lifecycle_invoke.clj
@@ -4,7 +4,6 @@

 (defn handle-exception [event phase t handler-fn]
   (let [action (handler-fn event phase t)]
-    (info "Testing handle exception" action phase)
     (cond (= action :kill)
           (throw t)


delaney.clj: faster creatoin of a DSymbol instance from an existing symbol

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -291,21 +291,15 @@
 (defn- ds-from-ds [ds]
   (let [emap (zipmap (elements ds) (range 1 (inc (size ds))))
         imap (zipmap (indices ds) (range (inc (dim ds))))
-        gluings (for [i (indices ds)
-                      D (orbit-reps ds [i])
-                      :when (s ds i D)]
-                    [(imap i) (emap D) (emap (s ds i D))])
-        spins (for [[i j] (zipmap (indices ds) (rest (indices ds)))
-                    D (orbit-reps ds [i j])
-                    :when (v ds i j D)]
-                  [(imap i) (emap D) (v ds i j D)])
-        d-set (reduce (fn [ds [i D E]] (glue ds i D E))
-                      (DSymbol. (dim ds) (size ds) {} {})
-                      gluings)
-        d-sym (reduce (fn [ds [i D v]] (spin ds i (inc i) D v))
-                      d-set
-                      spins)]
-    d-sym))
+        gluings-for (fn [i] (into {} (for [D (elements ds) :when (s ds i D)]
+                                       [(emap D) (emap (s ds i D))])))
+        gluings (into {} (for [i (indices ds)]
+                           [(imap i) (gluings-for i)]))
+        spins-for (fn [i j] (into {} (for [D (elements ds) :when (v ds i j D)]
+                                       [(emap D) (v ds i j D)])))
+        spins (into {} (for [[i j] (zipmap (indices ds) (rest (indices ds)))]
+                         [(imap i) (spins-for i j)]))]
+    (DSymbol. (dim ds) (size ds) gluings spins)))

 (defprotocol DSymbolSource
   (dsymbol [_]))


cleaning up

cleaning up

--- test/celestial/integration/proxmox.clj
+++ test/celestial/integration/proxmox.clj
@@ -24,4 +24,6 @@
      (.delete ct)
      (.create ct)
      (.start ct)
-     (.status ct) => "running")))
+     (.status ct) => "running"
+     (.stop ct)
+     (.delete ct))))


redo query tests

redo query tests

--- test/com/billpiel/sayid/query_test.clj
+++ test/com/billpiel/sayid/query_test.clj
@@ -231,37 +231,238 @@
                   :return "return F",
                   :children []}]}]}]})))

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+(t/deftest ancestors-and-descendants
+  (t/is (= (q/traverse-tree-dissoc-zipper
+            (sd/tree-query test-trace
+                           :ad
+                           [:name "E"]
+                           [:name "C"]))
+           {:id :query-result10,
+            :children
+            [{:id 1,
+              :name "A",
+              :depth 0,
+              :args [1 2],
+              :return 3,
+              :children
+              [{:id 2,
+                :name "B",
+                :depth 1,
+                :args [3 4 5],
+                :return :b-return,
+                :children
+                [{:id 11,
+                  :name "E",
+                  :depth 2,
+                  :args [:a 1 :b 2],
+                  :return 5,
+                  :children []}]}
+               {:id 3,
+                :name "C",
+                :depth 1,
+                :args [1 {:a [10 11 12]} 5],
+                :return 8,
+                :children
+                [{:id 4,
+                  :name "F",
+                  :depth 2,
+                  :args [2 5 9],
+                  :return "return F",
+                  :children
+                  [{:id 5,
+                    :name "I",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children
+                    [{:id 6,
+                      :name "L",
+                      :depth 4,
+                      :args [],
+                      :return 0,
+                      :children []}]}
+                   {:id 7,
+                    :name "M",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 8,
+                    :name "N",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 9,
+                    :name "O",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}]}]}]}]})))
+
+(t/deftest ancestors-and-descendants-limited-distance
+  (t/is (= (q/traverse-tree-dissoc-zipper
+            (sd/tree-query test-trace
+                           :ad 2
+                           [:name "E"]
+                           [:name "C"]))
+           {:id :query-result10,
+            :children
+            [{:id 1,
+              :name "A",
+              :depth 0,
+              :args [1 2],
+              :return 3,
+              :children
+              [{:id 2,
+                :name "B",
+                :depth 1,
+                :args [3 4 5],
+                :return :b-return,
+                :children
+                [{:id 11,
+                  :name "E",
+                  :depth 2,
+                  :args [:a 1 :b 2],
+                  :return 5,
+                  :children []}]}
+               {:id 3,
+                :name "C",
+                :depth 1,
+                :args [1 {:a [10 11 12]} 5],
+                :return 8,
+                :children
+                [{:id 4,
+                  :name "F",
+                  :depth 2,
+                  :args [2 5 9],
+                  :return "return F",
+                  :children
+                  [{:id 5,
+                    :name "I",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 7,
+                    :name "M",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 8,
+                    :name "N",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 9,
+                    :name "O",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}]}]}]}]})))
+
+(t/deftest wildcard
+  (t/is (= (q/traverse-tree-dissoc-zipper
+            (sd/tree-query test-trace
+                           :w
+                           [:name "I"]))
+           {:id :query-result10,
+            :children
+            [{:id 1,
+              :name "A",
+              :depth 0,
+              :args [1 2],
+              :return 3,
+              :children
+              [{:id 3,
+                :name "C",
+                :depth 1,
+                :args [1 {:a [10 11 12]} 5],
+                :return 8,
+                :children
+                [{:id 4,
+                  :name "F",
+                  :depth 2,
+                  :args [2 5 9],
+                  :return "return F",
+                  :children
+                  [{:id 5,
+                    :name "I",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children
+                    [{:id 6,
+                      :name "L",
+                      :depth 4,
+                      :args [],
+                      :return 0,
+                      :children []}]}
+                   {:id 7,
+                    :name "M",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 8,
+                    :name "N",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}
+                   {:id 9,
+                    :name "O",
+                    :depth 3,
+                    :args [],
+                    :return 0,
+                    :children []}]}]}]}]})))
+
+(t/deftest wildcard-limited-distance
+  (t/is (= (q/traverse-tree-dissoc-zipper
+            (sd/tree-query test-trace
+                           :w 1
+                           [:name "I"]))
+           {:id :query-result10,
+            :children
+            [{:id 4,
+              :name "F",
+              :depth 2,
+              :args [2 5 9],
+              :return "return F",
+              :children
+              [{:id 5,
+                :name "I",
+                :depth 3,
+                :args [],
+                :return 0,
+                :children
+                [{:id 6,
+                  :name "L",
+                  :depth 4,
+                  :args [],
+                  :return 0,
+                  :children []}]}
+               {:id 7, :name "M", :depth 3, :args [], :return 0, :children []}
+               {:id 8, :name "N", :depth 3, :args [], :return 0, :children []}
+               {:id 9,
+                :name "O",
+                :depth 3,
+                :args [],
+                :return 0,
+                :children []}]}]})))
+
+(t/deftest siblings
+  (t/is (= (q/traverse-tree-dissoc-zipper
+            (sd/tree-query test-trace :s
+                           [:name "E"]))
+           {:id :query-result10,
+            :children
+            [{:id 10, :name "D", :depth 2, :args [], :return 4, :children []}
+             {:id 11,
+              :name "E",
+              :depth 2,
+              :args [:a 1 :b 2],
+              :return 5,
+              :children []}]})))


[#2763] Run VACUUM after update dataset

[#2763] Run VACUUM after update dataset

--- backend/src/akvo/lumen/lib/update.clj
+++ backend/src/akvo/lumen/lib/update.clj
@@ -173,7 +173,9 @@
                                  dataset-id
                                  table-name
                                  imported-table-name
-                                 dataset-version))))))))
+                                 dataset-version)))))))
+  (let [dsv (db.transformation/latest-dataset-version-by-dataset-id tenant-conn {:dataset-id dataset-id})]
+    (db.job-execution/vacuum-table tenant-conn (select-keys dsv [:table-name]))))

 (defn update-dataset [tenant-conn caddisfly import-config error-tracker dataset-id data-source-id data-source-spec]
   (if-let [current-tx-job (db.transformation/pending-transformation-job-execution tenant-conn {:dataset-id dataset-id})]


Comment out broken lancet call.

Comment out broken lancet call.

--- src/lancet.clj
+++ src/lancet.clj
@@ -126,7 +126,8 @@

 (define-all-ant-tasks)

-(define-ant-type files org.apache.tools.ant.types.resources.Files)
+;; The version of ant that maven-ant-tasks requires doesn't have this class:
+;; (define-ant-type files org.apache.tools.ant.types.resources.Files)
 (define-ant-type fileset org.apache.tools.ant.types.FileSet)

 (defn -main [& targs]


CMR-3279 uncomments vaildation code

CMR-3279 uncomments vaildation code

--- access-control-app/src/cmr/access_control/services/acl_search_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_search_service.clj
@@ -227,7 +227,7 @@
  (let [[safe-params type-errors] (cpv/apply-type-validations
                                    params
                                    [(partial cpv/validate-map [:options])
-                                    ;(partial cpv/validate-map [:options :collection-concept-id])
+                                    (partial cpv/validate-map [:options :collection-concept-id])
                                     (partial cpv/validate-map [:options :permitted-group])
                                     (partial cpv/validate-map [:options :identity-type])
                                     (partial cpv/validate-map [:options :provider])


Fix sam header reading

Fix sam header reading


hack to support reload of library file changes on Windows

--- informing/build.boot
+++ informing/build.boot
@@ -31,6 +31,7 @@
   (comp (cljs :optimizations :advanced)))

 (deftask dev []
+  (set-env! :source-paths #{"src" "../../ion/src"})
   (task-options!
     checkout {:dependencies '[[ion/cuss "0.1.0-SNAPSHOT"]
                               [ion/poly "0.1.0-SNAPSHOT"]]}


Pull out read-task-ledgers code

Pull out read-task-ledgers code

--- src/onyx_jepsen/onyx_client.clj
+++ src/onyx_jepsen/onyx_client.clj
@@ -124,14 +124,7 @@
                                (try
                                  (assoc op
                                         :type :ok
-                                        :value (into {}
-                                                     (map (fn [[job-num job-data]]
-                                                            (vector job-num
-                                                                    (mapv (partial read-ledger-entries env-config)
-                                                                          (get-written-ledgers onyx-client job-data onyx-id (:task op)))))
-                                                          @jobs-data))
-
-                                        #_(read-task-ledgers onyx-client ))
+                                        :value (read-task-ledgers onyx-client env-config @jobs-data onyx-id (:task op)))
                                  (catch Throwable t
                                    (assoc op :type :info :value t))))