make annotations work for all collections

--- src/strictly_specking/annotated_pprint.clj
+++ src/strictly_specking/annotated_pprint.clj
@@ -48,11 +48,16 @@
      (pp/write-out obj))
     (pp/write-out obj)))

-(def orig-pprint-map (.getMethod pp/simple-dispatch clojure.lang.IPersistentMap))
+;; these methods are private so ... have to fetch them this way
+(def orig-pprint-map    (.getMethod pp/simple-dispatch clojure.lang.IPersistentMap))
+(def orig-pprint-vector (.getMethod pp/simple-dispatch clojure.lang.IPersistentVector))
+(def orig-pprint-list   (.getMethod pp/simple-dispatch clojure.lang.ISeq))
+(def orig-pprint-set    (.getMethod pp/simple-dispatch clojure.lang.IPersistentSet))
+

 ;; should create a dispatch that uses the normal method for maps
 ;; and this method for annotated maps
-(defn pprint-map-with-pointer [amap]
+(defn pprint-map-with-pointer* [amap]
   (let [comments (or (-> amap meta :comments) {})
         comments? (not-empty comments)]
     (pp/pprint-logical-block
@@ -86,6 +91,11 @@
           (when (next aseq)
             (recur (next aseq)))))))))

+(defn pprint-map-with-pointer [amap]
+  (if (-> amap meta :comments)
+    (pprint-map-with-pointer* amap)
+    (orig-pprint-map amap)))
+
 (defn abbrev-pprint-map-with-pointer [amap]
   (if-let [abr-level  (-> amap meta :abbrev)]
     (let [length (if (= :tight abr-level) 2 4)
@@ -100,6 +110,50 @@
   (defn pprint-comment-pointer [comm-point]
     (apply pprint-message (string/split (:text comm-point) #"\n"))))

+(defn pprint-seq-with-pointer [pre suf avec comment-key-fn]
+  (let [comments (or (-> avec meta :comments) {})
+        comments? (not-empty comments)]
+    ;;abbrev print-length can be 3 + max key
+    (pp/pprint-logical-block
+     :prefix pre :suffix suf
+     (pp/print-length-loop
+      [aseq (seq avec)
+       c    0]
+      (when aseq
+        (if-let [{:keys [comment value-colors comment-colors]
+                  :as current-comment} (get comments (comment-key-fn (first aseq) c))]
+          (do
+            (print-colored value-colors (first aseq))
+            (pp/pprint-newline :mandatory)
+            (print-colored comment-colors (CommentPointer. comment))
+            #_(pp/pprint-newline :mandatory))
+          (pp/write-out (first aseq)))
+        (when (next aseq)
+          (.write ^java.io.Writer *out* " ")
+          (pp/pprint-newline :linear)
+          (recur (next aseq) (inc c))))))))
+
+(defn pprint-vector-with-pointer [avec]
+  (if (-> avec meta :comments)
+    (pprint-seq-with-pointer "[" "]" avec (fn [_ c] c))
+    (orig-pprint-vector avec)))
+
+(defn pprint-set-with-pointer [a-set]
+  (if (-> a-set meta :comments)
+    (pprint-seq-with-pointer "#{" "}" a-set (fn [a _] a))
+    (orig-pprint-set a-set)))
+
+(defn pprint-simple-list-with-pointer [alis]
+  (pprint-seq-with-pointer "(" ")" alis (fn [_ c] c)))
+
+(defn pprint-list-with-pointer [aseq]
+  (if (-> aseq meta :comments)
+    (pprint-simple-list-with-pointer aseq)
+    (orig-pprint-list aseq)))
+
+(use-method error-path-dispatch clojure.lang.IPersistentSet pprint-set-with-pointer)
+(use-method error-path-dispatch clojure.lang.ISeq pprint-list-with-pointer)
+(use-method error-path-dispatch clojure.lang.IPersistentVector pprint-vector-with-pointer)
 (use-method error-path-dispatch clojure.lang.IPersistentMap abbrev-pprint-map-with-pointer)
 (use-method error-path-dispatch CommentPointer pprint-comment-pointer)

@@ -124,7 +178,11 @@
     (f data)))

 (defn annotate-path-only [data path annotation]
-  (path-only-data-structure data path #(vary-meta % merge annotation)))
+  (path-only-data-structure data path
+                            #(do
+                               #_(prn path %)
+                               (when (coll? %)
+                                 (vary-meta % merge annotation)))))

 (defn annotate-path [data path annotation]
   (update-in data path #(vary-meta % merge annotation)))
@@ -132,12 +190,33 @@
 (defn annotate-paths [data path-to-annotation-map]
   (reduce #(annotate-path %1 (first %2) (second %2))
           data path-to-annotation-map))
+
+(ansi-util/with-ansi-when true
+    (pp/with-pprint-dispatch error-path-dispatch
+      (pp/pprint
+       (annotate-path-only test-data
+                           [:cljsbuild :builds 0 #_:source-paths-set]
+                           {:abbrev true
+                            :comments {:source-paths {
+                                          :key-colors [:green]
+                                          :value-colors [:red]
+                                          :comment-colors [:magenta]
+                                          :comment " is screwwed"
+                                          }
+                                       #_"tests" #_{
+                                          :key-colors [:green]
+                                          :value-colors [:red]
+                                          :comment-colors [:magenta]
+                                          :comment " is screwwed"
+                                          }}}))))

 (comment
   (def test-data
     {:cljsbuild {:assert true
                  :builds [{ :id "example-admin"
                            :source-paths ["src" "dev" "tests" "../support/src"]
+                           :source-paths-list '("src" "dev" "tests" "../support/src")
+                           :source-paths-set #{"src" "dev" "tests" "../support/src"}
                            :notify-command ["notify"]
                            :figwheel
                            { :websocket-host "localhost"


Fixes missing keys in text substitutions in the docs.

--- lambda-blog/test/lambda_blog/fixtures.clj
+++ lambda-blog/test/lambda_blog/fixtures.clj
@@ -120,6 +120,7 @@
       (update-all :docs
                   (promote :metadata)
                   (add-paths "{{title}}.html")
+                  #(merge docs %)
                   (substitute :contents))
       (read-dir :entries "doc/entries" parse)
       (update :entries
@@ -127,6 +128,7 @@
       (update-all :entries
                   (promote :metadata)
                   (add-paths "entries/{{title}}.html")
+                  #(merge docs %)
                   (substitute :contents)
                   #(update-all % :tags
                                (fn [t] {:id t})


Refactor tests extensively

Refactor tests extensively

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -23,14 +23,12 @@
     (is (not (u/array-eq a b)))
     (is (= s/noncebytes (alength ^bytes a) (alength ^bytes b)))))

-(deftest secretbox-pfx-test
-  (let [nonce (byte-array (range s/noncebytes))
-        ctext (ms/secretbox-pfx st/ptext nonce st/secret-key)
-        ptextlen (alength ^bytes st/ptext)]
+(defn is-valid-magicnonce-ctext?
+  "Does the given ctext decrypt properly?"
+  [ctext]
+  (let [ptextlen (alength ^bytes st/ptext)]
     (is (= (+ s/noncebytes ptextlen s/macbytes)
            (alength ^bytes ctext)))
-    (is (= (range s/noncebytes)
-           (take s/noncebytes ctext)))

     (let [out (byte-array ptextlen)]
       (ms/decrypt-to-buf! out st/secret-key ctext)
@@ -66,45 +64,15 @@
            RuntimeException #"Ciphertext verification failed"
            (ms/open forgery st/secret-key))))))

+(deftest secretbox-pfx-test
+  (let [nonce (byte-array (range s/noncebytes))
+        ctext (ms/secretbox-pfx st/ptext nonce st/secret-key)]
+    (is (= (range s/noncebytes) (take s/noncebytes ctext)))
+    (is-valid-magicnonce-ctext? ctext)))
+
 (deftest secretbox-rnd-test
-  (let [ctext (ms/secretbox-rnd st/ptext st/secret-key)
-        ptextlen (alength ^bytes st/ptext)]
-    (is (= (+ s/noncebytes ptextlen s/macbytes)
-           (alength ^bytes ctext)))
-
-    (let [out (byte-array ptextlen)]
-      (ms/decrypt-to-buf! out st/secret-key ctext)
-      (is (u/array-eq st/ptext out)))
-
-    (let [out (byte-array ptextlen)
-          forgery (r/randombytes (alength ^bytes out))]
-      (is (thrown-with-msg?
-           RuntimeException #"Ciphertext verification failed"
-           (ms/decrypt-to-buf! out st/secret-key forgery))))
-
-    (is (u/array-eq st/ptext (ms/decrypt st/secret-key ctext)))
-
-    (let [forgery (r/randombytes (alength ^bytes ctext))]
-      (is (thrown-with-msg?
-           RuntimeException #"Ciphertext verification failed"
-           (ms/decrypt st/secret-key forgery))))
-
-    (let [out (byte-array ptextlen)]
-      (ms/open-to-buf! out ctext st/secret-key)
-      (is (u/array-eq st/ptext out)))
-
-    (let [out (byte-array ptextlen)
-          forgery (r/randombytes (alength ^bytes out))]
-      (is (thrown-with-msg?
-           RuntimeException #"Ciphertext verification failed"
-           (ms/open-to-buf! out forgery st/secret-key))))
-
-    (is (u/array-eq st/ptext (ms/open ctext st/secret-key)))
-
-    (let [forgery (r/randombytes (alength ^bytes ctext))]
-      (is (thrown-with-msg?
-           RuntimeException #"Ciphertext verification failed"
-           (ms/open forgery st/secret-key)))))
+  (let [ctext (ms/secretbox-rnd st/ptext st/secret-key)]
+    (is-valid-magicnonce-ctext? ctext))

   (let [c1 (ms/secretbox-rnd st/ptext st/secret-key)
         c2 (ms/secretbox-rnd st/ptext st/secret-key)]


Add a test for secretbox-pfx

Add a test for secretbox-pfx

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -1,5 +1,7 @@
 (ns caesium.magicnonce.secretbox-test
-  (:require [caesium.magicnonce.secretbox :as s]
+  (:require [caesium.magicnonce.secretbox :as ms]
+            [caesium.crypto.secretbox :as s]
+            [caesium.crypto.secretbox-test :as st]
             [clojure.test :refer [deftest is]]
             [caesium.util :as u]))

@@ -7,9 +9,17 @@
   (let [one (byte-array [1 0 1])
         two (byte-array [0 1 0])
         out (byte-array [0 0 0])]
-    (is (identical? (#'s/xor! out one two) out))
+    (is (identical? (#'ms/xor! out one two) out))
     (is (u/array-eq (byte-array [1 1 1]) out)))
   (let [one (byte-array [1 0 1])
         two (byte-array [0 1 0])]
-    (is (identical? (#'s/xor-inplace! one two) one))
+    (is (identical? (#'ms/xor-inplace! one two) one))
     (is (u/array-eq (byte-array [1 1 1]) one))))
+
+(deftest secretbox-pfx-test
+  (let [nonce (byte-array (range s/noncebytes))
+        ctext (ms/secretbox-pfx st/ptext nonce st/secret-key)]
+    (is (= (+ s/noncebytes
+              (alength ^bytes st/ptext)
+              s/macbytes)
+           (alength ^bytes ctext)))))


Added some additional examples of granules that failed in workload.


remove redundant checks

remove redundant checks

--- test/com/billpiel/mem_tracer/core_test.clj
+++ test/com/billpiel/mem_tracer/core_test.clj
@@ -7,8 +7,6 @@
       (let [trace-root (mt/trace-ns 'com.billpiel.mem-tracer.test.ns1)]
         (com.billpiel.mem-tracer.test.ns1/func1 :a)

-        trace-root => {}
-        (-> trace-root :children deref) => []
         (mt/deref-children trace-root) => {}

         (mt/untrace-ns 'com.billpiel.mem-tracer.test.ns1)))


show only first element from list in log/debug

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -105,11 +105,8 @@
         add-complements-to-bolts
         (fn [bolts path]
           (log/debug (str "generate-all: "
-                          "add-complements-to-bolts@" path ":#bolts(" (count bolts) "):"
-                          (string/join ","
-                                       (map (fn [bolt]
-                                              (show-bolt bolt path morph))
-                                            bolts))))
+                          "add-complements-to-bolts@" path ": first bolt:"
+                          (show-bolt (first bolts) path morph)))
           (mapcat
            #(if (not (= :none (get-in % path :none)))
               (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
@@ -151,8 +148,8 @@
                         (if (= false (get-in parent [:head :phrasal] false))
                           (let [candidate-lexemes (get-lex parent :head index spec)
                                 results (over/overh parent (mapfn copy candidate-lexemes))]
-                            (log/debug (str "lightning-bolt: " (get-in parent [:rule]) ": candidate head lexemes:'"
-                                            (string/join "','" (map morph candidate-lexemes)) "'"))
+                            (log/debug (str "lightning-bolt: " (get-in parent [:rule]) ": first candidate head lexeme:'"
+                                            (morph (first candidate-lexemes)) "'"))
                             results)))
                       parents)
               phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
@@ -191,8 +188,8 @@
                                              complement-candidate-lexemes)
         debug (log/debug
                (if (not (empty? filtered-lexical-complements))
-                 (str "add-complement: " (show-bolt bolt path morph) ":candidate complement-lexemes:'"
-                      (string/join "','" (sort (map morph filtered-lexical-complements))) "'")))]
+                 (str "add-complement: " (show-bolt bolt path morph) ":candidate first complement-lexemes:'"
+                      (morph (first filtered-lexical-complements))) "'"))]
     (filter (fn [complement]
               (if (fail? complement)
                 (do


remove unnecessary test for :phrasal and consolidate (let)s

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -103,35 +103,34 @@
           (when (= false (get-in spec [:head :phrasal] false))
             (lazy-mapcat
              (fn [parent]
-               (let [parent (unify parent spec)]
-                 (when (= false (get-in parent [:head :phrasal] false))
-                   (let [pred (get-in spec [:synsem :sem :pred])
-                         cat (get-in spec [:synsem :cat])
-                         aux (get-in spec [:synsem :aux])
-                         non-empty-index-sets (filter #(not (empty? %))
-                                                      [(get (:pred2lex language-model) pred)
-                                                       (get (:cat2lex language-model) cat)
-                                                       (get (:aux2lex language-model) aux)])
-                         subset
-                         (cond
-                           (not (empty? non-empty-index-sets))
-                           (reduce intersection-with-identity non-empty-index-sets)
-                           true
-                           (do
-                             (log/warn (str "no index found for spec: " (spec-info spec)))
-                             (get-lex parent :head (:index language-model))))]
-                     (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (get-in parent [:rule])))
-                     (let [result (over/overh parent (lazy-shuffle subset))]
-                       (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
-                       (log/debug (str "trying overh with spec: " (strip-refs spec)))
-                       (if (and (not (empty? subset)) (empty? result)
-                                (> (count subset)
-                                   10))
-                         ;; log/warn because it's very expensive to run
-                         ;; over/overh: for every candidate, both parent
-                         ;; and candidate head must be copied.
-                         (log/warn (str "tried: " (count subset) " lexical candidates with spec:" ( strip-refs spec) " and all of them failed as heads of parent:" (get-in parent [:rule]))))
-                       result)))))
+               (let [parent (unify parent spec)
+                     pred (get-in spec [:synsem :sem :pred])
+                     cat (get-in spec [:synsem :cat])
+                     aux (get-in spec [:synsem :aux])
+                     non-empty-index-sets (filter #(not (empty? %))
+                                                  [(get (:pred2lex language-model) pred)
+                                                   (get (:cat2lex language-model) cat)
+                                                   (get (:aux2lex language-model) aux)])
+                     subset
+                     (cond
+                       (not (empty? non-empty-index-sets))
+                       (reduce intersection-with-identity non-empty-index-sets)
+                       true
+                       (do
+                         (log/warn (str "no index found for spec: " (spec-info spec)))
+                         (get-lex parent :head (:index language-model))))]
+                 (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (get-in parent [:rule])))
+                 (let [result (over/overh parent (lazy-shuffle subset))]
+                   (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
+                   (log/debug (str "trying overh with spec: " (strip-refs spec)))
+                   (if (and (not (empty? subset)) (empty? result)
+                            (> (count subset)
+                               10))
+                     ;; log/warn because it's very expensive to run
+                     ;; over/overh: for every candidate, both parent
+                     ;; and candidate head must be copied.
+                     (log/warn (str "tried: " (count subset) " lexical candidates with spec:" ( strip-refs spec) " and all of them failed as heads of parent:" (get-in parent [:rule]))))
+                   result)))
              parents))
           phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
           (if (and (< total-depth max-total-depth)


refine 'take' treatment

refine 'take' treatment

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -155,7 +155,7 @@
    (mapfn #(do-defaults % model)
           (let [comp-paths (find-comp-paths bolt-at)
                 comp-bolts
-                (pmap #(if (or true take-n)
+                (pmap #(if take-n
                          (take take-n (comp-path-to-bolts bolt-at % model (+ 1 depth) max-depth))
                          (comp-path-to-bolts bolt-at % model (+ 1 depth) max-depth))
                        comp-paths)]
@@ -180,11 +180,14 @@
            truncate-children true}}]
   (log/debug (str "generate2: spec: " spec))
   (let [depth 0
+        spec (if (fail? (unify spec {:synsem {:subcat []}}))
+               spec
+               (unify spec {:synsem {:subcat []}}))
         max-depth max-total-depth]
      (flatten
       (mapfn #(do
                 (log/debug (str "top-level add-bolt-at: " ((:morph-ps model) %)))
-                (add-bolt-at % % [] % model depth max-depth truncate-children 1))
+                (add-bolt-at % % [] % model depth max-depth truncate-children))
              (lightning-bolts model spec 0 max-total-depth)))))

 (defn generate-n


support per-language-model default function to be applied after both head and complement are added to a rule

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -217,9 +217,13 @@
      language-model total-depth (rest comp-paths)
      truncate-children max-total-depth top-level-spec)))

-(defn do-defaults [expr]
-  (log/info (str "do-defaults.."))
-  expr)
+(defn do-defaults [tree language-model]
+  (if-let [default-fn (:default-fn language-model)]
+    (default-fn tree)
+    ;;
+    (do
+      (log/info (str "language-model has no default function."))
+      tree)))

 (defn add-complement-to-bolt [bolt path language-model total-depth top-level-spec
                               & {:keys [max-total-depth truncate-children]
@@ -263,55 +267,58 @@
                     (string/join ","
                                  (map #((:morph language-model) %)
                                       lexical-complements))))
-    (filter #(not-fail? %)
-            (mapfn (fn [complement]
-                     (let [unified
-                           (unify! (copy bolt)
-                                   (assoc-in {} path
-                                             (copy complement)))]
-                       (if (and (not-fail? unified)
-                                truncate-children)
-                         (truncate unified [path] language-model)
-                         unified)))
-                   (let [phrasal-complements (if (and (> max-total-depth total-depth)
-                                                      (= true (get-in spec [:phrasal] true)))
-                                               (do
-                                                 (log/debug (str "calling (generate-all) from add-complement-to-bolt with bolt:"
-                                                                 (show-bolt bolt language-model)))
-                                                 (generate-all spec language-model (+ (count path) total-depth)
-                                                               :max-total-depth max-total-depth)))
-                         lexemes-before-phrases (lexemes-before-phrases total-depth max-total-depth)]
-                     (cond (and lexemes-before-phrases
-                                (empty? lexical-complements)
-                                (= false (get-in spec [:phrasal] true)))
-                           (log/warn (str "failed to generate any lexical complements with spec: "
-                                          (strip-refs spec)))
-
-                           (and lexemes-before-phrases
-                                (= true (get-in spec [:phrasal] false))
-                                (empty? phrasal-complements))
-                           (log/warn (str "failed to generate any phrasal complements with spec: "
-                                          (strip-refs spec)))
-
-                           (and (empty? lexical-complements)
-                                (empty? phrasal-complements))
-
-                           (let [message (str "add-complement-to-bolt: could generate neither phrasal "
-                                              "nor lexical complements for "
-                                      "bolt:" (show-bolt bolt language-model) "; immediate parent: "
-                                      (get-in bolt (concat (butlast path) [:rule]) :norule) " "
-                                      "while trying to create a complement: "
-                                      (spec-info spec)
-                                      )]
-                             (log/debug message)
-                             (if error-if-no-complements (exception message)))
-
-                           lexemes-before-phrases
-                           (take max-generated-complements
-                                 (lazy-cat lexical-complements phrasal-complements))
-                           true
-                           (take max-generated-complements
-                                 (lazy-cat phrasal-complements lexical-complements))))))))
+    (->>
+     (let [phrasal-complements (if (and (> max-total-depth total-depth)
+                                        (= true (get-in spec [:phrasal] true)))
+                                 (do
+                                   (log/debug (str "calling (generate-all) from add-complement-to-bolt with bolt:"
+                                                   (show-bolt bolt language-model)))
+                                   (generate-all spec language-model (+ (count path) total-depth)
+                                                 :max-total-depth max-total-depth)))
+           lexemes-before-phrases (lexemes-before-phrases total-depth max-total-depth)]
+       (cond (and lexemes-before-phrases
+                  (empty? lexical-complements)
+                  (= false (get-in spec [:phrasal] true)))
+             (log/warn (str "failed to generate any lexical complements with spec: "
+                            (strip-refs spec)))
+
+             (and lexemes-before-phrases
+                  (= true (get-in spec [:phrasal] false))
+                  (empty? phrasal-complements))
+             (log/warn (str "failed to generate any phrasal complements with spec: "
+                            (strip-refs spec)))
+
+             (and (empty? lexical-complements)
+                  (empty? phrasal-complements))
+
+             (let [message (str "add-complement-to-bolt: could generate neither phrasal "
+                                "nor lexical complements for "
+                                "bolt:" (show-bolt bolt language-model) "; immediate parent: "
+                                (get-in bolt (concat (butlast path) [:rule]) :norule) " "
+                                "while trying to create a complement: "
+                                (spec-info spec)
+                                )]
+               (log/debug message)
+               (if error-if-no-complements (exception message)))
+
+             lexemes-before-phrases
+             (take max-generated-complements
+                   (lazy-cat lexical-complements phrasal-complements))
+             true
+             (take max-generated-complements
+                   (lazy-cat phrasal-complements lexical-complements))))
+
+     (mapfn (fn [complement]
+              (let [unified
+                    (unify! (copy bolt)
+                            (assoc-in {} path
+                                      (copy complement)))]
+                (if (and (not-fail? unified)
+                         truncate-children)
+                  (truncate unified [path] language-model)
+                  unified))))
+     (mapfn (fn [tree]
+              (do-defaults tree language-model))))))

 (defn bolt-depth [bolt]
   (if-let [head (get-in bolt [:head] nil)]


remove old comment

remove old comment

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -16,7 +16,6 @@
    [clojure.string :as string]
    [dag_unify.core :refer [fail-path-between get-in strip-refs unifyc]]))

-;; can't decide between 'morph' or 'fo' or something other better name.
 (defn morph [expr & {:keys [from-language show-notes]
                      :or {from-language nil
                           show-notes true}}]


upparse rpc help

upparse rpc help

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -321,6 +321,8 @@
    :STRING-SYMBOL (fn [_ a _] a)
    :ARGS (fn [& args] args)
    :TITLE str
+   :MAP-ARG (fn [& args] (symbol (str (reduce (fn [acc [_ k v]] (format "%s%s_%s" (if acc (str acc "-") "") k v)) nil args) "-map")))
+   :LIST-ARG #(symbol (format "%s-list" %))
    :BTC (fn
           ([a] a)
           ([] nil))
@@ -338,7 +340,11 @@
     (not (contains? not-working n))))

 (defn def-rpcs []
-  (map #(ast->clj (help-parser %)) (filter valid-fn (split-help))))
+  (conj
+    (map
+      #(let [r (help-parser %)]
+         (ast->clj r)) (filter valid-fn (split-help)))
+    'do))

 ;;--------------------------------------------------------


Remove direct clj-time dependency with optional extensions.

Automatically extend java.time.Instant and jodatime related
classes if they are available in the classpath.

--- src/buddy/sign/util.clj
+++ src/buddy/sign/util.clj
@@ -13,35 +13,62 @@
 ;; limitations under the License.

 (ns buddy.sign.util
-  (:require [buddy.core.codecs :as codecs]
-            [clj-time.coerce :as coerce]
-            [clj-time.core :as time]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Utils protocols related to time checking
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  (:require [buddy.core.codecs :as codecs]))

 (defprotocol ITimestamp
   "Default protocol for convert any type to
   unix timestamp in UTC."
   (to-timestamp [obj] "Covert to timestamp"))

-(extend-protocol ITimestamp
-  java.util.Date
+(extend-type java.util.Date
+  ITimestamp
   (to-timestamp [obj]
-    (let [date (coerce/from-date obj)]
-      (quot (coerce/to-long date) 1000)))
+    (-> (.getTime ^java.util.Date obj)
+        (quot 1000))))

-  org.joda.time.DateTime
-  (to-timestamp [obj]
-    (let [date (time/to-time-zone obj time/utc)]
-      (quot (coerce/to-long date) 1000))))
+(defmacro ^:private apply-jodatime-extensions
+  []
+  (try
+    (Class/forName "org.joda.time.DateTime")
+    (Class/forName "org.joda.time.Instant")

-(defn timestamp
+    `(extend-protocol ITimestamp
+       org.joda.time.DateTime
+       (to-timestamp [obj#]
+         (-> (.getMillis ^org.joda.time.DateTime obj#)
+             (quot 1000)))
+
+       org.joda.time.Instant
+       (to-timestamp [obj#]
+         (-> (.getMillis ^org.joda.time.Instant obj#)
+             (quot 1000))))
+    (catch ClassNotFoundException e
+      ;; pass
+      )))
+
+(defmacro ^:private apply-jdk8-extensions
+  []
+  (try
+    (Class/forName "java.time.Instant")
+    `(extend-protocol ITimestamp
+       java.time.Instant
+       (to-timestamp [obj#]
+         (.getEpochSecond ^java.time.Instant obj#)))
+    (catch ClassNotFoundException e
+      ;; pass
+      )))
+
+(apply-jodatime-extensions)
+(apply-jdk8-extensions)
+
+(defn now
   "Get a current timestamp."
   []
-  (let [date (time/now)]
-    (to-timestamp date)))
+  (quot (System/currentTimeMillis) 1000))
+
+(def ^:deprecated timestamp
+  "Alias to `now`."
+  now)

 (defmacro defalias
   [name orig]


add restock-all function

add restock-all function

--- src/ca_recipe/store.clj
+++ src/ca_recipe/store.clj
@@ -69,3 +69,8 @@
   (set-validator! inventory no-negative-values?)
   (add-wath inventory :restock restock-other))

+(defn restock-all
+  "restock all items sold"
+  []
+  (swap! inventory #(merge-with + % @sold-items))
+  (reset! sold-tems {}))


Refactored out calc-addrs and calc-coords helper funcs.

--- src/cbfg/world/net.cljs
+++ src/cbfg/world/net.cljs
@@ -58,6 +58,50 @@
                          (aput client-loop-out res-ch msg)
                          (recur (inc num-outs)))))))
     cmd-ch))
+
+(defn calc-addrs [net-state]
+  (let [addrs (atom {})]
+    (doseq [[[addr port] accept-chs] (:listens net-state)]
+      (swap! addrs #(assoc-in % [addr :listens port] true)))
+    (doseq [[send-ch stream] (:streams net-state)]
+      (if (= (:side stream) :client)
+        (swap! addrs #(assoc-in % [(:client-addr stream) :outs
+                                   [(:accept-addr stream) (:accept-port stream)]
+                                   [(:client-port stream)
+                                    (:server-addr stream) (:server-port stream)]]
+                                (:msgs stream)))
+        (swap! addrs #(assoc-in % [(:server-addr stream) :outs
+                                   [(:accept-addr stream) (:accept-port stream)]
+                                   [(:server-port stream)
+                                    (:client-addr stream) (:client-port stream)]]
+                                (:msgs stream)))))
+    @addrs))
+
+(defn calc-coords [addrs]
+  (let [coords (atom {}) ; Index positions.
+        naddrs (count addrs) ; Assign coords.
+        conns (sort (mapcat (fn [[addr addr-v]]
+                              (mapcat (fn [[[accept-addr accept-port]
+                                            accept-addr-port-v]]
+                                        (map (fn [[[from-port to-addr to-port] msgs]]
+                                               [(not= addr accept-addr)
+                                                addr accept-addr accept-port
+                                                from-port])
+                                             accept-addr-port-v))
+                                      (:outs addr-v)))
+                            addrs))]
+    (doall (map-indexed (fn [addr-idx [addr addr-v]]
+                          (swap! coords
+                                 #(assoc % addr
+                                         [addr-idx (rem (* (dec naddrs) addr-idx)
+                                                        naddrs)])))
+                        (sort-by first addrs)))
+    (reduce (fn [prev [is-client addr accept-addr accept-port port]]
+              (let [idx (if (= (first prev) addr) (second prev) 0)]
+                (swap! coords #(assoc % [addr port] idx))
+                [addr (inc idx)]))
+            nil conns)
+    @coords))

 (defn render-msg [msg class-extra style-extra]
   ["<div class='msg " class-extra
@@ -172,49 +216,11 @@
     [addrs h]))

 (defn render-net-html [net-state prev-addrs &
-                       {:keys [addr-override-xy addr-attrs-fn geom]
-                        :or {geom {}}}]
-  (let [addrs (atom {})
-        coords (atom {})] ; Index positions.
-    (doseq [[[addr port] accept-chs] (:listens net-state)]
-      (swap! addrs #(assoc-in % [addr :listens port] true)))
-    (doseq [[send-ch stream] (:streams net-state)]
-      (if (= (:side stream) :client)
-        (swap! addrs #(assoc-in % [(:client-addr stream) :outs
-                                   [(:accept-addr stream) (:accept-port stream)]
-                                   [(:client-port stream)
-                                    (:server-addr stream) (:server-port stream)]]
-                                (:msgs stream)))
-        (swap! addrs #(assoc-in % [(:server-addr stream) :outs
-                                   [(:accept-addr stream) (:accept-port stream)]
-                                   [(:server-port stream)
-                                    (:client-addr stream) (:client-port stream)]]
-                                (:msgs stream)))))
-    (let [naddrs (count @addrs) ; Assign coords.
-          conns (sort (mapcat
-                       (fn [[addr addr-v]]
-                         (mapcat (fn [[[accept-addr accept-port]
-                                       accept-addr-port-v]]
-                                   (map (fn [[[from-port to-addr to-port] msgs]]
-                                          [(not= addr accept-addr)
-                                           addr accept-addr accept-port
-                                           from-port])
-                                        accept-addr-port-v))
-                                 (:outs addr-v)))
-                       @addrs))]
-      (doall (map-indexed
-              (fn [addr-idx [addr addr-v]]
-                (swap! coords
-                       #(assoc % addr
-                               [addr-idx (rem (* (dec naddrs) addr-idx)
-                                              naddrs)])))
-              (sort-by first @addrs)))
-      (reduce (fn [prev [is-client addr accept-addr accept-port port]]
-                (let [idx (if (= (first prev) addr) (second prev) 0)]
-                  (swap! coords #(assoc % [addr port] idx))
-                  [addr (inc idx)]))
-              nil conns))
-    (render-net-addrs-html @addrs prev-addrs @coords addr-override-xy addr-attrs-fn geom)))
+                       {:keys [addr-override-xy addr-attrs-fn geom]}]
+  (let [addrs (calc-addrs net-state)
+        coords (calc-coords addrs)]
+    (render-net-addrs-html addrs prev-addrs coords
+                           addr-override-xy addr-attrs-fn (or geom {}))))

 (defn net-actx-info [vis net-actx-id]
   (first (filter (fn [[actx actx-info]] (= (last actx) net-actx-id))


Pass another test.

Pass another test.

--- test/onyx/coordinator/single_peer_test.clj
+++ test/onyx/coordinator/single_peer_test.clj
@@ -100,9 +100,11 @@
                 (let [jobs (extensions/bucket sync :job)]
                   (fact (count jobs) => 1)))

-         #_(facts "There are three tasks"
-                (let [query '[:find ?n :where [?t :task/name ?n]]]
-                  (fact (d/q query db) => #{[:in] [:inc] [:out]})))
+         (facts "There are three tasks"
+                (let [task-nodes (extensions/bucket-at sync :task job-id)
+                      tasks (map #(extensions/read-place-at sync :task job-id %) task-nodes)]
+                  (fact (count task-nodes) => 3)
+                  (fact (into #{} (map :task/name tasks)) => #{:in :inc :out})))

          #_(facts ":in's ingress queue is generated"
                 (let [query '[:find ?qs :where


Generator should tend to submit a job in initial phase

--- test/onyx/peer/deterministic_peer_test.clj
+++ test/onyx/peer/deterministic_peer_test.clj
@@ -391,7 +391,7 @@
             ;; Number of peers on each input task
             n-input-peers (gen/elements [1 2]) ;(gen/resize 1 gen/s-pos-int)
             job-ids (gen/vector gen/uuid n-jobs)
-            initial-submit? (gen/elements [0 1])
+            initial-submit? (gen/elements [1 0])
             phases (gen/tuple
                      (gen/vector (submit-job-gen n-jobs job-ids n-input-peers) initial-submit?)
                      (gen/no-shrink
@@ -418,7 +418,7 @@

 (defn successful-run? [generated]
   (try (run-test generated)
-       (println "SUccess run")
+       (println "SUCCESSFUL RUN")
        true
        (catch Throwable t
          (println "FAILED RUN" t)


Add some further deploy utility.

Add some further deploy utility.

 - make instances grab a public ip
 - fn to extract ips from reservation
 - return map of everything we've created (although this is out of date
   by the time we see it because the entities have been updated) TODO -
   return updated version.

--- src/kixi/cloud/deploy.clj
+++ src/kixi/cloud/deploy.clj
@@ -12,34 +12,36 @@
         route-tables        (ec2/describe-route-tables :filters [{:name "vpc-id" :values [vpc-id]}])
         route-table-id      (get-in route-tables [:route-tables 0 :route-table-id])
         internet-gateway    (ec2/create-internet-gateway {:vpc-id vpc-id
-                                                          :cidr-block vpc-cidr-block})
+                                                          :cidr-block vpc-cidr-block
+                                                          :tags       tag})
         internet-gateway-id (get-in internet-gateway [:internet-gateway :internet-gateway-id])
         subnet              (ec2/create-subnet {:cidr-block subnet-cidr-block
                                                 :vpc-id vpc-id
-                                                :map-public-ip-on-launch true})
-        subnet-id           (get-in subnet [:subnet :subnet-id])
-        reservation         (ec2/run-instances {:image-id       "ami-6e7bd919"
-                                                :instance-type  instance-type
-                                                :vpc-id         vpc-id
-                                                :subnet-id      subnet-id
-                                                :min-count      min-count
-                                                :max-count      max-count
-                                                :key-name       key-name
-                                                :security-group security-group})
-        instances         (get-in reservation [:reservation :instances])]
+                                                :tags       tag
+                                                })
+        subnet-id           (get-in subnet [:subnet :subnet-id])]

     (ec2/attach-internet-gateway {:internet-gateway-id internet-gateway-id :vpc-id vpc-id})
-
     (ec2/create-route {:route-table-id route-table-id :destination-cidr-block "0.0.0.0/0" :gateway-id internet-gateway-id})
-
-    (let [elb (elb/create-load-balancer {:load-balancer-name load-balancer-name
-                                         :subnets [subnet-id]
-                                         :listeners [{:instance-port 80
-                                                      :load-balancer-port 80
-                                                      :instance-protocol "HTTP"
-                                                      :protocol "HTTP"}]})]
-      (doseq [{:keys [instance-id]} instances]
-        (elb/register-instances-with-load-balancer {:load-balancer-name load-balancer-name :instances [{:instance-id instance-id}]})))))
+    (ec2/modify-subnet-attribute {:subnet-id subnet-id
+                                  :map-public-ip-on-launch true})
+    (let [reservation (ec2/run-instances {:image-id       "ami-6e7bd919"
+                                          :instance-type  instance-type
+                                          :vpc-id         vpc-id
+                                          :subnet-id      subnet-id
+                                          :min-count      min-count
+                                          :max-count      max-count
+                                          :key-name       key-name
+                                          :security-group security-group})
+          elb         (elb/create-load-balancer {:load-balancer-name load-balancer-name
+                                                 :subnets [subnet-id]
+                                                 :listeners [{:instance-port 80
+                                                              :load-balancer-port 80
+                                                              :instance-protocol "HTTP"
+                                                              :protocol "HTTP"}]})]
+      (doseq [{:keys [instance-id]} (get-in reservation [:reservation :instances])]
+        (elb/register-instances-with-load-balancer {:load-balancer-name load-balancer-name :instances [{:instance-id instance-id}]}))
+      (merge vpcs internet-gateway subnet reservation))))

 (defn build []
   (build* {:vpc-cidr-block     "10.23.0.0/16"
@@ -51,3 +53,9 @@
            :max-count          5
            :tag                "mc-test-2"
            :load-balancer-name "mc-test-elb2"}))
+
+(defn extract-ip-addresses [arch]
+  (->> [:reservation :instances]
+       (get-in arch)
+       (map (juxt :instance-id (comp :private-ip-address first #(filter :primary %) :private-ip-addresses first :network-interfaces)))
+       (into {})))


removed unused function

removed unused function

--- src/datascript/datafy.cljc
+++ src/datascript/datafy.cljc
@@ -5,9 +5,6 @@
             [datascript.impl.entity :as e]))

 (declare datafy-entity-seq)
-
-(defn- pull-pattern [ref-rattrs]
-  (into ["*"] ref-rattrs))

 (defn- navize-pulled-entity [db-val pulled-entity]
   (let [ref-attrs (:db.type/ref (:rschema db-val))


Moving settlements record at the top of civs.model.core

--- src/civs/model/core.clj
+++ src/civs/model/core.clj
@@ -12,6 +12,7 @@
 (defrecord Game [world settlements groups political-entities next_id])
 (defrecord Culture [nomadism knowledge language])
 (defrecord Group [id name position population political-entity-id])
+(defrecord Settlement [id name foundation-turn position owner])

 (declare culture)
 (declare society)
@@ -181,8 +182,6 @@
 ; ###########################################################
 ;  Settlement
 ; ###########################################################
-
-(defrecord Settlement [id name foundation-turn position owner])

 ;===============================================
 ; Society (Govern forms)


turn off test-stuff export

turn off test-stuff export


* src/cljs/cljs/core.cljs: move bounded count into local in apply

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1748,41 +1748,46 @@
   ([f args]
      (let [fixed-arity (.-cljs$lang$maxFixedArity f)]
        (if (.-cljs$lang$applyTo f)
-         (if (<= (bounded-count args (inc fixed-arity)) fixed-arity)
-           (.apply f f (to-array args))
-           (.cljs$lang$applyTo f args))
+         (let [bc (bounded-count args (inc fixed-arity))]
+          (if (<=  bc fixed-arity)
+            (.apply f f (to-array args))
+            (.cljs$lang$applyTo f args)))
          (.apply f f (to-array args)))))
   ([f x args]
      (let [arglist (list* x args)
            fixed-arity (.-cljs$lang$maxFixedArity f)]
        (if (.-cljs$lang$applyTo f)
-         (if (<= (bounded-count arglist (inc fixed-arity)) fixed-arity)
-           (.apply f f (to-array arglist))
-           (.cljs$lang$applyTo f arglist))
+         (let [bc (bounded-count arglist (inc fixed-arity))]
+          (if (<= bc fixed-arity)
+            (.apply f f (to-array arglist))
+            (.cljs$lang$applyTo f arglist)))
          (.apply f f (to-array arglist)))))
   ([f x y args]
      (let [arglist (list* x y args)
            fixed-arity (.-cljs$lang$maxFixedArity f)]
        (if (.-cljs$lang$applyTo f)
-         (if (<= (bounded-count arglist (inc fixed-arity)) fixed-arity)
-           (.apply f f (to-array arglist))
-           (.cljs$lang$applyTo f arglist))
+         (let [bc (bounded-count arglist (inc fixed-arity))]
+          (if (<= bc fixed-arity)
+            (.apply f f (to-array arglist))
+            (.cljs$lang$applyTo f arglist)))
          (.apply f f (to-array arglist)))))
   ([f x y z args]
      (let [arglist (list* x y z args)
            fixed-arity (.-cljs$lang$maxFixedArity f)]
        (if (.-cljs$lang$applyTo f)
-         (if (<= (bounded-count arglist (inc fixed-arity)) fixed-arity)
-           (.apply f f (to-array arglist))
-           (.cljs$lang$applyTo f arglist))
+         (let [bc (bounded-count arglist (inc fixed-arity))]
+          (if (<= bc fixed-arity)
+            (.apply f f (to-array arglist))
+            (.cljs$lang$applyTo f arglist)))
          (.apply f f (to-array arglist)))))
   ([f a b c d & args]
      (let [arglist (cons a (cons b (cons c (cons d (spread args)))))
            fixed-arity (.-cljs$lang$maxFixedArity f)]
        (if (.-cljs$lang$applyTo f)
-         (if (<= (bounded-count arglist (inc fixed-arity)) fixed-arity)
-           (.apply f f (to-array arglist))
-           (.cljs$lang$applyTo f arglist))
+         (let [bc (bounded-count arglist (inc fixed-arity))]
+          (if (<= bc fixed-arity)
+            (.apply f f (to-array arglist))
+            (.cljs$lang$applyTo f arglist)))
          (.apply f f (to-array arglist))))))

 (defn vary-meta


localize search atom

localize search atom

--- src/cljs/jiyi/core.cljs
+++ src/cljs/jiyi/core.cljs
@@ -14,8 +14,8 @@
 (enable-console-print!)

 (defonce user (atom {}))
-(defonce search-term (atom ""))
-(defonce search-results (atom []))
+;; (defonce search-term (atom ""))
+;; (defonce search-results (atom []))

 ;; -------------------------
 ;; Views
@@ -84,25 +84,23 @@
          results)]])

 (defn Search []
-  [:div
-   [:div.row
-    [:div.input-field.col.s12
-     [:input {:placeholder "Search term"
-              :type :text
-              :value @search-term
-              :on-change (fn [e]
-                           (let [newval (-> e .-target .-value)]
-                             (reset! search-term newval)
-                             (when-not (empty? newval)
-                               (go
-                                 (reset! search-results (<! (<search-user newval)))))))}]]]
-   ;;Results
-   [SearchResults @search-results ]])
-
-(add-watch search-results :search-results
-  (fn [key atom old-state new-state]
-    (prn "-- Atom Changed --")
-    (prn key new-state)))
+  (let [search-term (atom "")
+        search-results (atom [])]
+    (fn []
+      [:div
+       [:div.row
+        [:div.input-field.col.s12
+         [:input {:placeholder "Search term"
+                  :type :text
+                  :value @search-term
+                  :on-change (fn [e]
+                               (let [newval (-> e .-target .-value)]
+                                 (reset! search-term newval)
+                                 (when-not (empty? newval)
+                                   (go
+                                     (reset! search-results (<! (<search-user newval)))))))}]]]
+       ;;Results
+       [SearchResults @search-results ]])))

 (defn json->userdetails [json]


Run-all

Run-all

--- src/defragment/core.clj
+++ src/defragment/core.clj
@@ -367,15 +367,18 @@
   (let [{:keys [version revision]} (ujava/get-project-properties "defragment" "defragment")]
     (format "Version: %s, Revision %s" version revision)))

-
-(defn -main [config-path & args]
-  (log/info "Welcome to Defragment " (revision-info))
+(defn run-all
+[config-path]
   (log/info "Loading config file " config-path)
   (let [conf (process-config config-path)]
     (run-all! conf)
     (log/info "concatenation done")
     (feed/make-feed! conf)
-    (log/info "feed done"))
+    (log/info "feed done")))
+
+(defn -main [config-path & args]
+  (log/info "Welcome to Defragment " (revision-info))
+  (run-all config-path)
   (System/exit 0))

@@ -383,7 +386,7 @@

 (comment

-  (-main "resources/test-config.edn")
+  (run-all "resources/test-config.edn")

   (clojure.tools.trace/trace-vars parse)


Minor readbility fixes

Minor readbility fixes

--- src/foreclojure/static.clj
+++ src/foreclojure/static.clj
@@ -50,12 +50,12 @@
    [:br][:br]
    "Some operations are prohibited for security reasons.  For instance, you will not be able to use \"def\" or switch namespaces.  In addition, some problems have special restrictions.  For example, a function which is supposed to count the number of elements in a sequence will not be allowed to use the \"count\" function.  Obviously, this would defeat the purpose.  Any special restrictions will be listed on the problem page."
    [:br][:br]
-   "Many of the easier problems on this site can be solved using only your browser.  However at some point you will want to install Clojure, and use your favorite IDE or text editor to write your code.  We prefer using Emacs, but its totally a matter of personal preference.  Writing all your code directly on the site has a few disadvantages:"
+   "Many of the easier problems on this site can be solved using only your browser.  However at some point you will want to install Clojure, and use your favorite IDE or text editor to write your code.  We prefer using Emacs, but it's totally a matter of personal preference.  Writing all your code directly on the site has a few disadvantages:"
    [:br][:br]
    [:li "4Clojure is not an IDE, and doesn't try to be"]
    [:li "4Clojure won't save any of your code for later use"]
    [:br]
-   "Check out the official "
+   "Check out the official Clojure "
    [:a {:href "http://clojure.org/getting_started"} "getting started"]
    " page for help with installation."
    [:br][:br]


removed unnecessary print

removed unnecessary print

--- src/frontend/renderer.cljs
+++ src/frontend/renderer.cljs
@@ -222,7 +222,6 @@
                       (dom/span #js {:className "track-delete-button"
                                      :title "Delete Track"
                                      :onClick #(core/delete-track track-id)} "X"))]
-        (println "DURATION!" duration)
         (if (:playing? state)
           (dom/div #js {:id track-id
                         :className "track-view"


Finished (?) black-and-white

Finished (?) black-and-white

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -185,11 +185,14 @@

 (defn black-and-white [context canvas]
   (let [pixels (get-pixels context canvas)
-        greyscale (fn[r g b alpha](
-                             (let [grey (+ (* r 0.3) (* g 0.59) (* b 0.11))]
-                               (if (> grey (/ 255 2)) 255 0))))]
-    ;; TODO
-    (reduce greyscale [] pixels)))
+        greyscale (fn[r g b alpha]
+            (let [grey (+ (* r 0.3) (* g 0.59) (* b 0.11))]
+             (if (> grey (/ 255 2)) 1 0)))
+        f  (fn [[r g b a & rest-pixels] result]
+             (if (nil? a)
+              result
+              (recur rest-pixels (conj result (greyscale r g b a)))))]
+    (f pixels [])))

 (defn on-image-load [event]


PLD: move comments to docstrings

PLD: move comments to docstrings

--- src/hatti/charting.cljs
+++ src/hatti/charting.cljs
@@ -16,8 +16,9 @@
   [st]
   (let [ans (js/parseInt st)] (when-not (js/isNaN ans) ans)))

-(defn str->int [typ]
+(defn str->int
   "Converts string to integer, for typ (int|date)."
+  [typ]
   (case typ
     "int" parse-int
     "date" (fn [date-string]
@@ -27,9 +28,10 @@
                    (/ millis-in-day)
                    floor)))))

-(defn int->str [typ &{:keys [digits] :or {digits 1}}]
+(defn int->str
   "Converts integers to strings, for type (int|date).
    Optional digits parameter = number of digits after decimal, default is 1."
+  [typ &{:keys [digits] :or {digits 1}}]
   (let [int-fmt-s (str "%." digits "f")
         d->millis #(* millis-in-day %)
         date->str #(when % (.format (js/moment %) "ll"))]
@@ -37,8 +39,9 @@
       "int"  #(format int-fmt-s (float %))
       "date" #(date->str (d->millis %)))))

-(defn range->str [[mn mx] typ]
+(defn range->str
   "Converts a range of typ (int|date) to a string."
+  [[mn mx] typ]
   (let [[mn mx] [(ceil mn) (floor mx)]
         fmt (int->str typ :digits 0)]
     (if (<= mx mn) (fmt mn)
@@ -198,9 +201,9 @@
        (response-count-message non-nil-count)])))

 (defn table-chart-h
-  [data nil-count non-nil-count field_type]
   "Create category bar chart out of some data + count data. Data of form:
   {'Label1' 1 'Label2' 2}, etc. where the numbers are counts."
+  [data nil-count non-nil-count field_type]
   (let [max-count (apply max (vals data))
         percent-s (fn [n total]
                     (let [s (scale/linear :domain [0 total] :range [0 100])]


Added comments in DIF UMM parsing to indicate why we're not parsing certain items.

--- umm-lib/src/cmr/umm/dif/collection.clj
+++ umm-lib/src/cmr/umm/dif/collection.clj
@@ -61,10 +61,12 @@
      :summary (cx/string-at-path xml-struct [:Summary :Abstract])
      :product (xml-elem->Product xml-struct)
      :data-provider-timestamps (xml-elem->DataProviderTimestamps xml-struct)
+     ;; See CMR-588
      ;:spatial-keywords (seq (cx/strings-at-path xml-struct [:Location]))
      :temporal-keywords (seq (cx/strings-at-path xml-struct [:Data_Resolution :Temporal_Resolution]))
      :temporal (t/xml-elem->Temporal xml-struct)
      :science-keywords (sk/xml-elem->ScienceKeywords xml-struct)
+     ;; Waiting on CMR-590 and CMRIN-4 for more info on DIF platforms
      ;:platforms (platform/xml-elem->Platforms xml-struct)
      :product-specific-attributes (psa/xml-elem->ProductSpecificAttributes xml-struct)
      :projects (pj/xml-elem->Projects xml-struct)


date un/parsing handled by images now

date un/parsing handled by images now

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -1,39 +1,12 @@
 (ns mars-ogler.scrape
-  (:require [clojure.string :as str]
+  (:require [clj-http.client :as http]
+            [clj-time.core :as time]
+            [clojure.string :as str]
             [mars-ogler.cams :as cams]
             [mars-ogler.images :as images]
             [mars-ogler.times :as times]
             [net.cgrand.enlive-html :as html]))
   (def % partial)
-
-;;
-;; HTML -> Information
-;;
-
-(defn parse-dates
-  [img]
-  (let [strs (select-keys img times/types)
-        dates (into {} (for [[type date-str] strs]
-                         [type (times/rfc-parser date-str)]))
-        taken (:taken-utc dates)
-        released (:released dates)
-        lag (-> (if (time/before? taken released)
-                  (time/interval taken released)
-                  (time/interval taken taken))
-              times/format-interval)
-        acquired (:acquired dates)
-        acquired-stamp (if acquired
-                         (cvt-time/to-long acquired)
-                         0)]
-    (-> (merge img dates)
-      (assoc :lag lag, :acquired-stamp acquired-stamp))))
-
-(defn unparse-dates
-  [img]
-  (let [dates (select-keys img times/types)]
-    (-> (into img (for [[type date] dates]
-                    [type (times/rfc-printer date)]))
-      (dissoc :lag :acquired-stamp))))

 ;;
 ;; Scrapin'
@@ -98,7 +71,7 @@
     (->> image-divs
       (map div->map)
       (map classify-size)
-      (map parse-dates))))
+      (map images/parse-dates))))

 ;;
 ;; Fetching Stuff Over the Tubes
@@ -147,7 +120,7 @@

 (defn fetch-tick
   [old-imgs]
-  (let [new-imgs (map images/parse-dates (fetch-new-images old-imgs))
+  (let [new-imgs (fetch-new-images old-imgs)
         all-imgs (concat new-imgs old-imgs)]
     {:all all-imgs, :new new-imgs, :old old-imgs}))


v0.1.1

--- joplin.lein/project.clj
+++ joplin.lein/project.clj
@@ -6,7 +6,7 @@
   :dependencies [[leinjacker "0.4.1"]]
   :eval-in-leiningen true

-  ;; Example usage
+   ;; Example usage
   :joplin {
            :migrators {
                        :pmig "joplin/migrators/psql"


doh - distinct-vector-callback

doh - distinct-vector-callback

--- src/er_cassandra/model/callbacks/distinct_vector_callback.clj
+++ src/er_cassandra/model/callbacks/distinct_vector_callback.clj
@@ -3,4 +3,4 @@
 (defn create-distinct-vector-callback
   [col]
   (fn [r]
-    (assoc r (vec (distinct (get r col))))))
+    (assoc r col (vec (distinct (get r col))))))


GAWB-1139: more checky box things

GAWB-1139: more checky box things

--- src/cljs/main/broadfcui/page/workspace/method_configs/launch_analysis.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/launch_analysis.cljs
@@ -37,7 +37,7 @@
         (row "Workflows ahead of yours:" queue-position)
         (row "Queue status:" (str queued " Queued; " active " Active"))])]))

-(defn- render-form [state props]
+(defn- render-form [state props refs]
   [:div {:style {:width 1000}}
    (when (:launching? @state)
      [comps/Blocker {:banner "Launching analysis..."}])
@@ -67,7 +67,7 @@
                                                     :selected-entity entity-id
                                                     :workflow-count (common/count-workflows
                                                                       e (:root-entity-type props)))})))}]]
-   (style/create-form-label "Define Expression")
+   (style/create-form-label "Define Expression Or Don't")
    (let [disabled (= (:root-entity-type props) (get-in @state [:selected-entity :type]))]
      (style/create-text-field {:placeholder "leave blank for default"
                                :style {:width "100%"
@@ -78,10 +78,18 @@
                                         (:expression @state))
                                :onChange #(let [text (-> % .-target .-value clojure.string/trim)]
                                             (swap! state assoc :expression text))}))
+   [:div {:style {:marginTop "1em"}}
+    [comps/Checkbox
+    {:ref "callCache-check"
+     :label "Use Call Caching with this submission"
+     :initial-checked? true
+     :disabled-text (case (:protected-option @state)
+                      :not-loaded "Call Caching status has not finished loading."
+                      :not-available "This option is not available for your account."
+                      nil)}]]
    (when-let [wf-count (:workflow-count @state)]
      (when (> wf-count (config/workflow-count-warning-threshold))
-       [:div {:style {:textAlign "center"}}
-        [:div {:style {:display "inline-flex" :alignItems "center" :margin "1em 0 -1em 0" :padding "0.5em"
+       [:div {:style {:textAlign "center"}}[:div {:style {:display "inline-flex" :alignItems "center" :margin "1em 0 -1em 0" :padding "0.5em"
                        :backgroundColor "white" :border style/standard-line :borderRadius 3}}
          (icons/icon {:style {:color (:exception-state style/colors) :marginRight 5 :verticalAlign "middle"}}
                      :warning-triangle)
@@ -96,10 +104,10 @@

 (react/defc Form
   {:render
-   (fn [{:keys [props state this]}]
+   (fn [{:keys [props state refs this]}]
      [comps/OKCancelForm
       {:header "Launch Analysis"
-       :content (render-form state props)
+       :content (react/create-element (render-form state props refs))
        :ok-button {:text "Launch" :disabled? (:disabled? props) :onClick #(react/call :launch this)}}])
    :component-did-mount
    (fn [{:keys [state]}]
@@ -110,14 +118,15 @@
                      (swap! state assoc :queue-status (common/queue-status-counts (get-parsed-response false)))
                      (swap! state assoc :queue-error status-text)))}))
    :launch
-   (fn [{:keys [props state]}]
+   (fn [{:keys [props state refs]}]
      (if-let [entity (:selected-entity @state)]
        (let [config-id (:config-id props)
              expression (:expression @state)
              payload (merge {:methodConfigurationNamespace (:namespace config-id)
                              :methodConfigurationName (:name config-id)
                              :entityType (:type entity)
-                             :entityName (:name entity)}
+                             :entityName (:name entity)
+                             :readFromCache (react/call :checked? (@refs "callCache-check"))}
                        (when-not (clojure.string/blank? expression) {:expression expression}))]
          (swap! state assoc :launching? true :launch-server-error nil)
          (endpoints/call-ajax-orch


Trigger tests every 5 minutes

Trigger tests every 5 minutes

--- simple.clj
+++ simple.clj
@@ -4,4 +4,4 @@
   :test (execute "run-tests.sh")
   :triggers [{:type :timer
               :name "test-simple-ci-trigger"
-              :args [:every 1 :minutes]}])
+              :args [:every 5 :minutes]}])


Работа над диалогом товаров

Работа над диалогом товаров

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -832,8 +832,6 @@
    files-select* row))

-
-;; WEB TOOL
 (defn web-file-upload [service-upload-fn uploader-params]
   (letfn [(upload-one [{:keys [size tempfile content-type filename]}]
             (service-upload-fn {:filename filename :size size :content_type content-type} tempfile))]


Fix bug related to CLJ-124.

Fix bug related to CLJ-124.

--- src/mvxcvi/vault/tool.clj
+++ src/mvxcvi/vault/tool.clj
@@ -111,4 +111,5 @@

 (defn -main [& args]
-  (execute commands args))
+  (execute commands args)
+  (shutdown-agents))


Update cache_utils.clj

Update cache_utils.clj

--- waiter/src/waiter/util/cache_utils.clj
+++ waiter/src/waiter/util/cache_utils.clj
@@ -19,7 +19,7 @@
            [java.util.concurrent TimeUnit]))

 (defn cache-factory
-  "Creates a cache wrapped in an atom.
+  "Creates a Guava cache.
    The argument to the method is a map that contains the threshold and ttl keys.
    The threshold argument defines the maximum number of elements in the cache.
    The ttl argument that defines the time (in millis) that entries are allowed to reside in the cache."


Use apply and a list.

Use apply and a list.

--- src/lab_notebook/core.cljs
+++ src/lab_notebook/core.cljs
@@ -8,9 +8,11 @@
   (reify
     om/IRender
     (render [this]
-      (dom/div nil
+      (apply dom/div nil
         (dom/h1 nil "Lab notebook")
-        (:message cursor)))))
+        nil
+        (for [x (range 10)]
+          (str x " "))))))

 (om/root app-container appstate
   {:target (. js/document (getElementById "app"))})


proof checking (of course) enabled by default

--- src/latte/kernel/proof.clj
+++ src/latte/kernel/proof.clj
@@ -39,11 +39,11 @@
 ;; # Proof checking control
 ;;}

-;; (def ^:private +proof-checking-enabled+ (atom true))
+(def ^:private +proof-checking-enabled+ (atom true))

 ;; The following is highly unsafe (and only required to
 ;; speed up heavy libraries at development time)
-(def ^:private +proof-checking-enabled+ (atom false))
+;; (def ^:private +proof-checking-enabled+ (atom false))

 (defn disable-proof-checking! []
   (swap! +proof-checking-enabled+


(SERVER-2231) Disable using the infrastructure CRL by default

This commit updates puppetserver's configuration to not use a separate
infrastructure CRL by default.

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -138,7 +138,7 @@
         defaults {:infra-nodes-path (str cadir "/infra_inventory.txt")
                   :infra-node-serials-path (str cadir "/infra_serials")
                   :infra-crl-path (str cadir "/infra_crl.pem")
-                  :enable-infra-crl true
+                  :enable-infra-crl false
                   :allow-subject-alt-names default-allow-subj-alt-names
                   :allow-authorization-extensions default-allow-auth-extensions}]
     (merge defaults ca-data)))


Throwing exception on bad synth params.

Throwing exception on bad synth params.

* Making sure synth has an even number of params, and explaining that
default vals are required.

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -306,6 +306,8 @@
 (defn- control-proxies
   "Returns a list of param name symbols and control proxies"
   [params]
+  (when (not (even? (count params)))
+    (throw (Exception. "Error: odd number of synth parameters.  Note, synth parameters require default values. (e.g. (synth [freq 440] ...))")))
   (mapcat (fn [param] [(symbol (:name param))
                       `(control-proxy ~(:name param) ~(:default param) ~(:rate param))])
           params))


use a memoize to calculate the distance

use a memoize to calculate the distance

--- src/k_means/cluster.clj
+++ src/k_means/cluster.clj
@@ -31,10 +31,12 @@
   ([c1 c2]
     (->> (map - c1 c2) (map #(* % %)) (reduce +))))

+
 (defn distance-p
   "Implements euclidian distance between two vectors"
   ([c1 c2]
     (->> (pmap - c1 c2) (pmap #(* % %)) (reduce +))))
+(def distance-p-m (memoize distance-p))

 (defn min-index
   [c]
@@ -48,7 +50,8 @@
 (defn min-distance-p
   "returns the index of the centroid c closest to vecotr v"
   [c v]
-    (for [i c :let [d (distance-p i v)]] d))
+    (for [i c :let [d (distance-p-m i v)]] d))
+(def min-distance-p-m (memoize min-distance-p))

 (defn min-vector
   "Chooses the smallest vector in a set of vectors"
@@ -79,7 +82,7 @@
       ; otherwise we continue until the list of vectors is empty
       (not-empty l)
         ; for the vector at the start of the list, choose a centroid which is closest
-        (let [i (min-index (p :min-distance (min-distance-p c (first l))))]
+        (let [i (min-index (p :min-distance (min-distance-p-m c (first l))))]
           ; append the vector to the smallest distance
           (recur (rest l) c (assoc a i (conj (nth a i) (first l)))))
       :else


Handle traces correctly that has snapshots generated from s/coll-of

--- src/pinpointer/trace.cljc
+++ src/pinpointer/trace.cljc
@@ -2,14 +2,15 @@
   (:require [spectrace.core :as strace]))

 (defn- partition-trace [t]
-  (loop [t t, chunk [], ret []]
+  (loop [t t, chunk [], prev nil, ret []]
     (if (empty? t)
       (conj ret chunk)
       (let [{:keys [val snapshots] :as frame} (first t)]
         (if (and (seq snapshots)
-                 (not= (first snapshots) val))
-          (recur (rest t) [frame] (conj ret chunk))
-          (recur (rest t) (conj chunk frame) ret))))))
+                 prev
+                 (not= prev (peek snapshots)))
+          (recur (rest t) [frame] nil (conj ret chunk))
+          (recur (rest t) (conj chunk frame) val ret))))))

 (defn- trace [t]
   (letfn [(diff-steps [steps1 steps2]


add untitled file count

add untitled file count

--- src/lt/objs/opener.cljs
+++ src/lt/objs/opener.cljs
@@ -38,11 +38,14 @@
     (let [type (files/path->type path)]
       {:name (files/basename path) :type-name (:name type) :path path :mime (:mime type) :tags (:tags type)})))

+(def untitled-count (atom 0))
+
 (behavior ::open-transient-editor
                   :triggers #{:new!}
                   :reaction (fn [this path dirty?]
                               (let [last (pool/last-active)
-                                    info (merge {:mime "plaintext" :tags [:editor.plaintext] :name "untitled"}
+                                    info (merge {:mime "plaintext" :tags [:editor.plaintext] :name (str "untitled-"
+                                                                                (swap! untitled-count inc))}
                                                 (path->info path))
                                     ed (pool/create info)]
                                 (object/add-tags ed [:editor.transient])


reimplement open dialog

reimplement open dialog

--- src/lt/objs/opener.cljs
+++ src/lt/objs/opener.cljs
@@ -24,12 +24,10 @@
 ;; transient docs
 ;;**********************************************************

-(defui open-input [this]
-  [:input {:type "file"}]
-  :change (fn []
-            (this-as me
-                     (when-not (empty? (dom/val me))
-                       (object/raise this :open! (dom/val me))))))
+(defn open-input [this & [ev dir?]]
+  (ipc/call this (or ev :open!)
+            :dialog.showOpenDialog ipc/win {:properties [(if dir? :openDirectory :openFile)
+                                                         :multiSelections]}))

 (defn save-input [this path]
   (ipc/call this :save-as!
@@ -141,6 +139,12 @@
           :reaction (fn [this bool]
                       (object/merge! this {:open-linked-doc bool})))

+(behavior ::open-dialog
+          :triggers #{:open-dialog!}
+          :reaction (fn [opener paths]
+                      (doseq [path paths :when path]
+                        (object/raise opener :open! path))))
+
 (behavior ::open-standard-editor
                   :triggers #{:open!}
                   :reaction (fn [obj path]
@@ -211,7 +215,7 @@
                 :tags #{:opener}
                 :triggers #{}
                 :open-files #{}
-                :behaviors [::open-standard-editor]
+                :behaviors [::open-standard-editor ::open-dialog]
                 :init (fn [this]))

 (def opener (object/create ::opener))
@@ -224,7 +228,7 @@
 (cmd/command {:command :open-file
               :desc "File: Open file"
               :exec (fn []
-                      (dialogs/file opener :open!))})
+                      (open-input opener :open-dialog!))})

 (cmd/command {:command :open-path
               :desc "File: Open path"


restructure (over) and more logging

restructure (over) and more logging

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -95,6 +95,8 @@
 (def ^:dynamic *check-infl* true)

 (defn head-pre-checks [parent child]
+  (log/debug (str "head-pre-checks PH: " (strip-refs (get-in parent [:head]))))
+  (log/debug (str "head-pre-checks H: " (dissoc (strip-refs child) :serialized)))
   (or
    (fail? (unifyc (get-in parent [:head :synsem :infl] :top)
                   (get-in child [:synsem :infl] :top)))
@@ -135,13 +137,15 @@
                   (get-in child [:synsem :subcat] :top)))))

 (defn moreover-head [parent child lexfn-sem-impl morph]
-  (let [morph (if morph morph (fn [x] x))]
-    (log/trace (str "moreover-head (candidate) parent: [" (get-in parent [:rule]) "] '" (morph parent) "' sem:    " (strip-refs (get-in parent '(:synsem :sem) :no-semantics))))
-    (log/trace (str "moreover-head (candidate) head child: [" (get-in parent [:child]) "] '" (morph child) "' sem:" (strip-refs (get-in child '(:synsem :sem) :top))))
+  (let [morph (if morph morph (fn [x] (strip-refs (dissoc x :serialized))))]
+    (log/debug (str "moreover-head (candidate) parent: [" (get-in parent [:rule]) "] '" (morph parent) "' sem:    " (strip-refs (get-in parent '(:synsem :sem) :no-semantics))))
+    (log/debug (str "moreover-head (candidate) head child: [" (get-in parent [:child]) "] '" (morph child) "' sem:" (strip-refs (get-in child '(:synsem :sem) :top))))
     (let [head-pre-checks (head-pre-checks parent child)
           result
           (if head-pre-checks
-            :fail
+            (do
+              (log/debug (str "head failed prechecks."))
+              :fail)
             (unify
              (copy parent)
              (unify {:head (copy child)
@@ -204,8 +208,8 @@
 (def ^:dynamic *throw-exception-if-failed-to-add-complement* false)

 (defn moreover-comp [parent child lexfn-sem-impl]
-  (log/trace (str "moreover-comp type parent: " (type parent)))
-  (log/trace (str "moreover-comp type comp:" (type child)))
+  (log/debug (str "moreover-comp type parent: " (type parent)))
+  (log/debug (str "moreover-comp type comp:" (type child)))
   (log/debug (str "moreover-comp: child cat: " (get-in child [:synsem :cat])))
   (log/debug (str "moreover-comp: parent comp cat: " (get-in parent [:comp :synsem :cat])))

@@ -242,11 +246,14 @@
         (log/trace (str "moreover-comp:  parent value: " (strip-refs (get-in parent (fail-path result)))))
         :fail))))

-(defn overh [parent head morph]
+(defn overh
   "add given head as the head child of the phrase: parent."
-  (when (map? parent)
+  [parent head morph]
+  (when (and (map? parent)
+             (map? head))
     (do
-      (log/trace (str "overh: parent: " (strip-refs parent)))))
+      (log/debug (str "overh: parent: " (strip-refs (dissoc parent :serialized))))
+      (log/debug (str "overh: head: " (strip-refs (dissoc head :serialized))))))

   (cond

@@ -280,9 +287,10 @@
    (let [result (moreover-head parent head sem-impl morph)
          is-fail? (fail? result)
          label (if (get-in parent [:rule]) (get-in parent [:rule]) (:comment parent))]
-     (log/trace (str "overh result result: " (strip-refs result)))
      (if (not is-fail?)
-       (list result)))))
+       (do
+         (log/debug (str "overh successful result: " (strip-refs (dissoc result :serialized))))
+         (list result))))))

 ;; Haskell-looking signature:
 ;; (parent:map) X (child:{set,seq,fs}) => list:map
@@ -291,13 +299,13 @@
 (defn overc [parent comp]
   "add given child as the comp child of the phrase: parent."

-  (log/trace (str "set? parent:" (set? parent)))
-  (log/trace (str "seq? parent:" (seq? parent)))
-  (log/trace (str "seq? comp:" (seq? comp)))
-
-  (log/trace (str "type of parent: " (type parent)))
-  (log/trace (str "type of comp  : " (type comp)))
-  (log/trace (str "nil? comp  : " (nil? comp)))
+  (log/debug (str "set? parent:" (set? parent)))
+  (log/debug (str "seq? parent:" (seq? parent)))
+  (log/debug (str "seq? comp:" (seq? comp)))
+
+  (log/debug (str "type of parent: " (type parent)))
+  (log/debug (str "type of comp  : " (type comp)))
+  (log/debug (str "nil? comp  : " (nil? comp)))

   (cond
    (nil? comp) nil
@@ -342,38 +350,60 @@
 (defn over [parents child1 & [child2]]
   (cond (vector? child1)
         (over parents (seq child1) child2)
+
         (vector? child2)
         (over parents child1 (seq child2))
+
+        (map? parents)
+        (do
+          (log/debug (str "parents is a map: converting to a list and re-calling."))
+          (over (list parents) child1 child2))
+
+        (nil? child2)
+        (over parents child1 :top)
+
+        (empty? parents)
+        nil
+
+        (and (map? parents)
+             (not (nil? (:serialized parents))))
+        ;; In this case, supposed 'parent' is really a lexical item: for now, definition of 'lexical item' is,
+        ;; it has a non-nil value for :serialized - just return nil, nothing else to do.
+        (throw (exception (str "Don't know what to do with this parent: " parents)))
+
+        ;; if parent is a symbol, evaluate it; should evaluate to a list of expansions (which might also be symbols, etc).
+        #?(:clj (symbol? parents))
+        #?(:clj (over (eval parents) child1 child2))
+
         true
-  (if (nil? child2) (over parents child1 :top)
-      (if (map? parents)
-        (over (list parents) child1 child2)
-        (if (not (empty? parents))
-          (let [parent (first parents)]
-            (log/trace (str "over: parent: " (get-in parent [:rule])))
-            (concat
-             (cond (and (map? parent)
-                        (not (nil? (:serialized parent))))
-                   ;; In this case, supposed 'parent' is really a lexical item: for now, definition of 'lexical item' is,
-                   ;; it has a non-nil value for :serialized - just return nil, nothing else to do.
-
-                   (throw (exception (str "Don't know what to do with this parent: " parent)))
-
-                   ;; if parent is a symbol, evaluate it; should evaluate to a list of expansions (which might also be symbols, etc).
-                   #?(:clj (symbol? parent))
-                   #?(:clj (over (eval parent) child1 child2))
-
-                   ;; if parent is map, do introspection: figure out the schema from the :schema-symbol attribute,
-                   ;; and figure out head-comp ordering from :first attribute.
-                   (and (map? parent)
-                        (not (nil? (:schema-symbol parent))))
-                   (filter (fn [each]
-                             (not (fail? each)))
-                           (overhc parent
-                                   (if (= (:first parent) :head)
-                                     child1 child2)
-                                   (if (= (:first parent) :head)
-                                     child2 child1)))
-                   true
-                   (throw (exception (str "Don't know what to do with parent: " parent))))
-             (over (rest parents) child1 child2))))))))
+        (let [parent (first parents)]
+          (cond
+            (nil? (get-in parent [:schema-symbol] nil))
+            (throw (exception (str "no schema symbol for parent: " (:rule parent))))
+
+            true
+            (do
+              (log/debug (str "over: parent: " (get-in parent [:rule]) " with schema symbol: " (get-in parent [:schema-symbol])))
+              (if (= (:first parent) :head)
+                ;; else, head is left child.
+                (do (log/debug "over: left child (head):" child1)
+                    (log/debug "over: right child (comp):" child2))
+                ;; else, head is right child.
+                (do (log/debug "over: left child (comp):" child1)
+                    (log/debug "over: right child (head):" child2)))
+
+              (concat
+               ;; if parent is map, do introspection: figure out the schema from the :schema-symbol attribute,
+               ;; and figure out head-comp ordering from :first attribute.
+               (filter (fn [each]
+                         (not (fail? each)))
+                       (overhc parent
+                               (if (= (:first parent) :head)
+                                 child1 child2)
+                               (if (= (:first parent) :head)
+                                 child2 child1)))
+               (over (rest parents) child1 child2)))))))
+
+
+
+


let AbstractModel do the empty update check

--- dada-core/src/main/clojure/org/dada/core/PivotModel.clj
+++ dada-core/src/main/clojure/org/dada/core/PivotModel.clj
@@ -184,5 +184,4 @@
 (defn -update [#^org.dada.core.PivotModel this & inputs]
   (let [[update-fn] (.state this)
 	[#^Collection i #^Collection a #^Collection d] (update-fn inputs)]
-    (if (not (and (empty? i) (empty? a) (empty? d)))
-      (.notifyUpdate this i a d))))
+    (.notifyUpdate this i a d)))


tidyness

tidyness

--- src/metabase/driver.clj
+++ src/metabase/driver.clj
@@ -289,9 +289,9 @@
         java.util.Date               :DateField
         java.util.UUID               :TextField
         org.postgresql.util.PGobject :UnknownField} klass)
-      (cond
-        (isa? klass clojure.lang.IPersistentMap)    :DictionaryField
-        (isa? klass clojure.lang.IPersistentVector) :ArrayField)
+      (condp isa? klass
+        clojure.lang.IPersistentMap    :DictionaryField
+        clojure.lang.IPersistentVector :ArrayField)
       (do (log/warn (format "Don't know how to map class '%s' to a Field base_type, falling back to :UnknownField." klass))
           :UnknownField)))


Update cider config.

Update cider config.

--- lein/.lein/profiles.clj
+++ lein/.lein/profiles.clj
@@ -1,8 +1,10 @@
-{:user {:plugin-repositories [["private-plugins" {:url "private repo url"}]]
+{:user
+ {:plugin-repositories [["private-plugins"
+                         {:url "private repo url"}]]
         :singing {:gpg-key "matthew.russell@wormbase.org"}
         :dependencies [[clojure-ini "0.0.2"]
                        [me.raynes/fs "1.4.6"]]
-        :plugins [[cider/cider-nrepl "0.8.2"]
+        :plugins [[cider/cider-nrepl "0.14.0-SNAPSHOT"]
                   [refactor-nrepl "0.2.2"]
                   [jonase/eastwood "0.2.3"]
                   [lein-ancient "0.6.8"]
@@ -12,6 +14,8 @@
  :repl {:dependencies [[acyclic/squiggly-clojure "0.1.6"]
                        [datomic-schema-grapher "0.0.1"]
                        [org.clojure/tools.nrepl "0.2.12"]]}
+ :dev {:env
+       {:squiggly {:checkers [:eastwood]}}}
  ;; VisualVM profiling opts
  :jvm-opts ["-Dcom.sun.management.jmxremote"
             "-Dcom.sun.management.jmxremote.ssl=false"


Step 6-1: Sprite generator

Step 6-1: Sprite generator

--- desktop/src-common/brain_gain_or_drain/screens/game.clj
+++ desktop/src-common/brain_gain_or_drain/screens/game.clj
@@ -20,6 +20,13 @@
   (assoc entity
          :x width
          :y (rand-int height)))
+
+(defn sprite-generator
+  [template max-x max-y]
+  (repeatedly (fn []
+                (merge template
+                       {:x (rand-int max-x)
+                        :y (rand-int max-y)}))))

 (defscreen game-screen
   :on-show


add new ui index html again for heroku

add new ui index html again for heroku

--- backend/src/lambdaui/core.clj
+++ backend/src/lambdaui/core.clj
@@ -24,7 +24,9 @@
     (routes (context "/lambdaui/api" [] (new-api/api-routes pipeline))
             (context "/api" [] (old-api/rest-api pipeline))
             (GET "/old" [] (old-ui/ui-page pipeline))
-            (route/resources "/" {:root "public"}))))
+            (route/resources "/" {:root "public"})
+            (route/resources "/ui" {:root "public/target"})
+            )))

 (defn start-server [port]
   (git/init-ssh!)


Add piggieback to local profile

Add piggieback to local profile

--- fulcro-todo/project.clj
+++ fulcro-todo/project.clj
@@ -23,6 +23,9 @@
                                :optimizations        :none}}]}

   :profiles {:dev {:source-paths ["src/dev" "src/main"]
+                   :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
                    :dependencies [[binaryage/devtools "0.9.4"]
+                                  [com.cemerick/piggieback "0.2.1"]
                                   [org.clojure/tools.namespace "0.3.0-alpha4"]
-                                  [figwheel-sidecar "0.5.13"]]}})
+                                  [figwheel-sidecar "0.5.13"]
+                                  [org.clojure/tools.nrepl "0.2.13"]]}})


scheme of API responses hardcoded to https

--- src/notehub/handler.clj
+++ src/notehub/handler.clj
@@ -143,12 +143,10 @@
 (def app
   (let [handler (handler/site app-routes)]
     (fn [request]
-      (let [{:keys [scheme server-name server-port]} request
-            hostURL (str (name scheme) "://" server-name
+      (let [{:keys [server-name server-port]} request
+            hostURL (str "https://" server-name
                           (when (not= 80 server-port) (str ":" server-port)))
             request (assoc-in request [:params :hostURL] hostURL)]
-        (println (str (java.util.Date.) ":") (request :request-method) (str hostURL (request :uri)) "-"
-                 ((request :headers) "user-agent"))
         (if (get-setting :dev-mode)
         (handler request)
         (try (handler request)


delete debug line

delete debug line

--- src/one_hyde/server.clj
+++ src/one_hyde/server.clj
@@ -47,9 +47,6 @@
 (defn -main
   "main"
   [& [option]]
-  #_(doseq [s ["2012-03-19" "2012-3-19" "hoge" "2012-1-1"]]
-    (println
-      (f/parse (f/formatter "YYYY-MM-dd") s)))
   (case option
     "compile" (compile-all-templates)


NFE in stuff

NFE in stuff

--- src/ontrail/formats.clj
+++ src/ontrail/formats.clj
@@ -47,7 +47,7 @@
       (time-format/unparse date-format date-time))))

 (defn seconds-part [seconds hundreds]
-  (if (> hundreds 0)
+  (if ((and false (> hundreds 0)))
     (str seconds "," (format "%02d" hundreds) " s")
     (str seconds " s")))


Return user with sports.

Return user with sports.

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -61,7 +61,7 @@
   (.debug logger (str "Getting summary: " user " condition " condition))
   (let [cond-with-user (assoc condition :user user)
         all-distinct-sports (mc/distinct EXERCISE "sport" cond-with-user)]
-     (sort-by :numericalDuration > (map #(get-summary (assoc condition :user user :sport %) %) all-distinct-sports))))
+    {:user user :sports (sort-by :numericalDuration > (map #(get-summary (assoc condition :user user :sport %) %) all-distinct-sports))}))

 (defn get-year-summary-sport [user year]
   (let [first-day (time/date-time year 1 1)


Don't send any unknown messages to scsynth - raise an exception instead.

--- src/overtone/sc/osc.clj
+++ src/overtone/sc/osc.clj
@@ -285,4 +285,6 @@
   [host path & args]
   (if-let [sig (OSC-TYPE-SIGNATURES path)]
     (apply checked-snd sig host path args)
-    (apply osc-send host path args)))
+    (let [err-string (str "Unknown scsynth OSC path" path)]
+      (log/error err-string)
+      (throw (Exception. err-string)))))


Fixed definitions of some aliases

Fixed definitions of some aliases

--- src/rosado/processing.clj
+++ src/rosado/processing.clj
@@ -224,7 +224,7 @@
   [amt low high]
   (PApplet/constrain (int amt) (int low) (int high)))

-(defn constrain constrain-float)
+(def constrain constrain-float)

 (defn copy
   ([[sx1 sy1 sx2 sy2] [dx1 dy1 dx2 dy2]]
@@ -758,7 +758,7 @@
   ([rgb] (.stroke *applet* (int rgb)))
   ([rgb alpha] (.stroke *applet* (int rgb) (float alpha))))

-(defn stroke stroke-float)
+(def stroke stroke-float)

 (defn stroke-cap [cap] (.strokeCap *applet* (int cap)))

@@ -830,7 +830,7 @@
   ([rgb] (.tint *applet* (int rgb)))
   ([rgb alpha] (.tint *applet* (int rgb) (float alpha))))

-(defn tint tint-float)
+(def tint tint-float)

 (defn translate
   ([v] (apply translate v))


added Alex to mumsnet entry

added Alex to mumsnet entry

--- src/prais2/content.cljc
+++ src/prais2/content.cljc
@@ -1160,7 +1160,7 @@
                                [:li
                                 [:a (core/href "http://www.insight.mrc.ac.uk/2016/07/29/beyond-open-making-data-accessible/" :target "_blank") "Insight: Medical Research Council"] " “Beyond open: making your data accessible”"]
                                [:li
-                                [:a (core/href "http://www.mumsnet.com/Talk/guest_posts/2699023-Guest-post-I-hope-weve-helped-others-preparing-for-their-childs-heart-surgery" :target "_blank") "Mumsnet guest post:"] " “I hope we've helped others preparing for their child's heart surgery”"]
+                                [:a (core/href "http://www.mumsnet.com/Talk/guest_posts/2699023-Guest-post-I-hope-weve-helped-others-preparing-for-their-childs-heart-surgery" :target "_blank") "Mumsnet guest post:"] " “I hope we've helped others preparing for their child's heart surgery” by Alex Smith"]
                                ]
                               ]
                }]}


Update content.cljs

Update content.cljs

CP updating the multiple hypothesis testing explanation with David's suggestion.

--- src/prais2/content.cljs
+++ src/prais2/content.cljs
@@ -427,7 +427,7 @@
                            [:.col-sm-8 [:img.thumbnail {:style {:width "100%"}
                                                          :src "assets/rare.png"}]]

-                           [:p "BUT, if we are looking at all 14 hospitals at once, we’d actually expect that at least one hospital will fall outside its range just by chance about 8 times in 20! This is similar to the difference between flipping one coin and flipping many: if I only flip one coin there is a 50% probability that I’ll get one head whereas if I flipped, say, the four coins in a row the probability of me getting at least one head in the four throws goes up to 94%."]
+                           [:p "BUT, if we are looking at all 14 hospitals at once, we’d actually expect that at least one hospital will fall outside its range just by chance about 8 times in 20! This is similar to the situation where you hear a friend won a good prize in a raffle. This may be surprising, but it becomes a lot less surprising when you hear they bought 100 tickets. Just as this gave them more chances of winning, the more hospitals we look at, the more likely it becomes that at least one will fall outside its range, even if survival at all the hospitals matches the formula."]

                            [:p "8 times in 20 means that it is not that rare that " [:strong "any"] " one of these hospitals will have an survival rate that falls outside their predicted range. "]
                            [:.col-sm-8 [:img.thumbnail {:style {:width "100%"}


Use :require :as instead of use in cli ns.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -11,12 +11,11 @@
     :doc "cli4clj allows to create simple interactive command line interfaces for Clojure applications.
           For an example usage scenario please see the namespace cli4clj.example."}
   cli4clj.cli
-  (:use
-    [clojure.main :only [repl skip-if-eol skip-whitespace]]
-    [clojure.string :only [blank? split]])
   (:require
     (clj-assorted-utils [util :as utils])
-    (clojure [stacktrace :as strace]))
+    (clojure
+      [main :as main]
+      [stacktrace :as strace]))
   (:import
     (java.io PushbackReader StringReader)
     (jline.console ConsoleReader)
@@ -70,7 +69,7 @@
     (fn [request-prompt request-exit]
       (try
         (or ({:line-start request-prompt :stream-end request-exit}
-             (skip-whitespace *in*))
+             (main/skip-whitespace *in*))
             (loop [v []]
               (let [input (try
                             (read {:read-cond :allow} *in*)
@@ -84,9 +83,9 @@
                                   (throw e)))))]
                 (if (and (not (symbol? input)) (empty? v))
                   (do
-                    (skip-if-eol *in*)
+                    (main/skip-if-eol *in*)
                     input)
-                  (if (= :line-start (skip-whitespace *in*))
+                  (if (= :line-start (main/skip-whitespace *in*))
                     (if (and (symbol? input)
                              (some #(= (keyword input) %) quit-commands))
                       request-exit
@@ -306,7 +305,7 @@
   [user-options]
    (let [options-with-args-info (add-args-info user-options)]
     `(let [options# (get-cli-opts ~options-with-args-info)]
-       (repl
+       (main/repl
          :eval ((options# :eval-factory) options#)
          :print (options# :print)
          :prompt (options# :prompt-fn)


lein: remove unused plugins

lein: remove unused plugins

--- lein_profiles.clj
+++ lein_profiles.clj
@@ -1,11 +1,5 @@
 {:user {:plugins [
                   [lein-cljfmt "0.3.0" :exclusions [org.clojure/clojure]]
                   [lein-ancient "0.6.8" :exclusions [org.clojure/clojure]]
-                  [lein-ring "0.9.7"]
                   [lein-ancient "0.6.8"]
-                  [jonase/eastwood "0.2.3"]
-                  [cider/cider-nrepl "0.10.1"]
                   ]}}
-{:dev {:dependencies
-       [[com.cemerick/pomegranate "0.3.0"]]
-       }}


Make code more figwheel friendly.  Tabs stay put on figwheel refresh.

--- src/re_demo/basics.cljs
+++ src/re_demo/basics.cljs
@@ -566,23 +566,25 @@
             ;{:id 91 :label "v-box"                 :component v-box-demo} ;; Experimental
             ])

+;; This is not the way you'd store state in a "real" app.  We're just taking shortcuts for demo purposes.
+;; If we put this atom at global scope and use defonce, it works better with figwheel refreshes.
+(defonce selected-demo-id (reagent/atom 0))
+
 (defn panel2
   []
-  (let [selected-demo-id (reagent/atom 0)]
-    (fn []
-      [v-box
-       :gap "10px"
-       :children [[panel-title "Basic Components" ]
-                  [h-box
-                   :gap      "50px"
-                   :children [[v-box
-                               :gap      "10px"
-                               :children [[component-title "Components"]
-                                          [vertical-bar-tabs
-                                           :model     selected-demo-id
-                                           :tabs      demos
-                                           :on-change #(reset! selected-demo-id %)]]]
-                              [(get-in demos [@selected-demo-id :component])]]]]])))
+  [v-box
+   :gap "10px"
+   :children [[panel-title "Basic Components" ]
+              [h-box
+               :gap      "50px"
+               :children [[v-box
+                           :gap      "10px"
+                           :children [[component-title "Components"]
+                                      [vertical-bar-tabs
+                                       :model     selected-demo-id
+                                       :tabs      demos
+                                       :on-change #(reset! selected-demo-id %)]]]
+                          [(get-in demos [@selected-demo-id :component])]]]]])

 (defn panel   ;; Only required for Reagent to update panel2 when figwheel pushes changes to the browser


Implement cmd / ctrl key combinations

Implement cmd / ctrl key combinations

--- src/reabledit/util.cljs
+++ src/reabledit/util.cljs
@@ -36,10 +36,28 @@
 (defn default-handle-key-down
   [e row-change-fn column row-data rows cols state]
   (let [keycode (.-keyCode e)
+        meta? (.-metaKey e)
         shift? (.-shiftKey e)
         current-row (-> @state :selected first)
         current-col (-> @state :selected second)]
     (cond
+
+      ;; CMD / CTRL -combinations, when edit mode is not enabled
+      (and (not (:edit @state)) meta?)
+      (do
+        (.preventDefault e)
+        (case keycode
+
+          ;; Home selects the first cell
+          36 (move-to-cell! row-change-fn 0 0 state)
+
+          ;; Arrow keys move to the beginning of row or col
+          37 (move-to-cell! row-change-fn current-row 0 state)
+          38 (move-to-cell! row-change-fn 0 current-col state)
+          39 (move-to-cell! row-change-fn current-row cols state)
+          40 (move-to-cell! row-change-fn rows current-col state)
+          nil
+          ))

       ;; Home moves to the beginning of row if not in edit mode
       (and (not (:edit @state)) (= keycode 36))


ensure save-shape and restore-shape see the same components

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7452 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/DataBrowser/src/org/micromanager/browser/utils.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/utils.clj
@@ -187,8 +187,8 @@

 ;; saving and restoring window shape in preferences

-(defn get-shape [^java.awt.Component window]
-  (for [comp (widget-seq window)]
+(defn get-shape [components]
+  (for [comp components]
     (condp instance? comp
       java.awt.Window
         [:window {:x (.getX comp) :y (.getY comp)
@@ -197,8 +197,8 @@
         [:split-pane {:location (.getDividerLocation comp)}]
       nil)))

-(defn set-shape [comp shape-data]
-  (loop [comps (widget-seq comp) shapes shape-data]
+(defn set-shape [components shape-data]
+  (loop [comps components shapes shape-data]
     (let [comp (first comps)
           shape (first shapes)]
       (try
@@ -214,17 +214,18 @@
     (when (next comps)
       (recur (next comps) (next shapes)))))

-(defn save-shape [prefs name component]
-  (write-value-to-prefs prefs name (get-shape component)))
-
-(defn restore-shape [prefs name component]
-  (set-shape component (read-value-from-prefs prefs name)))
+(defn save-shape [prefs name components]
+  (write-value-to-prefs prefs name (get-shape components)))
+
+(defn restore-shape [prefs name components]
+  (set-shape components (read-value-from-prefs prefs name)))

 (defn persist-window-shape [prefs name ^java.awt.Window window]
-  (restore-shape prefs name window)
-  (.addWindowListener window
-    (proxy [java.awt.event.WindowAdapter] []
-      (windowClosing [_] (save-shape prefs name window)))))
+  (let [components (widget-seq window)]
+    (restore-shape prefs name components)
+    (.addWindowListener window
+      (proxy [java.awt.event.WindowAdapter] []
+        (windowClosing [_] (save-shape prefs name components))))))

 ;; file choosers


Remove gen-class

Remove gen-class

--- src/time_tracker/core.clj
+++ src/time_tracker/core.clj
@@ -1,5 +1,4 @@
 (ns time-tracker.core
-  (:gen-class)
   (:require [bidi.ring :refer [make-handler]]
             [ring.middleware.json :refer [wrap-json-response
                                           wrap-json-body]]


Remove log

Remove log

--- src/obb_rules_api/turn.clj
+++ src/obb_rules_api/turn.clj
@@ -21,7 +21,6 @@
 (defn get-raw-json
   "Retrieves the raw json from the given request"
   [raw]
-  (println raw)
   (if-let [body (get-in raw [:params :context])]
     body
     (slurp (:body raw))))


Add settings related new translation strings.

--- src/uxbox/locales/en.cljs
+++ src/uxbox/locales/en.cljs
@@ -38,12 +38,14 @@
    "ds.help.circle" "Circle (Ctrl + E)"
    "ds.help.line" "Line (Ctrl + L)"

-   "profile.password-saved" "Password saved successfully!"
+   "settings.profile" "PROFILE"
+   "settings.password" "PASSWORD"
+   "settings.notifications" "NOTIFICATIONS"
+   "settings.profile-saved" "Profile saved successfully!"
+   "settings.password-saved" "Password saved successfully!"

    "history.alert-message" "You are seeng version %s"
-
    "errors.api.form.old-password-not-match" "Incorrect old password"
-
    "errors.form.required" "This field is mandatory"
    "errors.form.string" "Should be string"
    "errors.form.number" "Invalid number"